added another stack to be able to allocate closures from the stack and still...

added another stack to be able to allocate closures from the stack and still be able to store the state e.g. push the closures to the heap, einstein example works
parent ea18d8fd
......@@ -4,6 +4,7 @@
(define-module (ice-9 match-phd-lookup)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:export (match-define match-let* match-let match-letrec match-lambda*
match-lambda match make-phd-matcher))
......@@ -291,14 +292,13 @@
(define-syntax match-three*
(syntax-rules (_ ___ *** quote quasiquote ? $ = and or not set! get!)
((match-two (abs ((car cdr pair? null? id) rr)) s v (p) g+s sk fk i)
(let ((s (pair? v s)))
(let-values (((w cd s) (pair? v s)))
(if s
(let ((s (null? (cdr v s) s)))
(let ((s (null? cd s)))
(if s
(let ((w (car v s)))
(match-one (abs ((car cdr pair? null? id) rr)) s w p
((car w)
(set-car! w)) sk fk i))
(match-one (abs ((car cdr pair? null? id) rr)) s w p
((car w)
(set-car! w)) sk fk i)
(insert-abs (abs ((car cdr pair? null? equal? id) pp)) fk)))
(insert-abs (abs ((car cdr pair? null? equal? id) pp)) fk))))
......@@ -310,14 +310,13 @@
((match-two (abs ((car cdr pair? null? equal? id) pp)) s v (p . q)
g+s sk fk i)
(let ((s (pair? v s)))
(let-values (((w x s) (pair? v s)))
(if s
(let ((w (car v s)) (x (cdr v s)))
(match-one (abs ((car cdr pair? null? equal? id) pp)) s w p
((car ww) (set-car! ww))
(match-one s x q ((cdr ww) (set-cdr! ww)) sk fk)
fk
i))
(match-one (abs ((car cdr pair? null? equal? id) pp)) s w p
((car ww) (set-car! ww))
(match-one s x q ((cdr ww) (set-cdr! ww)) sk fk)
fk
i)
(insert-abs (abs ((car cdr pair? null? equal? id) pp)) fk))))
((match-two abs s v #(p ...) g+s . x)
......
......@@ -17,7 +17,8 @@
gp-make-stack
gp-pair!? gp-null!? gp-null?
gp-jumpframe-start gp-jumpframe-end gp?
gp-module-init))
gp-module-init
-gp-member -gp-right-of))
......@@ -46,6 +47,13 @@
(define-inlinable (gp-m-unify! x y s)
(fast-call-3 2 x y s))
#|
(fast-call-set! -gp-member 3 3)
(define --gp-member -gp-member)
(define-inlinable (-gp-member x l s)
(fast-call-3 3 x l s))
|#
;; fast call 1 arg
(fast-call-set! gp-jumpframe-start 1 2)
(define-inlinable (gp-jumpframe-start s)
......@@ -63,6 +71,10 @@
(define-inlinable (gp-newframe s)
(fast-call-1 5 s))
(fast-call-set! gp-var! 1 6)
(define-inlinable (gp-var! s)
(fast-call-1 6 s))
;; fast call 2 arg
(fast-call-set! gp-lookup 2 0)
......@@ -89,10 +101,25 @@
(define-inlinable (gp-car x s)
(fast-call-2 5 x s))
(fast-call-set! gp-cdr 2 6)
(define-inlinable (gp-cdr x s)
(fast-call-2 6 x s))
(fast-call-set! gp->scm 2 7)
(define-inlinable (gp->scm x s)
(fast-call-2 7 x s))
;; fast call 4 args
#|
(fast-call-set! -gp-right-of 4 0)
(define-inlinable (-gp-right-of x y l s)
(fast-call-4 0 x y l s))
|#
(let ((tag (cons 'the 'closure-tag)))
(set-c-closure-tag tag)
(gp-set-closure-tag tag))
(define -gp-member (gp-make-member))
(define -gp-right-of (gp-make-right-of))
(define-module (logic guile-log examples einstein)
#:use-module (srfi srfi-11)
#:use-module (logic guile-log)
#:use-module (logic guile-log umatch)
#:use-module (ice-9 pretty-print)
......@@ -6,11 +7,22 @@
;(use-modules (language prolog kanren))
(<define> (memb x l)
(<match> () (l)
((,x . l) <cc>)
((_ . l) (<cut> (memb x l)))
(_ <fail>)))
(define memb gp-member)
#;(define (memb s p cc x l)
(let ((f (gp-newframe s)))
(letrec ((next (lambda (l)
(let loop ((l l))
(gp-unwind f)
(let-values (((a as s) (gp-fpair!? l s)))
(if s
(let ((s (gp-unify-raw! a x s)))
(if s
(cc s (lambda () (next as)))
(loop as)))
(p)))))))
(next l))))
#;
(<define> (on-right i j l)
......@@ -21,26 +33,43 @@
(_ <fail>)))
(define (on-right s p cc i j l)
(define on-right gp-right-of)
#;(define (on-right s p cc i j l)
(let ((f (gp-newframe s)))
(let loop ((l l))
(gp-unwind f)
(let ((s (gp-pair!? l f)))
(if s
(let ((ii (gp-car l s))
(ll (gp-cdr l s)))
(let ((s (gp-pair!? ll s)))
(if s
(let ((jj (gp-car ll s)))
(let ((s (gp-unify-raw! ii i s)))
(if s
(let ((s (gp-unify-raw! jj j s)))
(if s
(cc s (lambda () (loop ll)))
(loop ll)))
(loop ll))))
(p))))
(p))))))
(letrec ((next (lambda (l)
(let loop ((l l))
(gp-unwind f)
(let-values (((ii ll s) (gp-fpair!? l f)))
(if s
(let-values (((jj kk s) (gp-fpair!? ll s)))
(if s
(let ((s (gp-unify-raw! ii i s)))
(if s
(let ((s (gp-unify-raw! jj j s)))
(if s
(cc s (lambda () (next ll)))
(loop ll)))
(loop ll)))
(p)))
(p))))))
(loop (lambda (l)
(gp-unwind f)
(let-values (((ii ll s) (gp-fpair!? l f)))
(if s
(let-values (((jj kk s) (gp-fpair!? ll s)))
(if s
(let ((s (gp-unify-raw! ii i s)))
(if s
(let ((s (gp-unify-raw! jj j s)))
(if s
(cc s (lambda () (next ll)))
(loop ll)))
(loop ll)))
(p)))
(p))))))
(loop l))))
(<define> (next-to item1 item2 rest)
......@@ -54,24 +83,66 @@
((x . l) #'((gp-var! *current-stack*) . l))
(_ #'(gp-var! *current-stack*)))))
(define a1 #f)
(define a2 #f)
(define a3 #f)
(define a4a #f)
(define a4b #f)
(define a5 #f)
(define a6 #f)
(define a7 #f)
(define a8a #f)
(define a8b #f)
(define a9 #f)
(define a10a #f)
(define a10b #f)
(define a11a #f)
(define a11b #f)
(define a12 #f)
(define a13 #f)
(define a14a #f)
(define a14b #f)
(define a15 #f)
(<define> (einstein h)
(<code>
(set! a1 `(brit ,__ ,__ ,__ red))
(set! a2 `(swede dog ,__ ,__ ,__ ))
(set! a3 `(dane ,__ ,__ tea ,__ ))
(set! a4a `(,__ ,__ ,__ ,__ green))
(set! a4b `(,__ ,__ ,__ ,__ white))
(set! a5 `(,__ ,__ ,__ cofee green))
(set! a6 `(,__ bird pallmall ,__ ,__))
(set! a7 `(,__ ,__ dunhill ,__ yellow))
(set! a8a `(,__ ,__ dunhill ,__ ,__))
(set! a8b `(,__ horse ,__ ,__ ,__))
(set! a9 `(,__ ,__ ,__ milk ,__))
(set! a10a `(,__ ,__ marlboro ,__ ,__))
(set! a10b `(,__ cat ,__ ,__ ,__))
(set! a11a `(,__ ,__ marlboro ,__ ,__))
(set! a11b `(,__ ,__ ,__ water ,__))
(set! a12 `(,__ ,__ winfield beer ,__))
(set! a13 `(german ,__ rothmans ,__ ,__))
(set! a14a `(norwegian ,__ ,__ ,__ ,__))
(set! a14b `(,__ ,__ ,__ ,__ blue))
(set! a15 `(,__ fish ,__ ,__ ,__)))
(<and>
(<=> h ,`((norwegian ,__ ,__ ,__ ,__) ,__ (,__ ,__ ,__ milk ,__) ,__ ,__))
(memb `(brit ,__ ,__ ,__ red) h)
(memb `(swede dog ,__ ,__ ,__ ) h)
(memb `(dane ,__ ,__ tea ,__ ) h)
(on-right `(,__ ,__ ,__ ,__ green) `(,__ ,__ ,__ ,__ white) h)
(memb `(,__ ,__ ,__ cofee green) h)
(memb `(,__ bird pallmall ,__ ,__) h)
(memb `(,__ ,__ dunhill ,__ yellow) h)
(next-to `(,__ ,__ dunhill ,__ ,__) `(,__ horse ,__ ,__ ,__) h)
(memb `(,__ ,__ ,__ milk ,__) h)
(next-to `(,__ ,__ marlboro ,__ ,__) `(,__ cat ,__ ,__ ,__) h)
(next-to `(,__ ,__ marlboro ,__ ,__) `(,__ ,__ ,__ water ,__) h)
(memb `(,__ ,__ winfield beer ,__) h)
(memb `(german ,__ rothmans ,__ ,__) h)
(next-to `(norwegian ,__ ,__ ,__ ,__) `(,__ ,__ ,__ ,__ blue) h)
(memb `(,__ fish ,__ ,__ ,__) h)
(memb a1 h)
(memb a2 h)
(memb a3 h)
(on-right a4a a4b h)
(memb a5 h)
(memb a6 h)
(memb a7 h)
(next-to a8a a8b h)
(memb a9 h)
(next-to a10a a10b h)
(next-to a11a a11b h)
(memb a12 h)
(memb a13 h)
(next-to a14a a14b h)
(memb a15 h)
))
......
(define-module (logic guile-log examples queens)
#:use-module (logic guile-log)
#:use-module (logic guile-log umatch)
#:use-module (srfi srfi-11)
#:export (run))
(<define> (queens N Qs)
(<var> (Ns)
(<and> (range-list 1 N Ns)
(queens3 Ns '() Qs))))
(<define> (queens3 UnplacedQs SafeQs Qs)
(<match> () (UnplacedQs)
( _ (<var> (Q UnplacedQs1)
(<and> (selectq Q UnplacedQs UnplacedQs1)
(<not> (attack Q SafeQs))
(queens3 UnplacedQs1 (<cons> Q SafeQs) Qs))))
('() (<=> SafeQs Qs))
( _ <fail>)))
(<define> (attack X Xs) (attack3 X 1 Xs))
(define (attack3 s p cc x n v)
(let-values (((ca cd s) (gp-fpair!? v s)))
(if s
(let ((x (gp->scm x s))
(y (gp->scm ca s)))
(let ((f (gp-newframe s)))
(if (or (eq? x (+ y n)) (eq? x (- y n)))
(cc f (lambda ()
(gp-unwind f)
(attack3 f p cc x (+ n 1) cd)))
(attack3 f p cc x (+ n 1) cd))))
(p))))
#;
(<define> (attack3 X N V)
(<match> () (V)
((Y . _) (<when> (or (eq? (<scm> X) (+ (<scm> Y) N))
(eq? (<scm> X) (- (<scm> Y) N)))))
((_ . Y) (attack3 X (+ N 1) Y))
(_ <fail>)))
(<define> (range-list M N U)
(<match> () (U)
((,M) (<when> (>= M N) <cut>))
((,M . L) (range-list (+ M 1) N L))
(_ <fail>)))
(<define> (selectq X U Xs)
(<match> () (U Xs)
((,X . ,Xs) _ <cc>)
(( Y . Ys) ( Y . Zs) (selectq X Ys Zs))
(_ _ <fail>)))
(define (f)
(<run> * (Q)
(queens 10 Q)))
(define (run n)
(if (= n 0)
#t
(begin
(f)
(run (- n 1)))))
......@@ -2,9 +2,9 @@ LIBS = `pkg-config --libs guile-2.0`
CFLAGS = `pkg-config --cflags guile-2.0`
libguile-unify.so : unify.h unify.c unify-undo-redo.c logical.c unify.x state.c functional-tree.c
gcc $(LIBS) $(CFLAGS) -shared -o libguile-unify.so -fPIC unify.c
libguile-unify.so : unify.h unify.c unify-undo-redo.c logical.c unify.x state.c functional-tree.c util.c
gcc $(LIBS) $(CFLAGS) -O3 -shared -o libguile-unify.so -fPIC unify.c
unify.x : unify.h unify.c unify-undo-redo.c logical.c state.c functional-tree.c
unify.x : unify.h unify.c unify-undo-redo.c logical.c state.c functional-tree.c util.c
guile-snarf -o unify.x $(CFLAGS) unify.c
......@@ -11,17 +11,23 @@ struct gp_stack
int _logical_;
int gp_ncs;
SCM *gp_cons_stack;
int gp_nc;
SCM *gp_cstack;
int gp_ns;
SCM *gp_stack;
SCM* gp_cs;
SCM* gp_si;
SCM* gp_ci;
SCM *gp_nnc;
SCM *gp_nns;
SCM *gp_nncs;
SCM *gp_ci_h;
SCM *gp_ci_q;
};
......@@ -39,8 +45,10 @@ static inline struct gp_stack *get_gp(SCM s)
return (struct gp_stack *)0;
}
static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, struct gp_stack **ggp)
static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, struct gp_stack **ggp)
{
int i,ii;
*ggp =
(struct gp_stack *) scm_gc_malloc_pointerless(sizeof(struct gp_stack),"struct gp_stack");
......@@ -60,14 +68,24 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, struct gp_
scm_gc_protect_object(GP_UNREF(gp->gp_stack));
gp->gp_nc = nc;
gp->gp_ns = ns;
gp->gp_cons_stack =
(SCM *) scm_gc_malloc(sizeof(SCM) * ncs,"gp->gp_stack");
if(!gp->gp_cons_stack) goto error4;
scm_gc_protect_object(GP_UNREF(gp->gp_cons_stack));
gp->gp_nc = nc;
gp->gp_ns = ns;
gp->gp_ncs = ncs;
gp->gp_si = gp->gp_stack;
gp->gp_ci = gp->gp_cstack;
gp->gp_cs = gp->gp_cons_stack;
gp->gp_nns = gp->gp_stack + gp->gp_ns - 10;
gp->gp_nnc = gp->gp_cstack + gp->gp_nc - 10;
gp->gp_nns = gp->gp_stack + gp->gp_ns - 10;
gp->gp_nnc = gp->gp_cstack + gp->gp_nc - 10;
gp->gp_nncs = gp->gp_cons_stack + gp->gp_ncs - 10;
gp->_logical_ = 0;
gp->gp_ci_h = (SCM *) 0;
......@@ -77,11 +95,25 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, struct gp_
SCM ret;
SCM_NEWSMOB(ret, gp_stack_type, (void*)0);
GP_GETREF(ret)[1] = GP_UNREF((SCM *) gp);
for(i = 0; i < gp->gp_ncs; i++)
{
gp->gp_cs[i] = SCM_BOOL_F;
}
for(i = 0; i < gp->gp_ncs && i < 10000; i++)
{
gp->gp_cs[i] = scm_cons(SCM_BOOL_F,SCM_BOOL_F);
}
scm_gc_unprotect_object(GP_UNREF(gp->gp_cstack));
scm_gc_unprotect_object(GP_UNREF(gp->gp_stack));
scm_gc_unprotect_object(GP_UNREF(gp->gp_cons_stack));
return GP_GETREF(ret);
error4:
scm_gc_unprotect_object(GP_UNREF(gp->gp_stack));
error3:
scm_gc_unprotect_object(GP_UNREF(gp->gp_cstack));
......@@ -96,18 +128,26 @@ static SCM gp_stack_mark(SCM obj)
struct gp_stack *gp = (struct gp_stack *) SCM_SMOB_DATA(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));
for(i=0;i < gp->gp_ci - gp->gp_cstack; i++)
{
scm_gc_mark(gp->gp_cstack[i]);
}
for(i=0;i < gp->gp_si - gp->gp_stack; i+=2)
for(i=0;i < gp->gp_nncs - gp->gp_cons_stack; i++)
{
scm_gc_mark(gp->gp_cons_stack[i]);
}
for(i=0;i < gp->gp_si - gp->gp_stack; i++)
{
if(GP_VAL(&(gp->gp_stack[i])))
scm_gc_mark(gp->gp_stack[i+1]);
// if(GP_VAL(&(gp->gp_stack[i])))
scm_gc_mark(gp->gp_stack[i+1]);
}
return SCM_BOOL_T;
......@@ -126,3 +166,67 @@ static void gp_module_stack_init()
scm_set_smob_mark(gp_stack_type, gp_stack_mark);
scm_set_smob_print(gp_stack_type,gp_stack_printer);
}
static inline void gp_alloc_cons(struct gp_stack *gp, int n)
{
int i;
if(!(gp->gp_cs + n <= gp->gp_nncs)) goto error;
if(!SCM_CONSP(gp->gp_cs[n-1])) goto allocate;
return;
allocate:
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);
}
return;
error:
scm_misc_error("gp_alloc_cons","cons stack is full",SCM_EOL);
return;
}
static inline SCM gpa_cons(SCM x, SCM y, struct gp_stack *gp)
{
SCM r = gp->gp_cs[0];
gp->gp_cs++;
SCM_SETCAR(r,x);
SCM_SETCDR(r,y);
return r;
}
static inline SCM* gp_alloc_data(int n, struct gp_stack *gp)
{
int i;
if(!(gp->gp_si + n <= gp->gp_nns)) goto error;
SCM * ret = gp->gp_si;
gp->gp_si += n;
return ret;
error:
scm_misc_error("gp_alloc_data","data stack is full",SCM_EOL);
return;
}
static inline SCM gp_make_vector(int n, struct gp_stack *gp)
{
SCM *vec = gp_alloc_data(n + SCM_I_VECTOR_HEADER_SIZE,gp);
((scm_t_bits *) vec)[0] = (n << 8) | scm_tc7_vector;
((scm_t_bits *) vec)[1] = 0;
return PTR2SCM(vec);
}
static inline SCM gp_make_closure(int n, SCM **closure, SCM s)
{
struct gp_stack *gp = get_gp(s);
SCM vec = gp_make_vector(n,gp);
*closure = SCM_I_VECTOR_WELTS(vec);
gp_alloc_cons(gp,1);
return gpa_cons(closure_tag, vec, gp);
}
This diff is collapsed.
......@@ -27,6 +27,8 @@ scm_t_bits gp_type;
SCM gp_wind;
SCM gp_setup;
SCM closure_tag;
#define gp_format0(str) \
scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
......@@ -424,9 +426,16 @@ static inline SCM * gp_lookup2(SCM *id, SCM s)
return id;
}
/*
This routine stores information about stacks on the
control stack and returns a structure representing the
computational state. This routine makes sure to allocate
datstructures before storing the state in them meaning that
after an unwind the unwind information can be reused.
*/
static inline SCM gp_newframe(SCM s)
{
SCM sss = s;
SCM sss = s,ret;
s = SCM_CDR(s);
struct gp_stack *gp = get_gp(sss);
......@@ -434,24 +443,45 @@ static inline SCM gp_newframe(SCM s)
if(SCM_CONSP(s))
{
SCM fr = SCM_CAR(s);
SCM *ci = NUM2PTR(SCM_CAR(fr));
SCM *si = NUM2PTR(SCM_CDR(fr));
SCM *ci = NUM2PTR(fr);
SCM *si = NUM2PTR(ci[-2]);
SCM *cs = NUM2PTR(ci[-1]);
if((gp->gp_ci == ci || (ci == gp->gp_ci_h && gp->gp_ci == gp->gp_ci_q))
&& si == gp->gp_si)
&& si == gp->gp_si && cs == gp->gp_cs)
return sss;
{
gp->gp_ci_h = (SCM *) 0;
SCM cons = scm_cons(PTR2NUM(gp->gp_ci),PTR2NUM(gp->gp_si));
gp->gp_ci += 2;
SCM cons = PTR2NUM(gp->gp_ci);
SCM ss = SCM_CDR(s);
ss = SCM_CONSP(ss) ? ss : SCM_EOL;
return scm_cons(SCM_CAR(sss),scm_cons(cons,ss));
gp_alloc_cons(gp,2);
ret = gpa_cons(SCM_CAR(sss),gpa_cons(cons,ss,gp),gp);
gp->gp_ci[-2] = PTR2NUM(gp->gp_si);
gp->gp_ci[-1] = PTR2NUM(gp->gp_cs);
return ret;
}
}
gp->gp_ci_h = (SCM *) 0;
SCM cons = scm_cons(PTR2NUM(gp->gp_ci),PTR2NUM(gp->gp_si));
gp->gp_ci += 2;
SCM cons = PTR2NUM(gp->gp_ci);
SCM ss = SCM_EOL;
return scm_cons(SCM_CAR(sss),scm_cons(cons,ss));
gp_alloc_cons(gp,2);
ret = gpa_cons(SCM_CAR(sss),gpa_cons(cons,ss,gp),gp);
gp->gp_ci[-2] = PTR2NUM(gp->gp_si);
gp->gp_ci[-1] = PTR2NUM(gp->gp_cs);
return ret;
}
......@@ -1032,7 +1062,7 @@ SCM_DEFINE(gp_atomicp,"gp-atomic?",2,0,0,(SCM x, SCM s),
}
#undef FUNC_NAME
static inline void gp_unwind0(SCM *ci, SCM *sim, struct gp_stack *gp);
static inline void gp_unwind0(SCM *ci, SCM *sim, SCM *cs, struct gp_stack *gp);
SCM_DEFINE(gp_clear, "gp-clear", 1, 0, 0, (SCM s),
"resets the unifyier stacks")
......@@ -1042,7 +1072,7 @@ SCM_DEFINE(gp_clear, "gp-clear", 1, 0, 0, (SCM s),
gp_debug0("clear\n");
gp->_logical_ = 0;
gp->gp_ci_h = (SCM *) 0;
gp_unwind0(gp->gp_cstack + 1,gp->gp_stack + 2, gp);
gp_unwind0(gp->gp_cstack + 1,gp->gp_stack + 2, gp->gp_cons_stack, gp);
return SCM_BOOL_T;
}
#undef FUNC_NAME
......@@ -1528,8 +1558,8 @@ SCM_DEFINE(gp_dynwind, "gp-dynwind", 3, 0, 0, (SCM in, SCM out, SCM s),
}
#undef FUNC_NAME
SCM_DEFINE(gp_make_stack, "gp-make-stack", 4, 0, 0,
(SCM id, SCM thread_id, SCM nc, SCM ns),
SCM_DEFINE(gp_make_stack, "gp-make-stack", 5, 0, 0,
(SCM id, SCM thread_id, SCM nc, SCM ns, SCM ncs),
"make logical stack for id, thread_id, and sizes nc, ns")
#define FUNC_NAME s_gp_make_stack
{
......@@ -1539,21 +1569,24 @@ SCM_DEFINE(gp_make_stack, "gp-make-stack", 4, 0, 0,
if(!SCM_I_INUMP(thread_id)) goto error2;
if(!SCM_I_INUMP(nc)) goto error2;
if(!SCM_I_INUMP(ns)) goto error2;
if(!SCM_I_INUMP(ncs)) goto error2;
int i_id = SCM_I_INUM(id);
int i_thread_id = SCM_I_INUM(thread_id);
int i_nc = SCM_I_INUM(nc);
int i_ns = SCM_I_INUM(ns);
int i_ncs = SCM_I_INUM(ncs);
SCM* sgp = make_gp_stack(i_id,i_thread_id, i_nc, i_ns, &gp);
SCM* sgp = make_gp_stack(i_id,i_thread_id, i_nc, i_ns, i_ncs, &gp);
if(!sgp) goto error;
gp->gp_ci[0] = PTR2NUM(gp->gp_si);
gp->gp_ci[1] = PTR2NUM(gp->gp_cs);
gp->gp_ci += 2;
s = scm_cons(GP_UNREF(sgp),
scm_cons(scm_cons(PTR2NUM(gp->gp_ci),
PTR2NUM(gp->gp_si))
,SCM_EOL));
scm_cons(PTR2NUM(gp->gp_ci),SCM_EOL));
SCM v = GP_IT(gp_mk_var(s));
......@@ -1584,6 +1617,8 @@ SCM_DEFINE(gp_copy,"gp-copy",1,0,0, (SCM x),
#undef FUNC_NAME
*/