;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;;; DAMAGE.
-;;; Statistical profiler for x86.
+;;; Statistical profiler.
;;; Overview:
;;;
(defun topological-sort (dag)
(let ((sorted ())
(dfn -1))
- (labels ((sort (v)
+ (labels ((rec-sort (v)
(setf (vertex-visited v) t)
(setf (vertex-dfn v) (incf dfn))
(dolist (e (vertex-edges v))
(unless (vertex-visited (edge-vertex e))
- (sort (edge-vertex e))))
+ (rec-sort (edge-vertex e))))
(push v sorted)))
- (map-vertices #'sort dag)
+ (map-vertices #'rec-sort dag)
(nreverse sorted))))
;;; Reduce graph G to a dag by coalescing strongly connected components
(rotatef (aref vec i) (aref vec j))))
(key (i)
(aref vec (+ i key-offset)))
- (sort (from to)
+ (rec-sort (from to)
(when (> to from)
(let* ((mid (* element-size
(round (+ (/ from element-size)
(when (< j i) (return))
(rotate i j))
(rotate from j)
- (sort from (- j element-size))
- (sort i to)))))
- (sort from to)
+ (rec-sort from (- j element-size))
+ (rec-sort i to)))))
+ (rec-sort from to)
vec))
\f
(deftype address ()
"Type used for addresses, for instance, program counters,
code start/end locations etc."
- '(unsigned-byte 32))
+ '(unsigned-byte #+alpha 64 #-alpha 32))
(defconstant +unknown-address+ 0
"Constant representing an address that cannot be determined.")
#-x86
(defun sigprof-handler (signal code scp)
- (declare (ignore signal code scp))
- (error "Implement me."))
+ (declare (ignore signal code))
+ (when (and *sampling*
+ (< *samples-index* (length *samples*)))
+ (sb-sys:without-gcing
+ (with-alien ((scp (* os-context-t) :local scp))
+ (locally (declare (optimize (inhibit-warnings 2)))
+ (let* ((pc-ptr (sb-vm:context-pc scp))
+ (fp (sb-vm::context-register scp #.sb-vm::cfp-offset))
+ (ra (sap-ref-32
+ (int-sap fp)
+ (* sb-vm::lra-save-offset sb-vm::n-word-bytes))))
+ (record (sap-int pc-ptr))
+ (record ra)))))))
;;; Map function FN over code objects in dynamic-space. FN is called
;;; with two arguments, the object and its size in bytes.
;;; Return a CALL-GRAPH structure for the current contents of
;;; *SAMPLES*. The result contain a list of nodes sorted by self-time
-;;; in the FLAT-NODES slot, and a dag in Vertices, with call cycles
-;;; reduced to Cycle structures.
+;;; in the FLAT-NODES slot, and a dag in VERTICES, with call cycles
+;;; reduced to CYCLE structures.
(defun make-call-graph ()
(stop-profiling)
(show-progress "~&Computing call graph ")
(format t "~& Count % Parts~%")
(do-vertices (node call-graph)
(when (cycle-p node)
- (flet ((print (indent index count percent name)
+ (flet ((print-info (indent index count percent name)
(format t "~&~6d ~5,1f ~11@t ~V@t ~s [~d]~%"
count percent indent name index)))
(print-separator)
(samples-percent call-graph (cycle-count node))
(node-name node))
(dolist (v (vertex-scc-vertices node))
- (print 4 (node-index v) (node-count v)
- (samples-percent call-graph (node-count v))
- (node-name v))))))
+ (print-info 4 (node-index v) (node-count v)
+ (samples-percent call-graph (node-count v))
+ (node-name v))))))
(print-separator)
(format t "~2%")))
(print-cycles call-graph)
(flet ((find-call (from to)
(find to (node-edges from) :key #'call-vertex))
- (print (indent index count percent name)
+ (print-info (indent index count percent name)
(format t "~&~6d ~5,1f ~11@t ~V@t ~s [~d]~%"
count percent indent name index)))
(format t "~& Callers~%")
;; Print caller information.
(dolist (caller (node-callers node))
(let ((call (find-call caller node)))
- (print 4 (node-index caller)
- (call-count call)
- (samples-percent call-graph (call-count call))
- (node-name caller))))
+ (print-info 4 (node-index caller)
+ (call-count call)
+ (samples-percent call-graph (call-count call))
+ (node-name caller))))
;; Print the node itself.
(format t "~&~6d ~5,1f ~6d ~5,1f ~s [~d]~%"
(node-count node)
(node-index node))
;; Print callees.
(do-edges (call called node)
- (print 4 (node-index called)
- (call-count call)
- (samples-percent call-graph (call-count call))
- (node-name called))))
+ (print-info 4 (node-index called)
+ (call-count call)
+ (samples-percent call-graph (call-count call))
+ (node-name called))))
(print-separator)
(format t "~2%")
(print-flat call-graph :stream stream :max max
((nil)))
graph))
-;;;; Silly Examples
+;;; silly examples
(defun test-0 (n &optional (depth 0))
(declare (optimize (debug 3)))
(with-profiling (:reset t :max-samples 1000 :report :graph)
(test-0 7)))
-;;; End of file.
+
+;;; provision
+(provide 'sb-sprof)
+
+;;; end of file
projects / sbcl.git / blobdiff