one of several bignum cache ideas, appears slower - gcl.git - GNU Common Lisp

diff --git a/gcl/o/gbc.c b/gcl/o/gbc.c
index f1967de11..26ea7dedf 100755
--- a/gcl/o/gbc.c
+++ b/gcl/o/gbc.c

@@ -888,6 +888,48 @@ mark_stack_carefully(void *topv, void *bottomv, int offset) {

}

}

+/* static void */

+/* mark_big(void) { */

+

+/* struct pageinfo *v; */

+/* struct typemanager *btm=tm_of(t_bignum); */

+/* void *x; */

+/* object o; */

+/* ufixnum j,i; */

+/* extern ufixnum big_cache_size; */

+

+/* if (type_of(sSAbig_listA->s.s_dbind)!=t_vector) return; */

+

+/* sSAbig_listA->s.s_dbind->v.v_fillp=0; */

+/* for (i=0,v=cell_list_head;v;v=v->next) */

+/* if (tm_of(v->type)==btm */

+/* #ifdef SGC */

+/* && (!sgc_enabled || WRITABLE_PAGE_P(page(v))) */

+/* #endif */

+/* ) */

+/* for (x=pagetochar(page(v)),j=btm->tm_nppage;j--;x+=btm->tm_size) */

+/* if ((o=x) && !is_marked_or_free(o) && type_of(o)==t_bignum) { */

+/* i++; */

+/* if (sSAbig_listA->s.s_dbind->v.v_fillp<sSAbig_listA->s.s_dbind->v.v_dim) { */

+/* #ifdef SGC */

+/* if (sgc_enabled) */

+/* sgc_mark_object1(o); */

+/* else */

+/* #endif */

+/* mark_object(o); */

+

+/* sSAbig_listA->s.s_dbind->v.v_self[sSAbig_listA->s.s_dbind->v.v_fillp++ + */

+/* (COLLECT_RELBLOCK_P */

+/* #ifdef SGC */

+/* && (!sgc_enabled || SGC_RELBLOCK_P(sSAbig_listA->s.s_dbind->v.v_self)) */

+/* #endif */

+/* ? (rb_pointer1-rb_pointer)/sizeof(object) : 0)]=o; */

+/* } */

+/* } */

+

+/* big_cache_size=i*0.75; */

+

+/* } */

static void

mark_phase(void) {

@@ -959,7 +1001,8 @@ mark_phase(void) {

for (i = 0; i < size; i++)

mark_object(pp->p_external[i]);

}}

-

+

+

/* mark the c stack */

#ifndef N_RECURSION_REQD

#define N_RECURSION_REQD 2

@@ -1102,7 +1145,20 @@ sweep_phase(void) {

STATIC struct typemanager *tm;

STATIC object f;

STATIC struct pageinfo *v;

+ ufixnum *bp1=NULL,*bp=NULL,*bpe=NULL;

+ struct typemanager *btm=tm_of(t_bignum);

+ extern ufixnum last_big_alloc,current_big_alloc;

+ if (sSAbig_listA && type_of(sSAbig_listA->s.s_dbind)==t_vector) {

+ object bv=sSAbig_listA->s.s_dbind;

+ ufixnum dim;

+ last_big_alloc=(current_big_alloc>bv->v.v_dim ? current_big_alloc : bv->v.v_dim)*0.75;

+ current_big_alloc=0;

+ dim=last_big_alloc<bv->v.v_dim ? last_big_alloc : bv->v.v_dim;

+ bp=bp1=((void *)bv->v.v_self)+(COLLECT_RELBLOCK_P ? rb_pointer1-rb_pointer : 0);

+ bpe=bp+dim;

+ }

+

for (v=cell_list_head;v;v=v->next) {

tm = tm_of((enum type)v->type);

@@ -1119,6 +1175,13 @@ sweep_phase(void) {

continue;

}

+ if (tm==btm && bp<bpe && type_of(x)==t_bignum) {

+ mark_object(x);

+ unmark(x);

+ *bp++=(ufixnum)x;

+ continue;

+ }

+

SET_LINK(x,f);

make_free(x);

f = x;

@@ -1130,6 +1193,9 @@ sweep_phase(void) {

}

+ if (bp)

+ sSAbig_listA->s.s_dbind->v.v_fillp=bp-bp1;

+

}

static void

@@ -1343,7 +1409,9 @@ GBC(enum type t) {

fflush(stdout);

}

#endif

-

+

+ /* mark_big(); */

+

#ifdef DEBUG

if (debug) {

printf("sweep phase\n");

diff --git a/gcl/o/gmp_big.c b/gcl/o/gmp_big.c
index f1bb283dc..8739b91de 100755
--- a/gcl/o/gmp_big.c
+++ b/gcl/o/gmp_big.c

@@ -101,16 +101,90 @@ gcl_init_big1()

}

#endif

+ufixnum last_big_alloc=0,current_big_alloc=0;

+

+static int

+acomp(const void *v1,const void *v2) {

+ const object *o1=v1,*o2=v2;

+ ufixnum u1=(*o1)->big.big_mpz_t._mp_alloc,u2=(*o2)->big.big_mpz_t._mp_alloc;

+ return (u1>u2 ? 1 : (u1 == u2 ? 0 : -1));

+}

+

+static object

+cache_bignum(__mpz_struct *u) {

+

+ object ans=OBJNULL;

+ ufixnum i,j,k,s;

+

+ if (sSAbig_listA && type_of(sSAbig_listA->s.s_dbind)==t_vector) {

+

+ object bv=sSAbig_listA->s.s_dbind,bi=sSAbig_indexA->s.s_dbind;;

+

+ if (!current_big_alloc) {

+ if (2*labs(last_big_alloc-bv->v.v_dim)>bv->v.v_dim) {

+ ufixnum i=last_big_alloc<1000 ? 1000 : last_big_alloc;

+ void *v=alloc_relblock(i*sizeof(object));

+ memcpy(v,bv->v.v_self,bv->v.v_fillp*sizeof(object));

+ bv->v.v_self=v;

+ bv->v.v_dim=i;

+ }

+

+ qsort(bv->v.v_self,bv->v.v_fillp,sizeof(object),acomp);

+

+ for (i=j=s=0;i<bv->v.v_fillp;i++)

+ if (bv->v.v_self[i]->big.big_mpz_t._mp_alloc!=s) {

+ s=bv->v.v_self[i]->big.big_mpz_t._mp_alloc;

+ j++;

+ }

+

+#define FIXA(x) ((ufixnum *)x->v.v_self)

+

+ j*=3;

+ bi->v.v_self=alloc_relblock(j*sizeof(object));

+ bi->v.v_fillp=bi->v.v_dim=j;

+ for (i=k=s=0;i<bv->v.v_fillp && k<j;i++)

+ if (bv->v.v_self[i]->big.big_mpz_t._mp_alloc!=s) {

+ s=bv->v.v_self[i]->big.big_mpz_t._mp_alloc;

+ if (k) FIXA(bi)[k-1]=i;

+ FIXA(bi)[k++]=s;

+ FIXA(bi)[k++]=i;

+ FIXA(bi)[k++]=bv->v.v_fillp;

+ }

+

+ }

+

+ s=u ? labs(u->_mp_size) : 0;

+ for (i=0;i<bi->v.v_fillp && (FIXA(bi)[i]<s || FIXA(bi)[i+1]>=FIXA(bi)[i+2]);i+=3);

+ if (i<bi->v.v_fillp) {

+ ans=bv->v.v_self[FIXA(bi)[i+1]];

+ FIXA(bi)[i+1]++;

+ if (u) mpz_set(MP(ans),u);

+ }

+

+ }

+

+ current_big_alloc++;

+

+ return ans;

+

+}

+

object

-new_bignum(void)

-{ object ans;

- {BEGIN_NO_INTERRUPT;

- ans = alloc_object(t_bignum);

- MP_SELF(ans) = 0;

- mpz_init(MP(ans));

- END_NO_INTERRUPT;

- }

- return ans;

+new_bignum(void) {

+

+ object ans;

+

+ if ((ans=cache_bignum(0))!=OBJNULL)

+ return ans;

+

+ {

+ BEGIN_NO_INTERRUPT;

+ ans = alloc_object(t_bignum);

+ MP_SELF(ans) = 0;

+ mpz_init(MP(ans));

+ END_NO_INTERRUPT;

+ }

+ return ans;

}

/* we have to store the body of a u in a bignum object

@@ -123,10 +197,18 @@ new_bignum(void)

(__u)->_mp_alloc = (u)->_mp_alloc

#define GC_PROTECTED_SELF (__u)->_mp_d

#define END_GCPROTECT (__u)->_mp_d = 0

-

+

+DEFVAR("*BIG-LIST*",sSAbig_listA,SI,Cnil,"");

+DEFVAR("*BIG-INDEX*",sSAbig_indexA,SI,Cnil,"");

+

static object

make_bignum(__mpz_struct *u) {

- object ans=alloc_object(t_bignum);

+ object ans;

+

+ if ((ans=cache_bignum(u))!=OBJNULL)

+ return ans;

+

+ ans=alloc_object(t_bignum);

memset(MP(ans),0,sizeof(*MP(ans)));

mpz_init_set(MP(ans),u);

return ans;

@@ -583,5 +665,4 @@ gcl_init_big(void)

enter_mark_origin(&big_fixnum3);

enter_mark_origin(&big_fixnum4);

-

}

diff --git a/gcl/o/sgbc.c b/gcl/o/sgbc.c
index 042177def..0a0f47974 100755
--- a/gcl/o/sgbc.c
+++ b/gcl/o/sgbc.c

@@ -641,9 +641,9 @@ sgc_mark_phase(void) {

sgc_mark_pack_list(pp->p_external[i]);

}

}

-

+

mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully);

-

+

}

static void

@@ -655,7 +655,20 @@ sgc_sweep_phase(void) {

STATIC object f;

int size;

STATIC struct pageinfo *v;

+ ufixnum *bp1=NULL,*bp=NULL,*bpe=NULL;

+ struct typemanager *btm=tm_of(t_bignum);

+ extern ufixnum last_big_alloc,current_big_alloc;

+ if (sSAbig_listA && type_of(sSAbig_listA->s.s_dbind)==t_vector) {

+ object bv=sSAbig_listA->s.s_dbind;

+ ufixnum dim;

+ last_big_alloc=(current_big_alloc>bv->v.v_dim ? current_big_alloc : bv->v.v_dim)*0.75;

+ current_big_alloc=0;

+ dim=last_big_alloc<bv->v.v_dim ? last_big_alloc : bv->v.v_dim;

+ bp=bp1=((void *)bv->v.v_self)+(COLLECT_RELBLOCK_P && SGC_RELBLOCK_P(bv->v.v_self) ? rb_pointer1-rb_pointer : 0);

+ bpe=bp+dim;

+ }

+

for (v=cell_list_head;v;v=v->next) {

tm = tm_of((enum type)v->type);

@@ -684,6 +697,13 @@ sgc_sweep_phase(void) {

if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL)

continue;

+ if (tm==btm && bp<bpe && type_of(x)==t_bignum) {

+ sgc_mark_object1(x);

+ unmark(x);

+ *bp++=(ufixnum)x;

+ continue;

+ }

+

/* it is ok to free x */

SET_LINK(x,f);

@@ -706,6 +726,11 @@ sgc_sweep_phase(void) {

}

}

+

+ if (bp)

+ sSAbig_listA->s.s_dbind->v.v_fillp=bp-bp1;

+

+

}

diff --git a/gcl/unixport/init_ansi_gcl.lsp.in b/gcl/unixport/init_ansi_gcl.lsp.in
index 9e65afd2f..704de30e5 100644
--- a/gcl/unixport/init_ansi_gcl.lsp.in
+++ b/gcl/unixport/init_ansi_gcl.lsp.in

@@ -33,6 +33,11 @@

(or lisp::*link-array*

(setq lisp::*link-array*

(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0)))

+

+ ;; (unless si::*big-list*

+ ;; (setq si::*big-list* (make-array 1000 :element-type 'fixnum :fill-pointer 0 :adjustable t)

+ ;; si::*big-index* (make-array 10 :element-type 'fixnum :fill-pointer 0 :adjustable t)))

+

(si::use-fast-links t)

(let* ((x (append (pathname-directory si::*system-directory*) (list :parent)))

diff --git a/gcl/unixport/init_gcl.lsp.in b/gcl/unixport/init_gcl.lsp.in
index b00e86e69..c7b704c4c 100644
--- a/gcl/unixport/init_gcl.lsp.in
+++ b/gcl/unixport/init_gcl.lsp.in

@@ -22,6 +22,11 @@

(or lisp::*link-array*

(setq lisp::*link-array*

(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0)))

+

+ ;; (unless si::*big-list*

+ ;; (setq si::*big-list* (make-array 1000 :element-type 'fixnum :fill-pointer 0 :adjustable t)

+ ;; si::*big-index* (make-array 10 :element-type 'fixnum :fill-pointer 0 :adjustable t)))

+

(si::use-fast-links t)

(let* ((x (append (pathname-directory si::*system-directory*) (list :parent)))

diff --git a/gcl/unixport/init_pcl_gcl.lsp.in b/gcl/unixport/init_pcl_gcl.lsp.in
index 99bb1f5a8..f2f5ab3b1 100644
--- a/gcl/unixport/init_pcl_gcl.lsp.in
+++ b/gcl/unixport/init_pcl_gcl.lsp.in

@@ -29,6 +29,11 @@

(or lisp::*link-array*

(setq lisp::*link-array*

(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0)))

+

+ ;; (unless si::*big-list*

+ ;; (setq si::*big-list* (make-array 1000 :element-type 'fixnum :fill-pointer 0 :adjustable t)

+ ;; si::*big-index* (make-array 10 :element-type 'fixnum :fill-pointer 0 :adjustable t)))

+

(si::use-fast-links t)

(let* ((x (append (pathname-directory si::*system-directory*) (list :parent)))

diff --git a/gcl/unixport/init_pre_gcl.lsp.in b/gcl/unixport/init_pre_gcl.lsp.in
index f616cc099..f02aff358 100644
--- a/gcl/unixport/init_pre_gcl.lsp.in
+++ b/gcl/unixport/init_pre_gcl.lsp.in

@@ -23,6 +23,11 @@

(or lisp::*link-array*

(setq lisp::*link-array*

(make-array (ash 1 11) :element-type 'string-char :fill-pointer 0)))

+

+ ;; (unless si::*big-list*

+ ;; (setq si::*big-list* (make-array 1000 :element-type 'fixnum :fill-pointer 0 :adjustable t)

+ ;; si::*big-index* (make-array 10 :element-type 'fixnum :fill-pointer 0 :adjustable t)))

+

(si::use-fast-links t)

(let* ((x (append (pathname-directory si::*system-directory*) (list :parent)))