diff --git a/code/dyncount.lisp b/code/dyncount.lisp
index fb5ce1b1164684fa09ada0bc5d0a68c68a85aaaa..5565ba13f31c741d70db4bd19e8d8a8a361ed508 100644
--- a/code/dyncount.lisp
+++ b/code/dyncount.lisp
@@ -1,98 +1,249 @@
 ;;; -*- Package: C; Log: C.Log -*-
 ;;;
 ;;; **********************************************************************
-;;; 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). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dyncount.lisp,v 1.2 1992/02/13 09:54:29 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
-;;; Runtime support for dynamic statistic collecting.
+;;; Runtime support for dynamic VOP statistics collection.
 ;;; 
 (in-package "C")
 
+#|
+Put *count-adjustments* back into VOP costs, and verify them.
+Make sure multi-cycle instruction costs are plausible.
+VOP classification.
+  Make tables of %cost for benchmark X class.
+  Could be represented as a sort of bar chart.
+|#
+
 (eval-when (compile)
   (when *collect-dynamic-statistics*
     (error "Compiling this file with dynamic stat collection turn on would ~
     be a very bad idea.")))
+
+;;;; Hash utilities:
+
+(defmacro do-hash ((key-var value-var table &optional result)
+		   &body (body decls))
+  "DO-HASH (Key-Var Value-Var Table [Result]) Declaration* Form*
+   Iterate over the entries in a hash-table."
+  (let ((gen (gensym))
+	(n-more (gensym)))
+    `(with-hash-table-iterator (,gen ,table)
+       (loop
+	 (multiple-value-bind (,n-more ,key-var ,value-var)
+			      (,gen)
+	   ,@decls
+	   (unless ,n-more (return ,result))
+	   ,@body)))))
+
+(defun make-hash-table-like (table)
+  "Make a hash-table with the same test as table."
+  (declare (type hash-table table))
+  (make-hash-table :test (lisp::hash-table-kind table)))
 
+(defun hash-difference (table1 table2)
+  "Return a hash-table containing only the entries in Table1 whose key is not
+   also a key in Table2." (declare (type hash-table table1 table2))
+  (let ((res (make-hash-table-like table1)))
+    (do-hash (k v table1)
+      (unless (nth-value 1 (gethash k table2))
+	(setf (gethash res k) v)))
+    res))
 
-(eval-when (compile load eval)
-  (defparameter *count-adjustments*
-    '((return-multiple 152)
-      (tail-call-variable 88)
-      (unwind 92)
-      (throw 116)
-      (allocate-vector 72)
-      (sxhash-simple-string 248)
-      (sxhash-simple-substring 264)
-      (copy-to-system-area 1200)
-      (copy-from-system-area 1200)
-      (system-area-copy 1204)
-      (bit-bash-copy 1412)
-      (vm::generic-+ 72)
-      (vm::generic-- 72)
-      (vm::generic-* 184)
-      (vm::generic-< 68)
-      (vm::generic-> 68)
-      (vm::generic-eql 80)
-      (vm::generic-= 80)
-      (vm::generic-/= 104)
-      (%make-weak-pointer 60)
-      (make-value-cell 56)
-      (vm::make-funcallable-instance 76)
-      (make-closure 76)
-      (make-complex 60)
-      (make-ratio 60)
-      (%allocate-bignum 72)
-      (make-structure 72)
-      (cons 50))))
-
-
-(defvar *count-adjustments-hashtable*
-  (let ((result (make-hash-table :test 'eq)))
-    (dolist (entry *count-adjustments*)
-      (setf (gethash (car entry) result) (cadr entry)))
-    result))
-
-
-(defvar *vop-counts* nil)
+(defun hash-list (table)
+  "Return a list of the values in Table."
+  (declare (type hash-table table))
+  (collect ((res))
+    (do-hash (k v table)
+      (declare (ignore k))
+      (res v))
+    (res)))
 
+;;; READ-HASH-TABLE, WRITE-HASH-TABLE  --  Public
+;;;
+;;;    Read (or write) a hashtable from (or to) a file.
+;;;
+(defun read-hash-table (file)
+  (with-open-file (s file :direction :input)
+    (dotimes (i 3)
+      (format t "~%; ~A" (read-line s)))
+    (let* ((eof '(nil))
+	   (test (read s))
+	   (reader (read s))
+	   (res (make-hash-table :test test)))
+      (read s); Discard writer...
+      (loop
+	(let ((key (read s nil eof)))
+	  (when (eq key eof) (return))
+	  (setf (gethash key res)
+		(funcall reader s key))))
+      res)))
+;;;
+(defun write-hash-table (table file &key
+			       (comment (format nil "Contents of ~S" table))
+			       (reader 'read) (writer 'prin1) (test 'equal))
+  (with-open-file (s file :direction :output :if-exists :new-version)
+    (with-standard-io-syntax
+      (let ((*print-readably* nil))
+	(format s "~A~%Version ~A on ~A~%"
+		comment (lisp-implementation-version)
+		(machine-instance))
+	(format-universal-time s (get-universal-time))
+	(terpri s)
+	(format s "~S ~S ~S~%" test reader writer)
+	(do-hash (k v table)
+	  (prin1 k s)
+	  (write-char #\space s)
+	  (funcall writer v s)
+	  (terpri s)))))
+  table)
 
+
+;;;; Info accumulation:
+
+;;; Used to accumulate info about the usage of a single VOP.  Cost and count
+;;; are kept as double-floats, which lets us get more bits and avoid annoying
+;;; overflows.
+;;;
+(deftype count-vector () '(simple-array double-float (2)))
+;;;
+(defstruct (vop-stats
+	    (:constructor %make-vop-stats (name))
+	    (:constructor make-vop-stats-key))
+  (name (required-argument) :type simple-string)
+  (data (make-array 2 :element-type 'double-float) :type count-vector))
+
+(defmacro vop-stats-count (x) `(aref (vop-stats-data ,x) 0))
+(defmacro vop-stats-cost (x) `(aref (vop-stats-data ,x) 1))
+
+(defun make-vop-stats (&key name count cost)
+  (let ((res (%make-vop-stats name)))
+    (setf (vop-stats-count res) count)
+    (setf (vop-stats-cost res) cost)
+    res))
+    
+(declaim (freeze-type dyncount-info vop-stats))
+
+
+;;; NOTE-DYNCOUNT-INFO  --  Internal
+;;;
+;;;    Add the Info into the cumulative result on the VOP name plist.  We use
+;;; plists so that we will touch minimal system code outside of this file
+;;; (which may be compiled with profiling on.)
+;;;
 (defun note-dyncount-info (info)
-  (declare (type dyncount-info info))
+  (declare (type dyncount-info info) (inline get %put)
+	   (optimize (speed 2)))
   (let ((counts (dyncount-info-counts info))
 	(vops (dyncount-info-vops info)))
     (dotimes (index (length counts))
-      (let ((count (aref counts index)))
+      (declare (type index index))
+      (let ((count (coerce (the (unsigned-byte 31)
+				(aref counts index))
+			   'double-float)))
+	(when (minusp count)
+	  (warn "Oops: overflow.")
+	  (return-from note-dyncount-info nil))
 	(unless (zerop count)
 	  (let* ((vop-info (svref vops index))
 		 (length (length vop-info)))
+	    (declare (simple-vector vop-info))
 	    (do ((i 0 (+ i 4)))
 		((>= i length))
+	      (declare (type index i))
 	      (let* ((name (svref vop-info i))
-		     (adjustment
-		      (gethash name *count-adjustments-hashtable* 0))
-		     (entry (gethash name *vop-counts*))
-		     (counts (* (svref vop-info (1+ i)) count))
-		     (cost (* (+ (svref vop-info (+ i 2)) adjustment)
-			      count))
-		     (elsewhere-cost (* (svref vop-info (+ i 3)) count)))
-		(unless entry
-		  (setf entry (make-array 4 :initial-element 0))
-		  (setf (svref entry 0) name)
-		  (setf (gethash name *vop-counts*) entry))
-		(incf (svref entry 1) counts)
-		(incf (svref entry 2) cost)
-		(incf (svref entry 3) elsewhere-cost)))))))))
-
+		     (entry (or (get name 'vop-stats)
+				(setf (get name 'vop-stats)
+				      (%make-vop-stats (symbol-name name))))))
+		(incf (vop-stats-count entry)
+		      (* (coerce (the index (svref vop-info (1+ i)))
+				 'double-float)
+			 count))
+		(incf (vop-stats-cost entry)
+		      (* (coerce (the index (svref vop-info (+ i 2)))
+				 'double-float)
+			 count))))))))))
 
 (defun clear-dyncount-info (info)
   (declare (type dyncount-info info))
-  (fill (dyncount-info-counts info) 0)
-  nil)
+  (declare (optimize (speed 3) (safety 0)))
+  (let ((counts (dyncount-info-counts info)))
+    (dotimes (i (length counts))
+      (setf (aref counts i) 0))))
 
 
+;;; CLEAR-VOP-COUNTS  --  Public
+;;;
+;;;    Clear any VOP-COUNTS properties and the counts vectors for all code
+;;; objects.  The latter loop must not call any random functions.
+;;;
+(defun clear-vop-counts (&optional (spaces '(:dynamic)))
+  "Clear all dynamic VOP counts for code objects in the specified spaces."
+  (do-hash (k v (backend-template-names *backend*))
+    (declare (ignore v))
+    (remprop k 'vop-stats))
+  
+  (locally
+      (declare (optimize (speed 3) (safety 0))
+	       (inline vm::map-allocated-objects))
+    (without-gcing
+      (dolist (space spaces)
+	(vm::map-allocated-objects
+	 #'(lambda (object type-code size)
+	     (declare (ignore type-code size))
+	     (when (dyncount-info-p object)
+	       (clear-dyncount-info object)))
+	 space)))))
+
+
+;;; GET-VOP-COUNTS  --  Public
+;;;
+;;;    Call NOTE-DYNCOUNT-INFO on all DYNCOUNT-INFO structure allocated in the
+;;; specified spaces.  Return a hashtable describing the counts.  The initial
+;;; loop must avoid calling any functions outside this file to prevent adding
+;;; noise to the data, since other files may be compiled with profiling.
+;;;
+(defun get-vop-counts (&optional (spaces '(:dynamic)) &key (clear t))
+  "Return a hash-table mapping string VOP names to VOP-STATS structures
+   describing the VOPs executed.  If clear is true, then reset all counts to
+   zero as a side-effect."
+  (locally
+      (declare (optimize (speed 3) (safety 0))
+	       (inline vm::map-allocated-objects))
+    (without-gcing
+      (dolist (space spaces)
+	(vm::map-allocated-objects
+	 #'(lambda (object type-code size)
+	     (declare (ignore type-code size))
+	     (when (dyncount-info-p object)
+	       (note-dyncount-info object)
+	       (when clear
+		 (clear-dyncount-info object))))
+	 space))))
+  
+  (let ((counts (make-hash-table :test #'equal)))
+    (do-hash (k v (backend-template-names *backend*))
+      (declare (ignore v))
+      (let ((stats (get k 'vop-stats)))
+	(when stats
+	  (setf (gethash k counts) stats)
+	  (when clear
+	    (remprop k 'vop-stats)))))
+    counts))
+
+
+;;; FIND-INFO-FOR  --  Interface
+;;;
+;;;    Return the DYNCOUNT-INFO for FUNCTION.
+;;;
 (defun find-info-for (function)
   (declare (type function function))
   (let* ((function (%primitive closure-function function))
@@ -104,89 +255,177 @@
 	(when (dyncount-info-p constant)
 	  (return constant))))))
 
-#+nil
-(defun find-dyncount-info ()
-  (declare (inline vm::map-allocated-objects)
-	   (optimize (speed 3) (safety 0)))
-  (let ((results nil))
-    (dolist (space '(:read-only :static :dynamic))
-      (vm::map-allocated-objects
-       #'(lambda (object type-code size)
-	   (declare (ignore type-code size))
-	   (when (dyncount-info-p object)
-	     (push object results)))
-       space))
-    (setf *all-dyncount-infos* results)
-    (length results)))
-
-
-(defun generate-report (cut-off sort-by)
-  (let ((total-bytes 0)
-	(list nil))
-    (maphash #'(lambda (key value)
-		 (push value list)
-		 (unless (eq key 'c:count-me)
-		   (incf total-bytes (svref value 2))))
-	     *vop-counts*)
-    (format t "~30<Vop~>  ~13<Count~> ~17<Cost~> ~5:@<Percent~>~%")
-    (let ((total-bytes (coerce total-bytes 'double-float))
-	  (entries (sort list #'>
-			 :key #'(lambda (x)
-				  (svref x
-					 (ecase sort-by
-					   (:count 1)
-					   (:cost 2)))))))
-      (dolist (entry entries)
+
+(defun vop-counts-apply (function args &key (spaces '(:dynamic)) by-space)
+  "Apply Function to Args, collecting dynamic statistics on the running.
+   Spaces are the spaces to scan for counts.  If By-Space is true, we return a
+   list of result tables, instead of a single table.  In this case, specify
+   :READ-ONLY first."
+  (clear-vop-counts spaces)
+  (apply function args)
+  (if by-space
+      (mapcar #'get-vop-counts spaces)
+      (get-vop-counts spaces)))
+
+;;;; Adjustments:
+
+(defparameter *count-adjustments*
+  '((return-multiple 152)
+    (tail-call-variable 88)
+    (unwind 92)
+    (throw 116)
+    (allocate-vector 72)
+    (sxhash-simple-string 248)
+    (sxhash-simple-substring 264)
+    (copy-to-system-area 1200)
+    (copy-from-system-area 1200)
+    (system-area-copy 1204)
+    (bit-bash-copy 1412)
+    (vm::generic-+ 72)
+    (vm::generic-- 72)
+    (vm::generic-* 184)
+    (vm::generic-< 68)
+    (vm::generic-> 68)
+    (vm::generic-eql 80)
+    (vm::generic-= 80)
+    (vm::generic-/= 104)
+    (%make-weak-pointer 60)
+    (make-value-cell 56)
+    (vm::make-funcallable-instance 76)
+    (make-closure 76)
+    (make-complex 60)
+    (make-ratio 60)
+    (%allocate-bignum 72)
+    (make-structure 72)
+    (cons 50)))
+
+;;; GET-VOP-COSTS  --  Public
+;;;
+(defun get-vop-costs ()
+  "Return a hash-table mapping string VOP names to the cost recorded in the
+   generator for all VOPs which are also the names of assembly routines."
+  (let ((res (make-hash-table :test #'equal)))
+     (do-hash (name v lisp::*assembler-routines*)
+       (declare (ignore v))
+       (let ((vop (gethash name (backend-template-names *backend*))))
+	 (when vop
+	   (setf (gethash (symbol-name name) res)
+		 (template-cost (template-or-lose name))))))
+    res))
+
+(defvar *native-costs* (get-vop-costs)
+  "Costs of assember routines on this machine.")
+
+
+;;;; Analysis and report generation:
+
+;;; COST-SUMMARY  --  Internal
+;;;
+;;;    Sum the count and costs.
+;;;
+(defun cost-summary (table)
+  (let ((total-count 0d0)
+	(total-cost 0d0))
+    (do-hash (k v table)
+      (declare (ignore k))
+      (incf total-count (vop-stats-count v))
+      (incf total-cost (vop-stats-cost v)))
+    (values total-count total-cost)))
+
+  
+;;; COMPENSATE-COSTS  --  Internal
+;;;
+;;;    Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
+;;; according to the Costs table.
+;;;
+(defun compensate-costs (table costs)
+  (let ((res (make-hash-table-like table)))
+    (do-hash (key value table)
+      (unless (string= key "COUNT-ME")
+	(let ((cost (gethash key costs)))
+	  (if cost
+	      (let* ((count (vop-stats-count value))
+		     (sum (+ (* cost count)
+			     (vop-stats-cost value))))
+		(setf (gethash key res)
+		      (make-vop-stats :name key :count count :cost sum)))
+	      (setf (gethash key res) value)))))
+    res))
+
+
+;;; COMBINE-STATS  --  Internal
+;;;
+;;;    Take two tables of vop-stats and return a table of entries where the
+;;; entries have been compared somehow.  The counts are normalized to Compared.
+;;; The costs are the difference of the costs adjusted by the difference in
+;;; counts: the cost for Original is modified to correspond to the count in
+;;; Compared.
+;;;
+(defun combine-stats (original compared)
+  (declare (type hash-table original compared))
+  (let ((res (make-hash-table-like original)))
+    (do-hash (k cv compared)
+      (let ((ov (gethash k original)))
+	(when ov
+	  (let ((norm-cnt (/ (vop-stats-count ov) (vop-stats-count cv))))
+	    (setf (gethash k res)
+		  (make-vop-stats
+		   :name k
+		   :count norm-cnt
+		   :cost (- (/ (vop-stats-cost ov) norm-cnt)
+			    (vop-stats-cost cv))))))))
+    res))
+
+
+;;; SORT-RESULT  --  Internal
+;;;
+(defun sort-result (table by)
+  (sort (hash-list table) #'>
+	:key #'(lambda (x)
+		 (abs (ecase by
+			(:count (vop-stats-count x))
+			(:cost (vop-stats-cost x)))))))
+
+
+;;; GENERATE-REPORT  --  Public
+;;;
+;;; Generate a report from the specified table.
+;;;
+(defun generate-report (table &key (cut-off 15) (sort-by :cost)
+			      (costs *native-costs*) compare)
+  (let* ((compensated (if costs (compensate-costs table costs) table))
+	 (compared (if compare
+		       (combine-stats compensated compare)
+		       compensated))
+	 (*gc-verbose* nil))
+    (multiple-value-bind (total-count total-cost)
+			 (cost-summary (or compare compensated))
+      (format t "~30<Vop~>  ~13<Count~> ~6<Cost~>  ~6:@<Percent~>~%")
+      (dolist (entry (sort-result compared sort-by))
 	(when (and cut-off (minusp (decf cut-off)))
 	  (return))
-	(unless (eq (svref entry 0) 'c:count-me)
-	  (format t "~30<~A~>: ~13:D ~17:D ~4,1,2F%~%"
-		  (symbol-name (svref entry 0))
-		  (svref entry 1)
-		  (svref entry 2)
-		  (/ (coerce (svref entry 2) 'double-float)
-		     total-bytes))))))
+	(let* ((cost (vop-stats-cost entry))
+	       (name (vop-stats-name entry))
+	       (entry-count (vop-stats-count entry))
+	       (comp-entry (if compare (gethash name compare) entry))
+	       (count (vop-stats-count comp-entry)))
+	  (format t "~30<~A~>: ~:[~13:D~;~13,2F~] ~6,1F  ~4,1,2F%~%"
+		  (vop-stats-name entry)
+		  compare
+		  (if compare entry-count (round entry-count))
+		  (/ cost count)
+		  (/ cost total-cost))))
+	(format t "~%Total count ~,3E, total cost ~,3E.~%"
+		total-count total-cost)))
   (values))
 
-(defun report-dynamic-vop-counts (&key spaces (cut-off 15) (sort-by :cost))
-  (let ((*vop-counts* (make-hash-table :test #'eq)))
-    (without-gcing
-     (dolist (space (or spaces '(:read-only :static :dynamic)))
-       (format t "Scanning ~S space...~%" space)
-       (locally
-	(declare (optimize (speed 3) (safety 0)))
-	(vm::map-allocated-objects
-	 #'(lambda (object type-code size)
-	     (declare (ignore type-code size))
-	     (when (dyncount-info-p object)
-	       (note-dyncount-info object)))
-	 space))))
-    (generate-report cut-off sort-by)))
-
-
-(defun clear-dynamic-vop-counts (&rest spaces)
-  (without-gcing
-   (dolist (space (or spaces '(:read-only :static :dynamic)))
-     (format t "Scanning ~S space...~%" space)
-     (locally
-      (declare (optimize (speed 3) (safety 0)))
-      (vm::map-allocated-objects
-       #'(lambda (object type-code size)
-	   (declare (ignore type-code size))
-	   (when (dyncount-info-p object)
-	     (clear-dyncount-info object)))
-       space)))))
-
-
-(defun check-dynamic-vop-counts (&rest spaces)
-  (without-gcing
-   (dolist (space (or spaces '(:read-only :static :dynamic)))
-     (format t "Scanning ~S space...~%" space)
-     (locally
-      (declare (optimize (speed 3) (safety 0)))
-      (vm::map-allocated-objects
-       #'(lambda (object type-code size)
-	   (when (dyncount-info-p object)
-	     (assert (= (length (dyncount-info-counts object))
-			(length (dyncount-info-vops object))))))
-       space)))))
+
+;;; STATS-{READER,WRITER}  --  Public
+;;;
+;;;    Read & write VOP stats using hash IO utility.
+;;;
+(defun stats-reader (stream key)
+  (make-vop-stats :name key :count (read stream) :cost (read stream)))
+;;;
+(defun stats-writer (object stream)
+  (format stream "~S ~S" (vop-stats-count object) (vop-stats-cost object)))