Skip to content
Snippets Groups Projects
Commit 7c896eb1 authored by wlott's avatar wlott
Browse files

Added noise to count the number of times each vop is used and the number

of bytes each vop results in.  This feature is controlled by the special
*count-vop-usages*.
parent 643190af
No related branches found
No related tags found
No related merge requests found
......@@ -109,6 +109,13 @@
(finalize-segment *code-segment*))
(defun count-vops (component)
(do-ir2-blocks (block component)
(do ((vop (ir2-block-start-vop block) (vop-next vop)))
((null vop))
(count-vop (vop-info-name (vop-info vop))))))
(defun emit-label-elsewhere (label)
(assemble (*elsewhere* nil)
(emit-label label)))
......
......@@ -26,7 +26,8 @@
*compiler-trace-output*
*last-source-context* *last-original-source*
*last-source-form* *last-format-string* *last-format-args*
*last-message-count* *lexical-environment*))
*last-message-count* *lexical-environment*
*count-vop-usages*))
(defparameter compiler-version "0.0")
......@@ -68,6 +69,80 @@
(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))
;;;; Component compilation:
......@@ -226,6 +301,10 @@
component)
(dump-segment *code-segment* *compiler-trace-output*))
(when *count-vop-usages*
(count-vops component)
(count-instructions *code-segment*))
(etypecase object
(fasl-file
(maybe-mumble "FASL")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment