diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp
index 327e4bdfc7243aded085bfcfc63f73bf15be397d..d60a31b15a405c507df57251b7de52673abd5525 100644
--- a/compiler/generic/vm-tran.lisp
+++ b/compiler/generic/vm-tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.12 1990/06/15 12:35:22 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.13 1990/06/16 15:35:44 wlott Exp $
 ;;;
 ;;;    This file contains impelemtentation-dependent transforms.
 ;;;
@@ -25,7 +25,8 @@
 (def-source-transform structurep (x)
   (once-only ((n-x x))
     `(and (simple-vector-p ,n-x)
-	  (eql (%primitive get-vector-subtype ,n-x)
+	  (eql (truly-the (unsigned-byte 24)
+			  (%primitive get-vector-subtype ,n-x))
 	       system:%g-vector-structure-subtype))))
 
 (def-source-transform compiled-function-p (x)
@@ -51,7 +52,7 @@
 
 
 (def-source-transform %more-arg-context (&rest foo)
-  `(%primitive more-arg-context ,@foo))
+  `(truly-the (values t fixnum) (%primitive more-arg-context ,@foo)))
 ;;;
 (def-source-transform %verify-argument-count (&rest foo)
   `(%primitive verify-argument-count ,@foo))
diff --git a/compiler/generic/vm-type.lisp b/compiler/generic/vm-type.lisp
index d1eb1267b70623614210fa4a15d3845beb14b458..17ee83a707bd707981dda3bdcbb14e2cf7acc9b8 100644
--- a/compiler/generic/vm-type.lisp
+++ b/compiler/generic/vm-type.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.14 1990/05/15 01:20:59 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-type.lisp,v 1.15 1990/06/16 15:35:59 wlott Exp $
 ;;;
 ;;;    This file contains implementation-dependent parts of the type support
 ;;; code.  This is stuff which deals with the mapping from types defined in
@@ -44,7 +44,7 @@
 ;;; ### Bootstrap hack: base characters don't exist in the old compiler,
 ;;; so leave characters alone.  Also, make string-char look like base-char.
 (compiler-let ((lisp::*bootstrap-deftype* t))
-  (remhash 'character *builtin-types*)
+  (setf (info type builtin 'character) nil)
   (deftype character () 'base-character)
   (deftype string-char () 'base-character))
 
diff --git a/compiler/mips/arith.lisp b/compiler/mips/arith.lisp
index d43b43164a56ad50c7040c2d05486147dace20e9..b4b52a7a3a6bfb7d32d9ef3910938fbe7f41f636 100644
--- a/compiler/mips/arith.lisp
+++ b/compiler/mips/arith.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/arith.lisp,v 1.24 1990/06/12 02:29:53 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/arith.lisp,v 1.25 1990/06/16 15:33:18 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition arithmetic VOPs for the MIPS.
 ;;;
@@ -68,10 +68,10 @@
 ;;; Assume that any constant operand is the second arg...
 
 (define-vop (fast-fixnum-binop)
-  (:args (x :target r :scs (any-reg descriptor-reg))
-	 (y :target r :scs (any-reg descriptor-reg)))
+  (:args (x :target r :scs (any-reg))
+	 (y :target r :scs (any-reg)))
   (:arg-types tagged-num tagged-num)
-  (:results (r :scs (any-reg descriptor-reg)))
+  (:results (r :scs (any-reg)))
   (:result-types tagged-num)
   (:note "inline fixnum arithmetic")
   (:effects)
@@ -108,9 +108,9 @@
 					"/FIXNUM=>FIXNUM"))
 		  fast-fixnum-binop)
        (:args (x :target r
-		 :scs (any-reg descriptor-reg))
+		 :scs (any-reg))
 	      (y :target r
-		 :scs (any-reg descriptor-reg immediate zero
+		 :scs (any-reg immediate zero
 			       ,(if unsigned
 				    'unsigned-immediate
 				    'negative-immediate))))
@@ -118,7 +118,7 @@
        (:generator ,cost
 	 (inst ,op r x
 	       (sc-case y
-		 ((any-reg descriptor-reg) y)
+		 (any-reg y)
 		 (zero zero-tn)
 		 ((immediate
 		   ,(if unsigned 'unsigned-immediate 'negative-immediate))
@@ -176,23 +176,25 @@
 ;;; know the output type is a fixnum.
 
 (define-vop (fast-+/fixnum fast-+/fixnum=>fixnum)
-  (:result-types *)
+  (:results (r :scs (any-reg descriptor-reg)))
+  (:result-types (:or signed-num unsigned-num))
   (:note nil)
   (:generator 1
     (inst add r x
 	  (sc-case y
-	    ((any-reg descriptor-reg) y)
+	    (any-reg y)
 	    (zero zero-tn)
 	    ((immediate negative-immediate)
 	     (fixnum (tn-value y)))))))
 
 (define-vop (fast--/fixnum fast--/fixnum=>fixnum)
-  (:result-types *)
+  (:results (r :scs (any-reg descriptor-reg)))
+  (:result-types (:or signed-num unsigned-num))
   (:note nil)
   (:generator 1
     (inst sub r x
 	  (sc-case y
-	    ((any-reg descriptor-reg) y)
+	    (any-reg y)
 	    (zero zero-tn)
 	    ((immediate negative-immediate)
 	     (fixnum (tn-value y)))))))
@@ -204,7 +206,7 @@
   (:note "inline ASH")
   (:args (number :scs (signed-reg unsigned-reg))
 	 (amount :scs (signed-reg immediate negative-immediate)))
-  (:arg-types (:or signed-num unsigned-num) *)
+  (:arg-types (:or signed-num unsigned-num) signed-num)
   (:results (result :scs (signed-reg unsigned-reg)))
   (:result-types (:or signed-num unsigned-num))
   (:translate ash)
@@ -339,7 +341,7 @@
 	 (y :target r :scs (signed-reg)))
   (:results (q :scs (signed-reg))
 	    (r :scs (signed-reg)))
-  (:result-types * *)
+  (:result-types signed-num signed-num)
   (:generator 11
     (let ((zero (generate-error-code division-by-zero-error x y)))
       (inst beq y zero-tn zero))
@@ -352,7 +354,7 @@
   (:args (x :target r :scs (signed-reg))
 	 (y :target r :scs (signed-reg)))
   (:results (r :scs (signed-reg)))
-  (:result-types *)
+  (:result-types signed-num)
   (:generator 10
     (let ((zero (generate-error-code division-by-zero-error x y)))
       (inst beq y zero-tn zero))
@@ -377,6 +379,7 @@
   (:arg-types tagged-num tagged-num)
   (:note "inline fixnum comparison"))
 
+#+nil
 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
   (:arg-types tagged-num (:constant (signed-byte 14)))
   (:info target not-p y))
@@ -387,6 +390,7 @@
   (:arg-types signed-num signed-num)
   (:note "inline (signed-byte 32) comparison"))
 
+#+nil
 (define-vop (fast-conditional-c/signed fast-conditional/signed)
   (:arg-types tagged-num (:constant (signed-byte 16)))
   (:info target not-p y))
@@ -397,6 +401,7 @@
   (:arg-types unsigned-num unsigned-num)
   (:note "inline (unsigned-byte 32) comparison"))
 
+#+nil
 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
   (:arg-types tagged-num (:constant (unsigned-byte 15)))
   (:info target not-p y))
@@ -586,8 +591,7 @@
   (:variant vm:bignum-digits-offset vm:other-pointer-type)
   (:translate bignum::%bignum-set)
   (:args (object :scs (descriptor-reg))
-	 (index :scs (any-reg descriptor-reg
-			      immediate unsigned-immediate))
+	 (index :scs (any-reg immediate unsigned-immediate))
 	 (value :scs (unsigned-reg)))
   (:results (result :scs (unsigned-reg))))
 
diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp
index 2e0b838e74b8b1845aafc7f12fd8e9ec77e9aee7..af647def3cd028c106d5a866077541a3341074a8 100644
--- a/compiler/mips/array.lisp
+++ b/compiler/mips/array.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.17 1990/06/04 05:21:36 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.18 1990/06/16 15:34:40 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS definitions for array operations.
 ;;;
@@ -99,7 +99,7 @@
 
 ;;;; Accessors/Setters
 
-(defmacro def-data-vector-frobs (type variant &optional (element-type t) sc)
+(defmacro def-data-vector-frobs (type variant element-type &rest scs)
   `(progn
      (define-vop (,(intern (concatenate 'simple-string
 					"DATA-VECTOR-REF/"
@@ -109,10 +109,9 @@
 					"-REF")))
        (:variant vm:vector-data-offset vm:other-pointer-type)
        (:translate data-vector-ref)
-       (:arg-types ,type *)
-       ,@(when sc
-	   `((:results (value :scs (,sc)))
-	     (:result-types ,element-type))))
+       (:arg-types ,type positive-fixnum)
+       (:results (value :scs ,scs))
+       (:result-types ,element-type))
      (define-vop (,(intern (concatenate 'simple-string
 					"DATA-VECTOR-SET/"
 					(string type)))
@@ -121,17 +120,16 @@
 					"-SET")))
        (:variant vm:vector-data-offset vm:other-pointer-type)
        (:translate data-vector-set)
-       (:arg-types ,type * ,element-type)
-       ,@(when sc
-	   `((:args (object :scs (descriptor-reg))
-		    (index :scs (any-reg descriptor-reg
-					 immediate unsigned-immediate))
-		    (value :scs (,sc)))
-	     (:results (result :scs (,sc))))))))
+       (:arg-types ,type positive-fixnum ,element-type)
+       (:args (object :scs (descriptor-reg))
+	      (index :scs (any-reg zero immediate unsigned-immediate))
+	      (value :scs ,scs))
+       (:results (result :scs ,scs)))))
 
 (def-data-vector-frobs simple-string byte-index
   base-character base-character-reg)
-(def-data-vector-frobs simple-vector word-index)
+(def-data-vector-frobs simple-vector word-index
+  * descriptor-reg any-reg)
 
 (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index
   positive-fixnum unsigned-reg)
diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp
index 012817ca3a486715593feecdf772259d00b16987..954e8b7c0a4239f221aa1d8543cd977187661c6b 100644
--- a/compiler/mips/call.lisp
+++ b/compiler/mips/call.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.18 1990/06/10 20:22:33 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.19 1990/06/16 15:34:44 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of function call for the MIPS.
 ;;;
@@ -28,8 +28,11 @@
 (defun standard-argument-location (n)
   (declare (type unsigned-byte n))
   (if (< n register-arg-count)
-      (make-wired-tn register-arg-scn (elt register-arg-offsets n))
-      (make-wired-tn control-stack-arg-scn n)))
+      (make-wired-tn *any-primitive-type*
+		     register-arg-scn
+		     (elt register-arg-offsets n))
+      (make-wired-tn *any-primitive-type*
+		     control-stack-arg-scn n)))
 
 
 ;;; Make-Return-PC-Passing-Location  --  Interface
@@ -41,8 +44,8 @@
 ;;;
 (defun make-return-pc-passing-location (standard)
   (if standard
-      (make-wired-tn register-arg-scn lra-offset)
-      (make-restricted-tn register-arg-scn)))
+      (make-wired-tn *any-primitive-type* register-arg-scn lra-offset)
+      (make-restricted-tn *any-primitive-type* register-arg-scn)))
 
 
 ;;; Make-Old-FP-Passing-Location  --  Interface
@@ -54,8 +57,8 @@
 ;;;
 (defun make-old-fp-passing-location (standard)
   (if standard
-      (make-wired-tn register-arg-scn old-fp-offset)
-      (make-normal-tn *any-primitive-type*)))
+      (make-wired-tn *fixnum-primitive-type* immediate-arg-scn old-fp-offset)
+      (make-normal-tn *fixnum-primitive-type*)))
 
 ;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location  --  Interface
 ;;;
@@ -65,12 +68,14 @@
 ;;;
 (defun make-old-fp-save-location (env)
   (environment-live-tn
-   (make-wired-tn (sc-number-or-lose 'control-stack) old-fp-save-offset)
+   (make-wired-tn *fixnum-primitive-type*
+		  control-stack-arg-scn
+		  old-fp-save-offset)
    env))
 ;;;
 (defun make-return-pc-save-location (env)
   (environment-live-tn
-   (make-wired-tn (sc-number-or-lose 'control-stack) lra-save-offset)
+   (make-wired-tn *any-primitive-type* control-stack-arg-scn lra-save-offset)
    env))
 
 ;;; Make-Argument-Count-Location  --  Interface
@@ -80,7 +85,7 @@
 ;;; are using non-standard conventions.
 ;;;
 (defun make-argument-count-location ()
-  (make-wired-tn register-arg-scn nargs-offset))
+  (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
 
 
 ;;; MAKE-NFP-TN  --  Interface
@@ -90,7 +95,26 @@
 ;;;
 (defun make-nfp-tn ()
   (component-live-tn
-   (make-wired-tn (sc-number-or-lose 'any-reg) args-offset)))
+   (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset)))
+
+;;; MAKE-STACK-POINTER-TN ()
+;;; 
+(defun make-stack-pointer-tn ()
+  (make-normal-tn *fixnum-primitive-type*))
+
+;;; MAKE-NUMBER-STACK-POINTER-TN ()
+;;; 
+(defun make-number-stack-pointer-tn ()
+  (make-normal-tn *fixnum-primitive-type*))
+
+;;; Make-Unknown-Values-Locations  --  Interface
+;;;
+;;;    Return a list of TNs that can be used to represent an unknown-values
+;;; continuation within a function.
+;;;
+(defun make-unknown-values-locations ()
+  (list (make-stack-pointer-tn)
+	(make-normal-tn *fixnum-primitive-type*)))
 
 
 ;;; Select-Component-Format  --  Interface
@@ -113,7 +137,7 @@
 ;;; Used for setting up the Old-FP in local call.
 ;;;
 (define-vop (current-fp)
-  (:results (val :scs (any-reg descriptor-reg)))
+  (:results (val :scs (any-reg)))
   (:generator 1
     (move val fp-tn)))
 
@@ -121,7 +145,7 @@
 ;;; works assuming there is no variable size stuff on the nstack.
 ;;;
 (define-vop (compute-old-nfp)
-  (:results (val :scs (any-reg descriptor-reg)))
+  (:results (val :scs (any-reg)))
   (:vop-var vop)
   (:generator 1
     (let ((nfp (current-nfp-tn vop)))
@@ -152,7 +176,7 @@
 	(move nfp-tn nsp-tn)))))
 
 (define-vop (allocate-frame)
-  (:results (res :scs (any-reg descriptor-reg))
+  (:results (res :scs (any-reg))
 	    (nfp :scs (any-reg)))
   (:info callee)
   (:generator 2
@@ -171,7 +195,7 @@
 ;;;
 (define-vop (allocate-full-call-frame)
   (:info nargs)
-  (:results (res :scs (any-reg descriptor-reg)))
+  (:results (res :scs (any-reg)))
   (:generator 2
     (when (> nargs register-arg-count)
       (move res csp-tn)
@@ -220,12 +244,12 @@ regs-defaulted
 
 	bltz temp default-value-4	; jump to default code
         addu temp temp -1
-	loadw move-temp args-tn 3	; Move value to correct location.
+	loadw move-temp old-fp-tn 3	; Move value to correct location.
 	store-stack-tn val4-tn move-temp
 
 	bltz temp default-value-5
         addu temp temp -1
-	loadw move-temp args-tn 4
+	loadw move-temp old-fp-tn 4
 	store-stack-tn val5-tn move-temp
 
 	...
@@ -289,11 +313,11 @@ default-value-5
 		       
 		       (inst bltz temp default-lab)
 		       (inst addu temp temp (fixnum -1))
-		       (loadw move-temp args-tn i)
+		       (loadw move-temp old-fp-tn i)
 		       (store-stack-tn tn move-temp)))
 		   
 		   (emit-label defaulting-done)
-		   (move csp-tn args-tn)
+		   (move csp-tn old-fp-tn)
 		   
 		   (assemble (*elsewhere*)
 		     (dolist (def (defaults))
@@ -358,8 +382,8 @@ default-value-5
 ;;;
 (define-vop (unknown-values-receiver)
   (:results
-   (start :scs (descriptor-reg))
-   (count :scs (descriptor-reg)))
+   (start :scs (any-reg))
+   (count :scs (any-reg)))
   (:temporary (:sc descriptor-reg :offset old-fp-offset
 		   :from :eval :to (:result 0))
 	      values-start)
@@ -386,8 +410,8 @@ default-value-5
 ;;; Nvals is the number of values received.
 ;;;
 (define-vop (call-local)
-  (:args (fp :scs (any-reg descriptor-reg))
-	 (nfp :scs (any-reg descriptor-reg))
+  (:args (fp :scs (any-reg))
+	 (nfp :scs (any-reg))
 	 (args :more t))
   (:results (values :more t))
   (:save-p t)
@@ -422,8 +446,8 @@ default-value-5
 ;;; glob and the number of values received.
 ;;;
 (define-vop (multiple-call-local unknown-values-receiver)
-  (:args (fp :scs (any-reg descriptor-reg))
-	 (nfp :scs (any-reg descriptor-reg))
+  (:args (fp :scs (any-reg))
+	 (nfp :scs (any-reg))
 	 (args :more t))
   (:save-p t)
   (:move-args :local-call)
@@ -456,8 +480,8 @@ default-value-5
 ;;; just like argument passing in local call.
 ;;;
 (define-vop (known-call-local)
-  (:args (fp :scs (any-reg descriptor-reg))
-	 (nfp :scs (any-reg descriptor-reg))
+  (:args (fp :scs (any-reg))
+	 (nfp :scs (any-reg))
 	 (args :more t))
   (:results (res :more t))
   (:move-args :local-call)
@@ -488,7 +512,7 @@ default-value-5
 ;;; restore FP and CSP and jump to the Return-PC.
 ;;;
 (define-vop (known-return)
-  (:args (old-fp :scs (descriptor-reg))
+  (:args (old-fp :scs (any-reg))
 	 (return-pc :scs (descriptor-reg))
 	 (vals :more t))
   (:temporary (:scs (interior-reg) :type interior) lip)
@@ -557,14 +581,14 @@ default-value-5
 		    '(unknown-values-receiver)))
      (:args
       ,@(unless (eq return :tail)
-	  '((new-fp :scs (descriptor-reg) :to :eval)))
+	  '((new-fp :scs (any-reg) :to :eval)))
 
       ,(if named
 	   '(name :scs (descriptor-reg) :target name-pass)
 	   '(arg-fun :scs (descriptor-reg) :target lexenv :to :eval))
       
       ,@(when (eq return :tail)
-	  '((old-fp :scs (descriptor-reg) :target old-fp-pass)
+	  '((old-fp :scs (any-reg) :target old-fp-pass)
 	    (return-pc :scs (descriptor-reg) :target return-pc-pass)))
       
       ,@(unless variable '((args :more t))))
@@ -717,9 +741,9 @@ default-value-5
 (expand
  `(define-vop (tail-call-variable)
     (:args
-     (args :scs (descriptor-reg) :to (:result 0))
+     (args :scs (any-reg) :to (:result 0))
      (function-arg :scs (descriptor-reg) :target lexenv)
-     (old-fp-arg :scs (descriptor-reg) :target old-fp)
+     (old-fp-arg :scs (any-reg) :target old-fp)
      (return-pc-arg :scs (descriptor-reg) :target return-pc))
     (:temporary (:sc any-reg :offset lexenv-offset :from (:argument 0))
 		lexenv)
@@ -883,10 +907,10 @@ default-value-5
 			    register-arg-names)))
    `(define-vop (return-multiple)
       (:args
-       (old-fp :scs (descriptor-reg) :to (:eval 1))
+       (old-fp :scs (any-reg) :to (:eval 1))
        (return-pc :scs (descriptor-reg) :to (:eval 1))
-       (start :scs (descriptor-reg any-reg) :target src)
-       (nvals :scs (descriptor-reg any-reg) :target nargs))
+       (start :scs (any-reg) :target src)
+       (nvals :scs (any-reg) :target nargs))
       (:temporary (:sc any-reg :offset nargs-offset :from (:argument 3)) nargs)
       ,@(mapcar #'(lambda (name offset)
 		    `(:temporary (:sc descriptor-reg :offset ,offset
@@ -1076,13 +1100,13 @@ default-value-5
 ;;; Turn more arg (context, count) into a list.
 ;;;
 (define-vop (listify-rest-args)
-  (:args (context-arg :target context :scs (any-reg descriptor-reg))
-	 (count-arg :target count :scs (any-reg descriptor-reg)))
+  (:args (context-arg :target context :scs (descriptor-reg))
+	 (count-arg :target count :scs (any-reg)))
   (:temporary (:scs (any-reg) :from (:argument 0)) context)
   (:temporary (:scs (any-reg) :from (:argument 1)) count)
   (:temporary (:scs (descriptor-reg) :from :eval) temp)
   (:temporary (:scs (non-descriptor-reg) :from :eval) ndescr dst)
-  (:results (result :scs (any-reg descriptor-reg)))
+  (:results (result :scs (descriptor-reg)))
   (:translate %listify-rest-args)
   (:policy :safe)
   (:generator 20
@@ -1137,11 +1161,11 @@ default-value-5
 ;;;
 (define-vop (more-arg-context)
   (:args
-   (supplied :scs (any-reg descriptor-reg)))
+   (supplied :scs (any-reg)))
   (:info fixed)
   (:results
    (context :scs (descriptor-reg))
-   (count :scs (any-reg descriptor-reg)))
+   (count :scs (any-reg)))
   (:generator 5
     (inst addu count supplied (fixnum (- fixed)))
     (inst subu context csp-tn count)))
@@ -1151,7 +1175,7 @@ default-value-5
 ;;;
 (define-vop (verify-argument-count)
   (:args
-   (nargs :scs (any-reg descriptor-reg)))
+   (nargs :scs (any-reg)))
   (:temporary (:scs (any-reg) :type fixnum) temp)
   (:info count)
   (:generator 3
diff --git a/compiler/mips/debug.lisp b/compiler/mips/debug.lisp
index f50b89cf6804db522314b31759baf62cf634ce19..1011fbaa82e98757749f65dde7ee8651ef156a0d 100644
--- a/compiler/mips/debug.lisp
+++ b/compiler/mips/debug.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/debug.lisp,v 1.1 1990/06/03 19:11:05 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/debug.lisp,v 1.2 1990/06/16 15:34:52 wlott Exp $
 ;;;
 ;;; Compiler support for the new whizzy debugger.
 ;;;
@@ -51,17 +51,18 @@
   (:translate stack-ref)
   (:policy :fast-safe)
   (:results (result :scs (descriptor-reg)))
+  (:result-types *)
   (:variant :long nil))
 
 (define-vop (write-control-stack sap-set)
   (:translate %set-stack-ref)
   (:policy :fast-safe)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg negative-immediate
-				      zero immediate))
+	 (offset :scs (any-reg negative-immediate zero immediate))
 	 (value :scs (descriptor-reg) :target result))
   (:arg-types system-area-pointer positive-fixnum *)
   (:results (result :scs (descriptor-reg)))
+  (:result-types *)
   (:variant :long))
 
 (define-vop (code-from-mumble)
diff --git a/compiler/mips/memory.lisp b/compiler/mips/memory.lisp
index 2a8447194fe45d1f95c4fb2bb1bf179eb70c6cfc..de14d49a7ac2d6e0ffc9b217e8977c28244c65b1 100644
--- a/compiler/mips/memory.lisp
+++ b/compiler/mips/memory.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.7 1990/04/24 02:56:11 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.8 1990/06/16 15:35:14 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS definitions of some general purpose memory
 ;;; reference VOPs inherited by basic memory reference operations.
@@ -108,7 +108,7 @@
 (defmacro define-indexer (name write-p op shift)
   `(define-vop (,name)
      (:args (object :scs (descriptor-reg))
-	    (index :scs (any-reg descriptor-reg immediate negative-immediate))
+	    (index :scs (any-reg zero immediate negative-immediate))
 	    ,@(when write-p
 		'((value :scs (any-reg descriptor-reg) :target result))))
      (:temporary (:scs (interior-reg) :type interior) lip)
@@ -120,9 +120,11 @@
      (:policy :fast-safe)
      (:generator 5
        (sc-case index
-	 ((immediate negative-immediate)
+	 ((immediate zero negative-immediate)
 	  (inst ,op value object
-		(- (+ (ash (tn-value index) (- word-shift ,shift))
+		(- (+ (if (sc-is index zero)
+			  0
+			  (ash (tn-value index) (- word-shift ,shift)))
 		      (ash offset word-shift))
 		   lowtag))
 	  ,(if write-p
diff --git a/compiler/mips/move.lisp b/compiler/mips/move.lisp
index 34b3abf993da2a5f7e895669ee27ca1460e9ae92..bd8cfa40b71e74899137d8cf9b2b9c5ba4ad58ca 100644
--- a/compiler/mips/move.lisp
+++ b/compiler/mips/move.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.16 1990/06/04 05:23:37 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.17 1990/06/16 15:35:17 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS VM definition of operand loading/saving and
 ;;; the Move VOP.
@@ -118,7 +118,7 @@
 (define-vop (move-argument)
   (:args (x :target y
 	    :scs (any-reg descriptor-reg))
-	 (fp :scs (descriptor-reg)
+	 (fp :scs (any-reg)
 	     :load-if (not (sc-is y any-reg descriptor-reg))))
   (:results (y))
   (:generator 0
@@ -265,7 +265,7 @@
 (define-vop (move-signed/unsigned-argument)
   (:args (x :target y
 	    :scs (signed-reg unsigned-reg))
-	 (fp :scs (any-reg descriptor-reg)
+	 (fp :scs (any-reg)
 	     :load-if (not (sc-is y sap-reg))))
   (:results (y))
   (:generator 0
diff --git a/compiler/mips/nlx.lisp b/compiler/mips/nlx.lisp
index 68b8624b7aeb4a4cbb0f3355e2b62f4d5c79b61a..131e1f5786fc854f5419a7ed6ed7872f8116b328 100644
--- a/compiler/mips/nlx.lisp
+++ b/compiler/mips/nlx.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.9 1990/06/03 19:02:10 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.10 1990/06/16 15:35:21 wlott Exp $
 ;;;
 ;;;    This file contains the definitions of VOPs used for non-local exit
 ;;; (throw, lexical exit, etc.)
@@ -21,8 +21,9 @@
 ;;;    Make an environment-live stack TN for saving the SP for NLX entry.
 ;;;
 (defun make-nlx-sp-tn (env)
-  (environment-live-tn (make-representation-tn (sc-number-or-lose 'any-reg))
-		       env))
+  (environment-live-tn
+   (make-representation-tn *fixnum-primitive-type* immediate-arg-scn)
+   env))
 
 
 
@@ -116,7 +117,7 @@
 (define-vop (make-unwind-block)
   (:args (tn))
   (:info entry-label)
-  (:results (block :scs (descriptor-reg)))
+  (:results (block :scs (any-reg)))
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :target block) result)
   (:generator 22
@@ -137,7 +138,7 @@
   (:args (tn)
 	 (tag :scs (descriptor-reg)))
   (:info entry-label)
-  (:results (block :scs (descriptor-reg)))
+  (:results (block :scs (any-reg)))
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :target block) result)
   (:generator 44
@@ -169,7 +170,7 @@
 
 
 (define-vop (unlink-catch-block)
-  (:temporary (:scs (descriptor-reg)) block)
+  (:temporary (:scs (any-reg)) block)
   (:policy :fast-safe)
   (:translate %catch-breakup)
   (:generator 17
@@ -178,7 +179,7 @@
     (store-symbol-value block lisp::*current-catch-block*)))
 
 (define-vop (unlink-unwind-protect)
-  (:temporary (:scs (descriptor-reg)) block)
+  (:temporary (:scs (any-reg)) block)
   (:policy :fast-safe)
   (:translate %unwind-protect-breakup)
   (:generator 17
diff --git a/compiler/mips/sap.lisp b/compiler/mips/sap.lisp
index 233a0ca4038cb504239ebe01b271619634f4d772..593b1cef64aad236a91f009cabd4d667e1a919f6 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.11 1990/05/14 07:15:58 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.12 1990/06/16 15:35:25 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS VM definition of SAP operations.
 ;;;
@@ -150,10 +150,9 @@
   (:policy :fast-safe)
   (:variant-vars size signed)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg negative-immediate zero
-				      immediate unsigned-immediate)))
+	 (offset :scs (any-reg negative-immediate zero immediate)))
   (:arg-types system-area-pointer positive-fixnum)
-  (:results (result :scs (signed-reg unsigned-reg)))
+  (:results (result))
   (:temporary (:scs (sap-reg) :from (:argument 0)) sap)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 5
@@ -195,11 +194,11 @@
   (:policy :fast-safe)
   (:variant-vars size)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg negative-immediate
-				      zero immediate))
+	 (offset :scs (any-reg negative-immediate zero immediate))
 	 (value :scs (signed-reg unsigned-reg) :target result))
-  (:arg-types system-area-pointer positive-fixnum *)
+  (:arg-types system-area-pointer positive-fixnum (:or signed-num unsigned-num))
   (:results (result :scs (signed-reg unsigned-reg)))
+  (:result-types (:or signed-num unsigned-num))
   (:temporary (:scs (sap-reg) :from (:argument 0))
 	      sap)
   (:temporary (:scs (non-descriptor-reg)) temp)
@@ -238,56 +237,73 @@
 (define-vop (sap-system-ref sap-ref)
   (:translate sap-ref-sap)
   (:results (result :scs (sap-reg)))
+  (:result-types system-area-pointer)
   (:variant :long nil))
 
 (define-vop (sap-system-set sap-set)
   (:translate %set-sap-ref-sap)
   (:args (object :scs (sap-reg) :target sap)
-	 (offset :scs (descriptor-reg any-reg negative-immediate
-				      zero immediate))
+	 (offset :scs (any-reg negative-immediate zero immediate))
 	 (value :scs (sap-reg) :target result))
   (:arg-types system-area-pointer positive-fixnum system-area-pointer)
   (:results (result :scs (sap-reg)))
+  (:result-types system-area-pointer)
   (:variant :long))
 
 
 
 (define-vop (32bit-system-ref sap-ref)
   (:translate sap-ref-32)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)
   (:variant :long nil))
 
 (define-vop (signed-32bit-system-ref sap-ref)
   (:translate signed-sap-ref-32)
+  (:results (result :scs (signed-reg)))
+  (:result-types signed-num)
   (:variant :long t))
 
 (define-vop (32bit-system-set sap-set)
   (:translate %set-sap-ref-32)
+  (:arg-types system-area-pointer positive-fixnum
+	      (:or unsigned-num signed-num))
   (:variant :long))
 
 
 (define-vop (16bit-system-ref sap-ref)
   (:translate sap-ref-16)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types positive-fixnum)
   (:variant :short nil))
 
 (define-vop (signed-16bit-system-ref sap-ref)
   (:translate signed-sap-ref-16)
+  (:results (result :scs (signed-reg)))
+  (:result-types tagged-num)
   (:variant :short t))
 
 (define-vop (16bit-system-set sap-set)
   (:translate %set-sap-ref-16)
+  (:arg-types system-area-pointer positive-fixnum tagged-num)
   (:variant :short))
 
 
 (define-vop (8bit-system-ref sap-ref)
   (:translate sap-ref-8)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types positive-fixnum)
   (:variant :byte nil))
 
 (define-vop (signed-8bit-system-ref sap-ref)
   (:translate signed-sap-ref-8)
+  (:results (result :scs (signed-reg)))
+  (:result-types tagged-num)
   (:variant :byte t))
 
 (define-vop (8bit-system-set sap-set)
   (:translate %set-sap-ref-8)
+  (:arg-types system-area-pointer positive-fixnum tagged-num)
   (:variant :byte))
 
 
diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp
index 6f67199d959e94a14a924635eafbbcfc3c43d486..fd58e7bc28e1547c042454e9aff0860da8079392 100644
--- a/compiler/mips/type-vops.lisp
+++ b/compiler/mips/type-vops.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.17 1990/06/04 06:13:43 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.18 1990/06/16 15:35:31 wlott Exp $
 ;;; 
 ;;; This file contains the VM definition of type testing and checking VOPs
 ;;; for the RT.
@@ -474,3 +474,25 @@
 	
 	(emit-label not-coercable-label)
 	(error-call object-not-coercable-to-function-error object)))))
+
+(define-vop (fast-safe-coerce-to-function)
+  (:args (object :scs (descriptor-reg)
+		:target result))
+  (:results (result :scs (descriptor-reg)))
+  (:temporary (:type random  :scs (non-descriptor-reg)) nd-temp)
+  (:temporary (:scs (descriptor-reg)) saved-object)
+  (:generator 0
+    (let ((not-function-label (gen-label))
+	  (done-label (gen-label)))
+      (test-simple-type object nd-temp not-function-label t
+			vm:function-pointer-type)
+      (move result object)
+      (emit-label done-label)
+
+      (assemble (*elsewhere*)
+	(emit-label not-function-label)
+	(move saved-object object)
+	(loadw result object vm:symbol-function-slot vm:other-pointer-type)
+	(test-simple-type result nd-temp done-label nil
+			  vm:function-pointer-type)
+	(error-call undefined-symbol-error saved-object)))))
diff --git a/compiler/mips/values.lisp b/compiler/mips/values.lisp
index 02fc1684b793de0cc8800f5cfa82d9f84eebed47..c874e5a9a36185e9031bdeaf1632f1f9dee809f1 100644
--- a/compiler/mips/values.lisp
+++ b/compiler/mips/values.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/values.lisp,v 1.8 1990/06/04 05:23:53 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/values.lisp,v 1.9 1990/06/16 15:35:37 wlott Exp $
 ;;;
 ;;;    This file contains the implementation of unknown-values VOPs.
 ;;;
@@ -36,8 +36,8 @@
   (:args
    (vals :more t))
   (:results
-   (start :scs (descriptor-reg))
-   (count :scs (any-reg descriptor-reg)))
+   (start :scs (any-reg))
+   (count :scs (any-reg)))
   (:info nvals)
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg)
@@ -68,8 +68,8 @@
   (:args (arg :scs (descriptor-reg) :target list))
   (:arg-types list)
   (:policy :fast-safe)
-  (:results (start :scs (any-reg descriptor-reg))
-	    (count :scs (descriptor-reg)))
+  (:results (start :scs (any-reg))
+	    (count :scs (any-reg)))
   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp
index 7f5bb39a2c2dabdf81c779a47e6de80b2d96b4fe..11e2047c3e0c2a09ce480173abd6fe8fd2ff5b53 100644
--- a/compiler/mips/vm.lisp
+++ b/compiler/mips/vm.lisp
@@ -7,7 +7,7 @@
 ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.29 1990/06/03 18:56:47 ch Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.30 1990/06/16 15:36:02 wlott Exp $
 ;;;
 ;;; This file contains the VM definition for the MIPS R2000 and the new
 ;;; object format.
@@ -202,6 +202,8 @@
 (def-primitive-type signed-byte-32 (signed-reg descriptor-reg)
   :type (signed-byte 32))
 
+(defvar *fixnum-primitive-type* (primitive-type-or-lose 'fixnum))
+
 (def-primitive-type-alias tagged-num (:or positive-fixnum fixnum))
 (def-primitive-type-alias unsigned-num (:or unsigned-byte-32
 					    unsigned-byte-31
@@ -418,7 +420,7 @@
   (defconstant a5-offset 13)
   (defconstant cname-offset 14)
   (defconstant lexenv-offset 15)
-  (defconstant args-offset 16)
+  (defconstant nfp-offset 16)
   (defconstant old-fp-offset 17)
   (defconstant lra-offset 18)
   (defconstant l0-offset 19)
@@ -558,6 +560,7 @@
 ;;; The SC numbers for register and stack arguments/return values.
 ;;;
 (defconstant register-arg-scn (sc-number-or-lose 'descriptor-reg))
+(defconstant immediate-arg-scn (sc-number-or-lose 'any-reg))
 (defconstant control-stack-arg-scn (sc-number-or-lose 'control-stack))
 
 (eval-when (compile load eval)
@@ -575,11 +578,6 @@
 		  :sc (sc-or-lose 'any-reg)
 		  :offset nargs-offset))
 
-(defparameter args-tn
-  (make-random-tn :kind :normal
-		  :sc (sc-or-lose 'descriptor-reg)
-		  :offset args-offset))
-
 (defparameter old-fp-tn
   (make-random-tn :kind :normal
 		  :sc (sc-or-lose 'descriptor-reg)