remove and clean up some old files
This commit is contained in:
Jeff Bezanson
parent
07dfa697df
commit
6041c7b40e
13
FLOSSING
13
FLOSSING
|
|
@ -1,13 +0,0 @@
|
|||
Flossing is important to overall oral health.
|
||||
|
||||
Even by itself, flossing does a good job of cleaning teeth and gums,
|
||||
and is the only way to clean below the gumline.
|
||||
|
||||
However it has an important secondary purpose as well. Most people assume
|
||||
the point of brushing teeth is to scrub the teeth with bristles. This
|
||||
is not fully true; the more significant purpose of brushing is to apply
|
||||
fluoride to teeth. If you don't floss, food particles are left between
|
||||
the teeth and gums, blocking fluoride from reaching tooth surfaces. It
|
||||
is then as if you were not brushing at all. Even if no material is
|
||||
visible between teeth, there is probably some there. Flossing can pull
|
||||
a surprising amount of gunk from a mouth that appears totally clean.
|
||||
|
|
@ -1,59 +0,0 @@
|
|||
typedef struct {
|
||||
size_t n, maxsize;
|
||||
unsigned long *items;
|
||||
} ltable_t;
|
||||
|
||||
void ltable_init(ltable_t *t, size_t n)
|
||||
{
|
||||
t->n = 0;
|
||||
t->maxsize = n;
|
||||
t->items = (unsigned long*)malloc(n * sizeof(unsigned long));
|
||||
}
|
||||
|
||||
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;
|
||||
t->items = p;
|
||||
t->maxsize *= 2;
|
||||
}
|
||||
t->items[t->n++] = item;
|
||||
}
|
||||
|
||||
#define LT_NOTFOUND ((int)-1)
|
||||
|
||||
int ltable_lookup(ltable_t *t, unsigned long item)
|
||||
{
|
||||
int i;
|
||||
for(i=0; i < (int)t->n; i++)
|
||||
if (t->items[i] == item)
|
||||
return i;
|
||||
return LT_NOTFOUND;
|
||||
}
|
||||
|
||||
void ltable_adjoin(ltable_t *t, unsigned long item)
|
||||
{
|
||||
if (ltable_lookup(t, item) == LT_NOTFOUND)
|
||||
ltable_insert(t, item);
|
||||
}
|
||||
|
||||
char *snprintf_gensym_id(char *nbuf, size_t n, u_int32_t g)
|
||||
{
|
||||
size_t i=n-1;
|
||||
|
||||
nbuf[i--] = '\0';
|
||||
do {
|
||||
nbuf[i--] = '0' + g%10;
|
||||
g/=10;
|
||||
} while (g && i);
|
||||
nbuf[i] = 'g';
|
||||
return &nbuf[i];
|
||||
}
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
; property lists. they really suck.
|
||||
(setq *plists* nil)
|
||||
|
||||
(defun symbol-plist (sym)
|
||||
(cdr (or (assoc sym *plists*) '(()))))
|
||||
|
||||
(defun set-symbol-plist (sym lst)
|
||||
(let ((p (assoc sym *plists*)))
|
||||
(if (null p) ; sym has no plist yet
|
||||
(setq *plists* (cons (cons sym lst) *plists*))
|
||||
(rplacd p lst))))
|
||||
|
||||
(defun get (sym prop)
|
||||
(let ((pl (symbol-plist sym)))
|
||||
(if pl
|
||||
(let ((pr (member prop pl)))
|
||||
(if pr (cadr pr) nil))
|
||||
nil)))
|
||||
|
||||
(defun put (sym prop val)
|
||||
(let ((p (assoc sym *plists*)))
|
||||
(if (null p) ; sym has no plist yet
|
||||
(setq *plists* (cons (list sym prop val) *plists*))
|
||||
(let ((pr (member prop p)))
|
||||
(if (null pr) ; sym doesn't have this property yet
|
||||
(rplacd p (cons prop (cons val (cdr p))))
|
||||
(rplaca (cdr pr) val)))))
|
||||
val)
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
(define (equal a b)
|
||||
(if (and (consp a) (consp b))
|
||||
(and (equal (car a) (car b))
|
||||
(equal (cdr a) (cdr b)))
|
||||
(eq a b)))
|
||||
|
||||
; compare imposes an ordering on all values. yields -1 for a<b,
|
||||
; 0 for a==b, and 1 for a>b. lists are compared up to the first
|
||||
; point of difference.
|
||||
(defun compare (a b)
|
||||
(cond ((eq a b) 0)
|
||||
((or (atom a) (atom b)) (if (< a b) -1 1))
|
||||
(T (let ((c (compare (car a) (car b))))
|
||||
(if (not (eq c 0))
|
||||
c
|
||||
(compare (cdr a) (cdr b)))))))
|
||||
|
||||
(defun length (l)
|
||||
(if (null l) 0
|
||||
(+ 1 (length (cdr l)))))
|
||||
|
||||
(define (assoc item lst)
|
||||
(cond ((atom lst) ())
|
||||
((eq (caar lst) item) (car lst))
|
||||
(T (assoc item (cdr lst)))))
|
||||
303
attic/trash.c
303
attic/trash.c
|
|
@ -1,303 +0,0 @@
|
|||
value_t prim_types[32];
|
||||
value_t *prim_sym_addrs[] = {
|
||||
&int8sym, &uint8sym, &int16sym, &uint16sym, &int32sym, &uint32sym,
|
||||
&int64sym, &uint64sym, &charsym, &ucharsym, &shortsym, &ushortsym,
|
||||
&intsym, &uintsym, &longsym, &ulongsym,
|
||||
&lispvaluesym };
|
||||
#define N_PRIMSYMS (sizeof(prim_sym_addrs) / sizeof(value_t*))
|
||||
|
||||
static value_t cv_type(cvalue_t *cv)
|
||||
{
|
||||
if (cv->flags.prim) {
|
||||
return prim_types[cv->flags.primtype];
|
||||
}
|
||||
return cv->type;
|
||||
}
|
||||
|
||||
|
||||
double t0,t1;
|
||||
int i;
|
||||
int32_t i32;
|
||||
char s8;
|
||||
ulong_t c8=3;
|
||||
t0 = clock(); //0.058125017
|
||||
set_secret_symtag(ulongsym,TAG_UINT32);
|
||||
set_secret_symtag(int8sym,TAG_INT8);
|
||||
for(i=0; i < 8000000; i++) {
|
||||
cnvt_to_int32(&i32, &s8, int8sym);
|
||||
c8+=c8;
|
||||
s8+=s8;
|
||||
}
|
||||
t1 = clock();
|
||||
printf("%d. that took %.16f\n", i32, t1-t0);
|
||||
|
||||
|
||||
#define int_converter(type) \
|
||||
static int cnvt_to_##type(type##_t *i, void *data, value_t type) \
|
||||
{ \
|
||||
if (type==int32sym) *i = *(int32_t*)data; \
|
||||
else if (type==charsym) *i = *(char*)data; \
|
||||
else if (type==ulongsym) *i = *(ulong*)data; \
|
||||
else if (type==uint32sym) *i = *(uint32_t*)data; \
|
||||
else if (type==int8sym) *i = *(int8_t*)data; \
|
||||
else if (type==uint8sym) *i = *(uint8_t*)data; \
|
||||
else if (type==int64sym) *i = *(int64_t*)data; \
|
||||
else if (type==uint64sym) *i = *(uint64_t*)data; \
|
||||
else if (type==wcharsym) *i = *(wchar_t*)data; \
|
||||
else if (type==longsym) *i = *(long*)data; \
|
||||
else if (type==int16sym) *i = *(int16_t*)data; \
|
||||
else if (type==uint16sym) *i = *(uint16_t*)data; \
|
||||
else \
|
||||
return 1; \
|
||||
return 0; \
|
||||
}
|
||||
int_converter(int32)
|
||||
int_converter(uint32)
|
||||
int_converter(int64)
|
||||
int_converter(uint64)
|
||||
|
||||
#ifdef BITS64
|
||||
#define cnvt_to_ulong(i,d,t) cnvt_to_uint64(i,d,t)
|
||||
#else
|
||||
#define cnvt_to_ulong(i,d,t) cnvt_to_uint32(i,d,t)
|
||||
#endif
|
||||
|
||||
long intabs(long n)
|
||||
{
|
||||
long s = n>>(NBITS-1); // either -1 or 0
|
||||
return (n^s) - s;
|
||||
}
|
||||
|
||||
value_t fl_inv(value_t b)
|
||||
{
|
||||
int_t bi;
|
||||
int tb;
|
||||
void *bptr=NULL;
|
||||
cvalue_t *cv;
|
||||
|
||||
if (isfixnum(b)) {
|
||||
bi = numval(b);
|
||||
if (bi == 0)
|
||||
goto inv_error;
|
||||
else if (bi == 1)
|
||||
return fixnum(1);
|
||||
else if (bi == -1)
|
||||
return fixnum(-1);
|
||||
return fixnum(0);
|
||||
}
|
||||
else if (iscvalue(b)) {
|
||||
cv = (cvalue_t*)ptr(b);
|
||||
tb = cv_numtype(cv);
|
||||
if (tb <= T_DOUBLE)
|
||||
bptr = cv_data(cv);
|
||||
}
|
||||
if (bptr == NULL)
|
||||
type_error("/", "number", b);
|
||||
|
||||
if (tb == T_FLOAT)
|
||||
return mk_double(1.0/(double)*(float*)bptr);
|
||||
if (tb == T_DOUBLE)
|
||||
return mk_double(1.0 / *(double*)bptr);
|
||||
|
||||
if (tb == T_UINT64) {
|
||||
if (*(uint64_t*)bptr > 1)
|
||||
return fixnum(0);
|
||||
else if (*(uint64_t*)bptr == 1)
|
||||
return fixnum(1);
|
||||
goto inv_error;
|
||||
}
|
||||
int64_t b64 = conv_to_int64(bptr, tb);
|
||||
if (b64 == 0) goto inv_error;
|
||||
else if (b64 == 1) return fixnum(1);
|
||||
else if (b64 == -1) return fixnum(-1);
|
||||
|
||||
return fixnum(0);
|
||||
inv_error:
|
||||
lerror(DivideError, "/: division by zero");
|
||||
}
|
||||
|
||||
static void printstack(value_t *penv, uint32_t envsz)
|
||||
{
|
||||
int i;
|
||||
printf("env=%d, size=%d\n", penv - &Stack[0], envsz);
|
||||
for(i=0; i < SP; i++) {
|
||||
printf("%d: ", i);
|
||||
print(stdout, Stack[i], 0);
|
||||
printf("\n");
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
|
||||
// unordered comparison
|
||||
// not any faster than ordered comparison
|
||||
|
||||
// a is a fixnum, b is a cvalue
|
||||
static value_t equal_num_cvalue(value_t a, value_t b)
|
||||
{
|
||||
cvalue_t *bcv = (cvalue_t*)ptr(b);
|
||||
numerictype_t bt;
|
||||
if (valid_numtype(bt=cv_numtype(bcv))) {
|
||||
fixnum_t ia = numval(a);
|
||||
void *bptr = cv_data(bcv);
|
||||
if (cmp_eq(&ia, T_FIXNUM, bptr, bt))
|
||||
return fixnum(0);
|
||||
}
|
||||
return fixnum(1);
|
||||
}
|
||||
|
||||
static value_t bounded_equal(value_t a, value_t b, int bound);
|
||||
static value_t cyc_equal(value_t a, value_t b, ptrhash_t *table);
|
||||
|
||||
static value_t bounded_vector_equal(value_t a, value_t b, int bound)
|
||||
{
|
||||
size_t la = vector_size(a);
|
||||
size_t lb = vector_size(b);
|
||||
if (la != lb) return fixnum(1);
|
||||
size_t i;
|
||||
for (i = 0; i < la; i++) {
|
||||
value_t d = bounded_equal(vector_elt(a,i), vector_elt(b,i), bound-1);
|
||||
if (d==NIL || numval(d)!=0) return d;
|
||||
}
|
||||
return fixnum(0);
|
||||
}
|
||||
|
||||
static value_t bounded_equal(value_t a, value_t b, int bound)
|
||||
{
|
||||
value_t d;
|
||||
|
||||
compare_top:
|
||||
if (a == b) return fixnum(0);
|
||||
if (bound <= 0)
|
||||
return NIL;
|
||||
int taga = tag(a);
|
||||
int tagb = cmptag(b);
|
||||
switch (taga) {
|
||||
case TAG_NUM :
|
||||
case TAG_NUM1:
|
||||
if (isfixnum(b)) {
|
||||
return fixnum(1);
|
||||
}
|
||||
if (iscvalue(b)) {
|
||||
return equal_num_cvalue(a, b);
|
||||
}
|
||||
return fixnum(1);
|
||||
case TAG_SYM:
|
||||
return fixnum(1);
|
||||
case TAG_VECTOR:
|
||||
if (isvector(b))
|
||||
return bounded_vector_equal(a, b, bound);
|
||||
break;
|
||||
case TAG_CVALUE:
|
||||
if (iscvalue(b)) {
|
||||
cvalue_t *acv=(cvalue_t*)ptr(a), *bcv=(cvalue_t*)ptr(b);
|
||||
numerictype_t at, bt;
|
||||
if (valid_numtype(at=cv_numtype(acv)) &&
|
||||
valid_numtype(bt=cv_numtype(bcv))) {
|
||||
void *aptr = cv_data(acv);
|
||||
void *bptr = cv_data(bcv);
|
||||
if (cmp_eq(aptr, at, bptr, bt))
|
||||
return fixnum(0);
|
||||
return fixnum(1);
|
||||
}
|
||||
return cvalue_compare(a, b);
|
||||
}
|
||||
else if (isfixnum(b)) {
|
||||
return equal_num_cvalue(b, a);
|
||||
}
|
||||
break;
|
||||
case TAG_BUILTIN:
|
||||
return fixnum(1);
|
||||
case TAG_CONS:
|
||||
if (tagb != TAG_CONS) return fixnum(1);
|
||||
d = bounded_equal(car_(a), car_(b), bound-1);
|
||||
if (d==NIL || numval(d) != 0) return d;
|
||||
a = cdr_(a); b = cdr_(b);
|
||||
bound--;
|
||||
goto compare_top;
|
||||
}
|
||||
return fixnum(1);
|
||||
}
|
||||
|
||||
static value_t cyc_vector_equal(value_t a, value_t b, ptrhash_t *table)
|
||||
{
|
||||
size_t la = vector_size(a);
|
||||
size_t lb = vector_size(b);
|
||||
size_t i;
|
||||
value_t d, xa, xb, ca, cb;
|
||||
if (la != lb) return fixnum(1);
|
||||
|
||||
// first try to prove them different with no recursion
|
||||
for (i = 0; i < la; i++) {
|
||||
xa = vector_elt(a,i);
|
||||
xb = vector_elt(b,i);
|
||||
if (leafp(xa) || leafp(xb)) {
|
||||
d = bounded_equal(xa, xb, 1);
|
||||
if (numval(d)!=0) return d;
|
||||
}
|
||||
else if (cmptag(xa) != cmptag(xb)) {
|
||||
return fixnum(1);
|
||||
}
|
||||
}
|
||||
|
||||
ca = eq_class(table, a);
|
||||
cb = eq_class(table, b);
|
||||
if (ca!=NIL && ca==cb)
|
||||
return fixnum(0);
|
||||
|
||||
eq_union(table, a, b, ca, cb);
|
||||
|
||||
for (i = 0; i < la; i++) {
|
||||
xa = vector_elt(a,i);
|
||||
xb = vector_elt(b,i);
|
||||
if (!leafp(xa) && !leafp(xb)) {
|
||||
d = cyc_equal(xa, xb, table);
|
||||
if (numval(d)!=0) return d;
|
||||
}
|
||||
}
|
||||
|
||||
return fixnum(0);
|
||||
}
|
||||
|
||||
static value_t cyc_equal(value_t a, value_t b, ptrhash_t *table)
|
||||
{
|
||||
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 = cmptag(aa); int tagda = cmptag(da);
|
||||
int tagab = cmptag(ab); int tagdb = cmptag(db);
|
||||
value_t d, ca, cb;
|
||||
if (leafp(aa) || leafp(ab)) {
|
||||
d = bounded_equal(aa, ab, 1);
|
||||
if (numval(d)!=0) return d;
|
||||
}
|
||||
else if (tagaa != tagab)
|
||||
return fixnum(1);
|
||||
if (leafp(da) || leafp(db)) {
|
||||
d = bounded_equal(da, db, 1);
|
||||
if (numval(d)!=0) return d;
|
||||
}
|
||||
else if (tagda != tagdb)
|
||||
return fixnum(1);
|
||||
|
||||
ca = eq_class(table, a);
|
||||
cb = eq_class(table, b);
|
||||
if (ca!=NIL && ca==cb)
|
||||
return fixnum(0);
|
||||
|
||||
eq_union(table, a, b, ca, cb);
|
||||
d = cyc_equal(aa, ab, table);
|
||||
if (numval(d)!=0) return d;
|
||||
return cyc_equal(da, db, table);
|
||||
}
|
||||
else {
|
||||
return fixnum(1);
|
||||
}
|
||||
}
|
||||
else if (isvector(a) && isvector(b)) {
|
||||
return cyc_vector_equal(a, b, table);
|
||||
}
|
||||
return bounded_equal(a, b, 1);
|
||||
}
|
||||
1448
tiny/lisp2.c.bak
1448
tiny/lisp2.c.bak
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue