benchmarks/finalize.lisp

   1 (defun make-threads (semaphore nwriters nobjects)
   2   (loop for i below nwriters
   3         collect
   4         (let ((list (loop repeat nobjects for j from 1
   5                             collect (cons i j))))
   6           (sb-thread:make-thread
   7            (lambda (things)
   8              (sb-thread:wait-on-semaphore semaphore)
   9              (dolist (thing things)
  10                (finalize thing #'+)) ; a no-op finalizer
  11              (mapc #'cancel-finalization things))
  12            :arguments (list list)
  13            :name (format nil "worker ~D" i)))))
  14
  15 (defun test-finalize+cancel (ntrials nwriters nobjects)
  16   (dotimes (i ntrials)
  17     (let* ((sem (sb-thread:make-semaphore))
  18            (threads (make-threads sem nwriters nobjects)))
  19       (sb-thread:signal-semaphore sem nwriters)
  20       (mapc #'sb-thread:join-thread threads))))
  21
  22 (time (test-finalize+cancel 100 4 10000)) ; 100 trials, 4 threads, 10k objects per thread
  23 #|
  24 ;; Old:
  25 Evaluation took:
  26   4.100 seconds of real time
  27   10.704615 seconds of total run time (10.585181 user, 0.119434 system)
  28   [ Run times consist of 0.017 seconds GC time, and 10.688 seconds non-GC time. ]
  29   261.10% CPU
  30   9,841,747,312 processor cycles
  31   203,244,640 bytes consed
  32
  33 ;; New:
  34 Evaluation took:
  35   1.179 seconds of real time
  36   2.874184 seconds of total run time (2.756504 user, 0.117680 system)
  37   [ Run times consist of 0.041 seconds GC time, and 2.834 seconds non-GC time. ]
  38   243.77% CPU
  39   2,830,553,292 processor cycles
  40   353,720,608 bytes consed
  41 |#