diff --git a/code/dyncount.lisp b/code/dyncount.lisp new file mode 100644 index 0000000000000000000000000000000000000000..fb5ce1b1164684fa09ada0bc5d0a68c68a85aaaa --- /dev/null +++ b/code/dyncount.lisp @@ -0,0 +1,192 @@ +;;; -*- 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). +;;; ********************************************************************** +;;; +;;; Runtime support for dynamic statistic collecting. +;;; +(in-package "C") + +(eval-when (compile) + (when *collect-dynamic-statistics* + (error "Compiling this file with dynamic stat collection turn on would ~ + be a very bad idea."))) + + +(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 note-dyncount-info (info) + (declare (type dyncount-info info)) + (let ((counts (dyncount-info-counts info)) + (vops (dyncount-info-vops info))) + (dotimes (index (length counts)) + (let ((count (aref counts index))) + (unless (zerop count) + (let* ((vop-info (svref vops index)) + (length (length vop-info))) + (do ((i 0 (+ i 4))) + ((>= i length)) + (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))))))))) + + +(defun clear-dyncount-info (info) + (declare (type dyncount-info info)) + (fill (dyncount-info-counts info) 0) + nil) + + +(defun find-info-for (function) + (declare (type function function)) + (let* ((function (%primitive closure-function function)) + (component (di::function-code-header function))) + (do ((end (get-header-data component)) + (i vm:code-constants-offset (1+ i))) + ((= end i)) + (let ((constant (code-header-ref component i))) + (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) + (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)))))) + (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)))))