contrib/sb-sprof/test.lisp

   1 (in-package :cl-user)
   2
   3 (require :sb-sprof)
   4
   5 ;;; silly examples
   6
   7 (defun test-0 (n &optional (depth 0))
   8   (declare (optimize (debug 3)))
   9   (when (< depth n)
  10     (dotimes (i n)
  11       (test-0 n (1+ depth))
  12       (test-0 n (1+ depth)))))
  13
  14 (defun test ()
  15   (sb-sprof:with-profiling (:reset t :max-samples 1000 :report :graph)
  16     (test-0 7)))
  17
  18 (defun consalot ()
  19   (let ((junk '()))
  20     (loop repeat 10000 do
  21          (push (make-array 10) junk))
  22     junk))
  23
  24 (defun consing-test ()
  25   ;; 0.0001 chosen so that it breaks rather reliably when sprof does not
  26   ;; respect pseudo atomic.
  27   (sb-sprof:with-profiling (:reset t :sample-interval 0.0001 :report :graph :loop nil)
  28     (let ((target (+ (get-universal-time) 15)))
  29       (princ #\.)
  30       (force-output)
  31       (loop
  32          while (< (get-universal-time) target)
  33          do (consalot)))))
  34
  35 #-(or win32 darwin)                    ;not yet
  36 (test)
  37 #-(or win32 darwin)                    ;not yet
  38 (consing-test)
  39
  40 ;; For debugging purposes, print output for visual inspection to see if
  41 ;; the allocation sequence gets hit in the right places (i.e. not at all
  42 ;; in traditional builds, and everywhere if SB-SAFEPOINT-STRICTLY is
  43 ;; enabled.)
  44 (disassemble #'consalot)