From fad68d8e885e54d101015ba7648cb9f47c678077 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 11 Dec 1990 15:23:20 +0000
Subject: [PATCH] Moved static vop counting into it's own file: statcount.

---
 compiler/main.lisp | 106 +++------------------------------------------
 1 file changed, 5 insertions(+), 101 deletions(-)

diff --git a/compiler/main.lisp b/compiler/main.lisp
index c31c33c2d..90cde7a70 100644
--- a/compiler/main.lisp
+++ b/compiler/main.lisp
@@ -29,8 +29,7 @@
 		    *compiler-trace-output*
 		    *last-source-context* *last-original-source*
 		    *last-source-form* *last-format-string* *last-format-args*
-		    *last-message-count* *lexical-environment*
-		    *count-vop-usages*))
+		    *last-message-count* *lexical-environment*))
 
 (defparameter compiler-version "0.0")
 
@@ -72,100 +71,6 @@
 
 (deftype object () '(or fasl-file core-object null))
 
-
-;;;; Vop counting utilities
-
-;;; T if we should count the number of times we use each vop and the number
-;;; of instructions that come from each.
-;;; 
-(defvar *count-vop-usages* nil)
-
-;;; Hash table containing all the current counts.  The key is the name of the
-;;; vop, and the value is a cons of the car holding the number of times that
-;;; vop has been used and the cdr holding the number of instructions that
-;;; vop has accounted for.
-;;; 
-(defvar *vop-counts* (make-hash-table :test #'eq))
-
-(defun count-vop (vop)
-  (let ((entry (gethash vop *vop-counts*)))
-    (unless entry
-      (setf entry (cons 0 0))
-      (setf (gethash vop *vop-counts*) entry))
-    (incf (car entry))))
-
-(defun count-vop-instructions (vop instructions)
-  (let ((entry (gethash vop *vop-counts*)))
-    (unless entry
-      (setf entry (cons 0 0))
-      (setf (gethash vop *vop-counts*) entry))
-    (incf (cdr entry) instructions)))
-
-;;; Clear-Vop-Counts -- interface
-;;; 
-(defun clear-vop-counts ()
-  (clrhash *vop-counts*)
-  nil)
-
-;;; Report-Vop-Counts -- interface
-;;;
-(defun report-vop-counts (&key (cut-off 15) (sort-by :size))
-  (declare (type (or null unsigned-byte) cut-off)
-	   (type (member :size :count :name) sort-by))
-  (let ((results nil)
-	(total-count 0)
-	(total-size 0))
-    (maphash #'(lambda (key value)
-		 (push (cons key value) results)
-		 (incf total-count (car value))
-		 (incf total-size (cdr value)))
-	     *vop-counts*)
-    (format t "~20<Vop ~> ~20:@<Count~> ~20:@<Bytes~> Ave Sz~%")
-    (dolist (info (sort results
-			(ecase sort-by
-			  (:name #'(lambda (name-1 name-2)
-				     (string< (symbol-name name-1)
-					      (symbol-name name-2))))
-			  ((:count :size) #'>))
-			:key (ecase sort-by
-			       (:name #'car)
-			       (:count #'cadr)
-			       (:size #'cddr))))
-      (when cut-off
-	(if (zerop cut-off)
-	    (return)
-	    (decf cut-off)))
-      (format t "~20<~S~> ~20<~:D (~4,1,2F%)~> ~20<~D (~4,1,2F%)~> ~6D~%"
-	      (car info)
-	      (cadr info)
-	      (/ (coerce (cadr info) 'double-float)
-		 (coerce total-count 'double-float))
-	      (cddr info)
-	      (/ (coerce (cddr info) 'double-float)
-		 (coerce total-size 'double-float))
-	      (truncate (cddr info) (cadr info)))))
-  (values))
-
-(defun save-vop-counts (filename)
-  (with-open-file (stream filename :direction :output :if-exists :supersede)
-    (maphash #'(lambda (key value)
-		 (print (cons key value) stream))
-	     *vop-counts*)))
-
-(defun augment-vop-counts (filename)
-  (with-open-file (stream filename)
-    (loop
-      (let ((stuff (read stream nil :eof)))
-	(when (eq stuff :eof)
-	  (return))
-	(multiple-value-bind (entry found) (gethash (car stuff) *vop-counts*)
-	  (cond (found
-		 (incf (car entry) (cadr stuff))
-		 (incf (cdr entry) (cddr stuff)))
-		(t
-		 (setf (gethash (car stuff) *vop-counts*)
-		       (cdr stuff)))))))))
-
 
 ;;;; Component compilation:
 
@@ -322,9 +227,6 @@
     (when *compiler-trace-output*
       (describe-component component *compiler-trace-output*))
     
-    (when *collect-dynamic-statistics*
-      (setup-dynamic-count-info component))
-
     (maybe-mumble "Code ")
     (let ((length (generate-code component)))
       
@@ -335,8 +237,10 @@
 	(dump-segment *code-segment* *compiler-trace-output*))
 
       (when *count-vop-usages*
-	(count-vops component)
-	(count-instructions *code-segment*))
+	(count-vops component))
+
+      (when *collect-dynamic-statistics*
+	(setup-dynamic-count-info component))
 
       (etypecase object
 	(fasl-file
-- 
GitLab