diff --git a/bin/ikarus b/bin/ikarus index e34e3f1..76ba2a1 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-collect.c b/bin/ikarus-collect.c index 23685f1..2cdb862 100644 --- a/bin/ikarus-collect.c +++ b/bin/ikarus-collect.c @@ -1018,8 +1018,6 @@ add_object_proc(gc_t* gc, ikp x) ref(y,off_tcbucket_key) = key; ref(y,off_tcbucket_val) = ref(x, off_tcbucket_val); ref(y,off_tcbucket_next) = ref(x, off_tcbucket_next); - ref(y,off_tcbucket_dlink_next) = ref(x, off_tcbucket_dlink_next); - ref(y,off_tcbucket_dlink_prev) = ref(x, off_tcbucket_dlink_prev); if((! is_fixnum(key)) && (tagof(key) != immediate_tag)){ unsigned int kt = gc->segment_vector[page_index(key)]; if((kt & gen_mask) <= gc->collect_gen){ diff --git a/bin/ikarus-data.h b/bin/ikarus-data.h index 507400f..b3f449b 100644 --- a/bin/ikarus-data.h +++ b/bin/ikarus-data.h @@ -181,15 +181,11 @@ #define disp_tcbucket_key 4 #define disp_tcbucket_val 8 #define disp_tcbucket_next 12 -#define disp_tcbucket_dlink_prev 16 -#define disp_tcbucket_dlink_next 20 -#define tcbucket_size 24 +#define tcbucket_size 16 #define off_tcbucket_tconc (disp_tcbucket_tconc - vector_tag) #define off_tcbucket_key (disp_tcbucket_key - vector_tag) #define off_tcbucket_val (disp_tcbucket_val - vector_tag) #define off_tcbucket_next (disp_tcbucket_next - vector_tag) -#define off_tcbucket_dlink_next (disp_tcbucket_dlink_next - vector_tag) -#define off_tcbucket_dlink_prev (disp_tcbucket_dlink_prev - vector_tag) #define bignum_mask 0x7 diff --git a/src/ikarus.boot b/src/ikarus.boot index d1cd35b..673b918 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcompile.ss b/src/libcompile.ss index e584d79..3fa533a 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -160,12 +160,8 @@ [$tcbucket-key 1 value] [$tcbucket-val 1 value] [$tcbucket-next 1 value] - [$tcbucket-dlink-next 1 value] - [$tcbucket-dlink-prev 1 value] [$set-tcbucket-val! 2 effect] [$set-tcbucket-next! 2 effect] - [$set-tcbucket-dlink-next! 2 effect] - [$set-tcbucket-dlink-prev! 2 effect] [$set-tcbucket-tconc! 2 effect] ;;; misc [eof-object 0 value] @@ -2038,11 +2034,7 @@ $make-record $record? $record/rtd? $record-rtd $record-ref $record-set! primitive-set! primitive-ref $make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next - $tcbucket-dlink-next - $tcbucket-dlink-prev $set-tcbucket-val! - $set-tcbucket-dlink-next! - $set-tcbucket-dlink-prev! $set-tcbucket-next! $set-tcbucket-tconc!) #t] [else (error 'valid-arg-types? "unhandled op ~s" op)])) @@ -3071,8 +3063,6 @@ (define disp-tcbucket-key 4) (define disp-tcbucket-val 8) (define disp-tcbucket-next 12) - (define disp-tcbucket-dlink-prev 16) - (define disp-tcbucket-dlink-next 20) (define tcbucket-size 24) (define record-ptag 5) (define record-pmask 7) @@ -3725,10 +3715,6 @@ (indirect-ref arg* (fx- disp-tcbucket-val vector-tag) ac)] [($tcbucket-next) (indirect-ref arg* (fx- disp-tcbucket-next vector-tag) ac)] - [($tcbucket-dlink-next) - (indirect-ref arg* (fx- disp-tcbucket-dlink-next vector-tag) ac)] - [($tcbucket-dlink-prev) - (indirect-ref arg* (fx- disp-tcbucket-dlink-prev vector-tag) ac)] [($port-handler) (indirect-ref arg* (fx- disp-port-handler vector-tag) ac)] [($port-input-buffer) @@ -3947,8 +3933,8 @@ (movl eax (mem disp-tcbucket-val apr)) (movl (Simple (cadddr arg*)) eax) (movl eax (mem disp-tcbucket-next apr)) - (movl (int 0) (mem disp-tcbucket-dlink-prev apr)) - (movl (int 0) (mem disp-tcbucket-dlink-next apr)) + (movl (int 0) (mem 16 apr)) + (movl (int 0) (mem 20 apr)) (movl apr eax) (addl (int vector-tag) eax) (addl (int (align tcbucket-size)) apr) @@ -4180,10 +4166,6 @@ (indirect-assignment arg* (fx- disp-tcbucket-val vector-tag) ac)] [($set-tcbucket-next!) (indirect-assignment arg* (fx- disp-tcbucket-next vector-tag) ac)] - [($set-tcbucket-dlink-next!) - (indirect-assignment arg* (fx- disp-tcbucket-dlink-next vector-tag) ac)] - [($set-tcbucket-dlink-prev!) - (indirect-assignment arg* (fx- disp-tcbucket-dlink-prev vector-tag) ac)] [($set-tcbucket-tconc!) (indirect-assignment arg* (fx- disp-tcbucket-tconc vector-tag) ac)] [($set-port-input-index!) diff --git a/src/libhash.ss b/src/libhash.ss index 09e103d..cc3b9ae 100644 --- a/src/libhash.ss +++ b/src/libhash.ss @@ -1,12 +1,11 @@ -(let ([hash-rtd (make-record-type '"hash-table" '(hash-vec count tc dlink))]) +(let ([hash-rtd (make-record-type '"hash-table" '(hash-vec count tc))]) ;;; accessors (define get-vec (record-field-accessor hash-rtd 0)) (define set-vec! (record-field-mutator hash-rtd 0)) (define get-count (record-field-accessor hash-rtd 1)) (define set-count! (record-field-mutator hash-rtd 1)) (define get-tc (record-field-accessor hash-rtd 2)) - (define get-dlink (record-field-accessor hash-rtd 3)) ;;; implementation ;;; directly from Dybvig's paper @@ -165,13 +164,7 @@ [idx ($fxlogand ih ($fx- ($vector-length vec) 1))]) ($set-tcbucket-next! bucket ($vector-ref vec idx)) - ($vector-set! vec idx bucket))) - (let ([b1 (get-dlink h)]) - (let ([b2 ($tcbucket-dlink-next b1)]) - ($set-tcbucket-dlink-next! bucket b2) - ($set-tcbucket-dlink-prev! bucket b1) - ($set-tcbucket-dlink-next! b1 bucket) - ($set-tcbucket-dlink-prev! b2 bucket)))) + ($vector-set! vec idx bucket)))) (let ([ct (get-count h)]) (set-count! h ($fxadd1 ct)) (when ($fx> ct ($vector-length vec)) @@ -227,11 +220,7 @@ (lambda () (let ([x (cons #f #f)]) (let ([tc (cons x x)]) - (make (make-base-vec 32) 0 tc - (let ([b ($make-tcbucket tc #f #f #f)]) - ($set-tcbucket-dlink-next! b b) - ($set-tcbucket-dlink-prev! b b) - b))))))) + (make (make-base-vec 32) 0 tc)))))) (primitive-set! 'get-hash-table (lambda (h x v) (if (hash-table? h)