guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, wip-cps-bis, updated. v2.1.0-192-g561c


From: Mark H Weaver
Subject: [Guile-commits] GNU Guile branch, wip-cps-bis, updated. v2.1.0-192-g561c9db
Date: Fri, 16 Aug 2013 09:45:40 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=561c9db260a7e5d0dc86c471316526a8c89ccf65

The branch, wip-cps-bis has been updated
       via  561c9db260a7e5d0dc86c471316526a8c89ccf65 (commit)
      from  6a3e82845ed52dfd3e7711ba4a759091d7b8c2a4 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 561c9db260a7e5d0dc86c471316526a8c89ccf65
Author: Mark H Weaver <address@hidden>
Date:   Fri Aug 16 05:34:18 2013 -0400

    RTL Compiler: miscellaneous fixes.
    
    * module/language/cps/arities.scm (fix-arities): If a primcall isn't
      implemented in the VM, don't try to determine its arity or adapt it.
    
    * module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add case for
      'struct-set!' in 'emit-seq'.  Fix off-by-one error in emitted
      'receive-values' instruction.
    
    * module/language/cps/slot-allocation.scm (solve-parallel-moves):
      Construct list in the right order.  Fix reversed move order in
      pattern.

-----------------------------------------------------------------------

Summary of changes:
 module/language/cps/arities.scm         |   32 ++++++++++++++++++------------
 module/language/cps/compile-rtl.scm     |    4 ++-
 module/language/cps/slot-allocation.scm |    6 ++--
 3 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/module/language/cps/arities.scm b/module/language/cps/arities.scm
index 3c52268..a28ed65 100644
--- a/module/language/cps/arities.scm
+++ b/module/language/cps/arities.scm
@@ -173,19 +173,25 @@
             ;; Primcalls to return are in tail position.
             (make-$continue 'ktail exp))
            (($ $primcall name args)
-            (match (prim-arity name)
-              ((out . in)
-               (adapt
-                out
-                k
-                (if (= in (length args))
-                    (cut make-$continue <> exp)
-                    (lambda (k)
-                      (let ((k* (gensym "kprim"))
-                            (p* (gensym "vprim")))
-                        (make-$let1v #f k* 'prim p*
-                                     (make-$continue k (make-$call p* args))
-                                     (make-$continue k* (make-$prim 
name))))))))))
+            (if (or (prim-rtl-instruction name)
+                    (branching-primitive? name))
+                (match (prim-arity name)
+                  ((out . in)
+                   (adapt
+                    out
+                    k
+                    (if (= in (length args))
+                        (cut make-$continue <> exp)
+                        (lambda (k)
+                          (let ((k* (gensym "kprim"))
+                                (p* (gensym (symbol->string name))))
+                            (make-$let1v #f k* 'prim p*
+                                         (make-$continue k (make-$call p* 
args))
+                                         (make-$continue k* (make-$prim 
name)))))))))
+                ;; If it's not implemented in the VM, it will be
+                ;; converted into a normal procedure call, so we don't
+                ;; need to adapt.
+                term))
            (($ $values)
             ;; Values nodes are inserted by CPS optimization passes, so
             ;; we assume they are correct.
diff --git a/module/language/cps/compile-rtl.scm 
b/module/language/cps/compile-rtl.scm
index 73c27fd..5a4dfef 100644
--- a/module/language/cps/compile-rtl.scm
+++ b/module/language/cps/compile-rtl.scm
@@ -228,6 +228,8 @@
            (emit `(free-set! ,(slot closure) ,(slot value) ,(constant idx))))
           (($ $primcall 'box-set! (box value))
            (emit `(box-set! ,(slot box) ,(slot value))))
+          (($ $primcall 'struct-set! (struct index value))
+           (emit `(struct-set! ,(slot struct) ,(slot index) ,(slot value))))
           (($ $primcall 'vector-set! (vector index value))
            (emit `(vector-set ,(slot vector) ,(slot index) ,(slot value))))
           (($ $primcall 'set-car! (pair value))
@@ -285,7 +287,7 @@
                (match args
                  (()
                   (emit `(call ,proc-slot ,(+ nargs 1)))
-                  (emit `(receive-values ,(1+ proc-slot) ,nreq))
+                  (emit `(receive-values ,proc-slot ,nreq))
                   (when rest?
                     (emit `(bind-rest ,(+ proc-slot 1 nreq))))
                   (for-each (match-lambda
diff --git a/module/language/cps/slot-allocation.scm 
b/module/language/cps/slot-allocation.scm
index c66df53..00180d4 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -159,9 +159,9 @@ are comparable with eqv?.  A tmp slot may be used."
   (define (non-trivial-moves in moves)
     (match in
       (() (reverse moves))
-      (((and move (cut . dst)) . in)
+      (((and move (dst . cut)) . in)
        (let lp ((in in) (in* '())
-                (moves (cons* (cons cut tmp) move moves)))
+                (moves (cons* move (cons cut tmp) moves)))
          (match in
            (() (trivial-moves in* moves))
            (((and move (src . dst)) . in)
@@ -333,7 +333,7 @@ are comparable with eqv?.  A tmp slot may be used."
                        (nvals (length dst-syms))
                        (src-slots (map (cut + proc-slot 1 <>) (iota nvals)))
                        (live-set* (fold (cut allocate! <> kargs <> <>)
-                                        live-set src-slots dst-syms))
+                                        live-set dst-syms src-slots))
                        (dst-slots (map (cut lookup-slot <> allocation)
                                        dst-syms)))
                   (parallel-move! exp-k


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]