adding equalhash.c

some cleanup

moving some library code around for size optimization

now using == instead of flt_equals for float comparison, mostly
for hash compatibility
This commit is contained in:
JeffBezanson 2008-11-28 21:44:59 +00:00
parent e7e5677d51
commit a4bb09bcb2
18 changed files with 172 additions and 146 deletions

View File

@ -1,7 +1,7 @@
CC = gcc CC = gcc
NAME = flisp NAME = flisp
SRCS = $(NAME).c equal.c builtins.c string.c SRCS = $(NAME).c equal.c builtins.c string.c equalhash.c table.c
OBJS = $(SRCS:%.c=%.o) OBJS = $(SRCS:%.c=%.o)
DOBJS = $(SRCS:%.c=%.do) DOBJS = $(SRCS:%.c=%.do)
EXENAME = $(NAME) EXENAME = $(NAME)

View File

@ -343,11 +343,6 @@ value_t fl_randf(value_t *args, u_int32_t nargs)
(void)args; (void)nargs; (void)args; (void)nargs;
return mk_float(rand_float()); return mk_float(rand_float());
} }
value_t fl_randn(value_t *args, u_int32_t nargs)
{
(void)args; (void)nargs;
return mk_double(randn());
}
extern void stringfuncs_init(); extern void stringfuncs_init();
@ -376,7 +371,6 @@ static builtinspec_t builtin_info[] = {
{ "rand.uint64", fl_rand64 }, { "rand.uint64", fl_rand64 },
{ "rand.double", fl_randd }, { "rand.double", fl_randd },
{ "rand.float", fl_randf }, { "rand.float", fl_randf },
{ "randn", fl_randn },
{ "path.cwd", fl_path_cwd }, { "path.cwd", fl_path_cwd },

View File

@ -109,7 +109,6 @@ value_t cvalue(value_t type, size_t sz)
pcv->len = sz; pcv->len = sz;
autorelease(pcv); autorelease(pcv);
} }
pcv->deps = NIL;
pcv->type = POP(); pcv->type = POP();
return tagptr(pcv, TAG_CVALUE); return tagptr(pcv, TAG_CVALUE);
} }
@ -144,7 +143,6 @@ value_t cvalue_from_ref(value_t type, void *ptr, size_t sz, value_t parent)
pcv->flags.inlined = 0; pcv->flags.inlined = 0;
pcv->data = ptr; pcv->data = ptr;
pcv->len = sz; pcv->len = sz;
pcv->deps = NIL;
pcv->type = POP(); pcv->type = POP();
parent = POP(); parent = POP();
if (parent != NIL) { if (parent != NIL) {
@ -672,7 +670,7 @@ value_t cvalue_copy(value_t v)
static void cvalue_init(value_t type, value_t v, void *dest) static void cvalue_init(value_t type, value_t v, void *dest)
{ {
cvinitfunc_t f; cvinitfunc_t f=NULL;
if (issymbol(type)) { if (issymbol(type)) {
f = ((symbol_t*)ptr(type))->dlcache; f = ((symbol_t*)ptr(type))->dlcache;
@ -681,9 +679,6 @@ static void cvalue_init(value_t type, value_t v, void *dest)
value_t head = car_(type); value_t head = car_(type);
f = ((symbol_t*)ptr(head))->dlcache; f = ((symbol_t*)ptr(head))->dlcache;
} }
else {
f = NULL;
}
if (f == NULL) if (f == NULL)
lerror(ArgError, "c-value: invalid c type"); lerror(ArgError, "c-value: invalid c type");

View File

@ -331,7 +331,14 @@ static uptrint_t bounded_hash(value_t a, int bound)
return 0; return 0;
} }
uptrint_t hash(value_t a) int equal_lispvalue(value_t a, value_t b)
{
if (eq_comparable(a, b))
return (a==b);
return (numval(compare_(a,b,1))==0);
}
uptrint_t hash_lispvalue(value_t a)
{ {
return bounded_hash(a, BOUNDED_HASH_BOUND); return bounded_hash(a, BOUNDED_HASH_BOUND);
} }
@ -339,5 +346,5 @@ uptrint_t hash(value_t a)
value_t fl_hash(value_t *args, u_int32_t nargs) value_t fl_hash(value_t *args, u_int32_t nargs)
{ {
argcount("hash", nargs, 1); argcount("hash", nargs, 1);
return fixnum(hash(args[0])); return fixnum(hash_lispvalue(args[0]));
} }

12
femtolisp/equalhash.c Normal file
View File

@ -0,0 +1,12 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <assert.h>
#include <limits.h>
#include "llt.h"
#include "flisp.h"
#include "htable.inc"
HTIMPL(equalhash, hash_lispvalue, equal_lispvalue)

8
femtolisp/equalhash.h Normal file
View File

@ -0,0 +1,8 @@
#ifndef __EQUALHASH_H_
#define __EQUALHASH_H_
#include "htableh.inc"
HTPROT(equalhash)
#endif

View File

@ -413,6 +413,11 @@ static value_t relocate(value_t v)
return v; return v;
} }
value_t relocate_lispvalue(value_t v)
{
return relocate(v);
}
static void trace_globals(symbol_t *root) static void trace_globals(symbol_t *root)
{ {
while (root != NULL) { while (root != NULL) {

View File

@ -133,7 +133,10 @@ size_t llength(value_t v);
value_t list_nth(value_t l, size_t n); value_t list_nth(value_t l, size_t n);
value_t compare(value_t a, value_t b); // -1, 0, or 1 value_t compare(value_t a, value_t b); // -1, 0, or 1
value_t equal(value_t a, value_t b); // T or nil value_t equal(value_t a, value_t b); // T or nil
uptrint_t hash(value_t a); int equal_lispvalue(value_t a, value_t b);
uptrint_t hash_lispvalue(value_t a);
value_t relocate_lispvalue(value_t v);
void print_traverse(value_t v);
value_t fl_hash(value_t *args, u_int32_t nargs); value_t fl_hash(value_t *args, u_int32_t nargs);
/* safe casts */ /* safe casts */
@ -189,7 +192,7 @@ typedef struct {
typedef struct { typedef struct {
void (*print)(value_t self, ios_t *f, int princ); void (*print)(value_t self, ios_t *f, int princ);
void (*relocate)(value_t old, value_t new); void (*relocate)(value_t oldv, value_t newv);
void (*finalize)(value_t self); void (*finalize)(value_t self);
void (*print_traverse)(value_t self); void (*print_traverse)(value_t self);
} cvtable_t; } cvtable_t;
@ -200,7 +203,6 @@ typedef struct {
unsigned long flagbits; unsigned long flagbits;
}; };
value_t type; value_t type;
value_t deps;
//cvtable_t *vtable; //cvtable_t *vtable;
// fields below are absent in inline-allocated values // fields below are absent in inline-allocated values
void *data; void *data;

View File

@ -30,7 +30,7 @@ static void outindent(int n, ios_t *f)
} }
} }
static void print_traverse(value_t v) void print_traverse(value_t v)
{ {
value_t *bp; value_t *bp;
while (iscons(v)) { while (iscons(v)) {

View File

@ -46,24 +46,24 @@ void free_htable(value_t self)
htable_free(&pt->ht); htable_free(&pt->ht);
} }
void relocate_htable(value_t old, value_t new) void relocate_htable(value_t oldv, value_t newv)
{ {
fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(self)); fltable_t *pt = (fltable_t*)cv_data((cvalue_t*)ptr(newv));
htable_t *h = &pt->ht; htable_t *h = &pt->ht;
size_t i; size_t i;
for(i=0; i < h->size; i++) { for(i=0; i < h->size; i++) {
if (h->table[i] != HT_NOTFOUND) if (h->table[i] != HT_NOTFOUND)
h->table[i] = (void*)relocate((value_t)h->table[i]); h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]);
} }
} }
void rehash_htable(value_t old, value_t new) void rehash_htable(value_t oldv, value_t newv)
{ {
} }
cvtable_t h_r1_vtable = { print_htable, NULL, free_htable }; cvtable_t h_r1_vtable = { print_htable, NULL, free_htable, NULL };
cvtable_t h_r2_vtable = { print_htable, relocate_htable, free_htable }; cvtable_t h_r2_vtable = { print_htable, relocate_htable, free_htable, NULL };
cvtable_t h_r3_vtable = { print_htable, rehash_htable, free_htable }; cvtable_t h_r3_vtable = { print_htable, rehash_htable, free_htable, NULL };
int ishashtable(value_t v) int ishashtable(value_t v)
{ {
@ -72,6 +72,7 @@ int ishashtable(value_t v)
value_t fl_table(value_t *args, u_int32_t nargs) value_t fl_table(value_t *args, u_int32_t nargs)
{ {
return NIL;
} }
value_t fl_hashtablep(value_t *args, u_int32_t nargs) value_t fl_hashtablep(value_t *args, u_int32_t nargs)

View File

@ -965,8 +965,9 @@ typedef struct _fltype_t {
value_t type; value_t type;
int numtype; int numtype;
size_t sz; size_t sz;
size_t elsz;
cvtable_t *vtable; cvtable_t *vtable;
int marked;
struct _fltype_t *eltype; // for arrays struct _fltype_t *eltype; // for arrays
struct _fltype_t *artype; // (array this) struct _fltype_t *artype; // (array this)
int marked;
} fltype_t; } fltype_t;

View File

@ -1,7 +1,8 @@
CC = gcc CC = gcc
SRCS = bitvector.c hashing.c socket.c timefuncs.c utils.c dblprint.c ptrhash.c \ SRCS = bitvector.c hashing.c socket.c timefuncs.c utils.c dblprint.c ptrhash.c \
utf8.c ios.c operators.c cplxprint.c dirpath.c htable.c bitvector-ops.c utf8.c ios.c operators.c cplxprint.c dirpath.c htable.c \
bitvector-ops.c fp.c
OBJS = $(SRCS:%.c=%.o) OBJS = $(SRCS:%.c=%.o)
DOBJS = $(SRCS:%.c=%.do) DOBJS = $(SRCS:%.c=%.do)
TARGET = libllt.a TARGET = libllt.a

View File

@ -45,14 +45,14 @@ void snprint_cplx(char *s, size_t cnt, double re, double im,
} }
if (!fzi) { if (!fzi) {
len = sl = strlen(s); len = sl = strlen(s);
if (dbl_equals(im, -1)) { if (im == -1) {
while ((long)(len-sl) < (long)(width-2) && len < (space-3)) while ((long)(len-sl) < (long)(width-2) && len < (space-3))
s[len++] = ' '; s[len++] = ' ';
s[len] = '-'; s[len] = '-';
s[len+1] = 'i'; s[len+1] = 'i';
s[len+2] = '\0'; s[len+2] = '\0';
} }
else if (dbl_equals(im, 1)) { else if (im == 1) {
while ((long)(len-sl) < (long)(width-1) && len < (space-2)) while ((long)(len-sl) < (long)(width-1) && len < (space-2))
s[len++] = ' '; s[len++] = ' ';
s[len] = 'i'; s[len] = 'i';

View File

@ -5,87 +5,6 @@
#include "ieee754.h" #include "ieee754.h"
#include "dtypes.h" #include "dtypes.h"
static uint64_t max_ulps;
static uint32_t flt_max_ulps;
static uint64_t nexti64pow2(uint64_t i)
{
if (i==0) return 1;
if ((i&(i-1))==0) return i;
if (i&BIT63) return BIT63;
// repeatedly clear bottom bit
while (i&(i-1))
i = i&(i-1);
return i<<1;
}
static uint32_t nexti32pow2(uint32_t i)
{
if (i==0) return 1;
if ((i&(i-1))==0) return i;
if (i&BIT31) return BIT31;
// repeatedly clear bottom bit
while (i&(i-1))
i = i&(i-1);
return i<<1;
}
void dbl_tolerance(double tol)
{
max_ulps = nexti64pow2((uint64_t)(tol/DBL_EPSILON));
}
void flt_tolerance(float tol)
{
flt_max_ulps = nexti32pow2((uint32_t)(tol/FLT_EPSILON));
}
#ifdef __INTEL_COMPILER
static inline int64_t llabs(int64_t j)
{
return NBABS(j, 64);
}
#else
extern int64_t llabs(int64_t j);
#endif
int dbl_equals(double a, double b)
{
int64_t aint, bint;
if (a == b)
return 1;
aint = *(int64_t*)&a;
bint = *(int64_t*)&b;
if (aint < 0)
aint = BIT63 - aint;
if (bint < 0)
bint = BIT63 - bint;
/* you'd think it makes no difference whether the result of llabs is
signed or unsigned, but if it's signed then the case of
0x8000000000000000 blows up, making 4 == -1 :) */
if ((uint64_t)llabs(aint-bint) <= max_ulps)
return 1;
return 0;
}
int flt_equals(float a, float b)
{
int32_t aint, bint;
if (a == b)
return 1;
aint = *(int32_t*)&a;
bint = *(int32_t*)&b;
if (aint < 0)
aint = BIT31 - aint;
if (bint < 0)
bint = BIT31 - bint;
if ((uint32_t)abs(aint-bint) <= flt_max_ulps)
return 1;
return 0;
}
int double_exponent(double d) int double_exponent(double d)
{ {
union ieee754_double dl; union ieee754_double dl;

110
llt/fp.c Normal file
View File

@ -0,0 +1,110 @@
#include <math.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include "ieee754.h"
#include "dtypes.h"
#include "hashing.h"
static uint64_t max_ulps;
static uint32_t flt_max_ulps;
static uint64_t nexti64pow2(uint64_t i)
{
if (i==0) return 1;
if ((i&(i-1))==0) return i;
if (i&BIT63) return BIT63;
// repeatedly clear bottom bit
while (i&(i-1))
i = i&(i-1);
return i<<1;
}
static uint32_t nexti32pow2(uint32_t i)
{
if (i==0) return 1;
if ((i&(i-1))==0) return i;
if (i&BIT31) return BIT31;
// repeatedly clear bottom bit
while (i&(i-1))
i = i&(i-1);
return i<<1;
}
void dbl_tolerance(double tol)
{
max_ulps = nexti64pow2((uint64_t)(tol/DBL_EPSILON));
}
void flt_tolerance(float tol)
{
flt_max_ulps = nexti32pow2((uint32_t)(tol/FLT_EPSILON));
}
#ifdef __INTEL_COMPILER
static inline int64_t llabs(int64_t j)
{
return NBABS(j, 64);
}
#else
extern int64_t llabs(int64_t j);
#endif
int dbl_equals(double a, double b)
{
int64_t aint, bint;
if (a == b)
return 1;
aint = *(int64_t*)&a;
bint = *(int64_t*)&b;
if (aint < 0)
aint = BIT63 - aint;
if (bint < 0)
bint = BIT63 - bint;
/* you'd think it makes no difference whether the result of llabs is
signed or unsigned, but if it's signed then the case of
0x8000000000000000 blows up, making 4 == -1 :) */
if ((uint64_t)llabs(aint-bint) <= max_ulps)
return 1;
return 0;
}
int flt_equals(float a, float b)
{
int32_t aint, bint;
if (a == b)
return 1;
aint = *(int32_t*)&a;
bint = *(int32_t*)&b;
if (aint < 0)
aint = BIT31 - aint;
if (bint < 0)
bint = BIT31 - bint;
if ((uint32_t)abs(aint-bint) <= flt_max_ulps)
return 1;
return 0;
}
double randn()
{
double s, vre, vim, ure, uim;
static double next = -42;
if (next != -42) {
s = next;
next = -42;
return s;
}
do {
ure = rand_double();
uim = rand_double();
vre = 2*ure - 1;
vim = 2*uim - 1;
s = vre*vre + vim*vim;
} while (s >= 1);
s = sqrt(-2*log(s)/s);
next = s * vre;
return s * vim;
}

View File

@ -99,28 +99,6 @@ float rand_float()
return f.f - 1.0; return f.f - 1.0;
} }
double randn()
{
double s, vre, vim, ure, uim;
static double next = -42;
if (next != -42) {
s = next;
next = -42;
return s;
}
do {
ure = rand_double();
uim = rand_double();
vre = 2*ure - 1;
vim = 2*uim - 1;
s = vre*vre + vim*vim;
} while (s >= 1);
s = sqrt(-2*log(s)/s);
next = s * vre;
return s * vim;
}
void randomize() void randomize()
{ {
u_int64_t tm = i64time(); u_int64_t tm = i64time();
@ -138,14 +116,6 @@ float F_NINF;
void llt_init() void llt_init()
{ {
/*
I used this function to guess good values based on epsilon:
tol(eps) = exp(ln(eps)*-.2334012088721472)*eps
I derived the constant by hallucinating freely.
*/
dbl_tolerance(1e-12);
flt_tolerance(5e-6);
randomize(); randomize();
ios_init_stdstreams(); ios_init_stdstreams();

View File

@ -60,7 +60,7 @@ static void **HTNAME##_lookup_bp(htable_t *h, void *key) \
h->table = tab; \ h->table = tab; \
h->size = newsz; \ h->size = newsz; \
for(i=0; i < sz; i+=2) { \ for(i=0; i < sz; i+=2) { \
if (ol[i] != HT_NOTFOUND && ol[i+1] != HT_NOTFOUND) { \ if (ol[i+1] != HT_NOTFOUND) { \
(*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1]; \ (*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1]; \
} \ } \
} \ } \
@ -87,6 +87,7 @@ void **HTNAME##_bp(htable_t *h, void *key) \
} \ } \
\ \
/* returns bp if key is in hash, otherwise NULL */ \ /* returns bp if key is in hash, otherwise NULL */ \
/* if return is non-NULL and *bp == HT_NOTFOUND then key was deleted */ \
static void **HTNAME##_peek_bp(htable_t *h, void *key) \ static void **HTNAME##_peek_bp(htable_t *h, void *key) \
{ \ { \
size_t sz = hash_size(h); \ size_t sz = hash_size(h); \
@ -100,7 +101,7 @@ static void **HTNAME##_peek_bp(htable_t *h, void *key) \
do { \ do { \
if (tab[index] == HT_NOTFOUND) \ if (tab[index] == HT_NOTFOUND) \
return NULL; \ return NULL; \
if (EQFUNC(key, tab[index]) && tab[index+1] != HT_NOTFOUND) \ if (EQFUNC(key, tab[index])) \
return &tab[index+1]; \ return &tab[index+1]; \
\ \
index = (index+2) & (sz-1); \ index = (index+2) & (sz-1); \

View File

@ -167,8 +167,8 @@ int cmp_same_eq(void *a, void *b, numerictype_t tag)
case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b; case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b;
case T_INT64: return *(int64_t*)a == *(int64_t*)b; case T_INT64: return *(int64_t*)a == *(int64_t*)b;
case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b; case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b;
case T_FLOAT: return flt_equals(*(float*)a, *(float*)b); case T_FLOAT: return *(float*)a == *(float*)b;
case T_DOUBLE: return dbl_equals(*(double*)a, *(double*)b); case T_DOUBLE: return *(double*)a == *(double*)b;
} }
return 0; return 0;
} }
@ -234,7 +234,7 @@ int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag)
double db = conv_to_double(b, btag); double db = conv_to_double(b, btag);
if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT) if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT)
return dbl_equals(da, db); return (da == db);
if (da != db) if (da != db)
return 0; return 0;