sb-sprof: Split into multiple files

* COPYING: extracted license

* README: extracted source-level documentation

* package.lisp: package definition for the contrib

* record.lisp: sample storage and sampling

* call-graph.lisp: call graph data structures and computation

* report.lisp: reporting functions; currently flat report and graph
  report

* interface.lisp: exported functions and macros

* disassemble.lisp: disassembler integration

* call-counting.lisp: call counting functionality; mostly orthogonal
  to everything else

contrib/sb-sprof/COPYING

@@ -0,0 +1,28 @@
+Copyright (C) 2003 Gerd Moellmann <[email protected]>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. The name of the author may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
+OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.

contrib/sb-sprof/README

@@ -0,0 +1,65 @@
+Statistical profiler.
+
+Overview:
+
+This profiler arranges for SIGPROF interrupts to interrupt a running
+program at regular intervals. Each time a SIGPROF occurs, the current
+program counter and return address is recorded in a vector, until a
+configurable maximum number of samples have been taken.
+
+A profiling report is generated from the samples array by determining
+the Lisp functions corresponding to the recorded addresses. Each
+program counter/return address pair forms one edge in a call graph.
+
+Problems:
+
+The code being generated on x86 makes determining callers reliably
+something between extremely difficult and impossible. Example:
+
+10979F00: .entry eval::eval-stack-args(arg-count)
+ 18: pop dword ptr [ebp-8]
+ 1B: lea esp, [ebp-32]
+ 1E: mov edi, edx
+
+ 20: cmp ecx, 4
+ 23: jne L4
+ 29: mov [ebp-12], edi
+ 2C: mov dword ptr [ebp-16], #x28F0000B ; nil
+ ; No-arg-parsing entry point
+ 33: mov dword ptr [ebp-20], 0
+ 3A: jmp L3
+ 3C: L0: mov edx, esp
+ 3E: sub esp, 12
+ 41: mov eax, [#x10979EF8] ; #<FDEFINITION object for eval::eval-stack-pop>
+ 47: xor ecx, ecx
+ 49: mov [edx-4], ebp
+ 4C: mov ebp, edx
+ 4E: call dword ptr [eax+5]
+ 51: mov esp, ebx
+
+Suppose this function is interrupted by SIGPROF at 4E. At that point,
+the frame pointer EBP has been modified so that the original return
+address of the caller of eval-stack-args is no longer where it can be
+found by x86-call-context, and the new return address, for the call to
+eval-stack-pop, is not yet on the stack. The effect is that
+x86-call-context returns something bogus, which leads to wrong edges
+in the call graph.
+
+One thing that one might try is filtering cases where the program is
+interrupted at a call instruction. But since the above example of an
+interrupt at a call instruction isn't the only case where the stack is
+something x86-call-context can't really cope with, this is not a
+general solution.
+
+Random ideas for implementation:
+
+* Space profiler. Sample when new pages are allocated instead of
+ at SIGPROF.
+
+* Record a configurable number of callers up the stack. That could
+ give a more complete graph when there are many small functions.
+
+* Print help strings for reports, include hints to the problem
+ explained above.
+
+* Make flat report the default since call-graph isn't that reliable?

contrib/sb-sprof/call-counting.lisp

@@ -0,0 +1,86 @@
+;;;; Call counting extension to the statistical profiler
+;;;;
+;;;; Copyright (C) 2003 Gerd Moellmann <[email protected]>
+;;;; All rights reserved.
+
+(in-package #:sb-sprof)
+
+
+;;;; Call counting
+
+;;; The following functions tell sb-sprof to do call count profiling
+;;; for the named functions in addition to normal statistical
+;;; profiling. The benefit of this over using SB-PROFILE is that this
+;;; encapsulation is a lot more lightweight, due to not needing to
+;;; track cpu usage / consing. (For example, compiling asdf 20 times
+;;; took 13s normally, 15s with call counting for all functions in
+;;; SB-C, and 94s with SB-PROFILE profiling SB-C).
+
+(defun profile-call-counts (&rest names)
+ "Mark the functions named by NAMES as being subject to call counting
+during statistical profiling. If a string is used as a name, it will
+be interpreted as a package name. In this case call counting will be
+done for all functions with names like X or (SETF X), where X is a symbol
+with the package as its home package."
+ (dolist (name names)
+ (if (stringp name)
+ (let ((package (find-package name)))
+ (do-symbols (symbol package)
+ (when (eql (symbol-package symbol) package)
+ (dolist (function-name (list symbol (list 'setf symbol)))
+ (profile-call-counts-for-function function-name)))))
+ (profile-call-counts-for-function name))))
+
+(defun profile-call-counts-for-function (function-name)
+ (unless (gethash function-name *encapsulations*)
+ (setf (gethash function-name *encapsulations*) nil)))
+
+(defun unprofile-call-counts ()
+ "Clear all call counting information. Call counting will be done for no
+functions during statistical profiling."
+ (clrhash *encapsulations*))
+
+;;; Called when profiling is started to enable the call counting
+;;; encapsulation. Wrap all the call counted functions
+(defun enable-call-counting ()
+ (maphash (lambda (k v)
+ (declare (ignore v))
+ (enable-call-counting-for-function k))
+ *encapsulations*))
+
+;;; Called when profiling is stopped to disable the encapsulation. Restore
+;;; the original functions.
+(defun disable-call-counting ()
+ (maphash (lambda (k v)
+ (when v
+ (assert (cdr v))
+ (without-package-locks
+ (setf (fdefinition k) (cdr v)))
+ (setf (cdr v) nil)))
+ *encapsulations*))
+
+(defun enable-call-counting-for-function (function-name)
+ (let ((info (gethash function-name *encapsulations*)))
+ ;; We should never try to encapsulate an fdefn multiple times.
+ (assert (or (null info)
+ (null (cdr info))))
+ (when (and (fboundp function-name)
+ (or (not (symbolp function-name))
+ (and (not (special-operator-p function-name))
+ (not (macro-function function-name)))))
+ (let* ((original-fun (fdefinition function-name))
+ (info (cons 0 original-fun)))
+ (setf (gethash function-name *encapsulations*) info)
+ (without-package-locks
+ (setf (fdefinition function-name)
+ (sb-int:named-lambda call-counter (sb-int:&more more-context more-count)
+ (declare (optimize speed (safety 0)))
+ ;; 2^59 calls should be enough for anybody, and it
+ ;; allows using fixnum arithmetic on x86-64. 2^32
+ ;; isn't enough, so we can't do that on 32 bit platforms.
+ (incf (the (unsigned-byte 59)
+ (car info)))
+ (multiple-value-call original-fun
+ (sb-c:%more-arg-values more-context
+ 0
+ more-count)))))))))

contrib/sb-sprof/disassemble.lisp

@@ -0,0 +1,42 @@
+;;;; Disassembler integration for the statistical profiler
+;;;;
+;;;; Copyright (C) 2003 Gerd Moellmann <[email protected]>
+;;;; All rights reserved.
+
+(in-package #:sb-sprof)
+
+(defun sample-pc-from-pc-or-offset (sample pc-or-offset)
+ (etypecase sample
+ ;; Assembly routines or foreign functions don't move around, so we've
+ ;; stored a raw PC
+ ((or sb-kernel:code-component string)
+ pc-or-offset)
+ ;; Lisp functions might move, so we've stored a offset from the
+ ;; start of the code component.
+ (sb-di::compiled-debug-fun
+ (let* ((component (sb-di::compiled-debug-fun-component sample))
+ (start-pc (code-start component)))
+ (+ start-pc pc-or-offset)))))
+
+(defun add-disassembly-profile-note (chunk stream dstate)
+ (declare (ignore chunk stream))
+ (when *samples*
+ (let* ((location (+ (sb-disassem::seg-virtual-location
+ (sb-disassem:dstate-segment dstate))
+ (sb-disassem::dstate-cur-offs dstate)))
+ (samples (loop with index = (samples-index *samples*)
+ for x from 0 below (- index 2) by 2
+ for last-sample = nil then sample
+ for sample = (aref (samples-vector *samples*) x)
+ for pc-or-offset = (aref (samples-vector *samples*)
+ (1+ x))
+ when (and sample (eq last-sample 'trace-start))
+ count (= location
+ (sample-pc-from-pc-or-offset sample
+ pc-or-offset)))))
+ (unless (zerop samples)
+ (sb-disassem::note (format nil "~A/~A samples"
+ samples (samples-trace-count *samples*))
+ dstate)))))
+
+(pushnew 'add-disassembly-profile-note sb-disassem::*default-dstate-hooks*)