Fast version of indexer

parent 23df08ec
......@@ -10,7 +10,7 @@
#:re-export (get-index-set)
#:export (define-dynamic dynamic-push dynamic-prepend dynamic-compile
dynamic-remove dynamic-env-ref dynamic-env-set!
;get-index-set
;get-index-set
dynamic-compile-index <with-dynamic>))
#|
......
#include <gmp.h>
#include <stdio.h>
#if ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 4)))
#define bsf(r, i) \
do { \
r = __builtin_ctzl(i); \
} while(0)
#else
#define bsf(r, i) \
do { \
asm("bsfl %1, %0" : "=r" (r) : "rm" (i)); \
} while(0)
#endif
inline SCM make_indexer()
inline make_indexer()
{
SCM ret = scm_c_make_vector(5, SCM_BOOL_F);
scm_c_vector_set_x(ret, 2, my_scm_from_int(0));
......@@ -54,13 +68,15 @@ inline SCM get_fs_from_atoms(SCM a, SCM dlink)
if(scm_is_true(w))
return SCM_CDR(w);
else
return scm_from_int(0);
return my_scm_from_int(0);
}
return scm_from_int(0);
return my_scm_from_int(0);
}
SCM get_index_set(SCM s, SCM e, SCM f, SCM db)
{
/*
// Nice, slow and easy, really, this funciton does not need to be in C
SCM get_index_set(SCM s, SCM f, SCM e, SCM db)
{
if(scm_is_false(db)) return f;
if(SCM_CONSP(e))
......@@ -68,22 +84,251 @@ SCM get_index_set(SCM s, SCM e, SCM f, SCM db)
SCM x = SCM_CAR(e);
SCM l = SCM_CDR(e);
SCM a1 = get_index_set(s,x,f,dlink_car(db,0));
SCM a2 = get_index_set(s,l,a1,dlink_cdr(db,0));
SCM a2 = get_index_set(s,l,a2,dlink_cdr(db,0));
SCM vr = scm_logand(f, get_vars(db));
return scm_logior(a2,vr);
}
if(gp_varp(e,s))
if(scm_is_true(gp_varp(e,s)))
return scm_logand(f, get_all(db));
return scm_logand(f, scm_logior(get_vars(db), get_fs_from_atoms(e, db)));
}
*/
inline int MAX(int i, int j)
{
if(i < j)
return j;
else
return i;
}
inline int MIN(int i, int j)
{
if(i > j)
return j;
else
return i;
}
//#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)
{
ulong data2[200];
int n2;
//gp_format1("index for ~a~%",e);
//printf("n=%d, data[0] = %p datat[1]=%p\n", *n, data[0], data[1]);
if(scm_is_false(db)) return;
if(SCM_CONSP(e))
{
SCM x = SCM_CAR(e);
SCM l = SCM_CDR(e);
SCM v = get_vars(db);
int i;
//printf("CONSP\n");fflush(stdout);
//gp_format1("vars ~a~%",v);
if(SCM_I_INUMP (v))
{
ulong nv = my_scm_to_ulong(v);
//printf("NIMP v\n");fflush(stdout);
data2[0] = *n ? data[0] & nv : nv;
n2 = 1;
}
else
{
mpz_t *mpv = SCM_I_BIG_MPZ(v);
int n3 = (*mpv)->_mp_size;
ulong *data3 = (*mpv)->_mp_d;
//printf("MPZ v\n");fflush(stdout);
if(*n)
{
n2 = MIN(n3,*n);
for(i = 0; i < n2; i++)
data2[i] = data[i] & data3[i];
}
else
{
n2 = n3;
for(i = 0; i < n2; i++)
data2[i] = data3[i];
}
}
//printf("sub v\n");fflush(stdout);
get_index_set_0(s,x,dlink_car(db,0), n, data);
get_index_set_0(s,l,dlink_cdr(db,0), n, data);
//printf("finish v\n");fflush(stdout);
{
int N = *n;
*n = MAX(*n, n2);
for(i = 0; i < n2; i++)
if(i < N)
data[i] = data[i] | data2[i];
else
data[i] = data2[i];
}
return;
}
if(scm_is_true(gp_varp(e,s)))
{
SCM v = get_all(db);
//printf("VAR\n");fflush(stdout);
if(SCM_I_INUMP (v))
{
ulong nv = my_scm_to_ulong(v);
data[0] = *n ? data[0] & nv : nv;
*n = 1;
}
else
{
int i;
mpz_t *mpv = SCM_I_BIG_MPZ(v);
int n3 = (*mpv)->_mp_size;
ulong *data3 = (*mpv)->_mp_d;
if(*n)
{
*n = MIN(n3,*n);
for(i = 0; i < *n; i++)
data[i] = data[i] & data3[i];
}
else
{
*n = n3;
for(i = 0; i < *n; i++)
data[i] = data3[i];
}
}
return;
}
{
SCM v = get_vars(db);
SCM a = get_fs_from_atoms(e, db);
//printf("ATOM\n");fflush(stdout);
if(SCM_I_INUMP (v))
{
ulong nv = my_scm_to_ulong(v);
n2 = 1;
data2[0] = *n ? (data[0] & nv) : nv;
}
else
{
mpz_t *mpv = SCM_I_BIG_MPZ(v);
int n3 = (*mpv)->_mp_size;
ulong *data3 = (*mpv)->_mp_d;
int i,n2 = *n ? MIN(n3, *n) : n3;
if(*n)
{
for(i = 0; i < n2; i++)
data2[i] = data[i] & data3[i];
}
else
{
for(i = 0; i < n2; i++)
data2[i] = data3[i];
}
}
if(SCM_I_INUMP (a))
{
ulong na = my_scm_to_ulong(a);
int i;
data[0] = data2[0] | (*n ? (data[0] & na) : na);
*n = MAX(n2,1);
for(i = 1; i < *n; i++)
data[i] = data2[i];
}
else
{
mpz_t *mpa = SCM_I_BIG_MPZ(a);
int n4 = (*mpa)->_mp_size;
ulong *data4 = (*mpa)->_mp_d;
n4 = *n ? MIN(n4,*n) : n4;
if(*n)
{
int i;
*n = MAX(n2, n4);
for(i = 0; i < n4; i++)
data[i] = data[i] & data4[i];
for(i = 0; i < n2; i++)
if(i < n4)
data[i] = data[i] | data2[i];
else
data[i] = data2[i];
}
else
{
int i;
*n = MAX(n2, n4);
int nk = MIN(n4,n2);
for(i = 0; i < nk; i++)
data[i] = data[2] | data4[i];
if(n2 < n4)
for(i = nk; i < n4; i++)
data[i] = data4[i];
if(n4 < n2)
for(i = nk; i < n2; i++)
data[i] = data[2];
}
}
//printf("ret n=%d,data[0]=%p, data[1]=%p",*n,data[0],data[1]);
return;
}
}
//#define DB(X)
SCM get_index_set(SCM s, SCM e, SCM db)
{
ulong data[200];
int d,i,j,b,n = 0;
SCM ret;
get_index_set_0(s, e, db, &n, data);
//printf("Got %p %p\n",data[0],data[1]);
ret = SCM_EOL;
for(b = 0, i = 0; i < n; i++, b+=64)
{
ulong x = data[i];
//printf("data(%d) %p\n",i, data[i]);
for(j = 0; j<32; j++)
{
if(x == 0) break;
int l;
//printf("x = %p\n",x);
bsf(l,x);
//printf("found %d\n",l);
if(l < 0) break;
ret = scm_cons(scm_from_int(b + l), ret);
x = x & ~(1UL<<l);
}
}
return ret;
SCM_DEFINE(scm_get_index_set, "get-index-set", 4, 0, 0,
(SCM s, SCM e, SCM f, SCM db), "")
//return scm_from_int(10);
}
SCM_DEFINE(scm_get_index_set, "get-index-set", 3, 0, 0,
(SCM s, SCM e, SCM db), "")
#define FUNC_NAME s_scm_get_index_set
{
return get_index_set(s, e, f, db);
return get_index_set(s, e, db);
}
#undef FUNC_NAME
......
SCM_API SCM scm_get_index_set(SCM s, SCM e, SCM f, SCM db);
SCM_API SCM scm_get_index_set(SCM s, SCM e, SCM db);
......@@ -916,7 +916,6 @@ SCM vhash_assoc_exp(SCM key, SCM vhash,
offset = NEXT_REF(my_scm_to_ulong(offset_s));
loop:
printf("offset: %d size: %d\n", offset, size);
if(offset >= 0)
{
SCM key_val = block_ref(content, offset);
......
(use-modules (logic guile-log functional-database))
(use-modules (logic guile-log umatch))
(define-dynamic f)
(define (add x)
(dynamic-push *current-stack* f x #f #f))
(define (get)
(dynamic-env-ref f))
(define (comp)
(dynamic-compile-index *current-stack* f))
(define n 10)
(for-each
(lambda (x)
(for-each
(lambda (y)
(add `(,x ,y)))
(iota n)))
(iota n))
(define (find a)
(let* ((e (car (get)))
(db (vector-ref e 3))
(tag (vector-ref e 0)))
(get-index-set *current-stack* a db)))
(define (finde a e)
(let* ((db (vector-ref e 3)))
(get-index-set *current-stack* a db)))
(define (try n)
(let ((v `(,(gp-var! *current-stack*) 4))
(e (car (get))))
(let loop ((n n))
(if (= n 0)
(finde v e)
(begin
(finde v e)
(loop (- n 1)))))))
\ No newline at end of file
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