From: Joe Marshall <eval.apply@gmail.com>
Date: Mon, 16 Jan 2012 15:29:04 +0000 (-0800)
Subject: Add a sugraph-color slot to the cfg.
X-Git-Tag: release-9.2.0~334^2~23
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e6b8b19d96a8f72f3c52437da581fc948638fcc3;p=mit-scheme.git

Add a sugraph-color slot to the cfg.
---

diff --git a/src/compiler/base/cfg1.scm b/src/compiler/base/cfg1.scm
index de1d6f656..20e471144 100644
--- a/src/compiler/base/cfg1.scm
+++ b/src/compiler/base/cfg1.scm
@@ -32,20 +32,20 @@ USA.
 
 (define cfg-node-tag (make-vector-tag #f 'CFG-NODE #f))
 (define cfg-node? (tagged-vector/subclass-predicate cfg-node-tag))
-(define-vector-slots node 1 generation alist previous-edges)
+(define-vector-slots node 1 generation subgraph-color alist previous-edges)
 
 (set-vector-tag-description!
  cfg-node-tag
  (lambda (node)
-   (descriptor-list node node generation alist previous-edges)))
+   (descriptor-list node node generation subgraph-color alist previous-edges)))
 
 (define snode-tag (make-vector-tag cfg-node-tag 'SNODE #f))
 (define snode? (tagged-vector/subclass-predicate snode-tag))
-(define-vector-slots snode 4 next-edge)
+(define-vector-slots snode 5 next-edge)
 
 ;;; converted to a macro.
 ;;; (define (make-snode tag . extra)
-;;;   (list->vector (cons* tag #f '() '() #f extra)))
+;;;   (list->vector (cons* tag #f #f '() '() #f extra)))
 
 (set-vector-tag-description!
  snode-tag
@@ -55,11 +55,11 @@ USA.
 
 (define pnode-tag (make-vector-tag cfg-node-tag 'PNODE #f))
 (define pnode? (tagged-vector/subclass-predicate pnode-tag))
-(define-vector-slots pnode 4 consequent-edge alternative-edge)
+(define-vector-slots pnode 5 consequent-edge alternative-edge)
 
 ;;; converted to a macro.
 ;;; (define (make-pnode tag . extra)
-;;;   (list->vector (cons* tag #f '() '() #f #f extra)))
+;;;   (list->vector (cons* tag #f #f '() '() #f #f extra)))
 
 (set-vector-tag-description!
  pnode-tag
diff --git a/src/compiler/base/macros.scm b/src/compiler/base/macros.scm
index 72b6d1d2a..4b0cf0aef 100644
--- a/src/compiler/base/macros.scm
+++ b/src/compiler/base/macros.scm
@@ -171,8 +171,8 @@ USA.
 						   ,@slots))))))))
 		     (ill-formed-syntax form)))))))))))
 
-(define-type-definition snode 5 #f)
-(define-type-definition pnode 6 #f)
+(define-type-definition snode 6 #f)
+(define-type-definition pnode 7 #f)
 (define-type-definition rvalue 2 rvalue-types)
 (define-type-definition lvalue 14 #f)
 
@@ -214,7 +214,7 @@ USA.
 		(map (lambda (form) (close-syntax form environment))
 		     (cddr form))))
 	   `((ACCESS VECTOR ,system-global-environment)
-	     ,tag #F '() '() #F ,@extra))
+	     ,tag #F #F '() '() #F ,@extra))
 	 (ill-formed-syntax form)))))
 
 (define-syntax make-pnode
@@ -226,7 +226,7 @@ USA.
 		(map (lambda (form) (close-syntax form environment))
 		     (cddr form))))
 	   `((ACCESS VECTOR ,system-global-environment)
-	     ,tag #F '() '() #F #F ,@extra))
+	     ,tag #F #F '() '() #F #F ,@extra))
 	 (ill-formed-syntax form)))))
 
 (define-syntax make-rvalue
diff --git a/src/compiler/rtlbase/rtlcfg.scm b/src/compiler/rtlbase/rtlcfg.scm
index c26dd8596..2d1f88eaf 100644
--- a/src/compiler/rtlbase/rtlcfg.scm
+++ b/src/compiler/rtlbase/rtlcfg.scm
@@ -31,7 +31,7 @@ USA.
 (define-snode sblock)
 (define-pnode pblock)
 
-(define-vector-slots bblock 6
+(define-vector-slots bblock 7
   instructions
   live-at-entry
   live-at-exit
@@ -39,13 +39,13 @@ USA.
   label
   continuations)
 
-(define-vector-slots sblock 12
+(define-vector-slots sblock 13
   continuation)
 
 (define (make-sblock instructions)
   (make-pnode sblock-tag instructions false false false false '() false))
 
-(define-vector-slots pblock 12
+(define-vector-slots pblock 13
   consequent-lap-generator
   alternative-lap-generator)