diff --git a/code/dyncount.lisp b/code/dyncount.lisp
index 5565ba13f31c741d70db4bd19e8d8a8a361ed508..a10a444cea047ae415112533cfb595a096538e8a 100644
--- a/code/dyncount.lisp
+++ b/code/dyncount.lisp
@@ -7,7 +7,7 @@
 ;;; 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 $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dyncount.lisp,v 1.3 1992/05/27 00:33:00 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -55,7 +55,7 @@ VOP classification.
   (let ((res (make-hash-table-like table1)))
     (do-hash (k v table1)
       (unless (nth-value 1 (gethash k table2))
-	(setf (gethash res k) v)))
+	(setf (gethash k res) v)))
     res))
 
 (defun hash-list (table)
@@ -211,7 +211,7 @@ VOP classification.
 ;;; 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))
+(defun get-vop-counts (&optional (spaces '(:dynamic)) &key (clear nil))
   "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."
@@ -234,7 +234,7 @@ VOP classification.
       (declare (ignore v))
       (let ((stats (get k 'vop-stats)))
 	(when stats
-	  (setf (gethash k counts) stats)
+	  (setf (gethash (symbol-name k) counts) stats)
 	  (when clear
 	    (remprop k 'vop-stats)))))
     counts))
@@ -264,11 +264,14 @@ VOP classification.
   (clear-vop-counts spaces)
   (apply function args)
   (if by-space
-      (mapcar #'get-vop-counts spaces)
+      (mapcar #'(lambda (space)
+		  (get-vop-counts (list space) :clear t))
+	      spaces)
       (get-vop-counts spaces)))
 
 ;;;; Adjustments:
 
+#|
 (defparameter *count-adjustments*
   '((return-multiple 152)
     (tail-call-variable 88)
@@ -298,6 +301,7 @@ VOP classification.
     (%allocate-bignum 72)
     (make-structure 72)
     (cons 50)))
+|#
 
 ;;; GET-VOP-COSTS  --  Public
 ;;;
@@ -317,7 +321,102 @@ VOP classification.
   "Costs of assember routines on this machine.")
 
 
-;;;; Analysis and report generation:
+;;;; Classification:
+
+(defparameter *basic-classes*
+  '(("Integer multiplication"
+     "*/FIXNUM" "*/SIGNED" "*/UNSIGNED" "SIGNED-*" "FIXNUM-*" "GENERIC-*")
+    ("Integer division" "TRUNCATE")
+    ("Generic arithmetic" "GENERIC" "TWO-ARG")
+    ("Inline EQL" "EQL")
+    ("Inline compare less/greater" "</" ">/" "<-C/" ">-C/")
+    ("Inline arith" "*/" "//" "+/" "-/" "NEGATE" "ABS" "+-C" "--C")
+    ("Inline logic" "-ASH" "$ASH" "LOG")
+    ("CAR/CDR" "CAR" "CDR")
+    ("Array type test" "ARRAYP" "VECTORP" "ARRAY-HEADER-P")
+    ("Simple type predicate" "STRUCTUREP" "LISTP" "FIXNUMP")
+    ("Simple type check" "CHECK-LIST" "CHECK-FIXNUM" "CHECK-STRUCTURE")
+    ("Array bounds check" "CHECK-BOUND")
+    ("Complex type check" "$CHECK-" "COERCE-TO-FUNCTION")
+    ("Special read" "SYMBOL-VALUE")
+    ("Special bind" "BIND$")
+    ("Tagging" "MOVE-FROM")
+    ("Untagging" "MOVE-TO" "MAKE-FIXNUM")
+    ("Move" "MOVE")
+    ("Non-local exit" "CATCH" "THROW" "DYNAMIC-STATE" "NLX" "UNWIND")
+    ("Array write" "DATA-VECTOR-SET" "$SET-RAW-BITS$")
+    ("Array read" "DATA-VECTOR-REF" "$RAW-BITS$" "VECTOR-LENGTH"
+     "LENGTH/SIMPLE" "ARRAY-HEADER")
+    ("List/string utility" "LENGTH/LIST" "SXHASH" "BIT-BASH" "$LENGTH$")
+    ("Alien operations" "SAP" "ALLOC-NUMBER-STACK" "$CALL-OUT$")
+    ("Function call/return" "CALL" "RETURN" "ALLOCATE-FRAME"
+     "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARGUMENT-COUNT")
+    ("Allocation" "MAKE-" "ALLOC" "$CONS$" "$LIST$" "$LIST*$")
+    ("Float conversion" "%SINGLE-FLOAT" "%DOUBLE-FLOAT" "-BITS$")
+    ("Complex type predicate" "P$")))
+
+
+;;; MATCHES-PATTERN  --  Internal
+;;;
+;;;    Return true if Name patches a specified pattern.  Pattern is a string
+;;; (or symbol) or a list of strings (or symbols).  If any specified string
+;;; appears as a substring of name, the pattern is matched.  #\$'s are wapped
+;;; around name, allowing the use of $ to force a match at the beginning or
+;;; end.
+;;;
+(defun matches-pattern (name pattern)
+  (declare (simple-string name))
+  (let ((name (concatenate 'string "$" name "$")))
+    (dolist (pat (if (listp pattern) pattern (list pattern)) nil)
+      (when (search (the simple-string (string pat))
+		    name :test #'char=)
+	(return t)))))
+
+
+;;; FIND-MATCHES, WHAT-CLASS  --  Interface
+;;;
+;;;    Utilities for debugging classification rules.  FIND-MATCHES returns a
+;;; list of all the VOP names in Table that match Pattern.   WHAT-CLASS returns
+;;; the class that NAME would be placed in.
+;;;
+(defun find-matches (table pattern)
+  (collect ((res))
+    (do-hash (key value table)
+      (declare (ignore value))
+      (when (matches-pattern key pattern) (res key)))
+    (res)))
+;;;
+(defun what-class (name classes)
+  (dolist (class classes nil)
+    (when (matches-pattern name (rest class)) (return (first class)))))
+
+    
+;;; CLASSIFY-COSTS  --  Interface
+;;;
+;;;    Given a VOP-STATS hash-table, return a new one with VOPs in the same
+;;; class merged into a single entry for that class.  The classes are
+;;; represented as a list of lists: (class-name pattern*).  Each pattern is a
+;;; string (or symbol) that can appear as a subsequence of the VOP name.  A VOP
+;;; is placed in the first class that it matches, or is left alone if it
+;;; matches no class.
+;;;
+(defun classify-costs (table classes)
+  (let ((res (make-hash-table-like table)))
+    (do-hash (key value table)
+      (let ((class (dolist (class classes nil)
+		     (when (matches-pattern key (rest class))
+		       (return (first class))))))
+	(if class
+	    (let ((found (or (gethash class res)
+			     (setf (gethash class res)
+				   (%make-vop-stats class)))))
+	      (incf (vop-stats-count found) (vop-stats-count value))
+	      (incf (vop-stats-cost found) (vop-stats-cost value)))
+	    (setf (gethash key res) value))))
+    res))
+
+
+;;;; Analysis:
 
 ;;; COST-SUMMARY  --  Internal
 ;;;
@@ -336,12 +435,13 @@ VOP classification.
 ;;; COMPENSATE-COSTS  --  Internal
 ;;;
 ;;;    Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
-;;; according to the Costs table.
+;;; according to the Costs table.  Any VOPs in the list IGNORE are ignored.
 ;;;
-(defun compensate-costs (table costs)
+(defun compensate-costs (table costs &optional ignore)
   (let ((res (make-hash-table-like table)))
     (do-hash (key value table)
-      (unless (string= key "COUNT-ME")
+      (unless (or (string= key "COUNT-ME")
+		  (member key ignore :test #'string=))
 	(let ((cost (gethash key costs)))
 	  (if cost
 	      (let* ((count (vop-stats-count value))
@@ -353,15 +453,14 @@ VOP classification.
     res))
 
 
-;;; COMBINE-STATS  --  Internal
+;;; COMPARE-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.
+;;; entries have been compared.  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)
+(defun compare-stats (original compared)
   (declare (type hash-table original compared))
   (let ((res (make-hash-table-like original)))
     (do-hash (k cv compared)
@@ -377,6 +476,23 @@ VOP classification.
     res))
 
 
+;;; COMBINE-STATS  --  Public
+;;;
+(defun combine-stats (&rest tables)
+  "Sum the VOP stats for the specified tables, returning a new table with the
+   combined results."
+  (let ((res (make-hash-table-like (first tables))))
+    (dolist (table tables)
+      (do-hash (k v table)
+	(let ((found (or (gethash k res)
+			 (setf (gethash k res) (%make-vop-stats k)))))
+	  (incf (vop-stats-count found) (vop-stats-count v))
+	  (incf (vop-stats-cost found) (vop-stats-cost v)))))
+    res))
+
+
+;;;; Report generation:
+
 ;;; SORT-RESULT  --  Internal
 ;;;
 (defun sort-result (table by)
@@ -387,36 +503,177 @@ VOP classification.
 			(:cost (vop-stats-cost x)))))))
 
 
+;;; ENTRY-REPORT  --  Internal
+;;;
+;;;    Report about VOPs in the list of stats structures.
+;;;
+(defun entry-report (entries cut-off compensated compare total-cost)
+  (let ((counter (if (and cut-off (> (length entries) cut-off))
+		     cut-off
+		     most-positive-fixnum)))
+  (dolist (entry entries)
+    (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~] ~9,2F  ~5,2,2F%~%"
+	      (vop-stats-name entry)
+	      compare
+	      (if compare entry-count (round entry-count))
+	      (/ cost count)
+	      (/ (if compare
+		     (- (vop-stats-cost (gethash name compensated))
+			(vop-stats-cost comp-entry))
+		     cost)
+		 total-cost))
+      (when (zerop (decf counter))
+	(format t "[End of top ~D]~%" cut-off))))))
+
+;;; FIND-CUT-OFF  --  Internal
+;;;
+;;;    Divide Sorted into two lists, the first cut-off elements long.  Any VOP
+;;; names that match one of the report strings are moved into the report list
+;;; even if they would otherwise fall below the cut-off.
+;;;
+(defun find-cut-off (sorted cut-off report)
+  (if (or (not cut-off) (<= (length sorted) cut-off))
+      (values sorted ())
+      (let ((not-cut (subseq sorted 0 cut-off)))
+	(collect ((select)
+		  (reject))
+	  (dolist (el (nthcdr cut-off sorted))
+	    (let ((name (vop-stats-name el)))
+	      (if (matches-pattern name report)
+		  (select el)
+		  (reject el))))
+	  (values (append not-cut (select)) (reject))))))
+		  
+
+;;; CUT-OFF-REPORT  --  Internal
+;;;
+;;;    Display information about entries that were not displayed due to the
+;;; cut-off.  Note: if compare, we find the total cost delta and the geometric
+;; mean of the normalized counts.
+;;
+(defun cut-off-report (other compare total-cost)
+  (let ((rest-cost 0d0)
+	(rest-count 0d0)
+	(rest-entry-count (if compare 1d0 0d0)))
+    (dolist (entry other)
+      (incf rest-cost (vop-stats-cost entry))
+      (incf rest-count
+	    (vop-stats-count
+	     (if compare
+		 (gethash (vop-stats-name entry) compare)
+		 entry)))
+      (if compare
+	  (setq rest-entry-count
+		(* rest-entry-count (vop-stats-count entry)))
+	  (incf rest-entry-count (vop-stats-count entry))))
+    
+    (let ((count (if compare
+		     (expt rest-entry-count
+			   (/ (coerce (length other) 'double-float)))
+		     (round rest-entry-count))))
+      (format t "~30<Other~>: ~:[~13:D~;~13,2F~] ~9,2F  ~@[~5,2,2F%~]~%"
+	      compare count
+	      (/ rest-cost rest-count)
+	      (unless compare
+		(/ rest-cost total-cost))))))
+
+
+;;; COMPARE-REPORT  --  Internal
+;;;
+;;;    Report summary information about the difference between the comparison
+;;; and base data sets.
+;;;
+(defun compare-report (total-count total-cost compare-total-count
+				   compare-total-cost compensated compare)
+  (format t "~30<Relative total~>: ~13,2F ~9,2F~%"
+	  (/ total-count compare-total-count)
+	  (/ total-cost compare-total-cost))
+  (flet ((frob (a b sign wot)
+	   (multiple-value-bind
+	       (cost count) (cost-summary (hash-difference a b))
+	     (unless (zerop count)
+	       (format t "~30<~A~>: ~13:D ~9,2F  ~5,2,2F%~%"
+		       wot (* sign (round count))
+		       (* sign (/ cost count))
+		       (* sign (/ cost compare-total-cost)))))))
+    (frob compensated compare 1 "Not in comparison")
+    (frob compare compensated -1 "Only in comparison"))
+  (format t "~30<Comparison total~>: ~13,2E ~9,2E~%"
+	  compare-total-count compare-total-cost))
+
+
+;;; The fraction of system time that we guess happened during GC.
+;;;
+(defparameter *gc-system-fraction* 2/3)
+
+;;; FIND-CPI  --  Interface
+;;;
+;;;    Estimate CPI from CPU time and cycles accounted in profiling
+;;; information.
+;;;
+(defun find-cpi (total-cost user system gc clock)
+  (let ((adj-time (if (zerop gc)
+		      user
+		      (- user (- gc (* system *gc-system-fraction*))))))
+    (/ (* adj-time clock) total-cost)))
+
+  
 ;;; 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))
+			      (costs *native-costs*)
+			      ((:compare uncomp-compare))
+			      (compare-costs costs)
+			      ignore report
+			      (classes *basic-classes*)
+			      user (system 0d0) (gc 0d0)
+			      (clock 25d6))
+  (let* ((compensated
+	  (classify-costs
+	   (if costs
+	       (compensate-costs table costs ignore)
+	       table)
+	   classes))
+	 (compare
+	  (when uncomp-compare
+	    (classify-costs
+	     (if compare-costs
+		 (compensate-costs uncomp-compare compare-costs ignore)
+		 uncomp-compare)
+	     classes)))
 	 (compared (if compare
-		       (combine-stats compensated compare)
+		       (compare-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))
-	(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)))
+			 (cost-summary compensated)
+      (multiple-value-bind (compare-total-count compare-total-cost)
+			   (when compare (cost-summary compare))
+	(format t "~2&~30<Vop~>  ~13<Count~> ~9<Cost~>  ~6:@<Percent~>~%")
+	(let ((sorted (sort-result compared sort-by))
+	      (base-total (if compare compare-total-cost total-cost)))
+	  (multiple-value-bind
+	      (report other)
+	      (find-cut-off sorted cut-off report)
+	    (entry-report report cut-off compensated compare base-total)
+	    (when other
+	      (cut-off-report other compare base-total))))
+
+	(when compare
+	  (compare-report total-count total-cost compare-total-count
+			  compare-total-cost compensated compare))
+
+	(format t "~30<Total~>: ~13,2E ~9,2E~%" total-count total-cost)
+	(when user
+	  (format t "~%Cycles per instruction = ~,2F~%"
+		  (find-cpi total-cost user system gc clock))))))
   (values))