From c0cfd32bcb7dd63cbc1332188dd3e6463e18d069 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 14 Mar 2021 09:56:26 -0600
Subject: [PATCH] Chez Scheme: move cp machine-register indirection

Register allocation needs fresh machine-register state for each
compilation, and that was previously implemented by allocating a new
register record and indirecting references through a parameter. Move
the indirection to the places where conflict-set, index, and precolor
state is manipulated, and pass a state vector though to keep access
efficient. This change makes compilation slightly faster, and it makes
registers easier to work with by not having to introduce
indirections/delays in various places for register references.
---
 racket/src/ChezScheme/s/arm64.ss        |  10 +-
 racket/src/ChezScheme/s/cpnanopass.ss   | 230 ++++++++++++------------
 racket/src/ChezScheme/s/np-info.ss      |  35 ++--
 racket/src/ChezScheme/s/np-languages.ss |  97 +++++++++-
 racket/src/ChezScheme/s/np-register.ss  |  50 ++----
 racket/src/ChezScheme/s/x86_64.ss       |  22 ++-
 6 files changed, 256 insertions(+), 188 deletions(-)

diff --git a/racket/src/ChezScheme/s/arm64.ss b/racket/src/ChezScheme/s/arm64.ss
index 5dbd73b93f..2dae4637b6 100644
--- a/racket/src/ChezScheme/s/arm64.ss
+++ b/racket/src/ChezScheme/s/arm64.ss
@@ -2408,10 +2408,10 @@
 		    (or (andmap double-member? members)
 			(andmap float-member? members)))))]
 	[else #f]))
-    (define int-argument-regs (lambda () (list %Carg1 %Carg2 %Carg3 %Carg4
-                                               %Carg5 %Carg6 %Carg7 %Carg8)))
-    (define fp-argument-regs (lambda () (list %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4
-                                              %Cfparg5 %Cfparg6 %Cfparg7 %Cfparg8)))
+    (define int-argument-regs (list %Carg1 %Carg2 %Carg3 %Carg4
+                                    %Carg5 %Carg6 %Carg7 %Carg8))
+    (define fp-argument-regs (list %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4
+                                   %Cfparg5 %Cfparg6 %Cfparg7 %Cfparg8))
     (define save-and-restore
       (lambda (regs e)
         (safe-assert (andmap reg? regs))
@@ -2499,7 +2499,7 @@
 
     (define categorize-arguments
       (lambda (types varargs-after)
-        (let loop ([types types] [int* (int-argument-regs)] [fp* (fp-argument-regs)]
+        (let loop ([types types] [int* int-argument-regs] [fp* fp-argument-regs]
                    [varargs-after varargs-after]
                    ;; accumulate alignment from previous args so we can compute any
                    ;; needed padding and alignment after this next argument
diff --git a/racket/src/ChezScheme/s/cpnanopass.ss b/racket/src/ChezScheme/s/cpnanopass.ss
index 6b6a8778bd..cdf04166fe 100644
--- a/racket/src/ChezScheme/s/cpnanopass.ss
+++ b/racket/src/ChezScheme/s/cpnanopass.ss
@@ -8473,6 +8473,7 @@
       (define-threaded max-fv)
       (define-threaded max-fs@call)
       (define-threaded poison-cset)
+      (define-threaded current-reg-spillinfo)
 
       (define no-live* empty-tree)
 
@@ -8486,18 +8487,18 @@
           (tree-same? live1 live2)))
 
       (define live?
-        (lambda (live* live-size x)
-          (tree-bit-set? live* live-size (var-index x))))
+        (lambda (live* live-size x reg-spillinfo)
+          (tree-bit-set? live* live-size (var-index x reg-spillinfo))))
 
       (define get-live-vars
         (lambda (live* live-size v)
           (tree-extract live* live-size v)))
 
       (define make-add-var
-        (lambda (live-size)
+        (lambda (live-size reg-spillinfo)
           ; add x to live*.  result is eq? to live* if x is already in live*.
           (lambda (live* x)
-            (let ([index (var-index x)])
+            (let ([index (var-index x reg-spillinfo)])
               (if index
                   (let ([new (tree-bit-set live* live-size index)])
                     (safe-assert (or (eq? new live*) (not (tree-same? new live*))))
@@ -8506,11 +8507,11 @@
 
       (define make-remove-var
         ; remove x from live*.  result is eq? to live* if x is not in live*.
-        (lambda (live-size)
+        (lambda (live-size reg-spillinfo)
           (lambda (live* x)
-            (let ([index (var-index x)])
+            (let ([index (var-index x reg-spillinfo)])
               (if index
-                  (let ([new (tree-bit-unset live* live-size (var-index x))])
+                  (let ([new (tree-bit-unset live* live-size (var-index x reg-spillinfo))])
                     (safe-assert (or (eq? new live*) (not (tree-same? new live*))))
                     new)
                   live*)))))
@@ -8580,9 +8581,9 @@
             [(1) #t])))
 
       (define do-live-analysis!
-        (lambda (live-size entry-block*)
-          (define add-var (make-add-var live-size))
-          (define remove-var (make-remove-var live-size))
+        (lambda (live-size entry-block* reg-spillinfo)
+          (define add-var (make-add-var live-size reg-spillinfo))
+          (define remove-var (make-remove-var live-size reg-spillinfo))
           (define-who scan-block
             ; if we maintain a list of kills and a list of useless variables for
             ; each block, and we discover on entry to scan-block that the useless
@@ -8638,7 +8639,7 @@
                     (lambda (out instr)
                       (nanopass-case (L15a Effect) instr
                         [(set! ,live-info ,x ,rhs)
-                         (if (var-index x)
+                         (if (var-index x reg-spillinfo)
                              (let ([new-out (remove-var out x)])
                                (if (and (eq? new-out out)
                                         (nanopass-case (L15a Rhs) rhs
@@ -8888,11 +8889,11 @@
                   (refine (fxsrl skip 1) skip)))))))
 
       (define-who do-spillable-conflict!
-        (lambda (kspillable kfv varvec live-size block*)
-          (define remove-var (make-remove-var live-size))
+        (lambda (kspillable reg-spillinfo kfv varvec live-size block*)
+          (define remove-var (make-remove-var live-size reg-spillinfo))
           (define add-move!
             (lambda (x1 x2)
-              (when (var-index x2)
+              (when (var-index x2 reg-spillinfo)
                 ($add-move! x1 x2 2)
                 ($add-move! x2 x1 2))))
           (define add-conflict!
@@ -8900,14 +8901,14 @@
               ; invariants:
               ;   all poison spillables explicitly point to all spillables
               ;   all non-poison spillables implicitly point to all poison spillables via poison-cset
-              (let ([x-offset (var-index x)])
+              (let ([x-offset (var-index x reg-spillinfo)])
                 (when x-offset
                   (if (and (fx< x-offset kspillable) (uvar-poison? x))
                       (tree-for-each out live-size kspillable (fx+ kspillable kfv)
                         (lambda (y-offset)
                           ; frame y -> poison spillable x
-                          (conflict-bit-set! (var-spillable-conflict* (vector-ref varvec y-offset)) x-offset)))
-                      (let ([cset (var-spillable-conflict* x)])
+                          (conflict-bit-set! (var-spillable-conflict* (vector-ref varvec y-offset) reg-spillinfo) x-offset)))
+                      (let ([cset (var-spillable-conflict* x reg-spillinfo)])
                         (if (fx< x-offset kspillable)
                             (begin
                               (tree-for-each out live-size 0 kspillable
@@ -8917,12 +8918,12 @@
                                       ; non-poison spillable x -> non-poison spillable y
                                       (conflict-bit-set! cset y-offset)
                                       ; and vice versa
-                                      (conflict-bit-set! (var-spillable-conflict* y) x-offset)))))
+                                      (conflict-bit-set! (var-spillable-conflict* y reg-spillinfo) x-offset)))))
                               (tree-for-each out live-size kspillable live-size
                                 (lambda (y-offset)
                                   (let ([y (vector-ref varvec y-offset)])
                                     ; frame or register y -> non-poison spillable x
-                                    (conflict-bit-set! (var-spillable-conflict* y) x-offset)))))
+                                    (conflict-bit-set! (var-spillable-conflict* y reg-spillinfo) x-offset)))))
                             (if (fx< x-offset (fx+ kspillable kfv))
                                 (tree-for-each out live-size 0 kspillable
                                   (lambda (y-offset)
@@ -8947,8 +8948,8 @@
                  (if (live-info-useless live-info)
                      new-effect*
                      (let ([live (live-info-live live-info)])
-                       (when (var-index x)
-                         (if (and (var? rhs) (var-index rhs))
+                       (when (var-index x reg-spillinfo)
+                         (if (and (var? rhs) (var-index rhs reg-spillinfo))
                              (begin
                                (add-conflict! x (remove-var live rhs))
                                (add-move! x rhs))
@@ -8970,11 +8971,11 @@
                     (conflict-bit-set! poison-cset i)
                     ; leaving each poison spillable in conflict with itself, but this shouldn't matter
                     ; since we never ask for the degree of a poison spillable
-                    (var-spillable-conflict*-set! x (make-full-cset kspillable)))
-                  (var-spillable-conflict*-set! x (make-empty-cset kspillable)))))
+                    (var-spillable-conflict*-set! x reg-spillinfo (make-full-cset kspillable)))
+                  (var-spillable-conflict*-set! x reg-spillinfo (make-empty-cset kspillable)))))
           (do ([i kspillable (fx+ i 1)])
               ((fx= i live-size))
-            (var-spillable-conflict*-set! (vector-ref varvec i) (make-empty-cset kspillable)))
+            (var-spillable-conflict*-set! (vector-ref varvec i) reg-spillinfo (make-empty-cset kspillable)))
           (for-each
             (lambda (block)
               (block-effect*-set! block
@@ -8982,15 +8983,15 @@
             block*)))
 
       (define-who show-conflicts
-        (lambda (name varvec unvarvec)
+        (lambda (name varvec unvarvec reg-spillinfo)
           (define any? #f)
           (printf "\n~s conflicts:" name)
           (for-each
             (lambda (x)
               (let ([ls (append
-                          (let ([cset (var-spillable-conflict* x)])
+                          (let ([cset (var-spillable-conflict* x reg-spillinfo)])
                             (if cset (extract-conflicts cset varvec) '()))
-                          (let ([cset (var-unspillable-conflict* x)])
+                          (let ([cset (var-unspillable-conflict* x reg-spillinfo)])
                             (if cset (extract-conflicts cset unvarvec) '())))])
                 (unless (null? ls) (set! any? #t) (printf "\n~s:~{ ~s~}" x ls))))
             (append spillable* unspillable* (vector->list regvec) (map get-fv (iota (fx+ max-fv 1)))))
@@ -8999,19 +9000,19 @@
 
       (module (assign-frame! assign-new-frame!)
         (define update-conflict!
-          (lambda (fv spill)
-            (let ([cset1 (var-spillable-conflict* fv)]
-                  [cset2 (var-spillable-conflict* spill)])
+          (lambda (fv spill reg-spillinfo)
+            (let ([cset1 (var-spillable-conflict* fv reg-spillinfo)]
+                  [cset2 (var-spillable-conflict* spill reg-spillinfo)])
               (if cset1
                   (cset-merge! cset1 cset2)
                   ; tempting to set to cset2 rather than (cset-copy cset2), but this would not be
                   ; correct for local saves, which need their unaltered sets for later, and copying
                   ; is cheap anyway.
-                  (var-spillable-conflict*-set! fv (cset-copy cset2))))
-            (unless (uvar-poison? spill) (cset-merge! (var-spillable-conflict* fv) poison-cset))))
+                  (var-spillable-conflict*-set! fv reg-spillinfo (cset-copy cset2))))
+            (unless (uvar-poison? spill) (cset-merge! (var-spillable-conflict* fv reg-spillinfo) poison-cset))))
 
         (define assign-frame!
-          (lambda (spill*)
+          (lambda (spill* reg-spillinfo)
             (define sort-spill*
               ; NB: sorts based on likelihood of successfully assigning move-related vars to the same location
               ; NB: probably should sort based on value of assigning move-related vars to the same location,
@@ -9035,8 +9036,8 @@
               (lambda (x0 succ fail)
                 (define conflict-fv?
                   (lambda (x fv)
-                    (let ([cset (var-spillable-conflict* fv)])
-                      (and cset (conflict-bit-set? cset (var-index x))))))
+                    (let ([cset (var-spillable-conflict* fv reg-spillinfo)])
+                      (and cset (conflict-bit-set? cset (var-index x reg-spillinfo))))))
                 (let f ([x x0] [work* '()] [clear-seen! void])
                   (if (uvar-seen? x)
                       (if (null? work*) (begin (clear-seen!) (fail)) (f (car work*) (cdr work*) clear-seen!))
@@ -9067,7 +9068,7 @@
                   (lambda (home max-fv first-open)
                     (safe-assert (compatible-fv? home (uvar-type spill)))
                     (uvar-location-set! spill home)
-                    (update-conflict! home spill)
+                    (update-conflict! home spill reg-spillinfo)
                     (let ([max-fv
                            (constant-case ptr-bits
                              [(32)
@@ -9084,14 +9085,14 @@
                   (lambda (home) (return home max-fv first-open))
                   (lambda ()
                     (let f ([first-open first-open])
-                      (let* ([fv (get-fv first-open (uvar-type spill))] [cset (var-spillable-conflict* fv)])
+                      (let* ([fv (get-fv first-open (uvar-type spill))] [cset (var-spillable-conflict* fv reg-spillinfo)])
                         (if (and cset (cset-full? cset))
                             (f (fx+ first-open 1))
-                            (let ([spill-offset (var-index spill)])
+                            (let ([spill-offset (var-index spill reg-spillinfo)])
                               (let f ([fv-offset first-open] [fv fv] [cset cset])
                                 (if (or (and cset (conflict-bit-set? cset spill-offset))
                                         (not (compatible-fv? fv (uvar-type spill))))
-                                    (let* ([fv-offset (fx+ fv-offset 1)] [fv (get-fv fv-offset (uvar-type spill))] [cset (var-spillable-conflict* fv)])
+                                    (let* ([fv-offset (fx+ fv-offset 1)] [fv (get-fv fv-offset (uvar-type spill))] [cset (var-spillable-conflict* fv reg-spillinfo)])
                                       (f fv-offset fv cset))
                                     (return fv (fxmax fv-offset max-fv) first-open)))))))))))
             (define find-homes!
@@ -9106,9 +9107,9 @@
             ; live across only a few (only when setup-nfv?)
             (set! max-fv (find-homes! (sort-spill* spill*) max-fv 1))))
 
-        (define-pass assign-new-frame! : (L15a Dummy) (ir lambda-info live-size varvec block*) -> (L15b Dummy) ()
+        (define-pass assign-new-frame! : (L15a Dummy) (ir lambda-info live-size varvec reg-spillinfo block*) -> (L15b Dummy) ()
           (definitions
-            (define remove-var (make-remove-var live-size))
+            (define remove-var (make-remove-var live-size reg-spillinfo))
             (define find-max-fv
               (lambda (call-live*)
                 (fold-left
@@ -9122,8 +9123,8 @@
                       (and (or (not (car nfv*))
                                (let ([fv (get-fv offset)])
                                  (and (compatible-fv? fv 'ptr)
-                                      (let ([cset (var-spillable-conflict* fv)])
-                                        (not (and cset (conflict-bit-set? cset (var-index (car nfv*)))))))))
+                                      (let ([cset (var-spillable-conflict* fv reg-spillinfo)])
+                                        (not (and cset (conflict-bit-set? cset (var-index (car nfv*) reg-spillinfo))))))))
                            (loop (cdr nfv*) (fx+ offset 1)))))))
             (define assign-new-frame!
               (lambda (cnfv* nfv** call-live*)
@@ -9134,7 +9135,7 @@
                         (let* ([nfv (car nfv*)] [home (get-fv offset (uvar-type nfv))])
                           (safe-assert (compatible-fv? home (uvar-type nfv)))
                           (uvar-location-set! nfv home)
-                          (update-conflict! home nfv)
+                          (update-conflict! home nfv reg-spillinfo)
                           (set-offsets! (cdr nfv*) (fx+ offset 1))))))
                 (let ([arg-offset (fx+ (length cnfv*) 1)]) ; +1 for return address slot
                   (let loop ([base (fx+ (find-max-fv call-live*) 1)])
@@ -9246,7 +9247,7 @@
             [(restore-local-saves ,live-info ,info)
              (with-output-language (L15b Effect)
                (let ([live (live-info-live live-info)])
-                 (let loop ([x* (filter (lambda (x) (live? live live-size x)) (info-newframe-local-save* info))]
+                 (let loop ([x* (filter (lambda (x) (live? live live-size x reg-spillinfo)) (info-newframe-local-save* info))]
                             [live live]
                             [new-effect* new-effect*])
                    (if (null? x*)
@@ -9292,7 +9293,8 @@
                       [(newframe-block? block)
                        (let ([info (newframe-block-info block)])
                          (process-info-newframe! info)
-                         (safe-assert (andmap (lambda (x) (live? (newframe-block-live-call block) live-size x)) (info-newframe-local-save* info)))
+                         (safe-assert (andmap (lambda (x) (live? (newframe-block-live-call block) live-size x reg-spillinfo))
+                                              (info-newframe-local-save* info)))
                          (with-output-language (L15b Effect)
                            (let ([live (newframe-block-live-out block)])
                              (fold-left
@@ -9415,7 +9417,8 @@
         (define make-restricted-unspillable
           (lambda (x reg*)
             (import (only np-languages make-restricted-unspillable))
-            (safe-assert (andmap reg? reg*) (andmap var-index reg*))
+            (safe-assert (andmap reg? reg*)
+                         (andmap (lambda (r) (var-index r current-reg-spillinfo)) reg*))
             (let ([tmp (make-restricted-unspillable x reg*)])
               (set! unspillable* (cons tmp unspillable*))
               tmp)))
@@ -9425,11 +9428,12 @@
           ; for correct code but causes a spilled unspillable error if we try to use the same
           ; machine register for two conflicting variables
           (lambda (name reg)
-            (or (reg-precolored reg)
-                (let ([tmp (make-restricted-unspillable name (remq reg (vector->list regvec)))])
-                  (safe-assert (memq reg (vector->list regvec)))
-                  (reg-precolored-set! reg tmp)
-                  tmp))))
+            (let ([reg-spillinfo current-reg-spillinfo])
+              (or (reg-precolored reg reg-spillinfo)
+                  (let ([tmp (make-restricted-unspillable name (remq reg (vector->list regvec)))])
+                    (safe-assert (memq reg (vector->list regvec)))
+                    (reg-precolored-set! reg reg-spillinfo tmp)
+                    tmp)))))
 
         (define-syntax build-set!
           (lambda (x)
@@ -9737,10 +9741,10 @@
               [(k context (sym ...) cl ...) #'(k context (sym ...) (definitions) cl ...)]
               [(k context sym cl ...) (identifier? #'sym) #'(k context (sym) (definitions) cl ...)])))
 
-        (define-pass select-instructions! : (L15c Dummy) (ir block* live-size force-overflow?) -> (L15d Dummy) ()
+        (define-pass select-instructions! : (L15c Dummy) (ir block* live-size reg-spillinfo force-overflow?) -> (L15d Dummy) ()
           (definitions
             (module (handle-jump handle-effect-inline handle-pred-inline handle-value-inline)
-              (define add-var (make-add-var live-size))
+              (define add-var (make-add-var live-size reg-spillinfo))
               (define Triv
                 (lambda (out t)
                   (nanopass-case (L15d Triv) t
@@ -9927,8 +9931,8 @@
       )
 
       (define-who do-unspillable-conflict!
-        (lambda (kfv kspillable varvec live-size kunspillable unvarvec block*)
-          (define remove-var (make-remove-var live-size))
+        (lambda (kfv kspillable reg-spillinfo varvec live-size kunspillable unvarvec block*)
+          (define remove-var (make-remove-var live-size reg-spillinfo))
           (define unspillable?
             (lambda (x)
               (and (uvar? x) (uvar-unspillable? x))))
@@ -9941,26 +9945,26 @@
                   unspillable*)))
           (define add-move!
             (lambda (x1 x2)
-              (when (var-index x2)
+              (when (var-index x2 reg-spillinfo)
                 ($add-move! x1 x2 2)
                 ($add-move! x2 x1 2))))
           (define add-move-hint!
             (lambda (x1 x2)
-              (when (var-index x2)
+              (when (var-index x2 reg-spillinfo)
                 ($add-move! x1 x2 1)
                 ($add-move! x2 x1 1))))
           (define add-static-conflict!
             (lambda (u reg*)
-              (let ([u-offset (var-index u)])
+              (let ([u-offset (var-index u reg-spillinfo)])
                 (for-each
-                  (lambda (reg) (conflict-bit-set! (var-unspillable-conflict* reg) u-offset))
+                  (lambda (reg) (conflict-bit-set! (var-unspillable-conflict* reg reg-spillinfo) u-offset))
                   reg*))))
           (define add-us->s-conflicts!
             (lambda (x out) ; x is an unspillable
-              (let ([x-offset (var-index x)] [cset (var-spillable-conflict* x)])
+              (let ([x-offset (var-index x reg-spillinfo)] [cset (var-spillable-conflict* x reg-spillinfo)])
                 (tree-for-each out live-size 0 live-size
                   (lambda (y-offset)
-                    (let* ([y (vector-ref varvec y-offset)] [y-cset (var-unspillable-conflict* y)])
+                    (let* ([y (vector-ref varvec y-offset)] [y-cset (var-unspillable-conflict* y reg-spillinfo)])
                       (when y-cset
                         ; if y is a spillable, point the unspillable x at y
                         (when (fx< y-offset kspillable) (conflict-bit-set! cset y-offset))
@@ -9968,23 +9972,23 @@
                         (conflict-bit-set! y-cset x-offset))))))))
           (define add-us->us-conflicts!
             (lambda (x unspillable*) ; x is a unspillable
-              (let ([x-offset (var-index x)] [cset (var-unspillable-conflict* x)])
+              (let ([x-offset (var-index x reg-spillinfo)] [cset (var-unspillable-conflict* x reg-spillinfo)])
                 (for-each
                   (lambda (y)
-                    (let ([y-offset (var-index y)])
+                    (let ([y-offset (var-index y reg-spillinfo)])
                       (conflict-bit-set! cset y-offset)
-                      (conflict-bit-set! (var-unspillable-conflict* y) x-offset)))
+                      (conflict-bit-set! (var-unspillable-conflict* y reg-spillinfo) x-offset)))
                   unspillable*))))
           (define add-s->us-conflicts!
             (lambda (x unspillable*) ; x is a spillable or register
-              (let ([x-offset (var-index x)] [cset (var-unspillable-conflict* x)])
+              (let ([x-offset (var-index x reg-spillinfo)] [cset (var-unspillable-conflict* x reg-spillinfo)])
                 (for-each
                   (lambda (y)
-                    (let ([y-offset (var-index y)])
+                    (let ([y-offset (var-index y reg-spillinfo)])
                       ; point x at unspillable y
                       (conflict-bit-set! cset y-offset)
                       ; if x is a spillable, point unspillable y at x
-                      (when (fx< x-offset kspillable) (conflict-bit-set! (var-spillable-conflict* y) x-offset))))
+                      (when (fx< x-offset kspillable) (conflict-bit-set! (var-spillable-conflict* y reg-spillinfo) x-offset))))
                   unspillable*))))
           (define Triv
             (lambda (unspillable* t)
@@ -10021,7 +10025,7 @@
                              (let ([unspillable* (remq x unspillable*)])
                                (safe-assert (uvar-seen? x))
                                (uvar-seen! x #f)
-                               (if (and (var? rhs) (var-index rhs))
+                               (if (and (var? rhs) (var-index rhs reg-spillinfo))
                                    (begin
                                      (if (unspillable? rhs)
                                          (begin
@@ -10036,7 +10040,7 @@
                                      (add-us->s-conflicts! x spillable-live)))
                                (Rhs unspillable* rhs))
                              (begin
-                               (when (var-unspillable-conflict* x)
+                               (when (var-unspillable-conflict* x reg-spillinfo)
                                  (if (unspillable? rhs)
                                      (begin
                                        (add-s->us-conflicts! x (remq rhs unspillable*))
@@ -10048,8 +10052,8 @@
                       [(move-related ,x1 ,x2) (add-move-hint! x1 x2) unspillable*]
                       [(overflow-check ,p ,e* ...) (Effect* (reverse e*) '()) (Pred p)]
                       [else unspillable*])))))
-          (for-each (lambda (x) (var-spillable-conflict*-set! x (make-empty-cset kspillable))) unspillable*)
-          (let ([f (lambda (x) (var-unspillable-conflict*-set! x (make-empty-cset kunspillable)))])
+          (for-each (lambda (x) (var-spillable-conflict*-set! x reg-spillinfo (make-empty-cset kspillable))) unspillable*)
+          (let ([f (lambda (x) (var-unspillable-conflict*-set! x reg-spillinfo (make-empty-cset kunspillable)))])
             (vector-for-each f regvec)
             (for-each f spillable*)
             (vector-for-each f unvarvec))
@@ -10065,7 +10069,7 @@
             block*)))
 
       (define-who assign-registers!
-        (lambda (lambda-info varvec unvarvec)
+        (lambda (lambda-info varvec unvarvec reg-spillinfo)
           (define total-k (vector-length regvec))
           (define fp-k (length extra-fpregisters))
           (define ptr-k (- total-k fp-k))
@@ -10089,18 +10093,18 @@
                   (uvar-degree-set! x
                     (fx+
                       ; spills have been trimmed from the var-spillable-conflict* sets
-                      (conflict-bit-count (var-spillable-conflict* x))
-                      (conflict-bit-count (var-unspillable-conflict* x)))))
+                      (conflict-bit-count (var-spillable-conflict* x reg-spillinfo))
+                      (conflict-bit-count (var-unspillable-conflict* x reg-spillinfo)))))
                 x*)
               ; account for reg -> uvar conflicts
               (vector-for-each
                 (lambda (reg)
-                  (cset-for-each (var-spillable-conflict* reg)
+                  (cset-for-each (var-spillable-conflict* reg reg-spillinfo)
                     (lambda (x-offset)
                       (let ([x (vector-ref varvec x-offset)])
                         (unless (uvar-location x)
                           (uvar-degree-set! x (fx+ (uvar-degree x) 1))))))
-                  (cset-for-each (var-unspillable-conflict* reg)
+                  (cset-for-each (var-unspillable-conflict* reg reg-spillinfo)
                     (lambda (x-offset)
                       (let ([x (vector-ref unvarvec x-offset)])
                         (uvar-degree-set! x (fx+ (uvar-degree x) 1))))))
@@ -10110,8 +10114,8 @@
               (define conflict?
                 (lambda (reg x)
                   (or (not (compatible-var-types? (reg-type reg) (uvar-type x)))
-                      (let ([cset (if (uvar-unspillable? x) (var-unspillable-conflict* reg) (var-spillable-conflict* reg))])
-                        (conflict-bit-set? cset (var-index x))))))
+                      (let ([cset (if (uvar-unspillable? x) (var-unspillable-conflict* reg reg-spillinfo) (var-spillable-conflict* reg reg-spillinfo))])
+                        (conflict-bit-set? cset (var-index x reg-spillinfo))))))
               (define find-move-related-home
                 (lambda (x0 succ fail)
                   (let f ([x x0] [work* '()] [clear-seen! void])
@@ -10140,8 +10144,8 @@
                 (lambda (home)
                   (define update-conflict!
                     (lambda (reg x)
-                      (cset-merge! (var-spillable-conflict* reg) (var-spillable-conflict* x))
-                      (cset-merge! (var-unspillable-conflict* reg) (var-unspillable-conflict* x))))
+                      (cset-merge! (var-spillable-conflict* reg reg-spillinfo) (var-spillable-conflict* x reg-spillinfo))
+                      (cset-merge! (var-unspillable-conflict* reg reg-spillinfo) (var-unspillable-conflict* x reg-spillinfo))))
                   (uvar-location-set! x home)
                   (update-conflict! home x)))
               (find-move-related-home x
@@ -10177,11 +10181,11 @@
                     (values x (remq x x*)))))
               (define remove-victim!
                 (lambda (victim)
-                  (cset-for-each (var-spillable-conflict* victim)
+                  (cset-for-each (var-spillable-conflict* victim reg-spillinfo)
                     (lambda (offset)
                       (let ([x (vector-ref varvec offset)])
                         (uvar-degree-set! x (fx- (uvar-degree x) 1)))))
-                  (cset-for-each (var-unspillable-conflict* victim)
+                  (cset-for-each (var-unspillable-conflict* victim reg-spillinfo)
                     (lambda (offset)
                       (let ([x (vector-ref unvarvec offset)])
                         (uvar-degree-set! x (fx- (uvar-degree x) 1)))))))
@@ -10438,16 +10442,17 @@
                    [(_ ?unparser pass-name ?arg ...)
                     #'(xpass pass-name (RAprinter ?unparser) (list ?arg ...))]))))
            (safe-assert (andmap (lambda (x) (eq? (uvar-location x) #f)) local*))
-           (let ([kspillable (length local*)] [kfv (fx+ max-fv0 1)] [kreg (vector-length regvec)])
-             (fluid-let ([spillable* local*] [unspillable* '()] [max-fv max-fv0] [max-fs@call 0] [poison-cset (make-empty-cset kspillable)])
+           (let ([kspillable (length local*)] [kfv (fx+ max-fv0 1)] [kreg (vector-length regvec)] [reg-spillinfo (make-reg-spillinfo)])
+             (fluid-let ([spillable* local*] [unspillable* '()] [max-fv max-fv0] [max-fs@call 0]
+                         [poison-cset (make-empty-cset kspillable)] [current-reg-spillinfo reg-spillinfo])
                (let* ([live-size (fx+ kfv kreg kspillable)] [varvec (make-vector live-size)])
                  ; set up var indices & varvec mapping from indices to vars
                  (fold-left (lambda (i x) (var-index-set! x i) (vector-set! varvec i x) (fx+ i 1)) 0 spillable*)
                  (do ([i 0 (fx+ i 1)]) ((fx= i kfv)) (let ([fv (get-fv i)] [i (fx+ i kspillable)]) (var-index-set! fv i) (vector-set! varvec i fv)))
-                 (do ([i 0 (fx+ i 1)]) ((fx= i kreg)) (let ([reg (vector-ref regvec i)] [i (fx+ i kspillable kfv)]) (var-index-set! reg i) (vector-set! varvec i reg)))
+                 (do ([i 0 (fx+ i 1)]) ((fx= i kreg)) (let ([reg (vector-ref regvec i)] [i (fx+ i kspillable kfv)]) (var-index-set! reg reg-spillinfo i) (vector-set! varvec i reg)))
                  (with-live-info-record-writer live-size varvec
                    ; run intra/inter-block live analysis
-                   (RApass unparse-L15a do-live-analysis! live-size entry-block*)
+                   (RApass unparse-L15a do-live-analysis! live-size entry-block* reg-spillinfo)
                    ; this is worth enabling from time to time...
                    #;(check-entry-live! (info-lambda-name info) live-size varvec entry-block*)
                    ; rerun intra-block live analysis and record (fv v reg v spillable) x spillable conflicts
@@ -10455,64 +10460,64 @@
                    ;; NB: we could just use (vector-length varvec) to get live-size
                    (when (fx> kspillable 1000) ; NB: parameter?
                      (RApass unparse-L15a identify-poison! kspillable varvec live-size block*))
-                   (RApass unparse-L15a do-spillable-conflict! kspillable kfv varvec live-size block*)
-                   #;(show-conflicts (info-lambda-name info) varvec '#())
+                   (RApass unparse-L15a do-spillable-conflict! kspillable reg-spillinfo kfv varvec live-size block*)
+                   #;(show-conflicts (info-lambda-name info) varvec '#() reg-spillinfo)
                    ; find frame homes for call-live variables; adds new fv x spillable conflicts
-                   (RApass unparse-L15a assign-frame! (filter uvar-spilled? spillable*))
+                   (RApass unparse-L15a assign-frame! (filter uvar-spilled? spillable*) reg-spillinfo)
                    #;(show-homes)
                    (RApass unparse-L15a record-inspector-information! info)
                    ; determine frame sizes at nontail-call sites and assign homes to new-frame variables
                    ; adds new fv x spillable conflicts
-                   (let ([dummy (RApass unparse-L15b assign-new-frame! (with-output-language (L15a Dummy) `(dummy)) info live-size varvec block*)])
+                   (let ([dummy (RApass unparse-L15b assign-new-frame! (with-output-language (L15a Dummy) `(dummy)) info live-size varvec reg-spillinfo block*)])
                      ; record fp offset on entry to each block
                      (RApass unparse-L15b record-fp-offsets! entry-block*)
                      ; assign frame homes to poison variables
                      (let ([spill* (filter (lambda (x) (and (not (uvar-location x)) (uvar-poison? x))) spillable*)])
                        (unless (null? spill*)
                          (for-each (lambda (x) (uvar-spilled! x #t)) spill*)
-                         (RApass unparse-L15b assign-frame! spill*)))
+                         (RApass unparse-L15b assign-frame! spill* reg-spillinfo)))
                      ; on entry to loop, have assigned call-live and new-frame variables to frame homes, determined frame sizes, and computed block-entry fp offsets
-                     (let ([saved-reg-csets (vector-map (lambda (reg) (cset-copy (var-spillable-conflict* reg))) regvec)]
+                     (let ([saved-reg-csets (vector-map (lambda (reg) (cset-copy (var-spillable-conflict* reg reg-spillinfo))) regvec)]
                            [bcache* (map cache-block-info block*)])
                        (let loop ()
                          (for-each
                            (lambda (spill)
                              ; remove each spill from each other spillable's spillable conflict set
                              (unless (uvar-poison? spill)
-                               (let ([spill-index (var-index spill)])
-                                 (cset-for-each (var-spillable-conflict* spill)
+                               (let ([spill-index (var-index spill reg-spillinfo)])
+                                 (cset-for-each (var-spillable-conflict* spill reg-spillinfo)
                                    (lambda (i)
                                      (let ([x (vector-ref varvec i)])
                                        (unless (uvar-location x)
-                                         (conflict-bit-unset! (var-spillable-conflict* x) spill-index)))))))
+                                         (conflict-bit-unset! (var-spillable-conflict* x reg-spillinfo) spill-index)))))))
                              ; release the spill's conflict* set
-                             (var-spillable-conflict*-set! spill #f))
+                             (var-spillable-conflict*-set! spill reg-spillinfo #f))
                            (filter uvar-location spillable*))
                          (set! spillable* (remp uvar-location spillable*))
                          (let ([saved-move* (map uvar-move* spillable*)])
                            #;(show-homes)
                            (let ([dummy (RApass unparse-L15c finalize-frame-locations! dummy block*)])
-                             (let ([dummy (RApass unparse-L15d select-instructions! dummy block* live-size
+                             (let ([dummy (RApass unparse-L15d select-instructions! dummy block* live-size reg-spillinfo
                                             (let ([libspec (info-lambda-libspec info)])
                                               (and libspec (libspec-does-not-expect-headroom? libspec))))])
-                               (vector-for-each (lambda (reg) (reg-precolored-set! reg #f)) regvec)
+                               (vector-for-each (lambda (reg) (reg-precolored-set! reg reg-spillinfo #f)) regvec)
                                (let* ([kunspillable (length unspillable*)] [unvarvec (make-vector kunspillable)])
                                  ; set up var indices & unvarvec mapping from indices to unspillables
-                                 (fold-left (lambda (i x) (var-index-set! x i) (vector-set! unvarvec i x) (fx+ i 1)) 0 unspillable*)
+                                 (fold-left (lambda (i x) (var-index-set! x reg-spillinfo i) (vector-set! unvarvec i x) (fx+ i 1)) 0 unspillable*)
                                  ; select-instrcutions! kept intra-block live analysis up-to-date, so now
                                  ; record (reg v spillable v unspillable) x unspillable conflicts
-                                 (RApass unparse-L15d do-unspillable-conflict! kfv kspillable varvec live-size kunspillable unvarvec block*)
-                                 #;(show-conflicts (info-lambda-name info) varvec unvarvec)
-                                 (RApass unparse-L15d assign-registers! info varvec unvarvec)
+                                 (RApass unparse-L15d do-unspillable-conflict! kfv kspillable reg-spillinfo varvec live-size kunspillable unvarvec block*)
+                                 #;(show-conflicts (info-lambda-name info) varvec unvarvec reg-spillinfo)
+                                 (RApass unparse-L15d assign-registers! info varvec unvarvec reg-spillinfo)
                                  ; release the unspillable conflict sets
-                                 (for-each (lambda (x) (var-unspillable-conflict*-set! x #f)) spillable*)
-                                 (vector-for-each (lambda (x) (var-unspillable-conflict*-set! x #f)) regvec)
+                                 (for-each (lambda (x) (var-unspillable-conflict*-set! x reg-spillinfo #f)) spillable*)
+                                 (vector-for-each (lambda (x) (var-unspillable-conflict*-set! x reg-spillinfo #f)) regvec)
                                  #;(show-homes unspillable*)
                                  (if (everybody-home?)
                                      (let ([dummy (RApass unparse-L15e finalize-register-locations! dummy block*)])
                                        ; release the spillable conflict sets
-                                       (vector-for-each (lambda (reg) (var-spillable-conflict*-set! reg #f)) regvec)
-                                       (do ([i max-fv (fx- i 1)]) ((fx< i 0)) (var-spillable-conflict*-set! (get-fv i) #f))
+                                       (vector-for-each (lambda (reg) (var-spillable-conflict*-set! reg reg-spillinfo #f)) regvec)
+                                       (do ([i max-fv (fx- i 1)]) ((fx< i 0)) (var-spillable-conflict*-set! (get-fv i) reg-spillinfo #f))
                                        (let-values ([(dummy entry-block* block*)
                                                      (xpass expose-overflow-check-blocks!
                                                        (lambda (val*)
@@ -10525,11 +10530,12 @@
                                          `(lambda ,info (,entry-block* ...) (,block* ...))))
                                      (begin
                                        (for-each restore-block-info! block* bcache*)
-                                       (vector-for-each var-spillable-conflict*-set! regvec saved-reg-csets)
+                                       (vector-for-each (lambda (r c*) (var-spillable-conflict*-set! r reg-spillinfo c*))
+                                                        regvec saved-reg-csets)
                                        (for-each (lambda (x) (uvar-location-set! x #f)) spillable*)
                                        (for-each uvar-move*-set! spillable* saved-move*)
                                        (set! unspillable* '())
-                                       (RApass unparse-L15b assign-frame! (filter uvar-spilled? spillable*))
+                                       (RApass unparse-L15b assign-frame! (filter uvar-spilled? spillable*) reg-spillinfo)
                                        (loop)))))))))))))))])))
 
     ; NB: commonize with earlier
@@ -10679,7 +10685,6 @@
 
     (set! $np-compile
       (lambda (original-input-expression pt?)
-        (with-initialized-registers
           (fluid-let ([frame-vars (make-vector 8 #f)]
                       [next-lambda-seqno 0]
                       [pass-time? pass-time?])
@@ -10722,11 +10727,10 @@
               (pass np-flatten-case-lambda unparse-L12)
               (pass np-insert-trap-check unparse-L12.5)
               (pass np-impose-calling-conventions unparse-L13)
-              np-after-calling-conventions)))))
+              np-after-calling-conventions))))
 
     (set! $np-boot-code
       (lambda (which)
-        (with-initialized-registers
           ($c-func-code-record
             (fluid-let ([frame-vars (make-vector 8 #f)]
                         [next-lambda-seqno 0]
@@ -10735,7 +10739,7 @@
                 (np-after-calling-conventions
                   (with-output-language (L13 Program)
                     (let ([l (make-local-label 'Linvoke)])
-                      `(labels ([,l (hand-coded ,which)]) ,l))))))))))
+                      `(labels ([,l (hand-coded ,which)]) ,l)))))))))
   )
 
   (set! $np-tracer tracer)
diff --git a/racket/src/ChezScheme/s/np-info.ss b/racket/src/ChezScheme/s/np-info.ss
index da3629016b..675fe1332e 100644
--- a/racket/src/ChezScheme/s/np-info.ss
+++ b/racket/src/ChezScheme/s/np-info.ss
@@ -95,38 +95,33 @@
          ((new kill*) libspec save-ra?)]))))
 
 (module (intrinsic-info-asmlib intrinsic-return-live* intrinsic-entry-live* intrinsic-modify-reg* dorest-intrinsics)
-  ; standing on our heads here to avoid referencing registers at
-  ; load time...would be cleaner if registers were immutable,
-  ; i.e., mutable fields (direct and inherited from var) were kept
-  ; in separate tables...but that might add more cost to register
-  ; allocation, which is already expensive.
   (define-record-type intrinsic
-    (nongenerative #{intrinsic bcpkdd2y9yyv643zicd4jbe3y-8})
+    (nongenerative #{intrinsic bcpkdd2y9yyv643zicd4jbe3y-A})
     (sealed #t)
-    (fields libspec get-kill* get-live* get-rv*))
+    (fields libspec kill* live* rv*))
   (define intrinsic-info-asmlib
     (lambda (intrinsic save-ra?)
-      (make-info-asmlib ((intrinsic-get-kill* intrinsic))
+      (make-info-asmlib (intrinsic-kill* intrinsic)
         (intrinsic-libspec intrinsic)
         save-ra?
-        ((intrinsic-get-live* intrinsic)))))
+        (intrinsic-live* intrinsic))))
   (define intrinsic-return-live*
     ; used a handful of times, just while compiling library.ss...don't bother optimizing
     (lambda (intrinsic)
       (fold-left (lambda (live* kill) (remq kill live*))
-        (vector->list regvec) ((intrinsic-get-kill* intrinsic)))))
+        (vector->list regvec) (intrinsic-kill* intrinsic))))
   (define intrinsic-entry-live*
     ; used a handful of times, just while compiling library.ss...don't bother optimizing
     (lambda (intrinsic) ; return-live* - rv + live*
       (fold-left (lambda (live* live) (if (memq live live*) live* (cons live live*)))
         (fold-left (lambda (live* rv) (remq rv live*))
           (intrinsic-return-live* intrinsic)
-          ((intrinsic-get-rv* intrinsic)))
-        ((intrinsic-get-live* intrinsic)))))
+          (intrinsic-rv* intrinsic))
+        (intrinsic-live* intrinsic))))
   (define intrinsic-modify-reg*
     (lambda (intrinsic)
-      (append ((intrinsic-get-rv* intrinsic))
-              ((intrinsic-get-kill* intrinsic)))))
+      (append (intrinsic-rv* intrinsic)
+              (intrinsic-kill* intrinsic))))
   (define-syntax declare-intrinsic
     (syntax-rules (unquote)
       [(_ name entry-name (kill ...) (live ...) (rv ...))
@@ -134,9 +129,9 @@
          (define name
            (make-intrinsic
              (lookup-libspec entry-name)
-             (lambda () (reg-list kill ...))
-             (lambda () (reg-list live ...))
-             (lambda () (reg-list rv ...))))
+             (reg-list kill ...)
+             (reg-list live ...)
+             (reg-list rv ...)))
          (export name))]))
   ; must include in kill ... any register explicitly assigned by the intrinsic
   ; plus additional registers as needed to avoid spilled unspillables.  the
@@ -183,9 +178,9 @@
                     '()
                     (cons #`(make-intrinsic
                               (lookup-libspec #,(construct-name #'k "dorest" i))
-                              (lambda () (reg-list %ac0 %xp %ts %td))
-                              (lambda () (reg-cons* %ac0 (list-xtail arg-registers #,i)))
-                              (lambda () (let ([ls (list-xtail arg-registers #,i)]) (if (null? ls) '() (list (car ls))))))
+                              (reg-list %ac0 %xp %ts %td)
+                              (reg-cons* %ac0 (list-xtail arg-registers #,i))
+                              (let ([ls (list-xtail arg-registers #,i)]) (if (null? ls) '() (list (car ls)))))
                       (f (fx+ i 1))))))))
       dorests)))
 
diff --git a/racket/src/ChezScheme/s/np-languages.ss b/racket/src/ChezScheme/s/np-languages.ss
index 91bdeb1f57..c52daea3d8 100644
--- a/racket/src/ChezScheme/s/np-languages.ss
+++ b/racket/src/ChezScheme/s/np-languages.ss
@@ -32,6 +32,7 @@
     fv-offset fv-type
     var-spillable-conflict* var-spillable-conflict*-set!
     var-unspillable-conflict* var-unspillable-conflict*-set!
+    var-spillinfo-redirect! make-redirect-var
     uvar-degree uvar-degree-set!
     uvar-info-lambda uvar-info-lambda-set!
     uvar-iii uvar-iii-set!
@@ -86,14 +87,89 @@
   (define datum? (lambda (x) #t))
 
   (define-record-type var
-    (fields (mutable index) (mutable spillable-conflict*) (mutable unspillable-conflict*))
-    (nongenerative #{var n93q6qho9id46fha8itaytldd-1})
+    (fields (mutable index-or-redirect) (mutable spillable-conflict*-or-redirect) (mutable unspillable-conflict*-or-redirect))
+    (nongenerative #{var fjh3mleeyv82pb1x1uhd4vsbv-1})
     (protocol (lambda (new) (lambda () (new #f #f #f)))))
 
+  ;; relies on pairs being distinct from conflict sets and indices:
+  (define (make-spillinfo-redirect index) (cons index '()))
+  (define (spillinfo-redirect? v) (pair? v))
+  (define (spillinfo-redirect-index r) (car r))
+
+  (define-record-type precolor-var
+    (parent var)
+    (fields (mutable precolored))
+    (nongenerative #{precolor-var fjh3mleeyv82pb1x1uhd4vsbv-5})
+    (protocol (lambda (pargs->new) (lambda () ((pargs->new) #f)))))
+  
+  (define (make-redirect-var name)
+    (make-precolor-var))
+
+  (define (var-spillinfo-redirect! v index)
+    (let ([r (make-spillinfo-redirect index)])
+      (var-index-or-redirect-set! v r)
+      (var-spillable-conflict*-or-redirect-set! v r)
+      (var-unspillable-conflict*-or-redirect-set! v r)))
+
+  (define var-index
+    (case-lambda
+     [(v) ; when index is not used for spill information
+      (safe-assert (not (spillinfo-redirect? (var-index-or-redirect v))))
+      (var-index-or-redirect v)]
+     [(v reg-spillinfo) ; when index is used for spill information
+      (let ([i (var-index-or-redirect v)])
+        (if (spillinfo-redirect? i)
+            (var-index-or-redirect
+             (vector-ref reg-spillinfo (spillinfo-redirect-index i)))
+            i))]))
+
+  (define var-index-set!
+    (case-lambda
+     [(v i) ; when index is not used for spill information
+      (safe-assert (not (spillinfo-redirect? (var-index-or-redirect v))))
+      (var-index-or-redirect-set! v i)]
+     [(v reg-spillinfo i) ; when index is used for spill information
+      (let ([old-i (var-index-or-redirect v)])
+        (if (spillinfo-redirect? old-i)
+            (var-index-or-redirect-set!
+             (vector-ref reg-spillinfo (spillinfo-redirect-index old-i))
+             i)
+            (var-index-or-redirect-set! v i)))]))
+      
+  (define (var-spillable-conflict* v reg-spillinfo)
+    (let ([c* (var-spillable-conflict*-or-redirect v)])
+      (if (spillinfo-redirect? c*)
+          (var-spillable-conflict*-or-redirect
+           (vector-ref reg-spillinfo (spillinfo-redirect-index c*)))
+          c*)))
+
+  (define (var-unspillable-conflict* v reg-spillinfo)
+    (let ([c* (var-unspillable-conflict*-or-redirect v)])
+      (if (spillinfo-redirect? c*)
+          (var-unspillable-conflict*-or-redirect
+           (vector-ref reg-spillinfo (spillinfo-redirect-index c*)))
+          c*)))
+
+  (define (var-spillable-conflict*-set! v reg-spillinfo c*)
+    (let ([old-c* (var-spillable-conflict*-or-redirect v)])
+      (if (spillinfo-redirect? old-c*)
+          (var-spillable-conflict*-or-redirect-set!
+           (vector-ref reg-spillinfo (spillinfo-redirect-index old-c*))
+           c*)
+          (var-spillable-conflict*-or-redirect-set! v c*))))
+
+  (define (var-unspillable-conflict*-set! v reg-spillinfo c*)
+    (let ([old-c* (var-unspillable-conflict*-or-redirect v)])
+      (if (spillinfo-redirect? old-c*)
+          (var-unspillable-conflict*-or-redirect-set!
+           (vector-ref reg-spillinfo (spillinfo-redirect-index old-c*))
+           c*)
+          (var-unspillable-conflict*-or-redirect-set! v c*))))
+
   (define-record-type (fv $make-fv fv?)
     (parent var)
     (fields offset type)
-    (nongenerative #{var n93q6qho9id46fha8itaytldd-2})
+    (nongenerative #{fv fjh3mleeyv82pb1x1uhd4vsbv-2})
     (sealed #t)
     (protocol
       (lambda (pargs->new)
@@ -107,13 +183,20 @@
 
   (define-record-type reg
     (parent var)
-    (fields name mdinfo tc-disp callee-save? type (mutable precolored))
-    (nongenerative #{var n93q6qho9id46fha8itaytldd-3})
+    (fields name mdinfo tc-disp callee-save? type)
+    (nongenerative #{reg fjh3mleeyv82pb1x1uhd4vsbv-6})
     (sealed #t)
     (protocol
       (lambda (pargs->new)
         (lambda (name mdinfo tc-disp callee-save? type)
-          ((pargs->new) name mdinfo tc-disp callee-save? type #f)))))
+          ((pargs->new) name mdinfo tc-disp callee-save? type)))))
+
+  (define (reg-precolored reg reg-spillinfo)
+    (let ([i (var-index-or-redirect reg)])
+      (precolor-var-precolored (vector-ref reg-spillinfo (spillinfo-redirect-index i)))))
+  (define (reg-precolored-set! reg reg-spillinfo v)
+    (let ([i (var-index-or-redirect reg)])
+      (precolor-var-precolored-set! (vector-ref reg-spillinfo (spillinfo-redirect-index i)) v)))
 
   (module ()
     (record-writer (record-type-descriptor reg)
@@ -181,7 +264,7 @@
       (mutable save-weight)   ; must be a fixnum!
       (mutable live-count)    ; must be a fixnum!
      )
-    (nongenerative #{var n93q6qho9id46fha8itaytldd-4})
+    (nongenerative #{uvar fjh3mleeyv82pb1x1uhd4vsbv-4})
     (sealed #t)
     (protocol
       (lambda (pargs->new)
diff --git a/racket/src/ChezScheme/s/np-register.ss b/racket/src/ChezScheme/s/np-register.ss
index 7f0a689d14..49e49c8c00 100644
--- a/racket/src/ChezScheme/s/np-register.ss
+++ b/racket/src/ChezScheme/s/np-register.ss
@@ -27,11 +27,15 @@
              (module (alias ...) (define x regid) (define alias x) ...))
            ...)])))
 
+(define-syntax define-register-aliases
+  (syntax-rules ()
+    [(_ regid reg-alias ...) (begin (define reg-alias regid) ...)]))
+
 (define-syntax define-allocable-registers
   (lambda (x)
     (assert (fx<= (constant asm-arg-reg-cnt) (constant asm-arg-reg-max)))
     (syntax-case x ()
-      [(_ regvec arg-registers extra-registers extra-fpregisters with-initialized-registers
+      [(_ regvec arg-registers extra-registers extra-fpregisters make-reg-spillinfo
           [regid reg-alias ... callee-save? mdinfo type] ...)
        (with-syntax ([((tc-disp ...) (arg-regid ...) (extra-regid ...) (extra-fpregid ...))
                       (syntax-case #'([regid type] ...) (%ac0 %xp %ts %td uptr)
@@ -72,36 +76,20 @@
                                          (f (cdr other*) (cdr other-type*) (cons arg-offset rtc-disp*)
                                             (fx+ arg-offset (constant ptr-bytes)) fp-offset (cons other rextra*) rfpextra*))))))]
                         [_ (syntax-error x "missing or out-of-order required registers")])]
-                     [(regid-loc ...) (generate-temporaries #'(regid ...))])
+                     [(reg-spillinfo-index ...) (iota (length #'(regid ...)))])
          #'(begin
-             (define-syntax define-squawking-parameter
-               (syntax-rules ()
-                 [(_ (id (... ...)) loc)
-                  (begin
-                    (define-once loc (id (... ...)) ($make-thread-parameter #f))
-                    (define-syntax id
-                      (lambda (q)
-                        (unless (identifier? q) (syntax-error q))
-                        #`(let ([x (loc)])
-                            (unless x (syntax-error #'#,q "uninitialized"))
-                            x)))
-                    (... ...))]
-                 [(_ id loc) (define-squawking-parameter (id) loc)]))
-             (define-squawking-parameter (regid reg-alias ...) regid-loc)
+             (define-once regid (let ([r (make-reg 'regid 'mdinfo tc-disp callee-save? 'type)])
+                                  (var-spillinfo-redirect! r reg-spillinfo-index)
+                                  r))
              ...
-             (define-squawking-parameter regvec regvec-loc)
-             (define-squawking-parameter arg-registers arg-registers-loc)
-             (define-squawking-parameter extra-registers extra-registers-loc)
-             (define-squawking-parameter extra-fpregisters extra-fpregisters-loc)
-             (define-syntax with-initialized-registers
-               (syntax-rules ()
-                 [(_ b1 b2 (... ...))
-                  (parameterize ([regid-loc (make-reg 'regid 'mdinfo tc-disp callee-save? 'type)] ...)
-                    (parameterize ([regvec-loc (vector regid ...)]
-                                   [arg-registers-loc (list arg-regid ...)]
-                                   [extra-registers-loc (list extra-regid ...)]
-                                   [extra-fpregisters-loc (list extra-fpregid ...)])
-                      (let () b1 b2 (... ...))))]))))])))
+             (define-register-aliases regid reg-alias ...) ...
+             (define regvec (vector regid ...))
+             (define arg-registers (list arg-regid ...))
+             (define extra-registers (list extra-regid ...))
+             (define extra-fpregisters (list extra-fpregid ...))
+             (define (make-reg-spillinfo)
+               (vector (make-redirect-var 'regid)
+                       ...))))])))
 
 (define-syntax define-machine-dependent-registers
   (lambda (x)
@@ -119,10 +107,10 @@
       [(k (reserved [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...)
           (allocable [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...)
           (machine-depdendent [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...))
-       (with-implicit (k regvec arg-registers extra-registers extra-fpregisters real-register? with-initialized-registers)
+       (with-implicit (k regvec arg-registers extra-registers extra-fpregisters real-register? make-reg-spillinfo)
          #`(begin
              (define-reserved-registers [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...)
-             (define-allocable-registers regvec arg-registers extra-registers extra-fpregisters with-initialized-registers
+             (define-allocable-registers regvec arg-registers extra-registers extra-fpregisters make-reg-spillinfo
                [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...)
              (define-machine-dependent-registers [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...)
              (define-syntax real-register?
diff --git a/racket/src/ChezScheme/s/x86_64.ss b/racket/src/ChezScheme/s/x86_64.ss
index f65c6a8a70..875ec3ed59 100644
--- a/racket/src/ChezScheme/s/x86_64.ss
+++ b/racket/src/ChezScheme/s/x86_64.ss
@@ -2431,11 +2431,11 @@
   (module (asm-foreign-call asm-foreign-callable)
     (if-feature windows
       (begin
-        (define make-vint (lambda () (vector %Carg1 %Carg2 %Carg3 %Carg4)))
-        (define make-vfp (lambda () (vector %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4))))
+        (define vint (vector %Carg1 %Carg2 %Carg3 %Carg4))
+        (define vfp (vector %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4)))
       (begin
-        (define make-vint (lambda () (vector %Carg1 %Carg2 %Carg3 %Carg4 %Carg5 %Carg6)))
-        (define make-vfp (lambda () (vector %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4 %Cfparg5 %Cfparg6 %Cfparg7 %Cfparg8)))))
+        (define vint (vector %Carg1 %Carg2 %Carg3 %Carg4 %Carg5 %Carg6))
+        (define vfp (vector %Cfparg1 %Cfparg2 %Cfparg3 %Cfparg4 %Cfparg5 %Cfparg6 %Cfparg7 %Cfparg8))))
 
     (define (align n size)
       (fxlogand (fx+ n (fx- size 1)) (fx- size)))
@@ -2629,7 +2629,7 @@
                           `(set! ,(%mref ,%sp ,offset) (inline ,(make-info-load 'integer-8 #f)
                                                                ,%load ,x ,%zero (immediate ,x-offset)))]))))]
                  [load-content-regs
-                  (lambda (classes size iint ifp vint vfp)
+                  (lambda (classes size iint ifp)
                     (lambda (x) ; requires var
                       (let loop ([size size] [iint iint] [ifp ifp] [classes classes] [x-offset 0])
                         (cond
@@ -2686,7 +2686,7 @@
                       (add-regs (fx- ints 1) (fx+ ir 1) vr
                                 (cons (vector-ref vr ir) regs))]))]
                  [do-args
-                  (lambda (types vint vfp)
+                  (lambda (types)
                     (if-feature windows
                       (let loop ([types types] [locs '()] [regs '()] [fp-regs '()] [i 0] [isp 0])
                         (if (null? types)
@@ -2721,12 +2721,12 @@
                                           (eq? 'float (caar ($ftd->members ftd))))
                                      ;; float or double
                                      (loop (cdr types)
-                                       (cons (load-content-regs '(sse) ($ftd-size ftd) i i vint vfp) locs)
+                                       (cons (load-content-regs '(sse) ($ftd-size ftd) i i) locs)
                                        (add-regs 1 i vint regs) (add-regs 1 i vfp fp-regs) (fx+ i 1) isp)]
                                     [else
                                      ;; integer
                                      (loop (cdr types)
-                                       (cons (load-content-regs '(integer) ($ftd-size ftd) i i vint vfp) locs)
+                                       (cons (load-content-regs '(integer) ($ftd-size ftd) i i) locs)
                                        (add-regs 1 i vint regs) fp-regs(fx+ i 1) isp)])]
                                   [else
                                    ;; pass as value on the stack
@@ -2790,7 +2790,7 @@
                                   [else
                                    ;; pass in registers
                                    (loop (cdr types)
-                                         (cons (load-content-regs classes ($ftd-size ftd) iint ifp vint vfp) locs)
+                                         (cons (load-content-regs classes ($ftd-size ftd) iint ifp) locs)
                                          (add-regs ints iint vint regs) (add-regs fps ifp vfp fp-regs)
                                          (fx+ iint ints) (fx+ ifp fps) isp)]))]
                               [else
@@ -2921,7 +2921,7 @@
                    [fill-result-here? (result-fits-in-registers? result-classes)]
                    [result-reg* (get-result-regs fill-result-here? result-type result-classes)]
                    [adjust-active? (if-feature pthreads (memq 'adjust-active conv*) #f)])
-              (with-values (do-args (if fill-result-here? (cdr arg-type*) arg-type*) (make-vint) (make-vfp))
+              (with-values (do-args (if fill-result-here? (cdr arg-type*) arg-type*))
                 (lambda (frame-size nfp locs live* fp-live*)
                   (with-values (add-save-fill-target fill-result-here? frame-size locs)
                     (lambda (frame-size locs)
@@ -3065,8 +3065,6 @@
                 `(set! ,lvalue ,(%inline + ,%sp (immediate ,offset))))))
           (define save-arg-regs
             (lambda (types)
-              (define vint (make-vint))
-              (define vfp (make-vfp))
               (if-feature windows
                 (let f ([types types] [i 0] [isp 8])
                   (if (or (null? types) (fx= i 4))