diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index 22f62f55e80902fa19f74ad1f6f8576d005e65d9..49e4c61e3ea420288b3cecdbd7cfa46bdead42ae 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.28 1990/12/08 19:57:15 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.29 1991/01/20 15:04:13 ram Exp $
 ;;;
 ;;;    This file contains stuff that knows about dumping FASL files.
 ;;;
@@ -34,6 +34,11 @@
 
 ;;;; Fasl dumper state:
 
+;;; We do some buffering in front of the stream that represents the output file
+;;; so as to speed things up a bit.
+;;;
+(defconstant fasl-buffer-size 2048)
+
 ;;; The Fasl-File structure represents everything we need to know about dumping
 ;;; to a fasl file.  We need to objectify the state, since the fasdumper must
 ;;; be reentrant.
@@ -41,13 +46,22 @@
 (defstruct (fasl-file
 	    (:print-function
 	     (lambda (s stream d)
-	       (declare (ignore d))
+	       (declare (ignore d) (stream stream))
 	       (format stream "#<Fasl-File ~S>"
 		       (namestring (fasl-file-stream s))))))
   ;;
   ;; The stream we dump to.
   (stream (required-argument) :type stream)
   ;;
+  ;; The buffer we accumulate output in before blasting it out to the stream
+  ;; with SYS:OUTPUT-RAW-BYTES.
+  (buffer (make-array fasl-buffer-size :element-type '(unsigned-byte 8))
+	  :type (simple-array (unsigned-byte 8) (*)))
+  ;;
+  ;; The index of the first free byte in Buffer.  Note that there is always at
+  ;; least one byte free.
+  (buffer-index 0 :type index)
+  ;;
   ;; Hashtables we use to keep track of dumped constants so that we can get
   ;; them from the table rather than dumping them again.  The EQUAL-TABLE is
   ;; used for lists and strings, and the EQ-TABLE is used for everything else.
@@ -58,7 +72,7 @@
   (eq-table (make-hash-table :test #'eq) :type hash-table)
   ;;
   ;; The table's current free pointer: the next offset to be used.
-  (table-free 0 :type unsigned-byte)
+  (table-free 0 :type index)
   ;;
   ;; Alist (Package . Offset) of the table offsets for each package we have
   ;; currently located.
@@ -80,10 +94,10 @@
   ;; information when the compilation is complete.
   (debug-info () :type list)
   ;;
-  ;; Used to keep track of objects that we are in the process of dumping so that
-  ;; circularities can be preserved.  The key is the object that we have
-  ;; previously seen, and the value is the object that we reference in the table
-  ;; to find this previously seen object.  (The value is never NIL.)
+  ;; Used to keep track of objects that we are in the process of dumping so
+  ;; that circularities can be preserved.  The key is the object that we have
+  ;; previously seen, and the value is the object that we reference in the
+  ;; table to find this previously seen object.  (The value is never NIL.)
   ;;
   ;; Except with list objects, the key and the value are always the same.  In a
   ;; list, the key will be some tail of the value.
@@ -101,7 +115,7 @@
   object
   ;;
   ;; Index in object for circularity.
-  (index (required-argument) :type unsigned-byte)
+  (index (required-argument) :type index)
   ;;
   ;; The object to be stored at Index in Object.  This is that the key that we
   ;; were using when we discovered the circularity.
@@ -127,27 +141,114 @@
 
 ;;;; Utilities:
 
+;;; FLUSH-FASL-FILE-BUFFER  --  Internal
+;;;
+;;;    Write out the contents of File's buffer to its stream.
+;;;
+(defun flush-fasl-file-buffer (file)
+  (system:output-raw-bytes (fasl-file-stream file)
+			   (fasl-file-buffer file)
+			   0
+			   (fasl-file-buffer-index file))
+  (setf (fasl-file-buffer-index file) 0)
+  (undefined-value))
+
+
 ;;; Dump-Byte  --  Internal
 ;;;
 ;;;    Write the byte B to the specified fasl-file stream.
 ;;;
-(proclaim '(inline dump-byte))
+(declaim (maybe-inline dump-byte))
 (defun dump-byte (b file)
-  (declare (type (unsigned-byte 8) b) (type fasl-file file))
-  (write-byte b (fasl-file-stream file))
+  (declare (type (unsigned-byte 8) b) (type fasl-file file)
+	   (optimize (speed 3) (safety 0)))
+  (let ((idx (fasl-file-buffer-index file))
+	(buf (fasl-file-buffer file)))
+    (setf (aref buf idx) b)
+    (let ((new (1+ idx)))
+      (setf (fasl-file-buffer-index file) new)
+      (when (= new fasl-buffer-size)
+	(flush-fasl-file-buffer file))))
   (undefined-value))
 
 
+;;; DUMP-UNSIGNED-32  --  Internal
+;;;
+;;;    Dump a 4 byte unsigned integer.
+;;;
+(defun dump-unsigned-32 (num file)
+  (declare (type (unsigned-byte 32) num) (type fasl-file file)
+	   (optimize (speed 3) (safety 0)))
+  (let* ((idx (fasl-file-buffer-index file))
+	 (buf (fasl-file-buffer file))
+	 (new (+ idx 4)))
+    (when (>= new fasl-buffer-size)
+      (flush-fasl-file-buffer file)
+      (setq idx 0  new 4))
+    (setf (aref buf (+ idx 0)) (ldb (byte 8 0) num))
+    (setf (aref buf (+ idx 1)) (ldb (byte 8 8) num))
+    (setf (aref buf (+ idx 2)) (ldb (byte 8 16) num))
+    (setf (aref buf (+ idx 3)) (ldb (byte 8 24) num))
+    (setf (fasl-file-buffer-index file) new))
+  (undefined-value))
+
+
+;;; Dump-Var-Signed   --  Internal
+;;;
+;;;    Dump Num to the fasl stream, represented by the specified number of
+;;; bytes.
+;;;
+(defun dump-var-signed  (num bytes file)
+  (declare (integer num) (type index bytes) (type fasl-file file)
+	   (inline dump-byte))
+  (do ((n num (ash n -8))
+       (i bytes (1- i)))
+      ((= i 0))
+    (declare (type index i))
+    (dump-byte (logand n #xFF) file))
+  (undefined-value))
+
+
+;;; DUMP-BYTES  --  Internal
+;;;
+;;;    Dump the first N bytes in Vec out to File.  Vec is some sort of unboxed
+;;; vector-like thing that we can BLT from.
+;;;
+(defun dump-bytes (vec n file)
+  (declare (type index n) (type fasl-file file)
+	   (optimize (speed 3) (safety 0)))
+  (let* ((idx (fasl-file-buffer-index file))
+	 (buf (fasl-file-buffer file))
+	 (new (+ idx n)))
+    (cond ((< new fasl-buffer-size)
+	   (bit-bash-copy vec vector-data-bit-offset
+			  buf
+			  (+ vector-data-bit-offset
+			     (the index (* idx vm:byte-bits)))
+			  (* n vm:byte-bits))
+	   (setf (fasl-file-buffer-index file) new))
+	  (t
+	   (flush-fasl-file-buffer file)
+	   (cond ((>= n fasl-buffer-size)
+		  (system:output-raw-bytes (fasl-file-stream file)
+					   vec 0 n))
+		 (t
+		  (bit-bash-copy vec vector-data-bit-offset
+				 buf vector-data-bit-offset
+				 (* n vm:byte-bits))
+		  (setf (fasl-file-buffer-index file) n))))))
+  (undefined-value))
+      
+
 ;;; Dump-FOP  --  Internal
 ;;;
 ;;;    Dump the FOP code for the named FOP to the specified fasl-file.
 ;;;
-(defun dump-fop (fs file)
-  (declare (symbol fs) (type fasl-file file))
-  (let ((val (get fs 'lisp::fop-code)))
+(defmacro dump-fop (fs file)
+  (let* ((fs (eval fs))
+	 (val (get fs 'lisp::fop-code)))
     (assert val () "Compiler bug: ~S not a legal fasload operator." fs)
-    (dump-byte val file))
-  (undefined-value))
+    `(dump-byte ',val ,file)))
 
 
 ;;; Dump-FOP*  --  Internal
@@ -163,22 +264,7 @@
 	    (dump-byte ,n-n ,n-file))
 	   (t
 	    (dump-fop ',word-fop ,n-file)
-	    (quick-dump-number ,n-n 4 ,n-file)))))
-
-
-;;; Quick-Dump-Number  --  Internal
-;;;
-;;;    Dump Num to the fasl stream, represented by the specified number of
-;;; bytes.
-;;;
-(defun quick-dump-number (num bytes file)
-  (declare (integer num) (type unsigned-byte bytes) (type fasl-file file))
-  (let ((stream (fasl-file-stream file)))
-    (do ((n num (ash n -8))
-	 (i bytes (1- i)))
-	((= i 0))
-      (write-byte (logand n #xFF) stream)))
-  (undefined-value))
+	    (dump-unsigned-32 ,n-n ,n-file)))))
 
 
 ;;; Dump-Push  --  Internal
@@ -186,7 +272,7 @@
 ;;;    Push the object at table offset Handle on the fasl stack.
 ;;;
 (defun dump-push (handle file)
-  (declare (type unsigned-byte handle) (type fasl-file file))
+  (declare (type index handle) (type fasl-file file))
   (dump-fop* handle lisp::fop-byte-push lisp::fop-push file)
   (undefined-value))
 
@@ -324,8 +410,9 @@
   (assert (zerop (hash-table-count (fasl-file-patch-table 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)
+  (dump-unsigned-32 (fasl-file-table-free file) file)
   (dump-fop 'lisp::fop-end-group file)
+  (flush-fasl-file-buffer file)
   (close (fasl-file-stream file) :abort abort-p)
   (undefined-value))
 
@@ -348,7 +435,8 @@
 ;;; actually filled in by the loader.
 ;;;
 (defun dump-code-object (component code-segment code-length file)
-  (declare (type component component) (type fasl-file file))
+  (declare (type component component) (type fasl-file file)
+	   (type index code-length))
   (let* ((2comp (component-info component))
 	 (constants (ir2-component-constants 2comp))
 	 (num-consts (length constants)))
@@ -391,12 +479,13 @@
 	(cond ((and (< num-consts #x100) (< code-length #x10000))
 	       (dump-fop 'lisp::fop-small-code file)
 	       (dump-byte num-consts file)
-	       (quick-dump-number code-length 2 file))
+	       (dump-var-signed code-length 2 file))
 	      (t
 	       (dump-fop 'lisp::fop-code file)
-	       (quick-dump-number num-consts 4 file)
-	       (quick-dump-number code-length 4 file))))
-      
+	       (dump-unsigned-32 num-consts file)
+	       (dump-unsigned-32 code-length file))))
+
+      (flush-fasl-file-buffer file)
       (let ((fixups (emit-code-vector (fasl-file-stream file) code-segment))
 	    (handle (dump-pop file)))
 	(dump-fixups handle fixups file)
@@ -408,7 +497,8 @@
 
 (defun dump-assembler-routines (code-segment length routines file)
   (dump-fop 'lisp::fop-assembler-code file)
-  (quick-dump-number length 4 file)
+  (dump-unsigned-32 length file)
+  (flush-fasl-file-buffer file)
   (let ((fixups (emit-code-vector (fasl-file-stream file) code-segment)))
     (dolist (routine routines)
       (dump-fop 'lisp::fop-normal-load file)
@@ -416,7 +506,7 @@
 	(dump-object (car routine) file))
       (dump-fop 'lisp::fop-maybe-cold-load file)
       (dump-fop 'lisp::fop-assembler-routine file)
-      (quick-dump-number (label-position (cdr routine)) 4 file))
+      (dump-unsigned-32 (label-position (cdr routine)) file))
     (let ((handle (dump-pop file)))
       (dump-fixups handle fixups file)
       handle)))
@@ -428,7 +518,7 @@
 ;;; using miscop numbers other than a minor load-time efficiency win.
 ;;;
 (defun dump-fixups (code-handle fixups file)
-  (declare (type unsigned-byte code-handle) (list fixups)
+  (declare (type index code-handle) (list fixups)
 	   (type fasl-file file))
   (when fixups
     (dump-push code-handle file)
@@ -458,7 +548,7 @@
 	     (dump-byte len file)
 	     (dotimes (i len)
 	       (dump-byte (char-code (schar name i)) file)))))
-	(quick-dump-number offset 4 file)))
+	(dump-unsigned-32 offset file)))
     (dump-fop 'lisp::fop-pop-for-effect file))
   (undefined-value))
 
@@ -473,17 +563,15 @@
 ;;; references to functions in top-level forms.
 ;;;
 (defun dump-one-entry (entry code-handle file)
-  (declare (type entry-info entry) (type unsigned-byte code-handle)
+  (declare (type entry-info entry) (type index code-handle)
 	   (type fasl-file file))
   (let ((name (entry-info-name entry)))
-    ;; ### Do something special for closure functions?
     (dump-push code-handle file)
     (dump-object name file)
     (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-position (entry-info-offset entry))
-		       4 file)
+    (dump-unsigned-32 (label-position (entry-info-offset entry)) file)
     (let ((handle (dump-pop file)))
       (when (and name (symbolp name))
 	(dump-object name file)
@@ -497,6 +585,7 @@
 ;;; storing the object referenced by Entry-Handle.
 ;;;
 (defun alter-code-object (code-handle offset entry-handle file)
+  (declare (type index code-handle entry-handle offset) (type fasl-file file))
   (dump-push code-handle file)
   (dump-push entry-handle file)
   (dump-fop* offset lisp::fop-byte-alter-code lisp::fop-alter-code file)
@@ -513,7 +602,7 @@
 
   (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)
+  (dump-unsigned-32 (fasl-file-table-free file) file)
 
   (let ((code-handle (dump-code-object component code-segment length file))
 	(2comp (component-info component)))
@@ -560,8 +649,8 @@
       (dolist (info-handle (fasl-file-debug-info file))
 	(dump-push res-handle file)
 	(dump-fop 'lisp::fop-svset file)
-	(quick-dump-number info-handle 4 file)
-	(quick-dump-number 2 4 file))))
+	(dump-unsigned-32 info-handle file)
+	(dump-unsigned-32 2 file))))
 
   (setf (fasl-file-debug-info file) ())
   (undefined-value))
@@ -593,21 +682,27 @@
 	     (structure
 	      (dump-structure x file)
 	      (eq-save-object x file))
-	     (vector
-	      (cond ((stringp x)
-		     (unless (equal-check-table x file)
-		       (dump-string x file)
-		       (equal-save-object x file)))
-		    ((subtypep (array-element-type x)
-			       '(unsigned-byte 32))
-		     (dump-i-vector x file)
-		     (eq-save-object x file))
-		    (t
-		     (dump-vector x file)
-		     (eq-save-object x file))))
 	     (array
-	      (dump-array x file)
-	      (eq-save-object x file))
+	      (cond
+	       ((array-header-p x)
+		(dump-array x file)
+		(eq-save-object x file))
+	       (t
+		(typecase x
+		  (simple-base-string 
+		   (unless (equal-check-table x file)
+		     (dump-simple-string x file)
+		     (equal-save-object x file)))
+		  (simple-vector
+		   (dump-simple-vector x file)
+		   (eq-save-object x file))
+		  ((or (simple-array single-float (*))
+		       (simple-array double-float (*)))
+		   (dump-simple-vector (coerce x 'simple-vector) file)
+		   (eq-save-object x file))
+		  (t
+		   (dump-i-vector x file)
+		   (eq-save-object x file))))))
 	     (number
 	      (unless (equal-check-table x file)
 		(etypecase x
@@ -616,11 +711,6 @@
 		  (float (dump-float x file))
 		  (integer (dump-integer x file)))
 		(equal-save-object x file)))
-#|
-	     (compiled-function
-	      (dump-function x file)
-	      (eq-save-object x file))
-|#
 	     (t
 	      ;;
 	      ;; This probably never happens, since bad things are detected
@@ -654,10 +744,6 @@
 	     (dump-non-immediate-object x file)))
 	((fixnump x) (dump-integer x file))
 	((characterp x) (dump-character x file))
-#| Probably a bug to ever dump a trap object...
-	((lisp::trap-object-p x)
-	 (dump-fop 'lisp::fop-misc-trap file))
-|#
 	(t
 	 (dump-non-immediate-object x file))))
 
@@ -680,15 +766,15 @@
 	       (i 0 (1+ i)))
 	      ((eq current value)
 	       (dump-fop 'lisp::fop-nthcdr file)
-	       (quick-dump-number i 4 file)))))
+	       (dump-unsigned-32 i file))
+	    (declare (type index i)))))
       
-      (dump-fop (ecase (circularity-type info)
-		  (:rplaca 'lisp::fop-rplaca)
-		  (:rplacd 'lisp::fop-rplacd)
-		  ((:svset :struct-set) 'lisp::fop-svset))
-		file)
-      (quick-dump-number (gethash (circularity-object info) table) 4 file)
-      (quick-dump-number (circularity-index info) 4 file))))
+      (ecase (circularity-type info)
+	(:rplaca (dump-fop 'lisp::fop-rplaca file))
+	(:rplacd (dump-fop 'lisp::fop-rplacd file))
+	((:svset :struct-set) (dump-fop 'lisp::fop-svset file)))
+      (dump-unsigned-32 (gethash (circularity-object info) table) file)
+      (dump-unsigned-32 (circularity-index info) file))))
 
 
 ;;; Dump-Object  -- Interface
@@ -702,7 +788,7 @@
 ;;; overhead on types of objects that might be circular.
 ;;;
 (defun dump-object (x file)
-  (if (or (arrayp x) (consp x) (structurep x))
+  (if (or (array-header-p x) (simple-vector-p x) (consp x) (structurep x))
       (let ((*circularities-detected* ())
 	    (circ (fasl-file-circularity-table file)))
 	(clrhash circ)
@@ -745,41 +831,35 @@
   (dump-fop 'lisp::fop-complex file))
 
 
-;;; Compute how many bytes it will take to represent signed integer N.
-
-(defun compute-bytes (n)
-  (ceiling (1+ (integer-length n)) 8))
-
 ;;; Dump an integer.
 
 (defun dump-integer (n file)
-  (let* ((bytes (compute-bytes n)))
-    (cond ((= bytes 1)
-	   (dump-fop 'lisp::fop-byte-integer file)
-	   (dump-byte (logand #xFF n) file))
-	  ((< bytes 5)
-	   (dump-fop 'lisp::fop-word-integer file)
-	   (quick-dump-number n 4 file))
-	  ((< bytes 256)
-	   (dump-fop 'lisp::fop-small-integer file)
-	   (dump-byte bytes file)
-	   (quick-dump-number n bytes file))
-	  (t (dump-fop 'lisp::fop-integer file)
-	     (quick-dump-number bytes 4 file)
-	     (quick-dump-number n bytes file)))))
-
+  (typecase n
+    ((signed-byte 8)
+     (dump-fop 'lisp::fop-byte-integer file)
+     (dump-byte (logand #xFF n) file))
+    ((unsigned-byte 31)
+     (dump-fop 'lisp::fop-word-integer file)
+     (dump-unsigned-32 n file))
+    ((signed-byte 32)
+     (dump-fop 'lisp::fop-word-integer file)
+     (dump-var-signed n 4 file))
+    (t
+     (let ((bytes (ceiling (1+ (integer-length n)) 8)))
+       (dump-fop* bytes lisp::fop-small-integer lisp::fop-integer file)
+       (dump-var-signed n bytes file)))))
 
 (defun dump-float (x file)
   (etypecase x
     (single-float
      (dump-fop 'lisp::fop-single-float file)
-     (quick-dump-number (single-float-bits x) 4 file))
+     (dump-var-signed (single-float-bits x) 4 file))
     (double-float
      (dump-fop 'lisp::fop-double-float file)
      (let ((x x))
        (declare (double-float x))
-       (quick-dump-number (double-float-low-bits x) 4 file)
-       (quick-dump-number (double-float-high-bits x) 4 file)))))
+       (dump-unsigned-32 (double-float-low-bits x) file)
+       (dump-var-signed (double-float-high-bits x) 4 file)))))
 
 
 ;;;; Symbol Dumping:
@@ -791,11 +871,13 @@
 ;;; we can do the package lookup at cold load time.
 ;;;
 (defun dump-package (pkg file)
-  (cond ((cdr (assoc pkg (fasl-file-packages file))))
+  (declare (type package pkg) (type fasl-file file) (values index)
+	   (inline assoc))
+  (cond ((cdr (assoc pkg (fasl-file-packages file) :test #'eq)))
 	(t
 	 (unless *cold-load-dump*
 	   (dump-fop 'lisp::fop-normal-load file))
-	 (dump-string (package-name pkg) file)
+	 (dump-simple-string (package-name pkg) file)
 	 (dump-fop 'lisp::fop-package file)
 	 (unless *cold-load-dump*
 	   (dump-fop 'lisp::fop-maybe-cold-load file))
@@ -837,9 +919,9 @@
 	   (dump-fop* (dump-package pkg file)
 		      lisp::fop-symbol-in-byte-package-save
 		      lisp::fop-symbol-in-package-save file)
-	   (quick-dump-number pname-length 4 file)))
+	   (dump-unsigned-32 pname-length file)))
 
-    (write-string pname (fasl-file-stream file))
+    (dump-bytes pname (length pname) file)
 
     (unless *cold-load-dump*
       (setf (gethash s (fasl-file-eq-table file)) (fasl-file-table-free file)))
@@ -881,7 +963,7 @@
 	      (t
 	       (sub-dump-object l file)
 	       (terminate-dotted-list n file))))
-
+    (declare (type index n))
     (let ((ref (gethash l circ)))
       (when ref
 	(push (make-circularity :type :rplacd  :object list  :index (1- n)
@@ -905,6 +987,7 @@
 
 
 (defun terminate-dotted-list (n file)
+  (declare (type index n) (type fasl-file file))
   (case n
     (1 (dump-fop 'lisp::fop-list*-1 file))
     (2 (dump-fop 'lisp::fop-list*-2 file))
@@ -918,36 +1001,46 @@
 	   ((< nn 256)
 	    (dump-fop 'lisp::fop-list* file)
 	    (dump-byte nn file))
+	 (declare (type index nn))
 	 (dump-fop 'lisp::fop-list* file)
 	 (dump-byte 255 file)))))
 
 ;;; If N > 255, must build list with one list operator, then list* operators.
 
 (defun terminate-undotted-list (n file)
-    (case n
-      (1 (dump-fop 'lisp::fop-list-1 file))
-      (2 (dump-fop 'lisp::fop-list-2 file))
-      (3 (dump-fop 'lisp::fop-list-3 file))
-      (4 (dump-fop 'lisp::fop-list-4 file))
-      (5 (dump-fop 'lisp::fop-list-5 file))
-      (6 (dump-fop 'lisp::fop-list-6 file))
-      (7 (dump-fop 'lisp::fop-list-7 file))
-      (8 (dump-fop 'lisp::fop-list-8 file))
-      (T (cond ((< n 256)
-		(dump-fop 'lisp::fop-list file)
-		(dump-byte n file))
-	       (t (dump-fop 'lisp::fop-list file)
-		  (dump-byte 255 file)
-		  (do ((nn (- n 255) (- nn 255)))
-		      ((< nn 256)
-		       (dump-fop 'lisp::fop-list* file)
-		       (dump-byte nn file))
-		    (dump-fop 'lisp::fop-list* file)
-		    (dump-byte 255 file)))))))
+  (declare (type index n) (type fasl-file file))
+  (case n
+    (1 (dump-fop 'lisp::fop-list-1 file))
+    (2 (dump-fop 'lisp::fop-list-2 file))
+    (3 (dump-fop 'lisp::fop-list-3 file))
+    (4 (dump-fop 'lisp::fop-list-4 file))
+    (5 (dump-fop 'lisp::fop-list-5 file))
+    (6 (dump-fop 'lisp::fop-list-6 file))
+    (7 (dump-fop 'lisp::fop-list-7 file))
+    (8 (dump-fop 'lisp::fop-list-8 file))
+    (T (cond ((< n 256)
+	      (dump-fop 'lisp::fop-list file)
+	      (dump-byte n file))
+	     (t (dump-fop 'lisp::fop-list file)
+		(dump-byte 255 file)
+		(do ((nn (- n 255) (- nn 255)))
+		    ((< nn 256)
+		     (dump-fop 'lisp::fop-list* file)
+		     (dump-byte nn file))
+		  (declare (type index nn))
+		  (dump-fop 'lisp::fop-list* file)
+		  (dump-byte 255 file)))))))
+
 
 ;;;; Array dumping:
 
-(defun dump-vector (v file)
+
+;;; DUMP-SIMPLE-VECTOR  --  Internal
+;;;
+;;;    Dump a SIMPLE-VECTOR, handling any circularities.
+;;;
+(defun dump-simple-vector (v file)
+  (declare (type simple-vector v) (type fasl-file file))
   (note-potential-circularity v file)
   (do ((index 0 (1+ index))
        (length (length v))
@@ -964,13 +1057,18 @@
 	    (t
 	     (sub-dump-object obj file))))))
 
-;;; Dump a string.
 
-(defun dump-string (s file)
+;;; DUMP-SIMPLE-STRING  --  Internal
+;;;
+;;;    Dump a SIMPLE-BASE-STRING.
+;;;
+(defun dump-simple-string (s file)
+  (declare (type simple-base-string s))
   (let ((length (length s)))
     (dump-fop* length lisp::fop-small-string lisp::fop-string file)
-    (dotimes (i length)
-      (dump-byte (char-code (char s i)) file))))
+    (dump-bytes s length file))
+  (undefined-value))
+
 
 ;;; Dump-Array  --  Internal
 ;;;
@@ -991,7 +1089,8 @@
 		     (lisp::%array-data-vector array)
 		     file)
     (dump-fop 'lisp::fop-array file)
-    (quick-dump-number rank 4 file)))
+    (dump-unsigned-32 rank file)))
+
 
 ;;; DUMP-I-VECTOR  --  Internal
 ;;;
@@ -1003,11 +1102,8 @@
 ;;; and write the vector one element at a time.
 ;;;
 (defun dump-i-vector (vec file)
-  (let* ((vec (if #-new-compiler (%primitive complex-array-p vec)
-		  #+new-compiler (array-header-p vec)
-		  (coerce vec 'simple-array)
-		  vec))
-	 (ac #-new-compiler
+  (declare (type (simple-array * (*)) vec))
+  (let* ((ac #-new-compiler
 	     (%primitive get-vector-access-code vec)
 	     #+new-compiler
 	     (etypecase vec
@@ -1019,34 +1115,46 @@
 	       ((simple-array (unsigned-byte 32) (*)) 5)))
 	 (len (length vec))
 	 (size (ash 1 ac))
-	 (bytes (ash (+ (ash len ac) 7) -3)))
-		    
+	 (bytes (ash (+ (the index (ash len ac)) 7) -3)))
+    (declare (type index ac len size bytes))
+    
     (dump-fop 'lisp::fop-int-vector file)
-    (quick-dump-number len 4 file)
+    (dump-unsigned-32 len file)
     (dump-byte size file)
     (cond ((or (eq (backend-byte-order *backend*)
 		   (backend-byte-order *native-backend*))
 	       (= size 8))
-	   (system:output-raw-bytes (fasl-file-stream file) vec 0 bytes))
+	   (dump-bytes vec bytes file))
 	  ((> size 8)
 	   (ecase (backend-byte-order *backend*)
 	     (:little-endian
 	      (dotimes (i len)
 		(let ((int (aref vec i)))
-		  (quick-dump-number int (ash size -3) file))))
+		  (dump-var-signed int (ash size -3) file))))
 	     (:big-endian
 	      (dotimes (i len)
+		(declare (type index i))
 		(let ((int (aref vec i)))
+		  (declare (type (unsigned-byte 32) int))
 		  (do ((shift (- 8 size) (+ shift 8)))
 		      ((plusp shift))
-		    (dump-byte (logand (ash int shift) #xFF) file)))))))
+		    (declare (type fixnum shift))
+		    (dump-byte (logand (the (unsigned-byte 32)
+					    (ash int shift))
+				       #xFF)
+			       file)))))))
 	  (t
 	   (macrolet ((frob (initial step done)
 			`(let ((shift ,initial)
 			       (byte 0))
+			   (declare (type fixnum shift byte))
 			   (dotimes (i len)
 			     (let ((int (aref vec i)))
-			       (setq byte (logior byte (ash int shift)))
+			       (declare (type (unsigned-byte 8) int))
+			       (setq byte
+				     (logior byte
+					     (the (unsigned-byte 8)
+						  (ash int shift))))
 			       (,step shift size))
 			     (when ,done
 			       (dump-byte byte file)