engines can now grow

parent c830be9e
(define-module (logic guile-log paralell)
#:use-module (logic guile-log)
#:use-module (logic guile-log umatch)
#:export (<pand> <pzip> f test))
#:export (<pand> <pzip> f test1 test2))
(<define-guile-log-rule> (<pit> cc p s code ...)
......@@ -60,8 +60,11 @@
(if (< i n)
(<or> (<=> x i) (lp (+ i 1))))))
(<define> (test x y)
(<define> (test1 x y)
(<pzip> (v1 p1 (f x 3)) (v2 p2 (f y 3))))
(<define> (test2 x y)
(<pzip> (v1 p1 (<member> 1 x)) (v2 p2 (<member> 2 y))))
......@@ -3,28 +3,132 @@ int gp_gc_p = 0;
inline void enlarge_stack(struct gp_stack *gp, int N, int NN)
{
SCM * old = gp->gp_stack;
gp->gp_stack =
(SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
SCM *pt, *pt2;
for(pt = old, pt2 = gp->gp_stack; pt < gp->gp_si; pt++, pt2++)
{
*pt2 = *pt;
}
gp->gp_nns = gp->gp_stack + NN - 2;
gp->gp_si = pt2;
for(; pt2 < gp->gp_nns; pt2++)
{
*pt2 = SCM_BOOL_F;
}
}
inline void enlarge_frstack(struct gp_stack *gp, int N, int NN)
{
SCM * old = gp->gp_frstack;
gp->gp_frstack =
(SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
SCM *pt, *pt2;
for(pt = old, pt2 = gp->gp_frstack; pt < gp->gp_fr; pt++, pt2++)
{
*pt2 = *pt;
}
gp->gp_nnfr = gp->gp_frstack + NN - 2;
gp->gp_fr = pt2;
}
inline void enlarge_cstack(struct gp_stack *gp, int N, int NN)
{
SCM * old = gp->gp_cstack;
gp->gp_cstack =
(SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_cstack");
SCM *pt, *pt2;
for(pt = old, pt2 = gp->gp_cstack; pt < gp->gp_ci; pt++, pt2++)
{
*pt2 = *pt;
}
gp->gp_nnc = gp->gp_cstack + NN - 2;
gp->gp_ci = pt2;
}
inline void enlarge_csstack(struct gp_stack *gp, int N, int NN)
{
SCM * old = gp->gp_cons_stack;
gp->gp_cons_stack =
(SCM *) scm_gc_malloc_pointerless(sizeof(SCM) * NN,"gp->gp_stack");
SCM *pt, *pt2;
for(pt = old, pt2 = gp->gp_cons_stack; pt < gp->gp_cs; pt++, pt2++)
{
*pt2 = *pt;
}
gp->gp_nncs = gp->gp_cons_stack + NN - 2;
gp->gp_cs = pt2;
for(; pt2 < gp->gp_nncs; pt2++)
{
*pt2 = SCM_BOOL_F;
}
}
#ifdef HAS_GP_GC
int gp_gc_counter = 0;
inline void gp_gc_inc(struct gp_stack *gp)
{
unsigned long
ns = gp->gp_nns - gp->gp_si,
nc = gp->gp_nncs - gp->gp_cs,
nf = gp->gp_nnfr - gp->gp_fr,
long Ns = gp->gp_nns - gp->gp_stack;
long Nc = gp->gp_nncs - gp->gp_cons_stack;
long Nf = gp->gp_nnfr - gp->gp_frstack;
long N = gp->gp_nnc - gp->gp_cstack;
long ns = gp->gp_nns - gp->gp_si;
long nc = gp->gp_nncs - gp->gp_cs;
long nf = gp->gp_nnfr - gp->gp_fr;
long n = gp->gp_nnc - gp->gp_ci;
if(ns < 5)
{
enlarge_stack(gp,Ns,2*Ns);
ns = gp->gp_nns - gp->gp_si;
}
if(nc < 5)
{
enlarge_csstack(gp,Nc,2*Nc);
nc = gp->gp_nncs - gp->gp_cs;
}
if(nf < 5)
{
enlarge_frstack(gp,Nf,2*Nf);
nf = gp->gp_nnfr - gp->gp_fr;
}
if(n < 5)
{
enlarge_cstack(gp,N,2*N);
n = gp->gp_nnc - gp->gp_ci;
}
n = (nf > n) ? ((nc > n) ? (n > ns ? ns : n)
: (nc > ns ? ns : nc))
: ((nc > nf) ? (nf > ns ? ns : nf)
: (nc > ns ? ns : nc));
N = (Nf > N) ? ((Nc > Nf) ? (Ns > Nc ? Ns : N) :
(Ns > Nf ? Ns : Nf)) :
((Nc > N) ? (Ns > Nc ? Ns : Nc) : (Ns > N ? Ns : N));
if(N < 10000) return;
gp_gc_counter++;
if(n > 10000)
{
gp_gc_counter++;
}
else if (n > 1000)
if (n > 1000)
{
if(gp_gc_counter >= 10000)
{
......
......@@ -1247,6 +1247,7 @@ static inline SCM gp_newframe(SCM s)
struct gp_stack *gp = get_gp();
gp_debug0("newframe\n");
if(SCM_CONSP(s))
{
l = SCM_CDR(s);
......
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