fine tuning the vm for new setup

parent 1aef804d
......@@ -51,6 +51,7 @@ constant = #(nlocals nstack constants code)
(<declare-s> SCM gp_get_state_token ())
(<declare-s> SCM gp_cons_bang ((SCM x) (SCM y) (SCM s)))
(<declare-s> SCM gp_cons_simple ((SCM x) (SCM y) (SCM s)))
(<declare-s> SCM scm_gr_p ((SCM x) (SCM y)))
(<declare-s> SCM scm_less_p ((SCM x) (SCM y)))
(<declare-s> SCM scm_geq_p ((SCM x) (SCM y)))
......@@ -138,7 +139,7 @@ constant = #(nlocals nstack constants code)
(define-syntax-rule (GPPAIR? x s) (TRUE (<call> gp_pair x s)))
(define-syntax-rule (GPCAR x s) (LOOKUP (<call> gp_car x s) s))
(define-syntax-rule (GPCDR x s) (LOOKUP (<call> gp_gp_cdr x s) s))
(define-syntax-rule (GPCONS x y s) (<call> gp_cons_bang x y s))
(define-syntax-rule (GPCONS x y s) (<call> gp_cons_simple x y s))
(define-syntax-rule (1- x) (int->scm (<-> (scm->int x) (<c> 1))))
(define-syntax-rule (GET-TOKEN) (<call> gp_get_state_token))
(define-syntax-rule (SET x y s) (<call> gp_set x y s))
......
......@@ -46,19 +46,19 @@ push_code_without_cut(X,Label,V,L,LL) :-
push_args_args(K,X,V,L,LL,_,_) :- var_p(X),!,K==#f,
push_args(X,V,L,LL).
push_args_args(#f,[X|Y],V,L,LL,_,_) :- !,
push_args_args(#f,[X|Y],V,L,LL,U,U) :- !,
push_args(X,V,L,L1),
push_args_args(Y,V,L1,LL).
push_args_args(#f,Y,V,L1,LL,U,U).
push_args_args(with_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_with_cut(X,Label,V,LW,LLW),
push_args_args(Y,V,L1,LL).
push_args_args(with_cut,Y,V,L1,LL).
push_args_args(without_cut,[X|Y],V,L,LL,LW,LLW) :- !,
L=[['push-closure',Label]|L1],
push_code_without_cut(X,Label,V,L,L1),
push_args_args(Y,V,L1,LL).
push_args_args(without_cut,Y,V,L1,LL).
push_args_args(_,[],V,L,L,LW,LW) :- !.
......
......@@ -164,7 +164,7 @@ compile_goal(Op(\"recur\",Args),Tail,V,[L,LL]) :-
reverse(X,XX),
mg(recur(|U),XX,Impr,0,N),
add_recur(F,A,N),
push_args_args(Xin,V,L,L1),
push_args_args(#f,Xin,V,L,L1,_,_),
touch_A(V),
touch_Q(V),
set_F(V,scm[(gensym \"Rec\")]),
......
......@@ -2,6 +2,7 @@
(use-modules (logic guile-log guile-prolog ops))
(use-modules (logic guile-log guile-prolog vm-compiler))
#;
(define-prolog f1 "
f1(N,I,J,S) :-
I < N ->
......@@ -27,6 +28,7 @@
).
")
#;
(compile-prolog-string "
f3(N,I,J,S) :-
I < N ->
......@@ -38,6 +40,7 @@
S=J
")
#;
(define-prolog memb "
memb(X,L) :-
recur * lp((LL,L)),
......@@ -48,3 +51,4 @@
).
")
......@@ -986,8 +986,7 @@ static inline void gp_unwind(SCM fr)
static inline void gp_unwind_soft(int ncons)
{
struct gp_stack *gp = get_gp();
struct gp_stack *gp = get_gp();
gp->gp_cs -= ncons;
}
......
......@@ -4006,6 +4006,17 @@ SCM gp_copy_vector(SCM **vector, int nvar)
return newvec;
}
SCM inline gp_cons_simple(SCM x, SCM y, SCM s)
{
struct gp_stack *gp = get_gp();
SCM cons = get_gp_cons_pure(gp);
SCM *f = GP_GETREF(cons);
f[1] = x;
f[2] = y;
return cons;
}
#include "prolog-vm.c"
......
This source diff could not be displayed because it is too large. You can view the blob instead.
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