contrib/sb-sprof/test.lisp

   1 (in-package :cl-user)
   2
   3 (require :sb-sprof)
   4 ;#+sb-fasteval (setq sb-ext:*evaluator-mode* :compile)
   5
   6 ;;; silly examples
   7
   8 (defun test-0 (n &optional (depth 0))
   9   (declare (optimize (debug 3)))
  10   (when (< depth n)
  11     (dotimes (i n)
  12       (test-0 n (1+ depth))
  13       (test-0 n (1+ depth)))))
  14
  15 (defun test ()
  16   (sb-sprof:with-profiling (:reset t :max-samples 1000 :report :graph)
  17     (test-0 7)))
  18
  19 (defun consalot ()
  20   (let ((junk '()))
  21     (loop repeat 10000 do
  22          (push (make-array 10) junk))
  23     junk))
  24
  25 (defun consing-test ()
  26   ;; 0.0001 chosen so that it breaks rather reliably when sprof does not
  27   ;; respect pseudo atomic.
  28   (sb-sprof:with-profiling (:reset t
  29                             ;; setitimer with small intervals
  30                             ;; is broken on FreeBSD 10.0
  31                             ;; And ARM targets are not fast in
  32                             ;; general, causing the profiling signal
  33                             ;; to be constantly delivered without
  34                             ;; making any progress.
  35                             #-(or freebsd arm) :sample-interval
  36                             #-(or freebsd arm) 0.0001
  37                             #+arm :sample-interval #+arm 0.1
  38                             :report :graph :loop nil)
  39     (let ((target (+ (get-universal-time) 15)))
  40       (princ #\.)
  41       (force-output)
  42       (loop while (< (get-universal-time) target)
  43             do (consalot)))))
  44
  45 #-(or win32 darwin)                    ;not yet
  46 (test)
  47 #-(or win32 darwin)                    ;not yet
  48 (consing-test)
  49
  50 ;; For debugging purposes, print output for visual inspection to see if
  51 ;; the allocation sequence gets hit in the right places (i.e. not at all
  52 ;; in traditional builds, and everywhere if SB-SAFEPOINT-STRICTLY is
  53 ;; enabled.)
  54 #+nil (disassemble #'consalot)