diff --git a/code/sparc-vm.lisp b/code/sparc-vm.lisp
index b3b18b8e400ee19270f98348749f817a22c25d97..b8079b47885bbf53a4ae2b6c10b0f0eb830642cc 100644
--- a/code/sparc-vm.lisp
+++ b/code/sparc-vm.lisp
@@ -7,18 +7,39 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.9 1992/02/21 22:00:08 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.10 1992/02/27 07:59:11 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.9 1992/02/21 22:00:08 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-vm.lisp,v 1.10 1992/02/27 07:59:11 wlott Exp $
 ;;;
 ;;; This file contains the SPARC specific runtime stuff.
 ;;;
 (in-package "SPARC")
 (use-package "SYSTEM")
 
-(export '(fixup-code-object internal-error-arguments))
+(export '(fixup-code-object internal-error-arguments
+	  sigcontext-register sigcontext-float-register
+	  sigcontext-floating-point-modes extern-alien-name))
+
+
+;;;; The sigcontext structure.
+
+(def-alien-type sigcontext
+  (struct nil
+    (sc-onstack unsigned-long)
+    (sc-mask unsigned-long)
+    (sc-sp system-area-pointer)
+    (sc-pc system-area-pointer)
+    (sc-npc system-area-pointer)
+    (sc-psr unsigned-long)
+    (sc-g1 unsigned-long)
+    (sc-o0 unsigned-long)
+    (sc-regs (array unsigned-long 32))
+    (sc-fpregs (array unsigned-long 32))
+    (sc-y unsigned-long)
+    (sc-fsr unsigned-long)))
+
 
 
 ;;;; Add machine specific features to *features*
@@ -69,71 +90,67 @@
 ;;; Given the sigcontext, extract the internal error arguments from the
 ;;; instruction stream.
 ;;; 
-(defun internal-error-arguments (sc)
-  (alien-bind ((sc sc mach:sigcontext t))
-    (let* ((pc (alien-access (mach:sigcontext-pc (alien-value sc))))
-	   (bad-inst (sap-ref-32 pc 0))
-	   (op (ldb (byte 2 30) bad-inst))
-	   (op2 (ldb (byte 3 22) bad-inst))
-	   (op3 (ldb (byte 6 19) bad-inst)))
-      (cond ((and (= op #b00) (= op2 #b000))
-	     (args-for-unimp-inst sc))
-	    ((and (= op #b10) (= (ldb (byte 4 2) op3) #b1000))
-	     (args-for-tagged-add-inst sc bad-inst))
-	    ((and (= op #b10) (= op3 #b111010))
-	     (args-for-tcc-inst bad-inst))
-	    (t
-	     (values (error-number-or-lose 'unknown-error)
-		     nil))))))
-
-(defun args-for-unimp-inst (sc)
-  (alien-bind ((sc sc mach:sigcontext t))
-    (let* ((pc (alien-access (mach:sigcontext-pc (alien-value sc))))
-	   (length (sap-ref-8 pc 4))
-	   (vector (make-array length :element-type '(unsigned-byte 8))))
-      (declare (type system-area-pointer pc)
-	       (type (unsigned-byte 8) length)
-	       (type (simple-array (unsigned-byte 8) (*)) vector))
-      (copy-from-system-area pc (* sparc:byte-bits 5)
-			     vector (* sparc:word-bits
-				       sparc:vector-data-offset)
-			     (* length sparc:byte-bits))
-      (let* ((index 0)
-	     (error-number (c::read-var-integer vector index)))
-	(collect ((sc-offsets))
-		 (loop
-		   (when (>= index length)
-		     (return))
-		   (sc-offsets (c::read-var-integer vector index)))
-		 (values error-number (sc-offsets)))))))
-
-(defun args-for-tagged-add-inst (sc bad-inst)
-  (alien-bind ((sc sc mach:sigcontext t)
-	       (regs (mach:sigcontext-regs (alien-value sc)) mach:int-array t))
-    (let* ((rs1 (ldb (byte 5 14) bad-inst))
-	   (op1 (di::make-lisp-obj
-		 (alien-access
-		  (mach:int-array-ref (alien-value regs)
-				      rs1)))))
-      (if (fixnump op1)
-	  (if (zerop (ldb (byte 1 13) bad-inst))
-	      (let* ((rs2 (ldb (byte 5 0) bad-inst))
-		     (op2 (di::make-lisp-obj
-			   (alien-access
-			    (mach:int-array-ref (alien-value regs)
-						rs2)))))
-		(if (fixnump op2)
-		    (values (error-number-or-lose 'unknown-error)
-			    nil)
-		    (values (error-number-or-lose 'object-not-fixnum-error)
-			    (list (c::make-sc-offset
-				   sparc:descriptor-reg-sc-number
-				   rs2)))))
-	      (values (error-number-or-lose 'unknown-error)
-		      nil))
-	  (values (error-number-or-lose 'object-not-fixnum-error)
-		  (list (c::make-sc-offset sparc:descriptor-reg-sc-number
-					   rs1)))))))
+(defun internal-error-arguments (scp)
+  (declare (type (alien (* sigcontext)) scp))
+  (let* ((pc (with-alien ((scp (* sigcontext) scp))
+	       (slot scp 'sc-pc)))
+	 (bad-inst (sap-ref-32 pc 0))
+	 (op (ldb (byte 2 30) bad-inst))
+	 (op2 (ldb (byte 3 22) bad-inst))
+	 (op3 (ldb (byte 6 19) bad-inst)))
+    (declare (type system-area-pointer pc))
+    (cond ((and (= op #b00) (= op2 #b000))
+	   (args-for-unimp-inst scp))
+	  ((and (= op #b10) (= (ldb (byte 4 2) op3) #b1000))
+	   (args-for-tagged-add-inst scp bad-inst))
+	  ((and (= op #b10) (= op3 #b111010))
+	   (args-for-tcc-inst bad-inst))
+	  (t
+	   (values (error-number-or-lose 'unknown-error)
+		   nil)))))
+
+(defun args-for-unimp-inst (scp)
+  (declare (type (alien (* sigcontext)) scp))
+  (let* ((pc (with-alien ((scp (* sigcontext) scp))
+	       (slot scp 'sc-pc)))
+	 (length (sap-ref-8 pc 4))
+	 (vector (make-array length :element-type '(unsigned-byte 8))))
+    (declare (type system-area-pointer pc)
+	     (type (unsigned-byte 8) length)
+	     (type (simple-array (unsigned-byte 8) (*)) vector))
+    (copy-from-system-area pc (* sparc:byte-bits 5)
+			   vector (* sparc:word-bits
+				     sparc:vector-data-offset)
+			   (* length sparc:byte-bits))
+    (let* ((index 0)
+	   (error-number (c::read-var-integer vector index)))
+      (collect ((sc-offsets))
+	       (loop
+		 (when (>= index length)
+		   (return))
+		 (sc-offsets (c::read-var-integer vector index)))
+	       (values error-number (sc-offsets))))))
+
+(defun args-for-tagged-add-inst (scp bad-inst)
+  (declare (type (alien (* sigcontext)) scp))
+  (let* ((rs1 (ldb (byte 5 14) bad-inst))
+	 (op1 (di::make-lisp-obj (sigcontext-register scp rs1))))
+    (if (fixnump op1)
+	(if (zerop (ldb (byte 1 13) bad-inst))
+	    (let* ((rs2 (ldb (byte 5 0) bad-inst))
+		   (op2 (di::make-lisp-obj (sigcontext-register scp rs2))))
+	      (if (fixnump op2)
+		  (values (error-number-or-lose 'unknown-error)
+			  nil)
+		  (values (error-number-or-lose 'object-not-fixnum-error)
+			  (list (c::make-sc-offset
+				 sparc:descriptor-reg-sc-number
+				 rs2)))))
+	    (values (error-number-or-lose 'unknown-error)
+		    nil))
+	(values (error-number-or-lose 'object-not-fixnum-error)
+		(list (c::make-sc-offset sparc:descriptor-reg-sc-number
+					 rs1))))))
 
 (defun args-for-tcc-inst (bad-inst)
   (let* ((trap-number (ldb (byte 8 0) bad-inst))
@@ -148,15 +165,71 @@
 	    (list (c::make-sc-offset sparc:descriptor-reg-sc-number reg)))))
 
 
+;;;; Sigcontext access functions.
+
+;;; SIGCONTEXT-REGISTER -- Internal.
+;;;
+;;; An escape register saves the value of a register for a frame that someone
+;;; interrupts.  
+;;;
+(defun sigcontext-register (scp index)
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext) scp))
+    (deref (slot scp 'sc-regs) index)))
+
+(defun %set-sigcontext-register (scp index new)
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext) scp))
+    (setf (deref (slot scp 'sc-regs) index) new)
+    new))
+
+(defsetf sigcontext-register %set-sigcontext-register)
+
+
+;;; SIGCONTEXT-FLOAT-REGISTER  --  Internal
+;;;
+;;; Like SIGCONTEXT-REGISTER, but returns the value of a float register.
+;;; Format is the type of float to return.
+;;;
+(defun sigcontext-float-register (scp index format)
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext) scp))
+    (let ((sap (alien-sap (slot scp 'sc-fpregs))))
+      (ecase format
+	(single-float (system:sap-ref-single sap (* index vm:word-bytes)))
+	(double-float (system:sap-ref-double sap (* index vm:word-bytes)))))))
+;;;
+(defun %set-sigcontext-float-register (scp index format new-value)
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext) scp))
+    (let ((sap (alien-sap (slot scp 'sc-fpregs))))
+      (ecase format
+	(single-float
+	 (setf (sap-ref-single sap (* index vm:word-bytes)) new-value))
+	(double-float
+	 (setf (sap-ref-double sap (* index vm:word-bytes)) new-value))))))
+;;;
+(defsetf sigcontext-float-register %set-sigcontext-float-register)
+
+
 ;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface
 ;;;
 ;;;    Given a sigcontext pointer, return the floating point modes word in the
 ;;; same format as returned by FLOATING-POINT-MODES.
 ;;;
 (defun sigcontext-floating-point-modes (scp)
-  (alien-bind ((sc (make-alien 'mach:sigcontext
-					     #.(ext:c-sizeof 'mach:sigcontext)
-					     scp)
-			  mach:sigcontext
-			  t))
-    (alien-access (mach:sigcontext-fsr (alien-value sc)))))
+  (declare (type (alien (* sigcontext)) scp))
+  (with-alien ((scp (* sigcontext) scp))
+    (slot scp 'sc-fsr)))
+
+
+
+;;; EXTERN-ALIEN-NAME -- interface.
+;;;
+;;; The loader uses this to convert alien names to the form they occure in
+;;; the symbol table (for example, prepending an underscore).  On the SPARC,
+;;; we prepend an underscore.
+;;; 
+(defun extern-alien-name (name)
+  (declare (type simple-base-string name))
+  (concatenate 'string "_" name))