paralell improvements

parent df8719d4
...@@ -10,29 +10,29 @@ ...@@ -10,29 +10,29 @@
(<case-lambda> (<case-lambda>
(() <fail>) (() <fail>)
((x) (goal-eval x)) ((x) (goal-eval x))
((x y) ((fail x y)
(<pand> fail (<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x)) (p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y)))) (p2 s2 (gp-make-engine 100) (goal-eval y))))
((x y u) ((fail x y u)
(<pand> fail (<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x)) (p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y)) (p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u)))) (p3 s3 (gp-make-engine 100) (goal-eval u))))
((x y u v) ((fail x y u v)
(<pand> fail (<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (goal-eval x)) (p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y)) (p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u)) (p3 s3 (gp-make-engine 100) (goal-eval u))
(p4 s4 (gp-make-engine 100) (goal-eval v)))) (p4 s4 (gp-make-engine 100) (goal-eval v))))
(l ((fail . l)
(let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2))) (let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2)))
(if (= n 0) (if (= n 0)
(cons l u) (cons l u)
(lp (cdr l) (cons (car l) u) (- n 1)))))) (lp (cdr l) (cons (car l) u) (- n 1))))))
(<pand> fail (<pand> (</.> (goal-eval fail))
(p1 s1 (gp-make-engine 100) (<apply> paralell (car l-u))) (p1 s1 (gp-make-engine 100) (<apply> paralell fail (car l-u)))
(p3 s3 (gp-make-engine 100) (<apply> paralell (cdr l-u)))))))) (p3 s3 (gp-make-engine 100) (<apply> paralell fail (cdr l-u))))))))
(define pzip (define pzip
(<case-lambda> (<case-lambda>
......
...@@ -19,65 +19,90 @@ ...@@ -19,65 +19,90 @@
(<define> (check-bindings check key.vals) (<define> (check-bindings check key.vals)
(<recur> lp ((l key.vals)) (<recur> lp ((l key.vals))
(if (pair? l) (if (pair? l)
(let ((x (car l)) (let* ((x (car l))
(k (car x)) (k (car x))
(v (cdr x))) (v (cdr x)))
(<if> (<=> k v) (<if> (<=> k v)
(lp (cdr l)) (lp (cdr l))
(check)))))) (check)))
<cc>)))
(<define-guile-log-rule> (<pand> check (v se engine code ...) ...) (define level 0)
(define next-level 0)
(<define-guile-log-rule> (<pand> check (v l se engine code ...) ...)
(<var> (v ...) (<var> (v ...)
(<let> ((data (list v ...)) (let ((i level) (n next-level) (l level) ...)
(frame (<newframe>)) (<dynwind>
(se #f) ... (</.> (<cc>))
(p P) (</.>
(cc CC)) (<code> (set! level i))
(<let*> ((s frame) (<code> (set! next-level n))))
(ccc (lambda (ss pp) (<let> ((data (list v ...))
(gp-combine-engines data) (frame (<newframe>))
(cc (gp-combine-state (se #f) ...
s (list se ...)) (p P)
p)))) (cc CC))
(<with-s> s (<let*> ((s frame)
(<pit> s p ccc (ccc (lambda (ss pp)
(<with-fail> p (gp-combine-engines data)
(<with-s> (gp-push-engine frame engine) (cc (gp-combine-state
(<code> (gp-combine-push data)) s (list se ...))
(<code> (gp-var-set v (gp-peek-engine) S)) p))))
code ... (<with-s> s
(<code> (set! se S)) (<pit> s p ccc
(<code> (gp-pop-engine)))))) (<with-fail> p
... (<with-s> (gp-push-engine frame engine)
(<code> (gp-combine-push data))
(<code> (gp-combine-engines data)) (<code> (gp-var-set v (gp-peek-engine) S))
(let ((s.bindings (gp-combine-state s (list se ...)))) (<dynwind>
(check-bindings check (cdr s.bindings)) (</.>
(<with-s> (car s.bindings) (<code> (set! level (+ 1 n)))
(<with-fail> p <cc>)))))) (<code> (set! next-level (+ 1 n))))
(</.> <cc>))
code ...
(<define-guile-log-rule> (<pzip> check (v se p code ...) ...) (<dynwind>
(</.> (<code> (set! l next-level)))
(</.> (<code> (set! next-level l))))
(<code> (set! se S))
(<code> (gp-pop-engine))))))
...
(<dynwind>
(</.>
(<code> (set! next-level (max l ...)))
(<code> (set! level i)))
(</.> <cc>))
(<code> (gp-combine-engines data))
(let ((s.bindings (gp-combine-state s (list se ...))))
(check-bindings check (cdr s.bindings))
(<with-s> (car s.bindings)
(<with-fail> p <cc>))))))))
(<define-guile-log-rule> (<pzip> check (v ll se p code ...) ...)
(<var> (p ...) (<var> (p ...)
(<let*> ((l '()) (<letrec> ((l '())
(pwork (pwork
(lambda (q) (lambda (q)
(if (pair? l) (if (pair? l)
(let ((pp (car l))) (let ((pp (car l)))
(set! l (cdr l)) (set! l (cdr l))
(pp)) (pp))
(q)))) (q))))
(ccwork (ccwork
(lambda (s pp cc) (lambda (s pp cc)
(pwork (lambda () (cc s pp)))))) (pwork (lambda () (cc s pp)))))
(<pand> (</.> <fail>) (pend
(v se (gp-make-engine 100) code ... (<set> p P)) ...) (lambda ()
(set! l (list (<lookup> p) ...))
(pwork #f))))
(<pand> (check pend)
(v ll se (gp-make-engine (+ next-level 1) 100)
code ... (<set> p P)) ...)
(ccwork) (ccwork)
(let ((pend (<with-fail> pend <cc>))))
(lambda ()
(set! l (list (<lookup> p) ...))
(pwork #f))))
(<with-fail> pend <cc>)))))
(<define> (g x n) (<define> (g x n)
...@@ -94,24 +119,26 @@ ...@@ -94,24 +119,26 @@
(if (< i n) (if (< i n)
(<or> (<=> x i) (lp (+ i 1)))))) (<or> (<=> x i) (lp (+ i 1))))))
(<define> (idfail fail-all) (fail-all))
(<define> (test1 x y) (<define> (test1 x y)
(<pzip> (v1 s1 p1 (f x 3)) (v2 s2 p2 (f y 3)))) (<pzip> idfail (v1 l1 s1 p1 (f x 3)) (v2 l2 s2 p2 (f y 3))))
(<define> (test2 x y) (<define> (test2 x y)
(<pzip> (v1 s1 p1 (<member> 1 x)) (v2 s2 p2 (<member> 2 y)))) (<pzip> idfail (v1 l1 s1 p1 (<member> 1 x)) (v2 l2 s2 p2 (<member> 2 y))))
(<define> (test3 x y) (<define> (test3 x y)
(<logical++>) (<pzip> idfail (v1 l1 s1 p1 (g x 10)) (v2 l2 s2 p2 (g y 10))))
(<pzip> (v1 s1 p1 (g x 10)) (v2 s2 p2 (g y 10)))
(<logical-->))
(<define> (test4 x y z w) (<define> (test4 x y z w)
(<logical++>) (<pzip> idfail (v1 l1 s1 p1 (test3 x y)) (v2 l2 s2 p2 (test3 z w))))
(<pzip> (v1 s1 p1 (test3 x y)) (v2 s2 p2 (test3 z w)))
(<logical-->))
...@@ -33,46 +33,6 @@ int is_gc_locked(); ...@@ -33,46 +33,6 @@ int is_gc_locked();
#define GP_STACKP(scm) (SCM_NIMP(scm) && SCM_SMOB_PREDICATE(gp_stack_type,scm)) #define GP_STACKP(scm) (SCM_NIMP(scm) && SCM_SMOB_PREDICATE(gp_stack_type,scm))
struct gp_stack
{
scm_t_bits dynstack_length;
SCM dynstack;
SCM rguards;
SCM handlers;
int id;
int thread_id;
int _logical_;
int _thread_safe_;
int gp_ncs;
SCM *gp_cons_stack;
int gp_nc;
SCM *gp_cstack;
int gp_ns;
SCM *gp_stack;
int gp_nfr;
SCM *gp_frstack;
SCM *gp_cs;
SCM *gp_si;
SCM *gp_ci;
SCM *gp_fr;
SCM *gp_nnc;
SCM *gp_nns;
SCM *gp_nncs;
SCM *gp_nnfr;
int n;
int nrem;
};
#define GP_FRAMESIZE 6 #define GP_FRAMESIZE 6
#define CHOICE_BIT (1UL<<60) #define CHOICE_BIT (1UL<<60)
#define GP_GET_HANDLERS(fr) ((fr)[-6]) #define GP_GET_HANDLERS(fr) ((fr)[-6])
...@@ -181,7 +141,8 @@ inline ulong GP_GET_CONS(SCM *fr) ...@@ -181,7 +141,8 @@ inline ulong GP_GET_CONS(SCM *fr)
#define GP_TEST_STACK if(gp->gp_si > gp->gp_nns) scm_out_of_range(NULL, SCM_I_MAKINUM(gp->gp_ns)) #define GP_TEST_STACK if(gp->gp_si > gp->gp_nns) scm_out_of_range(NULL, SCM_I_MAKINUM(gp->gp_ns))
#define GET_GP(scm) ((struct gp_stack *) GP_GETREF(scm)[1]) #define GET_GP(scm) ((struct gp_stack *) GP_GETREF(scm)[1])
static inline struct gp_stack *get_gp()
inline struct gp_stack *get_gp()
{ {
SCM gp = scm_fluid_ref(gp_current_stack); SCM gp = scm_fluid_ref(gp_current_stack);
if(GP_STACKP(gp)) if(GP_STACKP(gp))
...@@ -192,13 +153,22 @@ static inline struct gp_stack *get_gp() ...@@ -192,13 +153,22 @@ static inline struct gp_stack *get_gp()
return (struct gp_stack *)0; return (struct gp_stack *)0;
} }
static inline void init_gp_var(SCM *cand) inline struct gp_stack *maybe_get_gp()
{
SCM gp = scm_fluid_ref(gp_current_stack);
if(GP_STACKP(gp))
return (struct gp_stack *) GET_GP(gp);
return (struct gp_stack *) 0;
}
inline void init_gp_var(SCM *cand)
{ {
cand[0] = SCM_PACK(GP_MK_FRAME_UNBD(gp_type)); cand[0] = SCM_PACK(GP_MK_FRAME_UNBD(gp_type));
cand[1] = SCM_UNBOUND; cand[1] = SCM_UNBOUND;
} }
static inline SCM *get_gp_var(struct gp_stack *gp) inline SCM *get_gp_var(struct gp_stack *gp)
{ {
SCM cand; SCM cand;
GP_TEST_STACK; GP_TEST_STACK;
...@@ -358,6 +328,7 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i ...@@ -358,6 +328,7 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i
gp->thread_id = nthread; gp->thread_id = nthread;
gp->nrem = 0; gp->nrem = 0;
gp->n = 0; gp->n = 0;
gp->id = id;
SCM ret; SCM ret;
...@@ -374,7 +345,7 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i ...@@ -374,7 +345,7 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i
for(i = 0; i < gp->gp_ncs && i < 10000; i++) for(i = 0; i < gp->gp_ncs && i < 10000; i++)
{ {
gp->gp_cs[i] = gp_make_cons(gp); gp->gp_cs[i] = gp_make_cons_id(id);
} }
...@@ -385,9 +356,8 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i ...@@ -385,9 +356,8 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, i
for(i = 0; i < gp->gp_ns && i < 10000; i++) for(i = 0; i < gp->gp_ns && i < 10000; i++)
{ {
SCM x = gp_make_variable(gp); SCM x = gp_make_variable_id(id);
gp->gp_si[i] = x; gp->gp_si[i] = x;
} }
scm_gc_unprotect_object(GP_UNREF(gp->gp_cstack)); scm_gc_unprotect_object(GP_UNREF(gp->gp_cstack));
...@@ -1252,15 +1222,6 @@ static void gp_module_stack_init() ...@@ -1252,15 +1222,6 @@ static void gp_module_stack_init()
void gp_init_stacks() void gp_init_stacks()
{ {
gp_stacks = scm_make_fluid_with_default(SCM_EOL); gp_stacks = scm_make_fluid_with_default(SCM_EOL);
gp_nil_fr = gp_make_variable();
gp_nil_ci = gp_make_variable();
scm_t_bits tag = GP_MK_FRAME_EQ(gp_type);
SET_FRAME(tag);
GP_GETREF(gp_nil_fr)[0] = SCM_PACK(GP_MK_FRAME_EQ(gp_type));
GP_GETREF(gp_nil_ci)[0] = SCM_PACK(tag);
GP_GETREF(gp_nil_fr)[1] = scm_from_int(GP_FRAMESIZE);
GP_GETREF(gp_nil_ci)[1] = scm_from_int(0);
} }
...@@ -1600,7 +1561,6 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e), ...@@ -1600,7 +1561,6 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e),
int logical = gp->_logical_; int logical = gp->_logical_;
int level = gp->id;
SCM rguards = gp->rguards; SCM rguards = gp->rguards;
gp_engine_path = scm_cons(x , gp_engine_path); gp_engine_path = scm_cons(x , gp_engine_path);
...@@ -1612,7 +1572,6 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e), ...@@ -1612,7 +1572,6 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e),
gp = get_gp(); gp = get_gp();
gp_clear(SCM_BOOL_F); gp_clear(SCM_BOOL_F);
gp->_logical_ = logical; gp->_logical_ = logical;
gp->id = level + 1;
gp->rguards = rguards; gp->rguards = rguards;
if(gp->id > 0) if(gp->id > 0)
...@@ -1761,13 +1720,13 @@ SCM folder(SCM key, SCM val, SCM seed, SCM data) ...@@ -1761,13 +1720,13 @@ SCM folder(SCM key, SCM val, SCM seed, SCM data)
SCM val2 = scm_hash_ref(key, variable_bindings, SCM_BOOL_F); SCM val2 = scm_hash_ref(key, variable_bindings, SCM_BOOL_F);
if(scm_is_true(val)) if(scm_is_true(val2))
{ {
return seed; return seed;
} }
else else
{ {
SCM val3 = scm_hash_ref(key, all_variable_bindinges, SCM_BOOL_F); SCM val3 = scm_hash_ref(key, all_variable_bindings, SCM_BOOL_F);
if(scm_is_true(val3)) if(scm_is_true(val3))
{ {
SCM val4 = scm_hash_ref(key, variable_bindings_found, SCM_BOOL_F); SCM val4 = scm_hash_ref(key, variable_bindings_found, SCM_BOOL_F);
...@@ -1777,14 +1736,15 @@ SCM folder(SCM key, SCM val, SCM seed, SCM data) ...@@ -1777,14 +1736,15 @@ SCM folder(SCM key, SCM val, SCM seed, SCM data)
} }
else else
{ {
scm_hash_set_x(key, SCM_BOOL_T, variables_bindings_found); scm_hash_set_x(key, SCM_BOOL_T, variable_bindings_found);
return scm_cons(scm_cons(key,val), return scm_cons(scm_cons(key,val),
scm_cons(scm_cons(key, val3), seed)); scm_cons(scm_cons(key, val3), seed));
} }
} }
else else
{ {
scm_hash_set_X(key, val, all_variable_bindings); scm_hash_set_x(key, val, all_variable_bindings);
return seed;
} }
} }
} }
...@@ -1802,7 +1762,6 @@ SCM level0(SCM data, SCM l, SCM ret) ...@@ -1802,7 +1762,6 @@ SCM level0(SCM data, SCM l, SCM ret)
SCM level1(SCM data, SCM ll, SCM ret) SCM level1(SCM data, SCM ll, SCM ret)
{ {
SCM ll = SCM_CAR(l);
SCM l0 = SCM_CAR(data); SCM l0 = SCM_CAR(data);
for(;SCM_CONSP(ll);ll=SCM_CDR(ll)) for(;SCM_CONSP(ll);ll=SCM_CDR(ll))
{ {
...@@ -1811,10 +1770,10 @@ SCM level1(SCM data, SCM ll, SCM ret) ...@@ -1811,10 +1770,10 @@ SCM level1(SCM data, SCM ll, SCM ret)
{ {
SCM x = SCM_CAR(ll); SCM x = SCM_CAR(ll);
if(vlist_p(x)) if(scm_vlist_p(x))
ret = vhash_fold_all_exp(data, folder, ret, SCM_CAR(l)); ret = vhash_fold_all_exp(data, folder, ret, x);
if(SCM_I_VECTOR_P(x)) if(SCM_I_IS_VECTOR(x))
ret = level0(data, ret); ret = level0(data, scm_c_vector_ref(ret, 0), ret);
if(SCM_CONSP(x)) if(SCM_CONSP(x))
ret = folder(SCM_CAR(x), SCM_CDR(x), ret, data); ret = folder(SCM_CAR(x), SCM_CDR(x), ret, data);
} }
...@@ -1826,13 +1785,13 @@ SCM level1(SCM data, SCM ll, SCM ret) ...@@ -1826,13 +1785,13 @@ SCM level1(SCM data, SCM ll, SCM ret)
SCM get_all_conflicting_bindings(SCM l, SCM data) SCM get_all_conflicting_bindings(SCM l, SCM data)
{ {
variable_bindings_found = scm_make_hash_table(); variable_bindings_found = scm_c_make_hash_table(100);
all_variable_bindings = scm_make_hash_table(); all_variable_bindings = scm_c_make_hash_table(100);
ret = SCM_EOL; SCM ret = SCM_EOL;
for(;SCM_CONSP(l);l=SCM_CDR(l)) for(;SCM_CONSP(l);l=SCM_CDR(l))
{ {
variable_bindings = scm_make_hash_table(); variable_bindings = scm_c_make_hash_table(100);
ret = level1(data, SCM_CAR(l), ret); ret = level1(data, SCM_CAR(l), ret);
} }
...@@ -1861,9 +1820,9 @@ SCM_DEFINE(gp_combine_state, "gp-combine-state", 2, 0, 0, (SCM s, SCM l), ...@@ -1861,9 +1820,9 @@ SCM_DEFINE(gp_combine_state, "gp-combine-state", 2, 0, 0, (SCM s, SCM l),
} }
SCM data = scm_cons(l0, scm_from_int(gp->id)); SCM datah = scm_cons(l0, scm_from_int(gp->id));
SCM ret = get_all_conflicting_bindings(ll,data); SCM ret = get_all_conflicting_bindings(ll,datah);
SCM sout; SCM sout;
......
...@@ -1016,8 +1016,6 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -1016,8 +1016,6 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
SCM_EOL); SCM_EOL);
} }
SCM a = scm_reverse(l);
while(nb > na) while(nb > na)
{ {
b = scm_cons(SCM_CAR(path), b); b = scm_cons(SCM_CAR(path), b);
......
...@@ -23,6 +23,8 @@ ...@@ -23,6 +23,8 @@
#include "libguile/smob.h" #include "libguile/smob.h"
#define VECTOR_HEADER_SIZE 2 #define VECTOR_HEADER_SIZE 2
static inline struct gp_stack * get_gp();
SCM* gp_lookup_l_1 (SCM *x, SCM l); SCM* gp_lookup_l_1 (SCM *x, SCM l);
SCM* gp_lookup_ll_1(SCM *x, SCM *l); SCM* gp_lookup_ll_1(SCM *x, SCM *l);
...@@ -214,16 +216,16 @@ scm_t_bits gp_smob_t; ...@@ -214,16 +216,16 @@ scm_t_bits gp_smob_t;
#define GPID B(0xffb000000) #define GPID B(0xffb000000)
#define GPHA B(0xffffff000000000) #define GPHA B(0xffffff000000000)
#define GPRENEW(x) ((x) & ~GPHA) #define GPRENEW(x) ((x) & ~GPHA)
#define GP_MARK(x) (x & GPI_GL_M) #define GP_MARK(x) (x & GPI_GL_M)
#define GP_SET_MARK(x) (x | GPI_GL_M) #define GP_SET_MARK(x) (x | GPI_GL_M)
#define GP_CLEAR_MARK(x) (x & (~GPI_GL_M)) #define GP_CLEAR_MARK(x) (x & (~GPI_GL_M))
//#define GP_HASH(x) ((SCM_UNPACK(x) & GPHA) >> H_BITS) //#define GP_HASH(x) ((SCM_UNPACK(x) & GPHA) >> H_BITS)
#define GP_ID(x) ((SCM_UNPACK(x) & GPID) >> N_BITS) #define GP_ID(x) ((SCM_UNPACK(x) & GPID) >> N_BITS)
#define GP_SETID(x,id) (id << N_BITS | x) #define GP_SETID(x,id) (((unsigned long) (id)) << N_BITS | (x))
#define GP_COUNT(X) ((scm_t_bits) ((SCM_UNPACK(X) & GPHA) >> H_BITS)) #define GP_COUNT(X) ((scm_t_bits) ((SCM_UNPACK(X) & GPHA) >> H_BITS))
#define GP_SETCOUNT(X,i) (((SCM_UNPACK(X) & (~GPHA)) \ #define GP_SETCOUNT(X,i) (((SCM_UNPACK(X) & (~GPHA)) \
| ((i) << H_BITS))) | ((i) << H_BITS)))
#define GP_FLAGS(x) ((x)[0]) #define GP_FLAGS(x) ((x)[0])
#define GP_SCM(x) ((x)[1]) #define GP_SCM(x) ((x)[1])
...@@ -464,7 +466,7 @@ inline SCM gp_make_s(SCM frci, SCM *l) ...@@ -464,7 +466,7 @@ inline SCM gp_make_s(SCM frci, SCM *l)
return scm_cons(frci,ll); return scm_cons(frci,ll);
} }
static inline void gp_store_var_2(SCM *id, int simple, struct gp_stack *gp) inline void gp_store_var_2(SCM *id, int simple, struct gp_stack *gp)
{ {
GP_TEST_CSTACK; GP_TEST_CSTACK;
...@@ -499,23 +501,23 @@ static inline void gp_store_var_2(SCM *id, int simple, struct gp_stack *gp) ...@@ -499,23 +501,23 @@ static inline void gp_store_var_2(SCM *id, int simple, struct gp_stack *gp)
gp->gp_ci += 1; gp->gp_ci += 1;
} }
static inline void mask_on(int stack_nr, SCM *id, SCM flags) inline void mask_on(int stack_nr, SCM *id, SCM flags)
{ {
scm_t_bits nr = ((((scm_t_bits) stack_nr) & 0xffff) << N_BITS); scm_t_bits nr = ((((scm_t_bits) stack_nr) & 0xffff) << N_BITS);
*id = SCM_PACK((SCM_UNPACK(*id) & GP_CLEAN)| SCM_UNPACK(flags) | nr); *id = SCM_PACK((SCM_UNPACK(*id) & GP_CLEAN)| SCM_UNPACK(flags) | nr);
gp_debug2("tag> %x %x\n",SCM_UNPACK(*id),nr); gp_debug2("tag> %x %x\n",SCM_UNPACK(*id),nr);
} }
static inline SCM handle(SCM *id, SCM flags, SCM v, SCM l, struct gp_stack *gp, int k, int bang) inline SCM handle(SCM *id, SCM flags, SCM v, SCM l, struct gp_stack *gp, int k, int bang)
{ {
if(!GP(GP_UNREF(id))) if(!GP(GP_UNREF(id)))
scm_misc_error("unify.c: handle"," got non gp variable to set ~a", scm_misc_error("unify.c: handle"," got non gp variable to set ~a",
scm_list_1(GP_UNREF(id))); scm_list_1(GP_UNREF(id)));
if(gp->_logical_) return logical_add2(GP_UNREF(id),v,l); if(!bang && gp->_logical_) return logical_add2(GP_UNREF(id),v,l);
if(GP_ID(*id) != gp->id && gp->_thread_safe_) if(!bang && GP_ID(*id) != gp->id && gp->_thread_safe_)
{ {
gp_debug0("logical add\n"); gp_debug0("logical add\n");
return logical_add2(GP_UNREF(id),v,l); return logical_add2(GP_UNREF(id),v,l);
...@@ -557,7 +559,7 @@ static inline SCM handle_l(SCM *id, SCM flags, SCM v, SCM *l, struct gp_stack *g ...@@ -557,7 +559,7 @@ static inline SCM handle_l(SCM *id, SCM flags, SCM v, SCM *l, struct gp_stack *g
return SCM_BOOL_T; return SCM_BOOL_T;
} }
static inline void handle_force(SCM *id, SCM flags, SCM v) inline void handle_force(SCM *id, SCM flags, SCM v)
{ {
if(!GP(GP_UNREF(id))) if(!GP(GP_UNREF(id)))
...@@ -608,7 +610,7 @@ inline SCM * set_fr_scm(SCM *fr, struct gp_stack *gp) ...@@ -608,7 +610,7 @@ inline SCM * set_fr_scm(SCM *fr, struct gp_stack *gp)
return f; return f;
} }
static inline SCM gp_set_val(SCM *id, SCM v, SCM l, struct gp_stack *gp) inline SCM gp_set_val(SCM *id, SCM v, SCM l, struct gp_stack *gp)
{ {
SCM flags; SCM flags;
if(GP_IS_EQ(v)) if(GP_IS_EQ(v))
...@@ -4070,7 +4072,7 @@ SCM gp_copy_vector(SCM **vector, int nvar) ...@@ -4070,7 +4072,7 @@ SCM gp_copy_vector(SCM **vector, int nvar)
return newvec; return newvec;
} }
SCM inline gp_cons_simple(SCM x, SCM y, SCM s) static SCM inline gp_cons_simple(SCM x, SCM y, SCM s)
{ {
struct gp_stack *gp = get_gp(); struct gp_stack *gp = get_gp();
SCM *f = get_gp_cons_pure(gp); SCM *f = get_gp_cons_pure(gp);
...@@ -4120,6 +4122,7 @@ typedef struct gp_vm ...@@ -4120,6 +4122,7 @@ typedef struct gp_vm
SCM *fp; /* frame pointer */ SCM *fp; /* frame pointer */
} vp_t; } vp_t;
/*
#include "prolog-vm.c" #include "prolog-vm.c"
...@@ -4164,7 +4167,7 @@ return SCM_UNSPECIFIED; ...@@ -4164,7 +4167,7 @@ return SCM_UNSPECIFIED;
#undef FUNC_NAME #undef FUNC_NAME
MK_CUSTOM_FKN_MODEL(vm__raw,gp_make_vm_model,"gp-make-vm-model"); MK_CUSTOM_FKN_MODEL(vm__raw,gp_make_vm_model,"gp-make-vm-model");