some newframes

parent 1f48e3c9
......@@ -11,94 +11,66 @@
'store-ps'.
'store-p'.
/*
(LABEL store-state)
(PRSTACK sp fp)
(<let> ((SCM tag (<ref> inst-pt (<c> 0)))
(SCM np (<ref> inst-pt (<c> 1))))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(STORE-STATE-SOFT s tag p fp nstack)
(<call> INTERUPT)
(NEXT inst-pt))
% Probably not used
mkconses2([],_,L,L).
mkconses2([A|U],I,L,LL) :-
gset(sp(I),A,I,L,L1),
II is I + 1,
'mk-cons(II,L1,L2),
mkconses(U,I,L2,LL).
(define-syntax-rule (STORE-STATE-SOFT s tag p fp nstack)
(<let> ((int v (scm->int tag)))
(<=> (SVAR-REF fp nstack v) p)))
mkconses([A|U],I,L,LL) :-
reset(I+2,L,L1)
gset(sp(I),A,I,L1,L2),
II is I + 1,
mkconses2(U,II,L2,L3),
reset(I+1,L3,LL).
'store-state'([],_,L,L).
'store-state'(U,I,L,LL) :-
mkconses(U,I,L,L1),
II is I + 1,
gset(sp(II),cstack,III,L1,L2),
'mk-cons'(L2,L3),
gset(cstack,sp(I),L3,L4),
reset(I,L4,LL).
*/
'store-state'(Tag,NP,I,L,LL) :-
sset(Tag,p,I,L,LL)
'newframe-ps'(PP,SS,I,L,LL) :-
gset(PP,p,I,L,L1),
gset(SS,s,I,L1,L2),
reset(I,L2,LL).
'newframe-ps'(A,P,S,I,L,LL) :-
gset(P,p,I,L,L1),
gset(S,s,I,L1,L2),
gset(p,l(A),I,L2,L3),
reset(I,L3,LL).
'newframe-pst'(P,S,T,I,L,LL) :-
'newframe-pst'(A,P,S,T,I,L,LL) :-
gset(P,p,I,L,L1),
gset(S,s,I,L1,L2).
gset(T,delayers,I,L2,L3),
reset(I,L3,LL).
gset(p,l(A),I,L3,L4).
reset(I,L4,LL).
'newframe-light'(P,NP,I,L,LL) :-
sset(P,p,I,L,L1),
gset(p,l(NP),I,L1,L2),
reset(I,L2,LL).
/*
(LABEL newframe)
(PRSTACK sp fp)
(<let> ((SCM np (<ref> inst-pt (<c> 0)))
(int tp (scm->int (<ref> inst-pt (<c> 1))))
(SCM fr (NEWFRAME s)))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(<=> ctrl-stack (STORE-STATE tp np s fr p ctrl-stack))
(<=> s fr)
(<=> p np)
(<call> INTERUPT)
(NEXT inst-pt))
*/
newframe(NP,TP,I,L,LL) :-
newframe(I,L,L1,
store_state(l(NP),TP,I,L1,L2),
gset(p,sp(I),L2,L3),
gset(s,newframe,I,L3,L4).
/*
(LABEL newframe-negation)
(PRSTACK sp fp)
(<let> ((SCM np (<ref> inst-pt (<c> 0)))
(int tp (scm->int (<ref> inst-pt (<c> 1))))
(SCM so s)
(SCM ss (NEWFRAME s)))
(<=> inst-pt (<+> inst-pt (<c> 2)))
(<=> s ss)
(<=> s (<call> gp_set
*gp-not-n*
(<call>
SCM_I_MAKINUM
(<+> (<c> 1)
(<call> SCM_I_INUM
(<call> gp_gp_lookup
*gp-not-n* s))))
s))
(<=> s (<call> gp_set *gp-is-delayed?* (<scm> #f) s))
(<=> ctrl-stack (STORE-STATE-NEG tp np so ss scut p ctrl-stack))
(<=> p np)
(<=> cut np)
(<call> INTERUPT)
(NEXT inst-pt))
*/
gset(sp(I),l(NP),I,L,L1),
II is I + 1,
'store-state'([sp(I),s,newframe,p],II,L1,L2),
gset(p,sp(I),II,L2,L3),
gset(s,newframe,I,L3,L4),
reset(I,L4,LL).
'newframe-negation'(NP,TP,I,L,LL) :-
neframe(L,L1),
I1 is I + 1,
gset(sp(I),l(NP),II,L1,L2),
mkcstack(sp(I),TP,newframe,s,scut,p,cstack),
scmcall('gp-newframe-negation',
[vec,],II,III,L2,L3),
gset(cstack,sp(III),
gset(sp(I),l(NP),I,L1,L2),
'store-state'([sp(I),c(TP),scut,p,newframe,],II,L1,L2),
III is II + 1,
gset(cstack,sp(II),III,L2,L3),
scmcall('gp-newframe-negation',[s],II,I2,L2,L3),
gset(s,sp(I2),I2,L3,L4),
gset(p,sp(I),II,L4,L5),
gset(cut,sp(I),II,L5,L6),
reset(I,L6,LL).
")
......@@ -31,7 +31,7 @@
;; push
cutter goto-inst sp-move equal-instruction
push-instruction pushv push-variable
pop-variable pop seek dup clear-sp)
pop-variable pop seek dup clear-sp
;; unify
ggset unify unify-2 unify-constant-2
......@@ -46,21 +46,8 @@
;; op
plus minus band bor xor modulo mul shift-l shift-r
divide gt lt le eq neq)
(compile-prolog-string
"
assemble(L,Asm) :-
Asm is 'make-assembler'(),
assemble0(L,Asm).
assemble0([],_).
assemble0([Emit(|A)|L],Asm) :-
Emit(Asm|A),
assemble0(L,Asm).
")
divide gt lt le eq neq
))
......
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