Chenged wrong referfence to patching guile in README

parent 98f73577
......@@ -6,18 +6,6 @@ This is a draft for guile-2.0.6 and later and works for linux.
You need to have guile-syntax-parse installed
http://gitorious.org/guile-syntax-parse/guile-syntax-parse
You need the sources to guile
We assume guile-2.0 is buildable and also installed. It is assumed that the
system is linux in order for the below to work out of the box. Also guile-syntax-parse must be installed.
First apply the guile.diff in the main directory patch using,
patch -p1 < path/to/guile.diff
In the guile directory and recompile.
Add this directory to guiles load-path
Install:
......
......@@ -344,9 +344,8 @@ and-interleave
(define-syntax-rule (fcall-m nm letg)
(define (nm s p cc lam x l f)
(use-logical s)
(let ((s (gp-newframe s)))
(letg ((cc cc))
(letg ((cc cc))
(let ((s (gp-newframe s)))
((gp-lookup lam s)
s p (lambda (ss pp)
(let ((state (gp-store-state ss)))
......@@ -361,9 +360,7 @@ and-interleave
(set! cc cc-new)
(gp-restore-wind state)
(pp)))))
(leave-logical s)
(for-each (lambda (l x) (l (gp-cp x s))) l xx)
(for-each (lambda (l x) (l x)) l xx)
(f ppp)
(cc s ppp))))))))))
......@@ -385,10 +382,11 @@ and-interleave
(fail2 (lambda (v)
(set! fail v))) ...
(allfail P))
(<logical++>)
(<with-fail> allfail
(fcall (</.> code ...) (list x ...) (list xx2 ...) fail2))
...
(<logical-->)
(<let> ((ccx CC))
(<fluid-let-syntax> ((CC2 (lambda z #'ccx)))
(<or> <cc>
......
......@@ -466,7 +466,7 @@
(gp-dynwind
(lambda () (pp (gp->scm a s)))
(lambda () (parse<> (cut s p cc) <cc>))
(lambda () (pp (gp->scm b s)))
(lambda (x) (pp (gp->scm b s)))
s)))))
(define-guile-log <dyn>
......@@ -476,7 +476,7 @@
(gp-dynwind
(lambda () a)
(lambda () (parse<> (cut s p cc) <cc>))
(lambda () b)
(lambda (x) b)
s)))))
(define-guile-log <format>
......
......@@ -134,6 +134,61 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, s
return (SCM *)0;
}
#define NCSTACK 1000000
static void gp_double_cstack(struct gp_stack *gp)
{
if(gp->gp_nc > NCSTACK) goto error;
int i,nc = 2*gp->gp_nc;
SCM *pt = (SCM *) scm_gc_malloc(sizeof(SCM) * nc,"gp->gp_stack");
if(!pt) goto error;
scm_gc_protect_object(GP_UNREF(pt));
for(i = 0; i < gp->gp_nc; i++)
{
pt[i] = gp->gp_cstack[i];
}
SCM *ci = pt + (gp->gp_ci - gp->gp_cstack);
gp->gp_cstack = pt;
gp->gp_nc = nc;
gp->gp_nnc = gp->gp_cstack + gp->gp_nc - 10;
gp->gp_ci = ci;
scm_gc_unprotect_object(GP_UNREF(pt));
error:
scm_misc_error("gp_stack","gp->cstack cannot grow more",SCM_EOL);
}
#define NCSSTACK 1000000
static void gp_double_cons_stack(struct gp_stack *gp)
{
if(gp->gp_ncs > NCSSTACK) goto error;
int i,ncs = 2*gp->gp_ncs;
SCM *pt = (SCM *) scm_gc_malloc(sizeof(SCM) * ncs,"gp->gp_stack");
if(!pt) goto error;
scm_gc_protect_object(GP_UNREF(pt));
for(i = 0; i < gp->gp_ncs; i++)
{
pt[i] = gp->gp_cons_stack[i];
}
for(;i < ncs; i++)
{
pt[i] = SCM_BOOL_F;
}
SCM *cs = pt + (gp->gp_cs - gp->gp_cons_stack);
gp->gp_cons_stack = pt;
gp->gp_ncs = ncs;
gp->gp_nncs = gp->gp_cons_stack + gp->gp_ncs - 10;
gp->gp_cs = cs;
scm_gc_unprotect_object(GP_UNREF(pt));
error:
scm_misc_error("gp_stack","gp->cstack cannot grow more",SCM_EOL);
}
static SCM gp_stack_mark(SCM obj)
{
......@@ -141,7 +196,7 @@ static SCM gp_stack_mark(SCM obj)
int i;
//printf("stack mark\n");
scm_gc_mark(GP_UNREF(gp->gp_cstack));
scm_gc_mark(GP_UNREF(gp->gp_stack));
scm_gc_mark(GP_UNREF(gp->gp_cons_stack));
......
......@@ -28,7 +28,7 @@ SCM inline get_cs(SCM v)
return v;
}
static inline SCM gp_handle(SCM item, int ret, SCM gp_unbd)
static inline SCM gp_handle(SCM item, int ret, SCM gp_unbd, int state)
{
SCM x = SCM_BOOL_F,q,a,b,*id;
......@@ -62,7 +62,7 @@ static inline SCM gp_handle(SCM item, int ret, SCM gp_unbd)
if(scm_is_false(SCM_CDR(item)))
scm_call_1(SCM_CAR(item),SCM_BOOL_F);
else
scm_call_0(SCM_CDR(item));
scm_call_1(SCM_CDR(item),(state == gp_store) ? SCM_BOOL_T : SCM_BOOL_F);
return item;
}
else if(GP(item))
......@@ -103,7 +103,7 @@ static inline int gp_advanced(SCM item, int state, SCM *old, SCM gp_unbd)
case 0:
*old = item;
item = SCM_CDR(item);
SCM_SETCAR(*old, gp_handle(item, 1, gp_unbd));
SCM_SETCAR(*old, gp_handle(item, 1, gp_unbd, state));
SCM_SETCDR(*old, SCM_EOL);
return gp_store;
}
......@@ -113,7 +113,7 @@ static inline int gp_advanced(SCM item, int state, SCM *old, SCM gp_unbd)
redo = SCM_CAR(item);
if(state == gp_store)
SCM_SETCDR(*old, redo);
gp_handle(SCM_CDR(item), 0, gp_unbd);
gp_handle(SCM_CDR(item), 0, gp_unbd, state);
*old = redo;
return gp_redo;
default:
......
......@@ -248,7 +248,7 @@
(define (gp-dynwind pre action post s)
(pre)
(dyn pre post s)
(dyn pre post) s)
(action))
......@@ -400,16 +400,16 @@
(define (use-logical s)
(gp-dynwind
(lambda () (gp-logical++ s))
(lambda () #f)
(lambda () (gp-logical-- s))
(lambda () (gp-logical++ s))
(lambda () #f)
(lambda (x) (gp-logical-- s))
s))
(define (leave-logical s)
(gp-dynwind
(lambda () (gp-logical-- s))
(lambda () #f)
(lambda () (gp-logical++ s))
(lambda () (gp-logical-- s))
(lambda () #f)
(lambda (x) (gp-logical++ s))
s))
(define gp-member -gp-member)
......
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