diff --git a/compiler/mips/sap.lisp b/compiler/mips/sap.lisp
index 9f1c46a7253ad9398998926991cc1a6ffd83ee08..489d20b1df3714c58e018f242a50f6eb2962d845 100644
--- a/compiler/mips/sap.lisp
+++ b/compiler/mips/sap.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.4 1990/04/24 02:56:32 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.5 1990/04/25 21:45:44 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS VM definition of SAP operations.
 ;;;
@@ -143,84 +143,84 @@
 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
 
 (define-vop (sap-ref)
+  (:policy :fast-safe)
   (:variant-vars size signed)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg)))
+	 (offset :scs (descriptor-reg any-reg negative-immediate zero
+				      immediate unsigned-immediate)))
   (:arg-types system-area-pointer fixnum)
-  (:results (result :scs (descriptor-reg any-reg)))
-  (:temporary (:scs (sap-reg) :type system-area-pointer :from (:argument 0))
-	      sap)
-  (:temporary (:scs (non-descriptor-reg) :type random
-		    :to (:result 0) :target result)
-	      temp)
+  (:results (result :scs (signed-reg unsigned-reg)))
+  (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
+  (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 5
-    (move sap object)
+    (sc-case offset
+      ((zero)
+       (move sap object))
+      ((negative-immediate immediate)
+       (inst addu sap object
+	     (ash (tn-value offset)
+		  (ecase size (:byte 0) (:short 1) (:long 2)))))
+      ((any-reg descriptor-reg)
+       (ecase size
+	 (:byte
+	  (inst sra temp offset 2)
+	  (inst addu sap object temp))
+	 (:short
+	  (inst sra temp offset 1)
+	  (inst addu sap object temp))
+	 ((:long :pointer)
+	  (inst addu sap object offset)))))
     (ecase size
       (:byte
-       (inst sra temp offset 2)
-       (inst addu sap sap temp)
        (if signed
-	   (inst lb temp sap 0)
-	   (inst lbu temp sap 0))
-       (inst sll result temp 2))
+	   (inst lb result sap 0)
+	   (inst lbu result sap 0)))
       (:short
-       (inst sra temp offset 1)
-       (inst addu sap sap temp)
        (if signed
-	   (inst lh temp sap 0)
-	   (inst lhu temp sap 0))
-       (inst sll result temp 2))
-      (:long
-       (inst addu sap sap offset)
-       (inst lw temp sap 0)
-       ;; ### Need to assure that it doesn't overflow
-       (inst sll result temp 2))
-      (:pointer
-       (inst addu sap sap offset)
-       (inst lw temp sap 0)
-       (sc-case result
-	 (sap-reg
-	  (move result temp)))))))
+	   (inst lh result sap 0)
+	   (inst lhu result sap 0)))
+      ((:long :pointer)
+       (inst lw result sap 0)))
+    (inst nop)))
 
 
 (define-vop (sap-set)
+  (:policy :fast-safe)
   (:variant-vars size)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg))
-	 (value :scs (descriptor-reg sap-reg any-reg) :target temp))
-  (:temporary (:scs (sap-reg) :type system-area-pointer :from (:argument 0))
+	 (offset :scs (descriptor-reg any-reg negative-immediate
+				      zero immediate))
+	 (value :scs (signed-reg unsigned-reg) :target result))
+  (:results (result :scs (signed-reg unsigned-reg sap-reg)))
+  (:temporary (:scs (sap-reg) :from (:argument 0))
 	      sap)
-  (:temporary (:scs (non-descriptor-reg) :type random :from (:result 3)) temp)
+  (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 5
-    (move sap object)
+    (sc-case offset
+      ((zero)
+       (move sap object))
+      ((negative-immediate immediate)
+       (inst addu sap object
+	     (ash (tn-value offset)
+		  (ecase size (:byte 0) (:short 1) (:long 2)))))
+      ((any-reg descriptor-reg)
+       (ecase size
+	 (:byte
+	  (inst sra temp offset 2)
+	  (inst addu sap object temp))
+	 (:short
+	  (inst sra temp offset 1)
+	  (inst addu sap object temp))
+	 ((:long :pointer)
+	  (inst addu sap object offset)))))
     (ecase size
       (:byte
-       (inst sra temp offset 2)
-       (inst addu sap sap temp))
+       (inst sb value sap 0))
       (:short
-       (inst sra temp offset 1)
-       (inst addu sap sap temp))
+       (inst sh value sap 0))
       ((:long :pointer)
-       (inst addu sap sap offset)))
-    (ecase size
-      ((:byte :short)
-       (inst sra temp value 2))
-      (:long
-       ;; ### Need to see if it's a fixnum or bignum
-       (inst sra temp value 2))
-      (:pointer
-       (sc-case value
-	 (sap-reg
-	  (move temp value))
-	 (descriptor-reg
-	  (loadw temp value vm:sap-pointer-slot vm:other-pointer-type)))))
-    (ecase size
-      (:byte
-       (inst sb temp sap 0))
-      (:short
-       (inst sh temp sap 0))
-      ((:long :pointer)
-       (inst sw temp sap 0)))))
+       (inst sw value sap 0)))
+    (move result value)))
 
 
 
@@ -231,6 +231,10 @@
 
 (define-vop (sap-system-set sap-set)
   (:translate (setf sap-ref-sap))
+  (:args (object :scs (sap-reg) :target sap)
+	 (offset :scs (descriptor-reg any-reg negative-immediate
+				      zero immediate))
+	 (value :scs (sap-reg) :target result))
   (:arg-types system-area-pointer fixnum system-area-pointer)
   (:variant :pointer))
 
@@ -246,7 +250,7 @@
 
 (define-vop (32bit-system-set sap-set)
   (:translate (setf sap-ref-32))
-  (:arg-types system-area-pointer fixnum t)
+  (:arg-types system-area-pointer fixnum *)
   (:variant :long))