Add a sugraph-color slot to the cfg.

diff --git a/src/compiler/base/cfg1.scm b/src/compiler/base/cfg1.scm
index de1d6f656feac4644495b94f9d994b68cfa2f44c..20e4711447c1c4f4ad81cb994ec9634b45b2fabe 100644 (file)
--- 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 72b6d1d2ae0417e3f3a3b66c1ffc143d522bd4e5..4b0cf0aeff0ade2a27a59583bc7fb7fa88186c84 100644 (file)
--- 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 c26dd8596688d64df76e92b122c5c2d2e223941b..2d1f88eafbb5708b5df25a53c44f7f26b1043b4f 100644 (file)
--- 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)