debugging the codeing of ix operations

parent ceae9974
......@@ -27,7 +27,7 @@ constant = #(nlocals nstack constants code)
(auto-defs)
(eval-when (compile eval load)
(define debug #f))
(define debug #t))
(define-syntax DB
(lambda (x)
......@@ -798,6 +798,47 @@ constant = #(nlocals nstack constants code)
(<=> (<ref> variables v2) z))
(NEXT inst-pt)))))
(define-syntax-rule (handle-kc lookup z k
s variables p instructions inst-pt fp sp)
(<if> (<bit-and> k (<c> 1))
(<let> ((s0 (<call> gp_gp_unify_raw
lookup z s)))
(<if> (TRUE s0)
(<=> s s0)
(BACKTRACK
p instructions inst-pt fp sp)))
(<=> lookup z)))
(define-syntax-rule (mk-scm-move-i-op-x op binop schmop
s p variables variables-scm
nvar pinned? cnst session middle nstack
instructions vars inst-pt sp fp)
(<begin>
(LABEL op)
(PRSTACK sp fp)
(<let*> ((SCM x (<ref> inst-pt (<c> 0)))
(ulong v (scm->ulong (<ref> inst-pt (<c> 1))))
(int v1 (<bit-and> v (<c> #xffff)))
(int v2 (q>> (<bit-and> v (<c> #xffff0000)) (<c> 16)))
(int q (q>> v (<c> 32)))
(int k (q>> v (<c> 34))))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(<let*> ((SCM y (UNPACK-VAR-A (<bit-and> q (<c> 1))
0 pinned? variables variables-scm nvar
cnst session middle
(SVAR-REF fp nstack v1)
(<ref> variables v1)))
(SCM z (ARITH binop schmop x y)))
(UNPACK-VAR-A (<bit-and> q (<c> 2))
1 pinned? variables variables-scm nvar
cnst session middle
(handle-kc (SVAR-REF fp nstack v2) z k
s variables p instructions inst-pt fp sp)
(handle-kc (<ref> variables v2) z k
s variables p instructions inst-pt fp sp))
(NEXT inst-pt)))))
(define-syntax-rule (mk-scm-xmove-op op binop schmop
s p variables variables-scm
nvar pinned? cnst session middle nstack
......@@ -867,6 +908,7 @@ constant = #(nlocals nstack constants code)
(<begin>
(<=> s ss)
(NEXT inst-pt))
(BACKTRACK p instructions inst-pt fp sp))))))))
(mk-i-c mk-scm-unify-i constants i i)
......@@ -1254,6 +1296,7 @@ constant = #(nlocals nstack constants code)
(REGISTER #{=\\=}# neq)
(REGISTER is-addi-s)
(REGISTER is-addi-x)
sp))
(define-syntax-rule (UNPACK-1 free always middle session const)
......@@ -1409,7 +1452,7 @@ constant = #(nlocals nstack constants code)
(<if> var?
(<=> (<ref> vv i) (<call> gp_mkvar s)))
(<next> lp (<+> i (<c> 1))))))
(<=> (<ref> vv (<c> 2)) (GET-TOKEN))
(<=> (GET-PINNED vv) (GET-TOKEN))
vv))))
(define-syntax-rule (DO-CONS s sp)
......@@ -1851,7 +1894,7 @@ constant = #(nlocals nstack constants code)
(SCM scut (<scm> 0))
(int iter (<c> 0)))
(UNPACK-ENV free narg nlocals)
(UNPACK-ENV free narg nlocals)
(UNPACK-1 free always middle session cnst)
(PRSTACK sp fp)
......@@ -2258,6 +2301,11 @@ constant = #(nlocals nstack constants code)
nvar pinned? cnst session middle nstack
instructions variables inst-pt sp fp)
(mk-scm-move-i-op-x is-addi-x <+> scm_sum
s p variables variables-scm
nvar pinned? cnst session middle nstack
instructions variables inst-pt sp fp)
(mk-scm-move sp-move (<c> 0) s p variables variables-scm
nvar pinned? cnst session middle nstack
instructions variables inst-pt sp fp)
......
......@@ -59,7 +59,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
handle_all(L,LL),
(var(Constants)-> get_consts(Constants);true),
%print(LL),nl,!,
print(LL),nl,!,
(Pretty==#t -> Iout=LL ; (b_setval(pretty,#f),mmtr(LL,Iout))).
compile_goal(X,Tail,V,L) :- var_p(X),!,
......
......@@ -305,27 +305,27 @@ handle([(Kind,(ibin;bini)),Op,X,
(F3==#t,S3==#t) ->
(
new_var(V3,Q3,S3),
code([Kind,Op,V2,V3,#t],K,Add),
code([Kind,Op,V2,V3,3],K,Add),
L=[[Add,X,K]|LL],
II is I + 3
);
F3==#t ->
(
new_var(V3,Q3,S3),
code([Kind,Op,V2,V3,#f],K,Add),
code([Kind,Op,V2,V3,0],K,Add),
L=[[Add,X,K]|LL],
II is I + 3
);
N3==1 ->
(
new_var(V3,Q3,S3),
code([Kind,Op,V2,V3,1],K,Add),
code([Kind,Op,V2,V3,5],K,Add),
L=[[Add,X,K]|LL],
II is I + 3
) ;
(
new_var(V3,Q3,S3),
code([Kind,Op,V2,V3,0],K,Unify),
code([Kind,Op,V2,V3,1],K,Unify),
L=[[Unify,X,K]|LL],
II is I + 3
)
......@@ -590,7 +590,7 @@ code([bini,OP,V2,V3,K3],Code,Action) :-
(
V3 = [V3C|_] ->
(
K3 == #f ->
K3 == 0 ->
(
!,
code2(V2C,V3C,Code),
......@@ -603,14 +603,9 @@ code([bini,OP,V2,V3,K3],Code,Action) :-
code([bini,OP,V1,V2,K],Code,Action) :-
(V1=[V1C|_] -> A1=1 ; (V1=V1C, A1=0)),
(V2=[V2C|_] -> A2=1 ; (V2=V2C, A2=0)),
(
K = #f -> KC=2;
K = #t -> K=3 ;
KC = K
),
A is A1 + A2 << 1 + KC << 2,
Code is V1C + V2C << 16 + A << 32,
binxi2(OP,Action).
A is A1 + A2 << 1 + K << 2,
Code is V1C + V2C << 16 + A << 32,
binxi2(OP,Action).
code([ibin,OP,V2,V3,K3],Code,Action) :-
(
......
(use-modules (logic guile-log iso-prolog))
(use-modules (logic guile-log guile-prolog ops))
(use-modules (logic guile-log guile-prolog vm-compiler2))
(use-modules (logic guile-log guile-prolog vm-compiler))
(compile-prolog-string
......@@ -10,7 +10,15 @@ the_tr2(X,[X]).
:- add_term_expansion_temp(the_tr2).
")
(define-prolog b "
b(X,Y) :- Y is X + 1.
")
(define-prolog a "
a(X,Z) :- b(X,Y),b(Y,Z)
")
#;
(define-prolog f1 "
f1(N,I,J,S) :-
I < N ->
......
......@@ -4031,7 +4031,7 @@ SCM gp_copy_vector(SCM **vector, int nvar)
{
newp[i] = vecp[i];
}
newp[2] = gp_get_state_token();
newp[3] = gp_get_state_token();
*vector = newp;
return newvec;
}
......
This diff is collapsed.
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