...

parent 13b3c171
...@@ -63,34 +63,30 @@ push_args_args2([],V,L,LL) :- ...@@ -63,34 +63,30 @@ push_args_args2([],V,L,LL) :-
push_args(X,V,L,LL) :- var_p(X),!, push_args(X,V,L,LL) :- var_p(X),!,
add_var(X,V,Tag), add_var(X,V,Tag),
push_v(1,V), push_v(1,V),
tr('push-variable',Push), L=[['push-variable',Tag]|LL].
L=[[Push,Tag]|LL].
push_args([X|Y],V,L,LL) :- !, push_args([X|Y],V,L,LL) :- !,
tr('mk-cons',Cons),
push_args(X,V,L,L1), push_args(X,V,L,L1),
push_args(Y,V,L1,L2), push_args(Y,V,L1,L2),
push_v(-1,V), push_v(-1,V),
L2=[[Cons]|LL]. L2=[['mk-cons']|LL].
push_args(X(|Y),V,L,LL) :- !, push_args(X(|Y),V,L,LL) :- !,
tr('mk-fkn',Fkn),
narg(Y,0,NN),N is NN + 1, narg(Y,0,NN),N is NN + 1,
push_args_args2([X|Y],V,L,L1), push_args_args2([X|Y],V,L,L1),
M is -N, push_v(M,V), M is -N, push_v(M,V),
L1=[[Fkn,N]|LL]. L1=[['mk-fkn',N]|LL].
push_args({X},V,L,LL) :- !, push_args({X},V,L,LL) :- !,
tr('mk-curly',MK),
push_args(X,V,L,L1), push_args(X,V,L,L1),
L1=[[MK]|LL]. L1=[['mk-curly']|LL].
push_args(X,V,L,LL) :- push_args(X,V,L,LL) :-
push_v(1,V), push_v(1,V),
( (
constant(X) -> constant(X) ->
(tr('push-constant',Push),regconst(X,XX),L=[[Push,XX]|LL]) ; (L=[['push-instruction', X]|LL]) ;
(tr('push-instruction',Push),L=[[Push,X]|LL]) (L=[['push-instruction', X]|LL])
). ).
get_post(S,C,Cplx,Tail,X,XX) :- get_post(S,C,Cplx,Tail,X,XX) :-
...@@ -122,21 +118,18 @@ caller(cc,Args,label(G,N),V,[L,LL]) :- !, ...@@ -122,21 +118,18 @@ caller(cc,Args,label(G,N),V,[L,LL]) :- !,
narg(Args,0,MM), narg(Args,0,MM),
M is MM + 3, M is MM + 3,
(M==N -> true ; throw(cc_does_not_match_caller)), (M==N -> true ; throw(cc_does_not_match_caller)),
tr('clear-sp' , Clear), L=[['clear-sp']|L2],
L=[[Clear]|L2],
get_S(V,S), get_S(V,S),
set_S(V,0), set_S(V,0),
push_v(2,V), push_v(2,V),
L2=[[seek,3]|L4], L2=[[seek,3]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_), push_args_args(#f,Args,V,L4,LL2,_,_),
tr('goto-inst', Goto), LL2 = [['goto-inst',G]|LL].
LL2 = [[Goto,G]|LL].
caller(cc,Args,Tail,V,[L,LL]) :- !, caller(cc,Args,Tail,V,[L,LL]) :- !,
touch_Q(2,V), touch_Q(2,V),
(Tail=#f -> throw(cc_not_in_tail_context) ; true), (Tail=#f -> throw(cc_not_in_tail_context) ; true),
tr('clear-sp' , Clear), L=[['clear-sp']|L2],
L=[[Clear]|L2],
get_S(V,S), get_S(V,S),
set_S(V,0), set_S(V,0),
push_args(F,V,L2,L3), push_args(F,V,L2,L3),
...@@ -144,15 +137,13 @@ caller(cc,Args,Tail,V,[L,LL]) :- !, ...@@ -144,15 +137,13 @@ caller(cc,Args,Tail,V,[L,LL]) :- !,
L3=[[seek,2]|L4], L3=[[seek,2]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_), push_args_args(#f,Args,V,L4,LL2,_,_),
set_FS(V,F,S), set_FS(V,F,S),
tr('tail-cc', Call), LL2 = [['tail-cc']|LW].
LL2 = [[Call]|LW].
caller(F,Args,Tail,V,[L,LL]) :- caller(F,Args,Tail,V,[L,LL]) :-
touch_Q(3,V), touch_Q(3,V),
(get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ; (get_recur(F,A,N) -> rec(F,A,N,Args,Tail,V,[L,LL]) ;
( (
tr('clear-sp' , Clear), L=[['clear-sp']|L2],
L=[[Clear]|L2],
get_CS(V,[C|_],S), get_CS(V,[C|_],S),
set_S(V,0), set_S(V,0),
push_args(F,V,L2,L3), push_args(F,V,L2,L3),
...@@ -165,18 +156,14 @@ caller(F,Args,Tail,V,[L,LL]) :- ...@@ -165,18 +156,14 @@ caller(F,Args,Tail,V,[L,LL]) :-
set_FS(V,Fsym,S), set_FS(V,Fsym,S),
(Tail == #t -> (Tail == #t ->
( (
tr('tail-call', Call), LL2 = [['tail-call']|LW]
LL2 = [[Call]|LW]
); );
Tail = label(G,N) -> Tail = label(G,N) ->
( (
tr(goto-inst,Goto), LL2 = [['call-n',N],['goto-inst',G]|LW]
tr('call-n',Call),
LL2 = [[Call,N],[Goto,G]|LW]
); );
( (
tr('call', Call), LL2=[['call']|LLL],
LL2=[[Call]|LLL],
get_post(S,C,#f,Tail,LLL,LW) get_post(S,C,#f,Tail,LLL,LW)
) )
))). ))).
......
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
#:use-module (logic guile-log prolog swi) #:use-module (logic guile-log prolog swi)
#:use-module (logic guile-log guile-prolog vm vm-pre) #:use-module (logic guile-log guile-prolog vm vm-pre)
#:use-module (logic guile-log guile-prolog vm vm-var) #:use-module (logic guile-log guile-prolog vm vm-var)
#:use-module (logic guile-log vm vm)
#:use-module (compat racket misc) #:use-module (compat racket misc)
#:use-module (system vm assembler) #:use-module (system vm assembler)
#:export (caller push_args_args2 push_args_args push_args)) #:export (caller push_args_args2 push_args_args push_args))
......
...@@ -153,8 +153,8 @@ compile_goal((F(|Args) :- Goal),Tail,V,L) :- !, ...@@ -153,8 +153,8 @@ compile_goal((F(|Args) :- Goal),Tail,V,L) :- !,
NN is N + 4, NN is N + 4,
push_v(NN,V), push_v(NN,V),
get_A(V,[[0|_]|_]) -> get_A(V,[[0|_]|_]) ->
wrap(compile_goal((begin_att,Impr,pop(4),end_att,Goal),Tail,V,L),L); wrap(compile_goal((move_args(NN),begin_att,Impr,end_att,Goal),Tail,V,L),L);
wrap(compile_goal((begin_att,Impr,pop(4),Goal),Tail,V,L),L). wrap(compile_goal((move_args(NN),begin_att,Impr,Goal),Tail,V,L),L).
compile_goal((F :- Goal),Tail,V,L) :- !, compile_goal((F :- Goal),Tail,V,L) :- !,
push_v(4,V), push_v(4,V),
...@@ -166,6 +166,14 @@ compile_goal(newtag_F(F),Tail,V,[L,L]) :- ...@@ -166,6 +166,14 @@ compile_goal(newtag_F(F),Tail,V,[L,L]) :-
compile_goal(extended_off,Tail,V,[L,L]) :- !, compile_goal(extended_off,Tail,V,[L,L]) :- !,
set_extended(#f). set_extended(#f).
compile_goal(move_args(4),Tail,V,[L,L]) :- !,
true.
compile_goal(move_args(N),Tail,V,[L,LL]) :- !,
L=[push_at(N)|L1],
NN is N - 1,
compile_goal(move_args(NN),Tail,V,[L1,LL]).
compile_goal(extended_on(|L),Tail,V,[L,L]) :- !, compile_goal(extended_on(|L),Tail,V,[L,L]) :- !,
set_extended(L). set_extended(L).
......
...@@ -30,6 +30,15 @@ chech_push(F) :- ...@@ -30,6 +30,15 @@ chech_push(F) :-
handle([label,N],[I,L],[II,LL]) :- !, handle([label,N],[I,L],[II,LL]) :- !,
N=I,I=II,LL=L. N=I,I=II,LL=L.
handle(['cc'],I,II,L,LL) :-
'cc-call'(I,II,L,LL).
handle(['clear-sp'],I,0,L,LL) :- !,
'clear-sp'(I,0,L,LL).
handle([seek,N],I,II,L,LL) :- !,
seek(N,I,II,L,LL).
handle([softie,A],I,II,L,LL) :- !, handle([softie,A],I,II,L,LL) :- !,
( (
(var(A) ; number(A)) -> (var(A) ; number(A)) ->
...@@ -42,6 +51,9 @@ handle([softie,A],I,II,L,LL) :- !, ...@@ -42,6 +51,9 @@ handle([softie,A],I,II,L,LL) :- !,
) )
). ).
handle(push_at(K),I,II,L,LL) :- !,
push_at(K,I,II,L,LL).
handle([(F,('newframe-light';'unwind-light-tail';'unwind-light')), handle([(F,('newframe-light';'unwind-light-tail';'unwind-light')),
[[S,V,Q],N,F|_],A],I,II,L,LL) :- [[S,V,Q],N,F|_],A],I,II,L,LL) :-
new_var(V,Q,S), new_var(V,Q,S),
...@@ -116,6 +128,9 @@ handle([pop,N],I,II,L,LL) :- ...@@ -116,6 +128,9 @@ handle([pop,N],I,II,L,LL) :-
handle(['post-c',C],I,II,L,LL) :- !, handle(['post-c',C],I,II,L,LL) :- !,
'post-c'(C,I,II,L,LL). 'post-c'(C,I,II,L,LL).
handle(['push-instruction',C],I,II,L,LL) :- !,
'push-instruction'(C,I,II,L,LL).
handle([label,N,[_,Tags]],I,II,L,LL) :- !, handle([label,N,[_,Tags]],I,II,L,LL) :- !,
L=[N|_], L=[N|_],
addvs(Tags,L,LL). addvs(Tags,L,LL).
...@@ -138,7 +153,7 @@ handle(['pre-unify',At,Vx],I,II,L,LL) :- !, ...@@ -138,7 +153,7 @@ handle(['pre-unify',At,Vx],I,II,L,LL) :- !,
isCplx(At) -> isCplx(At) ->
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=var(VC) ; E=sp(V)), (V=[VC|_] -> E=var(VC) ; E=svar(V)),
'pre-unify'(E,I,II,L,LL) 'pre-unify'(E,I,II,L,LL)
) ; ) ;
(L=LL,I=II) (L=LL,I=II)
...@@ -150,7 +165,7 @@ handle(['post-unify-tail',[[S,V,Q],N,F|_]],I,II,L,LL) :- ...@@ -150,7 +165,7 @@ handle(['post-unify-tail',[[S,V,Q],N,F|_]],I,II,L,LL) :-
F==#t -> throw(end_with_no_begin) ; F==#t -> throw(end_with_no_begin) ;
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=var(VC) ; E=sp(V)), (V=[VC|_] -> E=var(VC) ; E=svar(V)),
'post-unify-tail'(E,I,II,L,LL) 'post-unify-tail'(E,I,II,L,LL)
) )
). ).
...@@ -176,11 +191,11 @@ handle([set,(W,[[S,V,Q],N,F|_])],I,II,L,LL) :- !, ...@@ -176,11 +191,11 @@ handle([set,(W,[[S,V,Q],N,F|_])],I,II,L,LL) :- !,
handle(['push-variable',[[S,V,Q],N,F|_]],I,II,L,LL) :- !, handle(['push-variable',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,
( (
(F==#t,N==1) -> pushv(#f,L,LL); (F==#t,N==1) -> pushv(#f,L,LL);
F==#t -> (new_var(V,Q,S), pushv(V,L,LL)); F==#t -> (new_var(V,Q,S), pushv(V,L,LL));
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> Q=sp(VC) ; Q=V), (V=[VC|_] -> QQ=svar(VC) ; QQ=V),
'push-variable-s'(Q,I,II,L,LL) 'push-variable'(QQ,I,II,L,LL)
) )
). ).
...@@ -188,7 +203,11 @@ handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !, ...@@ -188,7 +203,11 @@ handle(['push-variable-scm',[[S,V,Q],N,F|_]],I,II,L,LL) :- !,
( (
F==#t -> F==#t ->
throw(first_variable_in_scheme_context); throw(first_variable_in_scheme_context);
'push-variable-scm'(V,I,II,L,LL) (
new_var(V,Q,S),
(V=[VC|_] -> QQ=svar(VC) ; QQ=V),
'push-variable'(QQ,I,II,L,LL)
)
). ).
handle([comp,CMP,[[S1,V1,Q1],N1,F1|_], handle([comp,CMP,[[S1,V1,Q1],N1,F1|_],
...@@ -295,9 +314,7 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !, ...@@ -295,9 +314,7 @@ handle([unify,[[S,V,Q],N,F|_],M],I,II,L,LL) :- !,
M=#f -> gfalse(I,II,L,LL); M=#f -> gfalse(I,II,L,LL);
( (
new_var(V,Q,S), new_var(V,Q,S),
write(thecase),nl,
code([unify,M,V,#f],K,VV,Unify), code([unify,M,V,#f],K,VV,Unify),
write(got(Unify,K,VV)),nl,
Unify(K,VV,I,II,L,LL) Unify(K,VV,I,II,L,LL)
) )
); );
...@@ -321,24 +338,24 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !, ...@@ -321,24 +338,24 @@ handle([U,[[S,V,Q],N,F|_],A,M],I,II,L,LL) :- !,
(F==#t,S==#t) -> (F==#t,S==#t) ->
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=sp(VC) ; E=var(V)), (V=[VC|_] -> E=svar(VC) ; E=var(V)),
U(M,XX,E,#t,I,II,L,LL) U(M,XX,E,#t,I,II,L,LL)
); );
F==#t -> F==#t ->
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=sp(VC) ; E=var(V)), (V=[VC|_] -> E=svar(VC) ; E=var(V)),
U(M,XX,E,#f,I,II,L,LL) U(M,XX,E,#f,I,II,L,LL)
) ; ) ;
N==1 -> N==1 ->
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=sp(VC) ; E=var(V)), (V=[VC|_] -> E=svar(VC) ; E=var(V)),
U(M,XX,E,1,I,II,L,LL) U(M,XX,E,1,I,II,L,LL)
) ; ) ;
( (
new_var(V,Q,S), new_var(V,Q,S),
(V=[VC|_] -> E=sp(VC) ; E=var(V)), (V=[VC|_] -> E=svar(VC) ; E=var(V)),
U(M,XX,E,0,I,II,L,LL) U(M,XX,E,0,I,II,L,LL)
) )
) )
...@@ -445,7 +462,7 @@ code([unify,M,V,K],Code,Q,Action) :- !, ...@@ -445,7 +462,7 @@ code([unify,M,V,K],Code,Q,Action) :- !,
(M\\=#f,K=#f) -> (M\\=#f,K=#f) ->
( (
V=[U|_] -> V=[U|_] ->
(Action = 'sp-move', Q = sp(U)); (Action = 'sp-move', Q = svar(U));
(Action = 'sp-move', Q = var(V)) (Action = 'sp-move', Q = var(V))
) ; ) ;
( (
...@@ -457,7 +474,7 @@ code([unify,M,V,K],Code,Q,Action) :- !, ...@@ -457,7 +474,7 @@ code([unify,M,V,K],Code,Q,Action) :- !,
MC=M MC=M
), ),
write(3), write(3),
(V=[VC|_] -> (A=1,Q=sp(VC)) ; (Q=var(V), A=0)), (V=[VC|_] -> (A=1,Q=svar(VC)) ; (Q=var(V), A=0)),
( (
K = #f -> KC=2 ; K = #f -> KC=2 ;
K = #t -> KC=3 ; K = #t -> KC=3 ;
...@@ -475,8 +492,8 @@ code(['unify-2',M,V1,K1,V2,K2],Code,Q1,Q2) :- !, ...@@ -475,8 +492,8 @@ code(['unify-2',M,V1,K1,V2,K2],Code,Q1,Q2) :- !,
M = #t -> MC=3 ; M = #t -> MC=3 ;
MC=M MC=M
), ),
(V1=[V1C|_] -> (A1=1,Q1=sp(V1C)) ; (V1=V1C, A1=0, Q1=var(V1))), (V1=[V1C|_] -> (A1=1,Q1=svar(V1C)) ; (V1=V1C, A1=0, Q1=var(V1))),
(V2=[V2C|_] -> (A2=1,Q2=sp(V2C)) ; (V2=V2C, A2=0, Q2=var(V2))), (V2=[V2C|_] -> (A2=1,Q2=svar(V2C)) ; (V2=V2C, A2=0, Q2=var(V2))),
( (
K1 = #f -> K1C=2 ; K1 = #f -> K1C=2 ;
K1 = #t -> K1C=3 ; K1 = #t -> K1C=3 ;
......
...@@ -83,7 +83,7 @@ ...@@ -83,7 +83,7 @@
(define (get-svarn s q) (define (get-svarn s q)
(let* ((h (fluid-ref *svarn*)) (let* ((h (fluid-ref *svarn*))
(i (vhashq-ref h q 0))) (i (vhashq-ref h q 2)))
(let () (let ()
(fluid-set! *svarn* (vhash-consq q (+ i 1) h)) (fluid-set! *svarn* (vhash-consq q (+ i 1) h))
(cons i 0)))) (cons i 0))))
......
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
#:use-module (logic guile-log vm utils) #:use-module (logic guile-log vm utils)
#:use-module (logic guile-log vm fkn) #:use-module (logic guile-log vm fkn)
#:export (in-call cc-call tail-call post-call post-unicall)) #:export (in-call cc-call in-tailcall post-call post-unicall))
(compile-prolog-string (compile-prolog-string
" "
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
#:use-module (logic guile-log vm utils) #:use-module (logic guile-log vm utils)
#:replace (cutter goto-inst sp-move equal-instruction #:replace (cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable push-instruction pushv push-variable
pop-variable pop seek dup clear-sp)) pop-variable pop seek dup clear-sp push_at))
(compile-prolog-string (compile-prolog-string
" "
...@@ -32,7 +32,11 @@ ...@@ -32,7 +32,11 @@
scmcall('gp-prune',[scut],I,_,L7,L8), scmcall('gp-prune',[scut],I,_,L7,L8),
reset(I,L8,LL). reset(I,L8,LL).
-trace.
push_at(K,I,II,L,LL) :-
gset(sp(I),svar(K),I,L,LL),
II is I + 1.
'sp-move'(_,V,I,II,L,LL) :- 'sp-move'(_,V,I,II,L,LL) :-
II is I - 1, II is I - 1,
gset(V,sp(II),I,L,L1), gset(V,sp(II),I,L,L1),
...@@ -42,7 +46,8 @@ ...@@ -42,7 +46,8 @@
pltest('equal?',[sp(I-1),c(C)],I,L,L2), pltest('equal?',[sp(I-1),c(C)],I,L,L2),
II is I - 1, II is I - 1,
reset(II,L2,LL). reset(II,L2,LL).
-trace.
'push-instruction'(C,I,II,L,LL) :- 'push-instruction'(C,I,II,L,LL) :-
gset(sp(I),c(C),I,L,L1), gset(sp(I),c(C),I,L,L1),
II is I + 1, II is I + 1,
...@@ -54,6 +59,7 @@ ...@@ -54,6 +59,7 @@
II is I + 1, II is I + 1,
reset(II,L2,LL). reset(II,L2,LL).
-trace.
'push-variable'(V,I,II,L,LL) :- 'push-variable'(V,I,II,L,LL) :-
gset(sp(I),V,I,L,L1), gset(sp(I),V,I,L,L1),
II is I + 1, II is I + 1,
......
...@@ -39,7 +39,7 @@ ...@@ -39,7 +39,7 @@
'post-unify-tail'(V,I,0,L,LL) :- 'post-unify-tail'(V,I,0,L,LL) :-
gref(V,I,L,L1), gref(V,I,L,L1),
II is I + 1, II is I + 1,
gref(c(delayers),II,L3,L4), gref(c(delayers),II,L1,L4),
generate(eq(I,II),L4,L5), generate(eq(I,II),L4,L5),
generate(je(E),L5,L6), generate(je(E),L5,L6),
III is II + 1, III is II + 1,
...@@ -110,12 +110,12 @@ ...@@ -110,12 +110,12 @@
). ).
'unify-instruction-2'(M,C,V,K,I,II,L,LL) :- 'unify-constant-2'(M,C,V,K,I,II,L,LL). 'unify-instruction-2'(M,C,V,K,I,II,L,LL) :- 'unify-constant-2'(M,C,V,K,I,II,L,LL).
-trace.
'unify-constant-2'(M,C,V,K,I,I,L,LL) :- 'unify-constant-2'(M,C,V,K,I,I,L,LL) :-
( (
K == #f -> K == #f ->
gset(V,c(C),I,L,LL); gset(V,c(C),I,L,LL);
( (
M == #f -> M == #f ->
( (
pltest('gp-m-unify',[V,c(C),s],I,_,L,L2), pltest('gp-m-unify',[V,c(C),s],I,_,L,L2),
...@@ -129,7 +129,7 @@ ...@@ -129,7 +129,7 @@
), ),
reset(I,L1,LL) reset(I,L1,LL)
) )
) )
). ).
'unify-instruction'(C,M,I,II,L,LL) :- 'unify-instruction'(C,M,I,II,L,LL) :-
......
(define-module (logic guile-log vm utils) (define-module (logic guile-log vm utils)
#:use-module (logic guile-log iso-prolog) #:use-module (logic guile-log iso-prolog)
#:use-module ((logic guile-log umatch) #:select (gp-make-var))
#:export (reset gset gref move scmcall make_p make_cc j je jne #:export (reset gset gref move scmcall make_p make_cc j je jne
scmtailcall scmtailcall2 scmcall1 generate scmtailcall scmtailcall2 scmcall1 generate
label gfalse gtrue isTrue pltest lookup2 label gfalse gtrue isTrue pltest lookup2 svar
test sp cc s c vec cut stack call? scut pp pltest_s)) test sp cc s c vec cut stack call? scut pp pltest_s base))
(define base (gp-make-var))
(compile-prolog-string (compile-prolog-string
" "
generate(Tok,[Tok|LL],LL). generate(Tok,[Tok|LL],LL).
id(s ,sp(0)). id(s ,svar(0)).
id(p ,sp(1)). id(p ,svar(1)).
id(cut ,var(0)). id(cut ,var(0)).
id(scut ,var(1)). id(scut ,var(1)).
id(vec ,var(2)). id(vec ,var(2)).
...@@ -33,34 +36,44 @@ ...@@ -33,34 +36,44 @@
reset(I,L,LL) :- reset(I,L,LL) :-
call(II is I), call(II is I),
generate(reset(II),L,LL). generate(reset(base+II),L,LL).
varref(Pos,I,II,L,LL) :- varref(Pos,I,II,L,LL) :-
generate('vector-ref'(I,0,Pos),L,LL), generate('vector-ref'(base+I,0,Pos),L,LL),
II is I + 1. II is I + 1.
varset(I,J,L,LL) :- varset(I,J,L,LL) :-
generate('vector-set!'(3,I,base+J),L,LL).
varset_s(I,J,L,LL) :-
generate('vector-set!'(3,I,J),L,LL). generate('vector-set!'(3,I,J),L,LL).
constant(C,I,L,LL) :- constant(C,I,L,LL) :-
generate(constant(I,C),L,LL). generate(constant(I,C),L,LL).
move(I,J,L,LL) :- move(I,J,L,LL) :-
call(II is I), generate(move(J,I),L,LL).
call(JJ is J),
generate(move(JJ,II),L,LL). -trace.
gref(c(X),I,L,LL) :- !, gref(c(X),I,L,LL) :- !,
constant(X,I,L,LL). call(II is I),
constant(X,base+II,L,LL).
gref(var(X),I,L,LL) :- !, gref(var(X),I,L,LL) :- !,
varref(X,I,_,L,LL). call(II is I),
varref(X,II,_,L,LL).
gref(sp(X),I,L,LL) :- !, gref(sp(X),I,L,LL) :- !,
move(X,I,L,LL). call(XX is X),
call(II is I),
move(XX,base + II,L,LL).
gref(svar(X),I,L,LL) :- !,
call(XX is X),
call(II is I),
move(XX,base + II,L,LL).
gref(l(X),I,L,LL) :- !, gref(l(X),I,L,LL) :- !,
generate('label-ref'(I,X),L,LL). generate('label-ref'(base+I,X),L,LL).
gref(A,I,L,LL) :- gref(A,I,L,LL) :-
id(A,X),!, id(A,X),!,
...@@ -69,14 +82,17 @@ ...@@ -69,14 +82,17 @@
gref(A,I,L,LL) :- gref(A,I,L,LL) :-
e(A,I,_,L,LL). e(A,I,_,L,LL).
vset(I,sp(J),I,L,LL) :- !, vset(K,sp(J),I,L,LL) :- !,
call(JJ is J), call(JJ is J),
varset(I,JJ,L,LL). varset(K,JJ,L,LL).
vset(J,var(X),I,L,LL) :- !, vset(J,var(X),I,L,LL) :- !,
gref(var(X),I,L,L2), gref(var(X),I,L,L2),
varset(J,I,L2,LL). varset(J,I,L2,LL).
vset(J,svar(X),I,L,LL) :- !,
varset_s(J,X,L2,LL).
vset(J,c(X),I,L,LL) :- !, vset(J,c(X),I,L,LL) :- !,
gref(c(X),I,L,L2), gref(c(X),I,L,L2),
varset(J,I,L2,LL). varset(J,I,L2,LL).
...@@ -85,27 +101,57 @@ ...@@ -85,27 +101,57 @@
id(X,XX), id(X,XX),
vset(J,XX,I,L,LL). vset(J,XX,I,L,LL).
-trace.
sset(K,sp(J),I,L,LL) :- !, sset(K,sp(J),I,L,LL) :- !,
move(J,K,L,LL). move(base+J,base+K,L,LL).
sset(K,svar(J),I,L,LL) :- !,
call(KK is K),
move(J,base+KK,L,LL).
sset(J,var(X),I,L,LL) :- !, sset(J,var(X),I,L,LL) :- !,
gref(var(X),I,L,L2), gref(var(X),I,L,L2),
move(I,J,L2,LL). call(JJ is J),
move(base+I,base+JJ,L2,LL).
sset(J,c(X),I,L,LL) :- !, sset(J,c(X),I,L,LL) :- !,
gref(c(X),I,L,L2), call(JJ is J),
move(I,J,L2,LL). gref(c(X),JJ,L,LLL).
sset(J,X,I,L,LL) :- sset(J,X,I,L,LL) :-
id(X,XX), id(X,XX),
sset(J,XX,I,L,LL). sset(J,XX,I,L,LL).
cset(K,sp(J),I,L,LL) :- !,
move(base+J,K,L,LL).
cset(K,svar(J),I,L,LL) :- !,
call(KK is K),
move(J,KK,L,LL).
cset(J,var(X),I,L,LL) :- !,
gref(var(X),I,L,L2),
call(JJ is J),
move(base + I,JJ,L2,LL).
cset(J,c(X),I,L,LL) :- !,
gref(c(X),I,L,L2),
call(JJ is J),
move(base+I,JJ,L2,LL).
cset(J,X,I,L,LL) :-
id(X,XX),
cset(J,XX,I,L,LL).
gset(var(V),Val,I,L,LL) :- !, gset(var(V),Val,I,L,LL) :- !,
vset(V,Val,I,L,LL). vset(V,Val,I,L,LL).
gset(sp(V),Val,I,L,LL) :- !, gset(sp(V),Val,I,L,LL) :- !,
sset(V,Val,I,L,LL). sset(V,Val,I,L,LL).
gset(svar(V),Val,I,L,LL) :- !,
cset(V,Val,I,L,LL).
gset(X,Val,I,L,LL) :- gset(X,Val,I,L,LL) :-
id(X,XX), id(X,XX),
gset(XX,Val,I,L,LL). gset(XX,Val,I,L,LL).
...@@ -118,30 +164,18 @@ ...@@ -118,30 +164,18 @@
I = N, I = N,
generate('pl-setup-frame',L4,LL).