diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 1440423cfd56b2c7c299e3d96fe9292d1ed45f52..173d1d601ec5981e50f6c6de91f2acfc8ef2ce4f 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.6 1997/09/15 10:40:10 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.7 1997/09/24 06:15:39 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,6 +18,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
 ;;;
 
 (in-package :x86)
@@ -129,7 +130,7 @@
 
 ;;; pfw -- from i486 microprocessor programmers reference manual
 (defconstant float-invalid-trap-bit        (ash 1 0))
-(defconstant float-denormal-trap-bit       (ash 1 1)) ; not used by lisp
+(defconstant float-denormal-trap-bit       (ash 1 1))
 (defconstant float-divide-by-zero-trap-bit (ash 1 2))
 (defconstant float-overflow-trap-bit       (ash 1 3))
 (defconstant float-underflow-trap-bit      (ash 1 4))
@@ -258,8 +259,9 @@
 
       *alien-stack*
 
+      *control-stacks*
+
       ;; Some unused static variables - very handy for hacking.
-      *unused-static-7*
       *unused-static-6*
       *unused-static-5*
       *unused-static-4*
diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp
index 7174c219133ffc1e452f4ca732690b99541a609f..629d98e796745d5a50154e0e134bb404f17a46c1 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.3 1997/02/13 01:20:36 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.4 1997/09/24 06:15:39 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)
@@ -178,6 +178,20 @@
   (:generator 1
     (load-symbol-value int *binding-stack-pointer*)))
 
+(defknown (setf binding-stack-pointer-sap)
+    (system-area-pointer) system-area-pointer ())
+
+(define-vop (set-binding-stack-pointer-sap)
+  (:args (new-value :scs (sap-reg) :target int))
+  (:arg-types system-area-pointer)
+  (:results (int :scs (sap-reg)))
+  (:result-types system-area-pointer)
+  (:translate (setf binding-stack-pointer-sap))
+  (:policy :fast-safe)
+  (:generator 1
+    (store-symbol-value new-value *binding-stack-pointer*)
+    (move int new-value)))
+
 (define-vop (control-stack-pointer-sap)
   (:results (int :scs (sap-reg)))
   (:result-types system-area-pointer)
@@ -298,3 +312,173 @@
     (inst inc (make-ea :dword :base count-vector
 		       :disp (- (* (+ vector-data-offset index) word-bytes)
 				other-pointer-type)))))
+
+
+;;;; Primitive multi-thread support.
+
+(export 'control-stack-fork)
+(defknown control-stack-fork ((simple-array (unsigned-byte 32) (*)))
+  (member t nil))
+
+(define-vop (control-stack-fork)
+  (:policy :fast-safe)
+  (:translate control-stack-fork)
+  (:args (save-stack :scs (descriptor-reg) :to :result))
+  (:arg-types simple-array-unsigned-byte-32)
+  (:results (child :scs (descriptor-reg)))
+  (:result-types t)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp)
+  (:save-p t)
+  (:generator 25
+    ;; Setup the return context.
+    (inst push (make-fixup nil :code-object RETURN))
+    (inst push ebp-tn)
+    ;; Save the stack.
+    (inst xor index index)
+    ;; First the stack-pointer.
+    (inst mov (make-ea :dword :base save-stack :index index :scale 4
+		       :disp (- (* vm:vector-data-offset vm:word-bytes)
+				vm:other-pointer-type))
+	  esp-tn)
+    (inst inc index)
+    (inst mov stack (make-fixup (extern-alien-name "control_stack_end")
+				:foreign))
+    LOOP
+    (inst cmp stack esp-tn)
+    (inst jmp :le STACK-SAVE-DONE)
+    (inst sub stack 4)
+    (inst mov temp (make-ea :dword :base stack))
+    (inst mov (make-ea :dword :base save-stack :index index :scale 4
+		       :disp (- (* vm:vector-data-offset vm:word-bytes)
+				vm:other-pointer-type))
+	  temp)
+    (inst inc index)
+    (inst jmp-short LOOP)
+    
+    RETURN
+    ;; Stack already clean if it reaches here. Parent returns NIL.
+    (inst mov child nil-value)
+    (inst jmp-short DONE)
+    
+    STACK-SAVE-DONE
+    ;; Cleanup the stack
+    (inst add esp-tn 8)
+    ;; Child returns T.
+    (load-symbol child t)
+    DONE))
+
+(export 'control-stack-resume)
+(defknown control-stack-resume ((simple-array (unsigned-byte 32) (*))
+				(simple-array (unsigned-byte 32) (*)))
+  (values))
+
+(define-vop (control-stack-resume)
+  (:policy :fast-safe)
+  (:translate control-stack-resume)
+  (:args (save-stack :scs (descriptor-reg) :to :result)
+	 (new-stack :scs (descriptor-reg) :to :result))
+  (:arg-types simple-array-unsigned-byte-32 simple-array-unsigned-byte-32)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp)
+  (:save-p t)
+  (:generator 25
+    ;; Setup the return context.
+    (inst push (make-fixup nil :code-object RETURN))
+    (inst push ebp-tn)
+    ;; Save the stack.
+    (inst xor index index)
+    ;; First the stack-pointer.
+    (inst mov (make-ea :dword :base save-stack :index index :scale 4
+		       :disp (- (* vm:vector-data-offset vm:word-bytes)
+				vm:other-pointer-type))
+	  esp-tn)
+    (inst inc index)
+    (inst mov stack (make-fixup (extern-alien-name "control_stack_end")
+				:foreign))
+    LOOP
+    (inst cmp stack esp-tn)
+    (inst jmp :le STACK-SAVE-DONE)
+    (inst sub stack 4)
+    (inst mov temp (make-ea :dword :base stack))
+    (inst mov (make-ea :dword :base save-stack :index index :scale 4
+		       :disp (- (* vm:vector-data-offset vm:word-bytes)
+				vm:other-pointer-type))
+	  temp)
+    (inst inc index)
+    (inst jmp-short LOOP)
+
+    STACK-SAVE-DONE
+    ;; Cleanup the stack
+    (inst add esp-tn 8)
+
+    ;; Restore the new-stack.
+    (inst xor index index)
+    ;; First the stack-pointer.
+    (inst mov esp-tn
+	  (make-ea :dword :base new-stack :index index :scale 4
+		   :disp (- (* vm:vector-data-offset vm:word-bytes)
+			    vm:other-pointer-type)))
+    (inst inc index)
+    (inst mov stack (make-fixup (extern-alien-name "control_stack_end")
+				:foreign))
+    LOOP2
+    (inst cmp stack esp-tn)
+    (inst jmp :le STACK-RESTORE-DONE)
+    (inst sub stack 4)
+    (inst mov temp (make-ea :dword :base new-stack :index index :scale 4
+			    :disp (- (* vm:vector-data-offset vm:word-bytes)
+				     vm:other-pointer-type)))
+    (inst mov (make-ea :dword :base stack) temp)
+    (inst inc index)
+    (inst jmp-short LOOP2)
+    STACK-RESTORE-DONE
+    ;; Pop the frame pointer, and resume at the return address.
+    (inst pop ebp-tn)
+    (inst ret)
+    
+    ;; Original thread resumes, stack has been cleaned up.
+    RETURN))
+
+
+(export 'control-stack-return)
+(defknown control-stack-return ((simple-array (unsigned-byte 32) (*)))
+  (values))
+
+(define-vop (control-stack-return)
+  (:policy :fast-safe)
+  (:translate control-stack-return)
+  (:args (new-stack :scs (descriptor-reg) :to :result))
+  (:arg-types simple-array-unsigned-byte-32)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) index)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) stack)
+  (:temporary (:sc unsigned-reg :from (:eval 0) :to (:eval 1)) temp)
+  (:save-p t)
+  (:generator 25
+    ;; Restore the new-stack.
+    (inst xor index index)
+    ;; First the stack-pointer.
+    (inst mov esp-tn
+	  (make-ea :dword :base new-stack :index index :scale 4
+		   :disp (- (* vm:vector-data-offset vm:word-bytes)
+			    vm:other-pointer-type)))
+    (inst inc index)
+    (inst mov stack (make-fixup (extern-alien-name "control_stack_end")
+				:foreign))
+    LOOP
+    (inst cmp stack esp-tn)
+    (inst jmp :le STACK-RESTORE-DONE)
+    (inst sub stack 4)
+    (inst mov temp (make-ea :dword :base new-stack :index index :scale 4
+			    :disp (- (* vm:vector-data-offset vm:word-bytes)
+				     vm:other-pointer-type)))
+    (inst mov (make-ea :dword :base stack) temp)
+    (inst inc index)
+    (inst jmp-short LOOP)
+    STACK-RESTORE-DONE
+    ;; Pop the frame pointer, and resume at the return address.
+    (inst pop ebp-tn)
+    (inst ret)))
+