major bugfix

parent 9f15b95b
......@@ -59,7 +59,7 @@
;vhash-fold* vhash-foldq* vhash-foldv*
;alist->vhash
block-growth-factor
block-growth-factor init-block-size
get-index-set
))
......@@ -188,9 +188,10 @@
(define x (setup-vlist <vlist>))
(define vlist-null (list-ref x 0))
(define block-growth-factor (list-ref x 1))
(define thread-seq (list-ref x 2))
(define thread-nr (list-ref x 3))
(define thread-inc (list-ref x 4))
(define init-block-size (list-ref x 2))
(define thread-seq (list-ref x 3))
(define thread-nr (list-ref x 4))
(define thread-inc (list-ref x 5))
(define (vlist-pair? x) (and (vlist? x) (not (vlist-null? x))))
(define (vlist-thread-inc)
......
......@@ -124,12 +124,21 @@ add/run * vlist *
(define (get-nlist-from-atom a dlink)
(let* ((r (get-atoms dlink)))
(if r
(let ((x (vhash-assoc a r)))
(let ((x (vhash-assq a r)))
(if x
(values r (cdr x))
(values r (make-empty))))
(values vlist-null (make-empty)))))
(define (get-nlist-from-atom! a dlink)
(let* ((r (get-atoms dlink)))
(if r
(let ((x (vhash-assq a r)))
(if x
(values r x)
(values r #f)))
(values vlist-null #f))))
(define (index-remove s tag e dlink)
(if dlink
(match e
......@@ -151,7 +160,7 @@ add/run * vlist *
(call-with-values (lambda () (get-nlist-from-atom a dlink))
(lambda (r k)
(add-atoms-all dlink
(vhash-cons a (difference k tag) r)
(vhash-consq a (difference k tag) r)
(difference (get-all dlink) tag)))))))
#f))
......@@ -178,13 +187,47 @@ add/run * vlist *
(call-with-values (lambda () (get-nlist-from-atom a dlink))
(lambda (r k)
(add-atoms-all dlink
(vhash-cons a (union k f) r)
(vhash-consq a (union k f) r)
(union f (get-all dlink)))))))))
(define (bitmap-indexer-add! s e f dlink)
(match e
((x . l)
(call-with-values
(lambda () (bitmap-indexer-add!
s x f (dlink-car dlink #t)))
(lambda (dlink-car)
(call-with-values
(lambda () (bitmap-indexer-add!
s l f (dlink-cdr dlink #t)))
(lambda (dlink-cdr)
(add-car-cdr-all dlink dlink-car dlink-cdr
(union (get-all dlink) f)))))))
(a
(if (gp-var? a s)
(add-vars-all dlink
(union f (get-vars dlink))
(union f (get-all dlink)))
(call-with-values (lambda () (get-nlist-from-atom! a dlink))
(lambda (r k.v)
(if k.v
(begin
(set-cdr! k.v (union f (cdr k.v)))
(add-atoms-all dlink
r
(union f (get-all dlink))))
(add-atoms-all dlink
(with-fluids ((init-block-size 128))
(vhash-consq a f r))
(union f (get-all dlink))))))))))
(define (get-fs-from-atoms a dlink)
(let ((r (get-atoms dlink)))
(if r
(let ((w (vhash-assoc a r)))
(let ((w (vhash-assq a r)))
(if w
(cdr w)
(make-empty)))
......@@ -339,7 +382,7 @@ add/run * vlist *
(dynlist->vlist (get-ar e) d)
(fold-dynlist-lr
(lambda (x indexer)
(bitmap-indexer-add s (vector-ref x 1) (vector-ref x 0) indexer))
(bitmap-indexer-add! s (vector-ref x 1) (vector-ref x 0) indexer))
d
(make-indexer)))))
......
......@@ -21,50 +21,50 @@ inline make_indexer()
return ret;
}
inline SCM get_car(SCM v)
inline SCM get_car(SCM* v)
{
return scm_c_vector_ref(v, 0);
return v[0];
}
inline SCM get_cdr(SCM v)
inline SCM get_cdr(SCM *v)
{
return scm_c_vector_ref(v, 1);
return v[1];
}
inline SCM get_vars(SCM v)
inline SCM get_vars(SCM *v)
{
return scm_c_vector_ref(v, 2);
return v[2];
}
inline SCM get_atoms(SCM v)
inline SCM get_atoms(SCM *v)
{
return scm_c_vector_ref(v, 3);
return v[3];
}
inline SCM get_all(SCM v)
inline SCM get_all(SCM *v)
{
return scm_c_vector_ref(v, 4);
return v[4];
}
#define MK_ACC(dlink_car, get_car) \
inline SCM dlink_car(SCM dlink, int mod) \
{ \
SCM v = get_car(dlink); \
if(mod) \
if(scm_is_true(v)) \
return v; \
inline SCM dlink_car(SCM *dlink, int mod) \
{ \
SCM v = get_car(dlink); \
if(mod) \
if(scm_is_true(v)) \
return v; \
else \
return make_indexer(); \
else \
return make_indexer(); \
else \
return v; \
}
return v; \
}
MK_ACC(dlink_car, get_car)
MK_ACC(dlink_cdr, get_cdr)
inline SCM get_fs_from_atoms(SCM a, SCM dlink)
inline SCM get_fs_from_atoms(SCM a, SCM *dlink)
{
SCM r = get_atoms(dlink);
if(scm_is_true(r))
{
SCM w = vhash_assoc(a,r);
SCM w = vhash_assq(a,r);
if(scm_is_true(w))
return SCM_CDR(w);
else
......@@ -114,11 +114,11 @@ inline int MIN(int i, int j)
//#define DB(X) X
// Fast but horribly hard really, this need to be in C
void get_index_set_0(SCM s, SCM e, SCM db, int *n, ulong *data)
void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data)
{
ulong data2[200];
int n2;
SCM *db = dB(db_);
//gp_format1("index for ~a~%",e);
//printf("n=%d, data[0] = %p datat[1]=%p\n", *n, data[0], data[1]);
......
......@@ -407,6 +407,9 @@ void vlist_init()
block_growth_factor = scm_make_fluid();
scm_fluid_set_x(block_growth_factor, scm_from_int(2));
init_block_size = scm_make_fluid();
scm_fluid_set_x(init_block_size, scm_from_int(1));
block_null = make_block(SCM_BOOL_F, 0, 0, 0);
SCM thread_id;
......
......@@ -30,10 +30,10 @@ do { \
#define ZERO 0L
#define SEQ(x) ((x) & TAGU(TAGN))
#define THR(x) ((x) & TAGU(TAGN))
#define BACKREF_REF(x) HIGH(x)
#define NEXT_REF(x) LOW(x)
#define BACKREF_REF(x) ((int) HIGH(x))
#define NEXT_REF(x) ((int) LOW(x))
#define COMB_REFS(low,high) ((((ulong) high) << TAGN) | (low))
#define NEXTFREE(x) LOW(x)
#define NEXTFREE(x) ((int) LOW(x))
#define INCREF(x) (x + (1L << TAGN))
#define DECREF(x) (x - (1L << TAGN))
#define REFCOUNT(x) ((x) & TAGU(TAGN))
......@@ -41,6 +41,7 @@ SCM thread_seq_number;
SCM thread_id;
SCM thread_inc;
SCM block_growth_factor;
SCM init_block_size;
SCM make_block(SCM base, int offset, int size, int hash_tab_p)
{
......@@ -88,7 +89,7 @@ int block_hash_table_p(SCM *block)
void set_block_next_free_s
(SCM* block, ulong next_free)
{
block[4] = my_scm_from_int(next_free++);
block[4] = my_scm_from_int(++next_free);
}
......@@ -101,7 +102,9 @@ inline int block_append_s(SCM* block, SCM value, int offset, int hashp)
ulong seq = my_scm_to_ulong(scm_fluid_ref(thread_seq_number));
ulong thr = my_scm_to_ulong(scm_fluid_ref(thread_id));
printf("offset %d block_size %d nextfree %d\n"
, offset , (int) block_size(block), NEXTFREE(nextfree));
if ((offset < block_size(block))
&& (!hashp || (THR(st) == thr && SEQ(os) == seq)) &&
(offset == NEXTFREE(nextfree)))
......@@ -264,9 +267,9 @@ SCM block_cons(SCM item, SCM vlist, int hash_tab_p)
int s;
if(size == 0)
s = 1;
s = my_scm_to_int(scm_fluid_ref(init_block_size));
else if (offset < size)
s = 1;
s = my_scm_to_int(scm_fluid_ref(init_block_size));
else
s = my_scm_to_int(scm_fluid_ref(block_growth_factor)) * size;
......@@ -278,7 +281,7 @@ SCM block_cons(SCM item, SCM vlist, int hash_tab_p)
base = dB(Base);
set_block_next_free_s(base, 1);
set_block_next_free_s(base, 0);
scm_c_vector_set_x(block_content(base), 0, item);
return make_vlist(Base, 0);
......@@ -1127,10 +1130,11 @@ SCM setup(SCM type)
vlist_null = make_vlist(block_null, 0);
return scm_cons(vlist_null,
scm_cons(block_growth_factor,
scm_cons(thread_seq_number,
scm_cons(thread_id,
scm_cons(thread_inc, SCM_EOL)))));
scm_cons(block_growth_factor,
scm_cons(init_block_size,
scm_cons(thread_seq_number,
scm_cons(thread_id,
scm_cons(thread_inc, SCM_EOL))))));
}
//-----------------------------------------------------------------
......@@ -20,4 +20,4 @@
;vhash-fold* vhash-foldq* vhash-foldv*
;alist->vhash
block-growth-factor))
block-growth-factor init-block-size))
......@@ -9,7 +9,7 @@
(define (comp)
(dynamic-compile-index *current-stack* f))
(define n 10)
(define n 100)
(for-each
(lambda (x)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment