├── screenshot.png ├── src ├── package.lisp ├── trace-event.lisp ├── main.lisp └── impl-sbcl.lisp ├── tracer.asd ├── LICENSE └── README.org /screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/TeMPOraL/tracer/HEAD/screenshot.png -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:tracer 2 | (:use #:cl) 3 | 4 | (:export #:start-tracing 5 | #:stop-tracing 6 | #:with-tracing 7 | #:save-report 8 | 9 | ;; Extra utility 10 | #:package-symbols-except)) 11 | 12 | -------------------------------------------------------------------------------- /tracer.asd: -------------------------------------------------------------------------------- 1 | (asdf:defsystem #:tracer 2 | :author "Jacek TeMPOraL Złydach" 3 | :description "A tracing and profiling utility" 4 | :version "0.0.1" 5 | :license "MIT" 6 | 7 | :homepage "https://github.com/TeMPOraL/tracer" 8 | :bug-tracker "https://github.com/TeMPOraL/tracer/issues" 9 | :source-control (:git "https://github.com/TeMPOraL/tracer.git") 10 | :mailto "tracer@jacek.zlydach.pl" 11 | 12 | :encoding :utf-8 13 | 14 | :depends-on (#:alexandria 15 | #:bordeaux-threads) 16 | 17 | :pathname "src/" 18 | :serial t 19 | 20 | :components ((:file "package") 21 | (:file "trace-event") 22 | #+sbcl (:file "impl-sbcl") 23 | (:file "main"))) 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Jacek Złydach 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/trace-event.lisp: -------------------------------------------------------------------------------- 1 | ;;;; Trace Event - the base data unit that's stored by the tracer. 2 | ;;;; Trace event format mimicks the Google Chrome's Tracing convention with PID assumed to be `*TRACE-EVENT-DEFAULT-PID*' by default, 3 | ;;;; and category being inferred when dumping the trace to file. 4 | 5 | (in-package #:tracer) 6 | 7 | 8 | 9 | (defvar *trace-event-default-pid* 1 "The default value for PID for the trace events. This library is currently intended for use within a single process only.") 10 | 11 | (defvar +arg-converter-ignore-all+ (constantly 'skipped) "A converter that rejects all parameters.") 12 | (defvar +arg-converter-passthrough+ (lambda (&rest args) args) "A converter that remembers all args as is, without modifying them.") 13 | (defvar +arg-converter-store-only-simple-objects+ (lambda (&rest args) 14 | (mapcar (lambda (arg) 15 | (typecase arg 16 | ((or boolean character number symbol) 17 | arg) 18 | (t 19 | (type-of arg)))) 20 | args)) 21 | "A converter that remembers directly only objects of simple types, that cannot or are very unlikely to be destructively modified.") 22 | (defvar +arg-converter-store-only-simple-objects-and-strings+ (lambda (&rest args) 23 | (mapcar (lambda (arg) 24 | (typecase arg 25 | ((or boolean character number symbol string) 26 | arg) 27 | (t 28 | (type-of arg)))) 29 | args)) 30 | "Like `+ARG-CONVERTER-STORE-ONLY-SIMPLE-OBJECTS+', but also records strings as-is, hoping they don't get destructively modified too much.") 31 | 32 | (defvar *default-arg-converter* +arg-converter-ignore-all+) 33 | (defvar *tracing-arg-converters* (make-hash-table :test 'equal)) 34 | 35 | 36 | 37 | ;;; The format of trace event; created primarily for reference, though later on we might upgrade to vector storage, and then it'll come helpful. 38 | (defstruct (trace-event (:type list)) 39 | "A single event being traced. " 40 | (phase :undefined :type keyword) 41 | (name nil :type (or symbol cons)) 42 | (thread 0 :type t) 43 | (timestamp 0 :type alexandria:non-negative-fixnum) 44 | (args nil :type t) 45 | (duration 0 :type (or null alexandria:non-negative-fixnum)) 46 | (id nil :type t)) 47 | 48 | ;;; TODO: define accessors manually, to save performance? or somehow optimize it. -- Jacek Złydach, 2019-11-04 49 | 50 | (declaim (inline convert-args)) 51 | (defun convert-args (traced-fn-name args) 52 | "Depending on the function being traced, named `TRACED-FN-NAME', and the value of `*DEFAULT-ARG-CONVERTER*' 53 | convert the list of arguments `ARGS' to a form suitable for storing with the trace event, using a converter 54 | registered under `*TRACING-ARG-CONVERTERS*'. 55 | Returns the representation of `ARGS' to store." 56 | (declare (optimize (speed 3))) 57 | (apply (the function (gethash traced-fn-name *tracing-arg-converters* *default-arg-converter*)) 58 | args)) 59 | 60 | (declaim (inline make-trace-event-fast)) 61 | (defun make-trace-event-fast (phase name thread timestamp args duration id) 62 | "Like `MAKE-TRACE-EVENT', but inlined, unsafe and without typechecking." 63 | (declare (optimize (speed 3))) 64 | (list phase name thread timestamp (convert-args name args) duration id)) 65 | -------------------------------------------------------------------------------- /src/main.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:tracer) 2 | 3 | ;;; Trace operations: 4 | ;;; 1. Reset 5 | ;;; 2. Trace 6 | ;;; 2.5 snapshot tracing? 7 | ;;; 3. Stop tracing 8 | ;;; 4. Save report 9 | 10 | #-sbcl (error "This system currently works only on SBCL.") 11 | 12 | (defvar *tracing-p* nil "Is currently tracing activity happening?") 13 | 14 | ;;; Trace info entry type, for function call 15 | ;;; - Timestamp 16 | ;;; - Function name 17 | ;;; - Function args maybe? (trace-with-args), on enter 18 | ;;; - Function return value, on exit 19 | ;;; - Beginning or ending 20 | ;;; - Thread ID 21 | 22 | 23 | 24 | ;;; This prints a representation of the return values delivered. 25 | ;;; First, this checks to see that cookie is at the top of 26 | ;;; *TRACED-ENTRIES*; if it is not, then we need to adjust this list 27 | ;;; to determine the correct indentation for output. We then check to 28 | ;;; see whether the function is still traced and that the condition 29 | ;;; succeeded before printing anything. 30 | 31 | (defmacro with-tracing ((&rest specs) &body body) 32 | `(unwind-protect 33 | (progn 34 | (reset-tracing) 35 | (start-tracing ,@specs) 36 | (progn 37 | ,@body)) 38 | (stop-tracing))) 39 | 40 | 41 | 42 | ;;; FIXME: this still has an SBCL dependency -- Jacek Złydach, 2019-10-18 43 | (defun function-name->name-and-category (function-name) 44 | (etypecase function-name 45 | (symbol 46 | (values (symbol-name function-name) (package-name (symbol-package function-name)))) 47 | (cons 48 | (ecase (first function-name) 49 | (setf 50 | (values (format nil "~S" function-name) (package-name (symbol-package (second function-name))))) 51 | ((method sb-pcl::combined-method) 52 | (values (remove #\Newline (format nil "~S" function-name)) 53 | (if (consp (second function-name)) 54 | (package-name (symbol-package (second (second function-name)))) 55 | (package-name (symbol-package (second function-name)))))))))) 56 | 57 | (defgeneric post-process-arg (arg) 58 | (:method ((arg t)) 59 | "Passthrough method." 60 | (or (ignore-errors 61 | (prin1-to-string arg)) 62 | "!!Error printing argument!!")) 63 | (:documentation "A hook useful for changing the printed representation of input and return values.")) 64 | 65 | (defmethod post-process-arg ((arg sequence)) 66 | (if (every (lambda (el) (typep el 'number)) arg) 67 | (format nil "[~{~F~^, ~}]" (coerce arg 'list)) 68 | (call-next-method))) 69 | 70 | ;;; FIXME: Something breaks if not collecting args, and :skip-args is NIL. Probably the getf in printing. -- Jacek Złydach, 2019-11-05 71 | (defun trace-event->json (trace-event &key (skip-args nil)) 72 | (flet ((sanitize-and-format-args-list (argslist) 73 | (if skip-args "\"skipped\"" 74 | (substitute #\Space #\Newline (format nil "[~{~S~^, ~}]" (mapcar #'post-process-arg argslist)))))) 75 | (ecase (trace-event-phase trace-event) 76 | (:enter 77 | (multiple-value-bind (name category) 78 | (function-name->name-and-category (trace-event-name trace-event)) 79 | (format nil 80 | "{ \"name\" : ~S, \"cat\" : ~S, \"ph\" : \"B\", \"pid\" : 1, \"tid\" : ~D, \"ts\" : ~D, \"args\" : { \"in\" : ~A }}" 81 | name 82 | category 83 | (sb-impl::get-lisp-obj-address (trace-event-thread trace-event)) 84 | (trace-event-timestamp trace-event) 85 | (sanitize-and-format-args-list (trace-event-args trace-event))))) 86 | (:exit 87 | (multiple-value-bind (name category) 88 | (function-name->name-and-category (trace-event-name trace-event)) 89 | (format nil 90 | "{ \"name\" : ~S, \"cat\" : ~S, \"ph\" : \"E\", \"pid\" : 1, \"tid\" : ~D, \"ts\" : ~D, \"args\" : { \"out\" : ~A }}" 91 | name 92 | category 93 | (sb-impl::get-lisp-obj-address (trace-event-thread trace-event)) 94 | (trace-event-timestamp trace-event) 95 | (sanitize-and-format-args-list (trace-event-args trace-event))))) 96 | (:complete 97 | (multiple-value-bind (name category) 98 | (function-name->name-and-category (trace-event-name trace-event)) 99 | (format nil 100 | "{ \"name\" : ~S, \"cat\" : ~S, \"ph\" : \"X\", \"pid\" : 1, \"tid\" : ~D, \"ts\" : ~D, \"dur\" : ~D, \"args\" : { \"in\" : ~A, \"out\" : ~A }}" 101 | name 102 | category 103 | (sb-impl::get-lisp-obj-address (trace-event-thread trace-event)) 104 | (trace-event-timestamp trace-event) 105 | (trace-event-duration trace-event) 106 | (sanitize-and-format-args-list (getf (trace-event-args trace-event) :in)) 107 | (sanitize-and-format-args-list (getf (trace-event-args trace-event) :out)))))))) 108 | 109 | (defun thread->json (thread) 110 | (format nil 111 | "{ \"name\" : \"thread_name\", \"ph\" : \"M\", \"pid\" : 1, \"tid\" : ~D, \"args\" : { \"name\" : ~S }}" 112 | (sb-impl::get-lisp-obj-address thread) 113 | (bt:thread-name thread))) 114 | 115 | (defun extract-threads (events) 116 | (loop 117 | with uniques-ht = (make-hash-table :test #'eq) 118 | for event in events 119 | do 120 | (setf (gethash (trace-event-thread event) uniques-ht) t) 121 | finally 122 | (return (alexandria:hash-table-keys uniques-ht)))) 123 | 124 | ;;; FIXME: save with streams instead? -- Jacek Złydach, 2019-10-14 125 | (defun save-report (output-file-name &key (skip-args t)) 126 | (with-open-file (stream output-file-name :direction :output :if-exists :supersede) 127 | ;; TODO: preamble -- Jacek Złydach, 2019-10-14 128 | (format stream "{~%\"traceEvents\" : [~%") 129 | (loop 130 | for (entry . restp) on *trace-events* 131 | do 132 | (write-string (trace-event->json entry :skip-args skip-args) stream) 133 | (when restp 134 | (write-string "," stream) 135 | (terpri stream))) 136 | (loop 137 | for (thread . restp) on (extract-threads *trace-events*) 138 | initially 139 | (write-string "," stream) 140 | (terpri stream) 141 | do 142 | (write-string (thread->json thread) stream) 143 | (when restp 144 | (write-string "," stream) 145 | (terpri stream))) 146 | 147 | (format stream "~&], 148 | \"displayTimeUnit\" : \"ms\", 149 | \"application\" : \"FIXME\", 150 | \"version\" : \"FIXME\", 151 | \"traceTime\" : ~S 152 | }" 153 | " TODO local-time independent time" 154 | ;;(local-time:format-timestring nil (local-time:now)) 155 | )) 156 | (values)) 157 | 158 | 159 | 160 | ;;; Helper function for blacklisting symbols when tracing whole packages. 161 | (defun package-symbols-except (name &rest exceptions) 162 | (let (symbols 163 | (package (sb-impl::find-undeleted-package-or-lose name))) 164 | (do-all-symbols (symbol (find-package name)) 165 | (when (eql package (symbol-package symbol)) 166 | (when (and (fboundp symbol) 167 | (not (macro-function symbol)) 168 | (not (special-operator-p symbol))) 169 | (push symbol symbols)) 170 | (let ((setf-name `(setf ,symbol))) 171 | (when (fboundp setf-name) 172 | (push setf-name symbols))))) 173 | (set-difference symbols exceptions :key (lambda (x) 174 | (if (consp x) 175 | (string (second x)) 176 | (string x))) :test #'string-equal))) 177 | -------------------------------------------------------------------------------- /src/impl-sbcl.lisp: -------------------------------------------------------------------------------- 1 | ;;;; SBCL-specific implementation of the Tracer. 2 | 3 | (in-package #:tracer) 4 | 5 | (defvar *trace-events* nil "A list of trace entries, pushed onto from the beginning.") 6 | 7 | (defvar *original-trace-start-breakpoint-fun* #'sb-debug::trace-start-breakpoint-fun "Original SBCL function being overwritten by the tracer.") 8 | (defvar *original-trace-end-breakpoint-fun* #'sb-debug::trace-end-breakpoint-fun "Original SBCL function being overwritten by the tracer.") 9 | 10 | (defvar *clock-reset-fun* nil) 11 | (defvar *clock-get-time-fun* nil) 12 | 13 | 14 | ;;; Timer 15 | ;;; TODO: make it so that user can plug a high-resolution timer here. -- Jacek Złydach, 2019-10-18 16 | 17 | (sb-ext:defglobal *hack-clock-jitter* 0 "A crude hack because our clock has too little resolution.") 18 | (declaim (type fixnum *hack-clock-jitter*)) 19 | 20 | (unless (>= internal-time-units-per-second 1000) 21 | (warn "Tracer clock may not havve enough precision to be useful for profiling use.")) 22 | 23 | ;;; TODO: this needs to be a function that can be changed between invocations of tracing! 24 | ;;; I want to allow for injecting higher resolution clocks if available. 25 | ;;; -- Jacek Złydach, 2019-11-01 26 | 27 | (defun get-current-time-usec () 28 | "Get current time with microsecond resolution." 29 | (sb-ext:atomic-incf *hack-clock-jitter*) 30 | (+ (* (get-internal-real-time) 1000) 31 | *hack-clock-jitter*)) 32 | 33 | (declaim (ftype (function () alexandria:non-negative-fixnum) get-current-time-usec) 34 | (inline get-current-time-usec)) 35 | (defun get-current-time-usec-nojitter () 36 | "Get current time with microsecond resolution. No extra jitter involved." 37 | (declare (optimize (speed 3))) 38 | (the alexandria:non-negative-fixnum (* (get-internal-real-time) 1000))) 39 | 40 | ;;; XXX: below is our new, usec clock -- Jacek Złydach, 2019-11-02 41 | (let ((clock-offset 0)) 42 | (declare (type alexandria:non-negative-fixnum clock-offset)) 43 | (defun %%start-clock () 44 | (setf clock-offset (sb-kernel::get-time-of-day))) 45 | (defun %%get-time-usec () 46 | (multiple-value-bind (sec usec) 47 | (sb-kernel::get-time-of-day) 48 | (+ (* (- sec clock-offset) 1000000) usec))) 49 | (defun %%time (thunk) 50 | (let ((start (%%get-time-usec))) 51 | (funcall thunk) 52 | (- (%%get-time-usec) start))) 53 | (setf *clock-reset-fun* #'%%start-clock 54 | *clock-get-time-fun* #'%%get-time-usec)) 55 | 56 | (declaim (ftype (function () alexandria:non-negative-fixnum) get-current-time) 57 | (inline get-current-time)) 58 | (defun get-current-time () 59 | (funcall *clock-get-time-fun*)) 60 | 61 | 62 | 63 | (defun post-process-entries (entries &key correct-zero-duration) 64 | "Destructively modify `ENTRIES', making it more compact and, if `CORRECT-ZERO-DURATION' is T, 65 | changing zero-length events to have 1us length, also modifying other times to offset for that. 66 | `ENTRIES' is expected to be in order entries were added. The function maintain separate offsets per (process, thread) pair. 67 | Returns a processed list, to replace old value `ENTRIES'. As additional values, returns the total accumulated clock offset, 68 | and the stacks containing unclosed duration entries, keyed by thread." 69 | (let ((offset 0) 70 | (stacks (make-hash-table :test 'equal))) 71 | (dolist (entry entries entries) 72 | ;; Always update event time to account for clock offset. 73 | (incf (trace-event-timestamp entry) offset) 74 | 75 | ;; Match starting and ending events to offset clock in case of zero-length events, and to convert 76 | ;; matching pairs of Duration events into Complete events. 77 | (let ((entry-ht-id (cons 1 (trace-event-thread entry)))) ;1 is the currently supported PID 78 | (ecase (trace-event-phase entry) 79 | (:enter 80 | ;; Push the :enter entry to stack. 81 | (push entry (gethash entry-ht-id stacks))) 82 | (:exit 83 | (let ((begin-event (first (gethash entry-ht-id stacks)))) 84 | (if (equalp (trace-event-name begin-event) 85 | (trace-event-name entry)) 86 | (progn 87 | ;; Actual post-processing happens here. 88 | ;; If zero-length and correct-zero-duration is on, update close time and offset. 89 | (when (and correct-zero-duration 90 | (= (trace-event-timestamp begin-event) 91 | (trace-event-timestamp entry))) 92 | (incf (trace-event-timestamp entry)) 93 | (incf offset)) 94 | 95 | ;; Convert task into complete task + counter 96 | (setf (trace-event-phase begin-event) :complete 97 | (trace-event-phase entry) :skip ;TODO: counters, if any, go here -- Jacek Złydach, 2019-11-04 98 | (trace-event-duration begin-event) (- (trace-event-timestamp entry) (trace-event-timestamp begin-event)) 99 | (trace-event-args begin-event) `(:in ,(trace-event-args begin-event) :out ,(trace-event-args entry))) 100 | 101 | ;; Pop the updated entry from stack. 102 | (pop (gethash entry-ht-id stacks))) 103 | (warn "Recorded entries misordered; expected ~A, got ~A." (trace-event-name begin-event) (trace-event-name entry)))))))) 104 | ;; Go over the list again, and remove "skip" entries. 105 | (alexandria:deletef entries :skip :key #'trace-event-phase) 106 | (values entries 107 | offset 108 | stacks))) 109 | 110 | 111 | ;;; Tracing process 112 | 113 | (defun my-trace-start-breakpoint-fun (info) 114 | (let (conditionp) 115 | (values 116 | (lambda (frame bpt &rest args) 117 | (declare (ignore bpt)) 118 | (sb-debug::discard-invalid-entries frame) 119 | (let ((condition (sb-debug::trace-info-condition info)) 120 | (wherein (sb-debug::trace-info-wherein info))) 121 | (setq conditionp 122 | (and (not sb-debug::*in-trace*) 123 | (or (not condition) 124 | (apply (cdr condition) frame args)) 125 | (or (not wherein) 126 | (sb-debug::trace-wherein-p frame wherein))))) 127 | (when conditionp 128 | (when (sb-debug::trace-info-encapsulated info) 129 | (sb-ext:atomic-push (make-trace-event-fast :enter 130 | (sb-debug::trace-info-what info) 131 | (bt:current-thread) 132 | (get-current-time) 133 | args 134 | nil 135 | nil) 136 | *trace-events*)) 137 | ;; TODO: perhaps remove this, it seems unneeded -- Jacek Złydach, 2019-11-05 138 | (with-standard-io-syntax 139 | (apply #'sb-debug::trace-maybe-break info (sb-debug::trace-info-break info) "before" 140 | frame args)))) 141 | (lambda (frame cookie) 142 | (declare (ignore frame)) 143 | (push (cons cookie conditionp) sb-debug::*traced-entries*))))) 144 | 145 | (declaim (ftype (function (sb-debug::trace-info) function) my-trace-end-breakpoint-fun)) 146 | (defun my-trace-end-breakpoint-fun (info) 147 | (lambda (frame bpt values cookie) 148 | (declare (ignore bpt)) 149 | (unless (eq cookie (caar sb-debug::*traced-entries*)) 150 | (setf sb-debug::*traced-entries* 151 | (member cookie sb-debug::*traced-entries* :key #'car))) 152 | 153 | (let ((entry (pop sb-debug::*traced-entries*))) 154 | (when (and (not (sb-debug::trace-info-untraced info)) 155 | (or (cdr entry) 156 | (let ((cond (sb-debug::trace-info-condition-after info))) 157 | (and cond (apply #'funcall (cdr cond) frame values))))) 158 | (sb-ext:atomic-push (make-trace-event-fast :exit 159 | (sb-debug::trace-info-what info) 160 | (bt:current-thread) 161 | (get-current-time) 162 | values 163 | nil 164 | nil) 165 | *trace-events*) 166 | 167 | (apply #'sb-debug::trace-maybe-break info (sb-debug::trace-info-break-after info) "after" 168 | frame values))))) 169 | 170 | (defun install-tracing-overrides () 171 | (sb-ext:unlock-package (find-package 'sb-debug)) 172 | (setf (symbol-function 'sb-debug::trace-start-breakpoint-fun) #'my-trace-start-breakpoint-fun 173 | (symbol-function 'sb-debug::trace-end-breakpoint-fun) #'my-trace-end-breakpoint-fun) 174 | (sb-ext:lock-package (find-package 'sb-debug))) 175 | 176 | (defun uninstall-tracing-overrides () 177 | (sb-ext:unlock-package (find-package 'sb-debug)) 178 | (setf (symbol-function 'sb-debug::trace-start-breakpoint-fun) *original-trace-start-breakpoint-fun* 179 | (symbol-function 'sb-debug::trace-end-breakpoint-fun) *original-trace-end-breakpoint-fun*) 180 | (sb-ext:lock-package (find-package 'sb-debug))) 181 | 182 | ;;; FIXME: This should not be a macro. -- Jacek Złydach, 2019-10-18 183 | (defmacro start-tracing (&rest specs) 184 | `(progn 185 | (install-tracing-overrides) 186 | (trace :encapsulate t :methods t ,@specs))) 187 | 188 | (defun stop-tracing () 189 | (untrace) 190 | (uninstall-tracing-overrides) 191 | #+nil(setf *trace-events* (nreverse *trace-events*)) 192 | (multiple-value-bind (events offset stacks) 193 | (post-process-entries (nreverse *trace-events*)) 194 | (declare (ignore offset stacks)) 195 | (setf *trace-events* events)) 196 | ;; TODO: report offsets and stacks -- Jacek Złydach, 2019-11-05 197 | (values)) 198 | 199 | (defun reset-tracing () 200 | (setf *trace-events* nil 201 | *hack-clock-jitter* 0)) 202 | 203 | (defun get-tracing-report-data () 204 | *trace-events*) 205 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+title: Tracer 2 | 3 | [[file:screenshot.png]] 4 | 5 | * Introduction 6 | 7 | A tracing profiler for SBCL, with output suitable for display in Chrome's/Chromium's Tracing Viewer (chrome://tracing). 8 | 9 | *NOTE*: in its current form, it's a pile of hacks altering the behavior of SBCL's implementation of Common Lisp's =TRACE= facility. 10 | Therefore it works *only* on SBCL - and I only tested it on SBCL 1.5.0 (AMD64, Linux). Help wanted in making it as portable as possible. 11 | 12 | UPDATE: There's also an [[http://jacek.zlydach.pl/blog/2020-02-04-introducing-tracer-a-tracing-profiler-for-common-lisp.html][associated blog post]] with some thoughts about tracing profilers in general, and this one in particular. 13 | 14 | =Tracer= is designed to be used in "drop-in" mode, i.e. no code in the profiled project needs to be modified to achieve its primary functionality. 15 | In the future, extended functionality may require adding some constructs to the profiled code. 16 | 17 | =Tracer= is a tracing profiler - i.e. it collects information not just what was called and how often, but records actual call sequences, optionally 18 | with input and output arguments. 19 | 20 | * Use example 21 | *The interface is currently highly unstable and subject to change at a whim.* Future versions will not be backwards compatible. 22 | 23 | The main entry point is the macro =with-tracing=, which takes two arguments - a list of things to trace, and the body of code to profile. 24 | The list of things to trace follows the same convention as [[http://www.sbcl.org/manual/#Function-Tracing][SBCL's implementation]] of the built-in [[http://clhs.lisp.se/Body/m_tracec.htm][TRACE]] macro: 25 | each element "may be a symbol, denoting an individual function, or a string, denoting all functions fbound to symbols whose home package is the package with the given name". 26 | 27 | To collect traces of a REPL-bound calculation: 28 | #+BEGIN_SRC lisp 29 | (tracer:with-tracing ("MY-PROJECT" other-package/some-function) 30 | (my-project:some-long-operation)) 31 | #+END_SRC 32 | 33 | To collect traces from all running threads, e.g. to trace how a web application responds to HTTP requests: 34 | #+BEGIN_SRC lisp 35 | (tracer:with-tracing ("MY-PROJECT" "MY-WEBSERVER") 36 | (sleep 20)) 37 | #+END_SRC 38 | 39 | In complex projects, it may be useful to define a helper function: 40 | 41 | #+BEGIN_SRC lisp 42 | (defun interesting-traceables () 43 | `("MY-PROJECT" 44 | "MY-PROJECT/CORE" 45 | ,@(tracer:package-symbols-except "MY-PROJECT/OBJECTS" "SOME-ACCESSOR" "OTHER-ACCESSOR") 46 | jsown:to-json 47 | jsown:to-json* 48 | "SQLITE" 49 | "UIOP/RUN-PROGRAM" 50 | "CLACK.HANDLER")) 51 | #+END_SRC 52 | 53 | (=PACKAGE-SYMBOLS-EXCEPT= is provided by =Tracer= to make it easier to trace everything in a package except a specified blacklist of functions.) 54 | 55 | And use it like this (note the use of =#.= for read-time evaluation): 56 | #+BEGIN_SRC lisp 57 | (tracer:with-tracing #.(interesting-traceables) 58 | (my-project:some-long-operation)) 59 | #+END_SRC 60 | 61 | After that's done, in order to save the report to a file invoke: 62 | #+BEGIN_SRC lisp 63 | (tracer:save-report "report.json") 64 | #+END_SRC 65 | 66 | You can now view the results in Google Chrome or Chromium, by visiting [[chrome://tracing]] and loading the 67 | saved report with "Load" button. 68 | 69 | Sadly, there isn't much good documentation on how to use the tracing viewer UI. Best I can recommend is 70 | [[http://www.chromium.org/developers/how-tos/trace-event-profiling-tool/trace-event-reading#TOC-Navigating-the-Tracing-View][this]]. Fortunately, traces generated by =Tracer= use only the most basic features, so things should be self-evident. 71 | 72 | (Also note that Chrome's trace viewer is not without its own issues; in particular, you may need to load the report multiple times 73 | before it gets processed and displayed.) 74 | 75 | ** On storing input arguments and return values of function calls 76 | In order to minimize the size of the resulting trace (as well as maximize timing accuracy), by default saving arguments and return values 77 | of traced functions is disabled. The API for selecting what values to store and when is in flux. 78 | Currently, you can set a global default by installing appropriate function as the value of =*DEFAULT-ARG-CONVERTER*=, or specify a 79 | per-symbol policy using the =*TRACING-ARG-CONVERTERS*= hash table. See [[file:src/trace-event.lisp][trace-event.lisp]] for details. As an example, you can do: 80 | 81 | #+BEGIN_SRC lisp 82 | (setf tracer::*default-arg-converter* tracer::+arg-converter-store-only-simple-objects-and-strings+) 83 | (tracer:with-tracing #.(interesting-traceables) 84 | (my-project:some-long-operation)) 85 | (tracer:save-report "report.json" :skip-args nil) 86 | #+END_SRC 87 | 88 | in order to remember numbers, characters, booleans, symbols and strings. The fastest and most dangerous of current arg converters 89 | is =+ARG-CONVERTER-PASSTHROUGH+=, which records /all/ inputs and return values "by reference", without re-encoding them. The problem is, if any of such 90 | recorded values gets changed later, the trace will show these changes instead of the values at the time of the call. In extreme cases - such as use of 91 | destructive operations - this may damage or invalidate the recorded object, causing a condition to be signalled when attempting to print it. 92 | 93 | The current interface is pretty crude and user-unfriendly, but it will be improved in the future. 94 | 95 | * Known issues 96 | =SAVE-REPORT= used with =:SKIP-ARGS NIL= may cause an error if =*DEFAULT-ARG-CONVERTER*= is left at its default value of 97 | =+ARG-CONVERTER-IGNORE-ALL+=. That's because the API for deciding what parameters to collect is in flux, and =:SKIP-ARGS= is a part of the old API. 98 | 99 | * Implementation notes 100 | =Tracer= works by abusing =TRACE= feature to time and record calls instead of printing them to =*TRACE-OUTPUT*=. 101 | To do so, it dynamically replaces a bunch of SBCL's internals implementing the =TRACE= functionality, and restores 102 | original implementations when done recording. Recording is protected by =UNWIND-PROTECT=, but if anything goes wrong, 103 | you can call =TRACER:STOP-TRACING= yourself just to be sure. 104 | 105 | =Tracer= also currently binds directly to SBCL's interface to [[http://man7.org/linux/man-pages/man2/gettimeofday.2.html][gettimeofday]] to provide a microsecond-resolution clock. 106 | This is a cludge that may or may not work on systems other than Linux (I think it should). This is an improvement over 107 | the initial approach, which was to use [[http://www.lispworks.com/documentation/HyperSpec/Body/f_get_in.htm][GET-INTERNAL-REAL-TIME]], hoping for millisecond resolution, and then to introduce 108 | jitter so that all traced samples are at least 1 microsecond long. The jittered maybe-millisecond-accurate clock is still 109 | available; to use it, do: 110 | #+BEGIN_SRC lisp 111 | (setf tracer::*clock-reset-fun* (lambda () (setf tracer::*hack-clock-jitter* 0)) 112 | tracer::*clock-get-time-fun* #'tracer::get-current-time-usec) 113 | #+END_SRC 114 | 115 | It's unknown how much damage is caused when =Tracer= is run when multiple threads are already running and have their functions 116 | wrapped by tracing infrastructure mid-flight. It might be a good idea to encourage/support running =Tracer= before most of the 117 | traced application is initialized. One way is to make tracing conditioned on a global variable, letting it run continuously 118 | during execution of the application, and only start saving traces when the flag gets flipped. 119 | 120 | (Really might want to consider doing it. Passive tracing guarded by flag would work well with in-code counters and 121 | block markers and whatever similar things may come up. But then again, that would mean having to define which functions 122 | are being traced at startup.) 123 | 124 | It might me just being a bit oversensitive, but I'm starting to have feelings that sometimes (rarely, but sometimes), some 125 | calls get missed by =Tracer=. I've started to grow these suspicions after looking at database calls in one of the applications 126 | I worked on; sometimes it seems that the actual CFFI calls are missing (but perhaps I misssed them in the trace; 127 | some of them are extremely fast). 128 | 129 | *This is all a bunch of ugly hacks and I'm not proud of them*. Except I kind of am. Despite its kludgy nature, it really does work well. 130 | 131 | * Planned features 132 | - Support for counters - adding information about memory use, open database connections, etc. Possibly in "auto-polling" mode, to keep the interface 133 | non-invasive. These would have their own specific display in Chrome's tracing viewer. 134 | - Support for connecting call constructs across threads (e.g. marking that a given =HTTP-REQUEST= is related to a handler function invocation 135 | in a different thread, visualized by arrows connecting them on the trace graph). 136 | - Tracking thread life time (to mark when a given thread was actually created or stopped). 137 | - More actual documentation. 138 | - Binding to some high-resolution clock that's both portable and doesn't require a third-party library. Currently, =Tracer= doesn't need a library, 139 | but the solution isn't portable. 140 | - API for reporting events to be put on the trace, e.g. to show when the user pressed a key or clicked a button, etc. 141 | - Actual API for safely and efficiently saving input arguments and return values of traced functions. 142 | - Handling of signals/conditions - currently exceptional exits break rendering of the trace report. 143 | - GZIPping saved reports to cut down on their size. 144 | - This should really be handled by external dependency; best we can probably offer is a way to output to stream, 145 | in such a way one can pass it to compression. 146 | 147 | * Dev notes for future changes 148 | (Not relevant to use of =Tracer=.) 149 | 150 | - RE clock jitter hack - it should be possible to remove its influence by going over traces in order they were recorded, 151 | counting the jitter that was applied and removing anything except the "+1 us for events shorter than clock resolution" fix. 152 | But alternatively, I could just not add jitter in the first place, and post-process saved samples by going over them and 153 | applying a per-thread offset to them; offset that increases for tasks with recorded length of 0! 154 | 155 | - Speaking of post-processing, here's an idea: how much of the analysis that Chrome does can I do myself? 156 | Can I tell, for any call, how much wall-time vs. self-time it has? 157 | 158 | - Anyways; what I'd like to have is a way to say, "what if calls to X took 10% of their time?", or "what if calls to X 159 | that are longer than Y took Y?", or in general, "what if calls to X with properties Y were Z(X, Y) long?". I'd 160 | like to generate an alternative, filtered trace from that, for side-by-side comparison. 161 | 162 | - Storage: I'm wondering about pros and cons of replacing a list of lists with a fixed-memory array of structs. 163 | That would definitely help reduce the memory load, perhaps even improving recording performance (but I'm not sure 164 | about this; consing is fast). 165 | 166 | - Recording arguments: 167 | - There's no good way to print an arbitrary object to string if there's a chance that the printing function will be traced, 168 | and its arguments will be printed too. This sounds like a recipe for an infinite loop. 169 | - I could perhaps work around this with some dynamic flags. 170 | - As a default, I'd like to move towards not even capturing arguments. But I want to capture *some* arguments - e.g. queries 171 | for database calls *are* interesting. 172 | - Could I instead provide a selector that could be used to optionally capture arguments for a given function(s)? 173 | Could it be provided to with-tracing macro directly? E.g. instead of ='foo=, I'd say ='(foo :trace-args t)=. 174 | 175 | --------------------------------------------------------------------------------