(end (+ start (sb-kernel:%code-code-size code))))
(values start end)))
-;;; Record the addresses of dynamic-space code objects in
-;;; *DYNAMIC-SPACE-CODE-INFO*. Call this with GC disabled.
(defun record-dyninfo ()
(setf *dynamic-space-code-info* nil)
(flet ((record-address (code size)
;; (pushnew 'turn-off-sampling *before-gc-hooks*)
(pushnew 'adjust-samples-for-address-changes *after-gc-hooks*)
(record-dyninfo)
- (sb-sys:enable-interrupt sb-unix::sigprof #'sigprof-handler)
+ (sb-sys:enable-interrupt sb-unix:sigprof #'sigprof-handler)
(unix-setitimer :profile secs usecs secs usecs)
(setq *profiling* t)))
(values))
(setq *after-gc-hooks*
(delete 'adjust-samples-for-address-changes *after-gc-hooks*))
(unix-setitimer :profile 0 0 0 0)
- (sb-sys:enable-interrupt sb-unix::sigprof :default)
+ ;; Even with the timer shut down we cannot be sure that there is
+ ;; no undelivered sigprof. Besides, leaving the signal handler
+ ;; installed won't hurt.
(setq *sampling* nil)
(setq *profiling* nil))
(values))
(end-offset (sb-c::compiled-debug-fun-elsewhere-pc cdf))
(component (sb-di::compiled-debug-fun-component info))
(start-pc (code-start component)))
+ ;; Call graphs are mostly useless unless we somehow
+ ;; distinguish a gazillion different (LAMBDA ())'s.
+ (when (equal name '(lambda ()))
+ (setf name (format nil "Unknown component: #x~x" start-pc)))
(%make-node :name name
:start-pc (+ start-pc start-offset)
:end-pc (+ start-pc end-offset))))
(let ((info (debug-info pc)))
(when info
(let* ((new (make-node info))
- (found (gethash (node-name new) *name->node*)))
+ (key (cons (node-name new)
+ (node-start-pc new)))
+ (found (gethash key *name->node*)))
(cond (found
(setf (node-start-pc found)
(min (node-start-pc found) (node-start-pc new)))
(max (node-end-pc found) (node-end-pc new)))
found)
(t
- (setf (gethash (node-name new) *name->node*) new)
+ (setf (gethash key *name->node*) new)
(tree-insert new)
new)))))))
(format t "~&~V,,,V<~>~%" length char))
(defun samples-percent (call-graph count)
- (* 100.0 (/ count (call-graph-nsamples call-graph))))
+ (if (> count 0)
+ (* 100.0 (/ count (call-graph-nsamples call-graph)))
+ 0))
(defun print-call-graph-header (call-graph)
(let ((nsamples (call-graph-nsamples call-graph))