diff --git a/code/bit-bash.lisp b/code/bit-bash.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..e3716279f389b557ec34f84f041decffc35eae29
--- /dev/null
+++ b/code/bit-bash.lisp
@@ -0,0 +1,296 @@
+;;; -*- Log: code.log; Package: Lisp -*-
+;;;
+;;; **********************************************************************
+;;; 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 Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; Functions to implement bit bashing.
+;;;
+;;; Written by William Lott.
+;;;
+
+(in-package "LISP")
+
+
+
+;;;; Constants and Types.
+
+
+(eval-when (compile load eval)
+
+(defconstant unit-bits 16
+  "The number of bits to process at a time.")
+
+(defconstant max-bits (ash most-positive-fixnum -2)
+  "The maximum number of bits that can be delt with during a single call.")
+
+
+(deftype unit ()
+  `(signed-byte ,unit-bits))
+
+(deftype offset ()
+  `(integer 0 ,max-bits))
+
+(deftype bit-offset ()
+  `(integer 0 (,unit-bits)))
+
+(deftype word-offset ()
+  `(integer 0 (,(ceiling max-bits unit-bits))))
+
+
+); eval-when
+
+
+
+;;;; Macros for generating bit-bashing routines.
+
+
+(eval-when (compile eval)
+
+(defmacro end-bits (count)
+  "Returns the byte spec for COUNT bits at the end of a word, i.e. the bits
+  at the largest address."
+  (ecase vm:target-byte-order
+    (:little-endian `(byte ,count (- unit-bits ,count)))
+    (:big-endian `(byte ,count 0))))
+
+(defmacro start-bits (count)
+  "Returns the byte spec for COUNT bits at the start of a word, i.e. the bits
+  at the smallest address."
+  (ecase vm:target-byte-order
+    (:little-endian `(byte ,count 0))
+    (:big-endian `(byte ,count (- unit-bits ,count)))))
+
+(defmacro middle-bits (count where)
+  "Return the byte spec for COUNT bits starting at bit WHERE.  WHERE of zero
+  corresponds to the start of the word (lowest address) and WHERE of
+  unit-bits corresponds to the end of the word (highest address).  In other
+  words, act like :little-endian"
+  (ecase vm:target-byte-order
+    (:little-endian `(byte ,count ,where))
+    (:big-endian `(byte ,count (- unit-bits ,where ,count)))))
+
+
+
+(defmacro merge-bits (shift prev next)
+  "Return (ldb (byte 32 0) (ash (logior (ash prev 32) next) shift)) but stay
+  out of bignum land."
+  `(logior (the unit (ash (ldb (byte (- unit-bits ,shift) 0) ,prev)
+			  (- unit-bits ,shift)))
+	   (ash ,next (- ,shift))))
+
+
+
+(defmacro bit-bash-bindings (&body guts)
+  `(let* ((final-bits (mod (+ len dst-bit-offset) unit-bits))
+	  (interior (floor (- len final-bits) unit-bits)))
+     (declare (type bit-offset final-bits)
+	      (type word-offset interior))
+     ,@guts))
+
+(defmacro bind-srcs ((kind incf-p ref-fn) &body body)
+  (ecase kind
+    (:constant `(progn
+		  ,@body
+		  ,@(when incf-p
+		      `((incf dst-word-offset)))))
+    (:unary `(let ((next-1 (,ref-fn src-1 src-1-word-offset)))
+	       (declare (type unit next-1))
+	       ,@body
+	       ,@(when incf-p
+		   '((incf dst-word-offset)
+		     (incf src-1-word-offset)))))
+    (:binary `(let ((next-1 (,ref-fn src-1 src-1-word-offset))
+		    (next-2 (,ref-fn src-2 src-2-word-offset)))
+		(declare (type unit next-1 next-2))
+		,@body
+		,@(when incf-p
+		   '((incf dst-word-offset)
+		     (incf src-1-word-offset)
+		     (incf src-2-word-offset)))))))
+
+
+(defmacro bit-bash-loop (kind ref-fn function &optional update)
+  `(progn
+     (unless (zerop dst-bit-offset)
+       (bind-srcs (,kind t ,ref-fn)
+	 (setf (ldb (end-bits (- unit-bits dst-bit-offset))
+		    (,ref-fn dst dst-word-offset))
+	       ,function)
+	 ,update))
+     (dotimes (count interior)
+       (declare (type word-offset count))
+       (bind-srcs (,kind t ,ref-fn)
+	 (setf (,ref-fn dst dst-word-offset) ,function)
+	 ,update))
+     (unless (zerop final-bits)
+       (bind-srcs (,kind nil ,ref-fn)
+	 (setf (ldb (start-bits final-bits)
+		    (,ref-fn dst dst-word-offset))
+	       (ldb (start-bits final-bits)
+		    ,function))))))
+
+
+(defun pick-args (op kind arg1 arg2)
+  (ecase kind
+    (:constant
+     op)
+    (:unary
+     (list op arg1))
+    (:binary
+     (list op arg1 arg2))))
+
+(defmacro def-bit-basher (name op &optional (kind :binary) (ref-fn '%raw-bits))
+  (let ((form
+	 `(cond
+	   ((<= (+ dst-bit-offset len) unit-bits)
+	    ;; It's narrow.
+	    (setf (ldb (middle-bits len dst-bit-offset)
+		       (,ref-fn dst dst-word-offset))
+		  ,(pick-args op kind
+			      `(the unit
+				    (ldb (middle-bits (the bit-offset len)
+						      src-1-bit-offset)
+					 (,ref-fn src-1 src-1-word-offset)))
+			      `(the unit
+				    (ldb (middle-bits (the bit-offset len)
+						      src-2-bit-offset)
+					 (,ref-fn src-2
+						  src-2-word-offset))))))
+	   (,(ecase kind
+	       (:constant t)
+	       (:unary '(= src-1-bit-offset dst-bit-offset))
+	       (:binary '(= src-1-bit-offset src-2-bit-offset dst-bit-offset )))
+	    ;; Everything is aligned evenly.
+	    (bit-bash-bindings
+	     (bit-bash-loop ,kind ,ref-fn
+	       ,(pick-args op kind 'next-1 'next-2))))
+	   ,@(when (eq kind :binary)
+	       `(((= src-1-bit-offset dst-bit-offset)
+		  ;; Src1 and the destination are aligned, but src2 is not.
+		  (bit-bash-bindings
+		   (when (> dst-bit-offset src-2-bit-offset)
+		     (decf src-2-word-offset))
+		   (let* ((src-2-shift
+			   (mod (- dst-offset src-2-offset) unit-bits))
+			  (prev-2 (,ref-fn src-2 src-2-word-offset)))
+		     (declare (type bit-offset src-2-shift))
+		     (declare (type unit prev-2))
+		     (incf src-2-word-offset)
+		     (bit-bash-loop ,kind ,ref-fn
+		       (,op next-1 (merge-bits src-2-shift prev-2 next-2))
+		       (setf prev-2 next-2)))))
+		 ((= src-2-bit-offset
+		     dst-bit-offset)
+		  ;; Src2 and the destination are aligned, but src1 is not.
+		  (bit-bash-bindings
+		   (when (> dst-bit-offset src-1-bit-offset)
+		     (decf src-1-word-offset))
+		   (let* ((src-1-shift
+			   (mod (- dst-offset src-1-offset) unit-bits))
+			  (prev-1 (,ref-fn src-1 src-1-word-offset)))
+		     (declare (type bit-offset src-1-shift))
+		     (declare (type unit prev-1))
+		     (incf src-1-word-offset)
+		     (bit-bash-loop ,kind ,ref-fn
+		       (,op (merge-bits src-1-shift prev-1 next-1) next-2)
+		       (setf prev-1 next-1)))))))
+	   ,@(unless (eq kind :constant)
+	       `((t
+		  ;; Nothing is aligned. Ack.
+		  (bit-bash-bindings
+		   (when (> dst-bit-offset src-1-bit-offset)
+		     (decf src-1-word-offset))
+		   ,@(when (eq kind :binary)
+		       '((when (> dst-bit-offset src-2-bit-offset)
+			   (decf src-2-word-offset))))
+		   (let* ((src-1-shift
+			   (mod (- dst-offset src-1-offset) unit-bits))
+			  (prev-1 (,ref-fn src-1 src-1-word-offset))
+			  ,@(when (eq kind :binary)
+			      `((src-2-shift
+				 (mod (- dst-offset src-2-offset) unit-bits))
+				(prev-2 (,ref-fn src-2 src-2-word-offset)))))
+		     (declare (type bit-offset src-1-shift
+				    ,@(when (eq kind :binary)
+					'(src-2-shift)))
+			      (type unit prev-1
+				    ,@(when (eq kind :binary) '(prev-2))))
+		     (incf src-1-word-offset)
+		     ,@(when (eq kind :binary)
+			 '((incf src-2-word-offset)))
+		     (bit-bash-loop ,kind ,ref-fn
+		       ,(pick-args op kind
+				   '(merge-bits src-1-shift prev-1 next-1)
+				   '(merge-bits src-2-shift prev-2 next-2))
+		       (setf prev-1 next-1
+			     ,@(when (eq kind :binary)
+				 '(prev-2 next-2)))))))))))
+	(function-args '(len))
+	(function-decls '(len)))
+    (dolist (arg (ecase kind
+		   (:constant '(dst))
+		   (:unary '(dst src-1))
+		   (:binary '(dst src-2 src-1))))
+      (let* ((name (string arg))
+	     (offset
+	      (intern (concatenate 'simple-string name "-OFFSET")))
+	     (bit-offset
+	      (intern (concatenate 'simple-string name "-BIT-OFFSET")))
+	     (word-offset
+	      (intern (concatenate 'simple-string name "-WORD-OFFSET"))))
+	(setf form
+	      `(multiple-value-bind (,word-offset ,bit-offset)
+				    (floor ,offset unit-bits)
+		 (declare (type word-offset ,word-offset)
+			  (type bit-offset ,bit-offset))
+		 ,form))
+	(push offset function-args)
+	(push offset function-decls)
+	(push arg function-args)))
+    `(defun ,name ,function-args
+       (declare (type offset ,@function-decls))
+       ,form)))
+
+); eval when
+
+
+;;;; The actual bashers.
+
+(proclaim '(optimize (speed 3) (safety 0)))
+
+
+;;; %raw-bits can be used to index into other-pointer objects.
+
+(defun %raw-bits (object offset)
+  (%raw-bits object offset))
+
+(defun (setf %raw-bits) (object offset value)
+  (setf (%raw-bits object offset) value))
+
+
+(def-bit-basher bit-bash-clear 0 :constant)
+(def-bit-basher bit-bash-set (1- (ash 1 unit-bits)) :constant)
+
+(def-bit-basher bit-bash-not lognot :unary)
+(def-bit-basher bit-bash-copy identity :unary)
+
+(def-bit-basher bit-bash-and logand)
+(def-bit-basher bit-bash-ior logior)
+(def-bit-basher bit-bash-xor logxor)
+(def-bit-basher bit-bash-eqv logeqv)
+(def-bit-basher bit-bash-nand lognand)
+(def-bit-basher bit-bash-nor lognor)
+(def-bit-basher bit-bash-andc1 logandc1)
+(def-bit-basher bit-bash-andc2 logandc2)
+(def-bit-basher bit-bash-orc1 logorc1)
+(def-bit-basher bit-bash-orc2 logorc2)
+
+
+;;; Sap-ref-16 can be used to index into SAP objects.
+
+(def-bit-basher system-area-clear 0 :constant sap-ref-16)
+(def-bit-basher system-area-copy identity :unary sap-ref-16)
diff --git a/code/mipsstrops.lisp b/code/mipsstrops.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..854d121d62b488c61912d68df4208bfcabfe79f0
--- /dev/null
+++ b/code/mipsstrops.lisp
@@ -0,0 +1,207 @@
+;;; -*- Log: Code.Log; Package: Lisp -*-
+;;;
+;;; **********************************************************************
+;;; 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 Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;;    String hacking functions that are stubs for things that might
+;;; be microcoded someday.
+;;;
+;;;    Written by Rob MacLachlan and Skef Wholey
+;;;
+(in-package "SYSTEM")
+(export '(%sp-reverse-find-character-with-attribute))
+
+(in-package "LISP")
+
+;(defun %sp-byte-blt (src-string src-start dst-string dst-start dst-end)
+;  "Moves bytes from Src-String into Dst-String between Dst-Start (inclusive)
+;and Dst-End (exclusive) (Dst-Start - Dst-End bytes are moved).  Overlap of the
+;strings does not affect the result.  This would be done on the Vax
+;with MOVC3. The arguments do not need to be strings: 8-bit U-Vectors
+;are also acceptable."
+;  (%primitive byte-blt src-string src-start dst-string dst-start dst-end))
+
+(defun %sp-string-compare (string1 start1 end1 string2 start2 end2)
+  (declare (simple-string string1 string2))
+  (declare (fixnum start1 end1 start2 end2))
+  "Compares the substrings specified by String1 and String2 and returns
+NIL if the strings are String=, or the lowest index of String1 in
+which the two differ. If one string is longer than the other and the
+shorter is a prefix of the longer, the length of the shorter + start1 is
+returned. This would be done on the Vax with CMPC3. The arguments must
+be simple strings."
+  (let ((len1 (- end1 start1))
+	(len2 (- end2 start2)))
+    (declare (fixnum len1 len2))
+    (cond
+     ((= len1 len2)
+      (do ((index1 start1 (1+ index1))
+	   (index2 start2 (1+ index2)))
+	  ((= index1 end1) nil)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1))))
+     ((> len1 len2)
+      (do ((index1 start1 (1+ index1))
+	   (index2 start2 (1+ index2)))
+	  ((= index2 end2) index1)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1))))
+     (t
+      (do ((index1 start1 (1+ index1))
+	   (index2 start2 (1+ index2)))
+	  ((= index1 end1) index1)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1)))))))
+
+(defun %sp-reverse-string-compare (string1 start1 end1 string2 start2 end2)
+  (declare (simple-string string1 string2))
+  (declare (fixnum start1 end1 start2 end2))
+  "Like %sp-string-compare, only backwards."
+  (let ((len1 (- end1 start1))
+	(len2 (- end2 start2)))
+    (declare (fixnum len1 len2))
+    (cond
+     ((= len1 len2)
+      (do ((index1 (1- end1) (1- index1))
+	   (index2 (1- end2) (1- index2)))
+	  ((< index1 start1) nil)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1))))
+     ((> len1 len2)
+      (do ((index1 (1- end1) (1- index1))
+	   (index2 (1- end2) (1- index2)))
+	  ((< index2 start2) index1)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1))))
+     (t
+      (do ((index1 (1- end1) (1- index1))
+	   (index2 (1- end2) (1- index2)))
+	  ((< index1 start1) index1)
+	(declare (fixnum index1 index2))
+	(if (char/= (elt string1 index1) (elt string2 index2))
+	    (return index1)))))))
+
+;(defun %sp-find-character-with-attribute (string start end table mask)
+;  (declare (type (simple-array (mod 256) char-code-max) table))
+;  (declare (simple-string string))
+;  (declare (fixnum start end))
+;  "%SP-Find-Character-With-Attribute  String, Start, End, Table, Mask
+;  The codes of the characters of String from Start to End are used as indices
+;  into the Table, which is a U-Vector of 8-bit bytes. When the number picked
+;  up from the table bitwise ANDed with Mask is non-zero, the current
+;  index into the String is returned. The corresponds to SCANC on the Vax."
+;  (%primitive find-character-with-attribute string start end table mask))
+
+;;;; ### Warning ###  ### Warning ###  ### Warning ###  ### Warning ###
+;;;
+;;;    This will lose big if a GC can happen during its execution, since
+;;; a pointer to after the header of the table is maintained.  Currently
+;;; GC's happen only immediately after allocation, so we're safe.
+;;;
+(defun %sp-reverse-find-character-with-attribute (string start end table mask)
+  "Like %SP-Find-Character-With-Attribute, only sdrawkcaB."
+  (declare (fixnum start end mask))
+  (incf start 8)
+  (do ((table (%primitive sap+ table 8))
+       (index (+ end 7) (1- index)))
+      ((< index start) nil)
+    (declare (fixnum index))
+    (unless (eql (logand (the fixnum
+			      (%primitive 8bit-system-ref table
+					  (%primitive 8bit-system-ref string index)))
+			 mask)
+		 0)
+      (return (- index 8)))))
+
+;(defun %sp-find-character (string start end character)
+;  "%SP-Find-Character  String, Start, End, Character
+;  Searches String for the Character from Start to End.  If the character is
+;  found, the corresponding index into String is returned, otherwise NIL is
+;  returned."
+;  (%primitive find-character string start end character))
+
+(defun %sp-skip-character (string start end character)
+  (declare (simple-string string))
+  (declare (fixnum start end))
+  "%SP-Skip-Character  String, Start, End, Character
+  Returns the index of the first character between Start and End which
+  is not Char=  to Character, or NIL if there is no such character."
+  (do ((index start (1+ index)))
+      ((= index end) nil)
+    (declare (fixnum index))
+    (if (char/= (char string index) character)
+	(return index))))
+
+(defun %sp-reverse-find-character (string start end character)
+  (declare (simple-string string))
+  (declare (fixnum start end))
+  "%SP-Reverse-Find-Character  String, Start, End, Character
+  Searches String for Character from End to Start.  If the character is
+  found, the corresponding index into String is returned, otherwise NIL is
+  returned."
+  (do ((index (1- end) (1- index))
+       (terminus (1- start)))
+      ((= index terminus) nil)
+    (declare (fixnum terminus index))
+    (if (char= (char string index) character)
+	(return index))))
+
+(defun %sp-reverse-skip-character (string start end character)
+  (declare (simple-string string))
+  (declare (fixnum start end))
+  "%SP-Skip-Character  String, Start, End, Character
+  Returns the index of the last character between Start and End which
+  is not Char=  to Character, or NIL if there is no such character."
+  (do ((index (1- end) (1- index))
+       (terminus (1- start)))
+      ((= index terminus) nil)
+    (declare (fixnum terminus index))
+    (if (char/= (char string index) character)
+	(return index))))
+
+(defun %sp-string-search (string1 start1 end1 string2 start2 end2)
+  "%SP-String-Search  String1, Start1, End1, String2, Start2, End2
+		Searches for the substring of String1 specified in String2.
+		Returns an index into String2 or NIL if the substring wasn't
+		found."
+  (do ((index2 start2 (1+ index2)))
+      ((= index2 end2) nil)
+    (if (do ((index1 start1 (1+ index1))
+	     (index2 index2 (1+ index2)))
+	    ((= index1 end1) t)
+	  (if (char/= (char string1 index1) (char string2 index2))
+	      (return nil)))
+	(return index2))))
+
+
+(defun %sp-char-upcase (character)
+  "%SP-Char-Upcase  Character
+  Returns a character with the same font and bits, but with an upper case
+  code if it was alphabetic."
+  (char-upcase character))
+
+(defun %sp-char-downcase (character)
+  "%SP-Char-Downcase  Character
+  Returns a character with the same font and bits, but with a lower
+  case character code if it was alphabetic."
+  (char-downcase character))
+
+(defun %sp-string-upcase (string start end)
+  "Creates a new string with the chars from start to end uppercased."
+  (string-upcase string :start start :end end))
+
+(defun %sp-string-downcase (string start end)
+  "Creates a new string with the chars from start to end lowercased."
+  (string-downcase string :start start :end end))
+
+;(defun %sp-sxhash-simple-string (string)
+;  (%primitive sxhash-simple-string string))