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_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){

6
bin/ikarus-data.h
View File

@ -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

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-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!)

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
(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)