conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* intermediate step: 

gc has tcbucket_size=16
  compile allocates tcbucket_size=24
This commit is contained in:
Abdulaziz Ghuloum 2007-01-17 14:34:25 -05:00
parent 21f4ecb88d
commit 13e8f76f13
6 changed files with 6 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/ikarus
View File

Binary file not shown.

2
bin/ikarus-collect.c
View File

@ -1018,8 +1018,6 @@ add_object_proc(gc_t* gc, ikp x)
ref(y,off_tcbucket_key) = key; ref(y,off_tcbucket_key) = key;
ref(y,off_tcbucket_val) = ref(x, off_tcbucket_val); ref(y,off_tcbucket_val) = ref(x, off_tcbucket_val);
ref(y,off_tcbucket_next) = ref(x, off_tcbucket_next); 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)){ if((! is_fixnum(key)) && (tagof(key) != immediate_tag)){
unsigned int kt = gc->segment_vector[page_index(key)]; unsigned int kt = gc->segment_vector[page_index(key)];
if((kt & gen_mask) <= gc->collect_gen){ if((kt & gen_mask) <= gc->collect_gen){

6
bin/ikarus-data.h
View File

@ -181,15 +181,11 @@
#define disp_tcbucket_key 4 #define disp_tcbucket_key 4
#define disp_tcbucket_val 8 #define disp_tcbucket_val 8
#define disp_tcbucket_next 12 #define disp_tcbucket_next 12
#define disp_tcbucket_dlink_prev 16 #define tcbucket_size 16
#define disp_tcbucket_dlink_next 20
#define tcbucket_size 24
#define off_tcbucket_tconc (disp_tcbucket_tconc - vector_tag) #define off_tcbucket_tconc (disp_tcbucket_tconc - vector_tag)
#define off_tcbucket_key (disp_tcbucket_key - vector_tag) #define off_tcbucket_key (disp_tcbucket_key - vector_tag)
#define off_tcbucket_val (disp_tcbucket_val - vector_tag) #define off_tcbucket_val (disp_tcbucket_val - vector_tag)
#define off_tcbucket_next (disp_tcbucket_next - 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 #define bignum_mask 0x7

BIN
src/ikarus.boot
View File

Binary file not shown.

22
src/libcompile.ss
View File

@ -160,12 +160,8 @@
[$tcbucket-key 1 value] [$tcbucket-key 1 value]
[$tcbucket-val 1 value] [$tcbucket-val 1 value]
[$tcbucket-next 1 value] [$tcbucket-next 1 value]
[$tcbucket-dlink-next 1 value]
[$tcbucket-dlink-prev 1 value]
[$set-tcbucket-val! 2 effect] [$set-tcbucket-val! 2 effect]
[$set-tcbucket-next! 2 effect] [$set-tcbucket-next! 2 effect]
[$set-tcbucket-dlink-next! 2 effect]
[$set-tcbucket-dlink-prev! 2 effect]
[$set-tcbucket-tconc! 2 effect] [$set-tcbucket-tconc! 2 effect]
;;; misc ;;; misc
[eof-object 0 value] [eof-object 0 value]
@ -2038,11 +2034,7 @@
$make-record $record? $record/rtd? $record-rtd $record-ref $record-set! $make-record $record? $record/rtd? $record-rtd $record-ref $record-set!
primitive-set! primitive-ref primitive-set! primitive-ref
$make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next $make-tcbucket $tcbucket-key $tcbucket-val $tcbucket-next
$tcbucket-dlink-next
$tcbucket-dlink-prev
$set-tcbucket-val! $set-tcbucket-val!
$set-tcbucket-dlink-next!
$set-tcbucket-dlink-prev!
$set-tcbucket-next! $set-tcbucket-tconc!) $set-tcbucket-next! $set-tcbucket-tconc!)
#t] #t]
[else (error 'valid-arg-types? "unhandled op ~s" op)])) [else (error 'valid-arg-types? "unhandled op ~s" op)]))
@ -3071,8 +3063,6 @@
(define disp-tcbucket-key 4) (define disp-tcbucket-key 4)
(define disp-tcbucket-val 8) (define disp-tcbucket-val 8)
(define disp-tcbucket-next 12) (define disp-tcbucket-next 12)
(define disp-tcbucket-dlink-prev 16)
(define disp-tcbucket-dlink-next 20)
(define tcbucket-size 24) (define tcbucket-size 24)
(define record-ptag 5) (define record-ptag 5)
(define record-pmask 7) (define record-pmask 7)
@ -3725,10 +3715,6 @@
(indirect-ref arg* (fx- disp-tcbucket-val vector-tag) ac)] (indirect-ref arg* (fx- disp-tcbucket-val vector-tag) ac)]
[($tcbucket-next) [($tcbucket-next)
(indirect-ref arg* (fx- disp-tcbucket-next vector-tag) ac)] (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) [($port-handler)
(indirect-ref arg* (fx- disp-port-handler vector-tag) ac)] (indirect-ref arg* (fx- disp-port-handler vector-tag) ac)]
[($port-input-buffer) [($port-input-buffer)
@ -3947,8 +3933,8 @@
(movl eax (mem disp-tcbucket-val apr)) (movl eax (mem disp-tcbucket-val apr))
(movl (Simple (cadddr arg*)) eax) (movl (Simple (cadddr arg*)) eax)
(movl eax (mem disp-tcbucket-next apr)) (movl eax (mem disp-tcbucket-next apr))
(movl (int 0) (mem disp-tcbucket-dlink-prev apr)) (movl (int 0) (mem 16 apr))
(movl (int 0) (mem disp-tcbucket-dlink-next apr)) (movl (int 0) (mem 20 apr))
(movl apr eax) (movl apr eax)
(addl (int vector-tag) eax) (addl (int vector-tag) eax)
(addl (int (align tcbucket-size)) apr) (addl (int (align tcbucket-size)) apr)
@ -4180,10 +4166,6 @@
(indirect-assignment arg* (fx- disp-tcbucket-val vector-tag) ac)] (indirect-assignment arg* (fx- disp-tcbucket-val vector-tag) ac)]
[($set-tcbucket-next!) [($set-tcbucket-next!)
(indirect-assignment arg* (fx- disp-tcbucket-next vector-tag) ac)] (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!) [($set-tcbucket-tconc!)
(indirect-assignment arg* (fx- disp-tcbucket-tconc vector-tag) ac)] (indirect-assignment arg* (fx- disp-tcbucket-tconc vector-tag) ac)]
[($set-port-input-index!) [($set-port-input-index!)

17
src/libhash.ss
View File

@ -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 ;;; accessors
(define get-vec (record-field-accessor hash-rtd 0)) (define get-vec (record-field-accessor hash-rtd 0))
(define set-vec! (record-field-mutator hash-rtd 0)) (define set-vec! (record-field-mutator hash-rtd 0))
(define get-count (record-field-accessor hash-rtd 1)) (define get-count (record-field-accessor hash-rtd 1))
(define set-count! (record-field-mutator hash-rtd 1)) (define set-count! (record-field-mutator hash-rtd 1))
(define get-tc (record-field-accessor hash-rtd 2)) (define get-tc (record-field-accessor hash-rtd 2))
(define get-dlink (record-field-accessor hash-rtd 3))
;;; implementation ;;; implementation
;;; directly from Dybvig's paper ;;; directly from Dybvig's paper
@ -165,13 +164,7 @@
[idx [idx
($fxlogand ih ($fx- ($vector-length vec) 1))]) ($fxlogand ih ($fx- ($vector-length vec) 1))])
($set-tcbucket-next! bucket ($vector-ref vec idx)) ($set-tcbucket-next! bucket ($vector-ref vec idx))
($vector-set! vec idx bucket))) ($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))))
(let ([ct (get-count h)]) (let ([ct (get-count h)])
(set-count! h ($fxadd1 ct)) (set-count! h ($fxadd1 ct))
(when ($fx> ct ($vector-length vec)) (when ($fx> ct ($vector-length vec))
@ -227,11 +220,7 @@
(lambda () (lambda ()
(let ([x (cons #f #f)]) (let ([x (cons #f #f)])
(let ([tc (cons x x)]) (let ([tc (cons x x)])
(make (make-base-vec 32) 0 tc (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)))))))
(primitive-set! 'get-hash-table (primitive-set! 'get-hash-table
(lambda (h x v) (lambda (h x v)
(if (hash-table? h) (if (hash-table? h)