cons stack is implemented

parent e1deabb0
......@@ -64,6 +64,12 @@ static inline struct gp_stack *get_gp()
return (struct gp_stack *)0;
}
static inline void init_gp_var(SCM *cand)
{
cand[0] = SCM_PACK(GP_MK_FRAME_EQ(gp_type));
cand[1] = SCM_UNBOUND;
}
static inline SCM *get_gp_var(struct gp_stack *gp)
{
SCM cand;
......@@ -75,7 +81,54 @@ static inline SCM *get_gp_var(struct gp_stack *gp)
gp->gp_si[0] = cand;
}
gp->gp_si ++;
GP_GETREF(cand)[0] = SCM_PACK(GP_MK_FRAME_EQ(gp_type));
init_gp_var(GP_GETREF(cand));
return GP_GETREF(cand);
}
static inline init_gp_cons(SCM *cand, struct gp_stack *gp)
{
if(!GP_CONS(cand))
cand[0] = SCM_PACK(GP_MK_FRAME_CONS(gp_type));
SCM car = cand[1];
if(GP(car))
{
if(!(GP_VAR(car)))
{
init_gp_var(GP_GETREF(car));
}
}
else
{
cand[1] = gp_make_variable();
}
SCM cdr = cand[2];
if(GP(cdr))
{
if(!(GP_VAR(cdr)))
{
init_gp_var(GP_GETREF(cdr));
}
}
else
{
cand[2] = gp_make_variable();
}
}
static inline SCM *get_gp_cons(struct gp_stack *gp)
{
SCM cand;
GP_TEST_STACK;
cand = *(gp->gp_cs);
if(scm_is_false(cand) || scm_is_eq(cand, SCM_BOOL_T))
{
cand = gp_make_cons();
gp->gp_cs[0] = cand;
}
gp->gp_cs ++;
init_gp_cons(GP_GETREF(cand));
return GP_GETREF(cand);
}
......@@ -506,6 +559,32 @@ gp_stack_mark0(SCM obj, int unlocked,
}
}
for(i=0;i < gp->gp_cs - gp->gp_cons_stack; i++)
{
SCM *pt = gp->gp_cons_stack + i;
if(GP(*pt))
{
if(unlocked)
{
scm_t_bits head = SCM_UNPACK(GP_GETREF(*pt)[0]);
GP_GC_CAND(head);
GP_GETREF(*pt)[0] = SCM_PACK(head);
GC_MARK_NT(*pt);
}
else
GC_MARK(*pt);
}
}
for(;i < gp->gp_nncs - gp->gp_cons_stack; i++)
{
SCM *pt = gp->gp_cons_stack + i;
if(GP(*pt))
{
GC_MARK(*pt);
}
}
GC_MARK(gp->dynstack);
GC_MARK(gp->rguards);
GC_MARK(gp->handlers);
......@@ -534,7 +613,7 @@ static inline void gp_alloc_cons(struct gp_stack *gp, int n)
for(i=0;i < 10000 && gp->gp_cs+i < gp->gp_nncs;i++)
{
if(!SCM_CONSP(gp->gp_cs[i]))
gp->gp_cs[i] = scm_cons(SCM_BOOL_F,SCM_BOOL_F);
gp->gp_cs[i] = gp_make_cons();
}
return;
......@@ -545,17 +624,10 @@ static inline void gp_alloc_cons(struct gp_stack *gp, int n)
static inline SCM gpa_cons(SCM x, SCM y, struct gp_stack *gp)
{
SCM r = gp->gp_cs[0];
gp->gp_cs++;
if(!SCM_CONSP(r))
{
r = scm_cons(x,y);
gp->gp_cs[-1] = r;
return r;
}
SCM_SETCAR(r,x);
SCM_SETCDR(r,y);
return r;
SCM *r = get_gp_cons(gp);
r[1] = x;
r[2] = y;
return GP_UNREF(r);
}
static inline SCM* gp_alloc_data(int n, struct gp_stack *gp)
......@@ -677,6 +749,26 @@ void gp_clear_marks(SCM in, int isBefore)
}
}
{
for(pt = gp->gp_cons_stack; pt < gp->gp_nncs; pt++)
{
if(GP(*pt))
{
SCM *f = GP_GETREF(*pt);
scm_t_bits head = SCM_UNPACK(f[0]);
if(pt >= gp->gp_cs)
{
f[1] = SCM_UNBOUND;
f[2] = SCM_UNBOUND;
}
GP_GC_CLEAR(head);
GP_GC_CLEARCAND(head);
f[0] = SCM_PACK(head);
}
}
}
//printf("end clear\n");
}
......@@ -787,6 +879,26 @@ void gp_sweep_handle(SCM in)
}
}
for(pt = gp->gp_cons_stack; pt < gp->gp_cs; pt++)
{
vn++;
if(GP(*pt))
{
SCM *f = GP_GETREF(*pt);
scm_t_bits head = SCM_UNPACK(f[0]);
if(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head))
{
head = SCM_UNPACK(tc);
GP_GC_CAND(head);
f[0] = SCM_PACK(head);
f[1] = SCM_UNBOUND;
f[2] = SCM_UNBOUND;
vrem++;
}
}
}
//Trigger cleanup code
if(vn > 100 && vrem*2 - vn > nrem * 2 - n)
{
......@@ -848,7 +960,8 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
if(gp->n > 100 && gp->nrem*4 > gp->n)
{
//printf("gc: %d %d\n",gp->n, gp->nrem);
SCM *pt1,*pt2, *pt1_insert, *pt2_insert, *last_redo = gp->gp_cstack,
SCM *pt1,*pt2, *pt3, *pt1_insert, *pt2_insert,*pt3_insert,
*last_redo = gp->gp_cstack,
*last_save = gp->gp_cstack;
......@@ -881,8 +994,10 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
pt1 = gp->gp_cstack + 4;
pt2 = gp->gp_stack;
pt3 = gp->gp_cons_stack;
pt1_insert = pt1;
pt2_insert = pt2;
pt3_insert = pt3;
while(pt1 < gp->gp_ci)
{
......@@ -978,10 +1093,44 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
pt2_insert ++; \
} \
\
} \
while(pt3 < si) \
{ \
if(!mute && scm_is_false(*pt3)) \
{ \
pt3++; \
continue; \
} \
\
if(GP(*pt3)) \
{ \
SCM *f = GP_GETREF(*pt3); \
scm_t_bits head = SCM_UNPACK(f[0]); \
if(!GP_GC_ISMARKED(head) && GP_GC_ISCAND(head)) \
{ \
if(!mute) \
{ \
f[1] = SCM_UNBOUND; \
f[2] = SCM_UNBOUND; \
pt3++; \
continue; \
} \
} \
} \
\
{ \
SCM temp = *pt3_insert; \
*pt3_insert = *pt3; \
*pt3 = temp; \
\
pt3 ++; \
pt3_insert ++; \
} \
\
}
macro;
set_cs_si_all(pt1_insert, cs, pt2_insert, gp);
set_cs_si_all(pt1_insert, pt3_insert, pt2_insert, gp);
}
continue;
......@@ -999,6 +1148,7 @@ SCM_DEFINE(gp_gc, "gp-gc", 0, 0, 0, (), "clean up the stack")
SCM *si=gp->gp_si;
macro;
gp->gp_si = pt2_insert;
gp->gp_cs = pt3_insert;
}
//printf("end gc\n");
......
......@@ -524,6 +524,43 @@ static inline void gp_unwind0(SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
//cs part
int cs_store = 0;
gp_debug0("si handling\n");
for(i = gp->gp_cs - 1; i >= cs; i--)
{
gp_debug2("cs iter %x %x\n",i - cs, i - gp->gp_cons_stack);
if(cs_store)
{
gp_debug0("store\n");
if(GP(*i))
{
*i = SCM_BOOL_F;
}
}
else
{
if(scm_is_eq(*i,SCM_BOOL_T))
{
*i = SCM_BOOL_F;
cs_store = 1;
continue;
}
}
}
gp_debug1("finishing cs %x\n",gp->gp_cs - cs);
if(cs_store)
{
*cs = SCM_BOOL_T;
gp->gp_cs = cs + 1;
}
else
gp->gp_cs = cs;
//*s part
int cs_store = 0;
gp_debug0("cs handling\n");
for(i = gp->gp_cs - 1; i >= cs; i--)
{
......@@ -596,6 +633,7 @@ static inline void gp_unwind0(SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
}
// ----------------------------- End cs part
*/
gp_debug1("last routines %x\n",gp->gp_ci - gp->gp_cstack);
if(state)
......
......@@ -218,9 +218,8 @@ scm_t_bits gp_smob_t;
#define PTR2NUM(x) SCM_PACK((((scm_t_bits) x) | 2))
#define NUM2PTR(x) ((SCM *) (SCM_UNPACK(x) & ~2))
#define GP_CAR(id) ((id) - 2)
#define GP_CDR(id) ((id) - 4)
#define GP_BUDY(id) ((id) + 2)
#define GP_CAR(id) ((id) + 1)
#define GP_CDR(id) ((id) + 2)
#define GP_GETREF(x) ((SCM *) (x))
......@@ -900,7 +899,7 @@ static inline SCM gp_mk_cons(SCM s)
struct gp_stack *gp;
gp = get_gp();
if(1 || gp->_logical_)
if(gp->_logical_)
{
SCM x = make_logical();
SCM y = make_logical();
......@@ -912,27 +911,12 @@ static inline SCM gp_mk_cons(SCM s)
GP_TEST_STACK;
GP_TEST_CSTACK;
ret = gp->gp_si;
gp->gp_si += 6;
gp_debug0("in cons is %x\n");
fi = GP_MK_FRAME_CONS(gp_type);
mask_on(gp->id,(ret+4),SCM_PACK(fi));
*(ret+5) = SCM_UNDEFINED;
ret = get_gp_cons(gp);
*(gp->gp_ci) = GP_UNREF(ret + 4);
gp->gp_ci ++;
fi = GP_MK_FRAME_UNBD(gp_type);
mask_on(gp->id,(ret+2),SCM_PACK(fi));
mask_on(gp->id,(ret+0),SCM_PACK(fi));
gp_debug0("in cons is %x\n");
*(ret+1) = SCM_UNBOUND;
*(ret+3) = SCM_UNBOUND;
return GP_UNREF(ret + 4);
return GP_UNREF(ret);
}
#define gp_struct_ref(scm,i) SCM_PACK(SCM_STRUCT_DATA(scm)[i])
......@@ -2181,14 +2165,8 @@ SCM_DEFINE(gp_next_budy, "gp-budy", 1, 0, 0, (SCM x),
"Assumes that v1 and v2 is allocated consecutively returns v2 when feeded by v1")
#define FUNC_NAME s_gp_next_budy
{
SCM *id;
if(!GP(x)) goto not_a_budy_error;
id = UN_GP(x);
return SCM_PACK(GP_BUDY(id));
not_a_budy_error:
scm_misc_error ("budy error", "cannot budy a non GP element",
scm_list_1 (x)); \
scm_misc_error ("budy error", "cannot budy - not supprted use attributed variables instead",
scm_list_1 (x));
return SCM_BOOL_F;
}
......@@ -2413,7 +2391,7 @@ SCM_DEFINE(gp_cons_bang, "gp-cons!", 3, 0, 0, (SCM car, SCM cdr, SCM s),
SCM *id;
struct gp_stack *gp = get_gp();
if(1 || gp->_logical_) return scm_cons(car,cdr);
if(gp->_logical_) return scm_cons(car,cdr);
gp_debus0("gp-cons>\n");
cons = GP_GETREF(gp_mk_cons(s));
......
......@@ -22,7 +22,7 @@ gp_mark_variable (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
if(SCM_SMOB_PREDICATE(gp_stack_type,cell))
{
mark_stack_ptr = gp_stack_mark(cell, mark_stack_ptr, mark_stack_limit);
}
}
else
{
SCM x = SCM_CELL_OBJECT_1 (cell);
......@@ -31,6 +31,14 @@ gp_mark_variable (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (x),
mark_stack_ptr,
mark_stack_limit, NULL);
if(GP_CONS(GP_GETREF(cell)))
{
mark_stack_ptr =
GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_2 (cell)),
mark_stack_ptr,
mark_stack_limit, NULL);
}
}
}
......@@ -53,9 +61,37 @@ SCM gp_make_variable()
#else
SCM ret = scm_new_smob(gp_type, (scm_t_bits)0);
SCM *v = GP_GETREF(ret);
v[0] = SCM_PACK(GP_MK_FRAME_UNBD(gp_type) | GPI_SCM_Q);
v[0] = SCM_PACK(GP_MK_FRAME_UNBD(gp_type));
v[1] = SCM_UNBOUND;
return ret;
#endif
}
SCM gp_make_cons()
{
SCM x1 = gp_make_variable();
SCM x2 = gp_make_variable();
#ifdef HAS_GP_GC
SCM ret = PTR2SCM (GC_generic_malloc (3 * sizeof (scm_t_cell),
gp_variable_gc_kind));
SCM tc = SCM_PACK(GP_MK_FRAME_CONS(gp_type));
SCM_SET_CELL_WORD_2 (ret, x1);
SCM_SET_CELL_WORD_1 (ret, x2);
SCM_SET_CELL_WORD_0 (ret, tc);
return ret;
#else
SCM ret = scm_new_double_smob(gp_type,
(scm_t_bits)0,
(scm_t_bits)0,
(scm_t_bits)0);
SCM *v = GP_GETREF(ret);
v[0] = SCM_PACK(GP_MK_FRAME_CONS(gp_type));
v[1] = x1;
v[2] = x2;
v[3] = SCM_UNBOUND;
return ret;
#endif
}
......
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