common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Add some optional instrumentation to object creation

Browse source 
* Compute the time spent waiting for free_pages_lock
* Produce a histogram of allocated object sizes

Conditional on #+allocator-metrics
This commit is contained in:
Douglas Katzman 2021-08-18 17:47:29 -04:00
parent e6d6e6fd05
commit a7eff00daa
8 changed files with 271 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

148
benchmarks/threads-compile.lisp
View file

@ -59,28 +59,11 @@ The statistics:
(sb-sys:sap-ref-64 sap 16) ; worst
(sb-sys:sap-ref-64 sap 0)))))) ; runtime
#|
diff to apply:
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -1649,7 +1649,7 @@ necessary, since type inference may take arbitrarily long to converge.")
(handler-bind (((satisfies handle-condition-p) #'handle-condition-handler))
(with-compilation-values
(with-compilation-unit ()
- (with-world-lock ()
+ (progn ; with-world-lock ()
(setf (sb-fasl::fasl-output-source-info *compile-object*)
(debug-source-for-info info))
(with-ir1-namespace
|#
;;; Exercise COMPILE-FILE in many threads, which is representative of a
;;; lispy workload. Any suitable workload should do.
;;; This test presumes that the world-lock has been removed from around
;;; COMPILE-FILE, in order to allow concurrent progress in each thread.
;;; It would be better to have each thread doing a different kind of work,
;;; but I took the easy route.
(defun benchmark (n-threads n-iter)
(defun gc-benchmark (n-threads n-iter)
(let (threads
(running (make-array n-threads :initial-element t))
(avg-gc-wait (make-array n-threads))
@ -129,3 +112,132 @@ diff to apply:
(let ((end (get-internal-real-time)))
(format t "~&all done: ~fs~%"
(/ (- end start) internal-time-units-per-second))))))
;;; run this with a 16GB dynamic space
(defun allocator-benchmark (n-threads n-iter)
(let (threads (sem (make-semaphore)))
(flet ((work (arg)
(let ((out (format nil "/tmp/out~d.fasl" arg)))
(dotimes (i n-iter)
(compile-file "src/compiler/node"
:print nil :block-compile t :verbose nil
:output-file out)
(signal-semaphore sem))
(delete-file out))
(values (sb-vm::current-thread-offset-sap
sb-vm::thread-et-allocator-mutex-acq-slot)
(sb-vm::current-thread-offset-sap
sb-vm::thread-et-find-freeish-page-slot)
(sb-vm::current-thread-offset-sap
sb-vm::thread-et-bzeroing-slot))))
(dotimes (i n-threads)
(push (make-thread #'work :name (format nil "worker~d" i) :arguments i)
threads)
(sleep .25))
(setq threads (nreverse threads))
(macrolet ((intmetric (slot)
`(sap-ref-word sap (ash ,slot sb-vm:word-shift)))
(floatmetric (slot)
`(float (sap-ref-word sap (ash ,slot sb-vm:word-shift)))))
(let ((n-to-go (* n-threads n-iter)))
(loop
;; Wait for any thread to be done with one COMPILE-FILE
(wait-on-semaphore sem)
(dolist (thread threads)
(with-deathlok (thread c-thread)
(unless (= c-thread 0)
(let* ((sap (int-sap c-thread))
(divisor (intmetric sb-vm::thread-slow-path-allocs-slot))
(times
(list (/ (floatmetric sb-vm::thread-et-allocator-mutex-acq-slot)
divisor)
(/ (floatmetric sb-vm::thread-et-find-freeish-page-slot)
divisor)
(/ (floatmetric sb-vm::thread-et-bzeroing-slot)
divisor))))
(format t "~a: ~a~%" (thread-name thread) times)))))
(terpri)
(when (zerop (decf n-to-go)) (return))))))))
#|
typical results:
(ALLOCATOR-BENCHMARK 1 5)
worker0: (330.69366 387.3285 6498.661)
(ALLOCATOR-BENCHMARK 2 5)
worker0: (330.5141 267.6703 7333.836)
worker1: (228.58601 165.74622 6578.589)
(ALLOCATOR-BENCHMARK 5 5)
worker0: (690.2581 425.22952 5876.69)
worker1: (710.41406 348.25806 6209.075)
worker2: (839.3615 454.86133 7612.185)
worker3: (885.43054 602.65674 10080.599)
worker4: (610.4866 262.36072 8558.833)
(ALLOCATOR-BENCHMARK 10 5)
worker0: (1223.6002 430.6594 7850.7573)
worker1: (1330.8501 370.85773 6489.9937)
worker2: (1253.6841 505.19583 5270.5938)
worker3: (1490.959 715.54004 6404.7485)
worker4: (1285.563 418.3966 4903.252)
worker5: (1166.429 367.69632 4751.1025)
worker6: (1516.6385 703.275 5229.6743)
worker7: (1445.5946 435.18625 8682.394)
worker8: (1445.0297 392.44226 6706.816)
worker9: (1356.9069 461.00558 5664.2266)
(ALLOCATOR-BENCHMARK 20 3)
worker0: (1556.1759 320.41278 7864.225)
worker1: (2484.3042 380.25073 6287.422)
worker2: (2330.8076 518.1103 6229.52)
worker3: (1892.3644 413.4363 6322.3574)
worker4: (2391.721 581.5211 5309.2114)
worker5: (3180.5654 1101.414 5779.844)
worker6: (2621.355 634.3344 4852.1455)
worker7: (2378.809 440.01437 4085.8718)
worker8: (2730.9878 432.23807 3691.8616)
worker9: (2128.9807 376.76605 6020.571)
worker10: (2715.6238 483.9466 7864.9487)
worker11: (2880.8203 445.12094 5770.294)
worker12: (3576.9197 767.5074 6190.4316)
worker13: (3010.8503 437.47897 6542.27)
worker14: (2961.2139 453.69385 6901.6504)
worker15: (3242.9263 513.6723 6050.3047)
worker16: (3760.2107 1017.8271 6511.578)
worker17: (3949.1416 794.4195 5975.102)
worker18: (3443.0042 444.75006 4557.97)
worker19: (3430.517 806.4593 3539.3176)
(ALLOCATOR-BENCHMARK 30 2)
worker0: (3228.2756 465.13016 8892.34)
worker1: (3792.6448 770.495 7546.6333)
worker2: (3741.0088 856.29407 9156.665)
worker3: (3276.4631 410.84845 8926.436)
worker4: (3618.4817 409.49045 6198.2173)
worker5: (3677.3682 533.64966 6499.718)
worker6: (3326.2502 426.92972 6894.4204)
worker7: (4277.313 497.48938 8042.677)
worker8: (4424.929 515.2159 8480.562)
worker9: (4579.331 646.7453 7944.594)
worker10: (5665.9673 585.96246 9082.217)
worker11: (4093.323 536.14 8263.94)
worker12: (5716.6953 636.16815 6921.578)
worker13: (5787.886 771.44214 4725.5513)
worker14: (7163.328 1685.777 5396.888)
worker15: (5750.1753 584.4418 4869.9063)
worker16: (5826.1787 653.7092 3785.243)
worker17: (6162.1816 760.8072 3882.8232)
worker18: (5333.0513 477.8418 4006.6885)
worker19: (8481.007 597.1158 3250.377)
worker20: (9162.3125 2120.3945 5063.6616)
worker21: (5398.499 643.1221 11578.032)
worker22: (7045.36 1039.0885 5842.894)
worker23: (9666.884 543.9834 4494.3945)
worker24: (9476.041 770.6879 4494.854)
worker25: (4477.0054 348.83954 5587.9424)
worker26: (5616.502 469.45154 5180.7173)
worker27: (10800.295 481.92975 6047.9507)
worker28: (11228.471 606.4268 4192.347)
worker29: (19881.9 996.91534 157.6319)
|#

1
src/code/save.lisp
View file

@ -317,6 +317,7 @@ sufficiently motivated to do lengthy fixes."
:interactive-threads interactive
:other-threads other)))))
(when err (error err))
#+allocator-metrics (setq sb-thread::*allocator-metrics* nil)
(setq sb-thread::*sprof-data* nil))
(tune-image-for-dump)
(float-deinit)

90
src/code/target-thread.lisp
View file

@ -1439,6 +1439,8 @@ on this semaphore, then N of them is woken up."
body)))
(sb-ext:define-load-time-global *sprof-data* nil)
#+allocator-metrics
(sb-ext:define-load-time-global *allocator-metrics* nil)
#+sb-thread
(progn
@ -1458,6 +1460,11 @@ on this semaphore, then N of them is woken up."
;; That in turn caused a failure in GC because a fixnum is not a legal value
;; for the startup info when observed by GC.
#+pauseless-threadstart (aver (not (memq thread *starting-threads*)))
;; If collecting allocator metrics, transfer them to the global list
;; so that we can summarize over exited threads.
#+allocator-metrics
(let ((metrics (cons (thread-name thread) (allocator-histogram))))
(sb-ext:atomic-push metrics *allocator-metrics*))
;; Stash the primitive thread SAP for reuse, but clobber the PRIMITIVE-THREAD
;; slot which makes ALIVE-P return NIL.
;; A minor TODO: can this lock acquire/release be moved to where we actually
@ -2583,15 +2590,19 @@ mechanism for inter-thread communication."
#+sb-thread (ash sb-vm::*free-tls-index* sb-vm:n-fixnum-tag-bits)
#-sb-thread (ash thread-obj-len sb-vm:word-shift)
by sb-vm:n-word-bytes
do (let ((thread-slot-name
(if (< tlsindex (ash thread-obj-len sb-vm:word-shift))
do
(unless (<= sb-vm::thread-obj-size-histo-slot
(ash tlsindex (- sb-vm:word-shift))
(+ sb-vm::thread-obj-size-histo-slot (1- sb-vm:n-word-bits)))
(let ((thread-slot-name
(if (< tlsindex (ash thread-obj-len sb-vm:word-shift))
(aref names (ash tlsindex (- sb-vm:word-shift))))))
(if (and thread-slot-name (neq thread-slot-name 'sb-vm::lisp-thread))
(format t " ~3d ~30a : #x~x~%" (ash tlsindex (- sb-vm:word-shift))
thread-slot-name (sap-ref-word sap tlsindex))
(let ((val (safely-read sap tlsindex)))
(unless (eq val :no-tls-value)
(show tlsindex val))))))
(show tlsindex val)))))))
(let ((from (descriptor-sap sb-vm:*binding-stack-start*))
(to (binding-stack-pointer-sap)))
(format t "~%Binding stack: (depth ~d)~%"
@ -2603,3 +2614,76 @@ mechanism for inter-thread communication."
#-sb-thread (sap-ref-lispobj from sb-vm:n-word-bytes)))
(show sym val))
(setq from (sap+ from (* sb-vm:binding-size sb-vm:n-word-bytes))))))))
#+allocator-metrics
(macrolet ((histogram-value (c-thread index)
`(sap-ref-word (int-sap ,c-thread)
(ash (+ sb-vm::thread-obj-size-histo-slot ,index)
sb-vm:word-shift)))
(metric (c-thread slot)
`(sap-ref-word (int-sap ,c-thread)
(ash ,slot sb-vm:word-shift))))
(export '(print-allocator-histogram reset-allocator-histogram))
(defun allocator-histogram (&optional (thread *current-thread*))
(if (eq thread :all)
(labels ((vector-sum (a b)
(let ((result (make-array (max (length a) (length b))
:element-type 'fixnum)))
(dotimes (i (length result) result)
(setf (aref result i)
(+ (if (< i (length a)) (aref a i) 0)
(if (< i (length b)) (aref b i) 0))))))
(sum (a b)
(cond ((null a) b)
((null b) a)
(t (list (+ (first a) (first b))
(vector-sum (second a) (second b))
(+ (third a) (third b))
(+ (fourth a) (fourth b))
(+ (fifth a) (fifth b))
(+ (sixth a) (sixth b)))))))
(reduce #'sum
;; what about the finalizer thread?
(mapcar 'allocator-histogram (list-all-threads))))
(with-deathlok (thread c-thread)
(unless (= c-thread 0)
(let ((a (make-array sb-vm:n-word-bits :element-type 'fixnum)))
(declare (notinline position)) ; style-warning for some reason
(dotimes (i sb-vm:n-word-bits)
(setf (aref a i) (histogram-value c-thread i)))
(list (metric c-thread sb-vm::thread-total-bytes-allocated-slot)
;; discard uninteresting entries
(subseq a sb-vm:n-lowtag-bits
(1+ (position 0 a :from-end t :test #'/=)))
(metric c-thread sb-vm::thread-slow-path-allocs-slot)
(metric c-thread sb-vm::thread-et-allocator-mutex-acq-slot)
(metric c-thread sb-vm::thread-et-find-freeish-page-slot)
(metric c-thread sb-vm::thread-et-bzeroing-slot)))))))
(defun reset-allocator-histogram (&optional (thread *current-thread*))
(with-deathlok (thread c-thread)
(unless (= c-thread 0)
(dotimes (i sb-vm:n-word-bits)
(setf (histogram-value c-thread i) 0)))))
(defun print-allocator-histogram (&optional (thread *current-thread*))
(destructuring-bind (total-bytes bins n-slow-path lock find clear)
(allocator-histogram thread)
(let ((total-objects (reduce #'+ bins))
(size (* 4 sb-vm:n-word-bytes)) ; "<=" this size is the smallest bin
(cumulative 0))
(format t "~& Size Count Cum%~%")
(dovector (count bins)
(incf cumulative count)
(format t "~& ~10@a : ~8d ~6,2,2f~%"
(if (< size 1048576)
(format nil "< ~d" size)
(format nil "< 2^~d" (1- (integer-length size))))
count (/ cumulative total-objects))
(setq size (* size 2)))
(format t "Total: ~D bytes, ~D objects, ~,2,2f% fast path~%"
total-bytes
total-objects
(/ (- total-objects n-slow-path) total-objects))
(format t "Times (sec): lock=~,,-9f find=~,,-9f clear=~,,-9f~%"
lock find clear)))))

9
src/compiler/generic/objdef.lisp
View file

@ -566,6 +566,15 @@ during backtrace.
(control-stack-pointer :c-type "lispobj *")
#+mach-exception-handler
(mach-port-name :c-type "mach_port_name_t")
;; allocation instrumenting
(total-bytes-allocated)
(slow-path-allocs)
(et-allocator-mutex-acq) ; elapsed times
(et-find-freeish-page)
(et-bzeroing)
(obj-size-histo :c-type "size_histogram" :length #.sb-vm:n-word-bits)
;; The *current-thread* MUST be the last slot in the C thread structure.
;; It it the only slot that needs to be noticed by the garbage collector.
(lisp-thread :pointer t :special sb-thread:*current-thread*))

16
src/compiler/x86-64/alloc.lisp
View file

@ -91,6 +91,22 @@
;;; Insert allocation profiler instrumentation
(defun instrument-alloc (size node)
#+allocator-metrics
(progn
(inst add :qword (thread-slot-ea thread-total-bytes-allocated-slot)
(cond ((typep size '(or (signed-byte 32))) size)
(t (inst mov temp-reg-tn size) temp-reg-tn)))
(cond ((tn-p size)
;; the low 4 bins of the histogram can't be used,
;; but I don't care. Math is hard.
(inst bsr temp-reg-tn size)
(inst inc :qword
(ea (ash thread-obj-size-histo-slot word-shift)
thread-base-tn temp-reg-tn 8)))
(t
(inst inc :qword
(thread-slot-ea (+ thread-obj-size-histo-slot
(1- (integer-length size))))))))
(when (policy node (> sb-c::instrument-consing 1))
(let ((skip-instrumentation (gen-label)))
(inst mov temp-reg-tn (thread-slot-ea thread-profile-data-slot))

2
src/compiler/x86-64/move.lisp
View file

@ -248,7 +248,7 @@
(signed-reg unsigned-reg) (any-reg descriptor-reg))
(eval-when (:compile-toplevel :execute)
;; Don't use a macro for this, because define-vop is weird.
;; This is like a macro, but not a macro, because define-vop is weird.
(defun bignum-from-reg (tn signedp)
(flet ((make-vector ()
(map 'vector

32
src/runtime/gencgc.c
View file

@ -902,6 +902,17 @@ static inline boolean region_closed_p(struct alloc_region* region) {
* allocation call using the same pages, all the pages in the region
* are allocated, although they will initially be empty.
*/
#ifdef LISP_FEATURE_ALLOCATOR_METRICS
#define INSTRUMENTING(expression, metric) { \
struct timespec t0, t1; clock_gettime(CLOCK_REALTIME, &t0); expression; \
clock_gettime(CLOCK_REALTIME, &t1); \
struct thread* th = get_sb_vm_thread(); \
th->metric += (t1.tv_sec - t0.tv_sec)*1000000000 + (t1.tv_nsec - t0.tv_nsec); }
#else
#define INSTRUMENTING(expression, metric) expression
#endif
static void
gc_alloc_new_region(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_region)
{
@ -918,13 +929,16 @@ gc_alloc_new_region(sword_t nbytes, int page_type_flag, struct alloc_region *all
/* Check that the region is in a reset state. */
gc_assert(region_closed_p(alloc_region));
ret = thread_mutex_lock(&free_pages_lock);
INSTRUMENTING(ret = thread_mutex_lock(&free_pages_lock), et_allocator_mutex_acq);
gc_assert(ret == 0);
first_page = alloc_start_page(page_type_flag, 0);
INSTRUMENTING(
last_page = gc_find_freeish_pages(&first_page, nbytes,
((nbytes >= (sword_t)GENCGC_CARD_BYTES) ?
SINGLE_OBJECT_FLAG : 0) | page_type_flag,
gc_alloc_generation);
gc_alloc_generation),
et_find_freeish_page);
/* Set up the alloc_region. */
alloc_region->last_page = last_page;
@ -962,7 +976,7 @@ gc_alloc_new_region(sword_t nbytes, int page_type_flag, struct alloc_region *all
first_page++;
}
zero_dirty_pages(first_page, last_page, page_type_flag);
INSTRUMENTING(zero_dirty_pages(first_page, last_page, page_type_flag), et_bzeroing);
#ifdef LISP_FEATURE_DARWIN_JIT
if (page_type_flag == CODE_PAGE_TYPE) {
@ -1075,7 +1089,8 @@ gc_close_region(struct alloc_region *alloc_region, int page_type_flag)
page_bytes_t orig_first_page_bytes_used = page_bytes_used(first_page);
gc_assert(alloc_region->start_addr == page_base + orig_first_page_bytes_used);
int ret = thread_mutex_lock(&free_pages_lock);
int ret;
INSTRUMENTING(ret = thread_mutex_lock(&free_pages_lock), et_allocator_mutex_acq);
gc_assert(ret == 0);
// Mark the region as closed on its first page.
@ -1165,7 +1180,7 @@ gc_alloc_large(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_re
page_index_t first_page, last_page;
int ret;
ret = thread_mutex_lock(&free_pages_lock);
INSTRUMENTING(ret = thread_mutex_lock(&free_pages_lock), et_allocator_mutex_acq);
gc_assert(ret == 0);
first_page = alloc_start_page(page_type_flag, 1);
@ -1178,9 +1193,11 @@ gc_alloc_large(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_re
first_page = alloc_region->last_page+1;
}
INSTRUMENTING(
last_page = gc_find_freeish_pages(&first_page, nbytes,
SINGLE_OBJECT_FLAG | page_type_flag,
gc_alloc_generation);
gc_alloc_generation),
et_find_freeish_page);
// FIXME: Should this be 1+last_page ?
// (Doesn't matter too much since it'll be skipped on restart if unusable)
@ -1195,7 +1212,7 @@ gc_alloc_large(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_re
page_table[page].gen = gc_alloc_generation;
}
zero_dirty_pages(first_page, last_page, page_type_flag);
INSTRUMENTING(zero_dirty_pages(first_page, last_page, page_type_flag), et_bzeroing);
// Store a filler so that a linear heap walk does not try to examine
// these pages cons-by-cons (or whatever they happen to look like).
@ -4416,6 +4433,7 @@ lisp_alloc(struct alloc_region *region, sword_t nbytes,
gc_assert((((uword_t)region->free_pointer & LOWTAG_MASK) == 0)
&& ((nbytes & LOWTAG_MASK) == 0));
++thread->slow_path_allocs;
if ((os_vm_size_t) nbytes > large_allocation)
large_allocation = nbytes;

2
src/runtime/thread.h
View file

@ -28,6 +28,8 @@ struct thread_state_word {
#endif
};
typedef lispobj size_histogram[N_WORD_BITS];
#include "genesis/thread.h"
#include "genesis/thread-instance.h"
#include "genesis/fdefn.h"