diff --git a/compiler/mips/insts.lisp b/compiler/mips/insts.lisp
index 201778681dc42233b6b70328b4f4fb18403848e0..bdcdaaabc34625d7bdef1b8b085dfdfabce494c9 100644
--- a/compiler/mips/insts.lisp
+++ b/compiler/mips/insts.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.39 1992/03/06 10:46:02 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/insts.lisp,v 1.40 1992/07/08 20:58:41 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,112 +16,37 @@
 ;;; Written by William Lott
 ;;;
 
+
 (in-package "MIPS")
-(use-package "ASSEM")
+
+(use-package "NEW-ASSEM")
 (use-package "EXT")
+(use-package "C")
 
-(disassem:set-disassem-params
- :instruction-alignment 32
- :storage-class-sets '((register any-reg descriptor-reg base-char-reg
-				 sap-reg signed-reg unsigned-reg
-				 non-descriptor-reg interior-reg)
-		       (float-reg single-reg double-reg)
-		       (control-stack control-stack)
-		       (number-stack signed-stack unsigned-stack
-				     base-char-stack sap-stack
-				     single-stack double-stack))
- )
+(def-assembler-params
+    :scheduler-p nil)
 
 
-;;;; Resources.
+;;;; Functions to convert TN's and random symbolic things into values.
 
-(define-resources high low memory float-status)
-
-
-;;;; Special argument types and fixups.
-
-(defun register-p (object)
-  (and (tn-p object)
-       (let* ((sc (tn-sc object))
-	      (sc-name (sc-name sc))
-	      (sb (sc-sb sc))
-	      (sb-name (sb-name sb)))
-	 (or (eq sc-name 'zero)
-	     (eq sc-name 'null)
-	     (eq sb-name 'registers)))))
-
-(defun tn-register-number (tn)
+(defun reg-tn-encoding (tn)
+  (declare (type tn tn))
   (sc-case tn
     (zero zero-offset)
     (null null-offset)
-    (t (tn-offset tn))))
-
-(defconstant reg-symbols
-  (map 'vector
-       #'(lambda (name)
-	   (cond ((null name) nil)
-		 (t (make-symbol (concatenate 'string "$" name)))))
-       *register-names*))
-
-(define-argument-type register
-  :type '(satisfies register-p)
-  :function tn-register-number
-  :disassem-printer #'(lambda (value stream dstate)
-			(declare (stream stream) (fixnum value))
-			(let ((regname (aref reg-symbols value)))
-			  (princ regname stream)
-			  (disassem:maybe-note-associated-storage-ref
-			   value
-			   'register
-			   regname
-			   dstate)))
-  )
-
-(defun fp-reg-p (object)
-  (and (tn-p object)
-       (eq (sb-name (sc-sb (tn-sc object)))
-	   'float-registers)))
-
-(defconstant float-reg-symbols
-  (coerce 
-   (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n)))
-   'vector))
-
-(define-argument-type fp-reg
-  :type '(satisfies fp-reg-p)
-  :function tn-offset
-  :disassem-printer #'(lambda (value stream dstate)
-			(declare (stream stream) (fixnum value))
-			(let ((regname (aref float-reg-symbols value)))
-			  (princ regname stream)
-			  (disassem:maybe-note-associated-storage-ref
-			   value
-			   'float-reg
-			   regname
-			   dstate)))
-  )
-
-(define-argument-type odd-fp-reg
-  :type '(satisfies fp-reg-p)
-  :function (lambda (tn)
-	      (1+ (tn-offset tn))))
-
-(define-argument-type control-register
-  :type '(unsigned-byte 5)
-  :function identity
-  :disassem-printer "{CR:#x~X}")
-
-(defun label-offset (label)
-  (1- (ash (- (label-position label) *current-position*) -2)))
-
-(define-argument-type relative-label
-  :type 'label
-  :function label-offset
-  :sign-extend t
-  :disassem-use-label #'(lambda (value dstate)
-			  (declare (type disassem:disassem-state dstate))
-			  (+ (ash (1+ value) 2)
-			     (disassem:dstate-curpos dstate))))
+    (t
+     (if (eq (sb-name (sc-sb (tn-sc tn))) 'registers)
+	 (tn-offset tn)
+	 (error "~S isn't a register." tn)))))
+
+(defun fp-reg-tn-encoding (tn)
+  (declare (type tn tn))
+  (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
+    (error "~S isn't a floating-point register." tn))
+  (tn-offset tn))
+
+(deftype float-format ()
+  '(member :s :single :d :double :w :word))
 
 (defun float-format-value (format)
   (ecase format
@@ -129,25 +54,11 @@
     ((:d :double) 1)
     ((:w :word) 4)))
 
-(define-argument-type float-format
-  :type '(member :s :single :d :double :w :word)
-  :function float-format-value
-  :disassem-printer #'(lambda (value stream dstate)
-			(declare (ignore dstate)
-				 (stream stream)
-				 (fixnum value))
-			(princ (case value
-				 (0 's)
-				 (1 'd)
-				 (4 'w)
-				 (t '?))
-			       stream)))
-			
-
 (defconstant compare-kinds
   '(:f :un :eq :ueq :olt :ult :ole :ule :sf :ngle :seq :ngl :lt :nge :le :ngt))
-(defconstant compare-kinds-vec
-  (apply #'vector compare-kinds))
+
+(deftype compare-kind ()
+  `(member ,@compare-kinds))
 
 (defun compare-kind (kind)
   (or (position kind compare-kinds)
@@ -155,16 +66,11 @@
 	     kind
 	     compare-kinds)))
 
-(define-argument-type compare-kind
-  :type `(member ,@compare-kinds)
-  :function compare-kind
-  :disassem-printer compare-kinds-vec)
-
 
 (defconstant float-operations '(+ - * /))
-(defconstant float-operation-names
-  ;; this gets used for output only
-  #(add sub mul div))
+
+(deftype float-operation ()
+  `(member ,@float-operations))
 
 (defun float-operation (op)
   (or (position op float-operations)
@@ -172,810 +78,501 @@
 	     op
 	     float-operations)))
 
-(define-argument-type float-operation
-  :type `(member ,@float-operations)
-  :function float-operation
-  :disassem-printer float-operation-names)
+
+;;;; Primitive emitters.
+
+(define-emitter emit-word 32
+  (byte 32 0))
+
+(define-emitter emit-short 16
+  (byte 16 0))
+
+(define-emitter emit-immediate-inst 32
+  (byte 6 26) (byte 5 21) (byte 5 16) (byte 16 0))
+
+(define-emitter emit-jump-inst 32
+  (byte 6 26) (byte 26 0))
 
-(define-fixup-type :jump
-  :disassem-printer #'(lambda (value stream dstate)
-			(let ((addr (ash value 2)))
-			  (disassem:maybe-note-assembler-routine addr dstate)
-			  (write addr :base 16 :radix t :stream stream))))
-(define-fixup-type :lui :disassem-printer "#x~4,'0X")
-(define-fixup-type :addi)
+(define-emitter emit-register-inst 32
+  (byte 6 26) (byte 5 21) (byte 5 16) (byte 5 11) (byte 5 6) (byte 6 0))
+
+
+(define-emitter emit-break-inst 32
+  (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
+
+(define-emitter emit-float-inst 32
+  (byte 6 26) (byte 1 25) (byte 4 21) (byte 5 16)
+  (byte 5 11) (byte 5 6) (byte 6 0))
 
 
 
-;;;; Formats.
+;;;; Constants used by instruction emitters.
 
 (defconstant special-op #b000000)
-(defconstant bcond-op #b0000001)
+(defconstant bcond-op #b000001)
 (defconstant cop0-op #b010000)
 (defconstant cop1-op #b010001)
 (defconstant cop2-op #b010010)
 (defconstant cop3-op #b010011)
 
-(defconstant immed-printer
-  '(:name :tab rt (:unless (:same-as rt) ", " rs) ", " immediate))
-
-;;; for things that use rt=0 as a nop
-(defconstant immed-zero-printer
-  '(:name :tab rt (:unless (:constant 0) ", " rs) ", " immediate))
-
-
-(define-format (immediate 32
-		:disassem-printer immed-printer)
-  (op (byte 6 26))
-  (rs (byte 5 21) :read t :default-type register)
-  (rt (byte 5 16) :write t :default-type register)
-  (immediate (byte 16 0) :default-type (signed-byte 16)))
-
-(define-format (jump 32
-		:disassem-printer '(:name :tab target))
-  (op (byte 6 26))
-  (target (byte 26 0) :default-type (unsigned-byte 26)))
-
-(defconstant reg-printer
-  '(:name :tab rd (:unless (:same-as rd) ", " rs) ", " rt))
-
-(define-format (register 32 :disassem-printer reg-printer)
-  (op (byte 6 26))
-  (rs (byte 5 21) :read t :default-type register)
-  (rt (byte 5 16) :read t :default-type register)
-  (rd (byte 5 11) :write t :default-type register)
-  (shamt (byte 5 6) :default 0 :default-type (unsigned-byte 5))
-  (funct (byte 6 0)))
-
-
-(define-format (break 32
-		:disassem-printer
-		  '(:name :tab code (:unless (:constant 0) subcode)))
-  (op (byte 6 26) :default special-op)
-  (code (byte 10 16))
-  (subcode (byte 10 6) :default 0)
-  (funct (byte 6 0) :default #b001101))
-
-
-(define-format (coproc-branch 32
-		:use (float-status)
-		:disassem-printer '(:name :tab offset))
-  (op (byte 6 26))
-  (funct (byte 10 16))
-  (offset (byte 16 0) :default-type (signed-byte 16)))
-
-(defconstant float-fmt-printer
-  '((:unless :constant funct)
-    (:choose (:unless :constant sub-funct) nil)
-    "." format))
-
-(defconstant float-printer
-  `(:name ,@float-fmt-printer
-	  :tab
-	  fd
-	  (:unless (:same-as fd) ", " fs)
-	  ", " ft))
-
-(define-format (float 32 :use (float-status) :clobber (float-status)
-		:disassem-printer float-printer)
-  (op (byte 6 26) :default #b010001)
-  (filler (byte 1 25) :default #b1)
-  (format (byte 4 21) :default-type float-format)
-  (ft (byte 5 16) :read t :default-type fp-reg)
-  (fs (byte 5 11) :read t :default-type fp-reg)
-  (fd (byte 5 6) :write t :default-type fp-reg)
-  (funct (byte 6 0)))
-
-(define-format (float-aux 32 :use (float-status) :clobber (float-status)
-			  :disassem-printer float-printer)
-  (op (byte 6 26) :default #b010001)
-  (filler-1 (byte 1 25) :default #b1)
-  (format (byte 4 21) :default-type float-format)
-  (ft (byte 5 16) :read t :default 0 :default-type fp-reg)
-  (fs (byte 5 11) :read t :default-type fp-reg)
-  (fd (byte 5 6) :write t :default-type fp-reg)
-  (funct (byte 2 4))
-  (sub-funct (byte 4 0)))
-
 
 
-;;;; 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)
-
-(defstruct lui-note
-  target-reg
-  high-bits
-  following-addr)
-
-(defun look-at-lui-note (chunk inst stream dstate)
-  (when stream
-    (let ((lui-note (disassem:dstate-get-prop dstate 'lui-note)))
-      (when (and lui-note
-		 (= (disassem:dstate-curpos dstate)
-		    (lui-note-following-addr lui-note))
-		 (= (disassem:arg-value 'rt chunk inst)
-		    (lui-note-target-reg lui-note)))
-	(let ((value
-	       (+ (lui-note-high-bits lui-note)
-		  (disassem:arg-value 'immediate
-				      chunk inst))))
-	(or (disassem:maybe-note-assembler-routine value dstate)
-	    (disassem:note #'(lambda (stream)
-			       (format stream "#x~x (~d)"
-				       value
-				       (disassem:sign-extend value 32)))
-			   dstate))))))) 
-
-(disassem:specialize (or :disassem-control #'look-at-lui-note)
-  immediate)
-(disassem:specialize (add :disassem-control #'look-at-lui-note)
-  immediate)
-
-;;; note: this must be after the above, because the disassem-controls
-;;; are exclusive
-(disassem:specialize (add
-		      :disassem-control
-		        #'(lambda (chunk inst stream dstate)
-			    (when stream
-			      (disassem:maybe-note-nil-indexed-object
-			       (disassem:arg-value 'immediate chunk inst)
-			       dstate))))
-  immediate
-  (rs :constant null-offset))
-
-
-(define-instruction (beq :pinned t
-			 :attributes (relative-branch delayed-branch))
-  (immediate (op :constant #b000100)
-	     (rs :argument register)
-	     (rt :constant 0)
-	     (immediate :argument relative-label))
-  (immediate (op :constant #b000100)
-	     (rs :argument register)
-	     (rt :argument register :read t :write nil)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bne :pinned t
-			 :attributes (relative-branch delayed-branch))
-  (immediate (op :constant #b000101)
-	     (rs :argument register)
-	     (rt :constant 0)
-	     (immediate :argument relative-label))
-  (immediate (op :constant #b000101)
-	     (rs :argument register)
-	     (rt :argument register :read t :write nil)
-	     (immediate :argument relative-label)))
-
-(defconstant cond-branch-printer
-  '(:name :tab rs ", " immediate))
-
-(define-instruction (blez :pinned t
-			  :attributes (relative-branch delayed-branch)
-			  :disassem-printer cond-branch-printer)
-  (immediate (op :constant #b000110)
-	     (rs :argument register)
-	     (rt :constant 0)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bgtz :pinned t
-			  :attributes (relative-branch delayed-branch)
-			  :disassem-printer cond-branch-printer)
-  (immediate (op :constant #b000111)
-	     (rs :argument register)
-	     (rt :constant 0)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bltz :pinned t
-			  :attributes (relative-branch delayed-branch)
-			  :disassem-printer cond-branch-printer)
-  (immediate (op :constant bcond-op)
-	     (rs :argument register)
-	     (rt :constant #b00000)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bgez :pinned t
-			  :attributes (relative-branch delayed-branch)
-			  :disassem-printer cond-branch-printer)
-  (immediate (op :constant bcond-op)
-	     (rs :argument register)
-	     (rt :constant #b00001)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bltzal :pinned t
-			    :attributes (relative-branch delayed-branch)
-			    :disassem-printer cond-branch-printer)
-  (immediate (op :constant bcond-op)
-	     (rs :argument register)
-	     (rt :constant #b01000)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bgezal :pinned t
-			    :attributes (relative-branch delayed-branch)
-			    :disassem-printer cond-branch-printer)
-  (immediate (op :constant bcond-op)
-	     (rs :argument register)
-	     (rt :constant #b01001)
-	     (immediate :argument relative-label)))
-
-(define-instruction (bc1f :pinned t
-			  :attributes (relative-branch delayed-branch))
-  (coproc-branch (op :constant cop1-op)
-		 (funct :constant #x100)
-		 (offset :argument relative-label)))
-
-(define-instruction (bc1t :pinned t
-			  :attributes (relative-branch delayed-branch))
-  (coproc-branch (op :constant cop1-op)
-		 (funct :constant #x101)
-		 (offset :argument relative-label)))
-
-;;; ----------------------------------------------------------------
-
-(defun snarf-error-junk (sap offset &optional length-only)
-  (let* ((length (system:sap-ref-8 sap offset))
-	 (vector (make-array length :element-type '(unsigned-byte 8))))
-    (declare (type system:system-area-pointer sap)
-	     (type (unsigned-byte 8) length)
-	     (type (simple-array (unsigned-byte 8) (*)) vector))
-    (cond (length-only
-	   (values 0 (1+ length) nil nil))
-	  (t
-	   (kernel:copy-from-system-area sap (* mips:byte-bits (1+ offset))
-					 vector (* mips:word-bits
-						   mips:vector-data-offset)
-					 (* length mips:byte-bits))
-	   (collect ((sc-offsets)
-		     (lengths))
-	     (lengths 1)		; the length byte
-	     (let* ((index 0)
-		    (error-number (c::read-var-integer vector index)))
-	       (lengths index)
-	       (loop
-		 (when (>= index length)
-		   (return))
-		 (let ((old-index index))
-		   (sc-offsets (c::read-var-integer vector index))
-		   (lengths (- index old-index))))
-	       (values error-number
-		       (1+ length)
-		       (sc-offsets)
-		       (lengths))))))))
-
-(defmacro break-cases (breaknum &body cases)
-  (let ((bn-temp (gensym)))
-    (collect ((clauses))
-      (dolist (case cases)
-	(clauses `((= ,bn-temp ,(car case)) ,@(cdr case))))
-      `(let ((,bn-temp ,breaknum))
-	 (cond ,@(clauses))))))
-
-(defun break-control (chunk inst stream dstate)
-  (flet ((nt (x) (if stream (disassem:note x dstate))))
-    (break-cases (disassem:arg-value 'code chunk inst)
-      (vm:error-trap
-       (nt "Error trap")
-       (disassem:handle-break-args #'snarf-error-junk stream dstate))
-      (vm:cerror-trap
-       (nt "Cerror trap")
-       (disassem:handle-break-args #'snarf-error-junk stream dstate))
-      (vm:breakpoint-trap
-       (nt "Breakpoint trap"))
-      (vm:pending-interrupt-trap
-       (nt "Pending interrupt trap"))
-      (vm:halt-trap
-       (nt "Halt trap"))
-      (vm:function-end-breakpoint-trap
-       (nt "Function end breakpoint trap"))
-    )))
-
-(define-instruction (break :pinned t :disassem-control #'break-control)
-  (break (code :argument (unsigned-byte 10)))
-  (break (code :argument (unsigned-byte 10))
-	 (subcode :argument (unsigned-byte 10))))
-
-;;; ----------------------------------------------------------------
-
-(defconstant divmul-printer '(:name :tab rs ", " rt))
-
-(define-instruction (div :clobber (low high) :disassem-printer divmul-printer)
-  (register (op :constant special-op)
-	    (rs :argument register)
-	    (rt :argument register)
-	    (rd :constant 0)
-	    (funct :constant #b011010)))
-
-(define-instruction (divu :clobber (low high) :disassem-printer divmul-printer)
-  (register (op :constant special-op)
-	    (rs :argument register)
-	    (rt :argument register)
-	    (rd :constant 0)
-	    (funct :constant #b011011)))
-
-(define-instruction (j :pinned t
-		       :attributes (unconditional-branch delayed-branch)
-		       :disassem-printer '(:name :tab (:choose rs target)))
-  (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 :pinned t
-			 :attributes (delayed-branch assembly-call)
-			 :disassem-printer
-			 '(:name :tab
-			   ;(:unless (:constant 31) rd ", ")
-			   (:choose rs target)))
-  (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)))
-
-(defconstant load-store-printer 
-  '(:name :tab
-	  rt ", "
-	  rs
-	  (:unless (:constant 0) "[" immediate "]")))
-
-(defmacro define-load/store-instruction (name read-p op
-					      &optional (rt-kind 'register))
-  `(define-instruction (,name ,@(if read-p
-				    '(:use (memory) :attributes (delayed-load))
-				    '(:clobber (memory)))
-			      :disassem-printer load-store-printer)
-     (immediate (op :constant ,op)
-		(rt :argument ,rt-kind ,@(unless read-p
-					   '(:read t :write nil)))
-		(rs :argument register)
-		(immediate :argument (signed-byte 16)))
-     (immediate (op :constant ,op)
-		(rt :argument ,rt-kind ,@(unless read-p
-					   '(:read t :write nil)))
-		(rs :argument register)
-		(immediate :argument addi-fixup))
-     (immediate (op :constant ,op)
-		(rt :argument ,rt-kind ,@(unless read-p
-					   '(:read t :write nil)))
-		(rs :argument register)
-		(immediate :constant 0))))
-
-(define-load/store-instruction lb t #b100000)
-(define-load/store-instruction lh t #b100001)
-(define-load/store-instruction lwl t #b100010)
-(define-load/store-instruction lw t #b100011)
-(define-load/store-instruction lbu t #b100100)
-(define-load/store-instruction lhu t #b100101)
-(define-load/store-instruction lwr t #b100110)
-(define-load/store-instruction lwc1 t #o61 fp-reg)
-(define-load/store-instruction lwc1-odd t #o61 odd-fp-reg)
-(define-load/store-instruction sb nil #b101000)
-(define-load/store-instruction sh nil #b101001)
-(define-load/store-instruction swl nil #b101010)
-(define-load/store-instruction sw nil #b101011)
-(define-load/store-instruction swr nil #b101110)
-(define-load/store-instruction swc1 nil #o71 fp-reg)
-(define-load/store-instruction swc1-odd nil #o71 odd-fp-reg)
-
-;;; ----------------------------------------------------------------
-;;; Disassembler annotation
-
-(defun note-niss-ref (chunk inst stream dstate)
-  (when stream
-    (disassem:maybe-note-nil-indexed-symbol-slot-ref
-     (disassem:arg-value 'immediate chunk inst)
-     dstate)))
-
-(defun note-control-stack-var-ref (chunk inst stream dstate)
-  (when stream
-    (disassem:maybe-note-single-storage-ref
-     (disassem:arg-value 'immediate chunk inst)
-     'control-stack
-     dstate))
-  )
-
-(defun note-number-stack-var-ref (chunk inst stream dstate)
-  (when stream
-    (disassem:maybe-note-single-storage-ref
-     (disassem:arg-value 'immediate chunk inst)
-     'number-stack
-     dstate))
-  )
-
-(disassem:specialize (lw
-		      :disassem-control
-		        #'(lambda (chunk inst stream dstate)
-			    (when stream
-			      (disassem:note-code-constant
-			       (disassem:arg-value 'immediate chunk inst)
-			       dstate))))
-  immediate
-  (rs :constant code-offset))
-
-(disassem:specialize (lw :disassem-control #'note-niss-ref)
-  immediate
-  (rs :constant null-offset))
-(disassem:specialize (lw :disassem-control #'note-control-stack-var-ref)
-  immediate
-  (rs :constant cfp-offset))
-(disassem:specialize (lw :disassem-control #'note-number-stack-var-ref)
-  immediate
-  (rs :constant nfp-offset))
-
-(disassem:specialize (sw :disassem-control #'note-niss-ref)
-  immediate
-  (rs :constant null-offset))
-(disassem:specialize (sw :disassem-control #'note-control-stack-var-ref)
-  immediate
-  (rs :constant cfp-offset))
-(disassem:specialize (sw :disassem-control #'note-number-stack-var-ref)
-  immediate
-  (rs :constant nfp-offset))
-
-;;; floating point
-(disassem:specialize (lwc1 :disassem-control #'note-number-stack-var-ref)
-  immediate
-  (rs :constant nfp-offset))
-(disassem:specialize (swc1 :disassem-control #'note-number-stack-var-ref)
-  immediate
-  (rs :constant nfp-offset))
-
-
-(defun lui-note (chunk inst stream dstate)
-  (when stream
-    (let ((lui-note (disassem:dstate-get-prop dstate 'lui-note)))
-      (when (null lui-note)
-	(setf lui-note (make-lui-note)
-	      (disassem:dstate-get-prop dstate 'lui-note) lui-note))
-      (setf (lui-note-target-reg lui-note)
-	    (disassem:arg-value 'rt chunk inst))
-      (setf (lui-note-high-bits lui-note)
-	    (ash (disassem:arg-value 'immediate chunk inst) 10))
-      (setf (lui-note-following-addr lui-note)
-	    (disassem:dstate-nextpos dstate)))))
-
-;;; ----------------------------------------------------------------
-
-(define-instruction (lui :disassem-control #'lui-note)
-  (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)))
-
-
-(defconstant mvsreg-printer '(:name :tab rd))
-
-(define-instruction (mfhi :use (high) :disassem-printer mvsreg-printer)
-  (register (op :constant special-op)
-	    (rd :argument register)
-	    (rs :constant 0)
-	    (rt :constant 0)
-	    (funct :constant #b010000)))
-
-(define-instruction (mthi :clobber (high) :disassem-printer mvsreg-printer)
-  (register (op :constant special-op)
-	    (rd :argument register)
-	    (rs :constant 0)
-	    (rt :constant 0)
-	    (funct :constant #b010001)))
-
-(define-instruction (mflo :use (low) :disassem-printer mvsreg-printer)
-  (register (op :constant special-op)
-	    (rd :argument register)
-	    (rs :constant 0)
-	    (rt :constant 0)
-	    (funct :constant #b010010)))
-
-(define-instruction (mtlo :clobber (low) :disassem-printer mvsreg-printer)
-  (register (op :constant special-op)
-	    (rd :argument register)
-	    (rs :constant 0)
-	    (rt :constant 0)
-	    (funct :constant #b010011)))
-
-
-(define-instruction (mult :clobber (low high) :disassem-printer divmul-printer)
-  (register (op :constant special-op)
-	    (rs :argument register)
-	    (rt :argument register)
-	    (rd :constant 0)
-	    (funct :constant #b011000)))
-
-(define-instruction (multu :clobber (low high)
-			   :disassem-printer divmul-printer)
-  (register (op :constant special-op)
-	    (rs :argument register)
-	    (rt :argument register)
-	    (rd :constant 0)
-	    (funct :constant #b011001)))
-
-(defconstant shift-printer
-  '(:name :tab
-	  rd
-	  (:unless (:same-as rd) ", " rt)
-	  ", " (:cond ((rs :constant 0) shamt)
-		      (t rs))))
-
-(define-instruction (sll :disassem-printer shift-printer)
-  (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 :disassem-printer shift-printer)
-  (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 :disassem-printer shift-printer)
-  (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 :pinned t :disassem-printer '(:name))
-  (register (op :constant special-op)
-	    (rd :constant 0)
-	    (rt :constant 0)
-	    (rs :constant 0)
-	    (funct :constant #b001100)))
+;;;; Math instructions.
+
+(defun emit-math-inst (segment dst src1 src2 reg-opcode immed-opcode
+			       &optional allow-fixups)
+  (unless src2
+    (setf src2 src1)
+    (setf src1 dst))
+  (etypecase src2
+    (tn
+     (emit-register-inst segment special-op (reg-tn-encoding src1)
+			 (reg-tn-encoding src2) (reg-tn-encoding dst)
+			 0 reg-opcode))
+    (integer
+     (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
+			  (reg-tn-encoding dst) src2))
+    (fixup
+     (unless allow-fixups
+       (error "Fixups aren't allowed."))
+     (note-fixup segment :addi src2)
+     (emit-immediate-inst segment immed-opcode (reg-tn-encoding src1)
+			  (reg-tn-encoding dst) 0))))
+
+(define-instruction add (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (signed-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100000 #b001000)))
+
+(define-instruction addu (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (signed-byte 16) fixup null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100001 #b001001 t)))
+
+(define-instruction sub (segment dst src1 &optional src2)
+  (:declare
+   (type tn dst)
+   (type (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (unless src2
+     (setf src2 src1)
+     (setf src1 dst))
+   (emit-math-inst segment dst src1
+		   (if (integerp src2) (- src2) src2)
+		   #b100010 #b001000)))
+
+(define-instruction subu (segment dst src1 &optional src2)
+  (:declare
+   (type tn dst)
+   (type
+    (or tn (integer #.(- 1 (ash 1 15)) #.(ash 1 15)) fixup null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (unless src2
+     (setf src2 src1)
+     (setf src1 dst))
+   (emit-math-inst segment dst src1
+		   (if (integerp src2) (- src2) src2)
+		   #b100011 #b001001 t)))
+
+(define-instruction and (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100100 #b001100)))
+
+(define-instruction or (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100101 #b001101)))
+
+(define-instruction xor (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100110 #b001110)))
+
+(define-instruction nor (segment dst src1 &optional src2)
+  (:declare (type tn dst src1) (type (or tn null) src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b100111 #b000000)))
+
+(define-instruction slt (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (signed-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b101010 #b001010)))
+
+(define-instruction sltu (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (signed-byte 16) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-math-inst segment dst src1 src2 #b101011 #b001011)))
+
+(define-instruction div (segment src1 src2)
+  (:declare (type tn src1 src2))
+  (:reads (list src1 src2))
+  (:writes :hi-and-lo-regs)
+  (:delay 1)
+  (:emitter
+   (emit-register-inst segment special-op (reg-tn-encoding src1)
+		       (reg-tn-encoding src2) 0 0 #b011010)))
+
+(define-instruction divu (segment src1 src2)
+  (:declare (type tn src1 src2))
+  (:reads (list src1 src2))
+  (:writes :hi-and-low-regs)
+  (:delay 1)
+  (:emitter
+   (emit-register-inst segment special-op (reg-tn-encoding src1)
+		       (reg-tn-encoding src2) 0 0 #b011011)))
+
+(define-instruction mult (segment src1 src2)
+  (:declare (type tn src1 src2))
+  (:reads (list src1 src2))
+  (:writes :hi-and-low-regs)
+  (:delay 1)
+  (:emitter
+   (emit-register-inst segment special-op (reg-tn-encoding src1)
+		       (reg-tn-encoding src2) 0 0 #b011000)))
+
+(define-instruction multu (segment src1 src2)
+  (:declare (type tn src1 src2))
+  (:reads (list src1 src2))
+  (:writes :hi-and-low-regs)
+  (:delay 1)
+  (:emitter
+   (emit-register-inst segment special-op (reg-tn-encoding src1)
+		       (reg-tn-encoding src2) 0 0 #b011001)))
+
+(defun emit-shift-inst (segment opcode dst src1 src2)
+  (unless src2
+    (setf src2 src1)
+    (setf src1 dst))
+  (etypecase src2
+    (tn
+     (emit-register-inst segment special-op (reg-tn-encoding src2)
+			 (reg-tn-encoding src1) (reg-tn-encoding dst)
+			 0 (logior #b000100 opcode)))
+    ((unsigned-byte 5)
+     (emit-register-inst segment special-op 0 (reg-tn-encoding src1)
+			 (reg-tn-encoding dst) src2 opcode))))
+
+(define-instruction sll (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 5) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-shift-inst segment #b00 dst src1 src2)))
+
+(define-instruction sra (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 5) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-shift-inst segment #b11 dst src1 src2)))
+
+(define-instruction srl (segment dst src1 &optional src2)
+  (:declare (type tn dst)
+	    (type (or tn (unsigned-byte 5) null) src1 src2))
+  (:reads (if src2 (list src1 src2) (list dst src1)))
+  (:writes dst)
+  (:emitter
+   (emit-shift-inst segment #b10 dst src1 src2)))
 
+
+;;;; Floating point math.
+
+(define-instruction float-op (segment operation format dst src1 src2)
+  (:declare (type float-operation operation)
+	    (type float-format format)
+	    (type tn dst src1 src2))
+  (:reads (list src1 src2))
+  (:writes dst)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format)
+		    (fp-reg-tn-encoding src2) (fp-reg-tn-encoding src1)
+		    (fp-reg-tn-encoding dst) (float-operation operation))))
+
+(define-instruction fabs (segment format dst &optional (src dst))
+  (:declare (type float-format format) (type tn dst src))
+  (:reads src)
+  (:writes dst)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format)
+		    0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
+		    #b000101)))
+
+(define-instruction fneg (segment format dst &optional (src dst))
+  (:declare (type float-format format) (type tn dst src))
+  (:reads src)
+  (:writes dst)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format)
+		    0 (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
+		    #b000111)))
+  
+(define-instruction fcvt (segment format1 format2 dst src)
+  (:declare (type float-format format1 format2) (type tn dst src))
+  (:reads src)
+  (:writes dst)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format2) 0
+		    (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
+		    (logior #b100000 (float-format-value format1)))))
+
+(define-instruction fcmp (segment operation format fs ft)
+  (:declare (type compare-kind operation)
+	    (type float-format format)
+	    (type tn fs ft))
+  (:reads (list fs ft))
+  (:writes :float-status)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format) 
+		    (fp-reg-tn-encoding ft) (fp-reg-tn-encoding fs) 0
+		    (logior #b110000 (compare-kind operation)))))
 
 
-;;;; Floating point instructions.
-
-;; rs is used as a sub-op code
-(defconstant sub-op-printer '(:name :tab rd ", " rt))
-
-(macrolet ((frob (name kind)
-	     `(define-instruction (,name :attributes (delayed-load)
-					 :disassem-printer sub-op-printer)
-		(register (op :constant #b010001)
-			  (rs :constant #b00100)
-			  (rd :argument ,kind)
-			  (rt :argument register)
-			  (funct :constant 0)))))
-  (frob mtc1 fp-reg)
-  (frob mtc1-odd odd-fp-reg))
-
-(macrolet ((frob (name kind)
-	     `(define-instruction (,name :attributes (delayed-load)
-					 :disassem-printer sub-op-printer)
-		(register (op :constant #b010001)
-			  (rs :constant #b00000)
-			  (rt :argument register :read nil :write t)
-			  (rd :argument ,kind :write nil :read t)
-			  (funct :constant 0)))))
-  (frob mfc1 fp-reg)
-  (frob mfc1-odd odd-fp-reg))
-
-(define-instruction (cfc1 :use (float-status)
-			  :attributes (delayed-load)
-			  :disassem-printer sub-op-printer)
-  (register (op :constant #b010001)
-	    (rs :constant #b00010)
-	    (rt :argument register :read nil :write t)
-	    (rd :argument control-register :write nil)
-	    (funct :constant 0)))
-
-(define-instruction (ctc1 :use (float-status)
-			  :clobber (float-status)
-			  :attributes (delayed-load)
-			  :disassem-printer sub-op-printer)
-  (register (op :constant #b010001)
-	    (rs :constant #b00110)
-	    (rt :argument register)
-	    (rd :argument control-register :write nil)
-	    (funct :constant 0)))
-
-(define-instruction (float-op
-		     :disassem-printer
-		       '('f funct "." format
-			    :tab
-			    fd
-			    (:unless (:same-as fd) ", " fs)
-			    ", " ft))
-  (float (funct :argument float-operation :mask #b11)
-	 (format :argument float-format)
-	 (fd :argument fp-reg)
-	 (fs :argument fp-reg)
-	 (ft :argument fp-reg)))
-
-
-(defconstant float-unop-printer
-  `(:name ,@float-fmt-printer :tab fd (:unless (:same-as fd) ", " fs)))
-
-(define-instruction (fabs :disassem-printer float-unop-printer)
-  (float (format :argument float-format)
-	 (ft :constant 0)
-	 (fd :argument fp-reg)
-	 (fs :argument fp-reg)
-	 (funct :constant #b000101))
-  (float (format :argument float-format)
-	 (ft :constant 0)
-	 (fd :argument fp-reg)
-	 (fs :same-as fd)
-	 (funct :constant #b000101)))
-
-(define-instruction (fneg :disassem-printer float-unop-printer)
-  (float (format :argument float-format)
-	 (ft :constant 0)
-	 (fd :argument fp-reg)
-	 (fs :argument fp-reg)
-	 (funct :constant #b000111))
-  (float (format :argument float-format)
-	 (ft :constant 0)
-	 (fd :argument fp-reg)
-	 (fs :same-as fd)
-	 (funct :constant #b000111)))
-
-(define-instruction (fcvt
-		     :disassem-printer
-		       `(:name "." sub-funct "." format
-			       :tab
-			       fd ", " fs))
-  (float-aux (sub-funct :argument float-format)
-	     (format :argument float-format)
-	     (fd :argument fp-reg)
-	     (fs :argument fp-reg)
-	     (funct :constant #b10)))
+;;;; Branch/Jump instructions.
+
+(defun emit-relative-branch (segment opcode r1 r2 target)
+  (emit-back-patch segment 4
+		   #'(lambda (segment posn)
+		       (emit-immediate-inst segment
+					    opcode
+					    (if (fixnump r1)
+						r1
+						(reg-tn-encoding r1))
+					    (if (fixnump r2)
+						r2
+						(reg-tn-encoding r2))
+					    (ash (- (label-position target)
+						    (+ posn 4))
+						 -2)))))
+
+(define-instruction b (segment target)
+  (:declare (type label target))
+  (:attributes branch)
+  (:delay 1)
+  (:emitter
+   (emit-relative-branch segment #b000100 0 0 target)))
+
+
+(define-instruction beq (segment r1 r2-or-target &optional target)
+  (:declare (type tn r1)
+	    (type (or tn fixnum label) r2-or-target)
+	    (type (or label null) target))
+  (:attributes branch)
+  (:delay 1)
+  (:reads (list r1 r2-or-target))
+  (:emitter
+   (unless target
+     (setf target r2-or-target)
+     (setf r2-or-target 0))
+   (emit-relative-branch segment #b000100 r1 r2-or-target target)))
+
+(define-instruction bne (segment r1 r2-or-target &optional target)
+  (:declare (type tn r1)
+	    (type (or tn fixnum label) r2-or-target)
+	    (type (or label null) target))
+  (:attributes branch)
+  (:delay 1)
+  (:reads (list r1 r2-or-target))
+  (:emitter
+   (unless target
+     (setf target r2-or-target)
+     (setf r2-or-target 0))
+   (emit-relative-branch segment #b000101 r1 r2-or-target target)))
+
+(define-instruction blez (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:emitter
+   (emit-relative-branch segment #b000110 reg 0 target)))
+
+(define-instruction bgtz (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:emitter
+   (emit-relative-branch segment #b000111 reg 0 target)))
+
+(define-instruction bltz (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:emitter
+   (emit-relative-branch segment bcond-op reg #b00000 target)))
+
+(define-instruction bgez (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:emitter
+   (emit-relative-branch segment bcond-op reg #b00001 target)))
+
+(define-instruction bltzal (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:writes :r31)
+  (:emitter
+   (emit-relative-branch segment bcond-op reg #b01000 target)))
+
+(define-instruction bgezal (segment reg target)
+  (:declare (type label target) (type tn reg))
+  (:attributes branch)
+  (:delay 1)
+  (:reads reg)
+  (:writes :r31)
+  (:emitter
+   (emit-relative-branch segment bcond-op reg #b01001 target)))
+
+(define-instruction j (segment target)
+  (:declare (type (or tn fixup) target))
+  (:attributes branch)
+  (:delay 1)
+  (:emitter
+   (etypecase target
+     (tn
+      (emit-register-inst segment special-op (reg-tn-encoding target)
+			  0 0 0 #b001000))
+     (fixup
+      (note-fixup segment :jump target)
+      (emit-jump-inst segment #b000010 0)))))
+
+(define-instruction jal (segment reg-or-target &optional target)
+  (:declare (type (or null tn fixup) target)
+	    (type (or tn fixup (integer -16 31)) reg-or-target))
+  (:attributes branch)
+  (:delay 1)
+  (:writes (if target (reg-tn-location reg-or-target) :r31))
+  (:emitter
+   (unless target
+     (setf target reg-or-target)
+     (setf reg-or-target 31))
+   (etypecase target
+     (tn
+      (emit-register-inst segment special-op (reg-tn-encoding target) 0
+			  reg-or-target 0 #b001001))
+     (fixup
+      (note-fixup segment :jump target)
+      (emit-jump-inst segment #b000011 0)))))
+
+(define-instruction bc1f (segment target)
+  (:declare (type label target))
+  (:reads :float-status)
+  (:attributes branch)
+  (:delay 1)
+  (:emitter
+   (emit-relative-branch segment cop1-op #b01000 #b00000 target)))
+
+(define-instruction bc1t (segment target)
+  (:declare (type label target))
+  (:reads :float-status)
+  (:attributes branch)
+  (:delay 1)
+  (:emitter
+   (emit-relative-branch segment cop1-op #b01000 #b00001 target)))
 
-  
-(define-instruction (fcmp
-		     :disassem-printer
-		       `(:name "-" sub-funct "." format
-			       :tab
-			       fs ", " ft))
-  (float-aux (sub-funct :argument compare-kind)
-	     (format :argument float-format)
-	     (fd :constant 0)
-	     (fs :argument fp-reg)
-	     (ft :argument fp-reg)
-	     (funct :constant #b11)))
 
 
-;;;; Pseudo-instructions
-
-(define-instruction (move
-		     :disassem-printer
-		     '(:name
-		       :tab
-		       (:choose rd fd) ", "
-		       (:choose rs fs)))
-  (register (op :constant special-op)
-	    (rd :argument register)
-	    (rs :argument register)
-	    (rt :constant 0)
-	    (funct :constant #b100001))
-  (float (format :argument float-format)
-	 (fd :argument fp-reg)
-	 (fs :argument fp-reg)
-	 (ft :constant 0)
-	 (funct :constant #b000110)))
-
-(define-pseudo-instruction li 64 (reg value)
+;;;; Random movement instructions.
+
+(define-instruction lui (segment reg value)
+  (:declare (type tn reg)
+	    (type (or fixup (signed-byte 16) (unsigned-byte 16)) value))
+  (:reads)
+  (:writes reg)
+  (:emitter
+   (when (fixup-p value)
+     (note-fixup segment :lui value)
+     (setf value 0))
+   (emit-immediate-inst segment #b001111 0 (reg-tn-encoding reg) value)))
+
+(define-instruction mfhi (segment reg)
+  (:declare (type tn reg))
+  (:reads :hi-and-low-regs)
+  (:writes reg)
+  (:emitter
+   (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
+			#b010000)))
+
+(define-instruction mthi (segment reg)
+  (:declare (type tn reg))
+  (:reads reg)
+  (:writes :hi-and-low-regs)
+  (:delay 1) ;; ### Is there a delay here?
+  (:emitter
+   (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
+			#b010001)))
+
+(define-instruction mflo (segment reg)
+  (:declare (type tn reg))
+  (:reads :hi-and-low-regs)
+  (:writes reg)
+  (:emitter
+   (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
+			#b010010)))
+
+(define-instruction mtlo (segment reg)
+  (:declare (type tn reg))
+  (:writes :hi-and-low-regs)
+  (:delay 1) ;; ### Is there a delay here?
+  (:emitter
+   (emit-register-inst segment special-op 0 0 (reg-tn-encoding reg) 0
+			#b010011)))
+
+(define-instruction move (segment dst src)
+  (:declare (type tn dst src))
+  (:reads src)
+  (:writes dst)
+  (:attributes flushable)
+  (:emitter
+   (emit-register-inst segment special-op (reg-tn-encoding src) 0
+		       (reg-tn-encoding dst) 0 #b100001)))
+
+(define-instruction fmove (segment format dst src)
+  (:declare (type float-format format) (type tn dst src))
+  (:reads src)
+  (:writes dst)
+  (:attributes flushable)
+  (:emitter
+   (emit-float-inst segment cop1-op 1 (float-format-value format) 0
+		    (fp-reg-tn-encoding src) (fp-reg-tn-encoding dst)
+		    #b000110)))
+
+(defun %li (reg value)
   (etypecase value
     ((unsigned-byte 16)
      (inst or reg zero-tn value))
@@ -983,119 +580,338 @@
      (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))))
+     (inst or reg (ldb (byte 16 0) value)))
     (fixup
      (inst lui reg value)
      (inst addu reg value))))
-
-(define-instruction (b :pinned t
-		       :attributes (relative-branch unconditional-branch
-						    delayed-branch)
-		       :disassem-printer '(:name :tab immediate))
-  (immediate (op :constant #b000100)
-	     (rs :constant 0)
-	     (rt :constant 0)
-	     (immediate :argument relative-label)))
-
-(define-instruction (nop :attributes (nop)
-			 :disassem-printer '(:name))
-  (register (op :constant 0)
-	    (rd :constant 0)
-	    (rt :constant 0)
-	    (rs :constant 0)
-	    (funct :constant 0)))
-
-(define-format (word-format 32 :pinned t)
-  (data (byte 32 0)))
-(define-instruction (word :cost 0)
-  (word-format (data :argument (or (unsigned-byte 32) (signed-byte 32)))))
-
-(define-format (short-format 16 :pinned t)
-  (data (byte 16 0)))
-(define-instruction (short :cost 0)
-  (short-format (data :argument (or (unsigned-byte 16) (signed-byte 16)))))
-
-(define-format (byte-format 8 :pinned t)
-  (data (byte 8 0)))
-(define-instruction (byte :cost 0)
-  (byte-format (data :argument (or (unsigned-byte 8) (signed-byte 8)))))
+  
+(define-instruction-macro li (reg value)
+  `(%li ,reg ,value))
+
+(define-instruction mtc1 (segment to from)
+  (:declare (type tn to from))
+  (:reads from)
+  (:writes to)
+  (:delay 1) ;; ### Is this delay correct?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
+		       (fp-reg-tn-encoding to) 0 0)))
+
+(define-instruction mtc1-odd (segment to from)
+  (:declare (type tn to from))
+  (:reads from)
+  (:writes to)
+  (:delay 1) ;; ### Is this delay correct?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00100 (reg-tn-encoding from)
+		       (1+ (fp-reg-tn-encoding to)) 0 0)))
+
+(define-instruction mfc1 (segment to from)
+  (:declare (type tn to from))
+  (:reads from)
+  (:writes to)
+  (:delay 1) ;; ### Is this delay correct?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding to)
+		       (fp-reg-tn-encoding from) 0 0)))
+
+(define-instruction mfc1-odd (segment to from)
+  (:declare (type tn to from))
+  (:reads from)
+  (:writes to)
+  (:delay 1) ;; ### Is this delay correct?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00000 (1+ (reg-tn-encoding to))
+		       (fp-reg-tn-encoding from) 0 0)))
+
+(define-instruction cfc1 (segment reg cr)
+  (:declare (type tn reg) (type (unsigned-byte 5) cr))
+  ;; ### reads/writes for this?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00000 (reg-tn-encoding reg)
+		       cr 0 0)))
+
+(define-instruction ctc1 (segment reg cr)
+  (:declare (type tn reg) (type (unsigned-byte 5) cr))
+  ;; ### reads/writes for this?
+  (:emitter
+   (emit-register-inst segment cop1-op #b00110 (reg-tn-encoding reg)
+		       cr 0 0)))
 
 
 
-;;;; Function and LRA Headers emitters and calculation stuff.
-
-(define-format (entry-point 0 :pinned t))
-(define-instruction (entry-point)
-  (entry-point))
-
-(defun header-data (ignore)
-  (declare (ignore ignore))
-  (ash (+ *current-position* (component-header-length)) (- vm:word-shift)))
-
-(define-format (header-object 32 :pinned t)
-  (type (byte 8 0))
-  (data (byte 24 8) :default 0 :function header-data))
-
-(define-instruction (function-header-word)
-  (header-object (type :constant vm:function-header-type)))
-
-(define-instruction (lra-header-word)
-  (header-object (type :constant vm:return-pc-header-type)))
-
-
-(defmacro define-compute-instruction (name calculation)
-  (let ((addui (symbolicate name "-ADDUI"))
-	(lui (symbolicate name "-LUI"))
-	(ori (symbolicate name "-ORI")))
-    `(progn
-       (defun ,name (label)
-	 (let ((result ,calculation))
-	   (assert (typep result '(signed-byte 16)))
-	   result))
-       (define-instruction (,addui)
-	 (immediate (op :constant #b001001)
-		    (rt :argument register)
-		    (rs :argument register)
-		    (immediate :argument label
-			       :function ,name)))
-       (define-instruction (,lui)
-	 (immediate (op :constant #b001111)
-		    (rs :constant 0)
-		    (rt :argument register :read t)
-		    (immediate :argument label
-			       :function (lambda (label)
-					   (ash ,calculation -16)))))
-       (define-instruction (,ori)
-	 (immediate (op :constant #b001101)
-		    (rt :argument register)
-		    (rs :same-as rt)
-		    (immediate :argument label
-
-			       :function (lambda (label)
-					   (logand ,calculation #xffff)))))
-       (define-pseudo-instruction ,name 96 (dst src label temp)
-	 (cond ((typep ,calculation '(signed-byte 16))
-		(inst ,addui dst src label))
-	       (t
-		(inst ,lui temp label)
-		(inst ,ori temp label)
-		(inst addu dst src temp)))))))
-
+;;;; Random system hackery and other noise
+
+(define-instruction-macro entry-point ()
+  nil)
+
+(define-emitter emit-break-inst 32
+  (byte 6 26) (byte 10 16) (byte 10 6) (byte 6 0))
+
+(define-instruction break (segment code &optional (subcode 0))
+  (:declare (type (unsigned-byte 10) code subcode))
+  :pinned
+  (:emitter
+   (emit-break-inst segment special-op code subcode #b001101)))
+
+(define-instruction syscall (segment)
+  :pinned
+  (:emitter
+   (emit-register-inst segment special-op 0 0 0 0 #b001100)))
+
+(define-instruction nop (segment)
+  (:attributes flushable)
+  (:emitter
+   (emit-word segment 0)))
+
+(define-instruction word (segment word)
+  (:declare (type (or (unsigned-byte 32) (signed-byte 32)) word))
+  :pinned
+  (:emitter
+   (emit-word segment word)))
+
+(define-instruction short (segment short)
+  (:declare (type (or (unsigned-byte 16) (signed-byte 16)) short))
+  :pinned
+  (:emitter
+   (emit-short segment short)))
+
+(define-instruction byte (segment byte)
+  (:declare (type (or (unsigned-byte 8) (signed-byte 8)) byte))
+  :pinned
+  (:emitter
+   (emit-byte segment byte)))
+
+
+(defun emit-header-data (segment type)
+  (emit-back-patch
+   segment 4
+   #'(lambda (segment posn)
+       (emit-word segment
+		  (logior type
+			  (ash (+ posn (component-header-length))
+			       (- type-bits word-shift)))))))
+
+(define-instruction function-header-word (segment)
+  :pinned
+  (:emitter
+   (emit-header-data segment function-header-type)))
+
+(define-instruction lra-header-word (segment)
+  :pinned
+  (:emitter
+   (emit-header-data segment return-pc-header-type)))
+
+
+(defun emit-compute-inst (segment vop dst src label temp calc)
+  (emit-chooser
+   ;; We emit either 12 or 4 bytes, so we maintain 8 byte alignments.
+   segment 12 3
+   #'(lambda (segment posn delta-if-after)
+       (let ((delta (funcall calc label posn delta-if-after)))
+	  (when (<= (- (ash 1 16)) delta (1- (ash 1 16)))
+	    (emit-back-patch segment 4
+			     #'(lambda (segment posn)
+				 (assemble (segment vop)
+					   (inst addu dst src
+						 (funcall calc label posn 0)))))
+	    t)))
+   #'(lambda (segment posn)
+       (let ((delta (funcall calc label posn 0)))
+	 (assemble (segment vop)
+		   (inst lui temp (ldb (byte 16 16) delta))
+		   (inst or temp (ldb (byte 16 0) delta))
+		   (inst addu dst src temp))))))
 
 ;; code = fn - header - label-offset + other-pointer-tag
-(define-compute-instruction compute-code-from-fn
-			    (- vm:other-pointer-type
-			       (label-position label)
-			       (component-header-length)))
+(define-instruction compute-code-from-fn (segment dst src label temp)
+  (:declare (type tn dst src temp) (type label label))
+  (:reads src)
+  (:writes (list dst temp))
+  (:vop-var vop)
+  (:emitter
+   (emit-compute-inst segment vop dst src label temp
+		      #'(lambda (label posn delta-if-after)
+			  (- other-pointer-type
+			     (label-position label posn delta-if-after)
+			     (component-header-length))))))
 
 ;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
-(define-compute-instruction compute-code-from-lra
-			    (- (+ (label-position label)
-				  (component-header-length))))
+(define-instruction compute-code-from-lra (segment dst src label temp)
+  (:declare (type tn dst src temp) (type label label))
+  (:reads src)
+  (:writes (list dst temp))
+  (:vop-var vop)
+  (:emitter
+   (emit-compute-inst segment vop dst src label temp
+		      #'(lambda (label posn delta-if-after)
+			  (- (+ (label-position label posn delta-if-after)
+				(component-header-length)))))))
 
 ;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
-(define-compute-instruction compute-lra-from-code
-			    (+ (label-position label)
-			       (component-header-length)))
+(define-instruction compute-lra-from-code (segment dst src label temp)
+  (:declare (type tn dst src temp) (type label label))
+  (:reads src)
+  (:writes (list dst temp))
+  (:vop-var vop)
+  (:emitter
+   (emit-compute-inst segment vop dst src label temp
+		      #'(lambda (label posn delta-if-after)
+			  (+ (label-position label posn delta-if-after)
+			     (component-header-length))))))
+
+
+;;;; Loads and Stores
+
+(defun emit-load/store-inst (segment opcode reg base index)
+  (when (fixup-p index)
+    (note-fixup segment :addi index)
+    (setf index 0))
+  (emit-immediate-inst segment opcode (reg-tn-encoding reg)
+		       (reg-tn-encoding base) index))
+
+(define-instruction lb (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100000 base reg index)))
+
+(define-instruction lh (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100001 base reg index)))
+
+(define-instruction lwl (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100010 base reg index)))
+
+(define-instruction lw (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100011 base reg index)))
+
+(define-instruction lbu (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100100 base reg index)))
+
+(define-instruction lhu (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100101 base reg index)))
+
+(define-instruction lwr (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads (list base :memory))
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-load/store-inst segment #b100110 base reg index)))
+
+(define-instruction sb (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-load/store-inst segment #b101000 base reg index)))
+
+(define-instruction sh (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-load/store-inst segment #b101001 base reg index)))
+
+(define-instruction swl (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-load/store-inst segment #b101010 base reg index)))
+
+(define-instruction sw (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-load/store-inst segment #b101011 base reg index)))
+
+(define-instruction swr (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-load/store-inst segment #b101110 base reg index)))
+
+
+(defun emit-fp-load/store-inst (segment opcode reg odd base index)
+  (when (fixup-p index)
+    (note-fixup segment :addi index)
+    (setf index 0))
+  (emit-immediate-inst segment opcode (reg-tn-encoding base)
+		       (+ (fp-reg-tn-encoding reg) odd) index))
+
+(define-instruction lwc1 (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base :memory)
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-fp-load/store-inst segment #b110001 reg 0 base index)))
+
+(define-instruction lwc1-odd (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base :memory)
+  (:writes reg)
+  (:delay 1)
+  (:emitter
+   (emit-fp-load/store-inst segment #b110001 reg 1 base index)))
+
+(define-instruction swc1 (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-fp-load/store-inst segment #b111001 reg 0 base index)))
+
+(define-instruction swc1-odd (segment reg base &optional (index 0))
+  (:declare (type tn reg base)
+	    (type (or (signed-byte 16) fixup) index))
+  (:reads base reg)
+  (:writes :memory)
+  (:emitter
+   (emit-fp-load/store-inst segment #b111001 reg 1 base index)))
+