From 54a0138ffb1405ca9a2f42767949c3a1ef89f305 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 24 Apr 1990 02:58:30 +0000
Subject: [PATCH] Changes for new-assembler.

---
 assembly/assemfile.lisp      |  33 +-
 compiler/dump.lisp           | 100 ++--
 compiler/mips/alloc.lisp     |   8 +-
 compiler/mips/arith.lisp     | 106 ++---
 compiler/mips/array.lisp     |  15 +-
 compiler/mips/call.lisp      | 315 ++++++-------
 compiler/mips/cell.lisp      |  42 +-
 compiler/mips/char.lisp      |   4 +-
 compiler/mips/insts.lisp     | 890 ++++++++++++++++++-----------------
 compiler/mips/macros.lisp    | 111 ++---
 compiler/mips/memory.lisp    |  10 +-
 compiler/mips/move.lisp      |  12 +-
 compiler/mips/nlx.lisp       |  58 ++-
 compiler/mips/pred.lisp      |   8 +-
 compiler/mips/print.lisp     |  12 +-
 compiler/mips/sap.lisp       |   8 +-
 compiler/mips/static-fn.lisp |  40 +-
 compiler/mips/subprim.lisp   |   8 +-
 compiler/mips/system.lisp    |  26 +-
 compiler/mips/type-vops.lisp |  53 +--
 compiler/mips/values.lisp    |  10 +-
 21 files changed, 904 insertions(+), 965 deletions(-)

diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp
index 567d65064..804c1998f 100644
--- a/assembly/assemfile.lisp
+++ b/assembly/assemfile.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.6 1990/03/29 16:25:41 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.7 1990/04/24 02:55:49 wlott Exp $
 ;;;
 ;;; This file contains the extra code necessary to feed an entire file of
 ;;; assembly code to the assembler.
@@ -24,7 +24,6 @@
 (defvar *assembler-routines* nil
   "A List of (name . label) for every entry point.")
 
-
 (defun assemble-file (name &key (output-file
 				 (make-pathname :defaults name
 						:type "mips-fasl")))
@@ -34,16 +33,19 @@
 	 (*assembler-routines* nil)
 	 (won nil))
     (unwind-protect
-	(progn
+	(let (*code-segment* *elsewhere*)
 	  (init-assembler)
 	  (load (merge-pathnames name (make-pathname :type "lisp")))
 	  (finish-assembly)
 	  (fasl-dump-cold-load-form `(in-package ,(package-name *package*))
 				    *lap-output-file*)
-	  (let ((handle (dump-assembler-routines *code-vector* *next-location*
-						 *assembler-routines*
-						 *lap-output-file*)))
-	    (dump-fixups handle *result-fixups* *lap-output-file*))
+	  (assemble (*code-segment* nil)
+	    (insert-segment *elsewhere*))
+	  (let ((length (finalize-segment *code-segment*)))
+	    (dump-assembler-routines *code-segment*
+				     length
+				     *assembler-routines*
+				     *lap-output-file*))
 	  (setq won t))
       (close-fasl-file *lap-output-file* (not won)))
     won))
@@ -220,7 +222,7 @@
 			 `(,label (gen-label)))
 		     labels))
        (push (cons ',name ,name) *assembler-routines*)
-       (assemble ',name
+       (assemble (*code-segment* ',name)
 	 (emit-label ,name)
 	 (let (,@(mapcar
 		  #'(lambda (reg)
@@ -231,9 +233,9 @@
 			   :offset ,(reg-spec-offset temp)))))
 		  regs))
 	   ,@insts
-	   (inst addiu lip-tn lra-tn (- vm:word-bytes vm:other-pointer-type))
-	   (inst jr lip-tn)
-	   (nop)))
+	   (inst addu lip-tn lra-tn (- vm:word-bytes vm:other-pointer-type))
+	   (inst j lip-tn)
+	   (inst nop)))
        (format t "~S assembled~%" ',name))))
 
 (defun arg-or-res-spec (reg)
@@ -292,11 +294,10 @@
 			      ,(reg-spec-name arg)))
 		   args)
 	 (let ((,return-pc-label (gen-label)))
-	   (inst compute-lra-from-code ,return-pc code-tn
-		 ,return-pc-label)
-	   (inst load-assembly-address ,ndescr ',name)
-	   (inst jr ,ndescr)
-	   (nop)
+	   (inst compute-lra-from-code ,return-pc code-tn ,return-pc-label)
+	   (inst li ,ndescr (make-fixup ',name :assembly-routine))
+	   (inst j ,ndescr)
+	   (inst nop)
 	   (emit-return-pc ,return-pc-label))
 
 	 ,@(mapcar #'(lambda (res)
diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index 0cfdcdfb1..22511fed6 100644
--- a/compiler/dump.lisp
+++ b/compiler/dump.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.7 1990/04/02 02:53:39 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.8 1990/04/24 02:58:30 wlott Exp $
 ;;;
 ;;;    This file contains stuff that knows about dumping FASL files.
 ;;;
@@ -328,11 +328,8 @@
 ;;;    We dump a trap object as a placeholder for the code vector, which is
 ;;; actually filled in by the loader.
 ;;;
-(defun dump-code-object (component code-vector code-length node-vector
-				   nodes-length file)
-  (declare (type component component) (type fasl-file file)
-	   (simple-vector node-vector)
-	   (type unsigned-byte code-length nodes-length))
+(defun dump-code-object (component code-segment code-length file)
+  (declare (type component component) (type fasl-file file))
   (let* ((2comp (component-info component))
 	 (constants (ir2-component-constants 2comp))
 	 (num-consts (length constants)))
@@ -356,16 +353,16 @@
 		   (t
 		    (patches (cons info i))
 		    (dump-fop 'lisp::fop-misc-trap file)))))
+	       #+nil
 	       (:label
-		(dump-object (+ (label-location (cdr entry))
+		(dump-object (+ (label-position (cdr entry))
 				clc::i-vector-header-size)
 			     file))))
 	    (null
 	     (dump-fop 'lisp::fop-misc-trap file)))))
 
       ;; Dump the debug info.
-      (let ((info (debug-info-for-component component node-vector
-					    nodes-length)))
+      (let ((info (debug-info-for-component component)))
 	(dump-object info file)
 	(let ((info-handle (dump-pop file)))
 	  (dump-push info-handle file)
@@ -381,26 +378,26 @@
 	       (quick-dump-number num-consts 4 file)
 	       (quick-dump-number code-length 4 file))))
       
-      (write-string code-vector (fasl-file-stream file) :end code-length)
-      
-      (let ((handle (dump-pop file)))
+      (let ((fixups (emit-code-vector (fasl-file-stream file) code-segment))
+	    (handle (dump-pop file)))
+	(dump-fixups handle fixups file)
 	(dolist (patch (patches))
 	  (push (cons handle (cdr patch))
 		(gethash (car patch) (fasl-file-patch-table file))))
 	handle))))
 
 
-(defun dump-assembler-routines (code-vector length routines file)
+(defun dump-assembler-routines (code-segment length routines file)
   (dump-fop 'lisp::fop-assembler-code file)
   (quick-dump-number length 4 file)
-  (write-string code-vector (fasl-file-stream file) :end length)
-  (dolist (routine routines)
-    (dump-object (car routine) file)
-    (dump-fop 'lisp::fop-assembler-routine file)
-    (quick-dump-number (label-location (cdr routine)) 4 file))
-  (dump-pop file))
-
-
+  (let ((fixups (emit-code-vector (fasl-file-stream file) code-segment)))
+    (dolist (routine routines)
+      (dump-object (car routine) file)
+      (dump-fop 'lisp::fop-assembler-routine file)
+      (quick-dump-number (label-position (cdr routine)) 4 file))
+    (let ((handle (dump-pop file)))
+      (dump-fixups handle fixups file)
+      handle)))
 
 ;;; Dump-Fixups  --  Internal
 ;;;
@@ -413,24 +410,36 @@
 	   (type fasl-file file))
   (when fixups
     (dump-push code-handle file)
-    (dolist (fixup fixups)
-      (let ((offset (second fixup))
-	    (value (third fixup)))
-	(ecase (first fixup)
-	  (:foreign
-	   (assert (stringp value))
-	   (dump-fop 'lisp::fop-foreign-fixup file)
-	   (quick-dump-number offset 4 file)
-	   (let ((len (length value)))
-	     (assert (< len 256))
-	     (dump-byte len file)
-	     (dotimes (i len)
-	       (dump-byte (char-code (schar value i)) file))))
-	  (:assembly
-	   (assert (symbolp value))
-	   (dump-object value file)
-	   (dump-fop 'lisp::fop-assembler-fixup file)
-	   (quick-dump-number offset 4 file)))))
+    (dolist (info fixups)
+      (let* ((kind (first info))
+	     (fixup (second info))
+	     (name (fixup-name fixup))
+	     (flavor (fixup-flavor fixup))
+	     (offset (third info)))
+	(ecase kind
+	  (:addi
+	   ;; ### The lui fixup assumes that an addi follows it.
+	   )
+	  (:lui
+	   (ecase flavor
+	     (:assembly-routine
+	      (assert (symbolp name))
+	      (dump-object name file)
+	      (dump-fop 'lisp::fop-assembler-fixup file)
+	      (quick-dump-number offset 4 file))
+	     (:foreign
+	      (assert (stringp name))
+	      (dump-fop 'lisp::fop-foreign-fixup file)
+	      (quick-dump-number offset 4 file)
+	      (let ((len (length name)))
+		(assert (< len 256))
+		(dump-byte len file)
+		(dotimes (i len)
+		  (dump-byte (char-code (schar name i)) file))))))
+	  #+nil
+	  (:jump
+	   ;; ### Need to impliment this.
+	   ))))
     (dump-fop 'lisp::fop-pop-for-effect file))
   (undefined-value))
 
@@ -454,7 +463,7 @@
     (dump-object (entry-info-arguments entry) file)
     (dump-object (entry-info-type entry) file)
     (dump-fop 'lisp::fop-function-entry file)
-    (quick-dump-number (label-location (entry-info-offset entry))
+    (quick-dump-number (label-position (entry-info-offset entry))
 		       4 file)
     (let ((handle (dump-pop file)))
       (when (and name (symbolp name))
@@ -480,20 +489,15 @@
 ;;;    Dump the code, constants, etc. for component.  We pass in the assembler
 ;;; fixups, code vector and node info.
 ;;;
-(defun fasl-dump-component (component code-vector code-length
-				      node-vector nodes-length
-				      fixups file)
-  (declare (type component component) (type unsigned-byte length)
-	   (list fixups) (type fasl-file file))
+(defun fasl-dump-component (component code-segment length file)
+  (declare (type component component) (type fasl-file file))
 
   (dump-fop 'lisp::fop-verify-empty-stack file)
   (dump-fop 'lisp::fop-verify-table-size file)
   (quick-dump-number (fasl-file-table-free file) 4 file)
 
-  (let ((code-handle (dump-code-object component code-vector code-length
-				       node-vector nodes-length file))
+  (let ((code-handle (dump-code-object component code-segment length file))
 	(2comp (component-info component)))
-    (dump-fixups code-handle fixups file)
     (dump-fop 'lisp::fop-verify-empty-stack file)
 
     (dolist (entry (ir2-component-entries 2comp))
diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
index 8ba8c4bbc..b4886807d 100644
--- a/compiler/mips/alloc.lisp
+++ b/compiler/mips/alloc.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.3 1990/02/28 18:23:33 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.4 1990/04/24 02:55:22 wlott Exp $
 ;;;
 ;;; Allocation VOPs for the MIPS port.
 ;;;
@@ -47,14 +47,14 @@
 		     (storew reg ,list ,slot vm:list-pointer-type))))
 	     (let ((cons-cells (if star (1- num) num)))
 	       (pseudo-atomic (ndescr)
-		 (inst addiu res alloc-tn vm:list-pointer-type)
-		 (inst addiu alloc-tn alloc-tn
+		 (inst addu res alloc-tn vm:list-pointer-type)
+		 (inst addu alloc-tn alloc-tn
 		       (* (vm:pad-data-block vm:cons-size) cons-cells))
 		 (move ptr res)
 		 (dotimes (i (1- cons-cells))
 		   (store-car (tn-ref-tn things) ptr)
 		   (setf things (tn-ref-across things))
-		   (inst addiu ptr ptr (vm:pad-data-block vm:cons-size))
+		   (inst addu ptr ptr (vm:pad-data-block vm:cons-size))
 		   (storew ptr ptr
 			   (- vm:cons-cdr-slot vm:cons-size)
 			   vm:list-pointer-type))
diff --git a/compiler/mips/arith.lisp b/compiler/mips/arith.lisp
index 8890f1eeb..4d311a116 100644
--- a/compiler/mips/arith.lisp
+++ b/compiler/mips/arith.lisp
@@ -7,6 +7,8 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/arith.lisp,v 1.12 1990/04/24 02:55:38 wlott Exp $
+;;;
 ;;;    This file contains the VM definition arithmetic VOPs for the MIPS.
 ;;;
 ;;; Written by Rob MacLachlan
@@ -31,14 +33,14 @@
 (define-vop (fast-negate/fixnum fixnum-unop)
   (:translate %negate)
   (:generator 1
-    (inst sub res zero-tn x)))
+    (inst subu res zero-tn x)))
 
 (define-vop (fast-lognot/fixnum fixnum-unop)
   (:temporary (:scs (any-reg) :type fixnum :to (:result 0))
 	      temp)
   (:translate lognot)
   (:generator 1
-    (loadi temp (fixnum -1))
+    (inst li temp (fixnum -1))
     (inst xor res x temp)))
 
 
@@ -58,61 +60,44 @@
   (:affected)
   (:policy :fast-safe))
 
-(defmacro define-fixnum-binop ((name translate cost result-type)
-			       op
-			       &key unsigned immed-op function)
+(defmacro define-fixnum-binop (name translate cost result-type op
+				    &optional unsigned)
   `(define-vop (,name fast-binop)
      (:args (x :target r
 	       :scs (any-reg descriptor-reg))
 	    (y :target r
-	       :scs (any-reg descriptor-reg
-			     ,@(when immed-op
-				 (list (if unsigned
-					   'unsigned-immediate
-					   'negative-immediate)
-				       'immediate
-				       'zero)))))
+	       :scs (any-reg descriptor-reg immediate zero
+			     ,(if unsigned
+				  'unsigned-immediate
+				  'negative-immediate))))
      (:translate ,translate)
      (:result-types ,result-type)
-     ,@(when (eq result-type t)
-	 '((:note "inline fixnum arithmetic")))
+     (:note ,(if (eq result-type '*) "inline fixnum arithmetic"))
      (:generator ,cost
        (sc-case y
 	 ((any-reg descriptor-reg)
 	  (inst ,op r x y))
 	 (zero
 	  (inst ,op r x zero-tn))
-	 ,@(when immed-op
-	     `(((immediate
-		 ,(if unsigned 'unsigned-immediate 'negative-immediate))
-		(inst ,immed-op r x
-		      (fixnum ,(if function
-				   `(,function (tn-value y))
-				   '(tn-value y)))))))))))
+	 ((immediate
+	   ,(if unsigned 'unsigned-immediate 'negative-immediate))
+	  (inst ,op r x
+		(fixnum (tn-value y))))))))
 
 ;;; Plus and minus.
 
-(define-fixnum-binop (fast-+/fixnum=>fixnum + 1 fixnum)
-		     addu :immed-op addiu))
-(define-fixnum-binop (fast-+/fixnum + 2 t)
-		     add :immed-op addi)
+(define-fixnum-binop fast-+/fixnum=>fixnum + 1 fixnum addu)
+(define-fixnum-binop fast-+/fixnum + 2 * add)
 
-(define-fixnum-binop (fast--/fixnum=>fixnum - 1 fixnum)
-		     subu :immed-op addiu :function -)
-(define-fixnum-binop (fast--/fixnum - 2 t)
-		     sub :immed-op addi :function -)
+(define-fixnum-binop fast--/fixnum=>fixnum - 1 fixnum subu)
+(define-fixnum-binop fast--/fixnum - 2 * sub)
 
 
 ;;; Logical operatons.
 
-(define-fixnum-binop (fast-logior/fixnum logior 1 *)
-		     or :immed-op ori :unsigned t)
-
-(define-fixnum-binop (fast-logand/fixnum logand 1 *)
-		     and :immed-op andi :unsigned t)
-
-(define-fixnum-binop (fast-logxor/fixnum logxor 1 *)
-		     xor :immed-op xori :unsigned t)
+(define-fixnum-binop fast-logior/fixnum logior 1 * or t)
+(define-fixnum-binop fast-logand/fixnum logand 1 * and t)
+(define-fixnum-binop fast-logxor/fixnum logxor 1 * xor t)
 
 
 ;;; Shifting
@@ -131,7 +116,6 @@
 	      num)
   (:temporary (:scs (non-descriptor-reg) :type random :from (:argument 1))
 	      ndesc foo)
-  (:node-var node)
   (:generator 3
     (sc-case amount
       ((any-reg descriptor-reg)
@@ -143,25 +127,24 @@
 	 (inst sra ndesc amount 2)
 
 	 ;; The fixnum result-type assures us that this shift will not overflow.
-	 (inst sllv result num ndesc)
+	 (inst sll result num ndesc)
 	 (emit-label done)
 
-	 (unassemble
-	  (assemble-elsewhere node
-	    (emit-label negative)
-	    (inst nor ndesc ndesc ndesc)
-	    (inst addiu ndesc ndesc 3)
-	    (inst andi foo ndesc #x1f)
-	    (inst beq foo ndesc very-negative)
-
-	    (inst srav ndesc num ndesc)
-	    (b done)
-	    (inst sll result ndesc 2)
-
-	    (emit-label very-negative)
-	    (inst sra ndesc num 31)
-	    (b done)
-	    (inst sll result ndesc 2)))))
+	 (assemble (*elsewhere*)
+	   (emit-label negative)
+	   (inst nor ndesc ndesc ndesc)
+	   (inst addu ndesc ndesc 3)
+	   (inst and foo ndesc #x1f)
+	   (inst beq foo ndesc very-negative)
+	   
+	   (inst sra ndesc num ndesc)
+	   (inst b done)
+	   (inst sll result ndesc 2)
+	   
+	   (emit-label very-negative)
+	   (inst sra ndesc num 31)
+	   (inst b done)
+	   (inst sll result ndesc 2))))
       (immediate
        (inst sll result number (tn-value amount)))
       (negative-immediate
@@ -203,9 +186,8 @@
   (:temporary (:scs (non-descriptor-reg) :type random) t1 t2)
   (:results (q :scs (any-reg descriptor-reg))
 	    (r :scs (any-reg descriptor-reg)))
-  (:node-var node)
   (:generator 5
-    (let ((zero (generate-error-code node di:division-by-zero-error x y)))
+    (let ((zero (generate-error-code di:division-by-zero-error x y)))
       (inst beq y zero-tn zero))
     (inst sra t1 x 2)
     (inst sra t2 y 2)
@@ -254,7 +236,7 @@
 	   (inst bgez x target)
 	   (inst bltz x target)))
       ((negative-immediate immediate)
-       (inst slti temp x (fixnum (tn-value y)))
+       (inst slt temp x (fixnum (tn-value y)))
        (if not-p
 	   (inst beq temp zero-tn target)
 	   (inst bne temp zero-tn target)))
@@ -263,7 +245,7 @@
        (if not-p
 	   (inst beq temp zero-tn target)
 	   (inst bne temp zero-tn target))))
-    (nop)))
+    (inst nop)))
 
 (define-vop (fast-if->/fixnum fast-conditional/fixnum)
   (:temporary (:type fixnum :scs (any-reg) :from (:argument 0)) temp)
@@ -275,7 +257,7 @@
 	   (inst blez x target)
 	   (inst bgtz x target)))
       ((negative-immediate immediate)
-       (inst slti temp x (fixnum (1+ (tn-value y))))
+       (inst slt temp x (fixnum (1+ (tn-value y))))
        (if not-p
 	   (inst bne temp zero-tn target)
 	   (inst beq temp zero-tn target)))
@@ -284,7 +266,7 @@
        (if not-p
 	   (inst beq temp zero-tn target)
 	   (inst bne temp zero-tn target))))
-    (nop)))
+    (inst nop)))
 
 (define-vop (fast-if-=/fixnum fast-conditional/fixnum)
   (:args (x :scs (any-reg descriptor-reg))
@@ -297,7 +279,7 @@
       (if not-p
 	  (inst bne x foo target)
 	  (inst beq x foo target)))
-    (nop)))
+    (inst nop)))
 
 
 
diff --git a/compiler/mips/array.lisp b/compiler/mips/array.lisp
index 9daa5e656..7801491c0 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.9 1990/04/04 22:37:59 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/array.lisp,v 1.10 1990/04/24 02:55:41 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS definitions for array operations.
 ;;;
@@ -26,8 +26,8 @@
   (:results (result :scs (descriptor-reg)))
   (:generator 0
     (pseudo-atomic (ndescr)
-      (inst addiu header alloc-tn vm:other-pointer-type)
-      (inst addiu alloc-tn alloc-tn
+      (inst addu header alloc-tn vm:other-pointer-type)
+      (inst addu alloc-tn alloc-tn
 	    (* vm:array-dimensions-offset vm:word-bytes))
       (inst addu alloc-tn alloc-tn rank)
       (inst sll ndescr rank vm:type-bits)
@@ -68,7 +68,7 @@
     (loadw temp x 0 vm:other-pointer-type)
     (inst sra temp temp vm:type-bits)
     (inst sll res temp 2)
-    (inst addiu res res (fixnum (- 1 vm:array-dimensions-offset)))))
+    (inst addu res res (fixnum (- 1 vm:array-dimensions-offset)))))
 
 
 
@@ -82,14 +82,13 @@
 	 (bound :scs (any-reg descriptor-reg))
 	 (index :scs (any-reg descriptor-reg) :target result))
   (:results (result :scs (any-reg descriptor-reg)))
-  (:node-var node)
   (:temporary (:scs (non-descriptor-reg) :type random) temp)
   (:generator 5
-    (let ((error (generate-error-code node di:invalid-array-index-error
+    (let ((error (generate-error-code di:invalid-array-index-error
 				      array bound index)))
       (inst sltu temp index bound)
       (inst beq temp zero-tn error)
-      (nop)
+      (inst nop)
       (move result index))))
 
 
@@ -182,7 +181,7 @@
   (:temporary (:scs (non-descriptor-reg) :type random) t1 t2)
   (:generator 6
     (loadw t1 x 0 vm:other-pointer-type)
-    (loadi t2 vm:type-mask)
+    (inst li t2 vm:type-mask)
     (inst and t1 t1 t2)
     (inst sll t2 subtype (- vm:type-bits 2))
     (inst or t1 t1 t2)
diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp
index 4734c5fcb..9cea31091 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.4 1990/04/23 16:39:07 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.5 1990/04/24 02:55:54 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of function call for the MIPS.
 ;;;
@@ -125,7 +125,7 @@
   (:generator 1
     (let ((nfp (current-nfp-tn vop)))
       (when nfp
-	(inst addiu val nfp
+	(inst addu val nfp
 	      (* (sb-allocated-size 'non-descriptor-stack) vm:word-bytes))))))
 
 
@@ -140,12 +140,12 @@
     (inst function-header-word)
     (dotimes (i (1- vm:function-header-code-offset))
       (inst word 0))
-    (inst addiu csp-tn fp-tn
+    (inst addu csp-tn fp-tn
 	  (* vm:word-bytes (sb-allocated-size 'control-stack)))
     (let ((nfp-tn (current-nfp-tn vop)))
       (when nfp-tn
 	(move nfp-tn nsp-tn)
-	(inst addiu nsp-tn nsp-tn
+	(inst addu nsp-tn nsp-tn
 	      (- (* (sb-allocated-size 'non-descriptor-stack)
 		    vm:word-bytes)))))))
 
@@ -156,11 +156,11 @@
   (:ignore nfp)
   (:generator 2
     (move res csp-tn)
-    (inst addiu csp-tn csp-tn
+    (inst addu csp-tn csp-tn
 	  (* vm:word-bytes (sb-allocated-size 'control-stack)))
     (when (ir2-environment-number-stack-p callee)
       (move nfp nsp-tn)
-      (inst addiu nsp-tn nsp-tn
+      (inst addu nsp-tn nsp-tn
 	    (- (* (sb-allocated-size 'non-descriptor-stack)
 		  vm:word-bytes))))))
 
@@ -174,7 +174,7 @@
   (:generator 2
     (when (> nargs register-arg-count)
       (move res csp-tn)
-      (inst addiu csp-tn csp-tn (* nargs vm:word-bytes)))))
+      (inst addu csp-tn csp-tn (* nargs vm:word-bytes)))))
 
 
 
@@ -184,8 +184,7 @@
 ;;;    Emit code needed at the return-point from an unknown-values call for a
 ;;; fixed number of values.  Values is the head of the TN-Ref list for the
 ;;; locations that the values are to be received into.  Nvals is the number of
-;;; values that are to be received (should equal the length of Values).  Node
-;;; is the node to use for source context in emitted code.
+;;; values that are to be received (should equal the length of Values).
 ;;;
 ;;;    Move-Temp and Nil-Temp are Descriptor-Reg TNs used as temporaries.
 ;;;
@@ -219,12 +218,12 @@ regs-defaulted
 	sub temp nargs register-arg-count
 
 	bltz temp default-value-4	; jump to default code
-        addiu temp temp -1
+        addu temp temp -1
 	loadw move-temp args-tn 3	; Move value to correct location.
 	store-stack-tn val4-tn move-temp
 
 	bltz temp default-value-5
-        addiu temp temp -1
+        addu temp temp -1
 	loadw move-temp args-tn 4
 	store-stack-tn val5-tn move-temp
 
@@ -247,62 +246,60 @@ default-value-5
         nop
 |#
 ;;;
-(defun default-unknown-values (node values nvals move-temp temp lra-label)
-  (declare (type node node) (type (or tn-ref null) values)
+(defun default-unknown-values (values nvals move-temp temp lra-label)
+  (declare (type (or tn-ref null) values)
 	   (type unsigned-byte nvals) (type tn move-temp temp))
-  (assemble node
-    (if (<= nvals 1)
-	(progn
-	  (move csp-tn old-fp-tn)
-	  (nop)
-	  (inst compute-code-from-lra code-tn code-tn lra-label))
-	(let ((regs-defaulted (gen-label))
-	      (defaulting-done (gen-label)))
-	  ;; Branch off to the MV case.
-	  (b regs-defaulted)
-	  (inst compute-code-from-lra code-tn code-tn lra-label)
-
-	  ;; Do the single value calse.
-	  (inst compute-code-from-lra code-tn code-tn lra-label)
-	  (do ((i 1 (1+ i))
-	       (val (tn-ref-across values) (tn-ref-across val)))
-	      ((= i (min nvals register-arg-count)))
-	    (move (tn-ref-tn val) null-tn))
-	  (when (> nvals register-arg-count)
-	    (loadi nargs-tn (fixnum 1))
-	    (move old-fp-tn csp-tn))
-
-	  (emit-label regs-defaulted)
-
-	  (when (> nvals register-arg-count)
-	    (inst addiu temp nargs-tn (fixnum (- register-arg-count)))
-	    (collect ((defaults))
-	      (do ((i register-arg-count (1+ i))
-		   (val (do ((i 0 (1+ i))
-			     (val values (tn-ref-across val)))
-			    ((= i register-arg-count) val))
-			(tn-ref-across val)))
-		  ((null val))
-		
-		(let ((default-lab (gen-label))
-		      (tn (tn-ref-tn val)))
-		  (defaults (cons default-lab tn))
-		  
-		  (inst bltz temp default-lab)
-		  (inst addiu temp temp (fixnum -1))
-		  (loadw move-temp args-tn i)
-		  (store-stack-tn tn move-temp)))
-
-	      (emit-label defaulting-done)
-	      (move csp-tn args-tn)
-
-	      (unassemble
-	       (assemble-elsewhere node
-		 (dolist (def (defaults))
-		   (emit-label (car def))
-		   (store-stack-tn (cdr def) null-tn))
-		 (b defaulting-done)
-		 (nop))))))))
+  (if (<= nvals 1)
+      (progn
+	(move csp-tn old-fp-tn)
+	(inst nop)
+	(inst compute-code-from-lra code-tn code-tn lra-label))
+      (let ((regs-defaulted (gen-label))
+	    (defaulting-done (gen-label)))
+	;; Branch off to the MV case.
+	(inst b regs-defaulted)
+	(inst compute-code-from-lra code-tn code-tn lra-label)
+	
+	;; Do the single value calse.
+	(inst compute-code-from-lra code-tn code-tn lra-label)
+	(do ((i 1 (1+ i))
+	     (val (tn-ref-across values) (tn-ref-across val)))
+	    ((= i (min nvals register-arg-count)))
+	  (move (tn-ref-tn val) null-tn))
+	(when (> nvals register-arg-count)
+	  (inst li nargs-tn (fixnum 1))
+	  (move old-fp-tn csp-tn))
+	
+	(emit-label regs-defaulted)
+	
+	(when (> nvals register-arg-count)
+	  (inst addu temp nargs-tn (fixnum (- register-arg-count)))
+	  (collect ((defaults))
+		   (do ((i register-arg-count (1+ i))
+			(val (do ((i 0 (1+ i))
+				  (val values (tn-ref-across val)))
+				 ((= i register-arg-count) val))
+			     (tn-ref-across val)))
+		       ((null val))
+		     
+		     (let ((default-lab (gen-label))
+			   (tn (tn-ref-tn val)))
+		       (defaults (cons default-lab tn))
+		       
+		       (inst bltz temp default-lab)
+		       (inst addu temp temp (fixnum -1))
+		       (loadw move-temp args-tn i)
+		       (store-stack-tn tn move-temp)))
+		   
+		   (emit-label defaulting-done)
+		   (move csp-tn args-tn)
+		   
+		   (assemble (*elsewhere*)
+		     (dolist (def (defaults))
+		       (emit-label (car def))
+		       (store-stack-tn (cdr def) null-tn))
+		     (inst b defaulting-done)
+		     (inst nop))))))
   (undefined-value))
 
 
@@ -327,33 +324,31 @@ default-value-5
 ;;; explicitly allocate these TNs, since their lifetimes overlap with the
 ;;; results Start and Count (also, it's nice to be able to target them).
 ;;;
-(defun receive-unknown-values (node args nargs start count lra-label)
-  (declare (type node node) (type tn args nargs start count))
-  (assemble node
-    (let ((variable-values (gen-label))
-	  (done (gen-label)))
-      (b variable-values)
-      (inst compute-code-from-lra code-tn code-tn lra-label)
-
-      (inst compute-code-from-lra code-tn code-tn lra-label)
-      (inst addiu csp-tn csp-tn 4)
-      (storew (first register-arg-tns) csp-tn -1)
-      (inst addiu start csp-tn -4)
-      (loadi count (fixnum 1))
-
-      (emit-label done)
-
-      (unassemble
-	(assemble-elsewhere node
-	  (emit-label variable-values)
-	  (do ((arg register-arg-tns (rest arg))
-	       (i 0 (1+ i)))
-	      ((null arg))
-	    (storew (first arg) args i))
-	  (move start args)
-	  (move count nargs)
-	  (b done)
-	  (nop)))))
+(defun receive-unknown-values (args nargs start count lra-label)
+  (declare (type tn args nargs start count))
+  (let ((variable-values (gen-label))
+	(done (gen-label)))
+    (inst b variable-values)
+    (inst compute-code-from-lra code-tn code-tn lra-label)
+    
+    (inst compute-code-from-lra code-tn code-tn lra-label)
+    (inst addu csp-tn csp-tn 4)
+    (storew (first register-arg-tns) csp-tn -1)
+    (inst addu start csp-tn -4)
+    (inst li count (fixnum 1))
+    
+    (emit-label done)
+    
+    (assemble (*elsewhere*)
+      (emit-label variable-values)
+      (do ((arg register-arg-tns (rest arg))
+	   (i 0 (1+ i)))
+	  ((null arg))
+	(storew (first arg) args i))
+      (move start args)
+      (move count nargs)
+      (inst b done)
+      (inst nop)))
   (undefined-value))
 
 
@@ -364,7 +359,6 @@ default-value-5
   (:results
    (start :scs (descriptor-reg))
    (count :scs (descriptor-reg)))
-  (:node-var node)
   (:temporary (:sc descriptor-reg :offset args-offset
 		   :from :eval :to (:result 0))
 	      values-start)
@@ -399,7 +393,6 @@ default-value-5
   (:move-args :local-call)
   (:info arg-locs callee target nvals)
   (:ignore arg-locs args nfp)
-  (:node-var node)
   (:vop-var vop)
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:temporary (:scs (any-reg) :type fixnum) temp)
@@ -414,12 +407,11 @@ default-value-5
       (let ((callee-nfp (callee-nfp-tn callee)))
 	(when callee-nfp
 	  (move callee-nfp nfp)))
-      (b target)
-      (nop)
+      (inst b target)
+      (inst nop)
       (emit-return-pc label)
       (note-this-location vop :unknown-return)
-      (unassemble
-	(default-unknown-values node values nvals move-temp temp label))
+      (default-unknown-values values nvals move-temp temp label)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save)))))
 
@@ -448,13 +440,11 @@ default-value-5
       (let ((callee-nfp (callee-nfp-tn callee)))
 	(when callee-nfp
 	  (move callee-nfp nfp)))
-      (b target)
-      (nop)
+      (inst b target)
+      (inst nop)
       (emit-return-pc label)
       (note-this-location vop :unknown-return)
-      (unassemble
-	(receive-unknown-values node values-start nvals
-				start count label))
+      (receive-unknown-values values-start nvals start count label)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save)))))
 
@@ -485,8 +475,8 @@ default-value-5
       (let ((callee-nfp (callee-nfp-tn callee)))
 	(when callee-nfp
 	  (move callee-nfp nfp)))
-      (b target)
-      (nop)
+      (inst b target)
+      (inst nop)
       (note-this-location vop :known-return)
       (emit-return-pc label)
       (when cur-nfp
@@ -510,8 +500,9 @@ default-value-5
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(move nsp-tn cur-nfp)))
-    (move fp-tn old-fp)
-    (lisp-return return-pc lip)))
+    (inst addu lip return-pc (- vm:word-bytes vm:other-pointer-type))
+    (inst j lip)
+    (move fp-tn old-fp)))
 
 
 ;;;; Full call:
@@ -580,7 +571,6 @@ default-value-5
    
      ,@(unless (eq return :tail)
 	 `((:save-p t)
-	   (:node-var node)
 	   (:vop-var vop)
 	   ,@(unless variable
 	       '((:move-args :full-call)))))
@@ -655,7 +645,7 @@ default-value-5
 		   (mapcar #'(lambda (name)
 			       `(loadw ,name new-fp ,(incf index)))
 			   register-arg-names)))
-	     `((loadi nargs-pass (fixnum nargs))))
+	     `((inst li nargs-pass (fixnum nargs))))
        
        (let (,@(unless (eq return :tail)
 		 '((lra-label (gen-label))
@@ -665,14 +655,14 @@ default-value-5
 
 	 (loadw function lexenv vm:closure-function-slot
 		vm:function-pointer-type)
-	 (inst addiu lip function (- (ash vm:function-header-code-offset
+	 (inst addu lip function (- (ash vm:function-header-code-offset
 					 vm:word-shift)
 				    vm:function-pointer-type))
 
 	 ,@(if (eq return :tail)
 	       '((move old-fp-pass old-fp)
 		 (move return-pc-pass return-pc)
-		 (inst jr lip)
+		 (inst j lip)
 		 (move code-tn function))
 	       `((move old-fp-pass fp-tn)
 		 ,(if variable
@@ -682,23 +672,20 @@ default-value-5
 			   (move fp-tn csp-tn)))
 		 (when cur-nfp
 		   (store-stack-tn nfp-save cur-nfp))
-		 (inst jr lip)
+		 (inst j lip)
 		 (move code-tn function)
 		 (emit-return-pc lra-label)))
 
 	 ,@(ecase return
 	     (:fixed
 	      '((note-this-location vop :unknown-return)
-		(unassemble
-		 (default-unknown-values node values nvals
-					 move-temp temp lra-label))
+		(default-unknown-values values nvals move-temp temp lra-label)
 		(when cur-nfp
 		  (load-stack-tn cur-nfp nfp-save))))
 	     (:unknown
 	      '((note-this-location vop :unknown-return)
-		(unassemble
-		 (receive-unknown-values node values-start nvals
-					 start count lra-label))
+		(receive-unknown-values values-start nvals start count
+					lra-label)
 		(when cur-nfp
 		  (load-stack-tn cur-nfp nfp-save))))
 	     (:tail))))))
@@ -760,22 +747,22 @@ default-value-5
 		    register-arg-names))
 	
 	;; Calc SRC, DST, and COUNT
-	(inst addiu src args (* vm:word-bytes register-arg-count))
-	(inst addiu dst fp-tn (* vm:word-bytes register-arg-count))
-	(b test)
-	(inst addiu count nargs (fixnum (- register-arg-count)))
+	(inst addu src args (* vm:word-bytes register-arg-count))
+	(inst addu dst fp-tn (* vm:word-bytes register-arg-count))
+	(inst b test)
+	(inst addu count nargs (fixnum (- register-arg-count)))
 	
 	(emit-label loop)
 	;; Copy one arg.
 	(loadw temp src)
-	(inst addiu src src vm:word-bytes)
+	(inst addu src src vm:word-bytes)
 	(storew temp dst)
-	(inst addiu dst dst vm:word-bytes)
+	(inst addu dst dst vm:word-bytes)
 	
 	;; Are we done?
 	(emit-label test)
 	(inst bgtz count loop)
-	(inst addiu count count (fixnum -1))
+	(inst addu count count (fixnum -1))
 	
 	;; We are done.  Do the jump.
 	(loadw function lexenv vm:closure-function-slot
@@ -823,13 +810,13 @@ default-value-5
 	       (when cur-nfp
 		 (move nsp-tn cur-nfp)))
 	     (move fp-tn old-fp)
-	     (inst addiu lip return-pc (- (* 3 word-bytes) other-pointer-type))
-	     (inst jr lip)
+	     (inst addu lip return-pc (- (* 3 word-bytes) other-pointer-type))
+	     (inst j lip)
 	     (move code-tn return-pc))
 	    (t
-	     (loadi nargs (fixnum nvals))
+	     (inst li nargs (fixnum nvals))
 	     (move val-ptr fp-tn)
-	     (inst addiu csp-tn val-ptr (* nvals word-bytes))
+	     (inst addu csp-tn val-ptr (* nvals word-bytes))
 	     (move fp-tn old-fp)
 	     (let ((cur-nfp (current-nfp-tn vop)))
 	       (when cur-nfp
@@ -896,9 +883,9 @@ default-value-5
 	      (move nsp-tn cur-nfp)))
 
 	  ;; Single case?
-	  (loadi count (fixnum 1))
+	  (inst li count (fixnum 1))
 	  (inst bne count nvals not-single)
-	  (nop)
+	  (inst nop)
 	  
 	  ;; Return with one value.
 	  (loadw ,(first register-arg-names) start)
@@ -906,8 +893,8 @@ default-value-5
 	  (move fp-tn old-fp)
 	  ;; Note: we can't use the lisp-return macro, 'cause we want to
 	  ;; skip two instructions.
-	  (inst addiu lip return-pc (- (* 3 word-bytes) other-pointer-type))
-	  (inst jr lip)
+	  (inst addu lip return-pc (- (* 3 word-bytes) other-pointer-type))
+	  (inst j lip)
 	  (move code-tn return-pc)
 
 	  ;; Nope, not the single case.
@@ -920,23 +907,23 @@ default-value-5
 	  ,@(mapcar #'(lambda (name label)
 			`(progn
 			   (inst blez count ,label)
-			   (inst addiu count count (fixnum -1))
+			   (inst addu count count (fixnum -1))
 			   (loadw ,name src)
-			   (inst addiu src src vm:word-bytes)))
+			   (inst addu src src vm:word-bytes)))
 		    register-arg-names
 		    label-names)
 	  
 	  ;; Copy the remaining args to the top of the stack.
-	  (inst addiu dst fp-tn (* vm:word-bytes register-arg-count))
+	  (inst addu dst fp-tn (* vm:word-bytes register-arg-count))
 	  
 	  (emit-label loop)
 	  (inst blez count done)
-	  (inst addiu count count (fixnum -1))
+	  (inst addu count count (fixnum -1))
 	  (loadw temp src)
-	  (inst addiu src src vm:word-bytes)
+	  (inst addu src src vm:word-bytes)
 	  (storew temp dst)
-	  (b loop)
-	  (inst addiu dst dst vm:word-bytes)
+	  (inst b loop)
+	  (inst addu dst dst vm:word-bytes)
 	  
 	  ;; Default some number of registers.
 	  ,@(mapcar #'(lambda (name label)
@@ -963,11 +950,10 @@ default-value-5
 ;;; Fetch the constant pool from the function entry structure.
 ;;;
 (define-vop (setup-environment)
-  (:node-var node)
+  (:info label)
   (:generator 5
     ;; Fix CODE, cause the function object was passed in.
-    (inst compute-code-from-fn
-	  code-tn code-tn (block-label (node-block node)))))
+    (inst compute-code-from-fn code-tn code-tn label)))
 
 ;;; Return the current Env as our result, then indirect throught the closure
 ;;; and the closure-entry to find the constant pool
@@ -977,11 +963,10 @@ default-value-5
 	       :to (:result 0))
 	      lexenv)
   (:results (closure :scs (descriptor-reg)))
-  (:node-var node)
+  (:info label)
   (:generator 6
     ;; Fix CODE, cause the function object was passed in.
-    (inst compute-code-from-fn
-	  code-tn code-tn (block-label (node-block node)))
+    (inst compute-code-from-fn code-tn code-tn label)
     ;; Get result.
     (move closure lexenv)))
 
@@ -1007,12 +992,12 @@ default-value-5
       (cond ((zerop fixed)
 	     (inst addu csp-tn csp-tn nargs-tn))
 	    (t
-	     (inst addiu count nargs-tn (fixnum (- fixed)))
+	     (inst addu count nargs-tn (fixnum (- fixed)))
 	     (inst addu csp-tn csp-tn count)))
       (when (< fixed register-arg-count)
 	;; We must stop when we run out of stack args, not when we run out of
 	;; more args.
-	(inst addiu count nargs-tn (fixnum (- register-arg-count))))
+	(inst addu count nargs-tn (fixnum (- register-arg-count))))
       ;; Everything of interest in registers.
       (inst blez count do-regs)
       ;; Initialize dst to be end of stack.
@@ -1022,22 +1007,22 @@ default-value-5
 
       (emit-label loop)
       ;; *--dst = *--src, --count
-      (inst addiu src src (- vm:word-bytes))
-      (inst addiu count count (fixnum -1))
+      (inst addu src src (- vm:word-bytes))
+      (inst addu count count (fixnum -1))
       (loadw temp src)
-      (inst addiu dst dst (- vm:word-bytes))
+      (inst addu dst dst (- vm:word-bytes))
       (inst bgtz count loop)
       (storew temp dst)
 
       (emit-label do-regs)
       (when (< fixed register-arg-count)
 	;; Now we have to deposit any more args that showed up in registers.
-	(inst addiu count nargs-tn (fixnum (- fixed)))
+	(inst addu count nargs-tn (fixnum (- fixed)))
 	(do ((i fixed (1+ i)))
 	    ((>= i register-arg-count))
 	  ;; Don't deposit any more than there are.
 	  (inst beq count zero-tn done)
-	  (inst addiu count count (fixnum -1))
+	  (inst addu count count (fixnum -1))
 	  ;; Store it relative to the pointer saved at the start.
 	  (storew (nth i register-arg-tns) result (- i fixed))))
       (emit-label done))))
@@ -1076,10 +1061,10 @@ default-value-5
       ;; We need to do this atomically.
       (pseudo-atomic (ndescr)
 	;; Allocate a cons (2 words) for each item.
-	(inst addiu result alloc-tn vm:list-pointer-type)
+	(inst addu result alloc-tn vm:list-pointer-type)
 	(move dst result)
 	(inst addu alloc-tn alloc-tn count)
-	(b enter)
+	(inst b enter)
 	(inst addu alloc-tn alloc-tn count)
 
 	;; Store the current cons in the cdr of the previous cons.
@@ -1089,13 +1074,13 @@ default-value-5
 	;; Grab one value and stash it in the car of this cons.
 	(emit-label enter)
 	(loadw temp context)
-	(inst addiu context context vm:word-bytes)
+	(inst addu context context vm:word-bytes)
 	(storew temp dst 0 vm:list-pointer-type)
 
 	;; Dec count, and if != zero, go back for more.
-	(inst addiu count count (fixnum -1))
+	(inst addu count count (fixnum -1))
 	(inst bne count zero-tn loop)
-	(inst addiu dst dst (* 2 vm:word-bytes))
+	(inst addu dst dst (* 2 vm:word-bytes))
 
 	;; NIL out the last cons.
 	(storew null-tn dst -1 vm:list-pointer-type))
@@ -1121,7 +1106,7 @@ default-value-5
    (context :scs (descriptor-reg))
    (count :scs (any-reg descriptor-reg)))
   (:generator 5
-    (inst addiu count supplied (fixnum (- fixed)))
+    (inst addu count supplied (fixnum (- fixed)))
     (inst subu context csp-tn count)))
 
 
@@ -1132,18 +1117,16 @@ default-value-5
    (nargs :scs (any-reg descriptor-reg)))
   (:temporary (:scs (any-reg) :type fixnum) temp)
   (:info count)
-  (:node-var node)
   (:generator 3
-    (let ((err-lab (generate-error-code node
-					di:invalid-argument-count-error
+    (let ((err-lab (generate-error-code di:invalid-argument-count-error
 					nargs)))
       (cond ((zerop count)
 	     (inst bne nargs zero-tn err-lab)
-	     (nop))
+	     (inst nop))
 	    (t
-	     (loadi temp (fixnum count))
+	     (inst li temp (fixnum count))
 	     (inst bne nargs temp err-lab)
-	     (nop))))))
+	     (inst nop))))))
 
 ;;; Signal an argument count error.
 ;;;
diff --git a/compiler/mips/cell.lisp b/compiler/mips/cell.lisp
index f53359b83..3933c9755 100644
--- a/compiler/mips/cell.lisp
+++ b/compiler/mips/cell.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.30 1990/04/23 16:39:47 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/cell.lisp,v 1.31 1990/04/24 02:55:58 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of various primitive memory access
 ;;; VOPs for the MIPS.
@@ -120,36 +120,36 @@
 		  `((:translate ,alloc-trans)))
 	      (:generator 37
 		(pseudo-atomic (ndescr)
-		  (inst addiu result alloc-tn ,lowtag)
+		  (inst addu result alloc-tn ,lowtag)
 		  ,@(cond ((and header variable-length)
-			   `((inst addiu temp extra-words
+			   `((inst addu temp extra-words
 				   (fixnum (1- ,size)))
 			     (inst addu alloc-tn alloc-tn temp)
 			     (inst sll temp temp
 				   (- vm:type-bits vm:word-bits))
-			     (inst ori temp temp ,header)
+			     (inst or temp temp ,header)
 			     (storew temp result 0 ,lowtag)
-			     (inst addiu alloc-tn alloc-tn
+			     (inst addu alloc-tn alloc-tn
 				   (+ (fixnum 1) vm:lowtag-mask))
-			     (loadi temp (lognot vm:lowtag-mask))
+			     (inst li temp (lognot vm:lowtag-mask))
 			     (inst and alloc-tn alloc-tn temp)))
 			  (variable-length
 			   (error ":REST-P T with no header in ~S?"
 				  (vm:primitive-object-name obj)))
 			  (header
-			   `((inst addiu alloc-tn alloc-tn
+			   `((inst addu alloc-tn alloc-tn
 				   (vm:pad-data-block ,size))
-			     (loadi temp
-				    ,(logior (ash (1- size) vm:type-bits)
-					     (if (integerp header)
-						 header
-						 0)))
+			     (inst li temp
+				   ,(logior (ash (1- size) vm:type-bits)
+					    (if (integerp header)
+						header
+						0)))
 			     (storew temp result 0 ,lowtag)))
 			  (t
-			   `((inst addiu alloc-tn alloc-tn
+			   `((inst addu alloc-tn alloc-tn
 				   (vm:pad-data-block ,size)))))
 		  ,@(when need-unbound-marker
-		      `((loadi temp vm:unbound-marker-type)))
+		      `((inst li temp vm:unbound-marker-type)))
 		  ,@(init-forms)
 		  (move real-result result))))))))
     (when (forms)
@@ -180,9 +180,9 @@
     (move obj-temp object)
     (loadw value obj-temp vm:symbol-value-slot vm:other-pointer-type)
     (let ((err-lab (generate-error-code node di:unbound-symbol-error obj-temp)))
-      (inst xori temp value vm:unbound-marker-type)
+      (inst xor temp value vm:unbound-marker-type)
       (inst beq temp zero-tn err-lab)
-      (nop))))
+      (inst nop))))
 
 ;;; With Symbol-Function, we check that the result is a function, so NIL is
 ;;; always un-fbound.
@@ -210,11 +210,11 @@
   (:translate boundp)
   (:generator 9
     (loadw value object vm:symbol-value-slot vm:other-pointer-type)
-    (inst xori temp value vm:unbound-marker-type)
+    (inst xor temp value vm:unbound-marker-type)
     (if not-p
 	(inst beq temp zero-tn target)
 	(inst bne temp zero-tn target))
-    (nop)))
+    (inst nop)))
 
 
 ;;; SYMBOL isn't a primitive type, so we can't use it for the arg restriction
@@ -259,7 +259,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:generator 5
     (loadw temp symbol vm:symbol-value-slot vm:other-pointer-type)
-    (inst addiu bsp-tn bsp-tn (* 2 vm:word-bytes))
+    (inst addu bsp-tn bsp-tn (* 2 vm:word-bytes))
     (storew temp bsp-tn (- vm:binding-value-slot vm:binding-size))
     (storew symbol bsp-tn (- vm:binding-symbol-slot vm:binding-size))
     (storew val symbol vm:symbol-value-slot vm:other-pointer-type)))
@@ -272,7 +272,7 @@
     (loadw value bsp-tn (- vm:binding-value-slot vm:binding-size))
     (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
     (storew zero-tn bsp-tn (- vm:binding-symbol-slot vm:binding-size))
-    (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes))))
+    (inst addu bsp-tn bsp-tn (* -2 vm:word-bytes))))
 
 
 (define-vop (unbind-to-here)
@@ -294,7 +294,7 @@
       (storew zero-tn bsp-tn (- vm:binding-symbol-slot vm:binding-size))
 
       (emit-label skip)
-      (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes))
+      (inst addu bsp-tn bsp-tn (* -2 vm:word-bytes))
       (inst bne where bsp-tn loop)
       (loadw symbol bsp-tn (- vm:binding-symbol-slot vm:binding-size))
 
diff --git a/compiler/mips/char.lisp b/compiler/mips/char.lisp
index a48ebedbb..bbae99358 100644
--- a/compiler/mips/char.lisp
+++ b/compiler/mips/char.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/char.lisp,v 1.5 1990/04/23 16:44:49 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/char.lisp,v 1.6 1990/04/24 02:56:01 wlott Exp $
 ;;; 
 ;;; This file contains the RT VM definition of character operations.
 ;;;
@@ -39,7 +39,7 @@
   (:results (y :scs (any-reg descriptor-reg)))
   (:generator 1
     (inst sll y x vm:type-bits)
-    (inst ori y y vm:base-character-type)))
+    (inst or y y vm:base-character-type)))
 ;;;
 (define-move-vop move-from-base-character :move
   (base-character-reg) (any-reg descriptor-reg))
diff --git a/compiler/mips/insts.lisp b/compiler/mips/insts.lisp
index 4233114e8..81787090d 100644
--- a/compiler/mips/insts.lisp
+++ b/compiler/mips/insts.lisp
@@ -1,30 +1,35 @@
-;;; -*- Package: C; Log: C.Log -*-
+;;; -*- Package: MIPS -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
+;;; This code was written as part of the Spice Lisp project at
 ;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; If you want to use this code or any part of CMU Common Lisp, please
-;;; contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU).
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.11 1990/03/05 21:06:44 wlott Exp $
-;;; 
-;;; Assembler instruction definitions for the MIPS R2000.
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.12 1990/04/24 02:56:14 wlott Exp $
 ;;;
-;;; Written by Christopher Hoover
+;;; Description of the MIPS architecture.
+;;;
+;;; Written by William Lott
 ;;;
 
-(in-package "C")
+(in-package "MIPS")
+(use-package "ASSEM")
 
-;;; Clear out any old definitions.
-;;; 
-(clrhash *instructions*)
-(clrhash *instruction-formats*)
+(import '(c::tn-p c::tn-sc c::tn-offset c::sc-sb c::sb-name c::zero-tn
+		  c::registers c::float-registers
+		  c::component-header-length))
 
 
-;;;; Formats
+;;;; Resources.
+
+(define-random-resources high low)
+(define-register-file ireg 32)
+(define-register-file fpreg 32)
 
-(eval-when (compile load eval)
+
+;;;; Formats.
 
 (defconstant special-op #b000000)
 (defconstant bcond-op #b0000001)
@@ -33,460 +38,467 @@
 (defconstant cop2-op #b010010)
 (defconstant cop3-op #b010011)
 
-) ; eval-when
-
-;;;
-;;; Load Store Format
-;;; 
-(def-instruction-format (load-store 4) (rt base &optional (offset 0))
-  (op :unsigned 6 :instruction-constant)
-  (base :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (offset :signed 16 :immediate))
-
-;;;
-;;; Signed Immediate Format
-;;; 
-(def-instruction-format (signed-immed 4) (rt rs immed)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (immed :signed 16 :immediate))
-
-;;;
-;;; Unsigned Immediate Format
-;;; 
-(def-instruction-format (unsigned-immed 4) (rt rs immed)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (immed :unsigned 16 :immediate))
-
-;;;
-;;; LUI Special Format
-;;;
-(def-instruction-format (lui-special 4) (rt immed)
-  (op :unsigned 6 :instruction-constant)
-  (rt :unsigned 5 :constant 0)
-  (rt :unsigned 5 :register)
-  (immed :unsigned 16 :immediate))
-
-;;;
-;;; Jump (J) Format
-;;;
-(def-instruction-format (jump 4) (target)
-  (op :unsigned 6 :instruction-constant)
-  (target :unsigned 26 :branch #'(lambda (x) (ash x -2)))) ; This isn't right
-
-;;;
-;;; JR Special Format
-;;; 
-(def-instruction-format (jr-special 4) (rs)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (zero :unsigned 15 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; JALR Special Format
-;;;
-(def-instruction-format (jalr-special 4) (rd rs)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (zero-1 :unsigned 5 :constant 0)
-  (rd :unsigned 5 :register)
-  (zero-2 :unsigned 5 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;; 
-;;; Branch Format
-;;;
-(def-instruction-format (branch 4) (rs offset)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (zero :unsigned 5 :constant 0)
-  (offset :signed 16 :branch #'(lambda (x) (ash (- x 4) -2))))
-
-;;;
-;;; Branch-2 Format
-;;;
-(def-instruction-format (branch-2 4) (rs rt offset)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (offset :signed 16 :branch #'(lambda (x) (ash (- x 4) -2))))
-
-;;;
-;;; Branch-Z Format
-;;;
-(def-instruction-format (branch-z 4) (rs offset)
-  (bcond :unsigned 6 :constant bcond-op)
-  (rs :unsigned 5 :register)
-  (op :unsigned 5 :instruction-constant)
-  (offset :signed 16 :branch #'(lambda (x) (ash (- x 4) -2))))
-
-;;;
-;;; R3 Format
-;;; 
-(def-instruction-format (r3 4) (rd rs rt)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (rd :unsigned 5 :register)
-  (zero :unsgined 5 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; MF Format
-;;;
-(def-instruction-format (mf 4) (rd)
-  (special :unsigned 6 :constant special-op)
-  (zero-1 :unsigned 10 :constant 0)
-  (rd :unsigned 5 :register)
-  (zero-2 :unsigned 5 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;; 
-;;; MT Format
-;;;
-(def-instruction-format (mt 4) (rs)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (zero :unsigned 15 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; Mult Format
-;;;
-(def-instruction-format (mult 4) (rs rt)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (zero :unsigned 10 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; Shift Format
-;;;
-(def-instruction-format (shift 4) (rd rt shamt)
-  (special :unsigned 6 :constant special-op)
-  (zero :unsgined 5 :constant 0)
-  (rt :unsigned 5 :register)
-  (rd :unsigned 5 :register)
-  (shamt :unsigned 5 :immediate)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; Shift-Var Format
-;;;
-(def-instruction-format (shift-var 4) (rd rt rs)
-  (special :unsigned 6 :constant special-op)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (rd :unsigned 5 :register)
-  (zero :unsigned 5 :constant 0)
-  (op :unsigned 6 :instruction-constant))
-
-;;;
-;;; BREAK-Special Format
-;;;
-(def-instruction-format (break-special 4) (code)
-  (special :unsigned 6 :constant special-op)
-  (code :unsigned 10 :immediate) ; The MIPS assembler only uses half the bits.
-  (unused :unsigned 10 :constant 0)
-  (op :unsigned 6 :instruction-constant))
 
-;;;
-;;; SYSCALL-Special Format
-;;;
-(def-instruction-format (syscall-special 4) ()
-  (special :unsigned 6 :constant special-op)
-  (zero :unsigned 20 :constant 0)
-  (op :unsigned 6 :instruction-constant))
+(define-format (immediate 32)
+  (op (byte 6 26))
+  (rs (byte 5 21) :use ireg)
+  (rt (byte 5 16) :clobber ireg)
+  (immediate (byte 16 0)))
 
-
-;;;; Instructions
-
-(def-instruction j-inst jump :op #b00010)
-(def-instruction jal-inst jump :op #b00011)
-(def-instruction jr jr-special :op #b001000)
-(def-instruction jalr jalr-special :op #b001001)
-(def-instruction beq-inst branch-2 :op #b000100)
-(def-instruction bne-inst branch-2 :op #b000101)
-(def-instruction blez-inst branch :op #b000110)
-(def-instruction bgtz-inst branch :op #b000111)
-
-(def-instruction addi signed-immed :op #b001000)
-(def-instruction addiu signed-immed :op #b001001)
-(def-instruction slti signed-immed :op #b001010)
-(def-instruction sltiu signed-immed :op #b001011)
-(def-instruction andi unsigned-immed :op #b001100)
-(def-instruction ori unsigned-immed :op #b001101)
-(def-instruction xori unsigned-immed :op #b001110)
-(def-instruction lui lui-special :op #b001111)
-
-(def-instruction lb load-store :op #b100000)
-(def-instruction lh load-store :op #b100001)
-(def-instruction lwl load-store :op #b100010)
-(def-instruction lw load-store :op #b100011)
-(def-instruction lbu load-store :op #b100100)
-(def-instruction lhu load-store :op #b100101)
-(def-instruction lwr load-store :op #b100110)
-
-(def-instruction sb load-store :op #b101000)
-(def-instruction sh load-store :op #b101001)
-(def-instruction swl load-store :op #b101010)
-(def-instruction sw load-store :op #b101011)
-(def-instruction swr load-store :op #b101110)
-
-(def-instruction sll shift :op #b000000)
-(def-instruction srl shift :op #b000010)
-(def-instruction sra shift :op #b000011)
-(def-instruction sllv shift-var :op #b000100)
-(def-instruction srlv shift-var :op #b000110)
-(def-instruction srav shift-var :op #b000111)
-
-(def-instruction syscall syscall-special :op #b001100)
-(def-instruction break break-special :op #b001101)
-
-(def-instruction mfhi mf :op #b010000)
-(def-instruction mthi mt :op #b010001)
-(def-instruction mflo mf :op #b010010)
-(def-instruction mtlo mt :op #b010011)
-
-(def-instruction mult mult :op #b011000)
-(def-instruction multu mult :op #b011001)
-(def-instruction div mult :op #b011010)
-(def-instruction divu mult :op #b011011)
-
-(def-instruction add r3 :op #b100000)
-(def-instruction addu r3 :op #b100001)
-(def-instruction sub r3 :op #b100010)
-(def-instruction subu r3 :op #b100011)
-(def-instruction and r3 :op #b100100)
-(def-instruction or r3 :op #b100101)
-(def-instruction xor r3 :op #b100110)
-(def-instruction nor r3 :op #b100111)
-
-(def-instruction slt r3 :op #b101010)
-(def-instruction sltu r3 :op #b101011)
-
-(def-instruction bltz-inst branch-z :op #b00000)
-(def-instruction bltzal-inst branch-z :op #b10000)
-
-(def-instruction bgez-inst branch-z :op #b00001)
-(def-instruction bgezal-inst branch-z :op #b10001)
+(define-format (jump 32)
+  (op (byte 6 26))
+  (target (byte 26 0)))
 
-
-;;;; Branches
+(define-format (register 32)
+  (op (byte 6 26))
+  (rs (byte 5 21) :use ireg)
+  (rt (byte 5 16) :use ireg)
+  (rd (byte 5 11) :clobber ireg)
+  (shamt (byte 5 6) :default 0)
+  (funct (byte 6 0)))
 
-(defmacro most-positive-twos-complement-number (n-bits)
-  `(1- (ash 1 (1- ,n-bits))))
 
-(defmacro most-negative-twos-complement-number (n-bits)
-  `(- (ash 1 (1- ,n-bits))))
 
+(define-format (break 32)
+  (op (byte 6 26) :default special-op)
+  (code (byte 10 16))
+  (subcode (byte 10 6) :default 0)
+  (funct (byte 6 0) :default #b001101))
 
-;;;
-;;; ### These two aren't right
-;;; 
-(def-branch j (label) label
-  (0 (ash 1 28) (j-inst label)))
-;;; 
-(def-branch jal (label) label
-  (0 (ash 1 28) (jal-inst label)))
-
-
-(def-branch beq (rs rt label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (beq-inst rs rt label)))
-
-(def-branch bne (rs rt label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bne-inst rs rt label)))
-
-(def-branch blez (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (blez-inst rs label)))
-
-(def-branch bgtz (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bgtz-inst rs label)))
-
-(def-branch bltz (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bltz-inst rs label)))
-
-(def-branch bltzal (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bltzal-inst rs label)))
-
-(def-branch bgez (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bgez-inst rs label)))
-
-(def-branch bgezal (rs label) label
-  ((most-negative-twos-complement-number 18)
-   (most-positive-twos-complement-number 18)
-   (bgezal-inst rs label)))
 
 
-;;;; Pseduo Instructions to Support Component Dumping
-
-(defun component-header-length (&optional (component *compile-component*))
-  (let* ((2comp (component-info component))
-	 (constants (ir2-component-constants 2comp))
-	 (num-consts (length constants)))
-    (ash (logandc2 (1+ num-consts) 1) word-shift)))
-
-
-;;; COMPUTE-CODE-FROM-FN
-;;;
-;;; code = fn - fn-tag - header - label-offset + other-pointer-tag
-;;; 
-(def-instruction-format (compute-code-from-fn-format 4) (rt rs label)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (label :signed 16
-	 :label #'(lambda (label-offset instr-offset)
-		    (declare (ignore instr-offset))
-		    (- other-pointer-type function-pointer-type label-offset
-		       (component-header-length)))))
-
-(def-instruction compute-code-from-fn compute-code-from-fn-format
-  :op #b001001)
-
-
-;;; COMPUTE-CODE-FROM-LRA
-;;;
-;;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
-;;; 
-(def-instruction-format (compute-code-from-lra-format 4) (rt rs label)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (label :signed 16
-	 :label #'(lambda (label-offset instr-offset)
-		    (declare (ignore instr-offset))
-		    (- (+ label-offset (component-header-length))))))
-
-(def-instruction compute-code-from-lra compute-code-from-lra-format
-  :op #b001001)
-
-
-;;; COMPUTE-LRA-FROM-CODE
-;;;
-;;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
-;;; 
-(def-instruction-format (compute-lra-from-code-format 4) (rt rs label)
-  (op :unsigned 6 :instruction-constant)
-  (rs :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (label :signed 16
-	 :label #'(lambda (label-offset instr-offset)
-		    (declare (ignore instr-offset))
-		    (+ label-offset (component-header-length)))))
+;;;; Special argument types and fixups.
 
-(def-instruction compute-lra-from-code compute-lra-from-code-format
-  :op #b001001)
+(defun register-p (object)
+  (and (tn-p object)
+       (eq (sb-name (sc-sb (tn-sc object))) 'registers)))
 
+(define-argument-type register
+  :type (satisfies register-p)
+  :function tn-offset)
 
-;;;
-;;; LRA-HEADER-WORD, FUNCTION-HEADER-WORD
-;;; 
-
-(def-instruction-format (header-word-format 4) ()
-  (data :unsigned 24 :calculation #'(lambda (posn)
-				      (ash (+ posn (component-header-length))
-					   (- vm:word-shift))))
-  (type :unsigned 8 :instruction-constant))
+(defun fp-reg-p (object)
+  (and (tn-p object)
+       (eq (sb-name (sc-sb (tn-sc object)))
+	   'float-registers)))
 
-(def-instruction lra-header-word header-word-format
-  :type vm:return-pc-header-type)
+(define-argument-type fp-reg
+  :type (satisfies fp-reg-p)
+  :function tn-offset)
 
-(def-instruction function-header-word header-word-format
-  :type vm:function-header-type)
 
 
+(defun label-offset (label)
+  (1- (ash (- (label-position label) *current-position*) -2)))
 
-;;; LOAD-FOREIGN-ADDRESS and LOAD-FOREIGN-VALUE
-;;; 
-;;; This ``instruction'' emits a LUI followed by either an ADDIU, LW, or SW
-;;;
-(def-instruction-format (load-foreign-format 8) (rt symbol)
-  ;; We need to switch the order of the two instructions because the MIPS
-  ;; is little-endian.
-  (op2 :unsigned 6 :instruction-constant)
-  (rt :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (filler :unsigned 16 :constant 0)
-  (op1 :unsigned 6 :constant #b001111)
-  (rt :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (symbol :unsigned 16 :fixup :foreign))
+(define-argument-type relative-label
+  :type label
+  :function label-offset)
 
-(def-instruction load-foreign-address load-foreign-format
-  :op2 #b001001)
 
-(def-instruction load-foreign-value load-foreign-format
-  :op2 #b100011)
+(define-fixup-type :jump)
+(define-fixup-type :lui)
+(define-fixup-type :addi)
 
-(def-instruction store-foreign-value load-foreign-format
-  :op2 #b101011)
 
+
+;;;; Instructions.
+
+
+(defmacro define-math-inst (name r3 imm &optional imm-type function fixup)
+  `(define-instruction (,name)
+     ,@(when imm
+	 `((immediate (op :constant ,imm)
+		      (rt :argument register)
+		      (rs :same-as rt)
+		      (immediate :argument (,(case imm-type
+					       (:signed 'signed-byte)
+					       (:unsigned 'unsigned-byte))
+					    16)
+				 ,@(when function
+				     `(:function ,function))))
+	   (immediate (op :constant ,imm)
+		      (rt :argument register)
+		      (rs :argument register)
+		      (immediate :argument (,(case imm-type
+					       (:signed 'signed-byte)
+					       (:unsigned 'unsigned-byte))
+					    16)
+				 ,@(when function
+				     `(:function ,function))))))
+     ,@(when (and imm fixup)
+	 `((immediate (op :constant ,imm)
+		      (rt :argument register)
+		      (rs :same-as rt)
+		      (immediate :argument addi-fixup))
+	   (immediate (op :constant ,imm)
+		      (rt :argument register)
+		      (rs :argument register)
+		      (immediate :argument addi-fixup))))
+     ,@(when r3
+	 `((register (op :constant special-op)
+		     (rd :argument register)
+		     (rs :argument register)
+		     (rt :argument register)
+		     (funct :constant ,r3))
+	   (register (op :constant special-op)
+		     (rd :argument register)
+		     (rs :same-as rd)
+		     (rt :argument register)
+		     (funct :constant ,r3))))))
+
+(define-math-inst add #b100000 #b001000 :signed)
+(define-math-inst addu #b100001 #b001001 :signed nil t)
+(define-math-inst sub #b100010 #b001000 :signed -)
+(define-math-inst subu #b100011 #b001001 :signed -)
+(define-math-inst and #b100100 #b001100 :unsigned)
+(define-math-inst or #b100101 #b001101 :unsigned)
+(define-math-inst xor #b100110 #b001110 :unsigned)
+(define-math-inst nor #b100111 #b001111 :unsigned)
+
+(define-math-inst slt #b101010 #b001010 :signed)
+(define-math-inst sltu #b101011 #b001011 :signed)
+
+(define-instruction (beq)
+  (immediate (op :constant #b000100)
+	     (rs :argument register)
+	     (rt :constant 0)
+	     (immediate :argument relative-label))
+  (immediate (op :constant #b000100)
+	     (rs :argument register)
+	     (rt :argument register)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bne)
+  (immediate (op :constant #b000101)
+	     (rs :argument register)
+	     (rt :constant 0)
+	     (immediate :argument relative-label))
+  (immediate (op :constant #b000101)
+	     (rs :argument register)
+	     (rt :argument register)
+	     (immediate :argument relative-label)))
+
+(define-instruction (blez)
+  (immediate (op :constant #b000110)
+	     (rs :argument register)
+	     (rt :constant 0)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bgtz)
+  (immediate (op :constant #b000111)
+	     (rs :argument register)
+	     (rt :constant 0)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bltz)
+  (immediate (op :constant bcond-op)
+	     (rs :argument register)
+	     (rt :constant #b00000)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bgez)
+  (immediate (op :constant bcond-op)
+	     (rs :argument register)
+	     (rt :constant #b00001)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bltzal)
+  (immediate (op :constant bcond-op)
+	     (rs :argument register)
+	     (rt :constant #b01000)
+	     (immediate :argument relative-label)))
+
+(define-instruction (bgezal)
+  (immediate (op :constant bcond-op)
+	     (rs :argument register)
+	     (rt :constant #b01001)
+	     (immediate :argument relative-label)))
+
+(define-instruction (break)
+  (break (code :argument (unsigned-byte 10)))
+  (break (code :argument (unsigned-byte 10))
+	 (subcode :argument (unsigned-byte 10))))
+
+(define-instruction (div :clobber (low high))
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :argument register)
+	    (rd :constant 0)
+	    (funct :constant #b011010)))
+
+(define-instruction (divu :clobber (low high))
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :argument register)
+	    (rd :constant 0)
+	    (funct :constant #b011011)))
+
+(define-instruction (j)
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :constant 0)
+	    (rd :constant 0)
+	    (funct :constant #b001000))
+  (jump (op :constant #b000010)
+	(target :argument jump-fixup)))
+
+(define-instruction (jal)
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :constant 0)
+	    (rd :constant 31)
+	    (funct :constant #b001001))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rs :argument register)
+	    (rt :constant 0)
+	    (funct :constant #b001001))
+  (jump (op :constant #b000011)
+	(target :argument jump-fixup)))
+
+
+(defmacro define-load/store-instruction (name op)
+  `(define-instruction (,name)
+     (immediate (op :constant ,op)
+		(rs :argument register)
+		(rt :argument register)
+		(immediate :argument (signed-byte 16)))
+     (immediate (op :constant ,op)
+		(rs :argument register)
+		(rt :argument register)
+		(immediate :argument addi-fixup))
+     (immediate (op :constant ,op)
+		(rs :argument register)
+		(rt :argument register)
+		(immediate :constant 0))))
+
+(define-load/store-instruction lb #b100000)
+(define-load/store-instruction lh #b100001)
+(define-load/store-instruction lwl #b100010)
+(define-load/store-instruction lw #b100011)
+(define-load/store-instruction lbu #b100100)
+(define-load/store-instruction lhu #b100101)
+(define-load/store-instruction lwr #b100110)
+(define-load/store-instruction sb #b101000)
+(define-load/store-instruction sh #b101001)
+(define-load/store-instruction swl #b101010)
+(define-load/store-instruction sw #b101011)
+(define-load/store-instruction swr #b101110)
+
+(define-instruction (lui)
+  (immediate (op :constant #b001111)
+	     (rs :constant 0)
+	     (rt :argument register)
+	     (immediate :argument (or (unsigned-byte 16) (signed-byte 16))))
+  (immediate (op :constant #b001111)
+	     (rs :constant 0)
+	     (rt :argument register)
+	     (immediate :argument lui-fixup)))
+
+
+(define-instruction (mfhi :use high)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rs :constant 0)
+	    (rt :constant 0)
+	    (funct :constant #b010000)))
+
+(define-instruction (mthi :clobber high)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rs :constant 0)
+	    (rt :constant 0)
+	    (funct :constant #b010001)))
+
+(define-instruction (mflo :use low)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rs :constant 0)
+	    (rt :constant 0)
+	    (funct :constant #b010010)))
+
+(define-instruction (mtlo :clobber low)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rs :constant 0)
+	    (rt :constant 0)
+	    (funct :constant #b010011)))
+
+
+(define-instruction (mult :clobber (low high))
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :argument register)
+	    (rd :constant 0)
+	    (funct :constant #b011000)))
+
+(define-instruction (multu :clobber (low high))
+  (register (op :constant special-op)
+	    (rs :argument register)
+	    (rt :argument register)
+	    (rd :constant 0)
+	    (funct :constant #b011001)))
+
+(define-instruction (sll)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000000))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000000))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :argument register)
+	    (funct :constant #b000100))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :argument register)
+	    (funct :constant #b000100)))
+
+(define-instruction (sra)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000011))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000011))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :argument register)
+	    (funct :constant #b000111))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :argument register)
+	    (funct :constant #b000111)))
+
+(define-instruction (srl)
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000010))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :constant 0)
+	    (shamt :argument (unsigned-byte 5))
+	    (funct :constant #b000010))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :argument register)
+	    (rs :argument register)
+	    (funct :constant #b000110))
+  (register (op :constant special-op)
+	    (rd :argument register)
+	    (rt :same-as rd)
+	    (rs :argument register)
+	    (funct :constant #b000110)))
+
+(define-instruction (syscall)
+  (register (op :constant special-op)
+	    (rd :constant 0)
+	    (rt :constant 0)
+	    (rs :constant 0)
+	    (funct :constant #b001100)))
 
 
-;;; LOAD-ASSEMBLY-ADDRESS and LOAD-ASSEMBLY-VALUE
-;;; 
-;;; This ``instruction'' emits a LUI followed by either an ADDIU, LW, or SW.
-;;; The difference is that we use :assembly fixups.
-;;;
-(def-instruction-format (load-assembly-format 8) (rt symbol)
-  ;; We need to switch the order of the two instructions because the MIPS
-  ;; is little-endian.
-  (op2 :unsigned 6 :instruction-constant)
-  (rt :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (filler :unsigned 16 :constant 0)
-  (op1 :unsigned 6 :constant #b001111)
-  (rt :unsigned 5 :register)
-  (rt :unsigned 5 :register)
-  (symbol :unsigned 16 :fixup :assembly))
+
+;;;; Pseudo-instructions
+
+(define-pseudo-instruction li 64 (reg value)
+  (etypecase value
+    ((unsigned-byte 16)
+     (inst or reg zero-tn value))
+    ((signed-byte 16)
+     (inst addu reg zero-tn value))
+    ((or (signed-byte 32) (unsigned-byte 32))
+     (inst lui reg (ldb (byte 16 16) value))
+     (let ((low (ldb (byte 16 0) value)))
+       (unless (zerop low)
+	 (inst or reg low))))
+    (fixup
+     (inst lui reg value)
+     (inst addu reg value))))
+
+(define-instruction (b)
+  (immediate (op :constant #b000100)
+	     (rs :constant 0)
+	     (rt :constant 0)
+	     (immediate :argument relative-label)))
+
+(define-instruction (nop)
+  (register (op :constant 0)
+	    (rd :constant 0)
+	    (rt :constant 0)
+	    (rs :constant 0)
+	    (funct :constant 0)))
+
+(define-format (word-format 32)
+  (data (byte 32 0)))
+(define-instruction (word)
+  (word-format (data :argument (or (unsigned-byte 32) (signed-byte 32)))))
+
+(define-format (short-format 16)
+  (data (byte 16 0)))
+(define-instruction (short)
+  (word-format (data :argument (or (unsigned-byte 16) (signed-byte 16)))))
+
+(define-format (byte-format 8)
+  (data (byte 8 0)))
+(define-instruction (byte)
+  (word-format (data :argument (or (unsigned-byte 8) (signed-byte 8)))))
 
-(def-instruction load-assembly-address load-assembly-format
-  :op2 #b001001)
 
-(def-instruction load-assembly-value load-assembly-format
-  :op2 #b100011)
+
+;;;; Function and LRA Headers emitters and calculation stuff.
 
-(def-instruction store-assembly-value load-assembly-format
-  :op2 #b101011)
+(defun header-data (ignore)
+  (declare (ignore ignore))
+  (ash (+ *current-position* (component-header-length)) (- vm:word-shift)))
 
+(define-format (header-object 32)
+  (type (byte 8 0))
+  (data (byte 24 8) :default 0 :function header-data))
 
+(define-instruction (function-header-word)
+  (header-object (type :constant #x5e)))
 
-;;; BYTE, SHORT, and WORD instructions.
-;;;
-;;; These instructions emit a byte, short, or word in the instruction
-;;; stream.  If you use them, be sure to use (align 2) afterwords to
-;;; assure that additional code gets properly aligned.
+(define-instruction (lra-header-word)
+  (header-object (type :constant #x66)))
 
-(def-instruction-format (byte-format 1) (value)
-  (value :unsigned 8 :immediate))
-(def-instruction byte byte-format)
 
-(def-instruction-format (short-format 2) (value)
-  (value :unsigned 16 :immediate))
-(def-instruction short short-format)
+(define-pseudo-instruction compute-code-from-fn 64 (code fn label)
+  ;; code = fn - fn-tag - header - label-offset + other-pointer-tag
+  (let ((offset (- vm:other-pointer-type
+		   vm:function-pointer-type
+		   (label-position label)
+		   (component-header-length))))
+    (inst addu code fn offset)))
 
-(def-instruction-format (word-format 4) (value)
-  (value :unsigned 32 :immediate))
-(def-instruction word word-format)
+(define-pseudo-instruction compute-code-from-lra 64 (code lra label)
+  ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
+  (let ((offset (- (+ (label-position label) (component-header-length)))))
+    (inst addu code lra offset)))
 
+(define-pseudo-instruction compute-lra-from-code 64 (lra code label)
+  ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
+  (let ((offset (+ (label-position label) (component-header-length))))
+    inst addu lra code offset))
diff --git a/compiler/mips/macros.lisp b/compiler/mips/macros.lisp
index fd0c14940..a67296948 100644
--- a/compiler/mips/macros.lisp
+++ b/compiler/mips/macros.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/macros.lisp,v 1.29 1990/04/23 16:45:03 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/macros.lisp,v 1.30 1990/04/24 02:56:19 wlott Exp $
 ;;;
 ;;;    This file contains various useful macros for generating MIPS code.
 ;;;
@@ -29,11 +29,6 @@
 
 ;;; Instruction-like macros.
 
-
-(defmacro nop ()
-  "Emit a nop."
-  '(inst sll zero-tn zero-tn 0))
-
 (defmacro move (dst src &optional (always-emit-code-p nil))
   "Move SRC into DST (unless they are location= and ALWAYS-EMIT-CODE-P
   is nil)."
@@ -44,38 +39,18 @@
 	`(unless (location= ,n-dst ,n-src)
 	   (inst addu ,n-dst ,n-src zero-tn)))))
 
-(defmacro b (label)
-  "Unconditional branch"
-  `(inst beq zero-tn zero-tn ,label))
-
-
 (defmacro def-mem-op (op inst shift load)
   `(defmacro ,op (object base &optional (offset 0) (lowtag 0))
      `(progn
 	(inst ,',inst ,object ,base (- (ash ,offset ,,shift) ,lowtag))
-	,,@(when load '('(nop))))))
+	,,@(when load '('(inst nop))))))
 ;;; 
 (def-mem-op loadw lw word-shift t)
 (def-mem-op storew sw word-shift nil)
 
 
-(defmacro loadi (reg const)
-  (once-only ((n-reg reg)
-	      (n-const const))
-    `(cond ((<= #x-8000 ,n-const #x7fff)
-	    (inst addi ,n-reg zero-tn ,n-const))
-	   ((<= #x8000 ,n-const #xffff)
-	    (inst ori ,n-reg zero-tn ,n-const))
-	   ((<= #x-80000000 ,n-const #xffffffff)
-	    (inst lui ,n-reg (ldb (byte 16 16) ,n-const))
-	    (let ((low (ldb (byte 16 0) ,n-const)))
-	      (unless (zerop low)
-		(inst ori ,n-reg ,n-reg low))))
-	   (t
-	    (error "Constant ~D cannot be loaded." ,n-const)))))
-
 (defmacro load-symbol (reg symbol)
-  `(inst addi ,reg null-tn (vm:static-symbol-offset ,symbol)))
+  `(inst add ,reg null-tn (vm:static-symbol-offset ,symbol)))
 
 (macrolet
     ((frob (slot)
@@ -97,7 +72,7 @@
 		       (+ (vm:static-symbol-offset ',symbol)
 			  (ash ,',offset vm:word-shift)
 			  (- vm:other-pointer-type)))
-		 (nop)))
+		 (inst nop)))
 	    (defmacro ,storer (reg symbol)
 	      `(inst sw ,reg null-tn
 		     (+ (vm:static-symbol-offset ',symbol)
@@ -125,17 +100,17 @@
 (defmacro lisp-jump (function lip)
   "Jump to the lisp function FUNCTION.  LIP is an interior-reg temporary."
   `(progn
-     (inst addiu ,lip ,function (- (ash vm:function-header-code-offset
+     (inst addu ,lip ,function (- (ash vm:function-header-code-offset
 					vm:word-shift)
 				   vm:function-pointer-type))
-     (inst jr ,lip)
+     (inst j ,lip)
      (move code-tn ,function)))
 
 (defmacro lisp-return (return-pc lip)
   "Return to RETURN-PC.  LIP is an interior-reg temporary."
   `(progn
-     (inst addiu ,lip ,return-pc (- vm:word-bytes vm:other-pointer-type))
-     (inst jr ,lip)
+     (inst addu ,lip ,return-pc (- vm:word-bytes vm:other-pointer-type))
+     (inst j ,lip)
      (move code-tn ,return-pc)))
 
 (defmacro emit-return-pc (label)
@@ -204,7 +179,7 @@
 	  (if ,n-not-p
 	      (inst beq ,n-temp zero-tn ,n-target)
 	      (inst bne ,n-temp zero-tn ,n-target))))
-       (nop))))
+       (inst nop))))
 
 
 ;;;; Simple Type Checking Macros
@@ -212,12 +187,12 @@
 (defmacro simple-test-tag (register temp target not-p tag-type tag-mask)
   `(progn
      (unless (zerop ,tag-mask)
-       (inst andi ,temp ,register ,tag-mask))
-     (inst xori ,temp ,temp ,tag-type)
+       (inst and ,temp ,register ,tag-mask))
+     (inst xor ,temp ,temp ,tag-type)
      (if ,not-p
 	 (inst bne ,temp zero-tn ,target)
 	 (inst beq ,temp zero-tn ,target))
-     (nop)))
+     (inst nop)))
 
 (defmacro simple-test-simple-type (register temp target not-p type-code)
   "Emit conditional code that test whether Register holds an object with
@@ -260,7 +235,7 @@
 	      (simple-test-tag ,n-register ,n-temp not-other-label t
 			       vm:other-pointer-type vm:lowtag-mask)
 	      (load-type ,n-temp ,n-register (- vm:other-pointer-type))
-	      (nop)
+	      (inst nop)
 	      (simple-test-tag ,n-temp ,n-temp ,n-target ,n-not-p
 			       ,n-type-code 0)
 	      (emit-label out-label))))))
@@ -297,7 +272,7 @@
       (macrolet ((frob (value)
 		   `(let ((diff (+ (- ,value) last-type-code)))
 		      (unless (zerop diff)
-			(emit `(inst addi ,temp ,temp ,diff))
+			(emit `(inst add ,temp ,temp ,diff))
 			(setf last-type-code ,value)))))
 	(do* ((types tag-types (cdr types))
 	      (type (car types) (car types))
@@ -330,9 +305,9 @@
 	 ,in-label			; squelch possible warning
 	 ,out-label
 	 (unless (zerop ,tag-mask)
-	   (inst andi ,temp ,register ,tag-mask))
+	   (inst and ,temp ,register ,tag-mask))
 	 ,@(emit)
-	 (nop)
+	 (inst nop)
 	 (emit-label drop-through)))))
 
 (defmacro test-hairy-type (register temp target not-p &rest types)
@@ -381,7 +356,7 @@
 	       `((simple-test-tag ,n-register ,n-temp not-other-label t
 				  vm:other-pointer-type vm:lowtag-mask)
 		 (load-type ,n-temp ,n-register (- vm:other-pointer-type))
-		 (nop)
+		 (inst nop)
 		 (hairy-test-tag ,n-register ,n-temp ,n-target ,n-not-p
 				 ,header-word-types 0)))
 	   (emit-label out-label))))))
@@ -473,52 +448,48 @@
 	(emit-error-break vm:error-trap error-code values)))
 
 
-
 (defmacro cerror-call (label error-code &rest values)
   "Cause a continuable error.  If the error is continued, execution resumes at
   LABEL."
   `(progn
-     (b ,label)
+     (inst b ,label)
      ,@(emit-error-break vm:cerror-trap error-code values)))
 
-(defmacro generate-error-code (node error-code &rest values)
-  "Generate-Error-Code Node Error-code Value*
-  Emit code for an error with the specified Error-Code and context Values.
-  Node is used for source context."
-  `(unassemble
-     (assemble-elsewhere ,node
-       (let ((start-lab (gen-label)))
-	 (emit-label start-lab)
-	 (error-call ,error-code ,@values)
-	 start-lab))))
-
-(defmacro generate-cerror-code (node error-code &rest values)
-  "Generate-CError-Code Node Error-code Value*
+(defmacro generate-error-code (error-code &rest values)
+  "Generate-Error-Code Error-code Value*
+  Emit code for an error with the specified Error-Code and context Values."
+  `(assemble (*elsewhere*)
+     (let ((start-lab (gen-label)))
+       (emit-label start-lab)
+       (error-call ,error-code ,@values)
+       start-lab)))
+
+(defmacro generate-cerror-code (error-code &rest values)
+  "Generate-CError-Code Error-code Value*
   Emit code for a continuable error with the specified Error-Code and
-  context Values.  Node is used for source context.  If the error is continued,
-  execution resumes after the GENERATE-CERROR-CODE form."
+  context Values.  If the error is continued, execution resumes after
+  the GENERATE-CERROR-CODE form."
   (let ((continue (gensym "CONTINUE-LABEL-"))
 	(error (gensym "ERROR-LABEL-")))
     `(let ((,continue (gen-label)))
        (emit-label ,continue)
-       (unassemble
-	(assemble-elsewhere ,node
-	  (let ((,error (gen-label)))
-	    (emit-label ,error)
-	    (cerror-call ,continue ,error-code ,@values)
-	    ,error))))))
+       (assemble (*elsewhere*)
+	 (let ((,error (gen-label)))
+	   (emit-label ,error)
+	   (cerror-call ,continue ,error-code ,@values)
+	   ,error)))))
 
 ;;; PSEUDO-ATOMIC -- Handy macro for making sequences look atomic.
 ;;;
 (defmacro pseudo-atomic ((ndescr-temp) &rest forms)
   (let ((label (gensym "LABEL-")))
     `(let ((,label (gen-label)))
-       (inst andi flags-tn flags-tn (lognot (ash 1 interrupted-flag)))
-       (inst ori flags-tn flags-tn (ash 1 atomic-flag))
+       (inst and flags-tn flags-tn (logxor (ash 1 interrupted-flag) #Xffff))
+       (inst or flags-tn flags-tn (ash 1 atomic-flag))
        ,@forms
-       (inst andi flags-tn flags-tn (lognot (ash 1 atomic-flag)))
-       (inst andi ,ndescr-temp flags-tn (ash 1 interrupted-flag))
+       (inst and flags-tn flags-tn (logxor (ash 1 atomic-flag) #Xffff))
+       (inst and ,ndescr-temp flags-tn (ash 1 interrupted-flag))
        (inst beq ,ndescr-temp zero-tn ,label)
-       (nop)
+       (inst nop)
        (inst break vm:pending-interrupt-trap)
        (emit-label ,label))))
diff --git a/compiler/mips/memory.lisp b/compiler/mips/memory.lisp
index 49b306cac..2a8447194 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.6 1990/03/29 21:51:56 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/memory.lisp,v 1.7 1990/04/24 02:56:11 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS definitions of some general purpose memory
 ;;; reference VOPs inherited by basic memory reference operations.
@@ -127,16 +127,16 @@
 		   lowtag))
 	  ,(if write-p
 	       '(move result value)
-	       '(nop)))
+	       '(inst nop)))
 	 (t
 	  ,@(if (zerop shift)
-		`((inst add lip object index))
+		`((inst addu lip object index))
 		`((inst srl temp index ,shift)
-		  (inst add lip temp object)))
+		  (inst addu lip temp object)))
 	  (inst ,op value lip (- (ash offset word-shift) lowtag))
 	  ,(if write-p
 	       '(move result value)
-	       '(nop)))))))
+	       '(inst nop)))))))
 
 (define-indexer word-index-ref nil lw 0)
 (define-indexer word-index-set t sw 0)
diff --git a/compiler/mips/move.lisp b/compiler/mips/move.lisp
index 806310a12..ff03824c8 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.12 1990/04/23 16:45:09 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.13 1990/04/24 02:56:22 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS VM definition of operand loading/saving and
 ;;; the Move VOP.
@@ -25,23 +25,23 @@
   (let ((val (tn-value x)))
     (etypecase val
       (integer
-       (loadi y (fixnum val)))
+       (inst li y (fixnum val)))
       (null
        (move y null-tn))
       (symbol
        (load-symbol y val))
       (character
-       (loadi y (logior (ash (char-code val) type-bits)
-			base-character-type))))))
+       (inst li y (logior (ash (char-code val) type-bits)
+			  base-character-type))))))
 
 (define-move-function (load-number 1) (vop x y)
   ((null unsigned-immediate immediate zero negative-immediate random-immediate)
    (signed-reg unsigned-reg))
-  (loadi y (tn-value x)))
+  (inst li y (tn-value x)))
 
 (define-move-function (load-base-character 1) (vop x y)
   ((immediate-base-character) (base-character-reg))
-  (loadi y (char-code (tn-value x))))
+  (inst li y (char-code (tn-value x))))
 
 (define-move-function (load-constant 5) (vop x y)
   ((constant) (any-reg descriptor-reg))
diff --git a/compiler/mips/nlx.lisp b/compiler/mips/nlx.lisp
index 0a7620df0..2df18402b 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.7 1990/04/23 16:45:11 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.8 1990/04/24 02:56:24 wlott Exp $
 ;;;
 ;;;    This file contains the definitions of VOPs used for non-local exit
 ;;; (throw, lexical exit, etc.)
@@ -81,7 +81,7 @@
       (move nsp-tn nsp)
       
       (inst beq special bsp-tn done)
-      (nop)
+      (inst nop)
 
       (emit-label loop)
       (loadw symbol bsp-tn (- binding-symbol-slot binding-size))
@@ -90,9 +90,9 @@
       (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
       (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
       (emit-label skip)
-      (inst addiu bsp-tn bsp-tn (* -2 vm:word-bytes))
+      (inst addu bsp-tn bsp-tn (* -2 vm:word-bytes))
       (inst bne bsp-tn special loop)
-      (nop)
+      (inst nop)
 
       (emit-label done))))
 
@@ -120,7 +120,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :target block) result)
   (:generator 22
-    (inst addiu result fp-tn (* (tn-offset tn) vm:word-bytes))
+    (inst addu result fp-tn (* (tn-offset tn) vm:word-bytes))
     (load-symbol-value temp lisp::*current-unwind-protect-block*)
     (storew temp result vm:unwind-block-current-uwp-slot)
     (storew fp-tn result vm:unwind-block-current-cont-slot)
@@ -141,7 +141,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :target block) result)
   (:generator 44
-    (inst addiu result fp-tn (* (tn-offset tn) vm:word-bytes))
+    (inst addu result fp-tn (* (tn-offset tn) vm:word-bytes))
     (load-symbol-value temp lisp::*current-unwind-protect-block*)
     (storew temp result vm:catch-block-current-uwp-slot)
     (storew fp-tn result vm:catch-block-current-cont-slot)
@@ -164,7 +164,7 @@
   (:args (tn))
   (:temporary (:scs (descriptor-reg)) new-uwp)
   (:generator 7
-    (inst addiu new-uwp fp-tn (* (tn-offset tn) vm:word-bytes))
+    (inst addu new-uwp fp-tn (* (tn-offset tn) vm:word-bytes))
     (store-symbol-value new-uwp lisp::*current-unwind-protect-block*)))
 
 
@@ -198,7 +198,6 @@
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:info label nvals)
   (:save-p :force-to-stack)
-  (:node-var node)
   (:generator 30
     (emit-return-pc label)
     (cond ((zerop nvals))
@@ -218,30 +217,29 @@
 		 (defaults (cons default-lab tn))
 		 
 		 (inst beq count zero-tn default-lab)
-		 (inst addiu count count (fixnum -1))
+		 (inst addu count count (fixnum -1))
 		 (sc-case tn
-		   ((descriptor-reg any-reg)
-		    (loadw tn start i))
-		   (control-stack
-		    (loadw move-temp start i)
-		    (store-stack-tn tn move-temp)))))
-		    
+			  ((descriptor-reg any-reg)
+			   (loadw tn start i))
+			  (control-stack
+			   (loadw move-temp start i)
+			   (store-stack-tn tn move-temp)))))
+	     
 	     (let ((defaulting-done (gen-label)))
 	       
 	       (emit-label defaulting-done)
 	       
-	       (unassemble
-		(assemble-elsewhere node
-		  (dolist (def (defaults))
-		    (emit-label (car def))
-		    (let ((tn (cdr def)))
-		      (sc-case tn
-			((descriptor-reg any-reg)
-			 (move tn null-tn))
-			(control-stack
-			 (store-stack-tn tn null-tn)))))
-		  (b defaulting-done)
-		  (nop)))))))
+	       (assemble (*elsewhere*)
+		 (dolist (def (defaults))
+		   (emit-label (car def))
+		   (let ((tn (cdr def)))
+		     (sc-case tn
+			      ((descriptor-reg any-reg)
+			       (move tn null-tn))
+			      (control-stack
+			       (store-stack-tn tn null-tn)))))
+		 (inst b defaulting-done)
+		 (inst nop))))))
     (move csp-tn sp)))
 
 
@@ -274,11 +272,11 @@
       ;; Copy stuff on stack.
       (emit-label loop)
       (loadw temp src)
-      (inst addiu src src (fixnum 1))
+      (inst addu src src (fixnum 1))
       (storew temp dst)
-      (inst addiu num num (fixnum -1))
+      (inst addu num num (fixnum -1))
       (inst bne num zero-tn loop)
-      (inst addiu dst dst (fixnum 1))
+      (inst addu dst dst (fixnum 1))
 
       (emit-label done)
       (move csp-tn dst))))
diff --git a/compiler/mips/pred.lisp b/compiler/mips/pred.lisp
index 8d2ae540d..3a4c19d6b 100644
--- a/compiler/mips/pred.lisp
+++ b/compiler/mips/pred.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/pred.lisp,v 1.3 1990/03/06 19:39:09 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/pred.lisp,v 1.4 1990/04/24 02:56:27 wlott Exp $
 ;;;
 ;;;    This file contains the VM definition of predicate VOPs for the MIPS.
 ;;;
@@ -27,8 +27,8 @@
 (define-vop (branch)
   (:info dest)
   (:generator 5
-    (b dest)
-    (nop)))
+    (inst b dest)
+    (inst nop)))
 
 
 ;;;; Conditional VOPs:
@@ -54,6 +54,6 @@
       (if not-p
 	  (inst bne x-prime y-prime target)
 	  (inst beq x-prime y-prime target)))
-    (nop)))
+    (inst nop)))
 
 
diff --git a/compiler/mips/print.lisp b/compiler/mips/print.lisp
index 1a0913bc4..5f6228dbb 100644
--- a/compiler/mips/print.lisp
+++ b/compiler/mips/print.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/print.lisp,v 1.1 1990/03/18 23:45:13 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/print.lisp,v 1.2 1990/04/24 02:56:30 wlott Exp $
 ;;;
 ;;; This file contains temporary printing utilities and similar noise.
 ;;;
@@ -26,14 +26,14 @@
   (:temporary (:scs (any-reg) :type fixnum) temp)
   (:generator 0
     (let ((lra-label (gen-label)))
-      (inst addiu nsp-tn nsp-tn -16)
+      (inst addu nsp-tn nsp-tn -16)
       (storew object nsp-tn 0)
-      (inst load-foreign-address v0 "print")
-      (inst load-foreign-address temp "call_into_c")
-      (inst jr temp)
+      (inst li v0 (make-fixup "print" :foreign))
+      (inst li temp (make-fixup "call_into_c" :foreign))
+      (inst j temp)
       (inst compute-lra-from-code lra code lra-label)
       (align vm:lowtag-bits)
       (emit-label lra-label)
       (inst lra-header-word)
-      (inst addiu nsp-tn nsp-tn 16)
+      (inst addu nsp-tn nsp-tn 16)
       (move result v0))))
diff --git a/compiler/mips/sap.lisp b/compiler/mips/sap.lisp
index a198baf66..9f1c46a72 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.3 1990/04/23 16:45:19 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/sap.lisp,v 1.4 1990/04/24 02:56:32 wlott Exp $
 ;;;
 ;;;    This file contains the MIPS VM definition of SAP operations.
 ;;;
@@ -41,9 +41,9 @@
   (:generator 1
     (move sap x)
     (pseudo-atomic (ndescr)
-      (inst addiu y alloc-tn vm:other-pointer-type)
-      (inst addiu alloc-tn alloc-tn (vm:pad-data-block vm:sap-size))
-      (loadi ndescr (logior (ash vm:sap-size vm:type-bits) vm:sap-type))
+      (inst addu y alloc-tn vm:other-pointer-type)
+      (inst addu alloc-tn alloc-tn (vm:pad-data-block vm:sap-size))
+      (inst li ndescr (logior (ash vm:sap-size vm:type-bits) vm:sap-type))
       (storew y ndescr 0 vm:other-pointer-type)
       (storew y sap vm:sap-pointer-slot vm:other-pointer-type))))
 ;;;
diff --git a/compiler/mips/static-fn.lisp b/compiler/mips/static-fn.lisp
index 5807d205e..3841b8cbb 100644
--- a/compiler/mips/static-fn.lisp
+++ b/compiler/mips/static-fn.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/static-fn.lisp,v 1.5 1990/04/23 16:45:22 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.6 1990/04/24 02:56:34 wlott Exp $
 ;;;
 ;;; This file contains the VOPs and macro magic necessary to call static
 ;;; functions.
@@ -22,7 +22,6 @@
   (:save-p t)
   (:policy :fast-safe)
   (:variant-vars symbol)
-  (:node-var node)
   (:temporary (:scs (any-reg)) temp)
   (:temporary (:scs (descriptor-reg)) move-temp)
   (:temporary (:sc descriptor-reg :offset lra-offset) lra)
@@ -87,7 +86,7 @@
 	 (:generator ,(+ 50 num-args num-results)
 	   (let ((lra-label (gen-label)))
 	     ,@(moves (temp-names) (arg-names))
-	     (loadi nargs (fixnum ,num-args))
+	     (inst li nargs (fixnum ,num-args))
 	     (load-symbol cname symbol)
 	     (loadw lexenv cname vm:symbol-function-slot vm:other-pointer-type)
 	     (move old-fp fp-tn)
@@ -97,25 +96,21 @@
 		    vm:function-pointer-type)
 	     (lisp-jump function lip)
 	     (emit-return-pc lra-label)
-	     (unassemble
-	      ,(collect ((bindings) (links))
-		 (do ((temp (temp-names) (cdr temp))
-		      (name 'values (gensym))
-		      (prev nil name)
-		      (i 0 (1+ i)))
-		     ((= i num-results))
-		   (bindings `(,name
-			       (make-tn-ref ,(car temp) nil)))
-		   (when prev
-		     (links `(setf (tn-ref-across ,prev) ,name))))
-		 `(let ,(bindings)
-		    ,@(links)
-		    (default-unknown-values node
-					    ,(if (zerop num-results)
-						 nil
-						 'values)
-					    ,num-results
-					    move-temp temp lra-label))))
+	     ,(collect ((bindings) (links))
+		(do ((temp (temp-names) (cdr temp))
+		     (name 'values (gensym))
+		     (prev nil name)
+		     (i 0 (1+ i)))
+		    ((= i num-results))
+		  (bindings `(,name
+			      (make-tn-ref ,(car temp) nil)))
+		  (when prev
+		    (links `(setf (tn-ref-across ,prev) ,name))))
+		`(let ,(bindings)
+		   ,@(links)
+		   (default-unknown-values
+		       ,(if (zerop num-results) nil 'values)
+		       ,num-results move-temp temp lra-label))))
 	     ,@(moves (result-names) (temp-names))))))))
 
 
@@ -135,6 +130,7 @@
 		,(static-function-template-name (length args)
 						(length results)))
      (:variant ',name)
+     (:note ,(format nil "static-function ~@(~S~)" name))
      ,@(when translate
 	 `((:translate ,translate)))
      ,@(when policy
diff --git a/compiler/mips/subprim.lisp b/compiler/mips/subprim.lisp
index cda7e1685..7b94f18a7 100644
--- a/compiler/mips/subprim.lisp
+++ b/compiler/mips/subprim.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/subprim.lisp,v 1.4 1990/04/01 18:05:07 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/subprim.lisp,v 1.5 1990/04/24 02:56:39 wlott Exp $
 ;;;
 ;;;    Linkage information for standard static functions, and random vops.
 ;;;
@@ -29,12 +29,10 @@
 	      count)
   (:results (result :scs (any-reg descriptor-reg)))
   (:policy :fast-safe)
-  (:node-var node)
   (:generator 50
     (let ((done (gen-label))
 	  (loop (gen-label))
-	  (not-list (generate-cerror-code node di:object-not-list-error
-					  object)))
+	  (not-list (generate-cerror-code di:object-not-list-error object)))
       (move ptr object)
       (move count zero-tn)
 
@@ -46,7 +44,7 @@
       (simple-test-simple-type ptr temp not-list t vm:list-pointer-type)
 
       (loadw ptr ptr vm:cons-cdr-slot vm:list-pointer-type)
-      (inst addiu count count (fixnum 1))
+      (inst addu count count (fixnum 1))
       (simple-test-simple-type ptr temp loop nil vm:list-pointer-type)
 
       (cerror-call done di:object-not-list-error ptr)
diff --git a/compiler/mips/system.lisp b/compiler/mips/system.lisp
index ec3b72731..b1757ee2e 100644
--- a/compiler/mips/system.lisp
+++ b/compiler/mips/system.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.8 1990/03/21 23:32:43 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/system.lisp,v 1.9 1990/04/24 02:56:44 wlott Exp $
 ;;;
 ;;;    MIPS VM definitions of various system hacking operations.
 ;;;
@@ -78,20 +78,20 @@
 	  (shift (gen-label)))
       (simple-test-simple-type object ndescr other-ptr
 			       nil vm:other-pointer-type)
-      (inst andi ndescr object (logand (logeqv vm:other-immediate-0-type
-					       vm:other-immediate-1-type)
-				       vm:lowtag-mask))
-      (inst xori ndescr ndescr (logand vm:other-immediate-0-type
-				       vm:other-immediate-1-type))
+      (inst and ndescr object (logand (logeqv vm:other-immediate-0-type
+					      vm:other-immediate-1-type)
+				      vm:lowtag-mask))
+      (inst xor ndescr ndescr (logand vm:other-immediate-0-type
+				      vm:other-immediate-1-type))
       (inst bne ndescr zero-tn shift)
-      (inst andi ndescr object vm:lowtag-mask)
-
-      (b shift)
-      (inst andi ndescr object vm:type-mask)
-
+      (inst and ndescr object vm:lowtag-mask)
+      
+      (inst b shift)
+      (inst and ndescr object vm:type-mask)
+      
       (emit-label other-ptr)
       (load-type ndescr object)
-
+      
       (emit-label shift)
       (inst sll result ndescr 2))))
 
@@ -112,7 +112,7 @@
     (sc-case type
       ((immediate unsigned-immediate)
        (inst sll temp val vm:type-bits)
-       (inst ori res temp (tn-value type)))
+       (inst or res temp (tn-value type)))
       (t
        (inst sra temp type 2)
        (inst sll res val (- vm:type-bits 2))
diff --git a/compiler/mips/type-vops.lisp b/compiler/mips/type-vops.lisp
index 88aa23896..53296091f 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.9 1990/03/28 23:21:28 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.10 1990/04/24 02:56:47 wlott Exp $
 ;;; 
 ;;; This file contains the VM definition of type testing and checking VOPs
 ;;; for the RT.
@@ -31,10 +31,9 @@
   (:results
    (result :scs (any-reg descriptor-reg)))
   (:variant-vars type-code error-code)
-  (:node-var node)
   (:temporary (:type random :scs (non-descriptor-reg)) temp)
   (:generator 4
-    (let ((err-lab (generate-error-code node error-code value)))
+    (let ((err-lab (generate-error-code error-code value)))
       (test-simple-type value temp err-lab t type-code)
       (move result value))))
 
@@ -105,9 +104,8 @@
 (define-vop (check-fixnum check-simple-type)
   (:ignore type-code error-code)
   (:generator 3
-    (let ((err-lab (generate-error-code node di:object-not-fixnum-error
-					value)))
-      (inst andi temp value #x3)
+    (let ((err-lab (generate-error-code di:object-not-fixnum-error value)))
+      (inst and temp value #x3)
       (inst bne temp zero-tn err-lab)
       (move result value t))))
 
@@ -117,11 +115,11 @@
   (:ignore type-code)
   (:translate ext:fixnump)
   (:generator 3
-    (inst andi temp value #x3)
+    (inst and temp value #x3)
     (if not-p
 	(inst bne temp zero-tn target)
 	(inst beq temp zero-tn target))
-    (nop)))
+    (inst nop)))
 
 
 ;;;; Hairy type tests:
@@ -144,8 +142,7 @@
 	:target res))
   (:results
    (res :scs (any-reg descriptor-reg)))
-  (:temporary (:type random :scs (non-descriptor-reg)) temp)
-  (:node-var node))
+  (:temporary (:type random :scs (non-descriptor-reg)) temp))
 
 (macrolet ((frob (pred-name check-name error-code &rest types)
 	     (let ((cost (* (+ (length types)
@@ -161,8 +158,8 @@
 		  ,@(when check-name
 		      `((define-vop (,check-name check-hairy-type)
 			  (:generator ,cost
-			    (let ((err-lab (generate-error-code
-					    node ,error-code obj)))
+			    (let ((err-lab (generate-error-code ,error-code
+								obj)))
 			      (test-hairy-type obj temp err-lab t ,@types))
 			    (move res obj)))))))))
 
@@ -247,7 +244,7 @@
 		    ,@body))
 		(define-vop (,check-name check-list-symbol)
 		  (:generator 8
-		    (let ((target (generate-error-code node ,error-code obj))
+		    (let ((target (generate-error-code ,error-code obj))
 			  (not-p t))
 		      ,@body
 		      (move res obj)))))))
@@ -256,7 +253,7 @@
     (let* ((drop-thru (gen-label))
 	   (is-symbol-label (if not-p drop-thru target)))
       (inst beq obj null-tn is-symbol-label)
-      (nop)
+      (inst nop)
       (test-simple-type obj temp target not-p vm:symbol-header-type)
       (emit-label drop-thru)))
 
@@ -264,7 +261,7 @@
     (let* ((drop-thru (gen-label))
 	   (is-not-cons-label (if not-p target drop-thru)))
       (inst beq obj null-tn is-not-cons-label)
-      (nop)
+      (inst nop)
       (test-simple-type obj temp target not-p vm:list-pointer-type)
       (emit-label drop-thru))))
 
@@ -279,7 +276,6 @@
   (:args (object :scs (descriptor-reg)
 		:target result))
   (:results (result :scs (descriptor-reg)))
-  (:node-var node)
   (:temporary (:type random  :scs (non-descriptor-reg)) nd-temp)
   (:temporary (:scs (descriptor-reg)) saved-object)
   (:generator 0
@@ -291,16 +287,15 @@
       (move result object)
       (emit-label done-label)
 
-      (unassemble
-	(assemble-elsewhere node
-	  (emit-label not-function-label)
-	  (test-simple-type object nd-temp not-coercable-label t
-			    vm:symbol-header-type)
-	  (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 di:undefined-symbol-error saved-object)
-
-	  (emit-label not-coercable-label)
-	  (error-call di:object-not-coercable-to-function-error object))))))
+      (assemble (*elsewhere*)
+	(emit-label not-function-label)
+	(test-simple-type object nd-temp not-coercable-label t
+			  vm:symbol-header-type)
+	(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 di:undefined-symbol-error saved-object)
+	
+	(emit-label not-coercable-label)
+	(error-call di:object-not-coercable-to-function-error object)))))
diff --git a/compiler/mips/values.lisp b/compiler/mips/values.lisp
index a7fdc0f4e..46e99fef2 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.6 1990/04/03 03:01:51 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/values.lisp,v 1.7 1990/04/24 02:56:51 wlott Exp $
 ;;;
 ;;;    This file contains the implementation of unknown-values VOPs.
 ;;;
@@ -46,7 +46,7 @@
 	      start-temp)
   (:generator 20
     (move start-temp csp-tn)
-    (inst addi csp-tn csp-tn (* nvals vm:word-bytes))
+    (inst addu csp-tn csp-tn (* nvals vm:word-bytes))
     (do ((val vals (tn-ref-across val))
 	 (i 0 (1+ i)))
 	((null val))
@@ -58,7 +58,7 @@
 	   (load-stack-tn temp tn)
 	   (storew temp start-temp i)))))
     (move start start-temp)
-    (loadi count (fixnum nvals))))
+    (inst li count (fixnum nvals))))
 
 
 ;;; Push a list of values on the stack, returning Start and Count as used in
@@ -84,11 +84,11 @@
       (inst beq list null-tn done)
       (loadw temp list vm:cons-car-slot vm:list-pointer-type)
       (loadw list list vm:cons-cdr-slot vm:list-pointer-type)
-      (inst addiu csp-tn csp-tn vm:word-bytes)
+      (inst addu csp-tn csp-tn vm:word-bytes)
       (storew temp csp-tn -1)
       (test-simple-type list ndescr loop nil vm:list-pointer-type)
       (error-call di:bogus-argument-to-values-list-error list)
 
       (emit-label done)
-      (inst sub count csp-tn start))))
+      (inst subu count csp-tn start))))
 
-- 
GitLab