[Guile-commits] GNU Guile branch, wip-rtl-cps, updated. v2.1.0-177-gb4f139a

[Noah Lavine]

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=b4f139a1f353075520fb444c842bed212b341272

The branch, wip-rtl-cps has been updated
       via  b4f139a1f353075520fb444c842bed212b341272 (commit)
      from  2aeb4f87c345c709e59f5fe402a9379d15587f1a (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 b4f139a1f353075520fb444c842bed212b341272
Author: Noah Lavine <address@hidden>
Date:   Fri Feb 15 23:10:58 2013 -0500

    Clean Up the Register Allocator
    
    * module/language/cps/compile-rtl.scm: code clean-ups in the register
      allocator.

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

Summary of changes:
 module/language/cps/compile-rtl.scm |   93 ++++++++++++++++++----------------
 1 files changed, 49 insertions(+), 44 deletions(-)

diff --git a/module/language/cps/compile-rtl.scm 
b/module/language/cps/compile-rtl.scm
index 058dcf5..921dab2 100644
--- a/module/language/cps/compile-rtl.scm
+++ b/module/language/cps/compile-rtl.scm
@@ -54,22 +54,23 @@
     ;; counter is the number of local variables we've already allocated.
     (record-case cps
       ((<call>) counter)
-                 
+
       ((<lambda> names body)
        ;; TO DO: record which variables will be closure variables.
-       (let iter ((names names)
-                  (counter counter))
-         (if (null? names)
-             (let ((total (visit body counter)))
-               ;; we reserve one more than whatever number of variables
-               ;; we have because we might need an extra space to move
-               ;; variables around. see generate-shuffle below. this
-               ;; doesn't really feel elegant, but I don't have a better
-               ;; solution right now.
-               (set! (nlocals cps) (+ total 1)))
-             (begin
-               (set! (register (car names)) counter)
-               (iter (cdr names) (+ counter 1))))))
+       (let* ((after-names
+               ;; assign register numbers to each argument, starting
+               ;; with 0 and counting up.
+               (fold (lambda (name counter)
+                       (set! (register name) counter)
+                       (1+ counter))
+                     counter names))
+              (total
+               (visit body after-names)))
+         ;; we reserve one more than whatever number of variables we
+         ;; have because we might need an extra space to move variables
+         ;; around. see generate-shuffle below. this doesn't really feel
+         ;; elegant, but I don't have a better solution right now.
+         (set! (nlocals cps) (+ total 1))))
       
       ((<letval> names vals body)
        ;; update the name-defn mapping
@@ -77,14 +78,16 @@
               (set! (name-defn n) c))
             names vals)
 
-       ;; and allocate the registers
-       (let iter ((names names)
-                  (counter counter))
-         (if (null? names)
-             (visit body counter)
-             (begin
-               (set! (register (car names)) counter)
-               (iter (cdr names) (+ counter 1))))))
+       ;; allocate the registers
+       (let ((counter
+              (fold
+               (lambda (name counter)
+                 (set! (register name) counter)
+                 (1+ counter))
+               counter names)))
+
+         ;; and visit the body of the letval
+         (visit body counter)))
       
       ;; an important scoping point: none of the arguments to any of the
       ;; <letcont>'s continuations are in scope for any of the other
@@ -94,18 +97,18 @@
       ;; should try to set up our allocation to avoid unnecessary
       ;; moves.)
       ((<letcont> names conts body)
-       ;; first, allocate some labels
+       ;; allocate labels for the continuations
        (map (lambda (n)
               (set! (label n) (next-label!)))
             names)
-       ;; then the name-defn mapping
+       ;; update the name-defn mapping
        (map (lambda (n c)
               (set! (name-defn n) c))
             names conts)
-       ;; then local variables. we need to return the maximum of the
-       ;; register numbers used so that whatever procedure we're part of
-       ;; will allocate the right number of local variable slots on the
-       ;; stack.
+       ;; then allocate registers for all of the continuations and the
+       ;; body. we need to return the maximum of the register numbers
+       ;; used so that whatever procedure we're part of will allocate
+       ;; the right number of local variable slots on the stack.
        (apply max (visit body counter)
               (map (lambda (c) (visit c counter)) conts)))
       
@@ -115,20 +118,24 @@
       ;; also reference each other, so we should allocate labels for
       ;; them too.
       ((<letrec> names funcs body)
-       (let alloc-funcs ((names names)
-                         (counter counter))
-         (if (not (null? names))
-             (begin
-               (set! (register (car names)) counter)
-               (set! (label (car names)) (next-label!))
-               (alloc-funcs (cdr names) (+ counter 1)))
-             ;; the counter resets to zero for a new lambda because when it's
-             ;; called, only its arguments will be on the stack -
-             ;; everything else will be a closure variable.
-             (let ((alloc-func (lambda (f) (visit f 0))))
-               (map alloc-func funcs)
-               (visit body counter)))))
+       ;; allocate labels for the functions
+       (map
+        (lambda (name)
+          (set! (label name) (next-label!)))
+        names)
 
+       ;; allocate registers *within* the functions
+       (map (lambda (f) (visit f 0)) funcs)
+
+       ;; and allocate registers for the functions and the body
+       (let ((total
+              (fold
+               (lambda (name counter)
+                 (set! (register (car names)) counter)
+                 (1+ counter)))))
+         (visit body counter)
+         counter))
+      
       ;; an if has no interesting content, so we don't need to do
       ;; anything here.
       ((<if> test consequent alternate)
@@ -184,8 +191,6 @@
                       ,(with-alloc body)))
            ((<primitive> name)
             `(primitive ,name))
-           ;; this is sort of an ugly way to show the labels of the
-           ;; if-branches, but I don't have a better one right now.
            ((<if> test consequent alternate)
             `(if ,test ,consequent ,alternate))))))
 


hooks/post-receive
-- 
GNU Guile