diff --git a/compiler/codegen.lisp b/compiler/codegen.lisp index 14f8ba758fce49b2dae5519cba0c04081d364566..9d2e49f2043bb54d4e1c87289a6b45c41bf771e8 100644 --- a/compiler/codegen.lisp +++ b/compiler/codegen.lisp @@ -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))) diff --git a/compiler/main.lisp b/compiler/main.lisp index cdd910862d572909fd5e16442f5a5f7b65f52dcd..8074e130ef2627c732194af45cf97accf0406f18 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -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")