remove and clean up some old files
This commit is contained in:
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