push.scm 1.81 KB
Newer Older
1 2 3 4 5 6 7
(define-module (logic guile-log vm push)
  #:use-module ((logic guile-log iso-prolog)
		#:renamer
		(lambda (x) (if (eq? x 'reset)
				'reset_iso
				x)))
  #:use-module (logic guile-log vm utils)
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
8
  #:replace (cutter goto-inst sp-move equal-instruction
9
		   push-instruction pushv push-variable
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
10
		   pop-variable pop seek dup clear-sp push_at))
11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34

(compile-prolog-string
"
  'clear-sp'(I,0,L,LL) :-
     reset(0,L,LL).

   cutter(V,VC,I,L,LL) :-
      gset(cut,V,I,L,L1),
      gset(scut,VC,I,L1,L2),
      reset(I,L2,LL).

   'goto-inst'(Inst,I,L,LL) :-
       gref(I,c(Inst),I,L,L1),
       generate(goto(I),L1,LL).

   cut(I,L,LL) :-
      isZero(cut,I,L,L2),
      jne(Lab,L2,L3),
      gset(p,vcut,I,L3,L4),
      j(Lab2,L4,L5),
      gset(p,cut,I,L6,L7).
      scmcall('gp-prune',[scut],I,_,L7,L8),
      reset(I,L8,LL).

Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
35 36 37 38 39
 
   push_at(K,I,II,L,LL) :-
      gset(sp(I),svar(K),I,L,LL),
      II is I + 1.  

Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
40
   'sp-move'(_,V,I,II,L,LL) :-
41
     II is I - 1,
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
42
     gset(V,sp(II),I,L,L1),
43 44 45 46 47 48
     reset(II,L1,LL).

   'equal-instruction'(C,I,II,L,LL) :-
      pltest('equal?',[sp(I-1),c(C)],I,L,L2),
      II is I - 1,
      reset(II,L2,LL).
Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
49 50
   
   -trace.
51
   'push-instruction'(C,I,II,L,LL) :-
52
     gset(sp(I),c(C),I,L,L2),
53
     II is I + 1,
54
     reset(II,L2,LL).
55 56 57 58 59 60 61

   pushv(X,I,II,L,LL) :-
     scmcall('gp-var!',[s],I,I2,L,L1),
     gset(sp[I],svar(I2-1),I2,L1,L2),
     II is I + 1,
     reset(II,L2,LL).

Stefan Israelsson Tampe's avatar
Stefan Israelsson Tampe committed
62
   -trace.
63
   'push-variable'(V,I,II,L,LL) :-
64
      gset(sp(I),V,I,L,L2),
65
      II is I + 1,
66
      reset(II,L2,LL).
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82

   'pop-variable'(V,I,II,L,LL) :-
       gset(V,sp(I-1),L,L1),
       II is I - 1,
       reset(II,L1,LL).

   pop(N,I,II,L,LL) :-
      II is I - N,
      reset(II,L,LL).


   seek(N,I,II,L,LL) :-
      II is I + N,
      reset(II,L,LL).

   dup(I,II,L,LL) :-
83
      movex(I,I-1,L,L1),
84 85 86 87 88 89
      II is I + 1,
      reset(II,L1,LL).

")