diff --git a/assembly/x86/alloc.lisp b/assembly/x86/alloc.lisp
index 4a9b13ad0125164a969b1f38300a8b1b5ebfefbf..4cd98cb44b34e6cc0aca7559e47ed162c06113c5 100644
--- a/assembly/x86/alloc.lisp
+++ b/assembly/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/assembly/x86/alloc.lisp,v 1.2 1997/02/10 16:59:54 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/alloc.lisp,v 1.3 1997/11/04 09:10:35 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -26,8 +26,7 @@
 (define-assembly-routine
     (move-from-signed)
     ((:temp eax dword-reg eax-offset)
-     (:temp ebx dword-reg ebx-offset)
-     (:temp ecx dword-reg ecx-offset))
+     (:temp ebx dword-reg ebx-offset))
   (inst mov ebx eax)
   (inst shl ebx 1)
   (inst jmp :o bignum)
@@ -36,8 +35,8 @@
   (inst ret)
   BIGNUM
 
-  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
-    (storew eax ebx bignum-digits-offset other-pointer-type))
+  (fixed-allocation ebx bignum-type (+ bignum-digits-offset 1))
+  (storew eax ebx bignum-digits-offset other-pointer-type)
 
   (inst ret))
 
@@ -45,8 +44,7 @@
 (define-assembly-routine
   (move-from-unsigned)
   ((:temp eax dword-reg eax-offset)
-   (:temp ebx dword-reg ebx-offset)
-   (:temp ecx dword-reg ecx-offset))
+   (:temp ebx dword-reg ebx-offset))
 
   (inst test eax #xe0000000)
   (inst jmp :nz bignum)
@@ -66,11 +64,11 @@
   (inst mov ebx eax)
 
   ;; Two word bignum
-  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 2))
-    (storew eax ebx bignum-digits-offset other-pointer-type))
+  (fixed-allocation ebx bignum-type (+ bignum-digits-offset 2))
+  (storew eax ebx bignum-digits-offset other-pointer-type)
   (inst ret)
   
   ONE-WORD-BIGNUM
-  (with-fixed-allocation (ebx ecx bignum-type (+ bignum-digits-offset 1))
-    (storew eax ebx bignum-digits-offset other-pointer-type))
+  (fixed-allocation ebx bignum-type (+ bignum-digits-offset 1))
+    (storew eax ebx bignum-digits-offset other-pointer-type)
   (inst ret))
diff --git a/assembly/x86/arith.lisp b/assembly/x86/arith.lisp
index 1b4b385a4d8bf16396983a3f89f6b971cdc2cdb9..5bc13ad32115b1a93b67b4edecddd71ae0f69d76 100644
--- a/assembly/x86/arith.lisp
+++ b/assembly/x86/arith.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/arith.lisp,v 1.4 1997/09/15 10:40:12 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/arith.lisp,v 1.5 1997/11/04 09:10:36 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -78,9 +78,8 @@
 
   (move ecx res)
 
-  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
-    (storew ecx res bignum-digits-offset other-pointer-type))
-
+  (fixed-allocation res bignum-type (1+ bignum-digits-offset))
+  (storew ecx res bignum-digits-offset other-pointer-type)
   
   OKAY)
 
@@ -99,8 +98,8 @@
   
   (move ecx res)
   
-  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
-    (storew ecx res bignum-digits-offset other-pointer-type))
+  (fixed-allocation res bignum-type (1+ bignum-digits-offset))
+  (storew ecx res bignum-digits-offset other-pointer-type)
   OKAY)
 
 (define-generic-arith-routine (* 30)
@@ -120,15 +119,15 @@
   (inst cmp x ecx)
   (inst jmp :e SINGLE-WORD-BIGNUM)
 
-  (with-fixed-allocation (res ebx bignum-type (+ bignum-digits-offset 2))
-    (storew eax res bignum-digits-offset other-pointer-type)
-    (storew ecx res (1+ bignum-digits-offset) other-pointer-type))
+  (fixed-allocation res bignum-type (+ bignum-digits-offset 2))
+  (storew eax res bignum-digits-offset other-pointer-type)
+  (storew ecx res (1+ bignum-digits-offset) other-pointer-type)
   (inst jmp DONE)
 
   SINGLE-WORD-BIGNUM
   
-  (with-fixed-allocation (res ebx bignum-type (1+ bignum-digits-offset))
-    (storew eax res bignum-digits-offset other-pointer-type))
+  (fixed-allocation res bignum-type (1+ bignum-digits-offset))
+  (storew eax res bignum-digits-offset other-pointer-type)
   (inst jmp DONE)
 
   OKAY
@@ -168,9 +167,8 @@
   (inst shr res 2)			; sign bit is data - remove type bits
   (move ecx res)
 
-  (with-fixed-allocation (res eax bignum-type (1+ bignum-digits-offset))
-    (storew ecx res bignum-digits-offset other-pointer-type))
-
+  (fixed-allocation res bignum-type (1+ bignum-digits-offset))
+  (storew ecx res bignum-digits-offset other-pointer-type)
   
   OKAY)
 
diff --git a/assembly/x86/array.lisp b/assembly/x86/array.lisp
index ce0e7d04521afcd5eb2619c39811cc13b6d974ef..56ab832dec28a0d05b0b8b4198a540598df9d90e 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.2 1997/02/10 17:03:44 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/array.lisp,v 1.3 1997/11/04 09:10:37 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -32,24 +32,13 @@
 			 ((:arg type unsigned-reg eax-offset)
 			  (:arg length any-reg ebx-offset)
 			  (:arg words any-reg ecx-offset)
-			  (:res result descriptor-reg edx-offset)
-
-			  (:temp alloc dword-reg edi-offset))
-  #-cgc
-  (with-allocation (alloc)
-    (inst lea result (make-ea :byte :base alloc :disp other-pointer-type))
-    (inst add alloc
-	  (+ (1- (ash 1 lowtag-bits)) (* vector-data-offset word-bytes)))
-    (inst add alloc words)
-    (inst and alloc (lognot vm:lowtag-mask)))
-  #+cgc
-  (progn
-    (inst mov alloc (+ (1- (ash 1 lowtag-bits))
-		       (* vector-data-offset word-bytes)))
-    (inst add alloc words)
-    (inst and alloc (lognot vm:lowtag-mask))
-    (with-cgc-allocation(alloc alloc)
-      (inst lea result (make-ea :byte :base alloc :disp other-pointer-type))))
+			  (:res result descriptor-reg edx-offset))
+  (inst mov result (+ (1- (ash 1 lowtag-bits))
+		      (* vector-data-offset word-bytes)))
+  (inst add result words)
+  (inst and result (lognot vm:lowtag-mask))
+  (var-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)
   (inst ret))
diff --git a/code/debug-int.lisp b/code/debug-int.lisp
index 400628bec33046975d2f4600aff58a5716cb557c..fe5d50f3c2c51089b80ec9c7951bbf034e6e4dd6 100644
--- a/code/debug-int.lisp
+++ b/code/debug-int.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.71 1997/02/08 17:22:40 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.72 1997/11/04 09:10:41 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -915,12 +915,19 @@
 ;	(format t "c-lra-fpc ~a ~a ~a~%" pc code pc-offset)
 	(values pc-offset code)))))
 
+#+x86
+(defun stack-ref-32 (stack offset)
+  (declare (type sys:system-area-pointer stack)
+	   (type fixnum offset)
+	   (optimize (speed 3) (safety 0)))
+  (kernel::get-lisp-obj-address (stack-ref stack offset)))
+
 ;;; maybe these should be generalized in xxx-vm.lisp
 ;;;(proclaim '(inline old-frame-pointer lisp-return-pc))
 (defun old-frame-pointer(scp)
   (declare (type (alien:alien (* unix:sigcontext)) scp))
   (let* #+x86 ((cfp (vm:sigcontext-register scp vm::ebp-offset))
-	       (ofp (kernel:stack-ref (int-sap cfp) vm::ocfp-save-offset)))
+	       (ofp (stack-ref-32 (int-sap cfp) vm::ocfp-save-offset)))
 	#-x86 ((ofp (vm:sigcontext-register scp vm::ocfp-offset)))
 	(declare (type (unsigned-byte 32) #+x86 cfp ofp))
 	(int-sap ofp)))
@@ -931,7 +938,7 @@
   ;;; return a value that can be used in computation
   (declare (type (alien:alien (* unix:sigcontext)) scp))
   (let* ((cfp (vm:sigcontext-register scp vm::ebp-offset))
-	 (lra (kernel:stack-ref (int-sap cfp) vm::return-pc-save-offset)))
+	 (lra (stack-ref-32 (int-sap cfp) vm::return-pc-save-offset)))
     lra))
 #-x86
 (defun lisp-return-pc(scp)
@@ -957,8 +964,8 @@
 ;; These return hopefully correct ofp ret values at a call site
 (defun maybe-lisp-from-c(fp)
   (declare (type system-area-pointer fp))
-  (let ((s0 (kernel:stack-ref fp vm::old-fp-save-offset))
-	(s1 (kernel:stack-ref fp vm::return-pc-save-offset)))
+  (let ((s0 (stack-ref-32 fp vm::old-fp-save-offset))
+	(s1 (stack-ref-32 fp vm::return-pc-save-offset)))
     (when (and (kernel:make-lisp-obj s0)(kernel:make-lisp-obj s1))
       (let ((lisp-ofp (int-sap s0))
 	    (lisp-lra (int-sap s1)))
@@ -973,8 +980,8 @@
 (defun maybe-lisp-from-lisp(fp)
     (declare (type system-area-pointer fp))
     (when (cstack-pointer-valid-p fp)
-      (let ((s0 (kernel:stack-ref fp vm::old-fp-save-offset))
-	    (s1 (kernel:stack-ref fp vm::return-pc-save-offset)))
+      (let ((s0 (stack-ref-32 fp vm::old-fp-save-offset))
+	    (s1 (stack-ref-32 fp vm::return-pc-save-offset)))
 	(when (and (kernel:make-lisp-obj s0)
 		   (kernel:make-lisp-obj s1))
 	  (let ((ofp (int-sap s0))
@@ -1145,9 +1152,9 @@
 	    (sub-access-debug-var-slot pointer loc escaped))))
 	(ecase stack-slot
 	  (#.vm::ocfp-save-offset
-	   (kernel:stack-ref pointer stack-slot))
+	   (stack-ref-32 pointer stack-slot))
 	  (#.vm::lra-save-offset
-	   (kernel:make-lisp-obj (kernel:stack-ref pointer stack-slot)))))))
+	   (kernel:stack-ref pointer stack-slot))))))
 
 ;;;
 (defun (setf get-context-value) (value frame stack-slot loc)
@@ -3082,9 +3089,8 @@
 	  (system:int-sap (- (system:sap-int fp)
 			  (* (+ (c::sc-offset-offset sc-offset) 2)
 				vm:word-bytes))) 0))
-      ((#.vm:control-stack-sc-number #.vm:immediate-stack-sc-number)
-       (kernel:make-lisp-obj
-	(kernel:stack-ref fp (c::sc-offset-offset sc-offset))))
+      (#.vm:control-stack-sc-number
+       (kernel:stack-ref fp (c::sc-offset-offset sc-offset)))
       (#.vm:base-char-stack-sc-number
        (code-char
 	(system:sap-ref-32
@@ -3299,7 +3305,7 @@
 	      (system:sap+ fp (* (+ (c::sc-offset-offset sc-offset) 2)
 				 (- vm:word-bytes))) 0)
 	     (the double-float value)))
-      ((#.vm:control-stack-sc-number #.vm:immediate-stack-sc-number)
+      (#.vm:control-stack-sc-number
        (setf (kernel:stack-ref fp (c::sc-offset-offset sc-offset)) value))
       (#.vm:base-char-stack-sc-number
        (setf (system:sap-ref-32
diff --git a/code/gc.lisp b/code/gc.lisp
index 7694c9f5b59f71397576ffdfb6901e969e559708..7932f262559850fe881760a809f40c67ee06e208 100644
--- a/code/gc.lisp
+++ b/code/gc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.21 1997/02/08 21:08:01 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.22 1997/11/04 09:10:44 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -47,14 +47,14 @@
 (c-var-frob current-dynamic-space-start "current_dynamic_space")
 (declaim (inline dynamic-usage))
 
-#-cgc
+#-(or cgc gencgc)
 (defun dynamic-usage ()
   (the (unsigned-byte 32)
        (- (system:sap-int (c::dynamic-space-free-pointer))
 	  (current-dynamic-space-start))))
 
-#+cgc
-(c-var-frob dynamic-usage "cgc_bytes_allocated")
+#+(or cgc gencgc)
+(c-var-frob dynamic-usage "bytes_allocated")
 
 (defun static-space-usage ()
   (- (* lisp::*static-space-free-pointer* vm:word-bytes)
diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index 45546857d385a7045a49214fbbbafa229bb7ec76..72fa50820a8fff521fda812b59302ff8e4e0b743 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.50 1997/09/15 16:47:04 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.51 1997/11/04 09:10:45 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -518,7 +518,8 @@
 	 (let ((loc (int-sap (- (sap-int ptr) offset))))
 	   (cond ((= offset bytes-per-scrub-unit)
 		  count)
-		 ((zerop (stack-ref loc 0))
+		 ((zerop (kernel::get-lisp-obj-address (stack-ref loc 0)))
+;		 ((zerop (stack-ref loc 0))
 		  (look ptr (+ offset vm:word-bytes) count))
 		 (t
 		  (scrub ptr offset (+ count vm:word-bytes)))))))
diff --git a/code/symbol.lisp b/code/symbol.lisp
index abb94dd2acc39fcf9ff5d196f6187f343e0f3fb5..c6dc92543bf276bc4942e5318da0db6289b9a12b 100644
--- a/code/symbol.lisp
+++ b/code/symbol.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.22 1997/02/27 22:40:38 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/symbol.lisp,v 1.23 1997/11/04 09:10:46 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -99,7 +99,7 @@
   #-gengc (make-symbol string)
   #+gengc (%make-symbol (random most-positive-fixnum) string))
 
-#+gengc
+#+(or gengc x86)
 (defun symbol-hash (symbol)
   "Return the hash value for symbol."
   (symbol-hash symbol))
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index db4780caef7cfbd97c311ce53cd88ceba38f804a..6ad67b111fabcaf7efb2a3657c0eef25961c533c 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.25 1997/11/01 22:58:33 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.26 1997/11/04 09:10:51 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -543,6 +543,10 @@
 		 (or *cold-symbol-allocation-space* *dynamic*)
 		 vm:word-bits (1- vm:symbol-size) vm:symbol-header-type)))
     (write-indexed symbol vm:symbol-value-slot unbound-marker)
+    (when (c:backend-featurep :x86)
+      (write-indexed symbol vm:symbol-hash-slot
+		     (make-fixnum-descriptor
+		      (1+ (random vm:target-most-positive-fixnum)))))
     (write-indexed symbol vm:symbol-plist-slot *nil-descriptor*)
     (write-indexed symbol vm:symbol-name-slot (string-to-core name *dynamic*))
     (write-indexed symbol vm:symbol-package-slot *nil-descriptor*)
@@ -750,7 +754,8 @@
       (frob "*FP-CONSTANT-0D0*" "X86" (number-to-core 0d0))
       (frob "*FP-CONSTANT-1D0*" "X86" (number-to-core 1d0))
       (frob "*FP-CONSTANT-0S0*" "X86" (number-to-core 0s0))
-      (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0)))))
+      (frob "*FP-CONSTANT-1S0*" "X86" (number-to-core 1s0))
+      (frob "*SCAVENGE-READ-ONLY-SPACE*" "X86" (cold-intern t)))))
 
 ;;; Make-Make-Package-Args  --  Internal
 ;;;
@@ -1684,9 +1689,12 @@
      ((and is-linux (gethash (concatenate 'string "PVE_stub_" name)
 			     *cold-foreign-symbol-table* nil)))
      ;; Non-linux case
-     ((let ((value (gethash name *cold-foreign-symbol-table* nil)))
-        #+irix (when (and (numberp value) (zerop value))
-                 (warn "Not-really-defined foreign symbol: ~S" name))
+     (#-irix
+      (gethash name *cold-foreign-symbol-table* nil)
+      #+irix
+      (let ((value (gethash name *cold-foreign-symbol-table* nil)))
+        (when (and (numberp value) (zerop value))
+	  (warn "Not-really-defined foreign symbol: ~S" name))
         value))
      ((and is-linux (gethash (concatenate 'string "__libc_" name)
 			     *cold-foreign-symbol-table* nil)))
diff --git a/compiler/generic/objdef.lisp b/compiler/generic/objdef.lisp
index c58468c8195305d071348777e4ed8d20134d4ff6..9dda74e9238687ee407d6e618917e43458f6e784 100644
--- a/compiler/generic/objdef.lisp
+++ b/compiler/generic/objdef.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.39 1997/11/01 22:58:35 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/objdef.lisp,v 1.40 1997/11/04 09:10:53 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -451,15 +451,20 @@
 (defknown symbol-hash (symbol) index
   (flushable movable))
 
+#+x86
+(defknown symbol-hash (symbol) cl::hash
+  (flushable movable))
+
 (define-primitive-object (symbol :lowtag other-pointer-type
 				 :header symbol-header-type
-				 :alloc-trans
-				 #-gengc make-symbol
+				 #-x86 :alloc-trans
+				 #-(or gengc x86) make-symbol
 				 #+gengc %make-symbol)
   (value :set-trans %set-symbol-value
 	 :init :unbound)
-  #-gengc unused
+  #-(or gengc x86) unused
   #+gengc (hash :init :arg)
+  #+x86 (hash)
   (plist :ref-trans symbol-plist
 	 :set-trans %set-symbol-plist
 	 :init :null)
diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp
index bc7c24b3dc2b18692976cb1d3f21253b2adfccee..9216f91bb08eb67de16653a920a0d752e75a6918 100644
--- a/compiler/globaldb.lisp
+++ b/compiler/globaldb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.34 1997/04/16 18:11:23 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.35 1997/11/04 09:10:48 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -289,16 +289,16 @@
 (defun info-hash (x)
   (cond
    ((symbolp x)
-    #-gengc (%sxhash-simple-string (symbol-name x))
-    #+gengc (symbol-hash x))
+    #-(or gengc x86) (%sxhash-simple-string (symbol-name x))
+    #+(or gengc x86) (symbol-hash x))
    ((and (listp x)
 	 (eq (car x) 'setf)
 	 (let ((next (cdr x)))
 	   (when (listp next)
 	     (let ((name (car next)))
 	       (when (and (symbolp name) (null (cdr next)))
-		 (logxor #-gengc (%sxhash-simple-string (symbol-name name))
-			 #+gengc (symbol-hash name)
+		 (logxor #-(or gengc x86) (%sxhash-simple-string (symbol-name name))
+			 #+(or gengc x86) (symbol-hash name)
 			 110680597)))))))
    (t
     (sxhash x))))
@@ -459,8 +459,8 @@
 	(logand
 	 (the fixnum
 	      (logxor (the fixnum
-			   #+gengc (info-hash ,name)
-			   #-gengc (cache-hash-eq ,name))
+			   #+(or gengc x86) (info-hash ,name)
+			   #-(or gengc x86) (cache-hash-eq ,name))
 		      (the fixnum (ash (the fixnum ,type) 7))))
 	 #x3FF)))
 
@@ -492,11 +492,11 @@
 ;;; Not needed with the gengc system, because we use an address independent
 ;;; hashing.
 ;;; 
-#-gengc
+#-(or gengc x86)
 (defun info-cache-gc-hook ()
   (setq *cached-info-environment* nil))
 ;;;
-#-gengc
+#-(or gengc x86)
 (pushnew 'info-cache-gc-hook *after-gc-hooks*)
 
 
diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp
index 5d5601fbbb920b29e58ae3af9808670664dbc68e..382fa61fa5477ecf9a3eb257f0222037837a7745 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.2 1997/02/08 21:15:38 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.3 1997/11/04 09:10:55 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,6 +16,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1996.
 ;;; 
 
 (in-package :x86)
@@ -43,21 +44,13 @@
 		  `(let ((reg
 			  (sc-case ,tn
 			    ((any-reg descriptor-reg) ,tn)
-			    ((descriptor-stack immediate-stack)
+			    ((descriptor-stack)
 			     (move temp ,tn)
 			     temp))))
 		     (storew reg ,list ,slot vm:list-pointer-type))))
 	     (let ((cons-cells (if star (1- num) num)))
-	       #-cgc
-	       (with-allocation (temp)
-		 (inst lea res
-		       (make-ea :byte :base temp :disp list-pointer-type))
-		 (inst add temp (* (pad-data-block cons-size) cons-cells)))
-	       #+cgc
-	       (with-cgc-allocation (temp (* (pad-data-block cons-size)
-					     cons-cells))
-		 (inst lea res
-		       (make-ea :byte :base temp :disp list-pointer-type)))
+	       (allocation res (* (pad-data-block cons-size) cons-cells))
+	       (inst lea res (make-ea :byte :base res :disp list-pointer-type))
 	       (move ptr res)
 	       (dotimes (i (1- cons-cells))
 		 (store-car (tn-ref-tn things) ptr)
@@ -99,17 +92,12 @@
     (inst shr unboxed word-shift)
     (inst add unboxed lowtag-mask)
     (inst and unboxed (lognot lowtag-mask))
-    #+nil ;; keep this here in case we load code in dynamic again
-    (with-allocation (temp)
-      (inst lea result (make-ea :byte :base temp :disp other-pointer-type))
-      (inst add temp boxed)
-      (inst add temp unboxed))
-    (progn ;; now loading code into static space cause it can't move
-      (load-symbol-value temp lisp::*static-space-free-pointer*)
-      (inst lea result (make-ea :byte :base temp :disp other-pointer-type))
-      (inst add temp boxed)
-      (inst add temp unboxed)
-      (store-symbol-value temp lisp::*static-space-free-pointer*))
+    ;; now loading code into static space cause it can't move
+    (load-symbol-value temp lisp::*static-space-free-pointer*)
+    (inst lea result (make-ea :byte :base temp :disp other-pointer-type))
+    (inst add temp boxed)
+    (inst add temp unboxed)
+    (store-symbol-value temp lisp::*static-space-free-pointer*)
     (inst shl boxed (- type-bits word-shift))
     (inst or boxed code-header-type)
     (storew boxed result 0 other-pointer-type)
@@ -119,15 +107,11 @@
     (storew temp result code-entry-points-slot other-pointer-type)
     (storew temp result code-debug-info-slot other-pointer-type)))
 
-;;; Top-Level-Forms have a short lifetime as they are unreachable
-;;; once the loader eval's them. No point loading them in static
-;;; space. This justs gives the loader a way to grab a chunk
-;;; of the dynamic heap.
+
 (define-vop (allocate-dynamic-code-object)
   (:args (boxed-arg :scs (any-reg) :target boxed)
 	 (unboxed-arg :scs (any-reg) :target unboxed))
-  (:results (result :scs (descriptor-reg)))
-  (:temporary (:sc dword-reg :from :eval) temp)
+  (:results (result :scs (descriptor-reg) :from :eval))
   (:temporary (:sc dword-reg :from (:argument 0)) boxed)
   (:temporary (:sc dword-reg :from (:argument 1)) unboxed)
   (:generator 100
@@ -138,72 +122,52 @@
     (inst shr unboxed word-shift)
     (inst add unboxed lowtag-mask)
     (inst and unboxed (lognot lowtag-mask))
-    #-cgc
-    (with-allocation (temp)
-      (inst lea result (make-ea :byte :base temp :disp other-pointer-type))
-      (inst add temp boxed)
-      (inst add temp unboxed))
-    #+cgc
-    (progn 
-      (move temp boxed)
-      (inst add temp unboxed)
-      (with-cgc-allocation (temp temp)
-	(inst lea result (make-ea :byte :base temp :disp other-pointer-type))))
+    (inst mov result boxed)
+    (inst add result unboxed)
+    (var-allocation result result)
+    (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)
     (storew boxed result 0 other-pointer-type)
     (storew unboxed result code-code-size-slot other-pointer-type)
-    (inst mov temp nil-value)
-    (storew temp result code-entry-points-slot other-pointer-type)
-    (storew temp result code-debug-info-slot other-pointer-type)))
+    (storew nil-value result code-entry-points-slot other-pointer-type)
+    (storew nil-value result code-debug-info-slot other-pointer-type)))
+
 
 (define-vop (make-fdefn)
   (:policy :fast-safe)
   (:translate make-fdefn)
   (:args (name :scs (descriptor-reg) :to :eval))
-  (:temporary (:sc dword-reg) alloc)
   (:results (result :scs (descriptor-reg) :from :argument))
   (:generator 37
-    (with-fixed-allocation (result alloc fdefn-type fdefn-size)
-      (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
-	      fdefn-raw-addr-slot other-pointer-type))))
+    (fixed-allocation result fdefn-type fdefn-size)
+    (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
+	    fdefn-raw-addr-slot other-pointer-type)))
 
 
 (define-vop (make-closure)
-	    (:args (function :to :save :scs (descriptor-reg)))
+  (:args (function :to :save :scs (descriptor-reg)))
   (:info length)
   (:temporary (:sc any-reg) temp)
   (:results (result :scs (descriptor-reg)))
   (:generator 10
    (let ((size (+ length closure-info-offset)))
-     #-cgc
-     (with-allocation (temp)
-       (inst lea result (make-ea :byte :base temp :disp function-pointer-type))
-       (inst add temp (pad-data-block size))
-       (storew 0 temp 0)
-       (storew (logior (ash (1- size) type-bits) closure-header-type)
-	       result 0 function-pointer-type))
-     #+cgc
-     (with-cgc-allocation(temp (pad-data-block size))
-       (inst lea result
-	     (make-ea :byte :base temp :disp function-pointer-type))
-       (storew (logior (ash (1- size) type-bits) closure-header-type)
-	       temp 0))
-     
-     (loadw temp function closure-function-slot function-pointer-type)
-     (storew temp result closure-function-slot function-pointer-type))))
+     (allocation result (pad-data-block size))
+     (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))
+   (loadw temp function closure-function-slot function-pointer-type)
+   (storew temp result closure-function-slot function-pointer-type)))
 
 ;;; The compiler likes to be able to directly make value cells.
 ;;; 
 (define-vop (make-value-cell)
-  (:args (value :to :save :scs (descriptor-reg any-reg)))
-  (:temporary (:sc any-reg) temp)
-  (:results (result :scs (descriptor-reg)))
+  (:args (value :scs (descriptor-reg any-reg) :to :result))
+  (:results (result :scs (descriptor-reg) :from :eval))
   (:generator 10
-    (with-fixed-allocation
-	(result temp value-cell-header-type value-cell-size))
+    (fixed-allocation result value-cell-header-type value-cell-size)
     (storew value result value-cell-value-slot other-pointer-type)))
 
 
@@ -221,29 +185,21 @@
   (:info name words type lowtag)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
-  (:temporary (:sc descriptor-reg) temp)
-  (:generator #-cgc 4 #+cgc 50
-    #-cgc
-    (with-allocation(temp)		; dynamic free ptr
-      (inst lea result (make-ea :byte :base temp :disp lowtag))
-      (inst add temp (pad-data-block words))
-      (storew 0 temp 0 0))
-    #+cgc
-    (with-cgc-allocation(temp (pad-data-block words))
-      (inst lea result (make-ea :byte :base temp :disp lowtag)))
-
+  (:generator 50
+    (allocation result (pad-data-block words))
+    (inst lea result (make-ea :byte :base result :disp lowtag))
     (when type
-      (inst mov temp (logior (ash (1- words) type-bits) type))
-      (storew temp result 0 lowtag))))
+      (storew (logior (ash (1- words) type-bits) type) result 0 lowtag))))
 
 (define-vop (var-alloc)
-    (:args (extra :scs (any-reg)))
+  (:args (extra :scs (any-reg)))
   (:arg-types positive-fixnum)
   (:info name words type lowtag)
   (:ignore name)
-  (:results (result :scs (descriptor-reg)))
-  (:temporary (:sc any-reg) bytes header alloc)
-  (:generator #-cgc 6 #+cgc 50
+  (: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)
+  (:generator 50
     (inst lea bytes
 	  (make-ea :dword :base extra :disp (* (1+ words) word-bytes)))
     (inst mov header bytes)
@@ -252,17 +208,33 @@
     (inst lea header			; (w-1 << 8) | type
 	  (make-ea :dword :base header :disp (+ (ash -2 type-bits) type)))
     (inst and bytes (lognot lowtag-mask))
-    #-cgc
-    (with-allocation (alloc)
-      (inst lea result (make-ea :byte :base alloc :disp lowtag))
-      (storew header result 0 lowtag)
-      (inst add alloc bytes)
-      (storew 0 alloc 0))
-    ;; Note that the above inst stores into the free space which
-    ;; is probably already zeroed. It is a lose in the cgc case because
-    ;; it might trash the next region header.
-    #+cgc
-    (with-cgc-allocation (alloc bytes)
-      (inst lea result (make-ea :byte :base alloc :disp lowtag))
-      (storew header result 0 lowtag))))
+    (var-allocation result bytes)
+    (inst lea result (make-ea :byte :base result :disp lowtag))
+    (storew header result 0 lowtag)))
 
+
+
+(define-vop (make-symbol)
+  (:policy :fast-safe)
+  (:translate make-symbol)
+  (:args (name :scs (descriptor-reg) :to :eval))
+  (:temporary (:sc dword-reg :from :eval) temp)
+  (:results (result :scs (descriptor-reg) :from :argument))
+  (:generator 37
+    (fixed-allocation result symbol-header-type symbol-size)
+    (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
+    ;; address could be used for even faster and smaller code!
+    (inst imul temp
+	  (make-fixup (extern-alien-name "fast_random_state") :foreign)
+	  1103515245)
+    (inst add temp 12345)
+    (inst mov (make-fixup (extern-alien-name "fast_random_state") :foreign)
+	  temp)
+    ;; Want a positive fixnum for the hash value, discard the LS bits.
+    (inst shr temp 1)
+    (inst and temp #xfffffffc)
+    (storew temp result symbol-hash-slot other-pointer-type)
+    (storew nil-value result symbol-plist-slot other-pointer-type)
+    (storew nil-value result symbol-package-slot other-pointer-type)))
diff --git a/compiler/x86/arith.lisp b/compiler/x86/arith.lisp
index d82942c43a499b18410f7c1e488eb4af13570059..8d7436c6752a0e41f043ed54a3aa16b792973cdb 100644
--- a/compiler/x86/arith.lisp
+++ b/compiler/x86/arith.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/arith.lisp,v 1.6 1997/09/29 04:49:17 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.7 1997/11/04 09:10:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -77,16 +77,16 @@
 
 (define-vop (fast-fixnum-binop fast-safe-arith-op)
   (:args (x :target r :scs (any-reg)
-	    :load-if (not (and (sc-is x immediate-stack)
+	    :load-if (not (and (sc-is x descriptor-stack)
 			       (sc-is y any-reg)
-			       (sc-is r immediate-stack)
+			       (sc-is r descriptor-stack)
 			       (location= x r))))
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:results (r :scs (any-reg) :from (:argument 0)
-	       :load-if (not (and (sc-is x immediate-stack)
+	       :load-if (not (and (sc-is x descriptor-stack)
 				  (sc-is y any-reg)
-				  (sc-is r immediate-stack)
+				  (sc-is r descriptor-stack)
 				  (location= x r)))))
   (:result-types tagged-num)
   (:note "inline fixnum arithmetic"))
@@ -124,7 +124,7 @@
   (:note "inline (signed-byte 32) arithmetic"))
 
 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
-  (:args (x :target r :scs (any-reg immediate-stack)))
+  (:args (x :target r :scs (any-reg descriptor-stack)))
   (:info y)
   (:arg-types tagged-num (:constant (signed-byte 30)))
   (:results (r :scs (any-reg)
@@ -208,16 +208,16 @@
 (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
   (:translate +)
   (:args (x :scs (any-reg) :target r
-	    :load-if (not (and (sc-is x immediate-stack)
+	    :load-if (not (and (sc-is x descriptor-stack)
 			       (sc-is y any-reg)
-			       (sc-is r immediate-stack)
+			       (sc-is r descriptor-stack)
 			       (location= x r))))
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:results (r :scs (any-reg) :from (:argument 0)
-	       :load-if (not (and (sc-is x immediate-stack)
+	       :load-if (not (and (sc-is x descriptor-stack)
 				  (sc-is y any-reg)
-				  (sc-is r immediate-stack)
+				  (sc-is r descriptor-stack)
 				  (location= x r)))))
   (:result-types tagged-num)
   (:note "inline fixnum arithmetic")
@@ -231,7 +231,7 @@
 
 (define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
   (:translate +)
-  (:args (x :target r :scs (any-reg immediate-stack)))
+  (:args (x :target r :scs (any-reg descriptor-stack)))
   (:info y)
   (:arg-types tagged-num (:constant (signed-byte 30)))
   (:results (r :scs (any-reg)
@@ -337,7 +337,7 @@
   (:translate *)
   ;; We need different loading characteristics.
   (:args (x :scs (any-reg) :target r)
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:results (r :scs (any-reg) :from (:argument 0)))
   (:result-types tagged-num)
@@ -350,7 +350,7 @@
 (define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op)
   (:translate *)
   ;; We need different loading characteristics.
-  (:args (x :scs (any-reg immediate-stack)))
+  (:args (x :scs (any-reg descriptor-stack)))
   (:info y)
   (:arg-types tagged-num (:constant (signed-byte 30)))
   (:results (r :scs (any-reg)))
@@ -407,7 +407,7 @@
 (define-vop (fast-truncate/fixnum=>fixnum fast-safe-arith-op)
   (:translate truncate)
   (:args (x :scs (any-reg) :target eax)
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:temporary (:sc dword-reg :offset eax-offset :target quo
 		   :from (:argument 0) :to (:result 0)) eax)
@@ -568,14 +568,14 @@
   (:translate ash)
   (:policy :fast-safe)
   (:args (number :scs (any-reg) :target result
-		 :load-if (not (and (sc-is number any-reg immediate-stack)
-				    (sc-is result any-reg immediate-stack)
+		 :load-if (not (and (sc-is number any-reg descriptor-stack)
+				    (sc-is result any-reg descriptor-stack)
 				    (location= number result)))))
   (:info amount)
   (:arg-types tagged-num (:constant integer))
   (:results (result :scs (any-reg)
-		    :load-if (not (and (sc-is number immediate-stack)
-				       (sc-is result immediate-stack)
+		    :load-if (not (and (sc-is number descriptor-stack)
+				       (sc-is result descriptor-stack)
 				       (location= number result)))))
   (:result-types tagged-num)
   (:note "inline ASH")
@@ -603,15 +603,15 @@
 (define-vop (fast-ash-left/fixnum=>fixnum)
   (:translate ash)
   (:args (number :scs (any-reg) :target result
-		 :load-if (not (and (sc-is number immediate-stack)
-				    (sc-is result immediate-stack)
+		 :load-if (not (and (sc-is number descriptor-stack)
+				    (sc-is result descriptor-stack)
 				    (location= number result))))
 	 (amount :scs (unsigned-reg) :target ecx))
   (:arg-types tagged-num positive-fixnum)
   (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 1)) ecx)
   (:results (result :scs (any-reg) :from (:argument 0)
-		    :load-if (not (and (sc-is number immediate-stack)
-				       (sc-is result immediate-stack)
+		    :load-if (not (and (sc-is number descriptor-stack)
+				       (sc-is result descriptor-stack)
 				       (location= number result)))))
   (:result-types tagged-num)
   (:policy :fast-safe)
@@ -794,14 +794,14 @@
 
 (define-vop (fast-conditional/fixnum fast-conditional)
   (:args (x :scs (any-reg)
-	    :load-if (not (and (sc-is x immediate-stack)
+	    :load-if (not (and (sc-is x descriptor-stack)
 			       (sc-is y any-reg))))
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:note "inline fixnum comparison"))
 
 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
-  (:args (x :scs (any-reg immediate-stack)))
+  (:args (x :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num (:constant (signed-byte 30)))
   (:info target not-p y))
 
@@ -899,9 +899,9 @@
 
 (define-vop (fast-eql/fixnum fast-conditional)
   (:args (x :scs (any-reg)
-	    :load-if (not (and (sc-is x immediate-stack)
+	    :load-if (not (and (sc-is x descriptor-stack)
 			       (sc-is y any-reg))))
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num tagged-num)
   (:note "inline fixnum comparison")
   (:translate eql)
@@ -913,12 +913,12 @@
   (:args (x :scs (any-reg descriptor-reg)
 	    :load-if (not (and (sc-is x descriptor-stack)
 			       (sc-is y any-reg))))
-	 (y :scs (any-reg immediate-stack)))
+	 (y :scs (any-reg descriptor-stack)))
   (:arg-types * tagged-num)
   (:variant-cost 7))
 
 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
-  (:args (x :scs (any-reg immediate-stack)))
+  (:args (x :scs (any-reg descriptor-stack)))
   (:arg-types tagged-num (:constant (signed-byte 30)))
   (:info target not-p y)
   (:translate eql)
@@ -930,7 +930,7 @@
     (inst jmp (if not-p :ne :e) target)))
 ;;;
 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
-  (:args (x :scs (any-reg immediate-stack descriptor-reg descriptor-stack)))
+  (:args (x :scs (any-reg descriptor-reg descriptor-stack)))
   (:arg-types * (:constant (signed-byte 30)))
   (:variant-cost 6))
 
@@ -1052,6 +1052,7 @@
     (move ecx amount)
     (inst shl r :cl)))
 
+
 
 ;;;; Bignum stuff.
 
@@ -1112,7 +1113,7 @@
   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg) :to :eval :target result)
 	 (b :scs (unsigned-reg unsigned-stack) :to :result)
-	 (c :scs (any-reg immediate-stack)))
+	 (c :scs (any-reg descriptor-stack)))
   (:arg-types unsigned-num unsigned-num positive-fixnum)
   (:results (result :scs (unsigned-reg) :from :eval)
 	    (borrow :scs (unsigned-reg)))
@@ -1208,10 +1209,10 @@
 (define-vop (fixnum-to-digit)
   (:translate bignum::%fixnum-to-digit)
   (:policy :fast-safe)
-  (:args (fixnum :scs (any-reg immediate-stack) :target digit))
+  (:args (fixnum :scs (any-reg descriptor-stack) :target digit))
   (:arg-types tagged-num)
   (:results (digit :scs (unsigned-reg)
-		   :load-if (not (and (sc-is fixnum immediate-stack)
+		   :load-if (not (and (sc-is fixnum descriptor-stack)
 				      (sc-is digit unsigned-stack)
 				      (location= fixnum digit)))))
   (:result-types unsigned-num)
@@ -1247,12 +1248,12 @@
   (:arg-types unsigned-num)
   (:results (res :scs (any-reg signed-reg)
 		 :load-if (not (and (sc-is digit unsigned-stack)
-				    (sc-is res immediate-stack signed-stack)
+				    (sc-is res descriptor-stack signed-stack)
 				    (location= digit res)))))
   (:result-types signed-num)
   (:generator 1
     (move res digit)
-    (when (sc-is res any-reg immediate-stack)
+    (when (sc-is res any-reg descriptor-stack)
       (inst shl res 2))))
 
 (define-vop (digit-ashr)
diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp
index 74a4c8166e9e1b788ece4f890cd22a33a3a67583..738ee52ad02277ebb5cd3e88e3fb619216a548fb 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.6 1997/11/01 22:58:42 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.7 1997/11/04 09:10:58 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -30,10 +30,9 @@
   (:args (type :scs (any-reg))
 	 (rank :scs (any-reg)))
   (:arg-types positive-fixnum positive-fixnum)
-  (:temporary (:sc any-reg) bytes)
-  (:temporary (:sc any-reg) header)
-  (:temporary (:sc any-reg) alloc)
-  (:results (result :scs (descriptor-reg)))
+  (:temporary (:sc any-reg :to :eval) bytes)
+  (:temporary (:sc any-reg :to :result) header)
+  (:results (result :scs (descriptor-reg) :from :eval))
   (:generator 13
     (inst lea bytes
 	  (make-ea :dword :base rank
@@ -45,13 +44,8 @@
     (inst shl header type-bits)
     (inst or  header type)
     (inst shr header 2)
-    #-cgc
-    (with-allocation (alloc)
-      (inst lea result (make-ea :dword :base alloc :disp other-pointer-type))
-      (inst add alloc bytes))
-    #+cgc
-    (with-cgc-allocation (alloc bytes)
-      (inst lea result (make-ea :dword :base alloc :disp other-pointer-type)))
+    (var-allocation result bytes)
+    (inst lea result (make-ea :dword :base result :disp other-pointer-type))
     (storew header result 0 other-pointer-type)))
 
 
diff --git a/compiler/x86/c-call.lisp b/compiler/x86/c-call.lisp
index 360cc45ba53824eb3a1e0f207c3f56cbab1b8f7a..59bd18cd9e74655baeb76c09907d5f5b3e03483b 100644
--- a/compiler/x86/c-call.lisp
+++ b/compiler/x86/c-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/c-call.lisp,v 1.4 1997/09/07 23:27:50 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/c-call.lisp,v 1.5 1997/11/04 09:10:59 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,7 +17,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
-;;; Debugging and Enhancements by Douglas Crosher 1996.
+;;; Debugging and Enhancements by Douglas Crosher 1996,1997.
 ;;;
 
 (in-package :x86)
@@ -205,7 +205,7 @@
   (:generator 0
     (assert (location= result esp-tn))
     (unless (zerop amount)
-      (let ( (delta (logandc2 (+ amount 3) 3)) )
+      (let ((delta (logandc2 (+ amount 3) 3)))
 	(inst sub esp-tn delta)))
     (move result esp-tn)))
 
@@ -213,7 +213,7 @@
   (:info amount)
   (:generator 0
     (unless (zerop amount)
-      (let ( (delta (logandc2 (+ amount 3) 3)) )
+      (let ((delta (logandc2 (+ amount 3) 3)))
 	(inst add esp-tn delta)))))
 
 (define-vop (alloc-alien-stack-space)
@@ -222,7 +222,7 @@
   (:generator 0
     (assert (not (location= result esp-tn)))
     (unless (zerop amount)
-      (let ( (delta (logandc2 (+ amount 3) 3)) )
+      (let ((delta (logandc2 (+ amount 3) 3)))
 	(inst sub (make-ea :dword
 			   :disp (+ nil-value
 				    (static-symbol-offset '*alien-stack*)
@@ -235,7 +235,7 @@
   (:info amount)
   (:generator 0
     (unless (zerop amount)
-      (let ( (delta (logandc2 (+ amount 3) 3)) )
+      (let ((delta (logandc2 (+ amount 3) 3)))
 	(inst add (make-ea :dword
 			   :disp (+ nil-value
 				    (static-symbol-offset '*alien-stack*)
diff --git a/compiler/x86/call.lisp b/compiler/x86/call.lisp
index 654c4098cf084beb409ea7325d2955b476a5a976..51e7172dbdeef0c09e947863abeff65e486a33c6 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.3 1997/10/05 16:43:03 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/call.lisp,v 1.4 1997/11/04 09:11:00 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -50,7 +50,7 @@
 (def-vm-support-routine make-return-pc-passing-location (standard)
   (declare (ignore standard))
   (make-wired-tn *fixnum-primitive-type*
-		 immediate-stack-sc-number
+		 descriptor-stack-sc-number
 		 return-pc-save-offset))
 ;;;
 ;;; If standard is true, then use the standard (full call) location,
@@ -60,7 +60,7 @@
 #+nil
 (def-vm-support-routine make-return-pc-passing-location (standard)
   (if standard
-      (make-wired-tn *fixnum-primitive-type* immediate-stack-sc-number
+      (make-wired-tn *fixnum-primitive-type* descriptor-stack-sc-number
 		     return-pc-save-offset)
       (make-normal-tn *fixnum-primitive-type*)))
 
@@ -79,7 +79,7 @@
 (def-vm-support-routine make-old-fp-passing-location (standard)
   (declare (ignore standard))
   (make-wired-tn *fixnum-primitive-type*
-		 immediate-stack-sc-number
+		 descriptor-stack-sc-number
 		 old-fp-save-offset))
 ;;;
 ;;; If standard is true, then use the standard (full call) location,
@@ -89,7 +89,7 @@
 #+nil
 (def-vm-support-routine make-old-fp-passing-location (standard)
   (if standard
-      (make-wired-tn *fixnum-primitive-type* immediate-stack-sc-number old-fp-save-offset)
+      (make-wired-tn *fixnum-primitive-type* descriptor-stack-sc-number old-fp-save-offset)
       (make-normal-tn *fixnum-primitive-type*)))
 
 ;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location  --  Interface
@@ -102,7 +102,7 @@
 ;;; wire to the stack? No problems.
 (def-vm-support-routine make-old-fp-save-location (env)
   (environment-debug-live-tn (make-wired-tn *fixnum-primitive-type*
-					    immediate-stack-sc-number
+					    descriptor-stack-sc-number
 					    old-fp-save-offset)
 			     env))
 ;;;
@@ -112,7 +112,7 @@
   (specify-save-tn
    (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
    (make-wired-tn *fixnum-primitive-type*
-		  immediate-stack-sc-number
+		  descriptor-stack-sc-number
 		  ocfp-save-offset)))
 
 ;;;
@@ -120,7 +120,7 @@
 ;;; wire to the stack? No problems.
 (def-vm-support-routine make-return-pc-save-location (env)
   (environment-debug-live-tn (make-wired-tn *fixnum-primitive-type*
-					    immediate-stack-sc-number
+					    descriptor-stack-sc-number
 					    return-pc-save-offset)
 			     env))
 ;;;
@@ -131,7 +131,7 @@
     (specify-save-tn
      (environment-debug-live-tn (make-normal-tn ptype) env)
      (make-wired-tn ptype
-		    immediate-stack-sc-number
+		    descriptor-stack-sc-number
 		    return-pc-save-offset))))
 
 ;;; Make-Argument-Count-Location  --  Interface
@@ -179,9 +179,12 @@
 ;;; placeholder entries in the Constants to leave room for additional
 ;;; noise in the code object header.
 ;;;
+;;; For the x86 the first constant is a pointer to a list of fixups,
+;;; or nil if the code object has none.
+;;;
 (def-vm-support-routine select-component-format (component)
   (declare (type component component))
-  (dotimes (i code-constants-offset)
+  (dotimes (i (1+ code-constants-offset))
     (vector-push-extend nil
 			(ir2-component-constants (component-info component))))
   (undefined-value))
@@ -192,7 +195,7 @@
 ;;; Used for setting up the Old-FP in local call.
 ;;;
 (define-vop (current-fp)
-  (:results (val :scs (any-reg immediate-stack)))
+  (:results (val :scs (any-reg descriptor-stack)))
   (:generator 1
     (move val ebp-tn)))
 
@@ -224,7 +227,7 @@
     (popw ebp-tn (- (1+ return-pc-save-offset)))
 
     ;; If copy-more-arg follows it will allocate the correct stack
-    ;; size. The stack is not allocate first here as this may expose
+    ;; size. The stack is not allocated first here as this may expose
     ;; args on the stack if they take up more space than the frame!
     (unless copy-more-arg-follows
       ;; The args fit within the frame so just allocate the frame.
@@ -240,7 +243,7 @@
 ;;; callee (who has the same size stack as us).
 ;;; 
 (define-vop (allocate-frame)
-  (:results (res :scs (any-reg immediate-stack))
+  (:results (res :scs (any-reg descriptor-stack))
 	    (nfp))
   (:info callee)
   (:ignore nfp callee)
@@ -254,7 +257,7 @@
 ;;;
 (define-vop (allocate-full-call-frame)
   (:info nargs)
-  (:results (res :scs (any-reg immediate-stack)))
+  (:results (res :scs (any-reg descriptor-stack)))
   (:generator 2
     (move res esp-tn)
     (inst sub esp-tn (* (max nargs 3) vm:word-bytes))))
@@ -508,8 +511,8 @@
   (:temporary (:sc any-reg :offset ecx-offset
 	       :from :eval :to (:result 1))
 	      nvals)
-  (:results (start :scs (any-reg immediate-stack))
-	    (count :scs (any-reg immediate-stack))))
+  (:results (start :scs (any-reg descriptor-stack))
+	    (count :scs (any-reg descriptor-stack))))
 
 
 ;;;; Local call with unknown values convention return:
@@ -556,7 +559,7 @@
 
       ;; Is the return-pc on the stack or in a register?
       (sc-case ret-tn
-	((immediate-stack)
+	((descriptor-stack)
 #+nil	 (format t "*call-local: ret-tn on stack; offset=~s~%"
 		 (tn-offset ret-tn))
 	 ;; Stack
@@ -605,7 +608,7 @@
 
       ;; Is the return-pc on the stack or in a register?
       (sc-case ret-tn
-	((immediate-stack)
+	((descriptor-stack)
 #+nil	 (format t "*multiple-call-local: ret-tn on stack; offset=~s~%"
 		 (tn-offset ret-tn))
 	 ;; Stack
@@ -662,7 +665,7 @@
 
       ;; Is the return-pc on the stack or in a register?
       (sc-case ret-tn
-	((immediate-stack)
+	((descriptor-stack)
 #+nil	 (format t "*known-call-local: ret-tn on stack; offset=~s~%"
 		 (tn-offset ret-tn))
 	 ;; Stack
@@ -752,7 +755,7 @@
     (sc-case return-pc
       ((any-reg descriptor-reg)
        (sc-case old-fp
-         ((immediate-stack)
+         ((descriptor-stack)
 
 #+nil	  (format t "*known-return: old-fp ~s on stack; offset=~s~%"
 		  old-fp (tn-offset old-fp))
@@ -781,7 +784,7 @@
        ;; Return; return-pc is in a register.
        (inst jmp return-pc))
 
-      ((immediate-stack descriptor-stack)
+      ((descriptor-stack)
 
 #+nil       (format t "*known-return: return-pc ~s on stack; offset=~s~%"
 	       return-pc (tn-offset return-pc))
@@ -952,7 +955,7 @@
 		;; standard locations then these moves will be
 		;; un-necessary; this is probably best for the x86.
 		(sc-case old-fp
-		  ((immediate-stack descriptor-stack)
+		  ((descriptor-stack)
 		   (unless (= old-fp-save-offset (tn-offset old-fp))
 		     (format t "** tail-call old-fp not S0~%")
 		     (move old-fp-tmp old-fp)
@@ -963,7 +966,7 @@
 
 		#+x86-lra
 		(sc-case return-pc
-		  ((immediate-stack descriptor-stack)
+		  ((descriptor-stack)
 		   (unless (= return-pc-save-offset (tn-offset return-pc))
 		     (format t "** tail-call ret-pc not S1~%")
 		     (move ret-pc-tmp return-pc)
@@ -1076,7 +1079,7 @@
 ;;; set things up so that it can find what it needs.
 ;;;
 (define-vop (tail-call-variable)
-  (:args (args :scs (any-reg immediate-stack) :target esi)
+  (:args (args :scs (any-reg descriptor-stack) :target esi)
 	 (function :scs (descriptor-reg descriptor-stack) :target eax)
 	 (old-fp)
 	 (ret-addr))
@@ -1090,10 +1093,10 @@
 
     ;; The following assumes that the return-pc and old-fp are on the
     ;; stack in their standard save locations - Check this.
-    (unless (and (sc-is old-fp immediate-stack descriptor-stack)
+    (unless (and (sc-is old-fp descriptor-stack)
 		 (= (tn-offset old-fp) old-fp-save-offset))
 	    (error "tail-call-variable: old-fp not on stack in standard save location?"))
-    (unless (and (sc-is ret-addr immediate-stack descriptor-stack)
+    (unless (and (sc-is ret-addr descriptor-stack)
 		 (= (tn-offset ret-addr) return-pc-save-offset))
 	    (error "tail-call-variable: ret-addr not on stack in standard save location?"))
     
@@ -1437,15 +1440,9 @@
     ;; Check to see if there are no arguments, and just return NIL if so.
     (inst mov result nil-value)
     (inst jecxz done)
-    #-cgc
-    (with-allocation (eax)
-      (inst lea dst (make-ea :byte :base eax :disp list-pointer-type))
-      (inst lea eax (make-ea :dword :base eax :index ecx :scale 2)))
-    #+cgc
-    (progn
-      (inst lea eax (make-ea :dword :index ecx :scale 2))
-      (with-cgc-allocation (eax eax)
-	(inst lea dst (make-ea :byte :base eax :disp list-pointer-type))))
+    (inst lea dst (make-ea :dword :index ecx :scale 2))
+    (var-allocation dst dst)
+    (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)
     ;; Set decrement mode (successive args at lower addresses)
diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp
index b6e4e5a4b174b7144c8f4245dd655059d7074aa0..2c1cef3f9beec8089eed4d3c5eac61efbf28338a 100644
--- a/compiler/x86/cell.lisp
+++ b/compiler/x86/cell.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/cell.lisp,v 1.4 1997/09/29 05:06:53 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.5 1997/11/04 09:11:01 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -107,6 +107,12 @@
   (:policy :fast)
   (:translate symbol-value))
 
+(defknown fast-symbol-value-xadd (symbol fixnum) fixnum ())
+(define-vop (fast-symbol-value-xadd cell-xadd)
+  (:variant symbol-value-slot other-pointer-type)
+  (:policy :fast)
+  (:translate fast-symbol-value-xadd)
+  (:arg-types * tagged-num))
 
 (define-vop (boundp)
   (:translate boundp)
@@ -120,6 +126,19 @@
     (inst cmp value unbound-marker-type)
     (inst jmp (if not-p :e :ne) target)))
 
+(define-vop (symbol-hash)
+  (:policy :fast-safe)
+  (:translate symbol-hash)
+  (:args (symbol :scs (descriptor-reg)))
+  (:results (res :scs (any-reg)))
+  (:result-types positive-fixnum)
+  (:generator 2
+    ;; the symbol-hash slot of NIL holds NIL because it is also the cdr
+    ;; slot, so we have to strip off the two low bits to make sure it is
+    ;; a fixnum.
+    (loadw res symbol symbol-hash-slot other-pointer-type)
+    (inst and res (lognot #b11))))
+
 
 ;;;; Fdefinition (fdefn) objects.
 
@@ -323,6 +342,12 @@
 	  temp)
     (move result eax)))
 
+(defknown %instance-xadd (instance index fixnum) fixnum ())
+(define-vop (instance-xadd-c slot-xadd)
+  (:policy :fast-safe)
+  (:translate %instance-xadd)
+  (:variant instance-slots-offset instance-pointer-type)
+  (:arg-types instance (:constant index) tagged-num))
 
 
 ;;;; Code object frobbing.
diff --git a/compiler/x86/char.lisp b/compiler/x86/char.lisp
index 6fdf6bd3dccb59d2c5eb790f9360770cb683a0cb..64768571be87f4d946c1d6a26264fb88f159fde7 100644
--- a/compiler/x86/char.lisp
+++ b/compiler/x86/char.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/char.lisp,v 1.1 1997/01/18 14:31:20 ram Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/char.lisp,v 1.2 1997/11/04 09:11:02 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;; 
@@ -19,9 +19,10 @@
 ;;; And then to the x86, again by William.
 ;;;
 ;;; Debugged by Paul F. Werkowski, June-95.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;;
-(in-package :x86)
 
+(in-package :x86)
 
 
 ;;;; Moves and coercions:
@@ -29,7 +30,7 @@
 ;;; Move a tagged char to an untagged representation.
 ;;;
 (define-vop (move-to-base-char)
-  (:args (x :scs (any-reg immediate-stack) :target al))
+  (:args (x :scs (any-reg descriptor-stack) :target al))
   (:temporary (:sc byte-reg :offset al-offset
 		   :from (:argument 0) :to (:eval 0)) al)
   (:ignore al)
@@ -42,7 +43,7 @@
     (move y ah)))
 ;;;
 (define-move-vop move-to-base-char :move
-  (any-reg immediate-stack) (base-char-reg base-char-stack))
+  (any-reg descriptor-stack) (base-char-reg base-char-stack))
 
 
 ;;; Move an untagged char to a tagged representation.
@@ -53,7 +54,7 @@
 		   :from (:argument 0) :to (:result 0)) al)
   (:temporary (:sc byte-reg :offset ah-offset
 		   :from (:argument 0) :to (:result 0)) ah)
-  (:results (y :scs (any-reg descriptor-reg immediate-stack)))
+  (:results (y :scs (any-reg descriptor-reg descriptor-stack)))
   (:note "character tagging")
   (:generator 1
     (move ah x)				; maybe move char byte
@@ -63,7 +64,7 @@
 
 ;;;
 (define-move-vop move-from-base-char :move
-  (base-char-reg base-char-stack) (any-reg descriptor-reg immediate-stack))
+  (base-char-reg base-char-stack) (any-reg descriptor-reg descriptor-stack))
 
 ;;; Move untagged base-char values.
 ;;;
diff --git a/compiler/x86/debug.lisp b/compiler/x86/debug.lisp
index 741804fec83a6181f2005b290314c866054546ab..c12c3d922f7fa0f5b3b414f180f5e72da8845cee 100644
--- a/compiler/x86/debug.lisp
+++ b/compiler/x86/debug.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/debug.lisp,v 1.1 1997/01/18 14:31:21 ram Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/debug.lisp,v 1.2 1997/11/04 09:11:03 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,12 +16,10 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
-;;; Debugged by Douglas Crosher 1996.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;; 
 (in-package :x86)
 
-(defknown di::stack-ref (system-area-pointer index)
-  #-x86 t #+x86 (unsigned-byte 32) (flushable))
 (define-vop (debug-cur-sp)
   (:translate current-sp)
   (:policy :fast-safe)
@@ -38,34 +36,18 @@
   (:generator 1
     (move res ebp-tn)))
 
-#+nil
+;;; Stack-ref and %set-stack-ref can be used to read and store
+;;; descriptor objects on the control stack.  Use the sap-ref
+;;; functions to access other data types.
 (define-vop (read-control-stack)
-  (:translate kernel:stack-ref)
+  (:translate stack-ref)
   (:policy :fast-safe)
-  (:args (sap :scs (sap-reg) :to (:argument 1))
-	 (offset :scs (any-reg) :to (:argument 0) :target temp))
-  (:arg-types system-area-pointer tagged-num)
-  (:temporary (:sc dword-reg :from (:argument 0)) temp)
-  (:results (result :scs (descriptor-reg)))
-  (:result-types *)
-  (:generator 9
-    (move temp offset)
-    (inst neg temp)
-    (inst sub temp (fixnum 1))
-    (inst mov result (make-ea :dword :base sap :index temp))))
-
-;;; Unlike the RISC implementations, the control stack also is a number
-;;; stack and not just descriptors live there.
-
-(define-vop (read-control-stack)
-  (:translate kernel:stack-ref)
-  (:policy :fast-safe)
-  (:args (sap :scs (sap-reg) :to :eval)	; NOTE lifetime stuff IMPORTANT (why?)
+  (:args (sap :scs (sap-reg) :to :eval)
 	 (offset :scs (any-reg) :target temp))
   (:arg-types system-area-pointer positive-fixnum)
   (:temporary (:sc dword-reg :from (:argument 1)) temp)
-  (:results (result :scs (unsigned-reg)))
-  (:result-types unsigned-num)
+  (:results (result :scs (descriptor-reg)))
+  (:result-types *)
   (:generator 9
     (move temp offset)
     (inst neg temp)
@@ -73,13 +55,13 @@
 	  (make-ea :dword :base sap :disp (- word-bytes) :index temp))))
 
 (define-vop (read-control-stack-c)
-  (:translate kernel:stack-ref)
+  (:translate stack-ref)
   (:policy :fast-safe)
   (:args (sap :scs (sap-reg)))
   (:info index)
-  (:arg-types system-area-pointer (:constant (signed-byte 32)))
-  (:results (result :scs (unsigned-reg)))
-  (:result-types unsigned-num)
+  (:arg-types system-area-pointer (:constant (signed-byte 30)))
+  (:results (result :scs (descriptor-reg)))
+  (:result-types *)
   (:generator 5
     (inst mov result (make-ea :dword :base sap
 			      :disp (- (* (1+ index) word-bytes))))))
diff --git a/compiler/x86/float.lisp b/compiler/x86/float.lisp
index 3f107708f44c6187a957766718259bbce97d8c4e..45cff64f870956c94488bbe97c54e4f8e1d11244 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.10 1997/11/01 22:58:43 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/float.lisp,v 1.11 1997/11/04 09:11:04 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -298,13 +298,11 @@
 (define-vop (move-from-single)
   (:args (x :scs (single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
-  (:temporary (:sc dword-reg) ndescr)
   (:note "float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y ndescr vm:single-float-type
-			       vm:single-float-size)
-       (with-tn@fp-top(x)
-	 (inst fst (ea-for-sf-desc y))))))
+     (fixed-allocation y vm:single-float-type vm:single-float-size)
+     (with-tn@fp-top(x)
+       (inst fst (ea-for-sf-desc y)))))
 (define-move-vop move-from-single :move
   (single-reg) (descriptor-reg))
 
@@ -321,13 +319,11 @@
 (define-vop (move-from-double)
   (:args (x :scs (double-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
-  (:temporary (:sc dword-reg) ndescr)
   (:note "float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y ndescr vm:double-float-type
-			       vm:double-float-size)
-       (with-tn@fp-top(x)
-	 (inst fstd (ea-for-df-desc y))))))
+     (fixed-allocation y vm:double-float-type vm:double-float-size)
+     (with-tn@fp-top(x)
+       (inst fstd (ea-for-df-desc y)))))
 (define-move-vop move-from-double :move
   (double-reg) (descriptor-reg))
 
@@ -369,42 +365,36 @@
 (define-vop (move-from-complex-single)
   (:args (x :scs (complex-single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
-  (:temporary (:sc dword-reg) ndescr)
   (:note "complex float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y ndescr vm:complex-single-float-type
-			       vm:complex-single-float-size)
-       (let ((real-tn (make-random-tn :kind :normal
-				      :sc (sc-or-lose 'single-reg)
-				      :offset (tn-offset x))))
-	 (with-tn@fp-top(real-tn)
-	   (inst fst (ea-for-csf-real-desc y))))
-       (let ((imag-tn (make-random-tn :kind :normal
-				      :sc (sc-or-lose 'single-reg)
-				      :offset (1+ (tn-offset x)))))
-	 (with-tn@fp-top(imag-tn)
-	   (inst fst (ea-for-csf-imag-desc y)))))))
+     (fixed-allocation y vm:complex-single-float-type
+		       vm:complex-single-float-size)
+     (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
+				    :offset (tn-offset x))))
+       (with-tn@fp-top(real-tn)
+	 (inst fst (ea-for-csf-real-desc y))))
+     (let ((imag-tn (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
+				    :offset (1+ (tn-offset x)))))
+       (with-tn@fp-top(imag-tn)
+	 (inst fst (ea-for-csf-imag-desc y))))))
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
 
 (define-vop (move-from-complex-double)
   (:args (x :scs (complex-double-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
-  (:temporary (:sc dword-reg) ndescr)
   (:note "complex float to pointer coercion")
   (:generator 13
-     (with-fixed-allocation (y ndescr vm:complex-double-float-type
-			       vm:complex-double-float-size)
-       (let ((real-tn (make-random-tn :kind :normal
-				      :sc (sc-or-lose 'double-reg)
-				      :offset (tn-offset x))))
-	 (with-tn@fp-top(real-tn)
-	   (inst fstd (ea-for-cdf-real-desc y))))
-       (let ((imag-tn (make-random-tn :kind :normal
-				      :sc (sc-or-lose 'double-reg)
-				      :offset (1+ (tn-offset x)))))
-	 (with-tn@fp-top(imag-tn)
-	   (inst fstd (ea-for-cdf-imag-desc y)))))))
+     (fixed-allocation y vm:complex-double-float-type
+		       vm:complex-double-float-size)
+     (let ((real-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
+				    :offset (tn-offset x))))
+       (with-tn@fp-top(real-tn)
+	 (inst fstd (ea-for-cdf-real-desc y))))
+     (let ((imag-tn (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
+				    :offset (1+ (tn-offset x)))))
+       (with-tn@fp-top(imag-tn)
+	 (inst fstd (ea-for-cdf-imag-desc y))))))
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
 
diff --git a/compiler/x86/insts.lisp b/compiler/x86/insts.lisp
index a175126b23d005bfa93fb04988c5ec9b2827332c..a039b3471de99bdb2570df0f419c9fd82945e468 100644
--- a/compiler/x86/insts.lisp
+++ b/compiler/x86/insts.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/insts.lisp,v 1.11 1997/10/18 04:09:50 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/insts.lisp,v 1.12 1997/11/04 09:11:07 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -103,11 +103,11 @@
 	(t
 	 (format stream "~A PTR [" (symbol-name (ea-size ea)))
 	 (when (ea-base ea)
-	   (write-string (c::location-print-name (ea-base ea)) stream)
+	   (write-string (x86-location-print-name (ea-base ea)) stream)
 	   (when (ea-index ea)
 	     (write-string "+" stream)))
 	 (when (ea-index ea)
-	   (write-string (c::location-print-name (ea-index ea)) stream))
+	   (write-string (x86-location-print-name (ea-index ea)) stream))
 	 (unless (= (ea-scale ea) 1)
 	   (format stream "*~A" (ea-scale ea)))
 	 (typecase (ea-disp ea)
diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp
index 2949d95ae596a4ae1db47422085a63bc1030502f..8fac524bee52e119715b7d5d6b1104ed1779bf36 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.4 1997/04/01 17:44:40 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.5 1997/11/04 09:11:08 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,6 +16,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;;
 (in-package :x86)
 
@@ -111,46 +112,124 @@
 
 ;;;; Allocation helpers
 
-#-cgc
-(defmacro with-allocation ((alloc) &body body)
+;;; 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)
+  "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
-    (load-symbol-value ,alloc *allocation-pointer*)
-    ,@body
-    (store-symbol-value ,alloc *allocation-pointer*)))
-
-#-cgc
-(defmacro with-fixed-allocation ((result alloc type-code size) &body body)
-  `(with-allocation (,alloc)
-     (inst lea ,result
-	   (make-ea :byte :base ,alloc :disp other-pointer-type))
-     (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,alloc)
-     (inst add ,alloc (pad-data-block ,size))
-     ,@body))
-
-;;; Support for conservative GC and allocator. Call into C...
-#+cgc
-(defmacro with-cgc-allocation((alloc-tn size) &body body)
-  `(let ((stack-offset (- 28 (* 2 (tn-offset ,alloc-tn)))))
-    ;; I need to save all regs because C might trash a few.
-    ;; This works because register offsets are assigned in the
-    ;; same order that PUSHA pushes them on the stack.
-    (inst pusha)			; Save all registers
-    (inst push ,size)			; load the size param for C
-    (inst call (make-fixup (extern-alien-name "alloc") :foreign))
-    (inst add esp-tn word-bytes)	; pop off the arg
-    (inst mov (make-ea :dword		; move result over saved alloc-tn
-	       :base esp-tn :disp stack-offset) eax-tn)
-    (inst popa)				; restore all regs 
-    ,@body))
-
-#+cgc
-(defmacro with-fixed-allocation ((result alloc type-code size) &body body)
-  `(with-cgc-allocation (,alloc (pad-data-block ,size))
-    (inst lea ,result (make-ea :byte :base ,alloc :disp other-pointer-type))
-    (storew (logior (ash (1- ,size) vm:type-bits) ,type-code) ,alloc)
-    ,@body))
-
-
+    (allocation ,result-tn (pad-data-block ,size))
+    (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))))
 
 
 ;;;; Error Code
diff --git a/compiler/x86/memory.lisp b/compiler/x86/memory.lisp
index c2ea36368bd5992f37c692c78433a0ceebe6a607..9741c0898137a640b8ed45d2f6fe80360acd77f3 100644
--- a/compiler/x86/memory.lisp
+++ b/compiler/x86/memory.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/memory.lisp,v 1.3 1997/09/29 04:40:33 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/memory.lisp,v 1.4 1997/11/04 09:11:10 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -84,6 +84,19 @@
 	     ,@(when set-trans
 		 `((:translate ,set-trans))))))))
 
+;;; X86 special
+(define-vop (cell-xadd)
+  (:args (object :scs (descriptor-reg) :to :result)
+	 (value :scs (any-reg) :target result))
+  (:results (result :scs (any-reg) :from (:argument 1)))
+  (:result-types tagged-num)
+  (:variant-vars offset lowtag)
+  (:policy :fast-safe)
+  (:generator 4
+    (move result value)
+    (inst xadd (make-ea :dword :base object
+			:disp (- (* offset word-bytes) lowtag))
+	  value)))
 
 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
 ;;; offset is constant at compile time, but varies for different uses.
@@ -141,3 +154,17 @@
 			   :disp (- (* (+ base offset) word-bytes) lowtag))
 	  temp)
     (move result eax)))
+
+;;; X86 special
+(define-vop (slot-xadd)
+  (:args (object :scs (descriptor-reg) :to :result)
+	 (value :scs (any-reg) :target result))
+  (:results (result :scs (any-reg) :from (:argument 1)))
+  (:result-types tagged-num)
+  (:variant-vars base lowtag)
+  (:info offset)
+  (:generator 4
+    (move result value)
+    (inst xadd (make-ea :dword :base object
+			:disp (- (* (+ base offset) word-bytes) lowtag))
+	  value)))
diff --git a/compiler/x86/move.lisp b/compiler/x86/move.lisp
index cb448a820be51eebb978f9bdaa2e380433e6bc58..745208c251618019d10b57f27746d596d4367b76 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.2 1997/02/23 09:42:02 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/move.lisp,v 1.3 1997/11/04 09:11:11 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,7 +17,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
-;;; Enhancements/debugging by Douglas T. Crosher 1996.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;;
 (in-package :x86)
 
@@ -49,13 +49,11 @@
   (inst mov y (sap-int (tn-value x))))
 
 (define-move-function (load-constant 5) (vop x y)
-  ;; pfw adds any-reg to no effect
   ((constant) (descriptor-reg any-reg))
   (inst mov y x))
 
 (define-move-function (load-stack 5) (vop x y)
-  ((descriptor-stack) (descriptor-reg)
-   (immediate-stack) (any-reg)
+  ((descriptor-stack) (any-reg descriptor-reg)
    (base-char-stack) (base-char-reg)
    (sap-stack) (sap-reg)
    (signed-stack) (signed-reg)
@@ -63,27 +61,13 @@
   (inst mov y x))
 
 (define-move-function (store-stack 5) (vop x y)
-  ((descriptor-reg) (descriptor-stack)
-   (any-reg) (immediate-stack)
+  ((any-reg descriptor-reg) (descriptor-stack)
    (base-char-reg) (base-char-stack)
    (sap-reg) (sap-stack)
    (signed-reg) (signed-stack)
    (unsigned-reg) (unsigned-stack))
   (inst mov y x))
 
-;;;
-;;; ZZZZZ added by jrd.  add a move-function for immediate-stack -> descriptor-reg.
-;;; dunno if this is right, but we get into the pickle of trying to do this kind of
-;;; move a fair amount.  see if this fixes it
-;;;
-(define-move-function (load-immediate-stack 5) (vop x y)
-		      ((immediate-stack) (descriptor-reg))
-  (inst mov x y))
-
-(define-move-function (store-immediate-stack 5) (vop x y)
-		      ((descriptor-reg) (immediate-stack))
-  (inst mov x y))
-
 
 ;;;; The Move VOP:
 ;;;
@@ -94,12 +78,12 @@
 	       :load-if
 	       (not (or (location= x y)
 			(and (sc-is x any-reg descriptor-reg immediate)
-			     (sc-is y immediate-stack descriptor-stack))))))
+			     (sc-is y descriptor-stack))))))
   (:effects)
   (:affected)
   (:generator 0
     (if (and (sc-is x immediate)
-	     (sc-is y any-reg immediate-stack descriptor-reg descriptor-stack))
+	     (sc-is y any-reg descriptor-reg descriptor-stack))
 	(let ((val (tn-value x)))
 	  (etypecase val
 	    (integer
@@ -133,7 +117,7 @@
 (define-vop (move-argument)
   (:args (x :scs (any-reg descriptor-reg immediate) :target y
 	    :load-if (not (and (sc-is y any-reg descriptor-reg)
-			       (sc-is x immediate-stack))))
+			       (sc-is x descriptor-stack))))
 	 (fp :scs (any-reg)
 	     :load-if (not (sc-is y any-reg descriptor-reg))))
   (:results (y))
@@ -153,7 +137,7 @@
 	       (inst mov y (logior (ash (char-code val) type-bits)
 				   base-char-type)))))
 	 (move y x)))
-      ((descriptor-stack immediate-stack)
+      ((descriptor-stack)
        (if (sc-is x immediate)
 	   (let ((val (tn-value x)))
 	     (if (= (tn-offset fp) esp-offset)
@@ -294,6 +278,7 @@
 ;;; Result may be a bignum, so we have to check.  Use a worst-case cost to make
 ;;; sure people know they may be number consing.
 ;;;
+#+nil
 (define-vop (move-from-signed)
   (:args (x :scs (signed-reg unsigned-reg) :target eax))
   (:temporary (:sc dword-reg :offset eax-offset :from (:argument 0)) eax)
@@ -311,18 +296,14 @@
     (move y ebx)))
 ;;;
 ;;; Faster inline version,
-#+nil
 (define-vop (move-from-signed)
-  (:args (x :scs (signed-reg unsigned-reg) :to :save))
-  (:temporary (:sc dword-reg) alloc)
-  (:results (y :scs (any-reg descriptor-reg)))
+  (:args (x :scs (signed-reg unsigned-reg) :to :result))
+  (:results (y :scs (any-reg descriptor-reg) :from :argument))
   (:note "signed word to integer coercion")
   (:generator 20
      (assert (not (location= x y)))
-     (assert (not (location= x alloc)))
-     (assert (not (location= y alloc)))
-     (let ( (bignum (gen-label))
-	    (done (gen-label)) )
+     (let ((bignum (gen-label))
+	   (done (gen-label)))
        (inst mov y x)
        (inst shl y 1)
        (inst jmp :o bignum)
@@ -332,9 +313,8 @@
 
        (assemble (*elsewhere*)
           (emit-label bignum)
-	  (with-fixed-allocation (y alloc bignum-type
-				    (+ bignum-digits-offset 1))
-             (storew x y bignum-digits-offset other-pointer-type))
+	  (fixed-allocation y bignum-type (+ bignum-digits-offset 1))
+	  (storew x y bignum-digits-offset other-pointer-type)
 	  (inst jmp done)))))
 ;;;
 (define-move-vop move-from-signed :move
@@ -344,7 +324,7 @@
 ;;; Check for fixnum, and possibly allocate one or two word bignum result.  Use
 ;;; a worst-case cost to make sure people know they may be number consing.
 ;;;
-
+#+nil
 (define-vop (move-from-unsigned)
   (:args (x :scs (signed-reg unsigned-reg) :target eax))
   (:temporary (:sc dword-reg :offset eax-offset :from (:argument 0)) eax)
@@ -362,7 +342,6 @@
     (move y ebx)))
 ;;;
 ;;; Faster inline version.
-#+nil
 (define-vop (move-from-unsigned)
   (:args (x :scs (signed-reg unsigned-reg) :to :save))
   (:temporary (:sc dword-reg) alloc)
@@ -372,10 +351,10 @@
     (assert (not (location= x y)))
     (assert (not (location= x alloc)))
     (assert (not (location= y alloc)))
-    (let ( (bignum (gen-label))
-	   (done (gen-label))
-	   (one-word-bignum (gen-label))
-	   (l1 (gen-label)) )
+    (let ((bignum (gen-label))
+	  (done (gen-label))
+	  (one-word-bignum (gen-label))
+	  (l1 (gen-label)))
       (inst test x #xe0000000)
       (inst jmp :nz bignum)
       ;; Fixnum.
@@ -398,8 +377,7 @@
 	 (inst mov y (logior (ash (1- (+ bignum-digits-offset 1)) vm:type-bits)
 			     bignum-type))
 	 (emit-label l1)
-	 (with-cgc-allocation 
-	  (alloc (pad-data-block (+ bignum-digits-offset 2))))
+	 (allocation alloc (pad-data-block (+ bignum-digits-offset 2)))
 	 (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/nlx.lisp b/compiler/x86/nlx.lisp
index e9c4fdd97fc089d0ef62570cecae92c604a30670..a661e0b932476d6bd0f5aa771eee972ab99ea60e 100644
--- a/compiler/x86/nlx.lisp
+++ b/compiler/x86/nlx.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/nlx.lisp,v 1.5 1997/07/11 05:24:42 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/nlx.lisp,v 1.6 1997/11/04 09:11:12 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,7 +16,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
-;;; Enhancements/debugging by Douglas T. Crosher 1996.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;;
 (in-package :x86)
 
@@ -57,7 +57,6 @@
 	    (eval :scs (descriptor-reg))
 	    (oldfp :scs (descriptor-reg))
 	    (alien-stack :scs (descriptor-reg)))
-  (:vop-var vop)
   (:generator 13
     (load-symbol-value catch lisp::*current-catch-block*)
     (load-symbol-value eval lisp::*eval-stack-top*)
@@ -70,7 +69,6 @@
 	 (eval :scs (descriptor-reg))
 	 (oldfp :scs (descriptor-reg))
 	 (alien-stack :scs (descriptor-reg)))
-  (:vop-var vop)
   (:generator 10
     (store-symbol-value catch lisp::*current-catch-block*)
     (store-symbol-value eval lisp::*eval-stack-top*)
@@ -78,7 +76,7 @@
     (storew oldfp ebp-tn (- (1+ old-fp-save-offset)))))
 
 (define-vop (current-stack-pointer)
-  (:results (res :scs (any-reg immediate-stack)))
+  (:results (res :scs (any-reg descriptor-stack)))
   (:generator 1
     (move res esp-tn)))
 
@@ -268,7 +266,7 @@
 		    ;; (loadw tn start (- (1+ i)))
 		    (move move-temp start)
 		    (loadw tn move-temp (- (1+ i))))
-		   ((descriptor-stack immediate-stack)
+		   ((descriptor-stack)
 		    ;; (loadw move-temp start (- (1+ i)))
 		    (move move-temp start)
 		    (loadw move-temp move-temp (- (1+ i)))
@@ -348,7 +346,7 @@
   (:temporary (:sc dword-reg :offset esi-offset) esi)
   (:temporary (:sc dword-reg :offset edi-offset) edi)
   (:results (result :scs (any-reg) :from (:argument 0))
-	    (num :scs (any-reg immediate-stack)))
+	    (num :scs (any-reg descriptor-stack)))
   (:save-p :force-to-stack)
   (:vop-var vop)
   (:generator 30
diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 173d1d601ec5981e50f6c6de91f2acfc8ef2ce4f..18f8ee51bdcbc35f2505d76433bee868b81c1d2d 100644
--- a/compiler/x86/parms.lisp
+++ b/compiler/x86/parms.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/parms.lisp,v 1.7 1997/09/24 06:15:39 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.8 1997/11/04 09:11:13 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -42,7 +42,7 @@
 (setf (backend-fasl-file-type *target-backend*) "x86f")
 (setf (backend-fasl-file-implementation *target-backend*)
       x86-fasl-file-implementation)
-(setf (backend-fasl-file-version *target-backend*) 1)
+(setf (backend-fasl-file-version *target-backend*) 2)
 (setf (backend-register-save-penalty *target-backend*) 3)
 (setf (backend-byte-order *target-backend*) :little-endian)
 
@@ -240,35 +240,46 @@
       lisp::*current-catch-block*
       lisp::*current-unwind-protect-block*
       *eval-stack-top*
+      *alien-stack*
 
       ;; Interrupt Handling
       lisp::*free-interrupt-context-index*
       unix::*interrupts-enabled*
       unix::*interrupt-pending*
 
-      ;; added by pfw
       *allocation-pointer*
       *binding-stack-pointer*
-      *x86-cgc-active-p*
-      *internal-gc-trigger*	; Keep C code happy
+      *internal-gc-trigger*   ; Not used.
 
-      *fp-constant-1s0*
+      ;; The FP constants
+      *fp-constant-0d0*
       *fp-constant-1d0*
       *fp-constant-0s0*
-      *fp-constant-0d0*
+      *fp-constant-1s0*
 
-      *alien-stack*
+      ;; Used by gencgc.
+      *scavenge-read-only-space*
 
+      ;; Multi-process support.
       *control-stacks*
 
-      ;; Some unused static variables - very handy for hacking.
-      *unused-static-6*
-      *unused-static-5*
-      *unused-static-4*
-      *unused-static-3*
-      *unused-static-2*
-      *unused-static-1*
-
+      ;; Spare symbols
+      spare-13
+      spare-12
+      spare-11
+      spare-10
+      spare-9
+      spare-8
+      spare-7
+      spare-6
+      spare-5
+      spare-4
+      spare-3
+      spare-2
+      spare-1
+      
+      ;; Used by CGC.
+      *x86-cgc-active-p*
       *static-blue-bag*		; Must be last or change C code
       ))
 
diff --git a/compiler/x86/pred.lisp b/compiler/x86/pred.lisp
index 5021c9c3b07353f716c60f1fe96d919c5daddeaa..6ad950ca55c14508826caa5eb8c5222df892eb20 100644
--- a/compiler/x86/pred.lisp
+++ b/compiler/x86/pred.lisp
@@ -7,13 +7,14 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/pred.lisp,v 1.1 1997/01/18 14:31:22 ram Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/pred.lisp,v 1.2 1997/11/04 09:11:14 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
 ;;;    This file contains the VM definition of predicate VOPs for the x86.
 ;;;
 ;;; Written by William Lott.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;; 
 
 (in-package :x86)
@@ -35,16 +36,13 @@
 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
 ;;; not immediate data.
 (define-vop (if-eq)
-  (:args (x :scs (any-reg descriptor-reg immediate-stack descriptor-stack
-			  constant)
+  (:args (x :scs (any-reg descriptor-reg descriptor-stack constant)
 	    :load-if (not (and (sc-is x immediate)
 			       (sc-is y any-reg descriptor-reg
-				      immediate-stack descriptor-stack
-				      constant))))
+				      descriptor-stack constant))))
 	 (y :scs (any-reg descriptor-reg immediate)
 	    :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
-			       (sc-is y immediate-stack descriptor-stack
-				      constant)))))
+			       (sc-is y descriptor-stack constant)))))
   (:conditional)
   (:info target not-p)
   (:policy :fast-safe)
diff --git a/compiler/x86/print.lisp b/compiler/x86/print.lisp
index d9a5317f3b8e80de476b55b21e59efff0f520b51..db111aaf6ee3f717edccfbdcd2efaf7241ff7b96 100644
--- a/compiler/x86/print.lisp
+++ b/compiler/x86/print.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/print.lisp,v 1.1 1997/01/18 14:31:22 ram Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/print.lisp,v 1.2 1997/11/04 09:11:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -15,6 +15,7 @@
 ;;; core to keep the user entertained.
 ;;;
 ;;; Written by William Lott.
+;;; Enhancements/debugging by Douglas T. Crosher 1996.
 ;;;
 (in-package :x86)
 
diff --git a/compiler/x86/sap.lisp b/compiler/x86/sap.lisp
index 0192ab51e196d9398b8ab3e6d055520ef0db8bdf..30f47bb376bc51f1162bcd20065574aaedbf31e2 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.3 1997/10/05 16:44:57 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sap.lisp,v 1.4 1997/11/04 09:11:15 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -39,13 +39,12 @@
 ;;;
 
 (define-vop (move-from-sap)
-  (:args (sap :scs (sap-reg) :to :save))
-  (:temporary (:sc dword-reg) alloc)
-  (:results (res :scs (descriptor-reg)))
+  (:args (sap :scs (sap-reg) :to :result))
+  (:results (res :scs (descriptor-reg) :from :argument))
   (:note "SAP to pointer coercion") 
   (:generator 20
-    (with-fixed-allocation (res alloc sap-type sap-size)
-      (storew sap res sap-pointer-slot other-pointer-type))))
+    (fixed-allocation res sap-type sap-size)
+    (storew sap res sap-pointer-slot other-pointer-type)))
 	   
 ;;;
 (define-move-vop move-from-sap :move
diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp
index 629d98e796745d5a50154e0e134bb404f17a46c1..9a1370109c26998551c7d9ea7e4334b542d0df5e 100644
--- a/compiler/x86/system.lisp
+++ b/compiler/x86/system.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/system.lisp,v 1.4 1997/09/24 06:15:39 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.5 1997/11/04 09:11:16 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -27,7 +27,7 @@
 (define-vop (get-lowtag)
   (:translate get-lowtag)
   (:policy :fast-safe)
-  (:args (object :scs (any-reg descriptor-reg immediate-stack descriptor-stack)
+  (:args (object :scs (any-reg descriptor-reg descriptor-stack)
 		 :target result))
   (:results (result :scs (unsigned-reg)))
   (:result-types positive-fixnum)
diff --git a/compiler/x86/values.lisp b/compiler/x86/values.lisp
index fd7109d08fe1f6eb7af9d9425e0fc28c6e547e3d..765b09d7822e85f640ab324cae0f6008e020a77a 100644
--- a/compiler/x86/values.lisp
+++ b/compiler/x86/values.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/values.lisp,v 1.2 1997/02/08 21:38:35 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/values.lisp,v 1.3 1997/11/04 09:11:17 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,6 +17,7 @@
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
 ;;; %more-arg-values by Douglas Thomas Crosher, March 1996.
+;;; Enhancements/debugging by Douglas T. Crosher 1996.
 
 (in-package :x86)
 
diff --git a/compiler/x86/vm.lisp b/compiler/x86/vm.lisp
index cfea400a39c6b0ae57e61b72ec5ce7691dcc89a1..64037b52804984286e3f8e8c65b871263eef26ab 100644
--- a/compiler/x86/vm.lisp
+++ b/compiler/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/compiler/x86/vm.lisp,v 1.4 1997/11/01 22:58:46 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/vm.lisp,v 1.5 1997/11/04 09:11:18 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,6 +16,7 @@
 ;;; Written by William Lott
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
+;;; Enhancements/debugging by Douglas T. Crosher 1996, 1997.
 ;;;
 
 (in-package :x86)
@@ -178,7 +179,6 @@
 
   ;; The control stack.
   (descriptor-stack stack)		; may be pointers, scanned by GC
-  (immediate-stack stack)		; isn't pointers, ignored by GC
 
   ;; The non-descriptor stacks.
   (signed-stack stack)			; (signed-byte 32)
@@ -198,36 +198,29 @@
 
   ;; **** Things that can go in the integer registers.
 
-  ;; We don't have to distinguish between descriptor and non-descriptor
-  ;; registers, because we dump explicit information about what descriptor
-  ;; values are live at any potential GC point.  Therefore, we only different
-  ;; scs to distinguish between descriptor and non-descriptor values and
-  ;; to specify size.
+  ;; We don't have to distinguish between descriptor and
+  ;; non-descriptor registers, because of the conservative GC.
+  ;; Therefore, we only use different scs to distinguish between
+  ;; descriptor and non-descriptor values and to specify size.
 
+
+  ;; Immediate descriptor objects.  Don't have to be seen by GC, but nothing
+  ;; bad will happen if they are.  (fixnums, characters, header values, etc).
   (any-reg registers
 	   :locations #.dword-regs
 	   :element-size 2
-	   :reserve-locations (#.eax-offset)
+;	   :reserve-locations (#.eax-offset)
 	   :constant-scs (immediate)
 	   :save-p t
-	   :alternate-scs (immediate-stack))
+	   :alternate-scs (descriptor-stack))
 
   ;; Pointer descriptor objects.  Must be seen by GC.
   (descriptor-reg registers
 		  :locations #.dword-regs
 		  :element-size 2
-		  :reserve-locations (#.eax-offset)
+;		  :reserve-locations (#.eax-offset)
 		  :constant-scs
-		  (constant immediate 
-			    ;; zzz jrd added IMMEDIATE-STACK here.  
-			    ;; it seems right, and references elsewhere
-			    ;; in the code suggest that we expect to be
-			    ;; able to do this.  see 
-			    ;; DEFINE-MOVE-VOP MOVE :MOVE in MOVE.LISP
-			    
-			    ;; zzz this may not be right after all
-			    ;; immediate-stack
-			    )
+		  (constant immediate)
 		  :save-p t
 		  :alternate-scs (descriptor-stack))
 
@@ -243,7 +236,7 @@
   (sap-reg registers
 	   :locations #.dword-regs
 	   :element-size 2
-	   :reserve-locations (#.eax-offset)
+;	   :reserve-locations (#.eax-offset)
 	   :constant-scs (immediate)
 	   :save-p t
 	   :alternate-scs (sap-stack))
@@ -252,14 +245,14 @@
   (signed-reg registers
 	      :locations #.dword-regs
 	      :element-size 2
-	      :reserve-locations (#.eax-offset)
+;	      :reserve-locations (#.eax-offset)
 	      :constant-scs (immediate)
 	      :save-p t
 	      :alternate-scs (signed-stack))
   (unsigned-reg registers
 		:locations #.dword-regs
 		:element-size 2
-		:reserve-locations (#.eax-offset)
+;		:reserve-locations (#.eax-offset)
 		:constant-scs (immediate)
 		:save-p t
 		:alternate-scs (unsigned-stack))
@@ -268,14 +261,17 @@
   (dword-reg registers
 	     :locations #.dword-regs
 	     :element-size 2
-	     :reserve-locations (#.eax-offset))
+;	     :reserve-locations (#.eax-offset)
+	     )
   (word-reg registers
 	    :locations #.word-regs
 	    :element-size 2
-	    :reserve-locations (#.ax-offset))
+;	    :reserve-locations (#.ax-offset)
+	    )
   (byte-reg registers
 	    :locations #.byte-regs
-	    :reserve-locations (#.al-offset #.ah-offset))
+;	    :reserve-locations (#.al-offset #.ah-offset)
+	    )
 
   ;; **** Things that can go in the floating point registers.
 
@@ -336,7 +332,7 @@
 (defconstant word-sc-names '(word-reg))
 (defconstant dword-sc-names
   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg dword-reg
-    descriptor-stack immediate-stack signed-stack unsigned-stack
+    descriptor-stack signed-stack unsigned-stack
     sap-stack single-stack constant))
 
 ;;;
@@ -392,7 +388,6 @@
 ;;; some instruction instead of in the constants pool, then return
 ;;; the immediate SC.
 ;;;
-
 #+nil ;; pw-- the way it was.
 (def-vm-support-routine immediate-constant-sc (value)
   (if (or (and (symbolp value) (static-symbol-p value))
@@ -410,24 +405,6 @@
       (sc-number-or-lose 'immediate *backend*)
       nil))
 
-;;; I probably should use double-from-bits here
-;;; to avoid any compilation errors, but lets see
-;;; what happens. These should be part of lisp like PI?
-(defconstant i387-lg2 3.010299956639811952137389d0)
-(defconstant i387-ln2 0.6931471805599453094172321d0)
-(defconstant i387-l10 2.3025850929940456840179915d0)
-(defconstant i387-l2e (/ i387-ln2))
-(defconstant i387-l2t (/ i387-l10 i387-ln2))
-(export '(i387-lg2 i387-ln2 i387-l10 i387-l2e i387-l2t))
-
-
-;;; pw-- A good try and it works, but it also results in
-;;; extra consing when the constant is an argument to
-;;; some function. The descriptor from the constants vector
-;;; would normally be passed instead. DTC processes zero and
-;;; one in move-from-single|double as static symbols to
-;;; save on CV space for these common values.
-
 (def-vm-support-routine immediate-constant-sc (value)
   (typecase value
     ((or fixnum system-area-pointer character)
diff --git a/lisp/cgc.c b/lisp/cgc.c
index ea1b6c9ad440b9073ac2f717d7da3af79b5a6289..50f5819fc2ed530e8212031804249d57cad52868 100644
--- a/lisp/cgc.c
+++ b/lisp/cgc.c
@@ -1,5 +1,5 @@
 /* cgc.c -*- Mode: C; comment-column: 40; -*-
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.6 1997/11/02 09:49:11 dtc Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.7 1997/11/04 09:11:21 dtc Exp $
  *
  * Conservative Garbage Collector for CMUCL x86.
  *
@@ -404,7 +404,7 @@ static void new_cluster(int min_blocks)
     region->space = NULL;
 }
 
-unsigned long cgc_bytes_allocated = 0;	/* Seen by (dynamic-usage) */
+unsigned long bytes_allocated = 0;	/* Seen by (dynamic-usage) */
 static unsigned long auto_gc_trigger = 0;
 static int maybe_gc_called = 0;
 
@@ -471,7 +471,7 @@ static void *alloc_large(int nbytes)
     region->next = NULL;
     region->prev = NULL;
     region->space = NULL;
-    cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES;
+    bytes_allocated += region->num_chunks*CHUNK_BYTES;
     move_to_newspace(region);
     return (char *)region + REGION_OVERHEAD;
 }
@@ -506,7 +506,7 @@ void *cgc_alloc(int nbytes)
 	  region->contains_small_objects = 1;
 	  space->alloc_ptr = (char *)region + REGION_OVERHEAD;
 	  space->alloc_end = (char *)region + CHUNK_BYTES;
-	  cgc_bytes_allocated += region->num_chunks*CHUNK_BYTES;
+	  bytes_allocated += region->num_chunks*CHUNK_BYTES;
 	}
       
       res = space->alloc_ptr;
@@ -1398,7 +1398,7 @@ scavengex(lispobj*obj)
 static void
 scavenge_space( lispobj*where, int words, char*name )
 {
-  int allocated = cgc_bytes_allocated;
+  int allocated = bytes_allocated;
   lispobj*end = where + words;
   lispobj*last;
   bytes_copied = 0;
@@ -1412,7 +1412,7 @@ scavenge_space( lispobj*where, int words, char*name )
   gc_assert(where == end);
   if(name)
     dprintf(noise,(" %ld bytes moved, %ld bytes allocated.\n",
-		   bytes_copied, cgc_bytes_allocated - allocated));
+		   bytes_copied, bytes_allocated - allocated));
 }
 
 static int boxed_registers[] = BOXED_REGISTERS;
@@ -1817,7 +1817,7 @@ static int dolog=0;			/* log copy ops to file */
 static int dover=0;			/* hunt pointers to oldspace */
 void cgc_collect_garbage()
 {
-  unsigned long allocated =  cgc_bytes_allocated;
+  unsigned long allocated =  bytes_allocated;
 
   dprintf(noise,("GC\n"));
   if(dolog && !log)
@@ -1850,10 +1850,10 @@ void cgc_collect_garbage()
   if(log)
     fclose(log);
   log=NULL;
-  dprintf(noise,("  %ld bytes copied.\n",(cgc_bytes_allocated - allocated)));
+  dprintf(noise,("  %ld bytes copied.\n",(bytes_allocated - allocated)));
   dprintf(noise,("  %ld bytes (%ld pages) reclaimed.\n",
 	     chunks_freed*CHUNK_BYTES, chunks_freed));
-  cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES;
+  bytes_allocated -= chunks_freed*CHUNK_BYTES;
   maybe_gc_called = 0;
 }
 void cgc_free_heap()
@@ -1861,7 +1861,7 @@ void cgc_free_heap()
   /* Like above but just zap everything 'cause purify has
    * cleaned house!
    */
-  unsigned long allocated =  cgc_bytes_allocated;
+  unsigned long allocated =  bytes_allocated;
   flip_spaces();
   post_purify_fixup(oldspace);
   free_oldspace();
@@ -1869,7 +1869,7 @@ void cgc_free_heap()
 #if 0 /* purify is currently running on the C stack so don't do this */
   zero_stack();
 #endif
-  cgc_bytes_allocated -= chunks_freed*CHUNK_BYTES;
+  bytes_allocated -= chunks_freed*CHUNK_BYTES;
 }
 
 
@@ -1934,7 +1934,7 @@ char*alloc(int nbytes)
        * though because lisp will remember *need to collect garbage*
        * and get to it when it can.  */
       if( auto_gc_trigger		/* Only when enabled */
-	  && cgc_bytes_allocated > auto_gc_trigger
+	  && bytes_allocated > auto_gc_trigger
 	  && !maybe_gc_called++)		/* Only once         */
 	funcall0(SymbolFunction(MAYBE_GC));
       
diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c
index 6bc81a8b63ea34aae99044902339a15bb670a066..7951e7964df9e2142262025edba8c7e9c7d26d38 100644
--- a/lisp/x86-arch.c
+++ b/lisp/x86-arch.c
@@ -23,6 +23,8 @@
 
 #define BREAKPOINT_INST 0xcc	/* INT3 */
 
+unsigned long  fast_random_state = 1;
+
 char *
 arch_init(void)
 {
diff --git a/lisp/x86-assem.S b/lisp/x86-assem.S
index 0c4fe17c6edd3a463e4a20886fdbc214cae52606..34ceea34fe2eeea96d97081c497ea7bb2194527a 100644
--- a/lisp/x86-assem.S
+++ b/lisp/x86-assem.S
@@ -1,8 +1,9 @@
 ### x86-assem.S -*- Mode: Asm; -*-
 /**
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.4 1997/09/07 23:27:48 dtc Exp $
+ * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.5 1997/11/04 09:11:23 dtc Exp $
  *
- * Author:	Paul F. Werkowski <pw@snoopy.mv.com>
+ * Authors:	Paul F. Werkowski <pw@snoopy.mv.com>
+ *		Douglas T. Crosher
  *
  * This code was written to support the port of CMU Common Lisp
  * to the Intel X86 ISA and the FreeBSD operating system. The
@@ -324,7 +325,7 @@ GNAME(undefined_tramp):
 	.byte	trap_Cerror
         .byte   2
         .byte   23
-        .byte   14
+        .byte   sc_DescriptorReg # EAX in the Descriptor-reg SC.
 	ret
 	.size	GNAME(undefined_tramp), .-GNAME(undefined_tramp)
 
@@ -424,3 +425,312 @@ Lend:
 	ret
 	.size	GNAME(fastcopy16),.-GNAME(fastcopy16)
 	.end
+
+
+/*
+   Allocate bytes and return the start of the allocated space
+   in the specified destination register.
+
+   In the general case the size will be in the destination register.
+
+   All registers must be preserved except the destination.
+   The C conventions will preserve ebx, esi, edi, and ebp.
+   So only eax, ecx, and edx need special care here. */
+		
+	.globl	GNAME(alloc_to_eax)
+	.type	GNAME(alloc_to_eax),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_eax):
+	pushl	%ecx	# Save ecx and edx as C could destroy them.
+	pushl	%edx
+	pushl	%eax	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	popl	%edx	# Restore ecx and edx.
+	popl	%ecx
+	ret
+	.size	GNAME(alloc_to_eax),.-GNAME(alloc_to_eax)
+
+	.globl	GNAME(alloc_8_to_eax)
+	.type	GNAME(alloc_8_to_eax),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_eax):
+	pushl	%ecx	# Save ecx and edx as C could destroy them.
+	pushl	%edx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	popl	%edx	# Restore ecx and edx.
+	popl	%ecx
+	ret
+	.size	GNAME(alloc_8_to_eax),.-GNAME(alloc_8_to_eax)
+
+	.globl	GNAME(alloc_8_to_eax)
+	.type	GNAME(alloc_8_to_eax),@function
+	.align	align_4byte,0x90
+
+	.globl	GNAME(alloc_16_to_eax)
+	.type	GNAME(alloc_16_to_eax),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_eax):
+	pushl	%ecx	# Save ecx and edx as C could destroy them.
+	pushl	%edx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	popl	%edx	# Restore ecx and edx.
+	popl	%ecx
+	ret
+	.size	GNAME(alloc_16_to_eax),.-GNAME(alloc_16_to_eax)
+
+
+	.globl	GNAME(alloc_to_ecx)
+	.type	GNAME(alloc_to_ecx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_ecx):
+	pushl	%eax	# Save eax and edx as C could destroy them.
+	pushl	%edx
+	pushl	%ecx	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ecx	# setup the destination.
+	popl	%edx	# Restore eax and edx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_to_ecx),.-GNAME(alloc_to_ecx)
+
+	.globl	GNAME(alloc_8_to_ecx)
+	.type	GNAME(alloc_8_to_ecx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_ecx):
+	pushl	%eax	# Save eax and edx as C could destroy them.
+	pushl	%edx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ecx	# setup the destination.
+	popl	%edx	# Restore eax and edx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_8_to_ecx),.-GNAME(alloc_8_to_ecx)
+
+	.globl	GNAME(alloc_16_to_ecx)
+	.type	GNAME(alloc_16_to_ecx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_ecx):
+	pushl	%eax	# Save eax and edx as C could destroy them.
+	pushl	%edx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ecx	# setup the destination.
+	popl	%edx	# Restore eax and edx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_16_to_ecx),.-GNAME(alloc_16_to_ecx)
+
+
+	.globl	GNAME(alloc_to_edx)
+	.type	GNAME(alloc_to_edx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_edx):
+	pushl	%eax	# Save eax and ecx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edx	# setup the destination.
+	popl	%ecx	# Restore eax and ecx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_to_edx),.-GNAME(alloc_to_edx)
+
+	.globl	GNAME(alloc_8_to_edx)
+	.type	GNAME(alloc_8_to_edx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_edx):
+	pushl	%eax	# Save eax and ecx as C could destroy them.
+	pushl	%ecx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edx	# setup the destination.
+	popl	%ecx	# Restore eax and ecx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_8_to_edx),.-GNAME(alloc_8_to_edx)
+
+	.globl	GNAME(alloc_16_to_edx)
+	.type	GNAME(alloc_16_to_edx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_edx):
+	pushl	%eax	# Save eax and ecx as C could destroy them.
+	pushl	%ecx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edx	# setup the destination.
+	popl	%ecx	# Restore eax and ecx.
+	popl	%eax
+	ret
+	.size	GNAME(alloc_16_to_edx),.-GNAME(alloc_16_to_edx)
+
+
+
+	.globl	GNAME(alloc_to_ebx)
+	.type	GNAME(alloc_to_ebx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_ebx):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	%ebx	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ebx	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_to_ebx),.-GNAME(alloc_to_ebx)
+
+	.globl	GNAME(alloc_8_to_ebx)
+	.type	GNAME(alloc_8_to_ebx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_ebx):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ebx	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_8_to_ebx),.-GNAME(alloc_8_to_ebx)
+
+	.globl	GNAME(alloc_16_to_ebx)
+	.type	GNAME(alloc_16_to_ebx),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_ebx):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%ebx	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_16_to_ebx),.-GNAME(alloc_16_to_ebx)
+
+
+
+	.globl	GNAME(alloc_to_esi)
+	.type	GNAME(alloc_to_esi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_esi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	%esi	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%esi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_to_esi),.-GNAME(alloc_to_esi)
+
+	.globl	GNAME(alloc_8_to_esi)
+	.type	GNAME(alloc_8_to_esi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_esi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%esi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_8_to_esi),.-GNAME(alloc_8_to_esi)
+
+	.globl	GNAME(alloc_16_to_esi)
+	.type	GNAME(alloc_16_to_esi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_esi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%esi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_16_to_esi),.-GNAME(alloc_16_to_esi)
+
+
+	.globl	GNAME(alloc_to_edi)
+	.type	GNAME(alloc_to_edi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_to_edi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	%edi	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_to_edi),.-GNAME(alloc_to_edi)
+
+	.globl	GNAME(alloc_8_to_edi)
+	.type	GNAME(alloc_8_to_edi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_8_to_edi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$8	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_8_to_edi),.-GNAME(alloc_8_to_edi)
+
+	.globl	GNAME(alloc_16_to_edi)
+	.type	GNAME(alloc_16_to_edi),@function
+	.align	align_4byte,0x90
+GNAME(alloc_16_to_edi):
+	pushl	%eax	# Save eax, ecx, and edx as C could destroy them.
+	pushl	%ecx
+	pushl	%edx
+	pushl	$16	# Push the size
+	call	GNAME(alloc)
+	addl	$4,%esp	# pop the size arg.
+	movl	%eax,%edi	# setup the destination.
+	popl	%edx	# Restore eax, ecx and edx.
+	popl	%ecx
+	popl	%eax
+	ret
+	.size	GNAME(alloc_16_to_edi),.-GNAME(alloc_16_to_edi)
+		
+	.end