From 85594502a3533aa8c18e644564e4aed6f983b358 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@dino13.iro.umontreal.ca>
Date: Mon, 29 Jun 2009 20:12:28 -0400
Subject: [PATCH] The number of neighbours of each byte-cell is now cached.
 However, this doe snot seem to improve performance, as was expected.

---
 ast.scm                 |  5 +++--
 cte.scm                 |  6 +++---
 register-allocation.scm | 40 ++++++++++++++++++++++++----------------
 3 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/ast.scm b/ast.scm
index b05abad..56a125a 100644
--- a/ast.scm
+++ b/ast.scm
@@ -53,6 +53,7 @@
   name ; to display in the listing
   bb   ; label of the basic in which this byte-cell is used
   (interferes-with   unprintable:)  ; bitset
+  nb-neighbours                     ; cached length of interferes-with
   (coalesceable-with unprintable:)  ; set
   (coalesced-with    unprintable:)) ; set
 (define (new-byte-cell #!optional (name #f) (bb #f))
@@ -60,14 +61,14 @@
 	 (cell (make-byte-cell
 		id (if allocate-registers? #f id)
 		(if name (string-append name "$" (number->string id)) "__tmp")
-		bb #f (new-empty-set) (new-empty-set))))
+		bb #f 0 (new-empty-set) (new-empty-set))))
     (table-set! all-byte-cells id cell)
     cell))
 (define (get-register n)
   (let* ((id   (byte-cell-next-id))
 	 (cell (make-byte-cell
 		id n (symbol->string (cdr (assv n file-reg-names))) #f
-		#f (new-empty-set) (new-empty-set))))
+		#f 0 (new-empty-set) (new-empty-set))))
     (table-set! all-byte-cells id cell)
     cell))
 
diff --git a/cte.scm b/cte.scm
index fd64cd5..8fe3005 100644
--- a/cte.scm
+++ b/cte.scm
@@ -3,8 +3,8 @@
 	  ;; adrs is the list of addresses this variable is stored at
           (new-value (map (lambda (x)
 			    (make-byte-cell
-			     (byte-cell-next-id) x "dummy" #f
-			     #f (new-empty-set) (new-empty-set)))
+			     (byte-cell-next-id) x "dummy" #f #f 0
+			     (new-empty-set) (new-empty-set)))
 			  addresses)))
          (ast
           (new-def-variable '() id '() type value '())))
@@ -14,7 +14,7 @@
 ;;   (let* ((value
 ;;           (cond ((eq? type 'byte) ;; TODO have the other types, or make this generic (this is not actually used anyway)
 ;;                  (new-value (list (make-byte-cell (byte-cell-next-id) WREG
-;; 						  "dummy" #f #f
+;; 						  "dummy" #f #f 0
 ;; 						  (new-empty-set)
 ;; 						  (new-empty-set)))))
 ;;                 ((eq? type 'void)
diff --git a/register-allocation.scm b/register-allocation.scm
index 3d202fc..bd152ca 100644
--- a/register-allocation.scm
+++ b/register-allocation.scm
@@ -171,22 +171,20 @@
 
   ;; change the bitsets to sets, to speed up graph coloring
   (let loop ((l (- (vector-length byte-cells) 1)))
-    (define (cells-bitset->set bs)
-      (let ((n   (fxarithmetic-shift-left (u8vector-length bs) 3))
-	    (set (new-empty-set)))
-	(let loop ((i (- n 1)))
-	  (if (>= i 0)
-	      (begin (if (bitset-member? bs i)
-			 (set-add! set (vector-ref byte-cells i)))
-		     (loop (- i 1)))
-	      set))))
     (if (not (< l 0))
 	(let* ((cell (vector-ref byte-cells l)))
 	  (if cell
-	      (begin
-		(byte-cell-interferes-with-set!
-		 cell
-		 (cells-bitset->set (byte-cell-interferes-with cell)))))
+	      (byte-cell-interferes-with-set!
+	       cell
+	       (let* ((bs  (byte-cell-interferes-with cell))
+		      (n   (fxarithmetic-shift-left (u8vector-length bs) 3))
+		      (set (new-empty-set)))
+		 (let loop ((i (- n 1)))
+		   (if (>= i 0)
+		       (begin (if (bitset-member? bs i)
+				  (set-add! set (vector-ref byte-cells i)))
+			      (loop (- i 1)))
+		       set)))))
 	  (loop (- l 1)))))
   
   all-live)
@@ -196,12 +194,16 @@
 (define (delete byte-cell1 neighbours)
   (set-for-each (lambda (byte-cell2)
 		  (set-remove! (byte-cell-interferes-with byte-cell2)
-			       byte-cell1))
+			       byte-cell1)
+		  (byte-cell-nb-neighbours-set!
+		   byte-cell2 (- (byte-cell-nb-neighbours byte-cell2) 1)))
  		neighbours))
 (define (undelete byte-cell1 neighbours)
   (set-for-each (lambda (byte-cell2)
  		  (set-add! (byte-cell-interferes-with byte-cell2)
- 			    byte-cell1))
+ 			    byte-cell1)
+		  (byte-cell-nb-neighbours-set!
+		   byte-cell2 (+ (byte-cell-nb-neighbours byte-cell2) 1)))
  		neighbours))
 
 (define (coalesce graph)
@@ -293,7 +295,7 @@
         (if (null? lst)
             byte-cell
             (let* ((x (car lst))
-                   (n (set-length (byte-cell-interferes-with x))))
+                   (n (byte-cell-nb-neighbours x)))
               (if (or (not m) (< n m))
                   (loop (cdr lst) n x)
                   (loop (cdr lst) m byte-cell))))))
@@ -309,6 +311,12 @@
             (if (not (byte-cell-adr byte-cell))
                 (color byte-cell)))))
 
+    ;; cache the number of neighbours
+    (for-each (lambda (cell)
+		(byte-cell-nb-neighbours-set!
+		 cell (set-length (byte-cell-interferes-with cell))))
+	      all-live)
+    
     (pp register-allocation:)
     (time (alloc-reg all-live))
     (display (string-append (number->string (+ max-adr 1)) " RAM bytes\n"))))
-- 
2.11.4.GIT