persistanse development

parent 56bbf292
......@@ -125,13 +125,12 @@
(define-syntax-rule (ket self l ...)
(letrec ((self (let l ...))) self))
(define (unserialize log)
(define lmap (make-hash-table))
(let lp ((l (reverse (log 'data))))
(if (pair? l)
(begin
(match (pk (car l))
(match (car l)
(((? (M vlist-null-i)) i)
(let ((v vlist-null))
(log 'reg-obj i v)))
......@@ -187,7 +186,7 @@
(log 'reg-obj i <standard-vtable>))
(((? (M gp-cons)) i)
(let ((v (pk 'gp-cons (gp-make-pure-cons))))
(let ((v (gp-make-pure-cons)))
(log 'reg-obj i v)))
(((? (M code)) i a)
......@@ -261,13 +260,14 @@
obj)))))
(((? (M set-struct) i l)) 1)
(((? (M set-gp-cons)) i j k)
(let ((v (pk 'lookup (log 'rev-lookup i)))
(((? (M set-gp-cons)) i id j k)
(let ((v (log 'rev-lookup i))
(x (log 'rev-lookup j))
(y (log 'rev-lookup k)))
(gp-cons-set-1! v x)
(gp-cons-set-2! v y)
(pk 'resulting-vons v))))
(gp-cons-set-2! v y))))
(lp (cdr l))))))
......@@ -682,6 +682,7 @@
(if i
i
(code))))
(cond
((and pred (object-property x 'get-accessor))
=>
......@@ -696,28 +697,38 @@
((eq? x <standard-vtable>)
(mk make-standard-vtable))
((gp-cons? x)
(mk make-a-gp-cons))
((gp? x)
(mk make-a-gp-var))
((variable? x)
(mk make-a-var))
((fluid? x)
(mk make-a-fluid))
((pair? x)
(mk make-a-pair))
((vector? x)
(mk make-a-vector))
((struct? x)
(mk make-a-struct))
((procedure? x)
(if (primitive? x)
(aif (it) (get-primitive x)
(mk make-a-primitive)
(error "non registred primitive"))
(mk make-a-procedure)))
((code-to-int x)
(mk make-a-code))
(else
(mk make-atom))))
......
#define DB(X) X
//#define DB(X) X
#define STATE_LOGICAL 0
#define STATE_DYNSTACK 1
......@@ -1263,6 +1263,7 @@ static inline SCM * gp_get_branch(SCM *p, SCM *fr, struct gp_stack *gp)
}
}
*p = pt;
return fr;
}
//#define DB(X) X
......@@ -1560,6 +1561,17 @@ void check(char * str, SCM* fr, SCM pp_x, SCM path)
}
}
SCM scm_length2(SCM pt)
{
int i;
for(i = 0; SCM_CONSP(pt);pt=SCM_CDR(pt),i++)
{
}
return scm_from_int(i);
}
//#define DB(X) X
static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
{
......@@ -1597,6 +1609,10 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
fr_x = gp->gp_fr - 1;
pp_x = pathfr;
gp_format2("npath ~a npath_fr ~a~%",
scm_length2(path),
scm_length2(pathfr));
if(m > n)
{
gp_debug0("m > n\n");
......@@ -1621,13 +1637,21 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
gp_debug2("restore n == m %d > %d\n",n,m);
}
if(n != m)
scm_misc_error("gp-restore-state","m != n ~a != ~a",
scm_list_2(SCM_I_MAKINUM(m),SCM_I_MAKINUM(n)));
gp_format1("pp_x ~a~%", scm_length2(pp_x));
gp_debug0("get-branch\n");
fr = gp_get_branch(&pp_x, fr_x, gp) + 1;
gp_format2("pp_x ~a dfr ~a~%",
scm_length2(pp_x),
scm_from_long(fr_x-fr));
gp_debug1("got-branch - will check (check fr: %d == 0)\n",
(fr - gp->gp_frstack) % GP_FRAMESIZE);
......@@ -1657,6 +1681,7 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
gp_debug0("scan ci stack\n");
SCM pp_c = gp_scan_tail(path, ci, gp);
gp_format1("pp_c ~a~%", scm_length2(pp_c));
gp_debug0("check ci stack\n");
check("valstack", ci, pp_c, path);
......@@ -1671,9 +1696,7 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
scm_misc_error("gp_restore_state",
"final length is wrong by (theo - cur) ~a",
scm_list_1(SCM_I_MAKINUM(nfini -
((scm_t_bits)
(gp->gp_ci - gp->gp_cstack))
/ 8)));
(gp->gp_fr - gp->gp_frstack))));
if(GP_GET_VAL_VAL(gp->gp_fr) != gp->gp_ci - gp->gp_cstack - 1)
{
......@@ -1715,7 +1738,7 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
gp->handlers = v[HANDLERS];
}
#define DB(X)
//#define DB(X)
SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
"restore a continuation point")
......
......@@ -3175,7 +3175,7 @@ int _gp_pair(SCM **spp, int nargs, SCM *cl, SCM *max)
SCM_DEFINE(gp_consp, "gp-cons?", 1, 0, 0, (SCM x), "")
{
if(SCM_CONSP(x))
if(GP_CONSP(x))
return SCM_BOOL_T;
else
return SCM_BOOL_F;
......
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