This is the first version with stable tested gc of logical variables

parent 774f61ee
......@@ -23,4 +23,3 @@ Also it is possible to solve inifinite recursion.
(<apply> f x)
(<=> u x)
(hash-set! memo-data (cons f xx) x))))))
#include <pthread.h>
int gp_gc_p = 0;
static int isBefore = 1;
pthread_mutex_t gp_gc_lock = PTHREAD_MUTEX_INITIALIZER;
void gp_no_gc()
{
......@@ -35,26 +37,13 @@ void *gp_after_mark_hook(void *hook_data, void *fn_data, void *data)
SCM pt = scm_fluid_ref(gp_stacks);
pthread_mutex_lock(&gp_gc_lock);
if(gp_gc_p)
{
gp_clear_marks(SCM_CAR(pt));
while(SCM_CONSP(pt))
{
gp_clear_marks(SCM_CAR(pt));
pt = SCM_CDR(pt);
}
pthread_mutex_unlock(&gp_gc_lock);
return (void *)0;
}
while(SCM_CONSP(pt))
{
gp_sweep_handle(SCM_CAR(pt));
gp_clear_marks(SCM_CAR(pt));
gp_clear_marks(SCM_CAR(pt), !isBefore);
pt = SCM_CDR(pt);
}
pthread_mutex_unlock(&gp_gc_lock);
return (void *)0;
}
......@@ -62,21 +51,12 @@ void *gp_before_mark_hook(void *hook_data, void *fn_data, void *data)
{
SCM pt = scm_fluid_ref(gp_stacks);
pthread_mutex_lock(&gp_gc_lock);
if(gp_gc_p)
{
pthread_mutex_unlock(&gp_gc_lock);
return (void *)0;
}
while(SCM_CONSP(pt))
{
gp_clear_marks(SCM_CAR(pt));
gp_clear_marks(SCM_CAR(pt), isBefore);
pt = SCM_CDR(pt);
}
pthread_mutex_unlock(&gp_gc_lock);
return (void *)0;
}
......
......@@ -393,9 +393,13 @@ gp_stack_mark0(SCM obj, int unlocked,
struct gp_stack *gp = GET_GP(obj);
int i;
//printf("mark\n");
//printf("mark\n");
GC_MARK(GP_UNREF((SCM *) gp));
GC_MARK(gp->dynstack);
GC_MARK(gp->rguards);
GC_MARK(gp->handlers);
GC_MARK(GP_UNREF(gp->gp_cstack));
GC_MARK(GP_UNREF(gp->gp_stack));
GC_MARK(GP_UNREF(gp->gp_cons_stack));
......@@ -422,8 +426,9 @@ gp_stack_mark0(SCM obj, int unlocked,
GP_GC_CAND(head);
GP_GETREF(val)[0] = SCM_PACK(head);
//printf("NTMARK(%p)\n",SCM_UNPACK(val));
GC_MARK_NT(val);
GC_MARK(GP_GETREF(val)[1]);
GC_MARK_NT(val);
//GC_MARK(GP_GETREF(val)[1]);
//GC_MARK(val);
/*
val = GP_GETREF(val)[1];
retry:
......@@ -451,13 +456,19 @@ gp_stack_mark0(SCM obj, int unlocked,
GP_GC_CAND(head);
f[0] = SCM_PACK(head);
GC_MARK_NT(GP_UNREF(f));
//GC_MARK(GP_UNREF(f));
}
else
GC_MARK(GP_UNREF(f));
if(SCM_CONSP(*pt))
GC_MARK(*pt);
}
else
{
GC_MARK(pt[-2]);
GC_MARK(pt[-3]);
}
}
else
GC_MARK(*pt);
}
......@@ -493,6 +504,7 @@ gp_stack_mark0(SCM obj, int unlocked,
GC_MARK(gp->rguards);
GC_MARK(gp->handlers);
//printf("end mark\n");
return mark_stack_ptr;
}
......@@ -601,7 +613,7 @@ SCM_DEFINE(gp_make_stack, "gp-make-stack", 5, 0, 0,
static inline int is_advanced_tag(SCM *pt);
void gp_clear_marks(SCM in)
void gp_clear_marks(SCM in, int isBefore)
{
struct gp_stack *gp = GET_GP(in);
......@@ -614,7 +626,7 @@ void gp_clear_marks(SCM in)
{
SCM val = *pt;
scm_t_bits head = SCM_UNPACK(GP_GETREF(val)[0]);
if(!(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head)))
if(isBefore || !(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head)))
{
GP_GC_CLEAR(head);
GP_GC_CLEARCAND(head);
......@@ -628,7 +640,7 @@ void gp_clear_marks(SCM in)
{
SCM *f = get_ci_f(pt + 1);
scm_t_bits head = SCM_UNPACK(f[0]);
if(!(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head)))
if(isBefore || !(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head)))
{
GP_GC_CLEAR(head);
GP_GC_CLEARCAND(head);
......@@ -641,6 +653,7 @@ void gp_clear_marks(SCM in)
//printf("sweep1 %d %d\n",n,nrem);
//printf("clear II");
{
for(pt = gp->gp_stack; pt < gp->gp_nns; pt++)
{
......@@ -657,6 +670,8 @@ void gp_clear_marks(SCM in)
}
}
}
//printf("end clear\n");
}
void gp_sweep_handle(SCM in)
......@@ -667,6 +682,7 @@ void gp_sweep_handle(SCM in)
SCM *pt;
// printf("sweep\n");
// Search for the first newframe stored
for(pt = gp->gp_ci - 1; pt >= gp->gp_cstack + 4; pt--)
......@@ -684,7 +700,7 @@ void gp_sweep_handle(SCM in)
if(GP(*pt))
{
scm_t_bits head = SCM_UNPACK(GP_GETREF(*pt)[0]);
if(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head))
if(!GP_GC_ISMARKED(head))
{
*pt = SCM_BOOL_F;
nrem++;
......@@ -745,6 +761,7 @@ void gp_sweep_handle(SCM in)
{
int vn = 0;
int vrem = 0;
SCM tc = SCM_PACK(GP_MK_FRAME_UNBD(gp_type));
for(pt = gp->gp_stack; pt < gp->gp_si; pt++)
{
vn++;
......@@ -753,7 +770,14 @@ void gp_sweep_handle(SCM in)
SCM *f = GP_GETREF(*pt);
scm_t_bits head = SCM_UNPACK(f[0]);
if(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head))
vrem++;
{
head = SCM_UNPACK(tc);
GP_GC_CAND(head);
f[0] = SCM_PACK(head);
f[1] = SCM_UNBOUND;
vrem++;
}
}
}
......@@ -769,6 +793,8 @@ void gp_sweep_handle(SCM in)
gp->n = n;
gp->nrem = nrem;
//printf("end sweep\n");
}
#include "gc.c"
......@@ -787,7 +813,6 @@ struct GC_ms_entry *gp_stack_mark(SCM pt,
return ret;
}
ret = gp_stack_mark0(pt,1,ptr,limit);
pthread_mutex_unlock(&gp_gc_lock);
return ret;
......@@ -804,16 +829,15 @@ void gp_init_stacks()
gp_stacks = scm_make_fluid_with_default(SCM_EOL);
gp_nil = gp_make_variable();
GP_GETREF(gp_nil)[1] = SCM_PACK((4<<2) + 2);
}
SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
#define FUNC_NAME s_gp_gc
{
//return SCM_UNSPECIFIED;
int mute = 0;
struct gp_stack *gp = get_gp();
gp_no_gc();
//printf("gc0: %d %d\n",gp->n, gp->nrem);
if(gp->n > 100 && gp->nrem*4 > gp->n)
{
//printf("gc: %d %d\n",gp->n, gp->nrem);
......@@ -969,6 +993,8 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
macro;
gp->gp_si = pt2_insert;
}
//printf("end gc\n");
}
gp->n = 0;
......
......@@ -331,6 +331,7 @@ static inline void gp_unwind0(SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
if(GP(*i) && gp_is_free(i))
*i = SCM_BOOL_F;
retry_for_false:
if(scm_is_false(*i))
{
if(state == gp_redo)
......@@ -435,6 +436,16 @@ static inline void gp_unwind0(SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
id = GP_GETREF(*i);
{
SCM *f = GP_GETREF(*i);
scm_t_bits head = SCM_UNPACK(f[0]);
if(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head))
{
*i = SCM_BOOL_F;
goto retry_for_false;
}
}
if(state)
{
switch(state)
......
......@@ -19,7 +19,6 @@
#include<libguile.h>
#include<stdio.h>
//#define DB(X) X
#include "unify.h"
#define VECTOR_HEADER_SIZE 2
......@@ -101,7 +100,7 @@ SCM closure_tag;
#define DB(X)
#define DB(X)
#define DS(X)
#define gp_debug0(s) DB(printf(s) ; fflush(stdout))
#define gp_debug1(s,a) DB(printf(s,a) ; fflush(stdout))
......@@ -331,9 +330,8 @@ static inline SCM gp_make_closure_heap(int n, SCM **closure)
SCM a; \
a = scm_fluid_ref(gp_current_stack); \
if(!GP_STACKP(a)) \
scm_misc_error("unpack_s2",err,SCM_EOL); \
gp_debug0(err); \
if(!SCM_CONSP(s)) \
scm_misc_error("unpack_s0",err,SCM_EOL); \
if(!SCM_CONSP(s)) \
{ \
l = SCM_EOL; \
} \
......@@ -1233,7 +1231,7 @@ int len(SCM x, SCM *l)
gp_format1("(do_ns ~a)~%",scm2); \
if(SCM_STRUCTP(scm2)) \
{ \
SCM* id_save = iid1; \
SCM* id_save = iid1; \
if(attr && GP_ATTRIBUTE(scm2)) \
{ \
SCM *val = GP_GETREF(gp_struct_ref(scm2,0)); \
......@@ -1285,7 +1283,7 @@ static SCM gp_unify(SCM *id1, SCM *id2, int raw, int gp_plus_unify, SCM *l, stru
SCM * stack[110];
int sp;
sp = 0;
gp_format2("(gp-unify! ~a ~a)~%",GP_UNREF(id1),GP_UNREF(id2));
//gp_format2("(gp-unify! ~a ~a)~%",GP_UNREF(id1),GP_UNREF(id2));
#define U_NEXT \
{ \
if(SCM_UNLIKELY(sp==0)) \
......@@ -2543,20 +2541,24 @@ SCM_DEFINE(gp_pair, "gp-pair?", 2, 0, 0, (SCM x, SCM s),
if(GP(x))
{
//printf("pair gp-addr %x, val %x\n",SCM_UNPACK(x),SCM_UNPACK(*GP_GETREF(x)));
DB(printf("pair gp-addr %x, val %x\n",SCM_UNPACK(x),SCM_UNPACK(*GP_GETREF(x))));
if(GP_CONS(GP_GETREF(x)))
{
DB(printf("return> s#f\n"));
return s;
}
DB(printf("return> #f\n"));
return SCM_BOOL_F;
}
DB(printf("struct>\n"));
if(SCM_STRUCTP(x) && GP_NAMESPACE_P(x))
{
x = gp_struct_ref(x,0);
goto retry;
}
DB(printf("last>\n"));
return SCM_CONSP(x) ? s : SCM_BOOL_F;
}
#undef FUNC_NAME
......
......@@ -3,7 +3,7 @@
/*
We need a special variable
*/
#ifdef GP_USE_GC_MOCK
#ifdef GP_USE_GC_MOCK!
static int gp_variable_gc_kind;
static struct GC_ms_entry *
......@@ -26,21 +26,12 @@ gp_mark_variable (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
else
{
SCM x = SCM_CELL_OBJECT_1 (cell);
/*
int i = 0, j = 0, k = 0;
printf("%p\n",SCM_UNPACK(x));fflush(stdout);
if(x && !(SCM_UNPACK(x)&1) && GP(x))
i = 1;
if(i && GP_GC_ISMARKED(SCM_UNPACK(GP_GETREF(x)[0])))
j = 1;
if(GP_GC_ISMARKED(SCM_UNPACK(GP_GETREF(cell)[0])))
k = 1;
*/
//printf("pushing val of [%p] %d {%p} %d %d\n", SCM_UNPACK(cell), k, SCM_UNPACK(x), i, j);
fflush(stdout);
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (x),
mark_stack_ptr,
mark_stack_limit, NULL);
if(GP_GC_ISMARKED(SCM_UNPACK(SCM_CELL_OBJECT_0 (cell))));
{
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (x),
mark_stack_ptr,
mark_stack_limit, NULL);
}
}
return mark_stack_ptr;
......
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