X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-sprof%2Fsb-sprof.lisp;h=eb0640e57114faf58d7fd4bf492e4055a84adf71;hb=4fe24806cb00efee6bbd64f6575eadb3cedcb224;hp=45d9859170689388d2624937df0d6c7451e25359;hpb=554397512eea9d6e30067c5edc2def42006a5327;p=sbcl.git

diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp
index 45d9859..eb0640e 100644
--- a/contrib/sb-sprof/sb-sprof.lisp
+++ b/contrib/sb-sprof/sb-sprof.lisp
@@ -27,7 +27,7 @@
 ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 ;;; DAMAGE.
 
-;;; Statistical profiler for x86.
+;;; Statistical profiler.
 
 ;;; Overview:
 ;;;
@@ -202,14 +202,14 @@
 (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
@@ -382,7 +382,7 @@
 		     (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)
@@ -403,9 +403,9 @@
 		    (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))
 
 
@@ -414,7 +414,7 @@
 (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.")
@@ -580,8 +580,19 @@
 
 #-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.
@@ -922,8 +933,8 @@
 
 ;;; 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 ")
@@ -1002,7 +1013,7 @@
     (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)
@@ -1011,9 +1022,9 @@
 		  (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%")))
 
@@ -1025,7 +1036,7 @@
     (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~%")
@@ -1037,10 +1048,10 @@
 	;; 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)
@@ -1051,10 +1062,10 @@
 		(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
@@ -1100,7 +1111,7 @@
       ((nil)))
     graph))
 
-;;;; Silly Examples
+;;; silly examples
 
 (defun test-0 (n &optional (depth 0))
   (declare (optimize (debug 3)))
@@ -1113,4 +1124,8 @@
   (with-profiling (:reset t :max-samples 1000 :report :graph)
     (test-0 7)))
 
-;;; End of file.
+
+;;; provision
+(provide 'sb-sprof)
+
+;;; end of file