From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 Apr 1987 14:17:28 +0000 (+0000)
Subject: Change rules database so that it is sorted by statement-type.  Treat
X-Git-Tag: 20090517-FFI~13587
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1e30b87a926fe70872d1bcdbd6c23706e513495a;p=mit-scheme.git

Change rules database so that it is sorted by statement-type.  Treat
ASSIGN specially since it is by far the most common type.
---

diff --git a/v7/src/compiler/back/lapgn1.scm b/v7/src/compiler/back/lapgn1.scm
index c1f0a7d7e..6cf0aa6e7 100644
--- a/v7/src/compiler/back/lapgn1.scm
+++ b/v7/src/compiler/back/lapgn1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.27 1987/04/17 10:54:13 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn1.scm,v 1.28 1987/04/24 14:17:28 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -70,10 +70,24 @@ MIT in each case. |#
 (define *cgen-rules*
   '())
 
+(define *assign-rules*
+  '())
+
 (define (add-statement-rule! pattern result-procedure)
-  (set! *cgen-rules*
-	(cons (cons pattern result-procedure)
-	      *cgen-rules*))
+  (let ((result (cons pattern result-procedure)))
+    (if (eq? (car pattern) 'ASSIGN)
+	(let ((entry (assq (caadr pattern) *assign-rules*)))
+	  (if entry
+	      (set-cdr! entry (cons result (cdr entry)))
+	      (set! *assign-rules*
+		    (cons (list (caadr pattern) result)
+			  *assign-rules*))))
+	(let ((entry (assq (car pattern) *cgen-rules*)))
+	  (if entry
+	      (set-cdr! entry (cons result (cdr entry)))
+	      (set! *cgen-rules*
+		    (cons (list (car pattern) result)
+			  *cgen-rules*))))))
   pattern)
 
 (define (cgen-rnode rnode)
@@ -91,7 +105,13 @@ MIT in each case. |#
   (node-mark! rnode)
   ;; LOOP is for easy restart while debugging.
   (let loop ()
-    (let ((match-result (pattern-lookup *cgen-rules* (rnode-rtl rnode))))
+    (let ((match-result
+	   (pattern-lookup
+	    (cdr (or (if (eq? (car (rnode-rtl rnode)) 'ASSIGN)
+			 (assq (caadr (rnode-rtl rnode)) *assign-rules*)
+			 (assq (car (rnode-rtl rnode)) *cgen-rules*))
+		     (error "CGEN-RNODE: Unknown keyword" rnode)))
+	    (rnode-rtl rnode))))
       (if match-result
 	  (fluid-let ((*current-rnode* rnode)
 		      (*dead-registers* (rnode-dead-registers rnode))
@@ -120,9 +140,8 @@ MIT in each case. |#
 	      (delete-pseudo-registers
 	       map
 	       (regset->list
-		(regset-difference
-		 (bblock-live-at-exit (node-bblock previous))
-		 (bblock-live-at-entry (node-bblock rnode))))
+		(regset-difference (bblock-live-at-exit (node-bblock previous))
+				   (bblock-live-at-entry (node-bblock rnode))))
 	       (lambda (map aliases) map))
 	      map)))))