diff --git a/builtins.c b/builtins.c index 8cbb156..4fdc3a2 100644 --- a/builtins.c +++ b/builtins.c @@ -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 }, diff --git a/cvalues.c b/cvalues.c index df402de..a70ee02 100644 --- a/cvalues.c +++ b/cvalues.c @@ -1,9 +1,9 @@ #include "operators.c" #ifdef BITS64 -#define NWORDS(sz) (((sz)+7)>>3) +#define NWORDS(sz) (((sz) + 7) >> 3) #else -#define NWORDS(sz) (((sz)+3)>>2) +#define NWORDS(sz) (((sz) + 3) >> 2) #endif static int ALIGN2, ALIGN4, ALIGN8, ALIGNPTR; @@ -26,9 +26,9 @@ static fltype_t *int32type, *uint32type; static fltype_t *int64type, *uint64type; static fltype_t *longtype, *ulongtype; static fltype_t *floattype, *doubletype; - fltype_t *bytetype, *wchartype; - fltype_t *stringtype, *wcstringtype; - fltype_t *builtintype; +fltype_t *bytetype, *wchartype; +fltype_t *stringtype, *wcstringtype; +fltype_t *builtintype; static void cvalue_init(fltype_t *type, value_t v, void *dest); @@ -43,14 +43,15 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs); static size_t malloc_pressure = 0; static cvalue_t **Finalizers = NULL; -static size_t nfinalizers=0; -static size_t maxfinalizers=0; +static size_t nfinalizers = 0; +static size_t maxfinalizers = 0; void add_finalizer(cvalue_t *cv) { if (nfinalizers == maxfinalizers) { - size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2); - cvalue_t **temp = (cvalue_t**)realloc(Finalizers, nn*sizeof(value_t)); + size_t nn = (maxfinalizers == 0 ? 256 : maxfinalizers * 2); + cvalue_t **temp = + (cvalue_t **)realloc(Finalizers, nn * sizeof(value_t)); if (temp == NULL) lerror(MemoryError, "out of memory"); Finalizers = temp; @@ -63,19 +64,18 @@ void add_finalizer(cvalue_t *cv) static void sweep_finalizers(void) { cvalue_t **lst = Finalizers; - size_t n=0, ndel=0, l=nfinalizers; + size_t n = 0, ndel = 0, l = nfinalizers; cvalue_t *tmp; -#define SWAP_sf(a,b) (tmp=a,a=b,b=tmp,1) +#define SWAP_sf(a, b) (tmp = a, a = b, b = tmp, 1) if (l == 0) return; do { tmp = lst[n]; if (isforwarded((value_t)tmp)) { // object is alive - lst[n] = (cvalue_t*)ptr(forwardloc((value_t)tmp)); + lst[n] = (cvalue_t *)ptr(forwardloc((value_t)tmp)); n++; - } - else { + } else { fltype_t *t = cv_class(tmp); if (t->vtable != NULL && t->vtable->finalize != NULL) { t->vtable->finalize(tagptr(tmp, TAG_CVALUE)); @@ -88,7 +88,7 @@ static void sweep_finalizers(void) } ndel++; } - } while ((n < l-ndel) && SWAP_sf(lst[n],lst[n+ndel])); + } while ((n < l - ndel) && SWAP_sf(lst[n], lst[n + ndel])); nfinalizers -= ndel; #ifdef VERBOSEGC @@ -104,7 +104,7 @@ static size_t cv_nwords(cvalue_t *cv) { if (isinlined(cv)) { size_t n = cv_len(cv); - if (n==0 || cv_isstr(cv)) + if (n == 0 || cv_isstr(cv)) n++; return CVALUE_NWORDS - 1 + NWORDS(n); } @@ -113,20 +113,17 @@ static size_t cv_nwords(cvalue_t *cv) static void autorelease(cvalue_t *cv) { - cv->type = (fltype_t*)(((uptrint_t)cv->type) | CV_OWNED_BIT); + cv->type = (fltype_t *)(((uptrint_t)cv->type) | CV_OWNED_BIT); add_finalizer(cv); } -void cv_autorelease(cvalue_t *cv) -{ - autorelease(cv); -} +void cv_autorelease(cvalue_t *cv) { autorelease(cv); } static value_t cprim(fltype_t *type, size_t sz) { assert(!ismanaged((uptrint_t)type)); assert(sz == type->size); - cprim_t *pcp = (cprim_t*)alloc_words(CPRIM_NWORDS-1+NWORDS(sz)); + cprim_t *pcp = (cprim_t *)alloc_words(CPRIM_NWORDS - 1 + NWORDS(sz)); pcp->type = type; return tagptr(pcp, TAG_CPRIM); } @@ -134,7 +131,7 @@ static value_t cprim(fltype_t *type, size_t sz) value_t cvalue(fltype_t *type, size_t sz) { cvalue_t *pcv; - int str=0; + int str = 0; if (valid_numtype(type->numtype)) { return cprim(type, sz); @@ -143,20 +140,19 @@ value_t cvalue(fltype_t *type, size_t sz) if (sz == 0) return symbol_value(emptystringsym); sz++; - str=1; + str = 1; } if (sz <= MAX_INL_SIZE) { - size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz==0 ? 1 : 0); - pcv = (cvalue_t*)alloc_words(nw); + size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0); + pcv = (cvalue_t *)alloc_words(nw); pcv->type = type; pcv->data = &pcv->_space[0]; if (type->vtable != NULL && type->vtable->finalize != NULL) add_finalizer(pcv); - } - else { + } else { if (malloc_pressure > ALLOC_LIMIT_TRIGGER) gc(0); - pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS); + pcv = (cvalue_t *)alloc_words(CVALUE_NWORDS); pcv->type = type; pcv->data = malloc(sz); autorelease(pcv); @@ -164,7 +160,7 @@ value_t cvalue(fltype_t *type, size_t sz) } if (str) { sz--; - ((char*)pcv->data)[sz] = '\0'; + ((char *)pcv->data)[sz] = '\0'; } pcv->len = sz; return tagptr(pcv, TAG_CVALUE); @@ -191,26 +187,23 @@ value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent) cvalue_t *pcv; value_t cv; - pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS); + pcv = (cvalue_t *)alloc_words(CVALUE_NWORDS); pcv->data = ptr; pcv->len = sz; pcv->type = type; if (parent != NIL) { - pcv->type = (fltype_t*)(((uptrint_t)pcv->type) | CV_PARENT_BIT); + pcv->type = (fltype_t *)(((uptrint_t)pcv->type) | CV_PARENT_BIT); pcv->parent = parent; } cv = tagptr(pcv, TAG_CVALUE); return cv; } -value_t cvalue_string(size_t sz) -{ - return cvalue(stringtype, sz); -} +value_t cvalue_string(size_t sz) { return cvalue(stringtype, sz); } value_t cvalue_static_cstring(const char *str) { - return cvalue_from_ref(stringtype, (char*)str, strlen(str), NIL); + return cvalue_from_ref(stringtype, (char *)str, strlen(str), NIL); } value_t string_from_cstrn(char *str, size_t n) @@ -227,7 +220,7 @@ value_t string_from_cstr(char *str) int fl_isstring(value_t v) { - return (iscvalue(v) && cv_isstr((cvalue_t*)ptr(v))); + return (iscvalue(v) && cv_isstr((cvalue_t *)ptr(v))); } // convert to malloc representation (fixed address) @@ -236,92 +229,80 @@ void cv_pin(cvalue_t *cv) if (!isinlined(cv)) return; size_t sz = cv_len(cv); - if (cv_isstr(cv)) sz++; + if (cv_isstr(cv)) + sz++; void *data = malloc(sz); memcpy(data, cv_data(cv), sz); cv->data = data; autorelease(cv); } -#define num_init(ctype, cnvt, tag) \ -static int cvalue_##ctype##_init(fltype_t *type, value_t arg, \ - void *dest) \ -{ \ - fl_##ctype##_t n=0; \ - (void)type; \ - if (isfixnum(arg)) { \ - n = numval(arg); \ - } \ - else if (iscprim(arg)) { \ - cprim_t *cp = (cprim_t*)ptr(arg); \ - void *p = cp_data(cp); \ - n = (fl_##ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \ - } \ - else { \ - return 1; \ - } \ - *((fl_##ctype##_t*)dest) = n; \ - return 0; \ -} -num_init(int8, int32, T_INT8) -num_init(uint8, uint32, T_UINT8) -num_init(int16, int32, T_INT16) -num_init(uint16, uint32, T_UINT16) -num_init(int32, int32, T_INT32) -num_init(uint32, uint32, T_UINT32) -num_init(int64, int64, T_INT64) -num_init(uint64, uint64, T_UINT64) -num_init(float, double, T_FLOAT) -num_init(double, double, T_DOUBLE) +#define num_init(ctype, cnvt, tag) \ + static int cvalue_##ctype##_init(fltype_t *type, value_t arg, \ + void *dest) \ + { \ + fl_##ctype##_t n = 0; \ + (void)type; \ + if (isfixnum(arg)) { \ + n = numval(arg); \ + } else if (iscprim(arg)) { \ + cprim_t *cp = (cprim_t *)ptr(arg); \ + void *p = cp_data(cp); \ + n = (fl_##ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \ + } else { \ + return 1; \ + } \ + *((fl_##ctype##_t *)dest) = n; \ + return 0; \ + } +num_init(int8, int32, T_INT8) num_init(uint8, uint32, T_UINT8) +num_init(int16, int32, T_INT16) num_init(uint16, uint32, T_UINT16) +num_init(int32, int32, T_INT32) num_init(uint32, uint32, T_UINT32) +num_init(int64, int64, T_INT64) num_init(uint64, uint64, T_UINT64) +num_init(float, double, T_FLOAT) num_init(double, double, T_DOUBLE) -#define num_ctor_init(typenam, ctype, tag) \ -value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \ -{ \ - if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; } \ - value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \ - if (cvalue_##ctype##_init(typenam##type, \ - args[0], cp_data((cprim_t*)ptr(cp)))) \ - type_error(#typenam, "number", args[0]); \ - return cp; \ -} +#define num_ctor_init(typenam, ctype, tag) \ + value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \ + { \ + if (nargs == 0) { \ + PUSH(fixnum(0)); \ + args = &Stack[SP - 1]; \ + } \ + value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \ + if (cvalue_##ctype##_init(typenam##type, args[0], \ + cp_data((cprim_t *)ptr(cp)))) \ + type_error(#typenam, "number", args[0]); \ + return cp; \ + } -#define num_ctor_ctor(typenam, ctype, tag) \ -value_t mk_##typenam(fl_##ctype##_t n) \ -{ \ - value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \ - *(fl_##ctype##_t*)cp_data((cprim_t*)ptr(cp)) = n; \ - return cp; \ -} +#define num_ctor_ctor(typenam, ctype, tag) \ + value_t mk_##typenam(fl_##ctype##_t n) \ + { \ + value_t cp = cprim(typenam##type, sizeof(fl_##ctype##_t)); \ + *(fl_##ctype##_t *)cp_data((cprim_t *)ptr(cp)) = n; \ + return cp; \ + } #define num_ctor(typenam, ctype, tag) \ - num_ctor_init(typenam, ctype, tag) \ - num_ctor_ctor(typenam, ctype, tag) + num_ctor_init(typenam, ctype, tag) num_ctor_ctor(typenam, ctype, tag) -num_ctor(int8, int8, T_INT8) -num_ctor(uint8, uint8, T_UINT8) -num_ctor(int16, int16, T_INT16) -num_ctor(uint16, uint16, T_UINT16) -num_ctor(int32, int32, T_INT32) -num_ctor(uint32, uint32, T_UINT32) -num_ctor(int64, int64, T_INT64) -num_ctor(uint64, uint64, T_UINT64) -num_ctor(byte, uint8, T_UINT8) -num_ctor(wchar, int32, T_INT32) +num_ctor(int8, int8, T_INT8) num_ctor(uint8, uint8, T_UINT8) +num_ctor(int16, int16, T_INT16) num_ctor(uint16, uint16, T_UINT16) +num_ctor(int32, int32, T_INT32) num_ctor(uint32, uint32, T_UINT32) +num_ctor(int64, int64, T_INT64) num_ctor(uint64, uint64, T_UINT64) +num_ctor(byte, uint8, T_UINT8) num_ctor(wchar, int32, T_INT32) #ifdef BITS64 -num_ctor(long, int64, T_INT64) -num_ctor(ulong, uint64, T_UINT64) +num_ctor(long, int64, T_INT64) num_ctor(ulong, uint64, T_UINT64) #else -num_ctor(long, int32, T_INT32) -num_ctor(ulong, uint32, T_UINT32) +num_ctor(long, int32, T_INT32) num_ctor(ulong, uint32, T_UINT32) #endif -num_ctor(float, float, T_FLOAT) -num_ctor(double, double, T_DOUBLE) +num_ctor(float, float, T_FLOAT) num_ctor(double, double, T_DOUBLE) value_t size_wrap(size_t sz) { if (fits_fixnum(sz)) return fixnum(sz); - assert(sizeof(void*) == sizeof(size_t)); + assert(sizeof(void *) == sizeof(size_t)); return mk_ulong(sz); } @@ -330,7 +311,7 @@ size_t toulong(value_t n, char *fname) if (isfixnum(n)) return numval(n); if (iscprim(n)) { - cprim_t *cp = (cprim_t*)ptr(n); + cprim_t *cp = (cprim_t *)ptr(n); return conv_to_ulong(cp_data(cp), cp_numtype(cp)); } type_error(fname, "number", n); @@ -339,7 +320,7 @@ size_t toulong(value_t n, char *fname) static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest) { - int n=0; + int n = 0; value_t syms; value_t type = ft->type; @@ -347,9 +328,9 @@ static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest) if (!isvector(syms)) type_error("enum", "vector", syms); if (issymbol(arg)) { - for(n=0; n < (int)vector_size(syms); n++) { + for (n = 0; n < (int)vector_size(syms); n++) { if (vector_elt(syms, n) == arg) { - *(int*)dest = n; + *(int *)dest = n; return 0; } } @@ -357,17 +338,15 @@ static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest) } if (isfixnum(arg)) { n = (int)numval(arg); - } - else if (iscprim(arg)) { - cprim_t *cp = (cprim_t*)ptr(arg); + } else if (iscprim(arg)) { + cprim_t *cp = (cprim_t *)ptr(arg); n = conv_to_int32(cp_data(cp), cp_numtype(cp)); - } - else { + } else { type_error("enum", "number", arg); } if ((unsigned)n >= vector_size(syms)) lerror(ArgError, "enum: value out of range"); - *(int*)dest = n; + *(int *)dest = n; return 0; } @@ -377,13 +356,13 @@ value_t cvalue_enum(value_t *args, u_int32_t nargs) value_t type = fl_list2(enumsym, args[0]); fltype_t *ft = get_type(type); value_t cv = cvalue(ft, sizeof(int32_t)); - cvalue_enum_init(ft, args[1], cp_data((cprim_t*)ptr(cv))); + cvalue_enum_init(ft, args[1], cp_data((cprim_t *)ptr(cv))); return cv; } static int isarray(value_t v) { - return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != NULL; + return iscvalue(v) && cv_class((cvalue_t *)ptr(v))->eltype != NULL; } static size_t predict_arraylen(value_t arg) @@ -418,27 +397,28 @@ static int cvalue_array_init(fltype_t *ft, value_t arg, void *dest) if (isvector(arg)) { assert(cnt <= vector_size(arg)); - for(i=0; i < cnt; i++) { - cvalue_init(eltype, vector_elt(arg,i), dest); - dest = (char*)dest + elsize; + for (i = 0; i < cnt; i++) { + cvalue_init(eltype, vector_elt(arg, i), dest); + dest = (char *)dest + elsize; } return 0; - } - else if (iscons(arg) || arg==NIL) { + } else if (iscons(arg) || arg == NIL) { i = 0; while (iscons(arg)) { - if (i == cnt) { i++; break; } // trigger error + if (i == cnt) { + i++; + break; + } // trigger error cvalue_init(eltype, car_(arg), dest); i++; - dest = (char*)dest + elsize; + dest = (char *)dest + elsize; arg = cdr_(arg); } if (i != cnt) lerror(ArgError, "array: size mismatch"); return 0; - } - else if (iscvalue(arg)) { - cvalue_t *cv = (cvalue_t*)ptr(arg); + } else if (iscvalue(arg)) { + cvalue_t *cv = (cvalue_t *)ptr(arg); if (isarray(arg)) { fltype_t *aet = cv_class(cv)->eltype; if (aet == eltype) { @@ -447,8 +427,7 @@ static int cvalue_array_init(fltype_t *ft, value_t arg, void *dest) else lerror(ArgError, "array: size mismatch"); return 0; - } - else { + } else { // TODO: initialize array from different type elements lerror(ArgError, "array: element type mismatch"); } @@ -475,8 +454,9 @@ value_t cvalue_array(value_t *args, u_int32_t nargs) sz = elsize * cnt; value_t cv = cvalue(type, sz); - char *dest = cv_data((cvalue_t*)ptr(cv)); - FOR_ARGS(i,1,arg,args) { + char *dest = cv_data((cvalue_t *)ptr(cv)); + FOR_ARGS(i, 1, arg, args) + { cvalue_init(type->eltype, arg, dest); dest += elsize; } @@ -486,12 +466,12 @@ value_t cvalue_array(value_t *args, u_int32_t nargs) // NOTE: v must be an array size_t cvalue_arraylen(value_t v) { - cvalue_t *cv = (cvalue_t*)ptr(v); - return cv_len(cv)/(cv_class(cv)->elsz); + cvalue_t *cv = (cvalue_t *)ptr(v); + return cv_len(cv) / (cv_class(cv)->elsz); } -static size_t cvalue_struct_offs(value_t type, value_t field, int computeTotal, - int *palign) +static size_t cvalue_struct_offs(value_t type, value_t field, + int computeTotal, int *palign) { value_t fld = car(cdr_(type)); size_t fsz, ssz = 0; @@ -505,7 +485,7 @@ static size_t cvalue_struct_offs(value_t type, value_t field, int computeTotal, if (al > *palign) *palign = al; - if (!computeTotal && field==car_(car_(fld))) { + if (!computeTotal && field == car_(car_(fld))) { // found target field return ssz; } @@ -525,8 +505,10 @@ static size_t cvalue_union_size(value_t type, int *palign) while (iscons(fld)) { fsz = ctype_sizeof(car(cdr(car_(fld))), &al); - if (al > *palign) *palign = al; - if (fsz > usz) usz = fsz; + if (al > *palign) + *palign = al; + if (fsz > usz) + usz = fsz; fld = cdr_(fld); } return LLT_ALIGN(usz, *palign); @@ -565,7 +547,7 @@ size_t ctype_sizeof(value_t type, int *palign) value_t hed = car_(type); if (hed == pointersym || hed == cfunctionsym) { *palign = ALIGNPTR; - return sizeof(void*); + return sizeof(void *); } if (hed == arraysym) { value_t t = car(cdr_(type)); @@ -574,14 +556,11 @@ size_t ctype_sizeof(value_t type, int *palign) value_t n = car_(cdr_(cdr_(type))); size_t sz = toulong(n, "sizeof"); return sz * ctype_sizeof(t, palign); - } - else if (hed == structsym) { + } else if (hed == structsym) { return cvalue_struct_offs(type, NIL, 1, palign); - } - else if (hed == unionsym) { + } else if (hed == unionsym) { return cvalue_union_size(type, palign); - } - else if (hed == enumsym) { + } else if (hed == enumsym) { *palign = ALIGN4; return 4; } @@ -596,21 +575,19 @@ extern fltype_t *iostreamtype; void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz) { if (iscvalue(v)) { - cvalue_t *pcv = (cvalue_t*)ptr(v); - ios_t *x = value2c(ios_t*,v); + cvalue_t *pcv = (cvalue_t *)ptr(v); + ios_t *x = value2c(ios_t *, v); if (cv_class(pcv) == iostreamtype && (x->bm == bm_mem)) { *pdata = x->buf; *psz = x->size; return; - } - else if (cv_isPOD(pcv)) { + } else if (cv_isPOD(pcv)) { *pdata = cv_data(pcv); *psz = cv_len(pcv); return; } - } - else if (iscprim(v)) { - cprim_t *pcp = (cprim_t*)ptr(v); + } else if (iscprim(v)) { + cprim_t *pcp = (cprim_t *)ptr(v); *pdata = cp_data(pcp); *psz = cp_class(pcp)->size; return; @@ -625,7 +602,8 @@ value_t cvalue_sizeof(value_t *args, u_int32_t nargs) int a; return size_wrap(ctype_sizeof(args[0], &a)); } - size_t n; char *data; + size_t n; + char *data; to_sized_ptr(args[0], "sizeof", &data, &n); return size_wrap(n); } @@ -633,12 +611,16 @@ value_t cvalue_sizeof(value_t *args, u_int32_t nargs) value_t cvalue_typeof(value_t *args, u_int32_t nargs) { argcount("typeof", nargs, 1); - switch(tag(args[0])) { - case TAG_CONS: return pairsym; + switch (tag(args[0])) { + case TAG_CONS: + return pairsym; case TAG_NUM1: - case TAG_NUM: return fixnumsym; - case TAG_SYM: return symbolsym; - case TAG_VECTOR: return vectorsym; + case TAG_NUM: + return fixnumsym; + case TAG_SYM: + return symbolsym; + case TAG_VECTOR: + return vectorsym; case TAG_FUNCTION: if (args[0] == FL_T || args[0] == FL_F) return booleansym; @@ -650,19 +632,19 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs) return builtinsym; return FUNCTION; } - return cv_type((cvalue_t*)ptr(args[0])); + return cv_type((cvalue_t *)ptr(args[0])); } static value_t cvalue_relocate(value_t v) { size_t nw; - cvalue_t *cv = (cvalue_t*)ptr(v); + cvalue_t *cv = (cvalue_t *)ptr(v); cvalue_t *nv; value_t ncv; nw = cv_nwords(cv); - nv = (cvalue_t*)alloc_words(nw); - memcpy(nv, cv, nw*sizeof(value_t)); + nv = (cvalue_t *)alloc_words(nw); + memcpy(nv, cv, nw * sizeof(value_t)); if (isinlined(cv)) nv->data = &nv->_space[0]; ncv = tagptr(nv, TAG_CVALUE); @@ -677,23 +659,24 @@ value_t cvalue_copy(value_t v) { assert(iscvalue(v)); PUSH(v); - cvalue_t *cv = (cvalue_t*)ptr(v); + cvalue_t *cv = (cvalue_t *)ptr(v); size_t nw = cv_nwords(cv); - cvalue_t *ncv = (cvalue_t*)alloc_words(nw); - v = POP(); cv = (cvalue_t*)ptr(v); + cvalue_t *ncv = (cvalue_t *)alloc_words(nw); + v = POP(); + cv = (cvalue_t *)ptr(v); memcpy(ncv, cv, nw * sizeof(value_t)); if (!isinlined(cv)) { size_t len = cv_len(cv); - if (cv_isstr(cv)) len++; + if (cv_isstr(cv)) + len++; ncv->data = malloc(len); memcpy(ncv->data, cv_data(cv), len); autorelease(ncv); if (hasparent(cv)) { - ncv->type = (fltype_t*)(((uptrint_t)ncv->type) & ~CV_PARENT_BIT); + ncv->type = (fltype_t *)(((uptrint_t)ncv->type) & ~CV_PARENT_BIT); ncv->parent = NIL; } - } - else { + } else { ncv->data = &ncv->_space[0]; } @@ -707,7 +690,7 @@ value_t fl_copy(value_t *args, u_int32_t nargs) lerror(ArgError, "copy: argument must be a leaf atom"); if (!iscvalue(args[0])) return args[0]; - if (!cv_isPOD((cvalue_t*)ptr(args[0]))) + if (!cv_isPOD((cvalue_t *)ptr(args[0]))) lerror(ArgError, "copy: argument must be a plain-old-data type"); return cvalue_copy(args[0]); } @@ -716,13 +699,14 @@ value_t fl_podp(value_t *args, u_int32_t nargs) { argcount("plain-old-data?", nargs, 1); return (iscprim(args[0]) || - (iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ? - FL_T : FL_F; + (iscvalue(args[0]) && cv_isPOD((cvalue_t *)ptr(args[0])))) + ? FL_T + : FL_F; } static void cvalue_init(fltype_t *type, value_t v, void *dest) { - cvinitfunc_t f=type->init; + cvinitfunc_t f = type->init; if (f == NULL) lerror(ArgError, "c-value: invalid c type"); @@ -795,9 +779,8 @@ value_t cvalue_new(value_t *args, u_int32_t nargs) cnt = 0; cv = cvalue(ft, elsz * cnt); if (nargs == 2) - cvalue_array_init(ft, args[1], cv_data((cvalue_t*)ptr(cv))); - } - else { + cvalue_array_init(ft, args[1], cv_data((cvalue_t *)ptr(cv))); + } else { cv = cvalue(ft, ft->size); if (nargs == 2) cvalue_init(ft, args[1], cptr(cv)); @@ -808,8 +791,8 @@ value_t cvalue_new(value_t *args, u_int32_t nargs) // NOTE: this only compares lexicographically; it ignores numeric formats value_t cvalue_compare(value_t a, value_t b) { - cvalue_t *ca = (cvalue_t*)ptr(a); - cvalue_t *cb = (cvalue_t*)ptr(b); + cvalue_t *ca = (cvalue_t *)ptr(a); + cvalue_t *cb = (cvalue_t *)ptr(b); char *adata = cv_data(ca); char *bdata = cv_data(cb); size_t asz = cv_len(ca); @@ -829,9 +812,9 @@ static void check_addr_args(char *fname, value_t arr, value_t ind, char **data, ulong_t *index) { size_t numel; - cvalue_t *cv = (cvalue_t*)ptr(arr); + cvalue_t *cv = (cvalue_t *)ptr(arr); *data = cv_data(cv); - numel = cv_len(cv)/(cv_class(cv)->elsz); + numel = cv_len(cv) / (cv_class(cv)->elsz); *index = toulong(ind, fname); if (*index >= numel) bounds_error(fname, arr, ind); @@ -839,8 +822,9 @@ static void check_addr_args(char *fname, value_t arr, value_t ind, static value_t cvalue_array_aref(value_t *args) { - char *data; ulong_t index; - fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype; + char *data; + ulong_t index; + fltype_t *eltype = cv_class((cvalue_t *)ptr(args[0]))->eltype; value_t el = 0; numerictype_t nt = eltype->numtype; if (nt >= T_INT32) @@ -852,30 +836,31 @@ static value_t cvalue_array_aref(value_t *args) else if (nt == T_UINT8) return fixnum((uint8_t)data[index]); else if (nt == T_INT16) - return fixnum(((int16_t*)data)[index]); - return fixnum(((uint16_t*)data)[index]); + return fixnum(((int16_t *)data)[index]); + return fixnum(((uint16_t *)data)[index]); } char *dest = cptr(el); size_t sz = eltype->size; if (sz == 1) *dest = data[index]; else if (sz == 2) - *(int16_t*)dest = ((int16_t*)data)[index]; + *(int16_t *)dest = ((int16_t *)data)[index]; else if (sz == 4) - *(int32_t*)dest = ((int32_t*)data)[index]; + *(int32_t *)dest = ((int32_t *)data)[index]; else if (sz == 8) - *(int64_t*)dest = ((int64_t*)data)[index]; + *(int64_t *)dest = ((int64_t *)data)[index]; else - memcpy(dest, data + index*sz, sz); + memcpy(dest, data + index * sz, sz); return el; } static value_t cvalue_array_aset(value_t *args) { - char *data; ulong_t index; - fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype; + char *data; + ulong_t index; + fltype_t *eltype = cv_class((cvalue_t *)ptr(args[0]))->eltype; check_addr_args("aset!", args[0], args[1], &data, &index); - char *dest = data + index*eltype->size; + char *dest = data + index * eltype->size; cvalue_init(eltype, args[2], dest); return args[2]; } @@ -885,7 +870,7 @@ value_t fl_builtin(value_t *args, u_int32_t nargs) argcount("builtin", nargs, 1); symbol_t *name = tosymbol(args[0], "builtin"); cvalue_t *cv; - if (ismanaged(args[0]) || (cv=name->dlcache) == NULL) { + if (ismanaged(args[0]) || (cv = name->dlcache) == NULL) { lerrorf(ArgError, "builtin: function %s not found", name->name); } return tagptr(cv, TAG_CVALUE); @@ -893,15 +878,15 @@ value_t fl_builtin(value_t *args, u_int32_t nargs) value_t cbuiltin(char *name, builtin_t f) { - cvalue_t *cv = (cvalue_t*)malloc(CVALUE_NWORDS * sizeof(value_t)); + cvalue_t *cv = (cvalue_t *)malloc(CVALUE_NWORDS * sizeof(value_t)); cv->type = builtintype; cv->data = &cv->_space[0]; cv->len = sizeof(value_t); - *(void**)cv->data = f; + *(void **)cv->data = f; value_t sym = symbol(name); - ((symbol_t*)ptr(sym))->dlcache = cv; - ptrhash_put(&reverse_dlsym_lookup_table, cv, (void*)sym); + ((symbol_t *)ptr(sym))->dlcache = cv; + ptrhash_put(&reverse_dlsym_lookup_table, cv, (void *)sym); return tagptr(cv, TAG_CVALUE); } @@ -912,32 +897,34 @@ static value_t fl_logxor(value_t *args, u_int32_t nargs); static value_t fl_lognot(value_t *args, u_int32_t nargs); static value_t fl_ash(value_t *args, u_int32_t nargs); -static builtinspec_t cvalues_builtin_info[] = { - { "c-value", cvalue_new }, - { "typeof", cvalue_typeof }, - { "sizeof", cvalue_sizeof }, - { "builtin", fl_builtin }, - { "copy", fl_copy }, - { "plain-old-data?", fl_podp }, +static builtinspec_t cvalues_builtin_info[] = { { "c-value", cvalue_new }, + { "typeof", cvalue_typeof }, + { "sizeof", cvalue_sizeof }, + { "builtin", fl_builtin }, + { "copy", fl_copy }, + { "plain-old-data?", + fl_podp }, - { "logand", fl_logand }, - { "logior", fl_logior }, - { "logxor", fl_logxor }, - { "lognot", fl_lognot }, - { "ash", fl_ash }, - // todo: autorelease - { NULL, NULL } -}; + { "logand", fl_logand }, + { "logior", fl_logior }, + { "logxor", fl_logxor }, + { "lognot", fl_lognot }, + { "ash", fl_ash }, + // todo: autorelease + { NULL, NULL } }; #define cv_intern(tok) tok##sym = symbol(#tok) #define ctor_cv_intern(tok) \ - cv_intern(tok);set(tok##sym, cbuiltin(#tok, cvalue_##tok)) + cv_intern(tok); \ + set(tok##sym, cbuiltin(#tok, cvalue_##tok)) -#define mk_primtype(name) \ - name##type=get_type(name##sym);name##type->init = &cvalue_##name##_init +#define mk_primtype(name) \ + name##type = get_type(name##sym); \ + name##type->init = &cvalue_##name##_init -#define mk_primtype_(name,ctype) \ - name##type=get_type(name##sym);name##type->init = &cvalue_##ctype##_init +#define mk_primtype_(name, ctype) \ + name##type = get_type(name##sym); \ + name##type->init = &cvalue_##ctype##_init static void cvalues_init(void) { @@ -945,12 +932,29 @@ static void cvalues_init(void) htable_new(&reverse_dlsym_lookup_table, 256); // compute struct field alignment required for primitives - ALIGN2 = sizeof(struct { char a; int16_t i; }) - 2; - ALIGN4 = sizeof(struct { char a; int32_t i; }) - 4; - ALIGN8 = sizeof(struct { char a; int64_t i; }) - 8; - ALIGNPTR = sizeof(struct { char a; void *i; }) - sizeof(void*); + ALIGN2 = sizeof(struct { + char a; + int16_t i; + }) - + 2; + ALIGN4 = sizeof(struct { + char a; + int32_t i; + }) - + 4; + ALIGN8 = sizeof(struct { + char a; + int64_t i; + }) - + 8; + ALIGNPTR = sizeof(struct { + char a; + void *i; + }) - + sizeof(void *); - builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), NULL, NULL); + builtintype = + define_opaque_type(builtinsym, sizeof(builtin_t), NULL, NULL); ctor_cv_intern(int8); ctor_cv_intern(uint8); @@ -992,14 +996,14 @@ static void cvalues_init(void) mk_primtype(int64); mk_primtype(uint64); #ifdef BITS64 - mk_primtype_(long,int64); - mk_primtype_(ulong,uint64); + mk_primtype_(long, int64); + mk_primtype_(ulong, uint64); #else - mk_primtype_(long,int32); - mk_primtype_(ulong,uint32); + mk_primtype_(long, int32); + mk_primtype_(ulong, uint32); #endif - mk_primtype_(byte,uint8); - mk_primtype_(wchar,int32); + mk_primtype_(byte, uint8); + mk_primtype_(wchar, int32); mk_primtype(float); mk_primtype(double); @@ -1010,7 +1014,7 @@ static void cvalues_init(void) setc(emptystringsym, cvalue_static_cstring("")); } -#define RETURN_NUM_AS(var, type) return(mk_##type((fl_##type##_t)var)) +#define RETURN_NUM_AS(var, type) return (mk_##type((fl_##type##_t)var)) value_t return_from_uint64(uint64_t Uaccum) { @@ -1019,11 +1023,9 @@ value_t return_from_uint64(uint64_t Uaccum) } if (Uaccum > (uint64_t)S64_MAX) { RETURN_NUM_AS(Uaccum, uint64); - } - else if (Uaccum > (uint64_t)UINT_MAX) { + } else if (Uaccum > (uint64_t)UINT_MAX) { RETURN_NUM_AS(Uaccum, int64); - } - else if (Uaccum > (uint64_t)INT_MAX) { + } else if (Uaccum > (uint64_t)INT_MAX) { RETURN_NUM_AS(Uaccum, uint32); } RETURN_NUM_AS(Uaccum, int32); @@ -1036,8 +1038,7 @@ value_t return_from_int64(int64_t Saccum) } if (Saccum > (int64_t)UINT_MAX || Saccum < (int64_t)INT_MIN) { RETURN_NUM_AS(Saccum, int64); - } - else if (Saccum > (int64_t)INT_MAX) { + } else if (Saccum > (int64_t)INT_MAX) { RETURN_NUM_AS(Saccum, uint32); } RETURN_NUM_AS(Saccum, int32); @@ -1045,39 +1046,59 @@ value_t return_from_int64(int64_t Saccum) static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn) { - uint64_t Uaccum=0; + uint64_t Uaccum = 0; int64_t Saccum = carryIn; - double Faccum=0; + double Faccum = 0; int32_t inexact = 0; uint32_t i; - value_t arg=NIL; + value_t arg = NIL; - FOR_ARGS(i,0,arg,args) { + FOR_ARGS(i, 0, arg, args) + { if (isfixnum(arg)) { Saccum += numval(arg); continue; - } - else if (iscprim(arg)) { - cprim_t *cp = (cprim_t*)ptr(arg); + } else if (iscprim(arg)) { + cprim_t *cp = (cprim_t *)ptr(arg); void *a = cp_data(cp); int64_t i64; - switch(cp_numtype(cp)) { - case T_INT8: Saccum += *(int8_t*)a; break; - case T_UINT8: Saccum += *(uint8_t*)a; break; - case T_INT16: Saccum += *(int16_t*)a; break; - case T_UINT16: Saccum += *(uint16_t*)a; break; - case T_INT32: Saccum += *(int32_t*)a; break; - case T_UINT32: Saccum += *(uint32_t*)a; break; + switch (cp_numtype(cp)) { + case T_INT8: + Saccum += *(int8_t *)a; + break; + case T_UINT8: + Saccum += *(uint8_t *)a; + break; + case T_INT16: + Saccum += *(int16_t *)a; + break; + case T_UINT16: + Saccum += *(uint16_t *)a; + break; + case T_INT32: + Saccum += *(int32_t *)a; + break; + case T_UINT32: + Saccum += *(uint32_t *)a; + break; case T_INT64: - i64 = *(int64_t*)a; + i64 = *(int64_t *)a; if (i64 > 0) Uaccum += (uint64_t)i64; else Saccum += i64; break; - case T_UINT64: Uaccum += *(uint64_t*)a; break; - case T_FLOAT: Faccum += *(float*)a; inexact = 1; break; - case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break; + case T_UINT64: + Uaccum += *(uint64_t *)a; + break; + case T_FLOAT: + Faccum += *(float *)a; + inexact = 1; + break; + case T_DOUBLE: + Faccum += *(double *)a; + inexact = 1; + break; default: goto add_type_error; } @@ -1090,8 +1111,7 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn) Faccum += Uaccum; Faccum += Saccum; return mk_double(Faccum); - } - else if (Saccum < 0) { + } else if (Saccum < 0) { uint64_t negpart = (uint64_t)(-Saccum); if (negpart > Uaccum) { Saccum += (int64_t)Uaccum; @@ -1105,8 +1125,7 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn) RETURN_NUM_AS(Saccum, int64); } Uaccum -= negpart; - } - else { + } else { Uaccum += (uint64_t)Saccum; } // return value in Uaccum @@ -1118,38 +1137,45 @@ static value_t fl_neg(value_t n) if (isfixnum(n)) { fixnum_t s = fixnum(-numval(n)); if (__unlikely(s == n)) - return mk_long(-numval(n)); // negate overflows + return mk_long(-numval(n)); // negate overflows else return s; - } - else if (iscprim(n)) { - cprim_t *cp = (cprim_t*)ptr(n); + } else if (iscprim(n)) { + cprim_t *cp = (cprim_t *)ptr(n); void *a = cp_data(cp); uint32_t ui32; int32_t i32; int64_t i64; - switch(cp_numtype(cp)) { - case T_INT8: return fixnum(-(int32_t)*(int8_t*)a); - case T_UINT8: return fixnum(-(int32_t)*(uint8_t*)a); - case T_INT16: return fixnum(-(int32_t)*(int16_t*)a); - case T_UINT16: return fixnum(-(int32_t)*(uint16_t*)a); + switch (cp_numtype(cp)) { + case T_INT8: + return fixnum(-(int32_t) * (int8_t *)a); + case T_UINT8: + return fixnum(-(int32_t) * (uint8_t *)a); + case T_INT16: + return fixnum(-(int32_t) * (int16_t *)a); + case T_UINT16: + return fixnum(-(int32_t) * (uint16_t *)a); case T_INT32: - i32 = *(int32_t*)a; + i32 = *(int32_t *)a; if (i32 == (int32_t)BIT31) return mk_uint32((uint32_t)BIT31); return mk_int32(-i32); case T_UINT32: - ui32 = *(uint32_t*)a; - if (ui32 <= ((uint32_t)INT_MAX)+1) return mk_int32(-(int32_t)ui32); + ui32 = *(uint32_t *)a; + if (ui32 <= ((uint32_t)INT_MAX) + 1) + return mk_int32(-(int32_t)ui32); return mk_int64(-(int64_t)ui32); case T_INT64: - i64 = *(int64_t*)a; + i64 = *(int64_t *)a; if (i64 == (int64_t)BIT63) return mk_uint64((uint64_t)BIT63); return mk_int64(-i64); - case T_UINT64: return mk_int64(-(int64_t)*(uint64_t*)a); - case T_FLOAT: return mk_float(-*(float*)a); - case T_DOUBLE: return mk_double(-*(double*)a); + case T_UINT64: + return mk_int64(-(int64_t) * (uint64_t *)a); + case T_FLOAT: + return mk_float(-*(float *)a); + case T_DOUBLE: + return mk_double(-*(double *)a); break; } } @@ -1158,38 +1184,58 @@ static value_t fl_neg(value_t n) static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum) { - uint64_t Uaccum=1; - double Faccum=1; + uint64_t Uaccum = 1; + double Faccum = 1; int32_t inexact = 0; uint32_t i; - value_t arg=NIL; + value_t arg = NIL; - FOR_ARGS(i,0,arg,args) { + FOR_ARGS(i, 0, arg, args) + { if (isfixnum(arg)) { Saccum *= numval(arg); continue; - } - else if (iscprim(arg)) { - cprim_t *cp = (cprim_t*)ptr(arg); + } else if (iscprim(arg)) { + cprim_t *cp = (cprim_t *)ptr(arg); void *a = cp_data(cp); int64_t i64; - switch(cp_numtype(cp)) { - case T_INT8: Saccum *= *(int8_t*)a; break; - case T_UINT8: Saccum *= *(uint8_t*)a; break; - case T_INT16: Saccum *= *(int16_t*)a; break; - case T_UINT16: Saccum *= *(uint16_t*)a; break; - case T_INT32: Saccum *= *(int32_t*)a; break; - case T_UINT32: Saccum *= *(uint32_t*)a; break; + switch (cp_numtype(cp)) { + case T_INT8: + Saccum *= *(int8_t *)a; + break; + case T_UINT8: + Saccum *= *(uint8_t *)a; + break; + case T_INT16: + Saccum *= *(int16_t *)a; + break; + case T_UINT16: + Saccum *= *(uint16_t *)a; + break; + case T_INT32: + Saccum *= *(int32_t *)a; + break; + case T_UINT32: + Saccum *= *(uint32_t *)a; + break; case T_INT64: - i64 = *(int64_t*)a; + i64 = *(int64_t *)a; if (i64 > 0) Uaccum *= (uint64_t)i64; else Saccum *= i64; break; - case T_UINT64: Uaccum *= *(uint64_t*)a; break; - case T_FLOAT: Faccum *= *(float*)a; inexact = 1; break; - case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break; + case T_UINT64: + Uaccum *= *(uint64_t *)a; + break; + case T_FLOAT: + Faccum *= *(float *)a; + inexact = 1; + break; + case T_DOUBLE: + Faccum *= *(double *)a; + inexact = 1; + break; default: goto mul_type_error; } @@ -1202,8 +1248,7 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum) Faccum *= Uaccum; Faccum *= Saccum; return mk_double(Faccum); - } - else if (Saccum < 0) { + } else if (Saccum < 0) { Saccum *= (int64_t)Uaccum; if (Saccum >= INT_MIN) { if (fits_fixnum(Saccum)) { @@ -1212,8 +1257,7 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum) RETURN_NUM_AS(Saccum, int32); } RETURN_NUM_AS(Saccum, int64); - } - else { + } else { Uaccum *= (uint64_t)Saccum; } return return_from_uint64(Uaccum); @@ -1226,13 +1270,11 @@ static int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp) *pi = numval(a); *pp = pi; *pt = T_FIXNUM; - } - else if (iscprim(a)) { - cp = (cprim_t*)ptr(a); + } else if (iscprim(a)) { + cp = (cprim_t *)ptr(a); *pp = cp_data(cp); *pt = cp_numtype(cp); - } - else { + } else { return 0; } return 1; @@ -1252,28 +1294,37 @@ int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname) numerictype_t ta, tb; void *aptr, *bptr; - if (bothfixnums(a,b)) { - if (a==b) return 0; - if (numval(a) < numval(b)) return -1; + if (bothfixnums(a, b)) { + if (a == b) + return 0; + if (numval(a) < numval(b)) + return -1; return 1; } if (!num_to_ptr(a, &ai, &ta, &aptr)) { - if (fname) type_error(fname, "number", a); else return 2; + if (fname) + type_error(fname, "number", a); + else + return 2; } if (!num_to_ptr(b, &bi, &tb, &bptr)) { - if (fname) type_error(fname, "number", b); else return 2; + if (fname) + type_error(fname, "number", b); + else + return 2; } if (eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT))) return 1; if (cmp_eq(aptr, ta, bptr, tb, eqnans)) return 0; - if (eq) return 1; + if (eq) + return 1; if (cmp_lt(aptr, ta, bptr, tb)) return -1; return 1; } -static void DivideByZeroError() __attribute__ ((__noreturn__)); +static void DivideByZeroError() __attribute__((__noreturn__)); static void DivideByZeroError(void) { lerror(DivideError, "/: division by zero"); @@ -1297,7 +1348,7 @@ static value_t fl_div2(value_t a, value_t b) if (db == 0 && tb < T_FLOAT) // exact 0 DivideByZeroError(); - da = da/db; + da = da / db; if (ta < T_FLOAT && tb < T_FLOAT && (double)(int64_t)da == da) return return_from_int64((int64_t)da); @@ -1318,33 +1369,36 @@ static value_t fl_idiv2(value_t a, value_t b) if (ta == T_UINT64) { if (tb == T_UINT64) { - if (*(uint64_t*)bptr == 0) goto div_error; - return return_from_uint64(*(uint64_t*)aptr / *(uint64_t*)bptr); + if (*(uint64_t *)bptr == 0) + goto div_error; + return return_from_uint64(*(uint64_t *)aptr / *(uint64_t *)bptr); } b64 = conv_to_int64(bptr, tb); if (b64 < 0) { - return return_from_int64(-(int64_t)(*(uint64_t*)aptr / - (uint64_t)(-b64))); + return return_from_int64( + -(int64_t)(*(uint64_t *)aptr / (uint64_t)(-b64))); } if (b64 == 0) goto div_error; - return return_from_uint64(*(uint64_t*)aptr / (uint64_t)b64); + return return_from_uint64(*(uint64_t *)aptr / (uint64_t)b64); } if (tb == T_UINT64) { - if (*(uint64_t*)bptr == 0) goto div_error; + if (*(uint64_t *)bptr == 0) + goto div_error; a64 = conv_to_int64(aptr, ta); if (a64 < 0) { - return return_from_int64(-((int64_t)((uint64_t)(-a64) / - *(uint64_t*)bptr))); + return return_from_int64( + -((int64_t)((uint64_t)(-a64) / *(uint64_t *)bptr))); } - return return_from_uint64((uint64_t)a64 / *(uint64_t*)bptr); + return return_from_uint64((uint64_t)a64 / *(uint64_t *)bptr); } b64 = conv_to_int64(bptr, tb); - if (b64 == 0) goto div_error; + if (b64 == 0) + goto div_error; return return_from_int64(conv_to_int64(aptr, ta) / b64); - div_error: +div_error: DivideByZeroError(); } @@ -1352,7 +1406,7 @@ static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname) { int_t ai, bi; numerictype_t ta, tb, itmp; - void *aptr=NULL, *bptr=NULL, *ptmp; + void *aptr = NULL, *bptr = NULL, *ptmp; int64_t b64; if (!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT) @@ -1361,53 +1415,84 @@ static value_t fl_bitwise_op(value_t a, value_t b, int opcode, char *fname) type_error(fname, "integer", b); if (ta < tb) { - itmp = ta; ta = tb; tb = itmp; - ptmp = aptr; aptr = bptr; bptr = ptmp; + itmp = ta; + ta = tb; + tb = itmp; + ptmp = aptr; + aptr = bptr; + bptr = ptmp; } // now a's type is larger than or same as b's b64 = conv_to_int64(bptr, tb); switch (opcode) { case 0: - switch (ta) { - case T_INT8: return fixnum( *(int8_t *)aptr & (int8_t )b64); - case T_UINT8: return fixnum( *(uint8_t *)aptr & (uint8_t )b64); - case T_INT16: return fixnum( *(int16_t*)aptr & (int16_t )b64); - case T_UINT16: return fixnum( *(uint16_t*)aptr & (uint16_t)b64); - case T_INT32: return mk_int32( *(int32_t*)aptr & (int32_t )b64); - case T_UINT32: return mk_uint32(*(uint32_t*)aptr & (uint32_t)b64); - case T_INT64: return mk_int64( *(int64_t*)aptr & (int64_t )b64); - case T_UINT64: return mk_uint64(*(uint64_t*)aptr & (uint64_t)b64); - case T_FLOAT: - case T_DOUBLE: assert(0); - } - break; + switch (ta) { + case T_INT8: + return fixnum(*(int8_t *)aptr & (int8_t)b64); + case T_UINT8: + return fixnum(*(uint8_t *)aptr & (uint8_t)b64); + case T_INT16: + return fixnum(*(int16_t *)aptr & (int16_t)b64); + case T_UINT16: + return fixnum(*(uint16_t *)aptr & (uint16_t)b64); + case T_INT32: + return mk_int32(*(int32_t *)aptr & (int32_t)b64); + case T_UINT32: + return mk_uint32(*(uint32_t *)aptr & (uint32_t)b64); + case T_INT64: + return mk_int64(*(int64_t *)aptr & (int64_t)b64); + case T_UINT64: + return mk_uint64(*(uint64_t *)aptr & (uint64_t)b64); + case T_FLOAT: + case T_DOUBLE: + assert(0); + } + break; case 1: - switch (ta) { - case T_INT8: return fixnum( *(int8_t *)aptr | (int8_t )b64); - case T_UINT8: return fixnum( *(uint8_t *)aptr | (uint8_t )b64); - case T_INT16: return fixnum( *(int16_t*)aptr | (int16_t )b64); - case T_UINT16: return fixnum( *(uint16_t*)aptr | (uint16_t)b64); - case T_INT32: return mk_int32( *(int32_t*)aptr | (int32_t )b64); - case T_UINT32: return mk_uint32(*(uint32_t*)aptr | (uint32_t)b64); - case T_INT64: return mk_int64( *(int64_t*)aptr | (int64_t )b64); - case T_UINT64: return mk_uint64(*(uint64_t*)aptr | (uint64_t)b64); - case T_FLOAT: - case T_DOUBLE: assert(0); - } - break; + switch (ta) { + case T_INT8: + return fixnum(*(int8_t *)aptr | (int8_t)b64); + case T_UINT8: + return fixnum(*(uint8_t *)aptr | (uint8_t)b64); + case T_INT16: + return fixnum(*(int16_t *)aptr | (int16_t)b64); + case T_UINT16: + return fixnum(*(uint16_t *)aptr | (uint16_t)b64); + case T_INT32: + return mk_int32(*(int32_t *)aptr | (int32_t)b64); + case T_UINT32: + return mk_uint32(*(uint32_t *)aptr | (uint32_t)b64); + case T_INT64: + return mk_int64(*(int64_t *)aptr | (int64_t)b64); + case T_UINT64: + return mk_uint64(*(uint64_t *)aptr | (uint64_t)b64); + case T_FLOAT: + case T_DOUBLE: + assert(0); + } + break; case 2: - switch (ta) { - case T_INT8: return fixnum( *(int8_t *)aptr ^ (int8_t )b64); - case T_UINT8: return fixnum( *(uint8_t *)aptr ^ (uint8_t )b64); - case T_INT16: return fixnum( *(int16_t*)aptr ^ (int16_t )b64); - case T_UINT16: return fixnum( *(uint16_t*)aptr ^ (uint16_t)b64); - case T_INT32: return mk_int32( *(int32_t*)aptr ^ (int32_t )b64); - case T_UINT32: return mk_uint32(*(uint32_t*)aptr ^ (uint32_t)b64); - case T_INT64: return mk_int64( *(int64_t*)aptr ^ (int64_t )b64); - case T_UINT64: return mk_uint64(*(uint64_t*)aptr ^ (uint64_t)b64); - case T_FLOAT: - case T_DOUBLE: assert(0); - } + switch (ta) { + case T_INT8: + return fixnum(*(int8_t *)aptr ^ (int8_t)b64); + case T_UINT8: + return fixnum(*(uint8_t *)aptr ^ (uint8_t)b64); + case T_INT16: + return fixnum(*(int16_t *)aptr ^ (int16_t)b64); + case T_UINT16: + return fixnum(*(uint16_t *)aptr ^ (uint16_t)b64); + case T_INT32: + return mk_int32(*(int32_t *)aptr ^ (int32_t)b64); + case T_UINT32: + return mk_uint32(*(uint32_t *)aptr ^ (uint32_t)b64); + case T_INT64: + return mk_int64(*(int64_t *)aptr ^ (int64_t)b64); + case T_UINT64: + return mk_uint64(*(uint64_t *)aptr ^ (uint64_t)b64); + case T_FLOAT: + case T_DOUBLE: + assert(0); + } } assert(0); return NIL; @@ -1420,7 +1505,8 @@ static value_t fl_logand(value_t *args, u_int32_t nargs) if (nargs == 0) return fixnum(-1); v = args[0]; - FOR_ARGS(i,1,e,args) { + FOR_ARGS(i, 1, e, args) + { if (bothfixnums(v, e)) v = v & e; else @@ -1436,7 +1522,8 @@ static value_t fl_logior(value_t *args, u_int32_t nargs) if (nargs == 0) return fixnum(0); v = args[0]; - FOR_ARGS(i,1,e,args) { + FOR_ARGS(i, 1, e, args) + { if (bothfixnums(v, e)) v = v | e; else @@ -1452,7 +1539,8 @@ static value_t fl_logxor(value_t *args, u_int32_t nargs) if (nargs == 0) return fixnum(0); v = args[0]; - FOR_ARGS(i,1,e,args) { + FOR_ARGS(i, 1, e, args) + { if (bothfixnums(v, e)) v = fixnum(numval(v) ^ numval(e)); else @@ -1472,18 +1560,26 @@ static value_t fl_lognot(value_t *args, u_int32_t nargs) void *aptr; if (iscprim(a)) { - cp = (cprim_t*)ptr(a); + cp = (cprim_t *)ptr(a); ta = cp_numtype(cp); aptr = cp_data(cp); switch (ta) { - case T_INT8: return fixnum(~*(int8_t *)aptr); - case T_UINT8: return fixnum(~*(uint8_t *)aptr); - case T_INT16: return fixnum(~*(int16_t *)aptr); - case T_UINT16: return fixnum(~*(uint16_t*)aptr); - case T_INT32: return mk_int32(~*(int32_t *)aptr); - case T_UINT32: return mk_uint32(~*(uint32_t*)aptr); - case T_INT64: return mk_int64(~*(int64_t *)aptr); - case T_UINT64: return mk_uint64(~*(uint64_t*)aptr); + case T_INT8: + return fixnum(~*(int8_t *)aptr); + case T_UINT8: + return fixnum(~*(uint8_t *)aptr); + case T_INT16: + return fixnum(~*(int16_t *)aptr); + case T_UINT16: + return fixnum(~*(uint16_t *)aptr); + case T_INT32: + return mk_int32(~*(int32_t *)aptr); + case T_UINT32: + return mk_uint32(~*(uint32_t *)aptr); + case T_INT64: + return mk_int64(~*(int64_t *)aptr); + case T_UINT64: + return mk_uint64(~*(uint64_t *)aptr); } } type_error("lognot", "integer", a); @@ -1498,8 +1594,8 @@ static value_t fl_ash(value_t *args, u_int32_t nargs) n = tofixnum(args[1], "ash"); if (isfixnum(a)) { if (n <= 0) - return fixnum(numval(a)>>(-n)); - accum = ((int64_t)numval(a))<> (-n)); + accum = ((int64_t)numval(a)) << n; if (fits_fixnum(accum)) return fixnum(accum); else @@ -1509,29 +1605,37 @@ static value_t fl_ash(value_t *args, u_int32_t nargs) int ta; void *aptr; if (iscprim(a)) { - if (n == 0) return a; - cp = (cprim_t*)ptr(a); + if (n == 0) + return a; + cp = (cprim_t *)ptr(a); ta = cp_numtype(cp); aptr = cp_data(cp); if (n < 0) { n = -n; switch (ta) { - case T_INT8: return fixnum((*(int8_t *)aptr) >> n); - case T_UINT8: return fixnum((*(uint8_t *)aptr) >> n); - case T_INT16: return fixnum((*(int16_t *)aptr) >> n); - case T_UINT16: return fixnum((*(uint16_t*)aptr) >> n); - case T_INT32: return mk_int32((*(int32_t *)aptr) >> n); - case T_UINT32: return mk_uint32((*(uint32_t*)aptr) >> n); - case T_INT64: return mk_int64((*(int64_t *)aptr) >> n); - case T_UINT64: return mk_uint64((*(uint64_t*)aptr) >> n); + case T_INT8: + return fixnum((*(int8_t *)aptr) >> n); + case T_UINT8: + return fixnum((*(uint8_t *)aptr) >> n); + case T_INT16: + return fixnum((*(int16_t *)aptr) >> n); + case T_UINT16: + return fixnum((*(uint16_t *)aptr) >> n); + case T_INT32: + return mk_int32((*(int32_t *)aptr) >> n); + case T_UINT32: + return mk_uint32((*(uint32_t *)aptr) >> n); + case T_INT64: + return mk_int64((*(int64_t *)aptr) >> n); + case T_UINT64: + return mk_uint64((*(uint64_t *)aptr) >> n); } - } - else { + } else { if (ta == T_UINT64) - return return_from_uint64((*(uint64_t*)aptr)< 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; } diff --git a/equalhash.c b/equalhash.c index 70fb03d..da4c0b4 100644 --- a/equalhash.c +++ b/equalhash.c @@ -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_) diff --git a/flisp.c b/flisp.c index 08f5c4b..585cd49 100644 --- a/flisp.c +++ b/flisp.c @@ -47,44 +47,41 @@ #include "flisp.h" #include "opcodes.h" -static char *builtin_names[] = - { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, - // predicates - "eq?", "eqv?", "equal?", "atom?", "not", "null?", "boolean?", "symbol?", - "number?", "bound?", "pair?", "builtin?", "vector?", "fixnum?", - "function?", +static char *builtin_names[] = { + NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, + // predicates + "eq?", "eqv?", "equal?", "atom?", "not", "null?", "boolean?", "symbol?", + "number?", "bound?", "pair?", "builtin?", "vector?", "fixnum?", + "function?", - // lists - "cons", "list", "car", "cdr", "set-car!", "set-cdr!", + // lists + "cons", "list", "car", "cdr", "set-car!", "set-cdr!", - // execution - "apply", + // execution + "apply", - // arithmetic - "+", "-", "*", "/", "div0", "=", "<", "compare", + // arithmetic + "+", "-", "*", "/", "div0", "=", "<", "compare", - // sequences - "vector", "aref", "aset!", - "", "", "" }; + // sequences + "vector", "aref", "aset!", "", "", "" +}; #define ANYARGS -10000 -static short builtin_arg_counts[] = - { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 2, ANYARGS, 1, 1, 2, 2, - -2, - ANYARGS, -1, ANYARGS, -1, 2, 2, 2, 2, - ANYARGS, 2, 3 }; +static short builtin_arg_counts[] = { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, ANYARGS, 1, + 1, 2, 2, -2, ANYARGS, -1, ANYARGS, -1, 2, 2, 2, 2, ANYARGS, 2, 3 +}; static uint32_t N_STACK; static value_t *Stack; static uint32_t SP = 0; static uint32_t curr_frame = 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)) #define N_GC_HANDLES 1024 static value_t *GCHandleStack[N_GC_HANDLES]; @@ -103,7 +100,8 @@ static value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym; static value_t definesym, defmacrosym, forsym, setqsym; static value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym; // for reading characters -static value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym; +static value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, +newlinesym; static value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym; static value_t apply_cl(uint32_t nargs); @@ -122,27 +120,33 @@ static unsigned char *fromspace; static unsigned char *tospace; static unsigned char *curheap; static unsigned char *lim; -static uint32_t heapsize;//bytes +static uint32_t heapsize; // bytes static uint32_t *consflags; -// error utilities ------------------------------------------------------------ +// error utilities +// ------------------------------------------------------------ // saved execution state for an unwind target fl_exception_context_t *fl_ctx = NULL; -uint32_t fl_throwing_frame=0; // active frame when exception was thrown +uint32_t fl_throwing_frame = 0; // active frame when exception was thrown value_t fl_lasterror; -#define FL_TRY \ - fl_exception_context_t _ctx; int l__tr, l__ca; \ - _ctx.sp=SP; _ctx.frame=curr_frame; _ctx.rdst=readstate; _ctx.prev=fl_ctx; \ - _ctx.ngchnd = N_GCHND; 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 \ + fl_exception_context_t _ctx; \ + int l__tr, l__ca; \ + _ctx.sp = SP; \ + _ctx.frame = curr_frame; \ + _ctx.rdst = readstate; \ + _ctx.prev = fl_ctx; \ + _ctx.ngchnd = N_GCHND; \ + 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 \ - else \ - for(l__ca=1; l__ca; l__ca=0, \ - fl_lasterror=FL_NIL,fl_throwing_frame=0,SP=_ctx.sp,curr_frame=_ctx.frame) +#define FL_CATCH \ + else for (l__ca = 1; l__ca; l__ca = 0, fl_lasterror = FL_NIL, \ + fl_throwing_frame = 0, SP = _ctx.sp, \ + curr_frame = _ctx.frame) void fl_savestate(fl_exception_context_t *_ctx) { @@ -173,7 +177,7 @@ void fl_raise(value_t e) fl_throwing_frame = curr_frame; N_GCHND = fl_ctx->ngchnd; fl_exception_context_t *thisctx = fl_ctx; - if (fl_ctx->prev) // don't throw past toplevel + if (fl_ctx->prev) // don't throw past toplevel fl_ctx = fl_ctx->prev; longjmp(thisctx->buf, 1); } @@ -215,30 +219,32 @@ void bounds_error(char *fname, value_t arr, value_t ind) fl_raise(fl_listn(4, BoundsError, symbol(fname), arr, ind)); } -// safe cast operators -------------------------------------------------------- +// safe cast operators +// -------------------------------------------------------- #define isstring fl_isstring -#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); \ -} -SAFECAST_OP(cons, cons_t*, ptr) -SAFECAST_OP(symbol,symbol_t*,ptr) -SAFECAST_OP(fixnum,fixnum_t, numval) -SAFECAST_OP(cvalue,cvalue_t*,ptr) -SAFECAST_OP(string,char*, cvalue_data) +#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); \ + } +SAFECAST_OP(cons, cons_t *, ptr) +SAFECAST_OP(symbol, symbol_t *, ptr) +SAFECAST_OP(fixnum, fixnum_t, numval) +SAFECAST_OP(cvalue, cvalue_t *, ptr) +SAFECAST_OP(string, char *, cvalue_data) #undef isstring -// symbol table --------------------------------------------------------------- +// symbol table +// --------------------------------------------------------------- symbol_t *symtab = NULL; int fl_is_keyword_name(char *str, size_t len) { - return ((str[0] == ':' || str[len-1] == ':') && str[1] != '\0'); + return ((str[0] == ':' || str[len - 1] == ':') && str[1] != '\0'); } static symbol_t *mk_symbol(char *str) @@ -246,20 +252,19 @@ static symbol_t *mk_symbol(char *str) symbol_t *sym; size_t len = strlen(str); - sym = (symbol_t*)malloc(sizeof(symbol_t)-sizeof(void*) + len + 1); - assert(((uptrint_t)sym & 0x7) == 0); // make sure malloc aligns 8 + sym = (symbol_t *)malloc(sizeof(symbol_t) - sizeof(void *) + len + 1); + assert(((uptrint_t)sym & 0x7) == 0); // make sure malloc aligns 8 sym->left = sym->right = NULL; sym->flags = 0; if (fl_is_keyword_name(str, len)) { value_t s = tagptr(sym, TAG_SYM); setc(s, s); sym->flags |= 0x2; - } - else { + } else { sym->binding = UNBOUND; } sym->type = sym->dlcache = NULL; - sym->hash = memhash32(str, len)^0xAAAAAAAA; + sym->hash = memhash32(str, len) ^ 0xAAAAAAAA; strcpy(&sym->name[0], str); return sym; } @@ -268,7 +273,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; @@ -290,16 +295,16 @@ value_t symbol(char *str) return tagptr(*pnode, TAG_SYM); } -static uint32_t _gensym_ctr=0; +static uint32_t _gensym_ctr = 0; // two static buffers for gensym printing so there can be two // gensym names available at a time, mostly for compare() static char gsname[2][16]; -static int gsnameno=0; +static int gsnameno = 0; value_t fl_gensym(value_t *args, uint32_t nargs) { argcount("gensym", nargs, 0); (void)args; - gensym_t *gs = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*)); + gensym_t *gs = (gensym_t *)alloc_words(sizeof(gensym_t) / sizeof(void *)); gs->id = _gensym_ctr++; gs->binding = UNBOUND; gs->isconst = 0; @@ -307,10 +312,7 @@ value_t fl_gensym(value_t *args, uint32_t nargs) return tagptr(gs, TAG_SYM); } -int fl_isgensym(value_t v) -{ - return isgensym(v); -} +int fl_isgensym(value_t v) { return isgensym(v); } static value_t fl_gensymp(value_t *args, u_int32_t nargs) { @@ -321,16 +323,18 @@ static value_t fl_gensymp(value_t *args, u_int32_t nargs) char *symbol_name(value_t v) { if (ismanaged(v)) { - gensym_t *gs = (gensym_t*)ptr(v); - gsnameno = 1-gsnameno; - char *n = uint2str(gsname[gsnameno]+1, sizeof(gsname[0])-1, gs->id, 10); + gensym_t *gs = (gensym_t *)ptr(v); + gsnameno = 1 - gsnameno; + char *n = + uint2str(gsname[gsnameno] + 1, sizeof(gsname[0]) - 1, gs->id, 10); *(--n) = 'g'; return n; } - return ((symbol_t*)ptr(v))->name; + return ((symbol_t *)ptr(v))->name; } -// conses --------------------------------------------------------------------- +// conses +// --------------------------------------------------------------------- void gc(int mustgrow); @@ -340,7 +344,7 @@ static value_t mk_cons(void) if (__unlikely(curheap > lim)) gc(0); - c = (cons_t*)curheap; + c = (cons_t *)curheap; curheap += sizeof(cons_t); return tagptr(c, TAG_CONS); } @@ -350,55 +354,59 @@ static value_t *alloc_words(int n) value_t *first; assert(n > 0); - n = LLT_ALIGN(n, 2); // only allocate multiples of 2 words - if (__unlikely((value_t*)curheap > ((value_t*)lim)+2-n)) { + n = LLT_ALIGN(n, 2); // only allocate multiples of 2 words + if (__unlikely((value_t *)curheap > ((value_t *)lim) + 2 - n)) { gc(0); - while ((value_t*)curheap > ((value_t*)lim)+2-n) { + while ((value_t *)curheap > ((value_t *)lim) + 2 - n) { gc(1); } } - first = (value_t*)curheap; - curheap += (n*sizeof(value_t)); + first = (value_t *)curheap; + curheap += (n * sizeof(value_t)); return first; } // allocate n consecutive conses #define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS) -#define cons_index(c) (((cons_t*)ptr(c))-((cons_t*)fromspace)) -#define ismarked(c) bitvector_get(consflags, cons_index(c)) -#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1) +#define cons_index(c) (((cons_t *)ptr(c)) - ((cons_t *)fromspace)) +#define ismarked(c) bitvector_get(consflags, cons_index(c)) +#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1) #define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0) static value_t the_empty_vector; value_t alloc_vector(size_t n, int init) { - if (n == 0) return the_empty_vector; - value_t *c = alloc_words(n+1); + if (n == 0) + return the_empty_vector; + value_t *c = alloc_words(n + 1); value_t v = tagptr(c, TAG_VECTOR); vector_setsize(v, n); if (init) { unsigned int i; - for(i=0; i < n; i++) + for (i = 0; i < n; i++) vector_elt(v, i) = FL_UNSPECIFIED; } return v; } -// cvalues -------------------------------------------------------------------- +// cvalues +// -------------------------------------------------------------------- #include "cvalues.c" #include "types.c" -// print ---------------------------------------------------------------------- +// print +// ---------------------------------------------------------------------- static int isnumtok(char *tok, value_t *pval); static inline int symchar(char c); #include "print.c" -// collector ------------------------------------------------------------------ +// collector +// ------------------------------------------------------------------ void fl_gc_handle(value_t *pv) { @@ -422,63 +430,63 @@ static value_t relocate(value_t v) // iterative implementation allows arbitrarily long cons chains pcdr = &first; do { - if ((a=car_(v)) == TAG_FWD) { + if ((a = car_(v)) == TAG_FWD) { *pcdr = cdr_(v); return first; } - *pcdr = nc = tagptr((cons_t*)curheap, TAG_CONS); + *pcdr = nc = tagptr((cons_t *)curheap, TAG_CONS); curheap += sizeof(cons_t); d = cdr_(v); - car_(v) = TAG_FWD; cdr_(v) = nc; + car_(v) = TAG_FWD; + cdr_(v) = nc; car_(nc) = relocate(a); pcdr = &cdr_(nc); v = d; } while (iscons(v)); - *pcdr = (d==NIL) ? NIL : relocate(d); + *pcdr = (d == NIL) ? NIL : relocate(d); return first; } - if ((t&3) == 0) return v; - if (!ismanaged(v)) return v; - if (isforwarded(v)) return forwardloc(v); + if ((t & 3) == 0) + return v; + if (!ismanaged(v)) + return v; + if (isforwarded(v)) + return forwardloc(v); if (t == TAG_VECTOR) { // N.B.: 0-length vectors secretly have space for a first element size_t i, sz = vector_size(v); - if (vector_elt(v,-1) & 0x1) { + if (vector_elt(v, -1) & 0x1) { // grown vector - nc = relocate(vector_elt(v,0)); + nc = relocate(vector_elt(v, 0)); forward(v, nc); - } - else { - nc = tagptr(alloc_words(sz+1), TAG_VECTOR); + } else { + nc = tagptr(alloc_words(sz + 1), TAG_VECTOR); vector_setsize(nc, sz); - a = vector_elt(v,0); + a = vector_elt(v, 0); forward(v, nc); if (sz > 0) { - vector_elt(nc,0) = relocate(a); - for(i=1; i < sz; i++) - vector_elt(nc,i) = relocate(vector_elt(v,i)); + vector_elt(nc, 0) = relocate(a); + for (i = 1; i < sz; i++) + vector_elt(nc, i) = relocate(vector_elt(v, i)); } } return nc; - } - else if (t == TAG_CPRIM) { - cprim_t *pcp = (cprim_t*)ptr(v); - size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size); - cprim_t *ncp = (cprim_t*)alloc_words(nw); + } else if (t == TAG_CPRIM) { + cprim_t *pcp = (cprim_t *)ptr(v); + size_t nw = CPRIM_NWORDS - 1 + NWORDS(cp_class(pcp)->size); + cprim_t *ncp = (cprim_t *)alloc_words(nw); while (nw--) - ((value_t*)ncp)[nw] = ((value_t*)pcp)[nw]; + ((value_t *)ncp)[nw] = ((value_t *)pcp)[nw]; nc = tagptr(ncp, TAG_CPRIM); forward(v, nc); return nc; - } - else if (t == TAG_CVALUE) { + } else if (t == TAG_CVALUE) { return cvalue_relocate(v); - } - else if (t == TAG_FUNCTION) { - function_t *fn = (function_t*)ptr(v); - function_t *nfn = (function_t*)alloc_words(4); + } else if (t == TAG_FUNCTION) { + function_t *fn = (function_t *)ptr(v); + function_t *nfn = (function_t *)alloc_words(4); nfn->bcode = fn->bcode; nfn->vals = fn->vals; nc = tagptr(nfn, TAG_FUNCTION); @@ -489,10 +497,10 @@ static value_t relocate(value_t v) assert(!ismanaged(fn->name)); nfn->name = fn->name; return nc; - } - else if (t == TAG_SYM) { - gensym_t *gs = (gensym_t*)ptr(v); - gensym_t *ng = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*)); + } else if (t == TAG_SYM) { + gensym_t *gs = (gensym_t *)ptr(v); + gensym_t *ng = + (gensym_t *)alloc_words(sizeof(gensym_t) / sizeof(void *)); ng->id = gs->id; ng->binding = gs->binding; ng->isconst = 0; @@ -505,10 +513,7 @@ static value_t relocate(value_t v) return v; } -value_t relocate_lispvalue(value_t v) -{ - return relocate(v); -} +value_t relocate_lispvalue(value_t v) { return relocate(v); } static void trace_globals(symbol_t *root) { @@ -531,41 +536,41 @@ void gc(int mustgrow) curheap = tospace; if (grew) - lim = curheap+heapsize*2-sizeof(cons_t); + lim = curheap + heapsize * 2 - sizeof(cons_t); else - lim = curheap+heapsize-sizeof(cons_t); + lim = curheap + heapsize - sizeof(cons_t); if (fl_throwing_frame > curr_frame) { top = fl_throwing_frame - 4; - f = Stack[fl_throwing_frame-4]; - } - else { + f = Stack[fl_throwing_frame - 4]; + } else { top = SP; f = curr_frame; } while (1) { - for (i=f; i < top; i++) + for (i = f; i < top; i++) Stack[i] = relocate(Stack[i]); - if (f == 0) break; + if (f == 0) + break; top = f - 4; - f = Stack[f-4]; + f = Stack[f - 4]; } - for (i=0; i < N_GCHND; i++) + for (i = 0; i < N_GCHND; i++) *GCHandleStack[i] = relocate(*GCHandleStack[i]); trace_globals(symtab); relocate_typetable(); rs = readstate; while (rs) { value_t ent; - for(i=0; i < rs->backrefs.size; i++) { + for (i = 0; i < rs->backrefs.size; i++) { ent = (value_t)rs->backrefs.table[i]; if (ent != (value_t)HT_NOTFOUND) - rs->backrefs.table[i] = (void*)relocate(ent); + rs->backrefs.table[i] = (void *)relocate(ent); } - for(i=0; i < rs->gensyms.size; i++) { + for (i = 0; i < rs->gensyms.size; i++) { ent = (value_t)rs->gensyms.table[i]; if (ent != (value_t)HT_NOTFOUND) - rs->gensyms.table[i] = (void*)relocate(ent); + rs->gensyms.table[i] = (void *)relocate(ent); } rs->source = relocate(rs->source); rs = rs->prev; @@ -578,7 +583,7 @@ void gc(int mustgrow) #ifdef VERBOSEGC printf("GC: found %d/%d live conses\n", - (curheap-tospace)/sizeof(cons_t), heapsize/sizeof(cons_t)); + (curheap - tospace) / sizeof(cons_t), heapsize / sizeof(cons_t)); #endif temp = tospace; tospace = fromspace; @@ -587,17 +592,18 @@ void gc(int mustgrow) // 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)) || mustgrow) { - temp = LLT_REALLOC(tospace, heapsize*2); + if (grew || ((lim - curheap) < (int)(heapsize / 5)) || mustgrow) { + temp = LLT_REALLOC(tospace, heapsize * 2); if (temp == NULL) fl_raise(memory_exception_value); tospace = temp; if (grew) { - heapsize*=2; - temp = bitvector_resize(consflags, 0, heapsize/sizeof(cons_t), 1); + heapsize *= 2; + temp = + bitvector_resize(consflags, 0, heapsize / sizeof(cons_t), 1); if (temp == NULL) fl_raise(memory_exception_value); - consflags = (uint32_t*)temp; + consflags = (uint32_t *)temp; } grew = !grew; } @@ -607,34 +613,32 @@ void gc(int mustgrow) static void grow_stack(void) { - size_t newsz = N_STACK + (N_STACK>>1); - value_t *ns = realloc(Stack, newsz*sizeof(value_t)); + size_t newsz = N_STACK + (N_STACK >> 1); + value_t *ns = realloc(Stack, newsz * sizeof(value_t)); if (ns == NULL) lerror(MemoryError, "stack overflow"); Stack = ns; N_STACK = newsz; } -// utils ---------------------------------------------------------------------- +// utils +// ---------------------------------------------------------------------- // apply function with n args on the stack static value_t _applyn(uint32_t n) { - value_t f = Stack[SP-n-1]; + value_t f = Stack[SP - n - 1]; uint32_t saveSP = SP; value_t v; if (iscbuiltin(f)) { - v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n); - } - else if (isfunction(f)) { + v = ((builtin_t *)ptr(f))[3](&Stack[SP - n], n); + } else if (isfunction(f)) { v = apply_cl(n); - } - else if (isbuiltin(f)) { + } else if (isbuiltin(f)) { value_t tab = symbol_value(builtins_table_sym); - Stack[SP-n-1] = vector_elt(tab, uintval(f)); + Stack[SP - n - 1] = vector_elt(tab, uintval(f)); v = apply_cl(n); - } - else { + } else { type_error("apply", "function", f); } SP = saveSP; @@ -655,7 +659,7 @@ value_t fl_apply(value_t f, value_t l) } n = SP - n - 1; v = _applyn(n); - POPN(n+1); + POPN(n + 1); return v; } @@ -666,14 +670,14 @@ value_t fl_applyn(uint32_t n, value_t f, ...) size_t i; PUSH(f); - while (SP+n > N_STACK) + while (SP + n > N_STACK) grow_stack(); - for(i=0; i < n; i++) { + for (i = 0; i < n; i++) { value_t a = va_arg(ap, value_t); PUSH(a); } value_t v = _applyn(n); - POPN(n+1); + POPN(n + 1); va_end(ap); return v; } @@ -685,20 +689,20 @@ value_t fl_listn(size_t n, ...) uint32_t si = SP; size_t i; - while (SP+n > N_STACK) + while (SP + n > N_STACK) grow_stack(); - for(i=0; i < n; i++) { + for (i = 0; i < n; i++) { value_t a = va_arg(ap, value_t); PUSH(a); } - cons_t *c = (cons_t*)alloc_words(n*2); + cons_t *c = (cons_t *)alloc_words(n * 2); cons_t *l = c; - for(i=0; i < n; i++) { + for (i = 0; i < n; i++) { c->car = Stack[si++]; - c->cdr = tagptr(c+1, TAG_CONS); + c->cdr = tagptr(c + 1, TAG_CONS); c++; } - (c-1)->cdr = NIL; + (c - 1)->cdr = NIL; POPN(n); va_end(ap); @@ -709,11 +713,11 @@ value_t fl_list2(value_t a, value_t b) { PUSH(a); PUSH(b); - cons_t *c = (cons_t*)alloc_words(4); + cons_t *c = (cons_t *)alloc_words(4); b = POP(); a = POP(); c[0].car = a; - c[0].cdr = tagptr(c+1, TAG_CONS); + c[0].cdr = tagptr(c + 1, TAG_CONS); c[1].car = b; c[1].cdr = NIL; return tagptr(c, TAG_CONS); @@ -731,25 +735,29 @@ value_t fl_cons(value_t a, value_t b) int fl_isnumber(value_t v) { - if (isfixnum(v)) return 1; + if (isfixnum(v)) + return 1; if (iscprim(v)) { - cprim_t *c = (cprim_t*)ptr(v); + cprim_t *c = (cprim_t *)ptr(v); return c->type != wchartype; } return 0; } -// read ----------------------------------------------------------------------- +// read +// ----------------------------------------------------------------------- #include "read.c" -// equal ---------------------------------------------------------------------- +// equal +// ---------------------------------------------------------------------- #include "equal.c" -// eval ----------------------------------------------------------------------- +// eval +// ----------------------------------------------------------------------- -#define list(a,n) _list((a),(n),0) +#define list(a, n) _list((a), (n), 0) static value_t _list(value_t *args, uint32_t nargs, int star) { @@ -757,16 +765,16 @@ static value_t _list(value_t *args, uint32_t nargs, int star) uint32_t i; value_t v; v = cons_reserve(nargs); - c = (cons_t*)ptr(v); - for(i=0; i < nargs; i++) { + c = (cons_t *)ptr(v); + for (i = 0; i < nargs; i++) { c->car = args[i]; - c->cdr = tagptr(c+1, TAG_CONS); + c->cdr = tagptr(c + 1, TAG_CONS); c++; } if (star) - (c-2)->cdr = (c-1)->car; + (c - 2)->cdr = (c - 1)->car; else - (c-1)->cdr = NIL; + (c - 1)->cdr = NIL; return v; } @@ -776,10 +784,11 @@ static value_t copy_list(value_t L) return NIL; PUSH(NIL); PUSH(L); - value_t *plcons = &Stack[SP-2]; - value_t *pL = &Stack[SP-1]; + value_t *plcons = &Stack[SP - 2]; + value_t *pL = &Stack[SP - 1]; value_t c; - c = mk_cons(); PUSH(c); // save first cons + c = mk_cons(); + PUSH(c); // save first cons car_(c) = car_(*pL); cdr_(c) = NIL; *plcons = c; @@ -801,15 +810,14 @@ static value_t do_trycatch(void) { uint32_t saveSP = SP; value_t v; - value_t thunk = Stack[SP-2]; - Stack[SP-2] = Stack[SP-1]; - Stack[SP-1] = thunk; + value_t thunk = Stack[SP - 2]; + Stack[SP - 2] = Stack[SP - 1]; + Stack[SP - 1] = thunk; - FL_TRY { - v = apply_cl(0); - } - FL_CATCH { - v = Stack[saveSP-2]; + FL_TRY { v = apply_cl(0); } + FL_CATCH + { + v = Stack[saveSP - 2]; PUSH(v); PUSH(fl_lasterror); v = apply_cl(1); @@ -822,65 +830,68 @@ static value_t do_trycatch(void) argument layout on stack is |--required args--|--opt args--|--kw args--|--rest args... */ -static uint32_t process_keys(value_t kwtable, - uint32_t nreq, uint32_t nkw, uint32_t nopt, - uint32_t bp, uint32_t nargs, int va) +static uint32_t process_keys(value_t kwtable, uint32_t nreq, uint32_t nkw, + uint32_t nopt, uint32_t bp, uint32_t nargs, + int va) { - uint32_t extr = nopt+nkw; - uint32_t ntot = nreq+extr; + uint32_t extr = nopt + nkw; + uint32_t ntot = nreq + extr; value_t args[extr], v; uint32_t i, a = 0, nrestargs; - value_t s1 = Stack[SP-1]; - value_t s2 = Stack[SP-2]; - value_t s4 = Stack[SP-4]; - value_t s5 = Stack[SP-5]; + value_t s1 = Stack[SP - 1]; + value_t s2 = Stack[SP - 2]; + value_t s4 = Stack[SP - 4]; + value_t s5 = Stack[SP - 5]; if (nargs < nreq) lerror(ArgError, "apply: too few arguments"); - for (i=0; i < extr; i++) args[i] = UNBOUND; - for (i=nreq; i < nargs; i++) { - v = Stack[bp+i]; - if (issymbol(v) && iskeyword((symbol_t*)ptr(v))) + for (i = 0; i < extr; i++) + args[i] = UNBOUND; + for (i = nreq; i < nargs; i++) { + v = Stack[bp + i]; + if (issymbol(v) && iskeyword((symbol_t *)ptr(v))) break; if (a >= nopt) goto no_kw; args[a++] = v; } - if (i >= nargs) goto no_kw; + if (i >= nargs) + goto no_kw; // now process keywords - uptrint_t n = vector_size(kwtable)/2; + uptrint_t n = vector_size(kwtable) / 2; do { i++; if (i >= nargs) lerrorf(ArgError, "keyword %s requires an argument", symbol_name(v)); - value_t hv = fixnum(((symbol_t*)ptr(v))->hash); - uptrint_t x = 2*(labs(numval(hv)) % n); + value_t hv = fixnum(((symbol_t *)ptr(v))->hash); + uptrint_t x = 2 * (labs(numval(hv)) % n); if (vector_elt(kwtable, x) == v) { - uptrint_t idx = numval(vector_elt(kwtable, x+1)); + uptrint_t idx = numval(vector_elt(kwtable, x + 1)); assert(idx < nkw); idx += nopt; if (args[idx] == UNBOUND) { // if duplicate key, keep first value - args[idx] = Stack[bp+i]; + args[idx] = Stack[bp + i]; } - } - else { + } else { lerrorf(ArgError, "unsupported keyword %s", symbol_name(v)); } i++; - if (i >= nargs) break; - v = Stack[bp+i]; - } while (issymbol(v) && iskeyword((symbol_t*)ptr(v))); - no_kw: + if (i >= nargs) + break; + v = Stack[bp + i]; + } while (issymbol(v) && iskeyword((symbol_t *)ptr(v))); +no_kw: nrestargs = nargs - i; if (!va && nrestargs > 0) lerror(ArgError, "apply: too many arguments"); nargs = ntot + nrestargs; if (nrestargs) - memmove(&Stack[bp+ntot], &Stack[bp+i], nrestargs*sizeof(value_t)); - memcpy(&Stack[bp+nreq], args, extr*sizeof(value_t)); + memmove(&Stack[bp + ntot], &Stack[bp + i], + nrestargs * sizeof(value_t)); + memcpy(&Stack[bp + nreq], args, extr * sizeof(value_t)); SP = bp + nargs; - assert(SP < N_STACK-5); + assert(SP < N_STACK - 5); PUSH(s5); PUSH(s4); PUSH(nargs); @@ -891,24 +902,19 @@ static uint32_t process_keys(value_t kwtable, } #if BYTE_ORDER == BIG_ENDIAN -#define GET_INT32(a) \ - ((int32_t) \ - ((((int32_t)a[0])<<0) | \ - (((int32_t)a[1])<<8) | \ - (((int32_t)a[2])<<16) | \ - (((int32_t)a[3])<<24))) -#define GET_INT16(a) \ - ((int16_t) \ - ((((int16_t)a[0])<<0) | \ - (((int16_t)a[1])<<8))) -#define PUT_INT32(a,i) (*(int32_t*)(a) = bswap_32((int32_t)(i))) +#define GET_INT32(a) \ + ((int32_t)((((int32_t)a[0]) << 0) | (((int32_t)a[1]) << 8) | \ + (((int32_t)a[2]) << 16) | (((int32_t)a[3]) << 24))) +#define GET_INT16(a) \ + ((int16_t)((((int16_t)a[0]) << 0) | (((int16_t)a[1]) << 8))) +#define PUT_INT32(a, i) (*(int32_t *)(a) = bswap_32((int32_t)(i))) #else -#define GET_INT32(a) (*(int32_t*)a) -#define GET_INT16(a) (*(int16_t*)a) -#define PUT_INT32(a,i) (*(int32_t*)(a) = (int32_t)(i)) +#define GET_INT32(a) (*(int32_t *)a) +#define GET_INT16(a) (*(int16_t *)a) +#define PUT_INT32(a, i) (*(int32_t *)(a) = (int32_t)(i)) #endif -#define SWAP_INT32(a) (*(int32_t*)(a) = bswap_32(*(int32_t*)(a))) -#define SWAP_INT16(a) (*(int16_t*)(a) = bswap_16(*(int16_t*)(a))) +#define SWAP_INT32(a) (*(int32_t *)(a) = bswap_32(*(int32_t *)(a))) +#define SWAP_INT16(a) (*(int16_t *)(a) = bswap_16(*(int16_t *)(a))) #ifdef USE_COMPUTED_GOTO #define OP(x) L_##x: @@ -937,7 +943,7 @@ static value_t apply_cl(uint32_t nargs) VM_APPLY_LABELS; uint32_t top_frame = curr_frame; // frame variables - uint32_t n=0, captured; + uint32_t n = 0, captured; uint32_t bp; const uint8_t *ip; fixnum_t s, hi; @@ -953,35 +959,35 @@ static value_t apply_cl(uint32_t nargs) static int64_t accum; static value_t func, v, e; - apply_cl_top: +apply_cl_top: captured = 0; - func = Stack[SP-nargs-1]; - ip = cv_data((cvalue_t*)ptr(fn_bcode(func))); + func = Stack[SP - nargs - 1]; + ip = cv_data((cvalue_t *)ptr(fn_bcode(func))); assert(!ismanaged((uptrint_t)ip)); - while (SP+GET_INT32(ip) > N_STACK) { + while (SP + GET_INT32(ip) > N_STACK) { grow_stack(); } ip += 4; - bp = SP-nargs; + bp = SP - nargs; PUSH(fn_env(func)); PUSH(curr_frame); PUSH(nargs); - SP++;//PUSH(0); //ip - PUSH(0); //captured? + SP++; // PUSH(0); //ip + PUSH(0); // captured? curr_frame = SP; { #ifdef USE_COMPUTED_GOTO - { - NEXT_OP; + { + NEXT_OP; #else next_op: op = *ip++; dispatch: switch (op) { #endif - OP(OP_ARGC) + OP(OP_ARGC) n = *ip++; do_argc: if (nargs != n) { @@ -991,67 +997,72 @@ static value_t apply_cl(uint32_t nargs) lerror(ArgError, "apply: too few arguments"); } NEXT_OP; - OP(OP_VARGC) + OP(OP_VARGC) i = *ip++; do_vargc: s = (fixnum_t)nargs - (fixnum_t)i; if (s > 0) { - v = list(&Stack[bp+i], s); - Stack[bp+i] = v; + v = list(&Stack[bp + i], s); + Stack[bp + i] = v; if (s > 1) { - Stack[bp+i+1] = Stack[bp+nargs+0]; - Stack[bp+i+2] = Stack[bp+nargs+1]; - Stack[bp+i+3] = i+1; - //Stack[bp+i+4] = 0; - Stack[bp+i+5] = 0; - SP = bp+i+6; + Stack[bp + i + 1] = Stack[bp + nargs + 0]; + Stack[bp + i + 2] = Stack[bp + nargs + 1]; + Stack[bp + i + 3] = i + 1; + // Stack[bp+i+4] = 0; + Stack[bp + i + 5] = 0; + SP = bp + i + 6; curr_frame = SP; } - } - else if (s < 0) { + } else if (s < 0) { lerror(ArgError, "apply: too few arguments"); - } - else { + } else { PUSH(0); - Stack[SP-3] = i+1; - Stack[SP-4] = Stack[SP-5]; - Stack[SP-5] = Stack[SP-6]; - Stack[SP-6] = NIL; + Stack[SP - 3] = i + 1; + Stack[SP - 4] = Stack[SP - 5]; + Stack[SP - 5] = Stack[SP - 6]; + Stack[SP - 6] = NIL; curr_frame = SP; } - nargs = i+1; + nargs = i + 1; NEXT_OP; - OP(OP_LARGC) - n = GET_INT32(ip); ip+=4; + OP(OP_LARGC) + n = GET_INT32(ip); + ip += 4; goto do_argc; - OP(OP_LVARGC) - i = GET_INT32(ip); ip+=4; + OP(OP_LVARGC) + i = GET_INT32(ip); + ip += 4; goto do_vargc; - OP(OP_BRBOUND) - i = GET_INT32(ip); ip+=4; + OP(OP_BRBOUND) + i = GET_INT32(ip); + ip += 4; if (captured) v = vector_elt(Stack[bp], i); else - v = Stack[bp+i]; - if (v != UNBOUND) PUSH(FL_T); - else PUSH(FL_F); + v = Stack[bp + i]; + if (v != UNBOUND) + PUSH(FL_T); + else + PUSH(FL_F); NEXT_OP; - OP(OP_DUP) SP++; Stack[SP-1] = Stack[SP-2]; NEXT_OP; - OP(OP_POP) POPN(1); NEXT_OP; - OP(OP_TCALL) + OP(OP_DUP) SP++; + Stack[SP - 1] = Stack[SP - 2]; + NEXT_OP; + OP(OP_POP) POPN(1); + NEXT_OP; + OP(OP_TCALL) n = *ip++; // nargs do_tcall: - func = Stack[SP-n-1]; + func = Stack[SP - n - 1]; if (tag(func) == TAG_FUNCTION) { - if (func > (N_BUILTINS<<3)) { - curr_frame = Stack[curr_frame-4]; - for(s=-1; s < (fixnum_t)n; s++) - Stack[bp+s] = Stack[SP-n+s]; - SP = bp+n; + if (func > (N_BUILTINS << 3)) { + curr_frame = Stack[curr_frame - 4]; + for (s = -1; s < (fixnum_t)n; s++) + Stack[bp + s] = Stack[SP - n + s]; + SP = bp + n; nargs = n; goto apply_cl_top; - } - else { + } else { i = uintval(func); if (i <= OP_ASET) { s = builtin_arg_counts[i]; @@ -1060,8 +1071,8 @@ static value_t apply_cl(uint32_t nargs) else if (s != ANYARGS && (signed)n < -s) argcount(builtin_names[i], n, -s); // remove function arg - for(s=SP-n-1; s < (int)SP-1; s++) - Stack[s] = Stack[s+1]; + for (s = SP - n - 1; s < (int)SP - 1; s++) + Stack[s] = Stack[s + 1]; SP--; #ifdef USE_COMPUTED_GOTO if (i == OP_APPLY) @@ -1069,13 +1080,20 @@ static value_t apply_cl(uint32_t nargs) goto *vm_apply_labels[i]; #else switch (i) { - case OP_LIST: goto apply_list; - case OP_VECTOR: goto apply_vector; - case OP_APPLY: goto apply_tapply; - case OP_ADD: goto apply_add; - case OP_SUB: goto apply_sub; - case OP_MUL: goto apply_mul; - case OP_DIV: goto apply_div; + case OP_LIST: + goto apply_list; + case OP_VECTOR: + goto apply_vector; + case OP_APPLY: + goto apply_tapply; + case OP_ADD: + goto apply_add; + case OP_SUB: + goto apply_sub; + case OP_MUL: + goto apply_mul; + case OP_DIV: + goto apply_div; default: op = (uint8_t)i; goto dispatch; @@ -1083,27 +1101,25 @@ static value_t apply_cl(uint32_t nargs) #endif } } - } - else if (iscbuiltin(func)) { + } else if (iscbuiltin(func)) { s = SP; - v = ((builtin_t)(((void**)ptr(func))[3]))(&Stack[SP-n], n); - SP = s-n; - Stack[SP-1] = v; + v = ((builtin_t)(((void **)ptr(func))[3]))(&Stack[SP - n], n); + SP = s - n; + Stack[SP - 1] = v; NEXT_OP; } type_error("apply", "function", func); - // WARNING: repeated code ahead - OP(OP_CALL) + // WARNING: repeated code ahead + OP(OP_CALL) n = *ip++; // nargs do_call: - func = Stack[SP-n-1]; + func = Stack[SP - n - 1]; if (tag(func) == TAG_FUNCTION) { - if (func > (N_BUILTINS<<3)) { - Stack[curr_frame-2] = (uptrint_t)ip; + if (func > (N_BUILTINS << 3)) { + Stack[curr_frame - 2] = (uptrint_t)ip; nargs = n; goto apply_cl_top; - } - else { + } else { i = uintval(func); if (i <= OP_ASET) { s = builtin_arg_counts[i]; @@ -1112,20 +1128,27 @@ static value_t apply_cl(uint32_t nargs) else if (s != ANYARGS && (signed)n < -s) argcount(builtin_names[i], n, -s); // remove function arg - for(s=SP-n-1; s < (int)SP-1; s++) - Stack[s] = Stack[s+1]; + for (s = SP - n - 1; s < (int)SP - 1; s++) + Stack[s] = Stack[s + 1]; SP--; #ifdef USE_COMPUTED_GOTO goto *vm_apply_labels[i]; #else switch (i) { - case OP_LIST: goto apply_list; - case OP_VECTOR: goto apply_vector; - case OP_APPLY: goto apply_apply; - case OP_ADD: goto apply_add; - case OP_SUB: goto apply_sub; - case OP_MUL: goto apply_mul; - case OP_DIV: goto apply_div; + case OP_LIST: + goto apply_list; + case OP_VECTOR: + goto apply_vector; + case OP_APPLY: + goto apply_apply; + case OP_ADD: + goto apply_add; + case OP_SUB: + goto apply_sub; + case OP_MUL: + goto apply_mul; + case OP_DIV: + goto apply_div; default: op = (uint8_t)i; goto dispatch; @@ -1133,218 +1156,264 @@ static value_t apply_cl(uint32_t nargs) #endif } } - } - else if (iscbuiltin(func)) { + } else if (iscbuiltin(func)) { s = SP; - v = ((builtin_t)(((void**)ptr(func))[3]))(&Stack[SP-n], n); - SP = s-n; - Stack[SP-1] = v; + v = ((builtin_t)(((void **)ptr(func))[3]))(&Stack[SP - n], n); + SP = s - n; + Stack[SP - 1] = v; NEXT_OP; } type_error("apply", "function", func); - OP(OP_TCALLL) n = GET_INT32(ip); ip+=4; goto do_tcall; - OP(OP_CALLL) n = GET_INT32(ip); ip+=4; goto do_call; - OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP; - OP(OP_BRF) - v = POP(); - if (v == FL_F) ip += (ptrint_t)GET_INT16(ip); - else ip += 2; + OP(OP_TCALLL) n = GET_INT32(ip); + ip += 4; + goto do_tcall; + OP(OP_CALLL) n = GET_INT32(ip); + ip += 4; + goto do_call; + OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP; - OP(OP_BRT) + OP(OP_BRF) v = POP(); - if (v != FL_F) ip += (ptrint_t)GET_INT16(ip); - else ip += 2; + if (v == FL_F) + ip += (ptrint_t)GET_INT16(ip); + else + ip += 2; NEXT_OP; - OP(OP_JMPL) ip += (ptrint_t)GET_INT32(ip); NEXT_OP; - OP(OP_BRFL) + OP(OP_BRT) v = POP(); - if (v == FL_F) ip += (ptrint_t)GET_INT32(ip); - else ip += 4; + if (v != FL_F) + ip += (ptrint_t)GET_INT16(ip); + else + ip += 2; NEXT_OP; - OP(OP_BRTL) + OP(OP_JMPL) ip += (ptrint_t)GET_INT32(ip); + NEXT_OP; + OP(OP_BRFL) v = POP(); - if (v != FL_F) ip += (ptrint_t)GET_INT32(ip); - else ip += 4; + if (v == FL_F) + ip += (ptrint_t)GET_INT32(ip); + else + ip += 4; NEXT_OP; - OP(OP_BRNE) - if (Stack[SP-2] != Stack[SP-1]) ip += (ptrint_t)GET_INT16(ip); - else ip += 2; + OP(OP_BRTL) + v = POP(); + if (v != FL_F) + ip += (ptrint_t)GET_INT32(ip); + else + ip += 4; + NEXT_OP; + OP(OP_BRNE) + if (Stack[SP - 2] != Stack[SP - 1]) + ip += (ptrint_t)GET_INT16(ip); + else + ip += 2; POPN(2); NEXT_OP; - OP(OP_BRNEL) - if (Stack[SP-2] != Stack[SP-1]) ip += (ptrint_t)GET_INT32(ip); - else ip += 4; + OP(OP_BRNEL) + if (Stack[SP - 2] != Stack[SP - 1]) + ip += (ptrint_t)GET_INT32(ip); + else + ip += 4; POPN(2); NEXT_OP; - OP(OP_BRNN) + OP(OP_BRNN) v = POP(); - if (v != NIL) ip += (ptrint_t)GET_INT16(ip); - else ip += 2; + if (v != NIL) + ip += (ptrint_t)GET_INT16(ip); + else + ip += 2; NEXT_OP; - OP(OP_BRNNL) + OP(OP_BRNNL) v = POP(); - if (v != NIL) ip += (ptrint_t)GET_INT32(ip); - else ip += 4; + if (v != NIL) + ip += (ptrint_t)GET_INT32(ip); + else + ip += 4; NEXT_OP; - OP(OP_BRN) + OP(OP_BRN) v = POP(); - if (v == NIL) ip += (ptrint_t)GET_INT16(ip); - else ip += 2; + if (v == NIL) + ip += (ptrint_t)GET_INT16(ip); + else + ip += 2; NEXT_OP; - OP(OP_BRNL) + OP(OP_BRNL) v = POP(); - if (v == NIL) ip += (ptrint_t)GET_INT32(ip); - else ip += 4; + if (v == NIL) + ip += (ptrint_t)GET_INT32(ip); + else + ip += 4; NEXT_OP; - OP(OP_RET) + OP(OP_RET) v = POP(); SP = curr_frame; - curr_frame = Stack[SP-4]; - if (curr_frame == top_frame) return v; - SP -= (5+nargs); - captured = Stack[curr_frame-1]; - ip = (uint8_t*)Stack[curr_frame-2]; - nargs = Stack[curr_frame-3]; - bp = curr_frame - 5 - nargs; - Stack[SP-1] = v; + curr_frame = Stack[SP - 4]; + if (curr_frame == top_frame) + return v; + SP -= (5 + nargs); + captured = Stack[curr_frame - 1]; + ip = (uint8_t *)Stack[curr_frame - 2]; + nargs = Stack[curr_frame - 3]; + bp = curr_frame - 5 - nargs; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_EQ) - Stack[SP-2] = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F); - POPN(1); NEXT_OP; - OP(OP_EQV) - if (Stack[SP-2] == Stack[SP-1]) { + OP(OP_EQ) + Stack[SP - 2] = ((Stack[SP - 2] == Stack[SP - 1]) ? FL_T : FL_F); + POPN(1); + NEXT_OP; + OP(OP_EQV) + if (Stack[SP - 2] == Stack[SP - 1]) { v = FL_T; - } - else if (!leafp(Stack[SP-2]) || !leafp(Stack[SP-1])) { + } else if (!leafp(Stack[SP - 2]) || !leafp(Stack[SP - 1])) { v = FL_F; + } else { + v = (compare_(Stack[SP - 2], Stack[SP - 1], 1) == 0 ? FL_T + : FL_F); } - else { - v = (compare_(Stack[SP-2], Stack[SP-1], 1)==0 ? FL_T : FL_F); - } - Stack[SP-2] = v; POPN(1); + Stack[SP - 2] = v; + POPN(1); NEXT_OP; - OP(OP_EQUAL) - if (Stack[SP-2] == Stack[SP-1]) { + OP(OP_EQUAL) + if (Stack[SP - 2] == Stack[SP - 1]) { v = FL_T; + } else { + v = (compare_(Stack[SP - 2], Stack[SP - 1], 1) == 0 ? FL_T + : FL_F); } - else { - v = (compare_(Stack[SP-2], Stack[SP-1], 1)==0 ? FL_T : FL_F); - } - Stack[SP-2] = v; POPN(1); + Stack[SP - 2] = v; + POPN(1); NEXT_OP; - OP(OP_PAIRP) - Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_ATOMP) - Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); NEXT_OP; - OP(OP_NOT) - Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); NEXT_OP; - OP(OP_NULLP) - Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); NEXT_OP; - OP(OP_BOOLEANP) - v = Stack[SP-1]; - Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T:FL_F); NEXT_OP; - OP(OP_SYMBOLP) - Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_NUMBERP) - v = Stack[SP-1]; - Stack[SP-1] = (fl_isnumber(v) ? FL_T:FL_F); NEXT_OP; - OP(OP_FIXNUMP) - Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_BOUNDP) - sym = tosymbol(Stack[SP-1], "bound?"); - Stack[SP-1] = ((sym->binding == UNBOUND) ? FL_F : FL_T); + OP(OP_PAIRP) + Stack[SP - 1] = (iscons(Stack[SP - 1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_BUILTINP) - v = Stack[SP-1]; - Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F; + OP(OP_ATOMP) + Stack[SP - 1] = (iscons(Stack[SP - 1]) ? FL_F : FL_T); NEXT_OP; - OP(OP_FUNCTIONP) - v = Stack[SP-1]; - Stack[SP-1] = ((tag(v)==TAG_FUNCTION && - (uintval(v)<=OP_ASET || v>(N_BUILTINS<<3))) || - iscbuiltin(v)) ? FL_T : FL_F; + OP(OP_NOT) + Stack[SP - 1] = ((Stack[SP - 1] == FL_F) ? FL_T : FL_F); + NEXT_OP; + OP(OP_NULLP) + Stack[SP - 1] = ((Stack[SP - 1] == NIL) ? FL_T : FL_F); + NEXT_OP; + OP(OP_BOOLEANP) + v = Stack[SP - 1]; + Stack[SP - 1] = ((v == FL_T || v == FL_F) ? FL_T : FL_F); + NEXT_OP; + OP(OP_SYMBOLP) + Stack[SP - 1] = (issymbol(Stack[SP - 1]) ? FL_T : FL_F); + NEXT_OP; + OP(OP_NUMBERP) + v = Stack[SP - 1]; + Stack[SP - 1] = (fl_isnumber(v) ? FL_T : FL_F); + NEXT_OP; + OP(OP_FIXNUMP) + Stack[SP - 1] = (isfixnum(Stack[SP - 1]) ? FL_T : FL_F); + NEXT_OP; + OP(OP_BOUNDP) + sym = tosymbol(Stack[SP - 1], "bound?"); + Stack[SP - 1] = ((sym->binding == UNBOUND) ? FL_F : FL_T); + NEXT_OP; + OP(OP_BUILTINP) + v = Stack[SP - 1]; + Stack[SP - 1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F; + NEXT_OP; + OP(OP_FUNCTIONP) + v = Stack[SP - 1]; + Stack[SP - 1] = + ((tag(v) == TAG_FUNCTION && + (uintval(v) <= OP_ASET || v > (N_BUILTINS << 3))) || + iscbuiltin(v)) + ? FL_T + : FL_F; + NEXT_OP; + OP(OP_VECTORP) + Stack[SP - 1] = (isvector(Stack[SP - 1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_VECTORP) - Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP; - OP(OP_CONS) + OP(OP_CONS) if (curheap > lim) gc(0); - c = (cons_t*)curheap; + c = (cons_t *)curheap; curheap += sizeof(cons_t); - c->car = Stack[SP-2]; - c->cdr = Stack[SP-1]; - Stack[SP-2] = tagptr(c, TAG_CONS); - POPN(1); NEXT_OP; - OP(OP_CAR) - v = Stack[SP-1]; - if (!iscons(v)) type_error("car", "cons", v); - Stack[SP-1] = car_(v); + c->car = Stack[SP - 2]; + c->cdr = Stack[SP - 1]; + Stack[SP - 2] = tagptr(c, TAG_CONS); + POPN(1); NEXT_OP; - OP(OP_CDR) - v = Stack[SP-1]; - if (!iscons(v)) type_error("cdr", "cons", v); - Stack[SP-1] = cdr_(v); + OP(OP_CAR) + v = Stack[SP - 1]; + if (!iscons(v)) + type_error("car", "cons", v); + Stack[SP - 1] = car_(v); NEXT_OP; - OP(OP_CADR) - v = Stack[SP-1]; - if (!iscons(v)) type_error("cdr", "cons", v); + OP(OP_CDR) + v = Stack[SP - 1]; + if (!iscons(v)) + type_error("cdr", "cons", v); + Stack[SP - 1] = cdr_(v); + NEXT_OP; + OP(OP_CADR) + v = Stack[SP - 1]; + if (!iscons(v)) + type_error("cdr", "cons", v); v = cdr_(v); - if (!iscons(v)) type_error("car", "cons", v); - Stack[SP-1] = car_(v); + if (!iscons(v)) + type_error("car", "cons", v); + Stack[SP - 1] = car_(v); NEXT_OP; - OP(OP_SETCAR) - car(Stack[SP-2]) = Stack[SP-1]; - POPN(1); NEXT_OP; - OP(OP_SETCDR) - cdr(Stack[SP-2]) = Stack[SP-1]; - POPN(1); NEXT_OP; - OP(OP_LIST) + OP(OP_SETCAR) + car(Stack[SP - 2]) = Stack[SP - 1]; + POPN(1); + NEXT_OP; + OP(OP_SETCDR) + cdr(Stack[SP - 2]) = Stack[SP - 1]; + POPN(1); + NEXT_OP; + OP(OP_LIST) n = *ip++; apply_list: if (n > 0) { - v = list(&Stack[SP-n], n); + v = list(&Stack[SP - n], n); POPN(n); PUSH(v); - } - else { + } else { PUSH(NIL); } NEXT_OP; - OP(OP_TAPPLY) + OP(OP_TAPPLY) n = *ip++; apply_tapply: - v = POP(); // arglist - n = SP-(n-2); // n-2 == # leading arguments not in the list + v = POP(); // arglist + n = SP - (n - 2); // n-2 == # leading arguments not in the list while (iscons(v)) { if (SP >= N_STACK) grow_stack(); PUSH(car_(v)); v = cdr_(v); } - n = SP-n; + n = SP - n; goto do_tcall; - OP(OP_APPLY) + OP(OP_APPLY) n = *ip++; apply_apply: - v = POP(); // arglist - n = SP-(n-2); // n-2 == # leading arguments not in the list + v = POP(); // arglist + n = SP - (n - 2); // n-2 == # leading arguments not in the list while (iscons(v)) { if (SP >= N_STACK) grow_stack(); PUSH(car_(v)); v = cdr_(v); } - n = SP-n; + n = SP - n; goto do_call; - OP(OP_ADD) + OP(OP_ADD) n = *ip++; apply_add: s = 0; - i = SP-n; + i = SP - n; for (; i < SP; i++) { if (isfixnum(Stack[i])) { s += numval(Stack[i]); @@ -1352,87 +1421,85 @@ static value_t apply_cl(uint32_t nargs) i++; goto add_ovf; } - } - else { + } else { add_ovf: - v = fl_add_any(&Stack[i], SP-i, s); + v = fl_add_any(&Stack[i], SP - i, s); break; } } - if (i==SP) + if (i == SP) v = fixnum(s); POPN(n); PUSH(v); NEXT_OP; - OP(OP_ADD2) - if (bothfixnums(Stack[SP-1], Stack[SP-2])) { - s = numval(Stack[SP-1]) + numval(Stack[SP-2]); + OP(OP_ADD2) + if (bothfixnums(Stack[SP - 1], Stack[SP - 2])) { + s = numval(Stack[SP - 1]) + numval(Stack[SP - 2]); if (fits_fixnum(s)) v = fixnum(s); else v = mk_long(s); - } - else { - v = fl_add_any(&Stack[SP-2], 2, 0); + } else { + v = fl_add_any(&Stack[SP - 2], 2, 0); } POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_SUB) + OP(OP_SUB) n = *ip++; apply_sub: - if (n == 2) goto do_sub2; - if (n == 1) goto do_neg; - i = SP-n; + if (n == 2) + goto do_sub2; + if (n == 1) + goto do_neg; + i = SP - n; // we need to pass the full arglist on to fl_add_any // so it can handle rest args properly PUSH(Stack[i]); Stack[i] = fixnum(0); - Stack[i+1] = fl_neg(fl_add_any(&Stack[i], n, 0)); + Stack[i + 1] = fl_neg(fl_add_any(&Stack[i], n, 0)); Stack[i] = POP(); v = fl_add_any(&Stack[i], 2, 0); POPN(n); PUSH(v); NEXT_OP; - OP(OP_NEG) + OP(OP_NEG) do_neg: - if (isfixnum(Stack[SP-1])) { - s = fixnum(-numval(Stack[SP-1])); - if (__unlikely(s == Stack[SP-1])) - Stack[SP-1] = mk_long(-numval(Stack[SP-1])); // negate overflows + if (isfixnum(Stack[SP - 1])) { + s = fixnum(-numval(Stack[SP - 1])); + if (__unlikely(s == Stack[SP - 1])) + Stack[SP - 1] = + mk_long(-numval(Stack[SP - 1])); // negate overflows else - Stack[SP-1] = s; - } - else - Stack[SP-1] = fl_neg(Stack[SP-1]); + Stack[SP - 1] = s; + } else + Stack[SP - 1] = fl_neg(Stack[SP - 1]); NEXT_OP; - OP(OP_SUB2) + OP(OP_SUB2) do_sub2: - if (bothfixnums(Stack[SP-2], Stack[SP-1])) { - s = numval(Stack[SP-2]) - numval(Stack[SP-1]); + if (bothfixnums(Stack[SP - 2], Stack[SP - 1])) { + s = numval(Stack[SP - 2]) - numval(Stack[SP - 1]); if (fits_fixnum(s)) v = fixnum(s); else v = mk_long(s); - } - else { - Stack[SP-1] = fl_neg(Stack[SP-1]); - v = fl_add_any(&Stack[SP-2], 2, 0); + } else { + Stack[SP - 1] = fl_neg(Stack[SP - 1]); + v = fl_add_any(&Stack[SP - 2], 2, 0); } POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_MUL) + OP(OP_MUL) n = *ip++; apply_mul: accum = 1; - i = SP-n; + i = SP - n; for (; i < SP; i++) { if (isfixnum(Stack[i])) { accum *= numval(Stack[i]); - } - else { - v = fl_mul_any(&Stack[i], SP-i, accum); + } else { + v = fl_mul_any(&Stack[i], SP - i, accum); break; } } @@ -1445,76 +1512,79 @@ static value_t apply_cl(uint32_t nargs) POPN(n); PUSH(v); NEXT_OP; - OP(OP_DIV) + OP(OP_DIV) n = *ip++; apply_div: - i = SP-n; + i = SP - n; if (n == 1) { - Stack[SP-1] = fl_div2(fixnum(1), Stack[i]); - } - else { + Stack[SP - 1] = fl_div2(fixnum(1), Stack[i]); + } else { if (n > 2) { PUSH(Stack[i]); Stack[i] = fixnum(1); - Stack[i+1] = fl_mul_any(&Stack[i], n, 1); + Stack[i + 1] = fl_mul_any(&Stack[i], n, 1); Stack[i] = POP(); } - v = fl_div2(Stack[i], Stack[i+1]); + v = fl_div2(Stack[i], Stack[i + 1]); POPN(n); PUSH(v); } NEXT_OP; - OP(OP_IDIV) - v = Stack[SP-2]; e = Stack[SP-1]; + OP(OP_IDIV) + v = Stack[SP - 2]; + e = Stack[SP - 1]; if (bothfixnums(v, e)) { - if (e==0) DivideByZeroError(); + if (e == 0) + DivideByZeroError(); v = fixnum(numval(v) / numval(e)); - } - else + } else v = fl_idiv2(v, e); POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_NUMEQ) - v = Stack[SP-2]; e = Stack[SP-1]; + OP(OP_NUMEQ) + v = Stack[SP - 2]; + e = Stack[SP - 1]; if (bothfixnums(v, e)) v = (v == e) ? FL_T : FL_F; else - v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F; + v = (!numeric_compare(v, e, 1, 0, "=")) ? FL_T : FL_F; POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_LT) - if (bothfixnums(Stack[SP-2], Stack[SP-1])) { - v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? FL_T : FL_F; - } - else { - v = (numval(fl_compare(Stack[SP-2], Stack[SP-1])) < 0) ? - FL_T : FL_F; + OP(OP_LT) + if (bothfixnums(Stack[SP - 2], Stack[SP - 1])) { + v = + (numval(Stack[SP - 2]) < numval(Stack[SP - 1])) ? FL_T : FL_F; + } else { + v = (numval(fl_compare(Stack[SP - 2], Stack[SP - 1])) < 0) + ? FL_T + : FL_F; } POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_COMPARE) - Stack[SP-2] = compare_(Stack[SP-2], Stack[SP-1], 0); + OP(OP_COMPARE) + Stack[SP - 2] = compare_(Stack[SP - 2], Stack[SP - 1], 0); POPN(1); NEXT_OP; - OP(OP_VECTOR) + OP(OP_VECTOR) n = *ip++; apply_vector: v = alloc_vector(n, 0); if (n) { - memcpy(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t)); + memcpy(&vector_elt(v, 0), &Stack[SP - n], + n * sizeof(value_t)); POPN(n); } PUSH(v); NEXT_OP; - OP(OP_AREF) - v = Stack[SP-2]; + OP(OP_AREF) + v = Stack[SP - 2]; if (isvector(v)) { - e = Stack[SP-1]; + e = Stack[SP - 1]; if (isfixnum(e)) i = numval(e); else @@ -1522,100 +1592,109 @@ static value_t apply_cl(uint32_t nargs) if ((unsigned)i >= vector_size(v)) bounds_error("aref", v, e); v = vector_elt(v, i); - } - else if (isarray(v)) { - v = cvalue_array_aref(&Stack[SP-2]); - } - else { + } else if (isarray(v)) { + v = cvalue_array_aref(&Stack[SP - 2]); + } else { type_error("aref", "sequence", v); } POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_ASET) - e = Stack[SP-3]; + OP(OP_ASET) + e = Stack[SP - 3]; if (isvector(e)) { - i = tofixnum(Stack[SP-2], "aset!"); + i = tofixnum(Stack[SP - 2], "aset!"); if ((unsigned)i >= vector_size(e)) - bounds_error("aset!", v, Stack[SP-1]); - vector_elt(e, i) = (v=Stack[SP-1]); - } - else if (isarray(e)) { - v = cvalue_array_aset(&Stack[SP-3]); - } - else { + bounds_error("aset!", v, Stack[SP - 1]); + vector_elt(e, i) = (v = Stack[SP - 1]); + } else if (isarray(e)) { + v = cvalue_array_aset(&Stack[SP - 3]); + } else { type_error("aset!", "sequence", e); } POPN(2); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_FOR) - s = tofixnum(Stack[SP-3], "for"); - hi = tofixnum(Stack[SP-2], "for"); - //f = Stack[SP-1]; + OP(OP_FOR) + s = tofixnum(Stack[SP - 3], "for"); + hi = tofixnum(Stack[SP - 2], "for"); + // f = Stack[SP-1]; v = FL_UNSPECIFIED; SP += 2; n = SP; - for(; s <= hi; s++) { - Stack[SP-2] = Stack[SP-3]; - Stack[SP-1] = fixnum(s); + for (; s <= hi; s++) { + Stack[SP - 2] = Stack[SP - 3]; + Stack[SP - 1] = fixnum(s); v = apply_cl(1); SP = n; } POPN(4); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_LOADT) PUSH(FL_T); NEXT_OP; - OP(OP_LOADF) PUSH(FL_F); NEXT_OP; - OP(OP_LOADNIL) PUSH(NIL); NEXT_OP; - OP(OP_LOAD0) PUSH(fixnum(0)); NEXT_OP; - OP(OP_LOAD1) PUSH(fixnum(1)); NEXT_OP; - OP(OP_LOADI8) s = (int8_t)*ip++; PUSH(fixnum(s)); NEXT_OP; - OP(OP_LOADV) - v = fn_vals(Stack[bp-1]); + OP(OP_LOADT) PUSH(FL_T); + NEXT_OP; + OP(OP_LOADF) PUSH(FL_F); + NEXT_OP; + OP(OP_LOADNIL) PUSH(NIL); + NEXT_OP; + OP(OP_LOAD0) PUSH(fixnum(0)); + NEXT_OP; + OP(OP_LOAD1) PUSH(fixnum(1)); + NEXT_OP; + OP(OP_LOADI8) s = (int8_t)*ip++; + PUSH(fixnum(s)); + NEXT_OP; + OP(OP_LOADV) + v = fn_vals(Stack[bp - 1]); assert(*ip < vector_size(v)); - v = vector_elt(v, *ip); ip++; + v = vector_elt(v, *ip); + ip++; PUSH(v); NEXT_OP; - OP(OP_LOADVL) - v = fn_vals(Stack[bp-1]); - v = vector_elt(v, GET_INT32(ip)); ip+=4; + OP(OP_LOADVL) + v = fn_vals(Stack[bp - 1]); + v = vector_elt(v, GET_INT32(ip)); + ip += 4; PUSH(v); NEXT_OP; - OP(OP_LOADGL) - v = fn_vals(Stack[bp-1]); - v = vector_elt(v, GET_INT32(ip)); ip+=4; + OP(OP_LOADGL) + v = fn_vals(Stack[bp - 1]); + v = vector_elt(v, GET_INT32(ip)); + ip += 4; goto do_loadg; - OP(OP_LOADG) - v = fn_vals(Stack[bp-1]); + OP(OP_LOADG) + v = fn_vals(Stack[bp - 1]); assert(*ip < vector_size(v)); - v = vector_elt(v, *ip); ip++; + v = vector_elt(v, *ip); + ip++; do_loadg: assert(issymbol(v)); - sym = (symbol_t*)ptr(v); + sym = (symbol_t *)ptr(v); if (sym->binding == UNBOUND) fl_raise(fl_list2(UnboundError, v)); PUSH(sym->binding); NEXT_OP; - OP(OP_SETGL) - v = fn_vals(Stack[bp-1]); - v = vector_elt(v, GET_INT32(ip)); ip+=4; + OP(OP_SETGL) + v = fn_vals(Stack[bp - 1]); + v = vector_elt(v, GET_INT32(ip)); + ip += 4; goto do_setg; - OP(OP_SETG) - v = fn_vals(Stack[bp-1]); + OP(OP_SETG) + v = fn_vals(Stack[bp - 1]); assert(*ip < vector_size(v)); - v = vector_elt(v, *ip); ip++; + v = vector_elt(v, *ip); + ip++; do_setg: assert(issymbol(v)); - sym = (symbol_t*)ptr(v); - v = Stack[SP-1]; + sym = (symbol_t *)ptr(v); + v = Stack[SP - 1]; if (!isconstant(sym)) sym->binding = v; NEXT_OP; - OP(OP_LOADA) + OP(OP_LOADA) assert(nargs > 0); i = *ip++; if (captured) { @@ -1623,175 +1702,184 @@ static value_t apply_cl(uint32_t nargs) assert(isvector(e)); assert(i < vector_size(e)); v = vector_elt(e, i); - } - else { - v = Stack[bp+i]; + } else { + v = Stack[bp + i]; } PUSH(v); NEXT_OP; - OP(OP_LOADA0) + OP(OP_LOADA0) if (captured) v = vector_elt(Stack[bp], 0); else v = Stack[bp]; PUSH(v); NEXT_OP; - OP(OP_LOADA1) + OP(OP_LOADA1) if (captured) v = vector_elt(Stack[bp], 1); else - v = Stack[bp+1]; + v = Stack[bp + 1]; PUSH(v); NEXT_OP; - OP(OP_LOADAL) + OP(OP_LOADAL) assert(nargs > 0); - i = GET_INT32(ip); ip+=4; + i = GET_INT32(ip); + ip += 4; if (captured) v = vector_elt(Stack[bp], i); else - v = Stack[bp+i]; + v = Stack[bp + i]; PUSH(v); NEXT_OP; - OP(OP_SETA) + OP(OP_SETA) assert(nargs > 0); - v = Stack[SP-1]; + v = Stack[SP - 1]; i = *ip++; if (captured) { e = Stack[bp]; assert(isvector(e)); assert(i < vector_size(e)); vector_elt(e, i) = v; - } - else { - Stack[bp+i] = v; + } else { + Stack[bp + i] = v; } NEXT_OP; - OP(OP_SETAL) + OP(OP_SETAL) assert(nargs > 0); - v = Stack[SP-1]; - i = GET_INT32(ip); ip+=4; + v = Stack[SP - 1]; + i = GET_INT32(ip); + ip += 4; if (captured) vector_elt(Stack[bp], i) = v; else - Stack[bp+i] = v; + Stack[bp + i] = v; NEXT_OP; - OP(OP_LOADC) + OP(OP_LOADC) s = *ip++; i = *ip++; - v = Stack[bp+nargs]; + v = Stack[bp + nargs]; while (s--) - v = vector_elt(v, vector_size(v)-1); + v = vector_elt(v, vector_size(v) - 1); assert(isvector(v)); assert(i < vector_size(v)); PUSH(vector_elt(v, i)); NEXT_OP; - OP(OP_SETC) + OP(OP_SETC) s = *ip++; i = *ip++; - v = Stack[bp+nargs]; + v = Stack[bp + nargs]; while (s--) - v = vector_elt(v, vector_size(v)-1); + v = vector_elt(v, vector_size(v) - 1); assert(isvector(v)); assert(i < vector_size(v)); - vector_elt(v, i) = Stack[SP-1]; + vector_elt(v, i) = Stack[SP - 1]; NEXT_OP; - OP(OP_LOADC00) - PUSH(vector_elt(Stack[bp+nargs], 0)); + OP(OP_LOADC00) + PUSH(vector_elt(Stack[bp + nargs], 0)); NEXT_OP; - OP(OP_LOADC01) - PUSH(vector_elt(Stack[bp+nargs], 1)); + OP(OP_LOADC01) + PUSH(vector_elt(Stack[bp + nargs], 1)); NEXT_OP; - OP(OP_LOADCL) - s = GET_INT32(ip); ip+=4; - i = GET_INT32(ip); ip+=4; - v = Stack[bp+nargs]; + OP(OP_LOADCL) + s = GET_INT32(ip); + ip += 4; + i = GET_INT32(ip); + ip += 4; + v = Stack[bp + nargs]; while (s--) - v = vector_elt(v, vector_size(v)-1); + v = vector_elt(v, vector_size(v) - 1); PUSH(vector_elt(v, i)); NEXT_OP; - OP(OP_SETCL) - s = GET_INT32(ip); ip+=4; - i = GET_INT32(ip); ip+=4; - v = Stack[bp+nargs]; + OP(OP_SETCL) + s = GET_INT32(ip); + ip += 4; + i = GET_INT32(ip); + ip += 4; + v = Stack[bp + nargs]; while (s--) - v = vector_elt(v, vector_size(v)-1); + v = vector_elt(v, vector_size(v) - 1); assert(i < vector_size(v)); - vector_elt(v, i) = Stack[SP-1]; + vector_elt(v, i) = Stack[SP - 1]; NEXT_OP; - OP(OP_CLOSURE) + OP(OP_CLOSURE) // build a closure (lambda args body . env) if (nargs > 0 && !captured) { // save temporary environment to the heap n = nargs; pv = alloc_words(n + 2); PUSH(tagptr(pv, TAG_VECTOR)); - pv[0] = fixnum(n+1); + pv[0] = fixnum(n + 1); pv++; do { - pv[n] = Stack[bp+n]; + pv[n] = Stack[bp + n]; } while (n--); // environment representation changed; install // the new representation so everybody can see it captured = 1; - Stack[curr_frame-1] = 1; - Stack[bp] = Stack[SP-1]; + Stack[curr_frame - 1] = 1; + Stack[bp] = Stack[SP - 1]; + } else { + PUSH(Stack[bp]); // env has already been captured; share } - else { - PUSH(Stack[bp]); // env has already been captured; share - } - if (curheap > lim-2) + if (curheap > lim - 2) gc(0); - pv = (value_t*)curheap; - curheap += (4*sizeof(value_t)); - e = Stack[SP-2]; // closure to copy + pv = (value_t *)curheap; + curheap += (4 * sizeof(value_t)); + e = Stack[SP - 2]; // closure to copy assert(isfunction(e)); - pv[0] = ((value_t*)ptr(e))[0]; - pv[1] = ((value_t*)ptr(e))[1]; - pv[2] = Stack[SP-1]; // env - pv[3] = ((value_t*)ptr(e))[3]; + pv[0] = ((value_t *)ptr(e))[0]; + pv[1] = ((value_t *)ptr(e))[1]; + pv[2] = Stack[SP - 1]; // env + pv[3] = ((value_t *)ptr(e))[3]; POPN(1); - Stack[SP-1] = tagptr(pv, TAG_FUNCTION); + Stack[SP - 1] = tagptr(pv, TAG_FUNCTION); NEXT_OP; - OP(OP_TRYCATCH) + OP(OP_TRYCATCH) v = do_trycatch(); POPN(1); - Stack[SP-1] = v; + Stack[SP - 1] = v; NEXT_OP; - OP(OP_OPTARGS) - i = GET_INT32(ip); ip+=4; - n = GET_INT32(ip); ip+=4; + OP(OP_OPTARGS) + i = GET_INT32(ip); + ip += 4; + n = GET_INT32(ip); + ip += 4; if (nargs < i) lerror(ArgError, "apply: too few arguments"); if ((int32_t)n > 0) { if (nargs > n) lerror(ArgError, "apply: too many arguments"); - } - else n = -n; + } else + n = -n; if (n > nargs) { n -= nargs; SP += n; - Stack[SP-1] = Stack[SP-n-1]; - Stack[SP-2] = Stack[SP-n-2]; - Stack[SP-3] = nargs+n; - Stack[SP-4] = Stack[SP-n-4]; - Stack[SP-5] = Stack[SP-n-5]; + Stack[SP - 1] = Stack[SP - n - 1]; + Stack[SP - 2] = Stack[SP - n - 2]; + Stack[SP - 3] = nargs + n; + Stack[SP - 4] = Stack[SP - n - 4]; + Stack[SP - 5] = Stack[SP - n - 5]; curr_frame = SP; - for(i=0; i < n; i++) { - Stack[bp+nargs+i] = UNBOUND; + for (i = 0; i < n; i++) { + Stack[bp + nargs + i] = UNBOUND; } nargs += n; } NEXT_OP; - OP(OP_KEYARGS) - v = fn_vals(Stack[bp-1]); + OP(OP_KEYARGS) + v = fn_vals(Stack[bp - 1]); v = vector_elt(v, 0); - i = GET_INT32(ip); ip+=4; - n = GET_INT32(ip); ip+=4; - s = GET_INT32(ip); ip+=4; - nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0); + i = GET_INT32(ip); + ip += 4; + n = GET_INT32(ip); + ip += 4; + s = GET_INT32(ip); + ip += 4; + nargs = + process_keys(v, i, n, labs(s) - (i + n), bp, nargs, s < 0); NEXT_OP; #ifndef USE_COMPUTED_GOTO @@ -1809,13 +1897,15 @@ static value_t apply_cl(uint32_t nargs) static uint32_t compute_maxstack(uint8_t *code, size_t len, int bswap) { - uint8_t *ip = code+4, *end = code+len; + uint8_t *ip = code + 4, *end = code + len; uint8_t op; uint32_t i, n, sp = 0, maxsp = 0; while (1) { - if ((int32_t)sp > (int32_t)maxsp) maxsp = sp; - if (ip >= end) break; + if ((int32_t)sp > (int32_t)maxsp) + maxsp = sp; + if (ip >= end) + break; op = *ip++; switch (op) { case OP_ARGC: @@ -1823,161 +1913,250 @@ static uint32_t compute_maxstack(uint8_t *code, size_t len, int bswap) break; case OP_VARGC: n = *ip++; - sp += (n+2); + sp += (n + 2); break; case OP_LARGC: - if (bswap) SWAP_INT32(ip); - n = GET_INT32(ip); ip+=4; + if (bswap) + SWAP_INT32(ip); + n = GET_INT32(ip); + ip += 4; break; case OP_LVARGC: - if (bswap) SWAP_INT32(ip); - n = GET_INT32(ip); ip+=4; - sp += (n+2); + if (bswap) + SWAP_INT32(ip); + n = GET_INT32(ip); + ip += 4; + sp += (n + 2); break; case OP_OPTARGS: - if (bswap) SWAP_INT32(ip); - i = GET_INT32(ip); ip+=4; - if (bswap) SWAP_INT32(ip); - n = abs(GET_INT32(ip)); ip+=4; - sp += (n-i); + if (bswap) + SWAP_INT32(ip); + i = GET_INT32(ip); + ip += 4; + if (bswap) + SWAP_INT32(ip); + n = abs(GET_INT32(ip)); + ip += 4; + sp += (n - i); break; case OP_KEYARGS: - if (bswap) SWAP_INT32(ip); - i = GET_INT32(ip); ip+=4; - if (bswap) SWAP_INT32(ip); - n = GET_INT32(ip); ip+=4; - if (bswap) SWAP_INT32(ip); - n = abs(GET_INT32(ip)); ip+=4; - sp += (n-i); + if (bswap) + SWAP_INT32(ip); + i = GET_INT32(ip); + ip += 4; + if (bswap) + SWAP_INT32(ip); + n = GET_INT32(ip); + ip += 4; + if (bswap) + SWAP_INT32(ip); + n = abs(GET_INT32(ip)); + ip += 4; + sp += (n - i); break; case OP_BRBOUND: - if (bswap) SWAP_INT32(ip); - ip+=4; + if (bswap) + SWAP_INT32(ip); + ip += 4; sp++; break; - case OP_TCALL: case OP_CALL: + case OP_TCALL: + case OP_CALL: n = *ip++; // nargs sp -= n; break; - case OP_TCALLL: case OP_CALLL: - if (bswap) SWAP_INT32(ip); - n = GET_INT32(ip); ip+=4; + case OP_TCALLL: + case OP_CALLL: + if (bswap) + SWAP_INT32(ip); + n = GET_INT32(ip); + ip += 4; sp -= n; break; case OP_JMP: - if (bswap) SWAP_INT16(ip); - ip += 2; break; + if (bswap) + SWAP_INT16(ip); + ip += 2; + break; case OP_JMPL: - if (bswap) SWAP_INT32(ip); - ip += 4; break; - case OP_BRF: case OP_BRT: - if (bswap) SWAP_INT16(ip); - ip+=2; + if (bswap) + SWAP_INT32(ip); + ip += 4; + break; + case OP_BRF: + case OP_BRT: + if (bswap) + SWAP_INT16(ip); + ip += 2; sp--; break; - case OP_BRFL: case OP_BRTL: - if (bswap) SWAP_INT32(ip); + case OP_BRFL: + case OP_BRTL: + if (bswap) + SWAP_INT32(ip); ip += 4; sp--; break; case OP_BRNE: - if (bswap) SWAP_INT16(ip); + if (bswap) + SWAP_INT16(ip); ip += 2; sp -= 2; break; case OP_BRNEL: - if (bswap) SWAP_INT32(ip); + if (bswap) + SWAP_INT32(ip); ip += 4; sp -= 2; break; - case OP_BRNN: case OP_BRN: - if (bswap) SWAP_INT16(ip); + case OP_BRNN: + case OP_BRN: + if (bswap) + SWAP_INT16(ip); ip += 2; sp--; break; - case OP_BRNNL: case OP_BRNL: - if (bswap) SWAP_INT32(ip); + case OP_BRNNL: + case OP_BRNL: + if (bswap) + SWAP_INT32(ip); ip += 4; sp--; break; - case OP_RET: sp--; break; - - case OP_CONS: case OP_SETCAR: case OP_SETCDR: case OP_POP: - case OP_EQ: case OP_EQV: case OP_EQUAL: case OP_ADD2: case OP_SUB2: - case OP_IDIV: case OP_NUMEQ: case OP_LT: case OP_COMPARE: - case OP_AREF: case OP_TRYCATCH: + case OP_RET: sp--; break; - case OP_PAIRP: case OP_ATOMP: case OP_NOT: case OP_NULLP: - case OP_BOOLEANP: case OP_SYMBOLP: case OP_NUMBERP: case OP_FIXNUMP: - case OP_BOUNDP: case OP_BUILTINP: case OP_FUNCTIONP: case OP_VECTORP: - case OP_NOP: case OP_CAR: case OP_CDR: case OP_NEG: case OP_CLOSURE: + case OP_CONS: + case OP_SETCAR: + case OP_SETCDR: + case OP_POP: + case OP_EQ: + case OP_EQV: + case OP_EQUAL: + case OP_ADD2: + case OP_SUB2: + case OP_IDIV: + case OP_NUMEQ: + case OP_LT: + case OP_COMPARE: + case OP_AREF: + case OP_TRYCATCH: + sp--; break; - case OP_TAPPLY: case OP_APPLY: + case OP_PAIRP: + case OP_ATOMP: + case OP_NOT: + case OP_NULLP: + case OP_BOOLEANP: + case OP_SYMBOLP: + case OP_NUMBERP: + case OP_FIXNUMP: + case OP_BOUNDP: + case OP_BUILTINP: + case OP_FUNCTIONP: + case OP_VECTORP: + case OP_NOP: + case OP_CAR: + case OP_CDR: + case OP_NEG: + case OP_CLOSURE: + break; + + case OP_TAPPLY: + case OP_APPLY: n = *ip++; - sp -= (n-1); + sp -= (n - 1); break; - case OP_LIST: case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV: + case OP_LIST: + case OP_ADD: + case OP_SUB: + case OP_MUL: + case OP_DIV: case OP_VECTOR: n = *ip++; - sp -= (n-1); + sp -= (n - 1); break; case OP_ASET: sp -= 2; break; case OP_FOR: - if (sp+2 > maxsp) maxsp = sp+2; - sp -=2; + if (sp + 2 > maxsp) + maxsp = sp + 2; + sp -= 2; break; - case OP_LOADT: case OP_LOADF: case OP_LOADNIL: case OP_LOAD0: - case OP_LOAD1: case OP_LOADA0: case OP_LOADA1: case OP_LOADC00: - case OP_LOADC01: case OP_DUP: + case OP_LOADT: + case OP_LOADF: + case OP_LOADNIL: + case OP_LOAD0: + case OP_LOAD1: + case OP_LOADA0: + case OP_LOADA1: + case OP_LOADC00: + case OP_LOADC01: + case OP_DUP: sp++; break; - case OP_LOADI8: case OP_LOADV: case OP_LOADG: case OP_LOADA: + case OP_LOADI8: + case OP_LOADV: + case OP_LOADG: + case OP_LOADA: ip++; sp++; break; - case OP_LOADVL: case OP_LOADGL: case OP_LOADAL: - if (bswap) SWAP_INT32(ip); - ip+=4; + case OP_LOADVL: + case OP_LOADGL: + case OP_LOADAL: + if (bswap) + SWAP_INT32(ip); + ip += 4; sp++; break; - case OP_SETG: case OP_SETA: + case OP_SETG: + case OP_SETA: ip++; break; - case OP_SETGL: case OP_SETAL: - if (bswap) SWAP_INT32(ip); - ip+=4; + case OP_SETGL: + case OP_SETAL: + if (bswap) + SWAP_INT32(ip); + ip += 4; break; - case OP_LOADC: ip+=2; sp++; break; + case OP_LOADC: + ip += 2; + sp++; + break; case OP_SETC: - ip+=2; + ip += 2; break; case OP_LOADCL: - if (bswap) SWAP_INT32(ip); - ip+=4; - if (bswap) SWAP_INT32(ip); - ip+=4; - sp++; break; + if (bswap) + SWAP_INT32(ip); + ip += 4; + if (bswap) + SWAP_INT32(ip); + ip += 4; + sp++; + break; case OP_SETCL: - if (bswap) SWAP_INT32(ip); - ip+=4; - if (bswap) SWAP_INT32(ip); - ip+=4; + if (bswap) + SWAP_INT32(ip); + ip += 4; + if (bswap) + SWAP_INT32(ip); + ip += 4; break; } } - return maxsp+5; + return maxsp + 5; } // top = top frame pointer to start at @@ -1987,31 +2166,31 @@ static value_t _stacktrace(uint32_t top) value_t v, lst = NIL; fl_gc_handle(&lst); while (top > 0) { - sz = Stack[top-3]+1; - bp = top-5-sz; + sz = Stack[top - 3] + 1; + bp = top - 5 - sz; v = alloc_vector(sz, 0); - if (Stack[top-1] /*captured*/) { + if (Stack[top - 1] /*captured*/) { vector_elt(v, 0) = Stack[bp]; - memcpy(&vector_elt(v, 1), - &vector_elt(Stack[bp+1],0), (sz-1)*sizeof(value_t)); - } - else { + memcpy(&vector_elt(v, 1), &vector_elt(Stack[bp + 1], 0), + (sz - 1) * sizeof(value_t)); + } else { uint32_t i; - for(i=0; i < sz; i++) { - value_t si = Stack[bp+i]; + for (i = 0; i < sz; i++) { + value_t si = Stack[bp + i]; // if there's an error evaluating argument defaults some slots // might be left set to UNBOUND (issue #22) - vector_elt(v,i) = (si == UNBOUND ? FL_UNSPECIFIED : si); + vector_elt(v, i) = (si == UNBOUND ? FL_UNSPECIFIED : si); } } lst = fl_cons(v, lst); - top = Stack[top-4]; + top = Stack[top - 4]; } fl_free_gc_handles(1); return lst; } -// builtins ------------------------------------------------------------------- +// builtins +// ------------------------------------------------------------------- void assign_global_builtins(builtinspec_t *b) { @@ -2031,24 +2210,23 @@ static value_t fl_function(value_t *args, uint32_t nargs) type_error("function", "string", args[0]); if (!isvector(args[1])) type_error("function", "vector", args[1]); - cvalue_t *arr = (cvalue_t*)ptr(args[0]); + cvalue_t *arr = (cvalue_t *)ptr(args[0]); cv_pin(arr); char *data = cv_data(arr); int swap = 0; if ((uint8_t)data[4] >= N_OPCODES) { // read syntax, shifted 48 for compact text representation size_t i, sz = cv_len(arr); - for(i=0; i < sz; i++) + for (i = 0; i < sz; i++) data[i] -= 48; - } - else { + } else { #if BYTE_ORDER == BIG_ENDIAN swap = 1; #endif } - uint32_t ms = compute_maxstack((uint8_t*)data, cv_len(arr), swap); + uint32_t ms = compute_maxstack((uint8_t *)data, cv_len(arr), swap); PUT_INT32(data, ms); - function_t *fn = (function_t*)alloc_words(4); + function_t *fn = (function_t *)alloc_words(4); value_t fv = tagptr(fn, TAG_FUNCTION); fn->bcode = args[0]; fn->vals = args[1]; @@ -2059,8 +2237,7 @@ static value_t fl_function(value_t *args, uint32_t nargs) fn->name = args[2]; if (nargs > 3) fn->env = args[3]; - } - else { + } else { fn->env = args[2]; if (nargs > 3) { if (!issymbol(args[3])) @@ -2078,28 +2255,32 @@ static value_t fl_function_code(value_t *args, uint32_t nargs) { argcount("function:code", nargs, 1); value_t v = args[0]; - if (!isclosure(v)) type_error("function:code", "function", v); + if (!isclosure(v)) + type_error("function:code", "function", v); return fn_bcode(v); } static value_t fl_function_vals(value_t *args, uint32_t nargs) { argcount("function:vals", nargs, 1); value_t v = args[0]; - if (!isclosure(v)) type_error("function:vals", "function", v); + if (!isclosure(v)) + type_error("function:vals", "function", v); return fn_vals(v); } static value_t fl_function_env(value_t *args, uint32_t nargs) { argcount("function:env", nargs, 1); value_t v = args[0]; - if (!isclosure(v)) type_error("function:env", "function", v); + if (!isclosure(v)) + type_error("function:env", "function", v); return fn_env(v); } static value_t fl_function_name(value_t *args, uint32_t nargs) { argcount("function:name", nargs, 1); value_t v = args[0]; - if (!isclosure(v)) type_error("function:name", "function", v); + if (!isclosure(v)) + type_error("function:name", "function", v); return fn_name(v); } @@ -2113,22 +2294,22 @@ value_t fl_append(value_t *args, u_int32_t nargs) { if (nargs == 0) return NIL; - value_t first=NIL, lst, lastcons=NIL; + value_t first = NIL, lst, lastcons = NIL; fl_gc_handle(&first); fl_gc_handle(&lastcons); - uint32_t i=0; + uint32_t i = 0; while (1) { lst = args[i++]; - if (i >= nargs) break; + if (i >= nargs) + break; if (iscons(lst)) { lst = copy_list(lst); if (first == NIL) first = lst; else cdr_(lastcons) = lst; - lastcons = tagptr((((cons_t*)curheap)-1), TAG_CONS); - } - else if (lst != NIL) { + lastcons = tagptr((((cons_t *)curheap) - 1), TAG_CONS); + } else if (lst != NIL) { type_error("append", "cons", lst); } } @@ -2142,8 +2323,10 @@ value_t fl_append(value_t *args, u_int32_t nargs) value_t fl_liststar(value_t *args, u_int32_t nargs) { - if (nargs == 1) return args[0]; - else if (nargs == 0) argcount("list*", nargs, 1); + if (nargs == 1) + return args[0]; + else if (nargs == 0) + argcount("list*", nargs, 1); return _list(args, nargs, 1); } @@ -2158,63 +2341,69 @@ value_t fl_map1(value_t *args, u_int32_t nargs) { if (nargs < 2) lerror(ArgError, "map: too few arguments"); - if (!iscons(args[1])) return NIL; + if (!iscons(args[1])) + return NIL; value_t first, last, v; - int64_t argSP = args-Stack; + int64_t argSP = args - Stack; assert(argSP >= 0 && argSP < N_STACK); if (nargs == 2) { - if (SP+3 > N_STACK) grow_stack(); + if (SP + 3 > N_STACK) + grow_stack(); PUSH(Stack[argSP]); - PUSH(car_(Stack[argSP+1])); + PUSH(car_(Stack[argSP + 1])); v = _applyn(1); PUSH(v); v = mk_cons(); - car_(v) = POP(); cdr_(v) = NIL; + car_(v) = POP(); + cdr_(v) = NIL; last = first = v; - Stack[argSP+1] = cdr_(Stack[argSP+1]); + Stack[argSP + 1] = cdr_(Stack[argSP + 1]); fl_gc_handle(&first); fl_gc_handle(&last); - while (iscons(Stack[argSP+1])) { - Stack[SP-2] = Stack[argSP]; - Stack[SP-1] = car_(Stack[argSP+1]); + while (iscons(Stack[argSP + 1])) { + Stack[SP - 2] = Stack[argSP]; + Stack[SP - 1] = car_(Stack[argSP + 1]); v = _applyn(1); PUSH(v); v = mk_cons(); - car_(v) = POP(); cdr_(v) = NIL; + car_(v) = POP(); + cdr_(v) = NIL; cdr_(last) = v; last = v; - Stack[argSP+1] = cdr_(Stack[argSP+1]); + Stack[argSP + 1] = cdr_(Stack[argSP + 1]); } POPN(2); fl_free_gc_handles(2); - } - else { + } else { size_t i; - while (SP+nargs+1 > N_STACK) grow_stack(); + while (SP + nargs + 1 > N_STACK) + grow_stack(); PUSH(Stack[argSP]); - for(i=1; i < nargs; i++) { - PUSH(car(Stack[argSP+i])); - Stack[argSP+i] = cdr_(Stack[argSP+i]); + for (i = 1; i < nargs; i++) { + PUSH(car(Stack[argSP + i])); + Stack[argSP + i] = cdr_(Stack[argSP + i]); } - v = _applyn(nargs-1); + v = _applyn(nargs - 1); POPN(nargs); PUSH(v); v = mk_cons(); - car_(v) = POP(); cdr_(v) = NIL; + car_(v) = POP(); + cdr_(v) = NIL; last = first = v; fl_gc_handle(&first); fl_gc_handle(&last); - while (iscons(Stack[argSP+1])) { + while (iscons(Stack[argSP + 1])) { PUSH(Stack[argSP]); - for(i=1; i < nargs; i++) { - PUSH(car(Stack[argSP+i])); - Stack[argSP+i] = cdr_(Stack[argSP+i]); + for (i = 1; i < nargs; i++) { + PUSH(car(Stack[argSP + i])); + Stack[argSP + i] = cdr_(Stack[argSP + i]); } - v = _applyn(nargs-1); + v = _applyn(nargs - 1); POPN(nargs); PUSH(v); v = mk_cons(); - car_(v) = POP(); cdr_(v) = NIL; + car_(v) = POP(); + cdr_(v) = NIL; cdr_(last) = v; last = v; } @@ -2240,7 +2429,8 @@ static builtinspec_t core_builtin_info[] = { { NULL, NULL } }; -// initialization ------------------------------------------------------------- +// initialization +// ------------------------------------------------------------- extern void builtins_init(void); extern void comparehash_init(void); @@ -2255,55 +2445,77 @@ static void lisp_init(size_t initial_heapsize) heapsize = initial_heapsize; fromspace = LLT_ALLOC(heapsize); - tospace = LLT_ALLOC(heapsize); + tospace = LLT_ALLOC(heapsize); curheap = fromspace; - lim = curheap+heapsize-sizeof(cons_t); - consflags = bitvector_new(heapsize/sizeof(cons_t), 1); + lim = curheap + heapsize - sizeof(cons_t); + consflags = bitvector_new(heapsize / sizeof(cons_t), 1); htable_new(&printconses, 32); comparehash_init(); N_STACK = 262144; - Stack = malloc(N_STACK*sizeof(value_t)); + Stack = malloc(N_STACK * sizeof(value_t)); FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST); FL_T = builtin(OP_BOOL_CONST_T); FL_F = builtin(OP_BOOL_CONST_F); FL_EOF = builtin(OP_EOF_OBJECT); - LAMBDA = symbol("lambda"); FUNCTION = symbol("function"); - QUOTE = symbol("quote"); TRYCATCH = symbol("trycatch"); - BACKQUOTE = symbol("quasiquote"); COMMA = symbol("unquote"); - COMMAAT = symbol("unquote-splicing"); COMMADOT = symbol("unquote-nsplicing"); - IOError = symbol("io-error"); ParseError = symbol("parse-error"); - TypeError = symbol("type-error"); ArgError = symbol("arg-error"); + LAMBDA = symbol("lambda"); + FUNCTION = symbol("function"); + QUOTE = symbol("quote"); + TRYCATCH = symbol("trycatch"); + BACKQUOTE = symbol("quasiquote"); + COMMA = symbol("unquote"); + COMMAAT = symbol("unquote-splicing"); + COMMADOT = symbol("unquote-nsplicing"); + IOError = symbol("io-error"); + ParseError = symbol("parse-error"); + TypeError = symbol("type-error"); + ArgError = symbol("arg-error"); UnboundError = symbol("unbound-error"); - KeyError = symbol("key-error"); MemoryError = symbol("memory-error"); + KeyError = symbol("key-error"); + MemoryError = symbol("memory-error"); BoundsError = symbol("bounds-error"); DivideError = symbol("divide-error"); EnumerationError = symbol("enumeration-error"); - Error = symbol("error"); pairsym = symbol("pair"); - symbolsym = symbol("symbol"); fixnumsym = symbol("fixnum"); - vectorsym = symbol("vector"); builtinsym = symbol("builtin"); - booleansym = symbol("boolean"); nullsym = symbol("null"); - definesym = symbol("define"); defmacrosym = symbol("define-macro"); + Error = symbol("error"); + pairsym = symbol("pair"); + symbolsym = symbol("symbol"); + fixnumsym = symbol("fixnum"); + vectorsym = symbol("vector"); + builtinsym = symbol("builtin"); + booleansym = symbol("boolean"); + nullsym = symbol("null"); + definesym = symbol("define"); + defmacrosym = symbol("define-macro"); forsym = symbol("for"); - setqsym = symbol("set!"); evalsym = symbol("eval"); - vu8sym = symbol("vu8"); fnsym = symbol("fn"); - nulsym = symbol("nul"); alarmsym = symbol("alarm"); - backspacesym = symbol("backspace"); tabsym = symbol("tab"); - linefeedsym = symbol("linefeed"); vtabsym = symbol("vtab"); - pagesym = symbol("page"); returnsym = symbol("return"); - escsym = symbol("esc"); spacesym = symbol("space"); - deletesym = symbol("delete"); newlinesym = symbol("newline"); - tsym = symbol("t"); Tsym = symbol("T"); - fsym = symbol("f"); Fsym = symbol("F"); - set(printprettysym=symbol("*print-pretty*"), FL_T); - set(printreadablysym=symbol("*print-readably*"), FL_T); - set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH)); - set(printlengthsym=symbol("*print-length*"), FL_F); - set(printlevelsym=symbol("*print-level*"), FL_F); + setqsym = symbol("set!"); + evalsym = symbol("eval"); + vu8sym = symbol("vu8"); + fnsym = symbol("fn"); + nulsym = symbol("nul"); + alarmsym = symbol("alarm"); + backspacesym = symbol("backspace"); + tabsym = symbol("tab"); + linefeedsym = symbol("linefeed"); + vtabsym = symbol("vtab"); + pagesym = symbol("page"); + returnsym = symbol("return"); + escsym = symbol("esc"); + spacesym = symbol("space"); + deletesym = symbol("delete"); + newlinesym = symbol("newline"); + tsym = symbol("t"); + Tsym = symbol("T"); + fsym = symbol("f"); + Fsym = symbol("F"); + set(printprettysym = symbol("*print-pretty*"), FL_T); + set(printreadablysym = symbol("*print-readably*"), FL_T); + set(printwidthsym = symbol("*print-width*"), fixnum(SCR_WIDTH)); + set(printlengthsym = symbol("*print-length*"), FL_F); + set(printlevelsym = symbol("*print-level*"), FL_F); builtins_table_sym = symbol("*builtins*"); fl_lasterror = NIL; i = 0; - for (i=OP_EQ; i <= OP_ASET; i++) { + for (i = OP_EQ; i <= OP_ASET; i++) { setc(symbol(builtin_names[i]), builtin(i)); } setc(symbol("eq"), builtin(OP_EQ)); @@ -2336,15 +2548,16 @@ static void lisp_init(size_t initial_heapsize) setc(symbol("*install-dir*"), cvalue_static_cstring(strdup(exename))); } - memory_exception_value = fl_list2(MemoryError, - cvalue_static_cstring("out of memory")); + memory_exception_value = + fl_list2(MemoryError, cvalue_static_cstring("out of memory")); assign_global_builtins(core_builtin_info); builtins_init(); } -// top level ------------------------------------------------------------------ +// top level +// ------------------------------------------------------------------ value_t fl_toplevel_eval(value_t expr) { @@ -2367,17 +2580,18 @@ int fl_load_system_image(value_t sys_image_iostream) PUSH(sys_image_iostream); saveSP = SP; - FL_TRY { + FL_TRY + { while (1) { - e = fl_read_sexpr(Stack[SP-1]); - if (ios_eof(value2c(ios_t*,Stack[SP-1]))) break; + e = fl_read_sexpr(Stack[SP - 1]); + if (ios_eof(value2c(ios_t *, Stack[SP - 1]))) + break; if (isfunction(e)) { // stage 0 format: series of thunks PUSH(e); (void)_applyn(0); SP = saveSP; - } - else { + } else { // stage 1 format: list alternating symbol/value while (iscons(e)) { sym = tosymbol(car_(e), "bootstrap"); @@ -2390,13 +2604,14 @@ int fl_load_system_image(value_t sys_image_iostream) } } } - FL_CATCH { + FL_CATCH + { ios_puts("fatal error during bootstrap:\n", ios_stderr); fl_print(ios_stderr, fl_lasterror); ios_putc('\n', ios_stderr); return 1; } - ios_close(value2c(ios_t*,Stack[SP-1])); + ios_close(value2c(ios_t *, Stack[SP - 1])); POPN(1); return 0; } diff --git a/flisp.h b/flisp.h index 8c069b3..7eed78d 100644 --- a/flisp.h +++ b/flisp.h @@ -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)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, nargstype & 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; diff --git a/flmain.c b/flmain.c index 50c650b..4bd8f2a 100644 --- a/flmain.c +++ b/flmain.c @@ -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); diff --git a/iostream.c b/iostream.c index 9f0d3f8..ce4846f 100644 --- a/iostream.c +++ b/iostream.c @@ -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)); } diff --git a/llt/bitvector-ops.c b/llt/bitvector-ops.c index e3afef3..5f50315 100644 --- a/llt/bitvector-ops.c +++ b/llt/bitvector-ops.c @@ -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]<>(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]<>(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)<>5; + if (nbits == 0) + return; + nw = (offs + nbits + 31) >> 5; if (nw == 1) { - mask = (lomask(nbits)<>5; \ + if (nbits == 0) \ + return; \ + nw = (doffs + nbits + 31) >> 5; \ \ - if (soffs == doffs) { \ - if (nw == 1) { \ - mask = (lomask(nbits)<>5; \ - if (soffs < doffs) { \ - s = doffs-soffs; \ - if (nw == 1) { \ - mask = (lomask(nbits)<>(32-s); \ - for(i=1; i < snw-1; i++) { \ - dest[i] = (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])<> 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) & mask); \ + return; \ } \ - else { \ - dest[i] = (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)<>s) & mask); \ - return; \ - } \ - if (nw == 1) { \ - mask = (lomask(nbits)<>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); // 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)<>5; + if (nbits == 0) + return 0; + nw = (offs + nbits + 31) >> 5; if (nw == 1) { - mask = (lomask(nbits)< 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) diff --git a/llt/bitvector.c b/llt/bitvector.c index 11c3e9f..46f9177 100644 --- a/llt/bitvector.c +++ b/llt/bitvector.c @@ -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); } diff --git a/llt/bitvector.h b/llt/bitvector.h index cd1d713..d220ddd 100644 --- a/llt/bitvector.h +++ b/llt/bitvector.h @@ -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); diff --git a/llt/dirpath.c b/llt/dirpath.c index 52172ee..8d47f86 100644 --- a/llt/dirpath.c +++ b/llt/dirpath.c @@ -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 diff --git a/llt/dirpath.h b/llt/dirpath.h index 6f661c0..5eddf50 100644 --- a/llt/dirpath.h +++ b/llt/dirpath.h @@ -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); diff --git a/llt/dtypes.h b/llt/dtypes.h index 1bab667..45d1ff5 100644 --- a/llt/dtypes.h +++ b/llt/dtypes.h @@ -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 -# include -# define LITTLE_ENDIAN __LITTLE_ENDIAN -# define BIG_ENDIAN __BIG_ENDIAN -# define PDP_ENDIAN __PDP_ENDIAN -# define BYTE_ORDER __BYTE_ORDER +#include +#include +#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 -# define __LITTLE_ENDIAN LITTLE_ENDIAN -# define __BIG_ENDIAN BIG_ENDIAN -# define __PDP_ENDIAN PDP_ENDIAN -# define __BYTE_ORDER BYTE_ORDER +#include +#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 #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 diff --git a/llt/dump.c b/llt/dump.c index 27e8524..b6056b8 100644 --- a/llt/dump.c +++ b/llt/dump.c @@ -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); diff --git a/llt/hashing.c b/llt/hashing.c index f0a712a..c015852 100644 --- a/llt/hashing.c +++ b/llt/hashing.c @@ -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; diff --git a/llt/hashing.h b/llt/hashing.h index 9784241..9891ba9 100644 --- a/llt/hashing.h +++ b/llt/hashing.h @@ -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 diff --git a/llt/htable.c b/llt/htable.c index 2857ade..b13010f 100644 --- a/llt/htable.c +++ b/llt/htable.c @@ -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; } diff --git a/llt/htable.h b/llt/htable.h index 3c1e5c9..6796816 100644 --- a/llt/htable.h +++ b/llt/htable.h @@ -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); diff --git a/llt/ieee754.h b/llt/ieee754.h index 5f9ca37..de5a013 100644 --- a/llt/ieee754.h +++ b/llt/ieee754.h @@ -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; }; diff --git a/llt/int2str.c b/llt/int2str.c index 9a8084e..3a4c1a7 100644 --- a/llt/int2str.c +++ b/llt/int2str.c @@ -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 */ diff --git a/llt/ios.c b/llt/ios.c index 1084654..48a8579 100644 --- a/llt/ios.c +++ b/llt/ios.c @@ -5,7 +5,7 @@ #include #include #include -#include // for printf +#include // 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); diff --git a/llt/ios.h b/llt/ios.h index b2b6045..74a9517 100644 --- a/llt/ios.h +++ b/llt/ios.h @@ -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)) /* diff --git a/llt/lltinit.c b/llt/lltinit.c index ea534d6..c623f49 100644 --- a/llt/lltinit.c +++ b/llt/lltinit.c @@ -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); } diff --git a/llt/lookup3.c b/llt/lookup3.c index 32c3876..24e1019 100644 --- a/llt/lookup3.c +++ b/llt/lookup3.c @@ -3,8 +3,8 @@ lookup3.c, by Bob Jenkins, May 2006, Public Domain. These are functions for producing 32-bit hashes for hash table lookup. -hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() -are externally useful functions. Routines to test the hash are included +hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions. Routines to test the hash are included if SELF_TEST is defined. You can use this free for any purpose. It's in the public domain. It has no warranty. @@ -12,7 +12,7 @@ You probably want to use hashlittle(). hashlittle() and hashbig() hash byte arrays. hashlittle() is is faster than hashbig() on little-endian machines. Intel and AMD are little-endian machines. On second thought, you probably want hashlittle2(), which is identical to -hashlittle() except it returns two 32-bit hashes for the price of one. +hashlittle() except it returns two 32-bit hashes for the price of one. You could implement hashbig2() if you wanted but I haven't bothered here. If you want to find a hash of, say, exactly 7 integers, do @@ -25,9 +25,9 @@ If you want to find a hash of, say, exactly 7 integers, do then use c as the hash value. If you have a variable length array of 4-byte integers to hash, use hashword(). If you have a byte array (like a character string), use hashlittle(). If you have several byte arrays, or -a mix of things, see the comments above hashlittle(). +a mix of things, see the comments above hashlittle(). -Why is this so big? I read 12 bytes at a time into 3 4-byte integers, +Why is this so big? I read 12 bytes at a time into 3 4-byte integers, then mix those integers. This is fast (you can do a lot more thorough mixing with 12*3 instructions on 3 integers than you can with 3 instructions on 1 byte), but shoehorning those bytes into integers efficiently is messy. @@ -35,43 +35,43 @@ on 1 byte), but shoehorning those bytes into integers efficiently is messy. */ //#define SELF_TEST 1 -#include /* defines printf for tests */ -#include /* defines time_t for timings in the test */ +#include /* defines printf for tests */ +#include /* defines time_t for timings in the test */ #ifndef WIN32 -#include /* defines uint32_t etc */ -#include /* attempt to define endianness */ +#include /* defines uint32_t etc */ +#include /* attempt to define endianness */ #else typedef unsigned int uint32_t; typedef unsigned char uint8_t; typedef unsigned short uint16_t; #endif #ifdef LINUX -# include /* attempt to define endianness */ +#include /* attempt to define endianness */ #endif /* * My best guess at if you are big-endian or little-endian. This may * need adjustment. */ -#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \ - __BYTE_ORDER == __LITTLE_ENDIAN) || \ - (defined(i386) || defined(__i386__) || defined(__i486__) || \ - defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) -# define HASH_LITTLE_ENDIAN 1 -# define HASH_BIG_ENDIAN 0 +#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \ + __BYTE_ORDER == __LITTLE_ENDIAN) || \ +(defined(i386) || defined(__i386__) || defined(__i486__) || \ + defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) +#define HASH_LITTLE_ENDIAN 1 +#define HASH_BIG_ENDIAN 0 #elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \ - __BYTE_ORDER == __BIG_ENDIAN) || \ - (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 1 + __BYTE_ORDER == __BIG_ENDIAN) || \ +(defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) +#define HASH_LITTLE_ENDIAN 0 +#define HASH_BIG_ENDIAN 1 #else -# define HASH_LITTLE_ENDIAN 0 -# define HASH_BIG_ENDIAN 0 +#define HASH_LITTLE_ENDIAN 0 +#define HASH_BIG_ENDIAN 0 #endif -#define hashsize(n) ((uint32_t)1<<(n)) -#define hashmask(n) (hashsize(n)-1) -#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) +#define hashsize(n) ((uint32_t)1 << (n)) +#define hashmask(n) (hashsize(n) - 1) +#define rot(x, k) (((x) << (k)) | ((x) >> (32 - (k)))) /* ------------------------------------------------------------------------------- @@ -91,7 +91,7 @@ This was tested for: the output delta to a Gray code (a^(a>>1)) so a string of 1's (as is commonly produced by subtraction) look like a single 1-bit difference. -* the base values were pseudorandom, all zero but one bit set, or +* the base values were pseudorandom, all zero but one bit set, or all zero plus a counter that starts at zero. Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that @@ -101,7 +101,7 @@ satisfy this are 14 9 3 7 17 3 Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing for "differ" defined as + with a one-bit base and a two-bit delta. I -used http://burtleburtle.net/bob/hash/avalanche.html to choose +used http://burtleburtle.net/bob/hash/avalanche.html to choose the operations, constants, and arrangements of the variables. This does not achieve avalanche. There are input bits of (a,b,c) @@ -117,15 +117,27 @@ on, and rotates are much kinder to the top and bottom bits, so I used rotates. ------------------------------------------------------------------------------- */ -#define mix(a,b,c) \ -{ \ - a -= c; a ^= rot(c, 4); c += b; \ - b -= a; b ^= rot(a, 6); a += c; \ - c -= b; c ^= rot(b, 8); b += a; \ - a -= c; a ^= rot(c,16); c += b; \ - b -= a; b ^= rot(a,19); a += c; \ - c -= b; c ^= rot(b, 4); b += a; \ -} +#define mix(a, b, c) \ + { \ + a -= c; \ + a ^= rot(c, 4); \ + c += b; \ + b -= a; \ + b ^= rot(a, 6); \ + a += c; \ + c -= b; \ + c ^= rot(b, 8); \ + b += a; \ + a -= c; \ + a ^= rot(c, 16); \ + c += b; \ + b -= a; \ + b ^= rot(a, 19); \ + a += c; \ + c -= b; \ + c ^= rot(b, 4); \ + b += a; \ + } /* ------------------------------------------------------------------------------- @@ -140,7 +152,7 @@ produce values of c that look totally different. This was tested for the output delta to a Gray code (a^(a>>1)) so a string of 1's (as is commonly produced by subtraction) look like a single 1-bit difference. -* the base values were pseudorandom, all zero but one bit set, or +* the base values were pseudorandom, all zero but one bit set, or all zero plus a counter that starts at zero. These constants passed: @@ -152,16 +164,23 @@ and these came close: 11 8 15 26 3 22 24 ------------------------------------------------------------------------------- */ -#define final(a,b,c) \ -{ \ - c ^= b; c -= rot(b,14); \ - a ^= c; a -= rot(c,11); \ - b ^= a; b -= rot(a,25); \ - c ^= b; c -= rot(b,16); \ - a ^= c; a -= rot(c,4); \ - b ^= a; b -= rot(a,14); \ - c ^= b; c -= rot(b,24); \ -} +#define final(a, b, c) \ + { \ + c ^= b; \ + c -= rot(b, 14); \ + a ^= c; \ + a -= rot(c, 11); \ + b ^= a; \ + b -= rot(a, 25); \ + c ^= b; \ + c -= rot(b, 16); \ + a ^= c; \ + a -= rot(c, 4); \ + b ^= a; \ + b -= rot(a, 14); \ + c ^= b; \ + c -= rot(b, 24); \ + } /* -------------------------------------------------------------------- @@ -176,84 +195,94 @@ and these came close: hashlittle() has to dance around fitting the key bytes into registers. -------------------------------------------------------------------- */ -uint32_t hashword( -const uint32_t *k, /* the key, an array of uint32_t values */ -size_t length, /* the length of the key, in uint32_ts */ -uint32_t initval) /* the previous hash, or an arbitrary value */ +uint32_t +hashword(const uint32_t *k, /* the key, an array of uint32_t values */ + size_t length, /* the length of the key, in uint32_ts */ + uint32_t initval) /* the previous hash, or an arbitrary value */ { - uint32_t a,b,c; + uint32_t a, b, c; - /* Set up the internal state */ - a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + (((uint32_t)length) << 2) + initval; - /*------------------------------------------------- handle most of the key */ - while (length > 3) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 3; - k += 3; - } + /*------------------------------------------------- handle most of the key + */ + while (length > 3) { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a, b, c); + length -= 3; + k += 3; + } - /*------------------------------------------- handle the last 3 uint32_t's */ - switch(length) /* all the case statements fall through */ - { - case 3 : c+=k[2]; - case 2 : b+=k[1]; - case 1 : a+=k[0]; - final(a,b,c); - case 0: /* case 0: nothing left to add */ - break; - } - /*------------------------------------------------------ report the result */ - return c; + /*------------------------------------------- handle the last 3 uint32_t's + */ + switch (length) /* all the case statements fall through */ + { + case 3: + c += k[2]; + case 2: + b += k[1]; + case 1: + a += k[0]; + final(a, b, c); + case 0: /* case 0: nothing left to add */ + break; + } + /*------------------------------------------------------ report the result + */ + return c; } /* -------------------------------------------------------------------- hashword2() -- same as hashword(), but take two seeds and return two 32-bit values. pc and pb must both be nonnull, and *pc and *pb must -both be initialized with seeds. If you pass in (*pb)==0, the output +both be initialized with seeds. If you pass in (*pb)==0, the output (*pc) will be the same as the return value from hashword(). -------------------------------------------------------------------- */ -void hashword2 ( -const uint32_t *k, /* the key, an array of uint32_t values */ -size_t length, /* the length of the key, in uint32_ts */ -uint32_t *pc, /* IN: seed OUT: primary hash value */ -uint32_t *pb) /* IN: more seed OUT: secondary hash value */ +void hashword2(const uint32_t *k, /* the key, an array of uint32_t values */ + size_t length, /* the length of the key, in uint32_ts */ + uint32_t *pc, /* IN: seed OUT: primary hash value */ + uint32_t *pb) /* IN: more seed OUT: secondary hash value */ { - uint32_t a,b,c; + uint32_t a, b, c; - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc; - c += *pb; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ((uint32_t)(length << 2)) + *pc; + c += *pb; - /*------------------------------------------------- handle most of the key */ - while (length > 3) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 3; - k += 3; - } + /*------------------------------------------------- handle most of the key + */ + while (length > 3) { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a, b, c); + length -= 3; + k += 3; + } - /*------------------------------------------- handle the last 3 uint32_t's */ - switch(length) /* all the case statements fall through */ - { - case 3 : c+=k[2]; - case 2 : b+=k[1]; - case 1 : a+=k[0]; - final(a,b,c); - case 0: /* case 0: nothing left to add */ - break; - } - /*------------------------------------------------------ report the result */ - *pc=c; *pb=b; + /*------------------------------------------- handle the last 3 uint32_t's + */ + switch (length) /* all the case statements fall through */ + { + case 3: + c += k[2]; + case 2: + b += k[1]; + case 1: + a += k[0]; + final(a, b, c); + case 0: /* case 0: nothing left to add */ + break; + } + /*------------------------------------------------------ report the result + */ + *pc = c; + *pb = b; } #if 0 @@ -464,181 +493,275 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval) * the key. *pc is better mixed than *pb, so use *pc first. If you want * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)". */ -void hashlittle2( - const void *key, /* the key to hash */ - size_t length, /* length of the key */ - uint32_t *pc, /* IN: primary initval, OUT: primary hash */ - uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */ +void hashlittle2( +const void *key, /* the key to hash */ +size_t length, /* length of the key */ +uint32_t *pc, /* IN: primary initval, OUT: primary hash */ +uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */ { - uint32_t a,b,c; /* internal state */ - union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */ + uint32_t a, b, c; /* internal state */ + union { + const void *ptr; + size_t i; + } u; /* needed for Mac Powerbook G4 */ - /* Set up the internal state */ - a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc; - c += *pb; + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc; + c += *pb; - u.ptr = key; - if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { - const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ - const uint8_t *k8; + u.ptr = key; + if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { + const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ + const uint8_t *k8; - /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - b += k[1]; - c += k[2]; - mix(a,b,c); - length -= 12; - k += 3; - } + /*------ all but last block: aligned reads and affect 32 bits of + * (a,b,c) */ + while (length > 12) { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a, b, c); + length -= 12; + k += 3; + } - /*----------------------------- handle the last (probably partial) block */ - /* - * "k[2]&0xffffff" actually reads beyond the end of the string, but - * then masks off the part it's not allowed to read. Because the - * string is aligned, the masked-off tail is in the same word as the - * rest of the string. Every machine with memory protection I've seen - * does it on word boundaries, so is OK with this. But VALGRIND will - * still catch it and complain. The masking trick does make the hash - * noticably faster for short strings (like English words). - */ + /*----------------------------- handle the last (probably partial) + * block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ #ifndef VALGRIND - (void)k8; - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; - case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; - case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=k[1]&0xffffff; a+=k[0]; break; - case 6 : b+=k[1]&0xffff; a+=k[0]; break; - case 5 : b+=k[1]&0xff; a+=k[0]; break; - case 4 : a+=k[0]; break; - case 3 : a+=k[0]&0xffffff; break; - case 2 : a+=k[0]&0xffff; break; - case 1 : a+=k[0]&0xff; break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } + (void)k8; + switch (length) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += k[2] & 0xffffff; + b += k[1]; + a += k[0]; + break; + case 10: + c += k[2] & 0xffff; + b += k[1]; + a += k[0]; + break; + case 9: + c += k[2] & 0xff; + b += k[1]; + a += k[0]; + break; + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += k[1] & 0xffffff; + a += k[0]; + break; + case 6: + b += k[1] & 0xffff; + a += k[0]; + break; + case 5: + b += k[1] & 0xff; + a += k[0]; + break; + case 4: + a += k[0]; + break; + case 3: + a += k[0] & 0xffffff; + break; + case 2: + a += k[0] & 0xffff; + break; + case 1: + a += k[0] & 0xff; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } #else /* make valgrind happy */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[1]; a+=k[0]; break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]; break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ - case 1 : a+=k8[0]; break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } + k8 = (const uint8_t *)k; + switch (length) { + case 12: + c += k[2]; + b += k[1]; + a += k[0]; + break; + case 11: + c += ((uint32_t)k8[10]) << 16; /* fall through */ + case 10: + c += ((uint32_t)k8[9]) << 8; /* fall through */ + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[1]; + a += k[0]; + break; + case 7: + b += ((uint32_t)k8[6]) << 16; /* fall through */ + case 6: + b += ((uint32_t)k8[5]) << 8; /* fall through */ + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0]; + break; + case 3: + a += ((uint32_t)k8[2]) << 16; /* fall through */ + case 2: + a += ((uint32_t)k8[1]) << 8; /* fall through */ + case 1: + a += k8[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } #endif /* !valgrind */ - } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { - const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ - const uint8_t *k8; + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; - /*--------------- all but last block: aligned reads and different mixing */ - while (length > 12) - { - a += k[0] + (((uint32_t)k[1])<<16); - b += k[2] + (((uint32_t)k[3])<<16); - c += k[4] + (((uint32_t)k[5])<<16); - mix(a,b,c); - length -= 12; - k += 6; + /*--------------- all but last block: aligned reads and different + * mixing */ + while (length > 12) { + a += k[0] + (((uint32_t)k[1]) << 16); + b += k[2] + (((uint32_t)k[3]) << 16); + c += k[4] + (((uint32_t)k[5]) << 16); + mix(a, b, c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) + * block */ + k8 = (const uint8_t *)k; + switch (length) { + case 12: + c += k[4] + (((uint32_t)k[5]) << 16); + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 11: + c += ((uint32_t)k8[10]) << 16; /* fall through */ + case 10: + c += k[4]; + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 9: + c += k8[8]; /* fall through */ + case 8: + b += k[2] + (((uint32_t)k[3]) << 16); + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 7: + b += ((uint32_t)k8[6]) << 16; /* fall through */ + case 6: + b += k[2]; + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 5: + b += k8[4]; /* fall through */ + case 4: + a += k[0] + (((uint32_t)k[1]) << 16); + break; + case 3: + a += ((uint32_t)k8[2]) << 16; /* fall through */ + case 2: + a += k[0]; + break; + case 1: + a += k8[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of + * (a,b,c) */ + while (length > 12) { + a += k[0]; + a += ((uint32_t)k[1]) << 8; + a += ((uint32_t)k[2]) << 16; + a += ((uint32_t)k[3]) << 24; + b += k[4]; + b += ((uint32_t)k[5]) << 8; + b += ((uint32_t)k[6]) << 16; + b += ((uint32_t)k[7]) << 24; + c += k[8]; + c += ((uint32_t)k[9]) << 8; + c += ((uint32_t)k[10]) << 16; + c += ((uint32_t)k[11]) << 24; + mix(a, b, c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of + * (c) */ + switch (length) /* all the case statements fall through */ + { + case 12: + c += ((uint32_t)k[11]) << 24; + case 11: + c += ((uint32_t)k[10]) << 16; + case 10: + c += ((uint32_t)k[9]) << 8; + case 9: + c += k[8]; + case 8: + b += ((uint32_t)k[7]) << 24; + case 7: + b += ((uint32_t)k[6]) << 16; + case 6: + b += ((uint32_t)k[5]) << 8; + case 5: + b += k[4]; + case 4: + a += ((uint32_t)k[3]) << 24; + case 3: + a += ((uint32_t)k[2]) << 16; + case 2: + a += ((uint32_t)k[1]) << 8; + case 1: + a += k[0]; + break; + case 0: + *pc = c; + *pb = b; + return; /* zero length strings require no mixing */ + } } - /*----------------------------- handle the last (probably partial) block */ - k8 = (const uint8_t *)k; - switch(length) - { - case 12: c+=k[4]+(((uint32_t)k[5])<<16); - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ - case 10: c+=k[4]; - b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 9 : c+=k8[8]; /* fall through */ - case 8 : b+=k[2]+(((uint32_t)k[3])<<16); - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ - case 6 : b+=k[2]; - a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 5 : b+=k8[4]; /* fall through */ - case 4 : a+=k[0]+(((uint32_t)k[1])<<16); - break; - case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ - case 2 : a+=k[0]; - break; - case 1 : a+=k8[0]; - break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } - - } else { /* need to read the key one byte at a time */ - const uint8_t *k = (const uint8_t *)key; - - /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ - while (length > 12) - { - a += k[0]; - a += ((uint32_t)k[1])<<8; - a += ((uint32_t)k[2])<<16; - a += ((uint32_t)k[3])<<24; - b += k[4]; - b += ((uint32_t)k[5])<<8; - b += ((uint32_t)k[6])<<16; - b += ((uint32_t)k[7])<<24; - c += k[8]; - c += ((uint32_t)k[9])<<8; - c += ((uint32_t)k[10])<<16; - c += ((uint32_t)k[11])<<24; - mix(a,b,c); - length -= 12; - k += 12; - } - - /*-------------------------------- last block: affect all 32 bits of (c) */ - switch(length) /* all the case statements fall through */ - { - case 12: c+=((uint32_t)k[11])<<24; - case 11: c+=((uint32_t)k[10])<<16; - case 10: c+=((uint32_t)k[9])<<8; - case 9 : c+=k[8]; - case 8 : b+=((uint32_t)k[7])<<24; - case 7 : b+=((uint32_t)k[6])<<16; - case 6 : b+=((uint32_t)k[5])<<8; - case 5 : b+=k[4]; - case 4 : a+=((uint32_t)k[3])<<24; - case 3 : a+=((uint32_t)k[2])<<16; - case 2 : a+=((uint32_t)k[1])<<8; - case 1 : a+=k[0]; - break; - case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ - } - } - - final(a,b,c); - *pc=c; *pb=b; + final(a, b, c); + *pc = c; + *pb = b; } - #if 0 /* * hashbig(): @@ -699,7 +822,7 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval) case 0 : return c; /* zero length strings require no mixing */ } -#else /* make valgrind happy */ +#else /* make valgrind happy */ k8 = (const uint8_t *)k; switch(length) /* all the case statements fall through */ @@ -774,211 +897,227 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval) /* used for timings */ void driver1() { - uint8_t buf[256]; - uint32_t i; - uint32_t h=0; - time_t a,z; + uint8_t buf[256]; + uint32_t i; + uint32_t h = 0; + time_t a, z; - time(&a); - for (i=0; i<256; ++i) buf[i] = 'x'; - for (i=0; i<1; ++i) - { - h = hashlittle(&buf[0],1,h); - } - time(&z); - if (z-a > 0) printf("time %d %.8x\n", z-a, h); + time(&a); + for (i = 0; i < 256; ++i) + buf[i] = 'x'; + for (i = 0; i < 1; ++i) { + h = hashlittle(&buf[0], 1, h); + } + time(&z); + if (z - a > 0) + printf("time %d %.8x\n", z - a, h); } /* check that every input bit changes every output bit half the time */ #define HASHSTATE 1 -#define HASHLEN 1 +#define HASHLEN 1 #define MAXPAIR 60 -#define MAXLEN 70 +#define MAXLEN 70 void driver2() { - uint8_t qa[MAXLEN+1], qb[MAXLEN+2], *a = &qa[0], *b = &qb[1]; - uint32_t c[HASHSTATE], d[HASHSTATE], i=0, j=0, k, l, m=0, z; - uint32_t e[HASHSTATE],f[HASHSTATE],g[HASHSTATE],h[HASHSTATE]; - uint32_t x[HASHSTATE],y[HASHSTATE]; - uint32_t hlen; + uint8_t qa[MAXLEN + 1], qb[MAXLEN + 2], *a = &qa[0], *b = &qb[1]; + uint32_t c[HASHSTATE], d[HASHSTATE], i = 0, j = 0, k, l, m = 0, z; + uint32_t e[HASHSTATE], f[HASHSTATE], g[HASHSTATE], h[HASHSTATE]; + uint32_t x[HASHSTATE], y[HASHSTATE]; + uint32_t hlen; - printf("No more than %d trials should ever be needed \n",MAXPAIR/2); - for (hlen=0; hlen < MAXLEN; ++hlen) - { - z=0; - for (i=0; i>(8-j)); - c[0] = hashlittle(a, hlen, m); - b[i] ^= ((k+1)<>(8-j)); - d[0] = hashlittle(b, hlen, m); - /* check every bit is 1, 0, set, and not set at least once */ - for (l=0; lz) z=k; - if (k==MAXPAIR) - { - printf("Some bit didn't change: "); - printf("%.8x %.8x %.8x %.8x %.8x %.8x ", - e[0],f[0],g[0],h[0],x[0],y[0]); - printf("i %d j %d m %d len %d\n", i, j, m, hlen); - } - if (z==MAXPAIR) goto done; - } - } + /*---- check that every output bit is affected by that + * input bit */ + for (k = 0; k < MAXPAIR; k += 2) { + uint32_t finished = 1; + /* keys have one bit different */ + for (l = 0; l < hlen + 1; ++l) { + a[l] = b[l] = (uint8_t)0; + } + /* have a and b be two keys differing in only one bit + */ + a[i] ^= (k << j); + a[i] ^= (k >> (8 - j)); + c[0] = hashlittle(a, hlen, m); + b[i] ^= ((k + 1) << j); + b[i] ^= ((k + 1) >> (8 - j)); + d[0] = hashlittle(b, hlen, m); + /* check every bit is 1, 0, set, and not set at least + * once */ + for (l = 0; l < HASHSTATE; ++l) { + e[l] &= (c[l] ^ d[l]); + f[l] &= ~(c[l] ^ d[l]); + g[l] &= c[l]; + h[l] &= ~c[l]; + x[l] &= d[l]; + y[l] &= ~d[l]; + if (e[l] | f[l] | g[l] | h[l] | x[l] | y[l]) + finished = 0; + } + if (finished) + break; + } + if (k > z) + z = k; + if (k == MAXPAIR) { + printf("Some bit didn't change: "); + printf("%.8x %.8x %.8x %.8x %.8x %.8x ", e[0], f[0], + g[0], h[0], x[0], y[0]); + printf("i %d j %d m %d len %d\n", i, j, m, hlen); + } + if (z == MAXPAIR) + goto done; + } + } + } + done: + if (z < MAXPAIR) { + printf("Mix success %2d bytes %2d initvals ", i, m); + printf("required %d trials\n", z / 2); + } } - done: - if (z < MAXPAIR) - { - printf("Mix success %2d bytes %2d initvals ",i,m); - printf("required %d trials\n", z/2); - } - } - printf("\n"); + printf("\n"); } /* Check for reading beyond the end of the buffer and alignment problems */ void driver3() { - uint8_t buf[MAXLEN+20], *b; - uint32_t len; - uint8_t q[] = "This is the time for all good men to come to the aid of their country..."; - uint32_t h; - uint8_t qq[] = "xThis is the time for all good men to come to the aid of their country..."; - uint32_t i; - uint8_t qqq[] = "xxThis is the time for all good men to come to the aid of their country..."; - uint32_t j; - uint8_t qqqq[] = "xxxThis is the time for all good men to come to the aid of their country..."; - uint32_t ref,x,y; - uint8_t *p; + uint8_t buf[MAXLEN + 20], *b; + uint32_t len; + uint8_t q[] = "This is the time for all good men to come to the aid of " + "their country..."; + uint32_t h; + uint8_t qq[] = "xThis is the time for all good men to come to the aid of " + "their country..."; + uint32_t i; + uint8_t qqq[] = "xxThis is the time for all good men to come to the aid " + "of their country..."; + uint32_t j; + uint8_t qqqq[] = "xxxThis is the time for all good men to come to the " + "aid of their country..."; + uint32_t ref, x, y; + uint8_t *p; - printf("Endianness. These lines should all be the same (for values filled in):\n"); - printf("%.8x %.8x %.8x\n", - hashword((const uint32_t *)q, (sizeof(q)-1)/4, 13), - hashword((const uint32_t *)q, (sizeof(q)-5)/4, 13), - hashword((const uint32_t *)q, (sizeof(q)-9)/4, 13)); - p = q; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qq[1]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qqq[2]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - p = &qqqq[3]; - printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", - hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), - hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), - hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), - hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), - hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), - hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); - printf("\n"); + printf("Endianness. These lines should all be the same (for values " + "filled in):\n"); + printf( + "%.8x %.8x %.8x\n", + hashword((const uint32_t *)q, (sizeof(q) - 1) / 4, 13), + hashword((const uint32_t *)q, (sizeof(q) - 5) / 4, 13), + hashword((const uint32_t *)q, (sizeof(q) - 9) / 4, 13)); + p = q; + printf( + "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q) - 1, 13), hashlittle(p, sizeof(q) - 2, 13), + hashlittle(p, sizeof(q) - 3, 13), hashlittle(p, sizeof(q) - 4, 13), + hashlittle(p, sizeof(q) - 5, 13), hashlittle(p, sizeof(q) - 6, 13), + hashlittle(p, sizeof(q) - 7, 13), hashlittle(p, sizeof(q) - 8, 13), + hashlittle(p, sizeof(q) - 9, 13), hashlittle(p, sizeof(q) - 10, 13), + hashlittle(p, sizeof(q) - 11, 13), hashlittle(p, sizeof(q) - 12, 13)); + p = &qq[1]; + printf( + "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q) - 1, 13), hashlittle(p, sizeof(q) - 2, 13), + hashlittle(p, sizeof(q) - 3, 13), hashlittle(p, sizeof(q) - 4, 13), + hashlittle(p, sizeof(q) - 5, 13), hashlittle(p, sizeof(q) - 6, 13), + hashlittle(p, sizeof(q) - 7, 13), hashlittle(p, sizeof(q) - 8, 13), + hashlittle(p, sizeof(q) - 9, 13), hashlittle(p, sizeof(q) - 10, 13), + hashlittle(p, sizeof(q) - 11, 13), hashlittle(p, sizeof(q) - 12, 13)); + p = &qqq[2]; + printf( + "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q) - 1, 13), hashlittle(p, sizeof(q) - 2, 13), + hashlittle(p, sizeof(q) - 3, 13), hashlittle(p, sizeof(q) - 4, 13), + hashlittle(p, sizeof(q) - 5, 13), hashlittle(p, sizeof(q) - 6, 13), + hashlittle(p, sizeof(q) - 7, 13), hashlittle(p, sizeof(q) - 8, 13), + hashlittle(p, sizeof(q) - 9, 13), hashlittle(p, sizeof(q) - 10, 13), + hashlittle(p, sizeof(q) - 11, 13), hashlittle(p, sizeof(q) - 12, 13)); + p = &qqqq[3]; + printf( + "%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q) - 1, 13), hashlittle(p, sizeof(q) - 2, 13), + hashlittle(p, sizeof(q) - 3, 13), hashlittle(p, sizeof(q) - 4, 13), + hashlittle(p, sizeof(q) - 5, 13), hashlittle(p, sizeof(q) - 6, 13), + hashlittle(p, sizeof(q) - 7, 13), hashlittle(p, sizeof(q) - 8, 13), + hashlittle(p, sizeof(q) - 9, 13), hashlittle(p, sizeof(q) - 10, 13), + hashlittle(p, sizeof(q) - 11, 13), hashlittle(p, sizeof(q) - 12, 13)); + printf("\n"); - /* check that hashlittle2 and hashlittle produce the same results */ - i=47; j=0; - hashlittle2(q, sizeof(q), &i, &j); - if (hashlittle(q, sizeof(q), 47) != i) - printf("hashlittle2 and hashlittle mismatch\n"); + /* check that hashlittle2 and hashlittle produce the same results */ + i = 47; + j = 0; + hashlittle2(q, sizeof(q), &i, &j); + if (hashlittle(q, sizeof(q), 47) != i) + printf("hashlittle2 and hashlittle mismatch\n"); - /* check that hashword2 and hashword produce the same results */ - len = 0xdeadbeef; - i=47, j=0; - hashword2(&len, 1, &i, &j); - if (hashword(&len, 1, 47) != i) - printf("hashword2 and hashword mismatch %x %x\n", - i, hashword(&len, 1, 47)); + /* check that hashword2 and hashword produce the same results */ + len = 0xdeadbeef; + i = 47, j = 0; + hashword2(&len, 1, &i, &j); + if (hashword(&len, 1, 47) != i) + printf("hashword2 and hashword mismatch %x %x\n", i, + hashword(&len, 1, 47)); - /* check hashlittle doesn't read before or after the ends of the string */ - for (h=0, b=buf+1; h<8; ++h, ++b) - { - for (i=0; i -/* 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> 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> 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> 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 diff --git a/llt/ptrhash.c b/llt/ptrhash.c index 99f7b0e..0f0ad02 100644 --- a/llt/ptrhash.c +++ b/llt/ptrhash.c @@ -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 diff --git a/llt/random.c b/llt/random.c index c086f79..6142700 100644 --- a/llt/random.c +++ b/llt/random.c @@ -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); } diff --git a/llt/socket.c b/llt/socket.c index 3984fb0..755c196 100644 --- a/llt/socket.c +++ b/llt/socket.c @@ -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); } diff --git a/llt/timefuncs.c b/llt/timefuncs.c index 09ddeb8..9496c28 100644 --- a/llt/timefuncs.c +++ b/llt/timefuncs.c @@ -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 } diff --git a/llt/utf8.c b/llt/utf8.c index b8b0456..a4f10bf 100644 --- a/llt/utf8.c +++ b/llt/utf8.c @@ -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 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= 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: diff --git a/llt/utf8.h b/llt/utf8.h index ea0142a..0c3d231 100644 --- a/llt/utf8.h +++ b/llt/utf8.h @@ -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); diff --git a/llt/utils.h b/llt/utils.h index 9f2c5ad..b24d97c 100644 --- a/llt/utils.h +++ b/llt/utils.h @@ -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) diff --git a/llt/wcwidth.c b/llt/wcwidth.c index 71a5a6c..3a3a371 100644 --- a/llt/wcwidth.c +++ b/llt/wcwidth.c @@ -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 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; } diff --git a/opaque_type_template.c b/opaque_type_template.c index 246f97b..6fefa44 100644 --- a/opaque_type_template.c +++ b/opaque_type_template.c @@ -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); } diff --git a/opcodes.h b/opcodes.h index 593270c..0fb716e 100644 --- a/opcodes.h +++ b/opcodes.h @@ -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 diff --git a/operators.c b/operators.c index 494ca4e..334387b 100644 --- a/operators.c +++ b/operators.c @@ -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; diff --git a/print.c b/print.c index 993aafa..166d781 100644 --- a/print.c +++ b/print.c @@ -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("#", 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("#", 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, "#", - (size_t)(builtin_t)fptr); - } - else { + HPOS += + ios_printf(f, "#", (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); } } diff --git a/read.c b/read.c index e262c40..a5b692e 100644 --- a/read.c +++ b/read.c @@ -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 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 = "E; 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; diff --git a/string.c b/string.c index 387cf14..248656e 100644 --- a/string.c +++ b/string.c @@ -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 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); } diff --git a/table.c b/table.c index a3638c1..ed4710e 100644 --- a/table.c +++ b/table.c @@ -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); } diff --git a/tiny/flutils.c b/tiny/flutils.c index 7cd4023..fffba49 100644 --- a/tiny/flutils.c +++ b/tiny/flutils.c @@ -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; } diff --git a/tiny/lisp-nontail.c b/tiny/lisp-nontail.c index d115eb2..bae1979 100644 --- a/tiny/lisp-nontail.c +++ b/tiny/lisp-nontail.c @@ -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_("E, cons(&Stack[SP-1], &NIL)); + v = cons_("E, 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_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_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, nargsconstant != 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"); } diff --git a/tiny/lisp.c b/tiny/lisp.c index 4b9ffbc..1e70c8c 100644 --- a/tiny/lisp.c +++ b/tiny/lisp.c @@ -47,55 +47,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; @@ -104,7 +135,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; @@ -120,24 +152,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; @@ -145,7 +180,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); @@ -156,7 +191,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; @@ -178,35 +213,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); @@ -216,7 +255,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); } @@ -224,19 +263,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) { @@ -247,8 +289,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; @@ -270,13 +314,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; @@ -285,24 +330,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) { @@ -337,49 +381,44 @@ 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"); } // return: 1 for dot token, 0 for symbol static int read_token(FILE *f, char c) { - int i=0, ch, escaped=0, dot=(c=='.'), totread=0; + int i = 0, ch, escaped = 0, dot = (c == '.'), totread = 0; ungetc(c, f); while (1) { - ch = fgetc(f); totread++; + ch = fgetc(f); + totread++; if (ch == EOF) goto terminate; 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 (dot && (totread==2)); + return (dot && (totread == 2)); } static u_int32_t peek(FILE *f) @@ -390,33 +429,28 @@ 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=='-' || c=='+') { + } else if (isdigit(c) || c == '-' || c == '+') { read_token(f, c); x = strtol(buf, &end, 0); if (*end != '\0') { toktype = TOK_SYM; tokval = symbol(buf); - } - else { + } else { toktype = TOK_NUM; tokval = number(x); } - } - else { + } else { if (read_token(f, c)) { toktype = TOK_DOT; - } - else { + } else { toktype = TOK_SYM; tokval = symbol(buf); } @@ -433,12 +467,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 @@ -482,29 +517,35 @@ value_t read_sexpr(FILE *f) take(); v = read_sexpr(f); PUSH(v); - v = cons_("E, cons(&Stack[SP-1], &NIL)); + v = cons_("E, 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, "%ld", numval(v)); break; - case TAG_SYM: fprintf(f, "%s", ((symbol_t*)ptr(v))->name); break; - case TAG_BUILTIN: fprintf(f, "#", - builtin_names[intval(v)]); break; + case TAG_NUM: + fprintf(f, "%ld", numval(v)); + break; + case TAG_SYM: + fprintf(f, "%s", ((symbol_t *)ptr(v))->name); + break; + case TAG_BUILTIN: + fprintf(f, "#", builtin_names[intval(v)]); + break; case TAG_CONS: fprintf(f, "("); while (1) { @@ -525,33 +566,44 @@ 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, nargsconstant != UNBOUND) return sym->constant; + sym = (symbol_t *)ptr(e); + if (sym->constant != UNBOUND) + return sym->constant; v = *penv; while (iscons(v)) { bind = car_(v); @@ -563,13 +615,14 @@ 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 long)(char*)&nargs < (unsigned long)stack_bottom || SP>=(N_STACK-100)) + if ((unsigned long)(char *)&nargs < (unsigned long)stack_bottom || + SP >= (N_STACK - 100)) lerror("eval: error: stack overflow\n"); saveSP = SP; PUSH(e); PUSH(*penv); f = eval(car_(e), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; if (isbuiltin(f)) { // handle builtin function if (!isspecial(f)) { @@ -577,7 +630,7 @@ value_t eval_sexpr(value_t e, value_t *penv) v = Stack[saveSP] = cdr_(Stack[saveSP]); while (iscons(v)) { v = eval(car_(v), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; PUSH(v); v = Stack[saveSP] = cdr_(Stack[saveSP]); } @@ -599,10 +652,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; @@ -610,10 +663,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))); } @@ -624,22 +677,23 @@ value_t eval_sexpr(value_t e, value_t *penv) v = car(cdr_(cdr_(Stack[saveSP]))); else v = car(cdr(cdr_(cdr_(Stack[saveSP])))); - tail_eval(v, Stack[saveSP+1]); + tail_eval(v, Stack[saveSP + 1]); 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"); v = eval(c->car, penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; if (v != NIL) { *pv = cdr_(car_(*pv)); // evaluate body forms if (iscons(*pv)) { while (iscons(cdr_(*pv))) { v = eval(car_(*pv), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -651,13 +705,15 @@ 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; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv), penv)) == NIL) { - SP = saveSP; return NIL; + if ((v = eval(car_(*pv), penv)) == NIL) { + SP = saveSP; + return NIL; } - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -665,13 +721,15 @@ value_t eval_sexpr(value_t e, value_t *penv) break; case F_OR: Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = NIL; + pv = &Stack[saveSP]; + v = NIL; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv), penv)) != NIL) { - SP = saveSP; return v; + if ((v = eval(car_(*pv), penv)) != NIL) { + SP = saveSP; + return v; } - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -679,18 +737,18 @@ value_t eval_sexpr(value_t e, value_t *penv) break; case F_WHILE: PUSH(cdr(cdr_(Stack[saveSP]))); - body = &Stack[SP-1]; + body = &Stack[SP - 1]; PUSH(*body); Stack[saveSP] = car_(cdr_(Stack[saveSP])); value_t *cond = &Stack[saveSP]; PUSH(NIL); - pv = &Stack[SP-1]; + pv = &Stack[SP - 1]; while (eval(*cond, penv) != NIL) { - *penv = Stack[saveSP+1]; - *body = Stack[SP-2]; + *penv = Stack[saveSP + 1]; + *body = Stack[SP - 2]; while (iscons(*body)) { *pv = eval(car_(*body), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *body = cdr_(*body); } } @@ -699,11 +757,12 @@ 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; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { v = eval(car_(*pv), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -713,21 +772,22 @@ 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); - sym = tosymbol(Stack[SP-1], "boundp"); + sym = tosymbol(Stack[SP - 1], "boundp"); if (sym->binding == UNBOUND && sym->constant == UNBOUND) v = NIL; else @@ -735,45 +795,45 @@ value_t eval_sexpr(value_t e, value_t *penv) 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+2; i < (int)SP; i++) { + for (i = saveSP + 2; i < (int)SP; i++) { n = tonumber(Stack[i], "+"); s += n; } @@ -782,8 +842,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+2; - s = (nargs==1) ? 0 : tonumber(Stack[i++], "-"); + i = saveSP + 2; + s = (nargs == 1) ? 0 : tonumber(Stack[i++], "-"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "-"); s -= n; @@ -792,7 +852,7 @@ value_t eval_sexpr(value_t e, value_t *penv) break; case F_MUL: s = 1; - for (i=saveSP+2; i < (int)SP; i++) { + for (i = saveSP + 2; i < (int)SP; i++) { n = tonumber(Stack[i], "*"); s *= n; } @@ -801,8 +861,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+2; - s = (nargs==1) ? 1 : tonumber(Stack[i++], "/"); + i = saveSP + 2; + s = (nargs == 1) ? 1 : tonumber(Stack[i++], "/"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "/"); if (n == 0) @@ -813,23 +873,23 @@ 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 = Stack[SP-1]; + v = Stack[SP - 1]; tail_eval(v, NIL); break; case F_PRINT: - for (i=saveSP+2; i < (int)SP; i++) - print(stdout, v=Stack[i]); + for (i = saveSP + 2; i < (int)SP; i++) + print(stdout, v = Stack[i]); break; case F_READ: argcount("read", nargs, 0); @@ -837,23 +897,24 @@ 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+2]; + v = Stack[saveSP + 2]; break; case F_APPLY: 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)]); // unpack arglist onto the stack while (iscons(v)) { PUSH(car_(v)); @@ -866,11 +927,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) { @@ -882,18 +942,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; @@ -915,10 +975,10 @@ value_t eval_sexpr(value_t e, value_t *penv) v = car_(v); if (!noeval) { v = eval(v, penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; } 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]); @@ -927,30 +987,28 @@ 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); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; 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"); } } @@ -959,11 +1017,10 @@ value_t eval_sexpr(value_t e, value_t *penv) if (headsym == MACRO) { SP = saveSP; PUSH(*lenv); - lenv = &Stack[SP-1]; + lenv = &Stack[SP - 1]; v = eval(*body, lenv); tail_eval(v, *penv); - } - else { + } else { tail_eval(*body, *lenv); } // not reached @@ -972,7 +1029,8 @@ value_t eval_sexpr(value_t e, value_t *penv) return NIL; } -// repl ----------------------------------------------------------------------- +// repl +// ----------------------------------------------------------------------- static char *infile = NULL; @@ -981,21 +1039,23 @@ value_t toplevel_eval(value_t expr) value_t v; u_int32_t saveSP = SP; PUSH(NIL); - v = eval(expr, &Stack[SP-1]); + v = eval(expr, &Stack[SP - 1]); SP = saveSP; return v; } 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 = toplevel_eval(e); } infile = lastfile; @@ -1003,11 +1063,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; @@ -1019,14 +1079,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=toplevel_eval(v)); + if (feof(stdin)) + break; + print(stdout, v = toplevel_eval(v)); set(symbol("that"), v); printf("\n\n"); } diff --git a/tiny/lisp2.c b/tiny/lisp2.c index 3fb68c0..16049f1 100644 --- a/tiny/lisp2.c +++ b/tiny/lisp2.c @@ -63,58 +63,92 @@ 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, F_ERROR, F_EXIT, F_PRINC, F_CONSP, - F_ASSOC, 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, + F_ERROR, + F_EXIT, + F_PRINC, + F_CONSP, + F_ASSOC, + N_BUILTINS }; #define isspecial(v) (intval(v) <= (number_t)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", "error", "exit", "princ", - "consp", "assoc" }; +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", "error", "exit", + "princ", "consp", "assoc" +}; static char *stack_bottom; -#define PROCESS_STACK_SIZE (2*1024*1024) +#define PROCESS_STACK_SIZE (2 * 1024 * 1024) #define N_STACK 98304 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; value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT; @@ -134,7 +168,8 @@ typedef struct _readstate_t { } readstate_t; static readstate_t *readstate = NULL; -// error utilities ------------------------------------------------------------ +// error utilities +// ------------------------------------------------------------ jmp_buf toplevel; @@ -157,24 +192,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, 0); lerror("\n"); + print(stderr, got, 0); + 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; @@ -182,7 +220,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); @@ -193,7 +231,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; @@ -215,13 +253,14 @@ 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 = 128*1024;//bytes +static u_int32_t heapsize = 128 * 1024; // bytes static u_int32_t *consflags; static ltable_t printconses; @@ -230,15 +269,17 @@ void lisp_init(void) int i; fromspace = malloc(heapsize); - tospace = malloc(heapsize); + tospace = malloc(heapsize); curheap = fromspace; - lim = curheap+heapsize-sizeof(cons_t); - consflags = mk_bitvector(heapsize/sizeof(cons_t)); + lim = curheap + heapsize - sizeof(cons_t); + consflags = mk_bitvector(heapsize / sizeof(cons_t)); ltable_init(&printconses, 32); - 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"); @@ -247,11 +288,12 @@ void lisp_init(void) COMMA = symbol("*comma*"); COMMAAT = symbol("*comma-at*"); COMMADOT = symbol("*comma-dot*"); - for (i=0; i < (int)N_BUILTINS; i++) + for (i = 0; i < (int)N_BUILTINS; i++) setc(symbol(builtin_names[i]), builtin(i)); } -// conses --------------------------------------------------------------------- +// conses +// --------------------------------------------------------------------- void gc(int mustgrow); @@ -261,7 +303,7 @@ static value_t mk_cons(void) if (curheap > lim) gc(0); - c = (cons_t*)curheap; + c = (cons_t *)curheap; curheap += sizeof(cons_t); return tagptr(c, TAG_CONS); } @@ -272,23 +314,24 @@ static value_t cons_reserve(int n) cons_t *first; n--; - if ((cons_t*)curheap > ((cons_t*)lim)-n) { + if ((cons_t *)curheap > ((cons_t *)lim) - n) { gc(0); - while ((cons_t*)curheap > ((cons_t*)lim)-n) { + while ((cons_t *)curheap > ((cons_t *)lim) - n) { gc(1); } } - first = (cons_t*)curheap; - curheap += ((n+1)*sizeof(cons_t)); + first = (cons_t *)curheap; + curheap += ((n + 1) * sizeof(cons_t)); return tagptr(first, TAG_CONS); } -#define cons_index(c) (((cons_t*)ptr(c))-((cons_t*)fromspace)) -#define ismarked(c) bitvector_get(consflags, cons_index(c)) -#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1) +#define cons_index(c) (((cons_t *)ptr(c)) - ((cons_t *)fromspace)) +#define ismarked(c) bitvector_get(consflags, cons_index(c)) +#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1) #define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0) -// collector ------------------------------------------------------------------ +// collector +// ------------------------------------------------------------------ static value_t relocate(value_t v) { @@ -299,13 +342,14 @@ static value_t relocate(value_t v) // iterative implementation allows arbitrarily long cons chains pcdr = &first; do { - if ((a=car_(v)) == UNBOUND) { + if ((a = car_(v)) == UNBOUND) { *pcdr = cdr_(v); return first; } *pcdr = nc = mk_cons(); d = cdr_(v); - car_(v) = UNBOUND; cdr_(v) = nc; + car_(v) = UNBOUND; + cdr_(v) = nc; car_(nc) = relocate(a); pcdr = &cdr_(nc); v = d; @@ -332,20 +376,20 @@ void gc(int mustgrow) readstate_t *rs; 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); rs = readstate; while (rs) { - for(i=0; i < rs->exprs.n; i++) + for (i = 0; i < rs->exprs.n; i++) rs->exprs.items[i] = relocate(rs->exprs.items[i]); rs = rs->prev; } #ifdef VERBOSEGC printf("gc found %d/%d live conses\n", - (curheap-tospace)/sizeof(cons_t), heapsize/sizeof(cons_t)); + (curheap - tospace) / sizeof(cons_t), heapsize / sizeof(cons_t)); #endif temp = tospace; tospace = fromspace; @@ -354,19 +398,18 @@ void gc(int mustgrow) // 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)) || mustgrow) { - temp = realloc(tospace, grew ? heapsize : heapsize*2); + if (grew || ((lim - curheap) < (int)(heapsize / 5)) || mustgrow) { + temp = realloc(tospace, grew ? heapsize : heapsize * 2); if (temp == NULL) lerror("out of memory\n"); tospace = temp; if (!grew) { - heapsize*=2; - } - else { - temp = bitvector_resize(consflags, heapsize/sizeof(cons_t)); + heapsize *= 2; + } else { + temp = bitvector_resize(consflags, heapsize / sizeof(cons_t)); if (temp == NULL) lerror("out of memory\n"); - consflags = (u_int32_t*)temp; + consflags = (u_int32_t *)temp; } grew = !grew; } @@ -374,12 +417,25 @@ void gc(int mustgrow) gc(0); } -// read ----------------------------------------------------------------------- +// read +// ----------------------------------------------------------------------- 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_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 }; // defines which characters are ordinary symbol characters. @@ -418,49 +474,44 @@ 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"); } // return: 1 for dot token, 0 for symbol static int read_token(FILE *f, char c, int digits) { - int i=0, ch, escaped=0, dot=(c=='.'), totread=0; + int i = 0, ch, escaped = 0, dot = (c == '.'), totread = 0; ungetc(c, f); while (1) { - ch = fgetc(f); totread++; + ch = fgetc(f); + totread++; if (ch == EOF) goto terminate; 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) && (!digits || isdigit(c)))) { + } else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) { break; - } - else { + } else { accumchar(c, &i); } } ungetc(c, f); - terminate: +terminate: buf[i++] = '\0'; - return (dot && (totread==2)); + return (dot && (totread == 2)); } static u_int32_t peek(FILE *f) @@ -472,35 +523,29 @@ 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 (c == '`') { + } else if (c == '`') { toktype = TOK_BQ; - } - else if (c == '#') { + } else if (c == '#') { ch = fgetc(f); if (ch == EOF) lerror("read: error: invalid read macro\n"); if ((char)ch == '.') { toktype = TOK_SHARPDOT; - } - else if ((char)ch == '\'') { + } else if ((char)ch == '\'') { toktype = TOK_SHARPQUOTE; - } - else if ((char)ch == '\\') { + } else if ((char)ch == '\\') { u_int32_t cval = u8_fgetc(f); toktype = TOK_NUM; tokval = number(cval); - } - else if (isdigit((char)ch)) { + } else if (isdigit((char)ch)) { read_token(f, (char)ch, 1); c = (char)fgetc(f); if (c == '#') @@ -511,12 +556,10 @@ static u_int32_t peek(FILE *f) lerror("read: error: invalid label\n"); x = strtol(buf, &end, 10); tokval = number(x); - } - else { + } else { lerror("read: error: unknown read macro\n"); } - } - else if (c == ',') { + } else if (c == ',') { toktype = TOK_COMMA; ch = fgetc(f); if (ch == EOF) @@ -527,24 +570,20 @@ static u_int32_t peek(FILE *f) toktype = TOK_COMMADOT; else ungetc((char)ch, f); - } - else if (isdigit(c) || c=='-' || c=='+') { + } else if (isdigit(c) || c == '-' || c == '+') { read_token(f, c, 0); x = strtol(buf, &end, 0); if (*end != '\0') { toktype = TOK_SYM; tokval = symbol(buf); - } - else { + } else { toktype = TOK_NUM; tokval = number(x); } - } - else { + } else { if (read_token(f, c, 0)) { toktype = TOK_DOT; - } - else { + } else { toktype = TOK_SYM; tokval = symbol(buf); } @@ -563,28 +602,29 @@ static void read_list(FILE *f, value_t *pval, int fixup) 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 { + } else { *pval = c; if (fixup != -1) readstate->exprs.items[fixup] = c; } *pc = c; - c = do_read_sexpr(f,-1); // must be on separate lines due to undefined - car_(*pc) = c; // evaluation order + c = + do_read_sexpr(f, -1); // must be on separate lines due to undefined + car_(*pc) = c; // evaluation order t = peek(f); if (t == TOK_DOT) { take(); - c = do_read_sexpr(f,-1); + c = do_read_sexpr(f, -1); cdr_(*pc) = c; t = peek(f); if (feof(f)) @@ -615,40 +655,44 @@ static value_t do_read_sexpr(FILE *f, int fixup) 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 = "E; 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 (fixup != -1) readstate->exprs.items[fixup] = v; - v = do_read_sexpr(f,-1); - car_(cdr_(Stack[SP-1])) = v; + v = do_read_sexpr(f, -1); + car_(cdr_(Stack[SP - 1])) = v; return POP(); case TOK_SHARPQUOTE: // femtoLisp doesn't need symbol-function, so #' does nothing return do_read_sexpr(f, fixup); case TOK_OPEN: PUSH(NIL); - read_list(f, &Stack[SP-1], fixup); + read_list(f, &Stack[SP - 1], fixup); return POP(); 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 - v = do_read_sexpr(f,-1); + v = do_read_sexpr(f, -1); return toplevel_eval(v); case TOK_LABEL: // create backreference label @@ -658,7 +702,7 @@ static value_t do_read_sexpr(FILE *f, int fixup) ltable_insert(&readstate->labels, l); i = readstate->exprs.n; ltable_insert(&readstate->exprs, UNBOUND); - v = do_read_sexpr(f,i); + v = do_read_sexpr(f, i); readstate->exprs.items[i] = v; return v; case TOK_BACKREF: @@ -690,7 +734,8 @@ value_t read_sexpr(FILE *f) return v; } -// print ---------------------------------------------------------------------- +// print +// ---------------------------------------------------------------------- static void print_traverse(value_t v) { @@ -707,7 +752,7 @@ static void print_traverse(value_t v) static void print_symbol(FILE *f, char *name) { - int i, escape=0, charescape=0; + int i, escape = 0, charescape = 0; if (name[0] == '\0') { fprintf(f, "||"); @@ -719,11 +764,11 @@ static void print_symbol(FILE *f, char *name) } if (name[0] == '#') 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; } @@ -733,21 +778,19 @@ static void print_symbol(FILE *f, char *name) if (escape) { if (charescape) { fprintf(f, "|"); - i=0; + i = 0; while (name[i]) { - if (name[i]=='|' || name[i]=='\\') + if (name[i] == '|' || name[i] == '\\') fprintf(f, "\\%c", name[i]); else fprintf(f, "%c", name[i]); i++; } fprintf(f, "|"); - } - else { + } else { fprintf(f, "|%s|", name); } - } - else { + } else { fprintf(f, "%s", name); } } @@ -759,17 +802,21 @@ static void do_print(FILE *f, value_t v, int princ) char *name; switch (tag(v)) { - case TAG_NUM: fprintf(f, "%d", numval(v)); break; + case TAG_NUM: + fprintf(f, "%d", numval(v)); + break; case TAG_SYM: - name = ((symbol_t*)ptr(v))->name; + name = ((symbol_t *)ptr(v))->name; if (princ) fprintf(f, "%s", name); else print_symbol(f, name); break; - case TAG_BUILTIN: fprintf(f, "#.%s", builtin_names[intval(v)]); break; + case TAG_BUILTIN: + fprintf(f, "#.%s", builtin_names[intval(v)]); + break; case TAG_CONS: - if ((label=ltable_lookup(&printconses,v)) != NOTFOUND) { + if ((label = ltable_lookup(&printconses, v)) != NOTFOUND) { if (!ismarked(v)) { fprintf(f, "#%d#", label); return; @@ -788,9 +835,8 @@ static void do_print(FILE *f, value_t v, int princ) } fprintf(f, ")"); break; - } - else { - if ((label=ltable_lookup(&printconses,cd)) != NOTFOUND) { + } else { + if ((label = ltable_lookup(&printconses, cd)) != NOTFOUND) { fprintf(f, " . "); do_print(f, cd, princ); fprintf(f, ")"); @@ -811,12 +857,14 @@ void print(FILE *f, value_t v, int princ) do_print(f, v, princ); } -// eval ----------------------------------------------------------------------- +// eval +// ----------------------------------------------------------------------- static inline void argcount(char *fname, int nargs, int c) { if (nargs != c) - lerror("%s: error: too %s arguments\n", fname, nargsconstant != UNBOUND) return sym->constant; - while (issymbol(*penv)) { // 1. try lookup in argument env + sym = (symbol_t *)ptr(e); + if (sym->constant != UNBOUND) + return sym->constant; + while (issymbol(*penv)) { // 1. try lookup in argument env if (*penv == NIL) goto get_global; if (*penv == e) return penv[1]; - penv+=2; + penv += 2; } - if ((v=assoc(e,*penv)) != NIL) // 2. closure env + if ((v = assoc(e, *penv)) != NIL) // 2. closure env return cdr_(v); get_global: - if ((v = sym->binding) == UNBOUND) // 3. global env + if ((v = sym->binding) == UNBOUND) // 3. global env 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); v = car_(e); - if (tag(v)<0x2) f = v; - else if (issymbol(v) && (f=((symbol_t*)ptr(v))->constant)!=UNBOUND) ; - else f = eval_sexpr(v, penv, 0, envend); + if (tag(v) < 0x2) + f = v; + else if (issymbol(v) && (f = ((symbol_t *)ptr(v))->constant) != UNBOUND) + ; + else + f = eval_sexpr(v, penv, 0, envend); if (isbuiltin(f)) { // handle builtin function if (!isspecial(f)) { @@ -908,7 +968,8 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) // special forms case F_QUOTE: v = cdr_(Stack[saveSP]); - if (!iscons(v)) lerror("quote: error: expected argument\n"); + if (!iscons(v)) + lerror("quote: error: expected argument\n"); v = car_(v); break; case F_MACRO: @@ -916,43 +977,45 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) // build a closure (lambda args body . env) if (issymbol(*penv) && *penv != NIL) { // cons up and save temporary environment - PUSH(Stack[envend-1]); // passed-in CLOENV + PUSH(Stack[envend - 1]); // passed-in CLOENV // find out how many new conses we need - nargs = ((int)(&Stack[envend] - penv - 1))>>1; + nargs = ((int)(&Stack[envend] - penv - 1)) >> 1; if (nargs) { lenv = penv; - Stack[SP-1] = cons_reserve(nargs*2); - c = (cons_t*)ptr(Stack[SP-1]); + Stack[SP - 1] = cons_reserve(nargs * 2); + c = (cons_t *)ptr(Stack[SP - 1]); while (1) { - c->car = tagptr(c+1, TAG_CONS); - (c+1)->car = penv[0]; - (c+1)->cdr = penv[1]; + c->car = tagptr(c + 1, TAG_CONS); + (c + 1)->car = penv[0]; + (c + 1)->cdr = penv[1]; nargs--; - if (nargs==0) break; - penv+=2; - c->cdr = tagptr(c+2, TAG_CONS); + if (nargs == 0) + break; + penv += 2; + c->cdr = tagptr(c + 2, TAG_CONS); c += 2; } // final cdr points to existing cloenv - c->cdr = Stack[envend-1]; + c->cdr = Stack[envend - 1]; // environment representation changed; install // the new representation so everybody can see it - *lenv = Stack[SP-1]; + *lenv = Stack[SP - 1]; } - } - else { - PUSH(*penv); // env has already been captured; share + } else { + PUSH(*penv); // env has already been captured; share } v = cdr_(Stack[saveSP]); PUSH(car(v)); PUSH(car(cdr_(v))); - c = (cons_t*)ptr(v=cons_reserve(3)); - c->car = (intval(f)==F_LAMBDA ? LAMBDA : MACRO); - c->cdr = tagptr(c+1, TAG_CONS); c++; - c->car = Stack[SP-2]; //argsyms - c->cdr = tagptr(c+1, TAG_CONS); c++; - c->car = Stack[SP-1]; //body - c->cdr = Stack[SP-3]; //env + c = (cons_t *)ptr(v = cons_reserve(3)); + c->car = (intval(f) == F_LAMBDA ? LAMBDA : MACRO); + c->cdr = tagptr(c + 1, TAG_CONS); + c++; + c->car = Stack[SP - 2]; // argsyms + c->cdr = tagptr(c + 1, TAG_CONS); + c++; + c->car = Stack[SP - 1]; // body + c->cdr = Stack[SP - 3]; // env break; case F_LABEL: // the syntax of label is (label name (lambda args body)) @@ -960,12 +1023,13 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) v = cdr_(Stack[saveSP]); PUSH(car(v)); PUSH(car(cdr_(v))); - body = &Stack[SP-1]; + body = &Stack[SP - 1]; *body = eval(*body); // evaluate lambda - c = (cons_t*)ptr(cons_reserve(2)); - c->car = Stack[SP-2]; // name - c->cdr = v = *body; c++; - c->car = tagptr(c-1, TAG_CONS); + c = (cons_t *)ptr(cons_reserve(2)); + c->car = Stack[SP - 2]; // name + c->cdr = v = *body; + c++; + c->car = tagptr(c - 1, TAG_CONS); f = cdr(cdr(v)); c->cdr = cdr(f); // add (name . fn) to front of function's environment @@ -981,7 +1045,8 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) 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"); v = eval(c->car); @@ -1002,11 +1067,13 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) break; case F_AND: Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = T; + pv = &Stack[saveSP]; + v = T; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv))) == NIL) { - SP = saveSP; return NIL; + if ((v = eval(car_(*pv))) == NIL) { + SP = saveSP; + return NIL; } *pv = cdr_(*pv); } @@ -1015,11 +1082,13 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) break; case F_OR: Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = NIL; + pv = &Stack[saveSP]; + v = NIL; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv))) != NIL) { - SP = saveSP; return v; + if ((v = eval(car_(*pv))) != NIL) { + SP = saveSP; + return v; } *pv = cdr_(*pv); } @@ -1028,14 +1097,14 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) break; case F_WHILE: PUSH(cdr(cdr_(Stack[saveSP]))); - body = &Stack[SP-1]; + body = &Stack[SP - 1]; PUSH(*body); Stack[saveSP] = car_(cdr_(Stack[saveSP])); value_t *cond = &Stack[saveSP]; PUSH(NIL); - pv = &Stack[SP-1]; + pv = &Stack[SP - 1]; while (eval(*cond) != NIL) { - *body = Stack[SP-2]; + *body = Stack[SP - 2]; while (iscons(*body)) { *pv = eval(car_(*body)); *body = cdr_(*body); @@ -1046,7 +1115,8 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) case F_PROGN: // return last arg Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = NIL; + pv = &Stack[saveSP]; + v = NIL; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { v = eval(car_(*pv)); @@ -1059,26 +1129,28 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) // ordinary functions case F_SET: argcount("set", nargs, 2); - e = Stack[SP-2]; + e = Stack[SP - 2]; while (issymbol(*penv)) { if (*penv == NIL) goto set_global; if (*penv == e) { - penv[1] = Stack[SP-1]; - SP=saveSP; return penv[1]; + penv[1] = Stack[SP - 1]; + SP = saveSP; + return penv[1]; } - penv+=2; + penv += 2; } - if ((v=assoc(e,*penv)) != NIL) { - cdr_(v) = (e=Stack[SP-1]); - SP=saveSP; return e; + if ((v = assoc(e, *penv)) != NIL) { + cdr_(v) = (e = Stack[SP - 1]); + SP = saveSP; + return e; } set_global: - tosymbol(e, "set")->binding = (v=Stack[SP-1]); + tosymbol(e, "set")->binding = (v = Stack[SP - 1]); break; case F_BOUNDP: argcount("boundp", nargs, 1); - sym = tosymbol(Stack[SP-1], "boundp"); + sym = tosymbol(Stack[SP - 1], "boundp"); if (sym->binding == UNBOUND && sym->constant == UNBOUND) v = NIL; else @@ -1086,58 +1158,59 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) 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_CONSP: argcount("consp", 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; } v = number(s); break; case F_SUB: - if (nargs < 1) lerror("-: error: too few arguments\n"); - i = saveSP+1; - s = (nargs==1) ? 0 : tonumber(Stack[i++], "-"); + if (nargs < 1) + lerror("-: error: too few arguments\n"); + i = saveSP + 1; + s = (nargs == 1) ? 0 : tonumber(Stack[i++], "-"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "-"); s -= n; @@ -1146,19 +1219,21 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) 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; } v = number(s); break; case F_DIV: - if (nargs < 1) lerror("/: error: too few arguments\n"); - i = saveSP+1; - s = (nargs==1) ? 1 : tonumber(Stack[i++], "/"); + if (nargs < 1) + lerror("/: error: too few arguments\n"); + i = saveSP + 1; + s = (nargs == 1) ? 1 : tonumber(Stack[i++], "/"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "/"); - if (n == 0) lerror("/: error: division by zero\n"); + if (n == 0) + lerror("/: error: division by zero\n"); s /= n; } v = number(s); @@ -1169,21 +1244,23 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) // strange comparisons (for example with builtins) are resolved // arbitrarily but consistently. // ordering: number < builtin < symbol < cons - if (tag(Stack[SP-2]) != tag(Stack[SP-1])) { - v = (tag(Stack[SP-2]) < tag(Stack[SP-1]) ? T : NIL); - } - else { - switch (tag(Stack[SP-2])) { + if (tag(Stack[SP - 2]) != tag(Stack[SP - 1])) { + v = (tag(Stack[SP - 2]) < tag(Stack[SP - 1]) ? T : NIL); + } else { + switch (tag(Stack[SP - 2])) { case TAG_NUM: - v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? T : NIL; + v = + (numval(Stack[SP - 2]) < numval(Stack[SP - 1])) ? T : NIL; break; case TAG_SYM: - v = (strcmp(((symbol_t*)ptr(Stack[SP-2]))->name, - ((symbol_t*)ptr(Stack[SP-1]))->name) < 0) ? - T : NIL; + v = (strcmp(((symbol_t *)ptr(Stack[SP - 2]))->name, + ((symbol_t *)ptr(Stack[SP - 1]))->name) < 0) + ? T + : NIL; break; case TAG_BUILTIN: - v = (intval(Stack[SP-2]) < intval(Stack[SP-1])) ? T : NIL; + v = + (intval(Stack[SP - 2]) < intval(Stack[SP - 1])) ? T : NIL; break; case TAG_CONS: lerror("<: error: expected atom\n"); @@ -1192,30 +1269,33 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) 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 = Stack[SP-1]; - if (tag(v)<0x2) { SP=saveSP; return v; } + v = Stack[SP - 1]; + if (tag(v) < 0x2) { + SP = saveSP; + return v; + } if (tail) { *penv = NIL; - envend = SP = (u_int32_t)(penv-&Stack[0]) + 1; - e=v; goto eval_top; - } - else { + envend = SP = (u_int32_t)(penv - &Stack[0]) + 1; + e = v; + goto eval_top; + } else { PUSH(NIL); - v = eval_sexpr(v, &Stack[SP-1], 1, SP); + v = eval_sexpr(v, &Stack[SP - 1], 1, SP); } break; case F_PRINT: - for (i=saveSP+1; i < (int)SP; i++) - print(stdout, v=Stack[i], 0); + for (i = saveSP + 1; i < (int)SP; i++) + print(stdout, v = Stack[i], 0); fprintf(stdout, "\n"); break; case F_PRINC: - for (i=saveSP+1; i < (int)SP; i++) - print(stdout, v=Stack[i], 1); + for (i = saveSP + 1; i < (int)SP; i++) + print(stdout, v = Stack[i], 1); break; case F_READ: argcount("read", nargs, 0); @@ -1223,34 +1303,36 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) 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_EXIT: exit(0); break; case F_ERROR: - for (i=saveSP+1; i < (int)SP; i++) + for (i = saveSP + 1; i < (int)SP; i++) print(stderr, Stack[i], 1); lerror("\n"); break; case F_PROG1: // return first arg - if (nargs < 1) lerror("prog1: error: too few arguments\n"); - v = Stack[saveSP+1]; + if (nargs < 1) + lerror("prog1: error: too few arguments\n"); + v = Stack[saveSP + 1]; break; case F_ASSOC: argcount("assoc", nargs, 2); - v = assoc(Stack[SP-2], Stack[SP-1]); + v = assoc(Stack[SP - 2], Stack[SP - 1]); break; case F_APPLY: 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)]); // unpack arglist onto the stack while (iscons(v)) { PUSH(car_(v)); @@ -1263,21 +1345,20 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) } SP = saveSP; return v; - } - else { + } else { v = Stack[saveSP] = cdr_(Stack[saveSP]); } - apply_lambda: +apply_lambda: if (iscons(f)) { headsym = car_(f); // apply lambda or macro expression PUSH(cdr(cdr_(f))); PUSH(car_(cdr_(f))); - argsyms = &Stack[SP-1]; + argsyms = &Stack[SP - 1]; argenv = &Stack[SP]; // argument environment starts now if (headsym == MACRO) noeval = 1; - //else if (headsym != LAMBDA) + // else if (headsym != LAMBDA) // lerror("apply: error: head must be lambda, macro, or label\n"); // build a calling environment for the lambda // the environment is the argument binds on top of the captured @@ -1290,7 +1371,7 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) break; } asym = car_(*argsyms); - if (asym==NIL || iscons(asym)) + if (asym == NIL || iscons(asym)) lerror("apply: error: invalid formal argument\n"); v = car_(v); if (!noeval) { @@ -1306,8 +1387,7 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) PUSH(*argsyms); if (noeval) { PUSH(Stack[saveSP]); - } - else { + } else { // this version uses collective allocation. about 7-10% // faster for lists with > 2 elements, but uses more // stack space @@ -1317,47 +1397,50 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) PUSH(eval(car_(Stack[saveSP]))); Stack[saveSP] = cdr_(Stack[saveSP]); } - nargs = SP-i; + nargs = SP - i; if (nargs) { - Stack[i-1] = cons_reserve(nargs); - c = (cons_t*)ptr(Stack[i-1]); - for(; i < (int)SP; i++) { + Stack[i - 1] = cons_reserve(nargs); + c = (cons_t *)ptr(Stack[i - 1]); + for (; i < (int)SP; i++) { c->car = Stack[i]; - c->cdr = tagptr(c+1, TAG_CONS); + c->cdr = tagptr(c + 1, TAG_CONS); c++; } - (c-1)->cdr = NIL; + (c - 1)->cdr = NIL; POPN(nargs); } } - } - else if (iscons(*argsyms)) { + } else if (iscons(*argsyms)) { lerror("apply: error: too few arguments\n"); } } noeval = 0; - lenv = &Stack[saveSP+1]; - PUSH(cdr(*lenv)); // add cloenv to new environment - e = car_(Stack[saveSP+1]); + lenv = &Stack[saveSP + 1]; + PUSH(cdr(*lenv)); // add cloenv to new environment + e = car_(Stack[saveSP + 1]); // macro: evaluate expansion in the calling environment if (headsym == MACRO) { - if (tag(e)<0x2) ; - else e = eval_sexpr(e, argenv, 1, SP); + if (tag(e) < 0x2) + ; + else + e = eval_sexpr(e, argenv, 1, SP); SP = saveSP; - if (tag(e)<0x2) return(e); + if (tag(e) < 0x2) + return (e); goto eval_top; - } - else { - if (tag(e)<0x2) { SP=saveSP; return(e); } + } else { + if (tag(e) < 0x2) { + SP = saveSP; + return (e); + } if (tail) { // ok to overwrite environment nargs = (int)(&Stack[SP] - argenv); - for(i=0; i < nargs; i++) + for (i = 0; i < nargs; i++) penv[i] = argenv[i]; - envend = SP = (u_int32_t)((penv+nargs) - &Stack[0]); + envend = SP = (u_int32_t)((penv + nargs) - &Stack[0]); goto eval_top; - } - else { + } else { v = eval_sexpr(e, argenv, 1, SP); SP = saveSP; return v; @@ -1369,7 +1452,8 @@ value_t eval_sexpr(value_t e, value_t *penv, int tail, u_int32_t envend) return NIL; } -// repl ----------------------------------------------------------------------- +// repl +// ----------------------------------------------------------------------- static char *infile = NULL; @@ -1378,21 +1462,23 @@ value_t toplevel_eval(value_t expr) value_t v; u_int32_t saveSP = SP; PUSH(NIL); - v = topeval(expr, &Stack[SP-1]); + v = topeval(expr, &Stack[SP - 1]); SP = saveSP; return v; } 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 = toplevel_eval(e); } infile = lastfile; @@ -1400,11 +1486,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; @@ -1416,17 +1502,22 @@ int main(int argc, char* argv[]) goto repl; } load_file("system.lsp"); - if (argc > 1) { load_file(argv[1]); return 0; } + if (argc > 1) { + load_file(argv[1]); + return 0; + } printf("; _ \n"); printf("; |_ _ _ |_ _ | . _ _ 2\n"); printf("; | (-||||_(_)|__|_)|_)\n"); - printf(";-------------------|----------------------------------------------------------\n\n"); - repl: + printf(";-------------------|--------------------------------------------" + "--------------\n\n"); +repl: while (1) { printf("> "); v = read_sexpr(stdin); - if (feof(stdin)) break; - print(stdout, v=toplevel_eval(v), 0); + if (feof(stdin)) + break; + print(stdout, v = toplevel_eval(v), 0); set(symbol("that"), v); printf("\n\n"); } diff --git a/tiny/lispf.c b/tiny/lispf.c index 61c6e40..8e78c27 100644 --- a/tiny/lispf.c +++ b/tiny/lispf.c @@ -52,65 +52,96 @@ 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 ptr(x) ((void *)((x) & (~(value_t)0x3))) +#define tagptr(p, t) (((value_t)(p)) | (t)) #ifdef FLOAT -#define number(x) ((*(value_t*)&(x))&~0x3) -#define numval(x) (*(number_t*)&(x)) +#define number(x) ((*(value_t *)&(x)) & ~0x3) +#define numval(x) (*(number_t *)&(x)) #define NUM_FORMAT "%f" extern float strtof(const char *nptr, char **endptr); #define strtonum(s, e) strtof(s, e) #else -#define number(x) ((value_t)((x)<<2)) -#define numval(x) (((number_t)(x))>>2) +#define number(x) ((value_t)((x) << 2)) +#define numval(x) (((number_t)(x)) >> 2) #define NUM_FORMAT "%d" #define strtonum(s, e) strtol(s, e, 10) #endif -#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 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; @@ -119,7 +150,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; @@ -135,24 +167,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; @@ -160,7 +195,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); @@ -171,7 +206,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; @@ -193,35 +228,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); @@ -231,7 +270,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); } @@ -239,19 +278,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) { @@ -261,9 +303,12 @@ static value_t relocate(value_t v) return v; if (car_(v) == UNBOUND) return cdr_(v); - nc = mk_cons(); car_(nc) = NIL; - a = car_(v); d = cdr_(v); - car_(v) = UNBOUND; cdr_(v) = nc; + nc = mk_cons(); + car_(nc) = NIL; + a = car_(v); + d = cdr_(v); + car_(v) = UNBOUND; + cdr_(v) = nc; car_(nc) = relocate(a); cdr_(nc) = relocate(d); return nc; @@ -285,13 +330,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; @@ -300,24 +346,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) { @@ -352,21 +397,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) { @@ -376,22 +418,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; } @@ -404,36 +443,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 = strtonum(buf, &end); if (*end != '\0') lerror("read: error: invalid 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); } @@ -450,12 +484,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 @@ -499,29 +534,35 @@ value_t read_sexpr(FILE *f) take(); v = read_sexpr(f); PUSH(v); - v = cons_("E, cons(&Stack[SP-1], &NIL)); + v = cons_("E, 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, NUM_FORMAT, numval(v)); break; - case TAG_SYM: fprintf(f, "%s", ((symbol_t*)ptr(v))->name); break; - case TAG_BUILTIN: fprintf(f, "#", - builtin_names[intval(v)]); break; + case TAG_NUM: + fprintf(f, NUM_FORMAT, numval(v)); + break; + case TAG_SYM: + fprintf(f, "%s", ((symbol_t *)ptr(v))->name); + break; + case TAG_BUILTIN: + fprintf(f, "#", builtin_names[intval(v)]); + break; case TAG_CONS: fprintf(f, "("); while (1) { @@ -542,33 +583,44 @@ 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, nargsconstant != UNBOUND) return sym->constant; + sym = (symbol_t *)ptr(e); + if (sym->constant != UNBOUND) + return sym->constant; v = *penv; while (iscons(v)) { bind = car_(v); @@ -580,13 +632,14 @@ 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); PUSH(*penv); f = eval(car_(e), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; if (isbuiltin(f)) { // handle builtin function if (!isspecial(f)) { @@ -594,7 +647,7 @@ value_t eval_sexpr(value_t e, value_t *penv) v = Stack[saveSP] = cdr_(Stack[saveSP]); while (iscons(v)) { v = eval(car_(v), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; PUSH(v); v = Stack[saveSP] = cdr_(Stack[saveSP]); } @@ -616,10 +669,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; @@ -627,10 +680,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))); } @@ -641,22 +694,23 @@ value_t eval_sexpr(value_t e, value_t *penv) v = car(cdr_(cdr_(Stack[saveSP]))); else v = car(cdr(cdr_(cdr_(Stack[saveSP])))); - tail_eval(v, Stack[saveSP+1]); + tail_eval(v, Stack[saveSP + 1]); 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"); v = eval(c->car, penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; if (v != NIL) { *pv = cdr_(car_(*pv)); // evaluate body forms if (iscons(*pv)) { while (iscons(cdr_(*pv))) { v = eval(car_(*pv), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -668,13 +722,15 @@ 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; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv), penv)) == NIL) { - SP = saveSP; return NIL; + if ((v = eval(car_(*pv), penv)) == NIL) { + SP = saveSP; + return NIL; } - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -682,13 +738,15 @@ value_t eval_sexpr(value_t e, value_t *penv) break; case F_OR: Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = NIL; + pv = &Stack[saveSP]; + v = NIL; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { - if ((v=eval(car_(*pv), penv)) != NIL) { - SP = saveSP; return v; + if ((v = eval(car_(*pv), penv)) != NIL) { + SP = saveSP; + return v; } - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -696,25 +754,27 @@ value_t eval_sexpr(value_t e, value_t *penv) 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) { - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = eval(*body, penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; } v = *pv; break; case F_PROGN: // return last arg Stack[saveSP] = cdr_(Stack[saveSP]); - pv = &Stack[saveSP]; v = NIL; + pv = &Stack[saveSP]; + v = NIL; if (iscons(*pv)) { while (iscons(cdr_(*pv))) { v = eval(car_(*pv), penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; *pv = cdr_(*pv); } tail_eval(car_(*pv), *penv); @@ -724,66 +784,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+2; i < (int)SP; i++) { + for (i = saveSP + 2; i < (int)SP; i++) { n = tonumber(Stack[i], "+"); s += n; } @@ -792,8 +853,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+2; - s = (nargs==1) ? 0 : tonumber(Stack[i++], "-"); + i = saveSP + 2; + s = (nargs == 1) ? 0 : tonumber(Stack[i++], "-"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "-"); s -= n; @@ -802,7 +863,7 @@ value_t eval_sexpr(value_t e, value_t *penv) break; case F_MUL: s = 1; - for (i=saveSP+2; i < (int)SP; i++) { + for (i = saveSP + 2; i < (int)SP; i++) { n = tonumber(Stack[i], "*"); s *= n; } @@ -811,8 +872,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+2; - s = (nargs==1) ? 1 : tonumber(Stack[i++], "/"); + i = saveSP + 2; + s = (nargs == 1) ? 1 : tonumber(Stack[i++], "/"); for (; i < (int)SP; i++) { n = tonumber(Stack[i], "/"); if (n == 0) @@ -823,23 +884,23 @@ 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 = Stack[SP-1]; + v = Stack[SP - 1]; tail_eval(v, NIL); break; case F_PRINT: - for (i=saveSP+2; i < (int)SP; i++) - print(stdout, v=Stack[i]); + for (i = saveSP + 2; i < (int)SP; i++) + print(stdout, v = Stack[i]); break; case F_READ: argcount("read", nargs, 0); @@ -847,23 +908,24 @@ 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+2]; + v = Stack[saveSP + 2]; break; case F_APPLY: 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)]); // unpack arglist onto the stack while (iscons(v)) { PUSH(car_(v)); @@ -876,11 +938,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) { @@ -892,18 +953,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; @@ -925,10 +986,10 @@ value_t eval_sexpr(value_t e, value_t *penv) v = car_(v); if (!noeval) { v = eval(v, penv); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; } 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]); @@ -937,30 +998,28 @@ 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); - *penv = Stack[saveSP+1]; + *penv = Stack[saveSP + 1]; 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"); } } @@ -969,11 +1028,10 @@ value_t eval_sexpr(value_t e, value_t *penv) if (headsym == MACRO) { SP = saveSP; PUSH(*lenv); - lenv = &Stack[SP-1]; + lenv = &Stack[SP - 1]; v = eval(*body, lenv); tail_eval(v, *penv); - } - else { + } else { tail_eval(*body, *lenv); } // not reached @@ -982,7 +1040,8 @@ value_t eval_sexpr(value_t e, value_t *penv) return NIL; } -// repl ----------------------------------------------------------------------- +// repl +// ----------------------------------------------------------------------- static char *infile = NULL; @@ -990,21 +1049,23 @@ value_t toplevel_eval(value_t expr) { value_t v; PUSH(NIL); - v = eval(expr, &Stack[SP-1]); + v = eval(expr, &Stack[SP - 1]); POP(); return v; } 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 = toplevel_eval(e); } infile = lastfile; @@ -1012,11 +1073,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; @@ -1028,14 +1089,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=toplevel_eval(v)); + if (feof(stdin)) + break; + print(stdout, v = toplevel_eval(v)); set(symbol("that"), v); printf("\n\n"); } diff --git a/types.c b/types.c index b35eae8..e1fffe1 100644 --- a/types.c +++ b/types.c @@ -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; } } }