luv

Workshop wiki

trace.lisp

hal/trace.lisp

system luv · 27 definitions · on GitHub

Opt-in nested CPU timing zones for live and benchmark measurements.

in-package#:luv
defstruct
cpu-trace-zone
:constructor%make-cpu-trace-zone
:conc-namecpu-trace-zone-
name
parent-index-1:typefixnum
depth0:typefixnum
started-at0:typeinteger
ended-at0:typeinteger
started-dynamic-usage0:typeinteger
started-bytes-freed0:typeinteger
bytes-consed0:typeinteger
started-gc-run-time0:typeinteger
gc-run-time0:typeinteger
started-garbage-collections0:typefixnum
garbage-collections0:typefixnum
defstruct
cpu-trace
:constructor%make-cpu-trace
:conc-name%cpu-trace-
label
zones
make-array32:initial-elementnil
:typevector
zone-count0:typefixnum
stack
make-array16:element-type'fixnum:initial-element-1
:typevector
depth0:typefixnum
garbage-collections0:typefixnum
defstructruntime-observation

Process allocation and garbage-collection evidence for one dynamic extent.

elapsed-seconds0d0:typedouble-float
bytes-consed0:typeinteger
gc-seconds0d0:typedouble-float
garbage-collections0:typefixnum
defvar*cpu-trace*nil"The current opt-in CPU trace, or NIL on the ordinary execution path."
defvar*measurement-gc-hook-lock*
sb-thread:make-mutex:name"luv measurement GC hooks"
defunadd-measurement-gc-hook
hook
sb-thread:with-mutex
pushhooksb-ext:*after-gc-hooks*
defunremove-measurement-gc-hook
hook
sb-thread:with-mutex
setfsb-ext:*after-gc-hooks*
deletehooksb-ext:*after-gc-hooks*:test#'eq
defunmeasured-allocation-delta
started-usagestarted-freedended-usageended-freed

Compute allocated bytes from SBCL's non-allocating profiler counters.

if
eqlstarted-freedended-freed
-ended-usagestarted-usage
-
+ended-usageended-freed
started-usagestarted-freed
defmacrowith-runtime-observation
observation
&bodybody

Measure time, allocation, GC time, and collections while executing body.

observation is reset in place and body's values are preserved. SBCL's byte and GC clocks are process-wide; in a multithreaded image this deliberately attributes concurrent runtime activity during the observed extent too.

let
result
gensym"OBSERVATION"
hook
gensym"GC-HOOK"
gc-count
gensym"GC-COUNT"
started-at
gensym"STARTED-AT"
started-usage
gensym"STARTED-USAGE"
started-freed
gensym"STARTED-FREED"
started-gc
gensym"STARTED-GC"
finished-p
gensym"FINISHED-P"
`
let*
,result,observation
,gc-count0
,hook
lambda
incf,gc-count
,started-usage0
,started-freed0
,started-gc0
,started-at0
,finished-pnil
setf,started-usage
sb-kernel:dynamic-usage
,started-freedsb-kernel::*n-bytes-freed-or-purified*,started-gcsb-ext:*gc-run-time*,started-at
get-internal-real-time
flet
finish-observation
unless,finished-p
let
ended-at
get-internal-real-time
ended-usage
sb-kernel:dynamic-usage
ended-freedsb-kernel::*n-bytes-freed-or-purified*
ended-gcsb-ext:*gc-run-time*
setf
runtime-observation-elapsed-seconds,result
/
-ended-at,started-at
coerceinternal-time-units-per-second'double-float
runtime-observation-bytes-consed,result
measured-allocation-delta,started-usage,started-freedended-usageended-freed
runtime-observation-gc-seconds,result
/
-ended-gc,started-gc
coerceinternal-time-units-per-second'double-float
runtime-observation-garbage-collections,result
,gc-count
,finished-pt
unwind-protect
multiple-value-prog1
progn,@body
finish-observation
finish-observation
defunmake-cpu-trace
&keylabel

Make a reusable nested CPU trace buffer named label.

%make-cpu-trace:labellabel
defunreset-cpu-trace
trace

Forget trace's zones while retaining its allocated storage for reuse.

setf
%cpu-trace-zone-counttrace
0
%cpu-trace-depthtrace
0
%cpu-trace-garbage-collectionstrace
0
trace
defuncpu-trace-garbage-collections
trace
%cpu-trace-garbage-collectionstrace
defungrow-cpu-trace-vector
vectorminimum-size&keyelement-type
let
size
maxminimum-size
*2
lengthvector
adjust-arrayvectorsize:element-type
orelement-type
array-element-typevector
:initial-element
ifelement-type-1nil
defunbegin-cpu-trace-zone
tracename
let*
index
%cpu-trace-zone-counttrace
depth
%cpu-trace-depthtrace
zones
%cpu-trace-zonestrace
stack
%cpu-trace-stacktrace
when
=index
lengthzones
setfzones
%cpu-trace-zonestrace
zones
when
=depth
lengthstack
setfstack
grow-cpu-trace-vectorstack
1+depth
:element-type'fixnum
%cpu-trace-stacktrace
stack
let
zone
or
arefzonesindex
%make-cpu-trace-zone
setf
arefzonesindex
zone
cpu-trace-zone-namezone
name
cpu-trace-zone-parent-indexzone
if
zeropdepth
-1
arefstack
1-depth
cpu-trace-zone-depthzone
depth
cpu-trace-zone-started-dynamic-usagezone
sb-kernel:dynamic-usage
cpu-trace-zone-started-bytes-freedzone
sb-kernel::*n-bytes-freed-or-purified*
cpu-trace-zone-started-gc-run-timezone
sb-ext:*gc-run-time*
cpu-trace-zone-started-garbage-collectionszone
%cpu-trace-garbage-collectionstrace
cpu-trace-zone-started-atzone
get-internal-real-time
cpu-trace-zone-ended-atzone
0
cpu-trace-zone-bytes-consedzone
0
cpu-trace-zone-gc-run-timezone
0
cpu-trace-zone-garbage-collectionszone
0
arefstackdepth
index
%cpu-trace-zone-counttrace
1+index
%cpu-trace-depthtrace
1+depth
index
defunend-cpu-trace-zone
traceindex
let
depth
%cpu-trace-depthtrace
unless
and
pluspdepth
=index
aref
%cpu-trace-stacktrace
1-depth
error"CPU trace zones must end in nested order."
let
zone
aref
%cpu-trace-zonestrace
index
ended-at
get-internal-real-time
ended-usage
sb-kernel:dynamic-usage
ended-freedsb-kernel::*n-bytes-freed-or-purified*
ended-gcsb-ext:*gc-run-time*
ended-gc-count
%cpu-trace-garbage-collectionstrace
setf
cpu-trace-zone-ended-atzone
ended-at
cpu-trace-zone-bytes-consedzone
measured-allocation-delta
cpu-trace-zone-started-dynamic-usagezone
cpu-trace-zone-started-bytes-freedzone
ended-usageended-freed
cpu-trace-zone-gc-run-timezone
-ended-gc
cpu-trace-zone-started-gc-run-timezone
cpu-trace-zone-garbage-collectionszone
-ended-gc-count
cpu-trace-zone-started-garbage-collectionszone
%cpu-trace-depthtrace
1-depth
values
defmacrowith-cpu-trace
trace
&bodybody

Reset trace, bind it dynamically, and record zones established by body.

let
active
gensym"TRACE"
hook
gensym"GC-HOOK"
`
let*
,active
,hook
lambda
incf
%cpu-trace-garbage-collections,active
unwind-protect
let,@body
defmacrowith-cpu-trace-zone
name&key
tracy-valueniltracy-value-supplied-p
&bodybody

Measure body as nested zone name for whichever measurement is watching.

TRACY-VALUE, when supplied, is attached to the Tracy zone at exit. It does not affect the bounded CPU trace, whose zones retain time and runtime costs.

Two independent things may be: a Tracy viewer attached to this image, and an opt-in CPU-TRACE capture. Each disabled path is one special-variable test and does not allocate, so instrumenting a frame path costs nothing when nobody is measuring it. Active traces reuse their zone storage after the first capture.

The Tracy zone is the outer one. When only Tracy is watching there is no bookkeeping inside it to measure, and when a CPU-TRACE capture is running its own cost belongs to the zone it is attributed to rather than being hidden from it. #OHNIWM

let
trace
gensym"TRACE"
index
gensym"ZONE"
`
with-tracy-zone
,name,@
whentracy-value-supplied-p`
:value,tracy-value
let*
,index
and,trace

body occurs once so nested instrumentation does not multiply the

compiler's input. TRACE, rather than INDEX, guards cleanup because

zero is a valid first zone index.

unwind-protect
progn,@body
when,trace
end-cpu-trace-zone,trace,index
eval-when
:compile-toplevel:load-toplevel:execute
defunzoned-definition-name-and-options
specification
if
and
conspspecification
keywordp
secondspecification
let
name
firstspecification
options
restspecification
unless
evenp
lengthoptions
error"Odd zoned definition option list ~S."options
loopforkeyinoptionsby#'cddrunless
memberkey'
:zone:value
do
error"Unknown zoned definition option ~S."key
valuesname
getfoptions:zone
not
null
member:zoneoptions
getfoptions:value
not
null
member:valueoptions
valuesspecificationnilnilnilnil
defunzoned-symbol-name
symbol
let
package
symbol-packagesymbol
formatnil"~(~A/~A~)"
ifpackage
package-namepackage
"anonymous"
symbol-namesymbol
defunzoned-function-name
name
etypecasename
symbol
zoned-symbol-namename
cons
destructuring-bind
operatorsymbol
name
unless
eqoperator'setf
error"Invalid function name ~S."name
formatnil"~A/setf"
zoned-symbol-namesymbol
defunzoned-specializer-name
specializer
etypecasespecializer
symbol
zoned-symbol-namespecializer
cons
destructuring-bind
operatorvalue
specializer
unless
eqoperator'eql
error"Invalid method specializer ~S."specializer
formatnil"eql/~(~A~)"value
defunzoned-method-name
namequalifiersspecialized-lambda-list
let
specializers
loopforparameterinspecialized-lambda-listuntil
memberparameterlambda-list-keywords
when
and
conspparameter
not
eq
secondparameter
t
collect
zoned-specializer-name
secondparameter
formatnil"~A~@[<~{~A~^,~}>~]~@[{~{~(~A~)~^,~}}~]"
zoned-function-namename
specializersqualifiers
defunzoned-definition-body
body
let
docstring
and
stringp
firstbody
popbody
declarations
loopwhile
and
consp
firstbody
eq'declare
first
firstbody
do
push
popbody
declarations
valuesdocstring
nreversedeclarations
body
defmacrozone
specification&bodybody

Measure body with concise ambient zone syntax.

specification is either a zone name or (NAME :VALUE FORM). This is the ordinary spelling for a meaningful region inside a definition; zdefun and zdefmethod cover whole definitions.

if
conspspecification
destructuring-bind
name&key
valuenilvalue-supplied-p
specification
`
with-cpu-trace-zone
,name,@
whenvalue-supplied-p`
:tracy-value,value
,@body
`
with-cpu-trace-zone
,specification
,@body
defmacrozdefun
name-and-optionslambda-list&bodybody

Define a function whose complete dynamic extent is an ambient trace zone.

The inferred name is PACKAGE/FUNCTION. Use (NAME :zone ZONE-NAME) to provide a more semantic name and :VALUE FORM to attach a Tracy work count.

multiple-value-bind
nameexplicit-zonezone-supplied-pvaluevalue-supplied-p
zoned-definition-name-and-optionsname-and-options
multiple-value-bind
docstringdeclarationsforms
zoned-definition-bodybody
let
zone-name
ifzone-supplied-pexplicit-zone
zoned-function-namename
`
defun,name,lambda-list,@
whendocstring
listdocstring
,@declarations
with-cpu-trace-zone
,zone-name,@
whenvalue-supplied-p`
:tracy-value,value
,@forms
defmacrozdefmethod
name-and-options&restmethod-tail

Define a method whose complete dynamic extent is an ambient trace zone.

The inferred name includes the generic function, non-T required specializers, and qualifiers. :zone and :VALUE have the same meaning as in zdefun.

multiple-value-bind
nameexplicit-zonezone-supplied-pvaluevalue-supplied-p
zoned-definition-name-and-optionsname-and-options
let
qualifiersnil
tailmethod-tail
loopwhile
andtail
atom
firsttail
do
push
poptail
qualifiers
setfqualifiers
nreversequalifiers
unless
andtail
listp
firsttail
error"ZDEFMETHOD ~S has no specialized lambda list."name
let
specialized-lambda-list
poptail
multiple-value-bind
docstringdeclarationsforms
zoned-definition-bodytail
let
zone-name
ifzone-supplied-pexplicit-zone
zoned-method-namenamequalifiersspecialized-lambda-list
`
defmethod,name,@qualifiers,specialized-lambda-list,@
whendocstring
listdocstring
,@declarations
with-cpu-trace-zone
,zone-name,@
whenvalue-supplied-p`
:tracy-value,value
,@forms
defuncpu-trace-zones
trace

Return trace's completed zones in start order.

loopforindexbelow
%cpu-trace-zone-counttrace
collect
aref
%cpu-trace-zonestrace
index
defuncpu-trace-zone-seconds
/
-
cpu-trace-zone-ended-atzone
cpu-trace-zone-started-atzone
coerceinternal-time-units-per-second'double-float
defuncpu-trace-zone-self-seconds
traceindex
let*
zones
%cpu-trace-zonestrace
zone
arefzonesindex
child-ticks0
loopforchild-indexbelow
%cpu-trace-zone-counttrace
forchild=
arefzoneschild-index
when
=index
cpu-trace-zone-parent-indexchild
do
incfchild-ticks
-
cpu-trace-zone-ended-atchild
cpu-trace-zone-started-atchild
/
-
-
cpu-trace-zone-ended-atzone
cpu-trace-zone-started-atzone
child-ticks
coerceinternal-time-units-per-second'double-float
defuncpu-trace-zone-self-bytes-consed
traceindex
let*
zones
%cpu-trace-zonestrace
zone
arefzonesindex
child-bytes0
loopforchild-indexbelow
%cpu-trace-zone-counttrace
forchild=
arefzoneschild-index
when
=index
cpu-trace-zone-parent-indexchild
do
incfchild-bytes
cpu-trace-zone-bytes-consedchild
-
cpu-trace-zone-bytes-consedzone
child-bytes
defuncpu-trace-zone-gc-seconds
/
cpu-trace-zone-gc-run-timezone
coerceinternal-time-units-per-second'double-float
defuncpu-trace-zone-self-gc-seconds
traceindex
let*
zones
%cpu-trace-zonestrace
zone
arefzonesindex
child-ticks0
loopforchild-indexbelow
%cpu-trace-zone-counttrace
forchild=
arefzoneschild-index
when
=index
cpu-trace-zone-parent-indexchild
do
incfchild-ticks
cpu-trace-zone-gc-run-timechild
/
-
cpu-trace-zone-gc-run-timezone
child-ticks
coerceinternal-time-units-per-second'double-float
defunprint-cpu-trace
trace&optional
stream*standard-output*

Print trace as a bounded time, allocation, and GC table.

formatstream"CPU trace~@[ ~A~] (~D garbage collection~:P)~%"
%cpu-trace-labeltrace
%cpu-trace-garbage-collectionstrace
formatstream" zone inclusive self allocated self alloc GC~%"
loopforindexbelow
%cpu-trace-zone-counttrace
forzone=
aref
%cpu-trace-zonestrace
index
do
formatstream" ~V@T~(~A~)~45T~8,3F ms ~8,3F ms ~10,1F KiB ~10,1F KiB ~7,3F ms~%"
*2
cpu-trace-zone-depthzone
cpu-trace-zone-namezone
/
cpu-trace-zone-bytes-consedzone
1024d0
trace