diff --git a/assembly/x86/array.lisp b/assembly/x86/array.lisp
index 56ab832dec28a0d05b0b8b4198a540598df9d90e..1fc804b98d94989be24a5825293e29e57d132943 100644
--- a/assembly/x86/array.lisp
+++ b/assembly/x86/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.3 1997/11/04 09:10:37 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.4 1997/11/05 14:59:40 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -37,7 +37,7 @@
 		      (* vector-data-offset word-bytes)))
   (inst add result words)
   (inst and result (lognot vm:lowtag-mask))
-  (var-allocation result result)
+  (allocation result result)
   (inst lea result (make-ea :byte :base result :disp other-pointer-type))
   (storew type result 0 other-pointer-type)
   (storew length result vector-length-slot other-pointer-type)
diff --git a/code/numbers.lisp b/code/numbers.lisp
index 464103299a639631fc6c4b321287b4a671fd8da6..f8e508ee24a96c0be5fa018b6c3668439ee05967 100644
--- a/code/numbers.lisp
+++ b/code/numbers.lisp
@@ -5,11 +5,11 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.29 1997/11/01 22:58:17 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.29 1997/11/01 22:58:17 dtc Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.30 1997/11/05 14:59:45 dtc Exp $
 ;;;
 ;;; This file contains the definitions of most number functions.
 ;;;
@@ -215,10 +215,12 @@
       #+complex-float
       (cond ((and (typep realpart 'double-float)
 		  (typep imagpart 'double-float))
-	     (vm::make-complex-double-float realpart imagpart))
+	     (truly-the (complex double-float)
+			(complex realpart imagpart)))
 	    ((and (typep realpart 'single-float)
 		  (typep imagpart 'single-float))
-	     (vm::make-complex-single-float realpart imagpart))
+	     (truly-the (complex single-float)
+			(complex realpart imagpart)))
 	    (t
 	     (%make-complex realpart imagpart)))
       #-complex-float
@@ -275,10 +277,12 @@
   (flet ((%%make-complex (realpart imagpart)
 	   (cond ((and (typep realpart 'double-float)
 		       (typep imagpart 'double-float))
-		  (vm::make-complex-double-float realpart imagpart))
+		  (truly-the (complex double-float)
+			     (complex realpart imagpart)))
 		 ((and (typep realpart 'single-float)
 		       (typep imagpart 'single-float))
-		  (vm::make-complex-single-float realpart imagpart))
+		  (truly-the (complex single-float)
+			     (complex realpart imagpart)))
 		 (t
 		  (%make-complex realpart imagpart)))))
   (number-dispatch ((realpart real) (imagpart real))
diff --git a/code/x86-vm.lisp b/code/x86-vm.lisp
index 2da6fe4f0ea0205921a139076e8743dbffdc827e..63c277f77ade8c7f4f2bb911c8f68d5c7cbd388f 100644
--- a/code/x86-vm.lisp
+++ b/code/x86-vm.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 ;(ext:file-comment
-;  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.5 1997/11/01 22:58:21 dtc Exp $")
+;  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/x86-vm.lisp,v 1.6 1997/11/05 14:59:47 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -403,11 +403,11 @@
 (progn
 (defun make-complex-single-float (x y)
   (declare (type single-float x y))
-  (the (complex single-float) (make-complex-single-float x y)))
+  (truly-the (complex single-float) (complex x y)))
 
 (defun make-complex-double-float (x y)
   (declare (type double-float x y))
-  (the (complex double-float) (make-complex-double-float x y)))
+  (truly-the (complex double-float) (complex x y)))
 
 (defun complex-single-float-real (x)
   (declare (type (complex single-float) x))
diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp
index 382fa61fa5477ecf9a3eb257f0222037837a7745..b906dbfa4ca9a1e34551fed7abcfd8288a34f6d1 100644
--- a/compiler/x86/alloc.lisp
+++ b/compiler/x86/alloc.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.3 1997/11/04 09:10:55 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.4 1997/11/05 14:59:50 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -32,6 +32,7 @@
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
+  (:node-var node)
   (:generator 0
     (cond ((zerop num)
 	   ;; (move result nil-value)
@@ -49,7 +50,7 @@
 			     temp))))
 		     (storew reg ,list ,slot vm:list-pointer-type))))
 	     (let ((cons-cells (if star (1- num) num)))
-	       (allocation res (* (pad-data-block cons-size) cons-cells))
+	       (allocation res (* (pad-data-block cons-size) cons-cells) node)
 	       (inst lea res (make-ea :byte :base res :disp list-pointer-type))
 	       (move ptr res)
 	       (dotimes (i (1- cons-cells))
@@ -114,6 +115,7 @@
   (:results (result :scs (descriptor-reg) :from :eval))
   (:temporary (:sc dword-reg :from (:argument 0)) boxed)
   (:temporary (:sc dword-reg :from (:argument 1)) unboxed)
+  (:node-var node)
   (:generator 100
     (move boxed boxed-arg)
     (inst add boxed (fixnum (1+ code-trace-table-offset-slot)))
@@ -124,7 +126,7 @@
     (inst and unboxed (lognot lowtag-mask))
     (inst mov result boxed)
     (inst add result unboxed)
-    (var-allocation result result)
+    (allocation result result node)
     (inst lea result (make-ea :byte :base result :disp other-pointer-type))
     (inst shl boxed (- type-bits word-shift))
     (inst or boxed code-header-type)
@@ -139,8 +141,9 @@
   (:translate make-fdefn)
   (:args (name :scs (descriptor-reg) :to :eval))
   (:results (result :scs (descriptor-reg) :from :argument))
+  (:node-var node)
   (:generator 37
-    (fixed-allocation result fdefn-type fdefn-size)
+    (fixed-allocation result fdefn-type fdefn-size node)
     (storew name result fdefn-name-slot other-pointer-type)
     (storew nil-value result fdefn-function-slot other-pointer-type)
     (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) result
@@ -152,9 +155,10 @@
   (:info length)
   (:temporary (:sc any-reg) temp)
   (:results (result :scs (descriptor-reg)))
+  (:node-var node)
   (:generator 10
    (let ((size (+ length closure-info-offset)))
-     (allocation result (pad-data-block size))
+     (allocation result (pad-data-block size) node)
      (inst lea result (make-ea :byte :base result :disp function-pointer-type))
      (storew (logior (ash (1- size) type-bits) closure-header-type)
 	     result 0 function-pointer-type))
@@ -166,8 +170,9 @@
 (define-vop (make-value-cell)
   (:args (value :scs (descriptor-reg any-reg) :to :result))
   (:results (result :scs (descriptor-reg) :from :eval))
+  (:node-var node)
   (:generator 10
-    (fixed-allocation result value-cell-header-type value-cell-size)
+    (fixed-allocation result value-cell-header-type value-cell-size node)
     (storew value result value-cell-value-slot other-pointer-type)))
 
 
@@ -185,8 +190,9 @@
   (:info name words type lowtag)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
+  (:node-var node)
   (:generator 50
-    (allocation result (pad-data-block words))
+    (allocation result (pad-data-block words) node)
     (inst lea result (make-ea :byte :base result :disp lowtag))
     (when type
       (storew (logior (ash (1- words) type-bits) type) result 0 lowtag))))
@@ -199,6 +205,7 @@
   (:results (result :scs (descriptor-reg) :from (:eval 1)))
   (:temporary (:sc any-reg :from :eval :to (:eval 1)) bytes)
   (:temporary (:sc any-reg :from :eval :to :result) header)
+  (:node-var node)
   (:generator 50
     (inst lea bytes
 	  (make-ea :dword :base extra :disp (* (1+ words) word-bytes)))
@@ -208,7 +215,7 @@
     (inst lea header			; (w-1 << 8) | type
 	  (make-ea :dword :base header :disp (+ (ash -2 type-bits) type)))
     (inst and bytes (lognot lowtag-mask))
-    (var-allocation result bytes)
+    (allocation result bytes node)
     (inst lea result (make-ea :byte :base result :disp lowtag))
     (storew header result 0 lowtag)))
 
@@ -220,8 +227,9 @@
   (:args (name :scs (descriptor-reg) :to :eval))
   (:temporary (:sc dword-reg :from :eval) temp)
   (:results (result :scs (descriptor-reg) :from :argument))
+  (:node-var node)
   (:generator 37
-    (fixed-allocation result symbol-header-type symbol-size)
+    (fixed-allocation result symbol-header-type symbol-size node)
     (storew name result symbol-name-slot other-pointer-type)
     (storew unbound-marker-type result symbol-value-slot other-pointer-type)
     ;; Setup a random hash value for the symbol.  Perhaps the object
diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp
index 738ee52ad02277ebb5cd3e88e3fb619216a548fb..110b22d4ec6d2c713c3aa29d43843fcfcbdbc6d8 100644
--- a/compiler/x86/array.lisp
+++ b/compiler/x86/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.7 1997/11/04 09:10:58 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.8 1997/11/05 14:59:52 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -33,6 +33,7 @@
   (:temporary (:sc any-reg :to :eval) bytes)
   (:temporary (:sc any-reg :to :result) header)
   (:results (result :scs (descriptor-reg) :from :eval))
+  (:node-var node)
   (:generator 13
     (inst lea bytes
 	  (make-ea :dword :base rank
@@ -44,7 +45,7 @@
     (inst shl header type-bits)
     (inst or  header type)
     (inst shr header 2)
-    (var-allocation result bytes)
+    (allocation result bytes node)
     (inst lea result (make-ea :dword :base result :disp other-pointer-type))
     (storew header result 0 other-pointer-type)))
 
diff --git a/compiler/x86/call.lisp b/compiler/x86/call.lisp
index 51e7172dbdeef0c09e947863abeff65e486a33c6..588fa072ee1be76fa777ada23908919296dc9717 100644
--- a/compiler/x86/call.lisp
+++ b/compiler/x86/call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.4 1997/11/04 09:11:00 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.5 1997/11/05 14:59:53 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1434,6 +1434,7 @@
   (:temporary (:sc dword-reg :offset eax-offset) eax)
   (:temporary (:sc dword-reg) dst)
   (:results (result :scs (descriptor-reg)))
+  (:node-var node)
   (:generator 20
     (move src context)
     (move ecx count)
@@ -1441,7 +1442,7 @@
     (inst mov result nil-value)
     (inst jecxz done)
     (inst lea dst (make-ea :dword :index ecx :scale 2))
-    (var-allocation dst dst)
+    (allocation dst dst node)
     (inst lea dst (make-ea :byte :base dst :disp list-pointer-type))
     ;; Convert the count into a raw value, so we can use the LOOP inst.
     (inst shr ecx 2)
diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index 45cff64f870956c94488bbe97c54e4f8e1d11244..4c7388b154c5cbf02e22a8089e2dcb82fda11492 100644
--- a/compiler/x86/float.lisp
+++ b/compiler/x86/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.11 1997/11/04 09:11:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.12 1997/11/05 14:59:55 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -258,7 +258,7 @@
        (let ((x-real (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
 				     :offset (tn-offset x)))
 	     (y-real (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
-				     :offset (tn-offset x))))
+				     :offset (tn-offset y))))
 	 (cond ((zerop (tn-offset y-real))
 		(copy-fp-reg-to-fr0 x-real))
 	       ((zerop (tn-offset x-real))
@@ -270,7 +270,7 @@
        (let ((x-imag (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
 				     :offset (1+ (tn-offset x))))
 	     (y-imag (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
-				     :offset (1+ (tn-offset x)))))
+				     :offset (1+ (tn-offset y)))))
 	 (inst fxch x-imag)
 	 (inst fstd y-imag)
 	 (inst fxch x-imag)))))
@@ -298,9 +298,10 @@
 (define-vop (move-from-single)
   (:args (x :scs (single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
+  (:node-var node)
   (:note "float to pointer coercion")
   (:generator 13
-     (fixed-allocation y vm:single-float-type vm:single-float-size)
+     (fixed-allocation y vm:single-float-type vm:single-float-size node)
      (with-tn@fp-top(x)
        (inst fst (ea-for-sf-desc y)))))
 (define-move-vop move-from-single :move
@@ -319,9 +320,10 @@
 (define-vop (move-from-double)
   (:args (x :scs (double-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
+  (:node-var node)
   (:note "float to pointer coercion")
   (:generator 13
-     (fixed-allocation y vm:double-float-type vm:double-float-size)
+     (fixed-allocation y vm:double-float-type vm:double-float-size node)
      (with-tn@fp-top(x)
        (inst fstd (ea-for-df-desc y)))))
 (define-move-vop move-from-double :move
@@ -365,10 +367,11 @@
 (define-vop (move-from-complex-single)
   (:args (x :scs (complex-single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
+  (:node-var node)
   (:note "complex float to pointer coercion")
   (:generator 13
      (fixed-allocation y vm:complex-single-float-type
-		       vm:complex-single-float-size)
+		       vm:complex-single-float-size node)
      (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
 				    :offset (tn-offset x))))
        (with-tn@fp-top(real-tn)
@@ -383,10 +386,11 @@
 (define-vop (move-from-complex-double)
   (:args (x :scs (complex-double-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
+  (:node-var node)
   (:note "complex float to pointer coercion")
   (:generator 13
      (fixed-allocation y vm:complex-double-float-type
-		       vm:complex-double-float-size)
+		       vm:complex-double-float-size node)
      (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
 				    :offset (tn-offset x))))
        (with-tn@fp-top(real-tn)
@@ -499,7 +503,7 @@
 			       (y-real
 				(make-random-tn :kind :normal
 						:sc (sc-or-lose 'double-reg)
-						:offset (tn-offset x))))
+						:offset (tn-offset y))))
 			   (cond ((zerop (tn-offset y-real))
 				  (copy-fp-reg-to-fr0 x-real))
 				 ((zerop (tn-offset x-real))
@@ -515,7 +519,7 @@
 			       (y-imag
 				(make-random-tn :kind :normal
 						:sc (sc-or-lose 'double-reg)
-						:offset (1+ (tn-offset x)))))
+						:offset (1+ (tn-offset y)))))
 			   (inst fxch x-imag)
 			   (inst fstd y-imag)
 			   (inst fxch x-imag))))
@@ -2562,11 +2566,6 @@
 	    complex-single-float-real complex-double-float-real
 	    complex-single-float-imag complex-double-float-imag)))
 
-(defknown make-complex-single-float (single-float single-float)
-  (complex single-float) (flushable))
-(defknown make-complex-double-float (double-float double-float)
-  (complex double-float) (flushable))
-
 (define-vop (make-complex-float)
   (:args (x :target r)
 	 (y :to :save))
@@ -2595,7 +2594,7 @@
 	       (inst fxch y)))))))
 
 (define-vop (make-complex-single-float make-complex-float)
-  (:translate make-complex-single-float)
+  (:translate complex)
   (:args (x :scs (single-reg) :target r)
 	 (y :scs (single-reg) :to :save))
   (:arg-types single-float single-float)
@@ -2603,7 +2602,7 @@
   (:result-types complex-single-float))
 
 (define-vop (make-complex-double-float make-complex-float)
-  (:translate make-complex-double-float)
+  (:translate complex)
   (:args (x :scs (double-reg) :target r)
 	 (y :scs (double-reg) :to :save))
   (:arg-types double-float double-float)
diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp
index 8fac524bee52e119715b7d5d6b1104ed1779bf36..c0a957eecc5842c3f7caccc1198e24478634aaf4 100644
--- a/compiler/x86/macros.lisp
+++ b/compiler/x86/macros.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.5 1997/11/04 09:11:08 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.6 1997/11/05 14:59:58 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -112,121 +112,87 @@
 
 ;;;; Allocation helpers
 
-;;; Two allocation approaches are implemented. A call into C can be
-;;; used where special care can be taken to disable
-;;; interrupt. Alternatively with gencgc inline allocation is possible
-;;; although it isn't interrupt safe.
-
-;;;; Call into C.
-(defmacro var-allocation (alloc-tn size-tn)
-  "Allocate an object with a size in bytes given by Size-TN."
-  `(let ((alloc-tn-offset (tn-offset ,alloc-tn)))
-    ;; Dispatch to the appropriate allocation routine. Each
-    ;; destination has a special entry point. The size may be a
-    ;; register or a constant, although the constant case is better
-    ;; handled by with-fixed-cgc-allocation.
-    (ecase alloc-tn-offset
-      (,eax-offset
-       (move eax-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_eax") :foreign)))
-      (,ecx-offset
-       (move ecx-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_ecx") :foreign)))
-      (,edx-offset
-       (move edx-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_edx") :foreign)))
-      (,ebx-offset
-       (move ebx-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_ebx") :foreign)))
-      (,esi-offset
-       (move esi-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_esi") :foreign)))
-      (,edi-offset
-       (move edi-tn ,size-tn)
-       (inst call (make-fixup (extern-alien-name "alloc_to_edi") :foreign))))))
-
-(defmacro allocation (alloc-tn size)
-  "Allocate an object of the given fixed size in bytes; the size must be
-   an integer."
-  `(let ((alloc-tn-offset (tn-offset ,alloc-tn)))
-    (assert (integerp ,size))
-    ;; Dispatch to the appropriate allocation routine. Each
-    ;; destination has a special entry point and there are special
-    ;; case for 2 and 4 word objects.
-    (ecase alloc-tn-offset
-      (,eax-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_eax")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_eax")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov eax-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_eax")
-				 :foreign)))))
-      (,ecx-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ecx")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ecx")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov ecx-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_ecx")
-				 :foreign)))))
-      (,edx-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edx")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edx")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov edx-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_edx")
-				 :foreign)))))
-      (,ebx-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ebx")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ebx")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov ebx-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_ebx") 
-				 :foreign)))))
-      (,esi-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_esi")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_esi")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov esi-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_esi")
-				 :foreign)))))
-      (,edi-offset
-       (case ,size
-	 (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edi")
-				   :foreign)))
-	 (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edi")
-				    :foreign)))
-	 (t
-	  ;; Else: push the size onto the stack.
-	  (inst mov edi-tn ,size)
-	  (inst call (make-fixup (extern-alien-name "alloc_to_edi")
-				 :foreign))))))))
-
-(defmacro fixed-allocation (result-tn type-code size)
+(defun allocation (alloc-tn size &optional inline)
+  "Allocate an object with a size in bytes given by Size.
+   The size may be an integer of a TN.
+   If Inline is a VOP node-var then it is used to make an appropriate
+   speed vs size decision."
+  (declare (ignore inline))
+  (flet ((load-size (dst-tn size)
+	   (unless (and (tn-p size) (location= alloc-tn size))
+	     (inst mov dst-tn size))))
+    (let ((alloc-tn-offset (tn-offset alloc-tn)))
+      ;; C call to allocate via dispatch routines - each destination
+      ;; has a special entry point.
+      (ecase alloc-tn-offset
+	(#.eax-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_eax")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_eax")
+				      :foreign)))
+	   (t
+	    (load-size eax-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_eax")
+				   :foreign)))))
+	(#.ecx-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ecx")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ecx")
+				      :foreign)))
+	   (t
+	    (load-size ecx-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_ecx")
+				   :foreign)))))
+	(#.edx-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edx")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edx")
+				      :foreign)))
+	   (t
+	    (load-size edx-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_edx")
+				   :foreign)))))
+	(#.ebx-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_ebx")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_ebx")
+				      :foreign)))
+	   (t
+	    (load-size ebx-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_ebx") 
+				   :foreign)))))
+	(#.esi-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_esi")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_esi")
+				      :foreign)))
+	   (t
+	    (load-size esi-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_esi")
+				   :foreign)))))
+	(#.edi-offset
+	 (case size
+	   (8 (inst call (make-fixup (extern-alien-name "alloc_8_to_edi")
+				     :foreign)))
+	   (16 (inst call (make-fixup (extern-alien-name "alloc_16_to_edi")
+				      :foreign)))
+	   (t
+	    (load-size edi-tn size)
+	    (inst call (make-fixup (extern-alien-name "alloc_to_edi")
+				   :foreign))))))))
+  (values))
+
+(defmacro fixed-allocation (result-tn type-code size &optional inline)
   "Allocate an other-pointer object of fixed Size with a single
    word header having the specified Type-Code.  The result is placed in
    Result-TN."
   `(progn
-    (allocation ,result-tn (pad-data-block ,size))
+    (allocation ,result-tn (pad-data-block ,size) ,inline)
     (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,result-tn)
     (inst lea ,result-tn
      (make-ea :byte :base ,result-tn :disp other-pointer-type))))
diff --git a/compiler/x86/move.lisp b/compiler/x86/move.lisp
index 745208c251618019d10b57f27746d596d4367b76..210b1813a4732e9ffa1be15087ce099a027a14bb 100644
--- a/compiler/x86/move.lisp
+++ b/compiler/x86/move.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.3 1997/11/04 09:11:11 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.4 1997/11/05 14:59:58 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -300,6 +300,7 @@
   (:args (x :scs (signed-reg unsigned-reg) :to :result))
   (:results (y :scs (any-reg descriptor-reg) :from :argument))
   (:note "signed word to integer coercion")
+  (:node-var node)
   (:generator 20
      (assert (not (location= x y)))
      (let ((bignum (gen-label))
@@ -313,7 +314,7 @@
 
        (assemble (*elsewhere*)
           (emit-label bignum)
-	  (fixed-allocation y bignum-type (+ bignum-digits-offset 1))
+	  (fixed-allocation y bignum-type (+ bignum-digits-offset 1) node)
 	  (storew x y bignum-digits-offset other-pointer-type)
 	  (inst jmp done)))))
 ;;;
@@ -346,6 +347,7 @@
   (:args (x :scs (signed-reg unsigned-reg) :to :save))
   (:temporary (:sc dword-reg) alloc)
   (:results (y :scs (any-reg descriptor-reg)))
+  (:node-var node)
   (:note "unsigned word to integer coercion")
   (:generator 20
     (assert (not (location= x y)))
@@ -377,7 +379,7 @@
 	 (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) vm:type-bits)
 			     bignum-type))
 	 (emit-label l1)
-	 (allocation alloc (pad-data-block (+ bignum-digits-offset 2)))
+	 (allocation alloc (pad-data-block (+ bignum-digits-offset 2)) node)
 	 (storew y alloc)
 	 (inst lea y (make-ea :byte :base alloc :disp other-pointer-type))
 	 (storew x y bignum-digits-offset other-pointer-type)
diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp
index 30f47bb376bc51f1162bcd20065574aaedbf31e2..0bbfd165df8f86f2547a4c6288a163ffad0c0a02 100644
--- a/compiler/x86/sap.lisp
+++ b/compiler/x86/sap.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.4 1997/11/04 09:11:15 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.5 1997/11/05 14:59:59 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -42,8 +42,9 @@
   (:args (sap :scs (sap-reg) :to :result))
   (:results (res :scs (descriptor-reg) :from :argument))
   (:note "SAP to pointer coercion") 
+  (:node-var node)
   (:generator 20
-    (fixed-allocation res sap-type sap-size)
+    (fixed-allocation res sap-type sap-size node)
     (storew sap res sap-pointer-slot other-pointer-type)))
 	   
 ;;;