Skip to content
Snippets Groups Projects
Commit 92d52f8c authored by wlott's avatar wlott
Browse files

Initial revision

parent 3ee30c4c
No related branches found
No related tags found
No related merge requests found
;;; -*- 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)))))
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