/[cmucl]/src/code/dyncount.lisp
ViewVC logotype

Contents of /src/code/dyncount.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Fri Mar 19 15:18:58 2010 UTC (4 years, 1 month ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, cross-sol-x86-branch
Changes since 1.7: +3 -1 lines
Merge intl-branch 2010-03-18 to HEAD.  To build, you need to use
boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
1 ;;; -*- Package: C; Log: C.Log -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/dyncount.lisp,v 1.8 2010/03/19 15:18:58 rtoy Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Runtime support for dynamic VOP statistics collection.
13 ;;;
14 (in-package "C")
15
16 (intl:textdomain "cmucl")
17
18 #|
19 Put *count-adjustments* back into VOP costs, and verify them.
20 Make sure multi-cycle instruction costs are plausible.
21 VOP classification.
22 Make tables of %cost for benchmark X class.
23 Could be represented as a sort of bar chart.
24 |#
25
26 (eval-when (compile)
27 (when *collect-dynamic-statistics*
28 (error "Compiling this file with dynamic stat collection turned on would ~
29 be a very bad idea.")))
30
31 ;;;; Hash utilities:
32
33 (defun make-hash-table-like (table)
34 "Make a hash-table with the same test as table."
35 (declare (type hash-table table))
36 (make-hash-table :test (lisp::hash-table-kind table)))
37
38 (defun hash-difference (table1 table2)
39 "Return a hash-table containing only the entries in Table1 whose key is not
40 also a key in Table2."
41 (declare (type hash-table table1 table2))
42 (let ((res (make-hash-table-like table1)))
43 (do-hash (k v table1)
44 (unless (nth-value 1 (gethash k table2))
45 (setf (gethash k res) v)))
46 res))
47
48 (defun hash-list (table)
49 "Return a list of the values in Table."
50 (declare (type hash-table table))
51 (collect ((res))
52 (do-hash (k v table)
53 (declare (ignore k))
54 (res v))
55 (res)))
56
57 ;;; READ-HASH-TABLE, WRITE-HASH-TABLE -- Public
58 ;;;
59 ;;; Read (or write) a hash table from (or to) a file.
60 ;;;
61 (defun read-hash-table (file)
62 (with-open-file (s file :direction :input)
63 (dotimes (i 3)
64 (format t "~%; ~A" (read-line s)))
65 (let* ((eof '(nil))
66 (test (read s))
67 (reader (read s))
68 (res (make-hash-table :test test)))
69 (read s); Discard writer...
70 (loop
71 (let ((key (read s nil eof)))
72 (when (eq key eof) (return))
73 (setf (gethash key res)
74 (funcall reader s key))))
75 res)))
76 ;;;
77 (defun write-hash-table (table file &key
78 (comment (format nil "Contents of ~S" table))
79 (reader 'read) (writer 'prin1) (test 'equal))
80 (with-open-file (s file :direction :output :if-exists :rename-and-delete)
81 (with-standard-io-syntax
82 (let ((*print-readably* nil))
83 (format s "~A~%Version ~A on ~A~%"
84 comment (lisp-implementation-version)
85 (machine-instance))
86 (format-universal-time s (get-universal-time))
87 (terpri s)
88 (format s "~S ~S ~S~%" test reader writer)
89 (do-hash (k v table)
90 (prin1 k s)
91 (write-char #\space s)
92 (funcall writer v s)
93 (terpri s)))))
94 table)
95
96
97 ;;;; Info accumulation:
98
99 ;;; Used to accumulate info about the usage of a single VOP. Cost and count
100 ;;; are kept as double-floats, which lets us get more bits and avoid annoying
101 ;;; overflows.
102 ;;;
103 (deftype count-vector () '(simple-array double-float (2)))
104 ;;;
105 (defstruct (vop-stats
106 (:constructor %make-vop-stats (name))
107 (:constructor make-vop-stats-key))
108 (name (required-argument) :type simple-string)
109 (data (make-array 2 :element-type 'double-float) :type count-vector))
110
111 (defmacro vop-stats-count (x) `(aref (vop-stats-data ,x) 0))
112 (defmacro vop-stats-cost (x) `(aref (vop-stats-data ,x) 1))
113
114 (defun make-vop-stats (&key name count cost)
115 (let ((res (%make-vop-stats name)))
116 (setf (vop-stats-count res) count)
117 (setf (vop-stats-cost res) cost)
118 res))
119
120 (declaim (freeze-type dyncount-info vop-stats))
121
122
123 ;;; NOTE-DYNCOUNT-INFO -- Internal
124 ;;;
125 ;;; Add the Info into the cumulative result on the VOP name plist. We use
126 ;;; plists so that we will touch minimal system code outside of this file
127 ;;; (which may be compiled with profiling on.)
128 ;;;
129 (defun note-dyncount-info (info)
130 (declare (type dyncount-info info) (inline get %put)
131 (optimize (speed 2)))
132 (let ((counts (dyncount-info-counts info))
133 (vops (dyncount-info-vops info)))
134 (dotimes (index (length counts))
135 (declare (type index index))
136 (let ((count (coerce (the (unsigned-byte 31)
137 (aref counts index))
138 'double-float)))
139 (when (minusp count)
140 (warn "Oops: overflow.")
141 (return-from note-dyncount-info nil))
142 (unless (zerop count)
143 (let* ((vop-info (svref vops index))
144 (length (length vop-info)))
145 (declare (simple-vector vop-info))
146 (do ((i 0 (+ i 4)))
147 ((>= i length))
148 (declare (type index i))
149 (let* ((name (svref vop-info i))
150 (entry (or (get name 'vop-stats)
151 (setf (get name 'vop-stats)
152 (%make-vop-stats (symbol-name name))))))
153 (incf (vop-stats-count entry)
154 (* (coerce (the index (svref vop-info (1+ i)))
155 'double-float)
156 count))
157 (incf (vop-stats-cost entry)
158 (* (coerce (the index (svref vop-info (+ i 2)))
159 'double-float)
160 count))))))))))
161
162 (defun clear-dyncount-info (info)
163 (declare (type dyncount-info info))
164 (declare (optimize (speed 3) (safety 0)))
165 (let ((counts (dyncount-info-counts info)))
166 (dotimes (i (length counts))
167 (setf (aref counts i) 0))))
168
169
170 ;;; CLEAR-VOP-COUNTS -- Public
171 ;;;
172 ;;; Clear any VOP-COUNTS properties and the counts vectors for all code
173 ;;; objects. The latter loop must not call any random functions.
174 ;;;
175 (defun clear-vop-counts (&optional (spaces '(:dynamic)))
176 "Clear all dynamic VOP counts for code objects in the specified spaces."
177 (do-hash (k v (backend-template-names *backend*))
178 (declare (ignore v))
179 (remprop k 'vop-stats))
180
181 (locally
182 (declare (optimize (speed 3) (safety 0))
183 (inline vm::map-allocated-objects))
184 (without-gcing
185 (dolist (space spaces)
186 (vm::map-allocated-objects
187 #'(lambda (object type-code size)
188 (declare (ignore type-code size))
189 (when (dyncount-info-p object)
190 (clear-dyncount-info object)))
191 space)))))
192
193
194 ;;; GET-VOP-COUNTS -- Public
195 ;;;
196 ;;; Call NOTE-DYNCOUNT-INFO on all DYNCOUNT-INFO structure allocated in the
197 ;;; specified spaces. Return a hash table describing the counts. The initial
198 ;;; loop must avoid calling any functions outside this file to prevent adding
199 ;;; noise to the data, since other files may be compiled with profiling.
200 ;;;
201 (defun get-vop-counts (&optional (spaces '(:dynamic)) &key (clear nil))
202 "Return a hash-table mapping string VOP names to VOP-STATS structures
203 describing the VOPs executed. If clear is true, then reset all counts to
204 zero as a side-effect."
205 (locally
206 (declare (optimize (speed 3) (safety 0))
207 (inline vm::map-allocated-objects))
208 (without-gcing
209 (dolist (space spaces)
210 (vm::map-allocated-objects
211 #'(lambda (object type-code size)
212 (declare (ignore type-code size))
213 (when (dyncount-info-p object)
214 (note-dyncount-info object)
215 (when clear
216 (clear-dyncount-info object))))
217 space))))
218
219 (let ((counts (make-hash-table :test #'equal)))
220 (do-hash (k v (backend-template-names *backend*))
221 (declare (ignore v))
222 (let ((stats (get k 'vop-stats)))
223 (when stats
224 (setf (gethash (symbol-name k) counts) stats)
225 (when clear
226 (remprop k 'vop-stats)))))
227 counts))
228
229
230 ;;; FIND-INFO-FOR -- Interface
231 ;;;
232 ;;; Return the DYNCOUNT-INFO for FUNCTION.
233 ;;;
234 (defun find-info-for (function)
235 (declare (type function function))
236 (let* ((function (%primitive closure-function function))
237 (component (di::function-code-header function)))
238 (do ((end (get-header-data component))
239 (i vm:code-constants-offset (1+ i)))
240 ((= end i))
241 (let ((constant (code-header-ref component i)))
242 (when (dyncount-info-p constant)
243 (return constant))))))
244
245
246 (defun vop-counts-apply (function args &key (spaces '(:dynamic)) by-space)
247 "Apply Function to Args, collecting dynamic statistics on the running.
248 Spaces are the spaces to scan for counts. If By-Space is true, we return a
249 list of result tables, instead of a single table. In this case, specify
250 :READ-ONLY first."
251 (clear-vop-counts spaces)
252 (apply function args)
253 (if by-space
254 (mapcar #'(lambda (space)
255 (get-vop-counts (list space) :clear t))
256 spaces)
257 (get-vop-counts spaces)))
258
259 ;;;; Adjustments:
260
261 #|
262 (defparameter *count-adjustments*
263 '((return-multiple 152)
264 (tail-call-variable 88)
265 (unwind 92)
266 (throw 116)
267 (allocate-vector 72)
268 (sxhash-simple-string 248)
269 (sxhash-simple-substring 264)
270 (copy-to-system-area 1200)
271 (copy-from-system-area 1200)
272 (system-area-copy 1204)
273 (bit-bash-copy 1412)
274 (vm::generic-+ 72)
275 (vm::generic-- 72)
276 (vm::generic-* 184)
277 (vm::generic-< 68)
278 (vm::generic-> 68)
279 (vm::generic-eql 80)
280 (vm::generic-= 80)
281 (vm::generic-/= 104)
282 (%make-weak-pointer 60)
283 (make-value-cell 56)
284 (vm::make-funcallable-instance 76)
285 (make-closure 76)
286 (make-complex 60)
287 (make-ratio 60)
288 (%allocate-bignum 72)
289 (make-structure 72)
290 (cons 50)))
291 |#
292
293 ;;; GET-VOP-COSTS -- Public
294 ;;;
295 (defun get-vop-costs ()
296 "Return a hash-table mapping string VOP names to the cost recorded in the
297 generator for all VOPs which are also the names of assembly routines."
298 (let ((res (make-hash-table :test #'equal)))
299 (do-hash (name v lisp::*assembler-routines*)
300 (declare (ignore v))
301 (let ((vop (gethash name (backend-template-names *backend*))))
302 (when vop
303 (setf (gethash (symbol-name name) res)
304 (template-cost (template-or-lose name))))))
305 res))
306
307 (defvar *native-costs* (get-vop-costs)
308 "Costs of assember routines on this machine.")
309
310
311 ;;;; Classification:
312
313 (defparameter *basic-classes*
314 '(("Integer multiplication"
315 "*/FIXNUM" "*/SIGNED" "*/UNSIGNED" "SIGNED-*" "FIXNUM-*" "GENERIC-*")
316 ("Integer division" "TRUNCATE")
317 ("Generic arithmetic" "GENERIC" "TWO-ARG")
318 ("Inline EQL" "EQL")
319 ("Inline compare less/greater" "</" ">/" "<-C/" ">-C/")
320 ("Inline arith" "*/" "//" "+/" "-/" "NEGATE" "ABS" "+-C" "--C")
321 ("Inline logic" "-ASH" "$ASH" "LOG")
322 ("CAR/CDR" "CAR" "CDR")
323 ("Array type test" "ARRAYP" "VECTORP" "ARRAY-HEADER-P")
324 ("Simple type predicate" "STRUCTUREP" "LISTP" "FIXNUMP")
325 ("Simple type check" "CHECK-LIST" "CHECK-FIXNUM" "CHECK-STRUCTURE")
326 ("Array bounds check" "CHECK-BOUND")
327 ("Complex type check" "$CHECK-" "COERCE-TO-FUNCTION")
328 ("Special read" "SYMBOL-VALUE")
329 ("Special bind" "BIND$")
330 ("Tagging" "MOVE-FROM")
331 ("Untagging" "MOVE-TO" "MAKE-FIXNUM")
332 ("Move" "MOVE")
333 ("Non-local exit" "CATCH" "THROW" "DYNAMIC-STATE" "NLX" "UNWIND")
334 ("Array write" "DATA-VECTOR-SET" "$SET-RAW-BITS$")
335 ("Array read" "DATA-VECTOR-REF" "$RAW-BITS$" "VECTOR-LENGTH"
336 "LENGTH/SIMPLE" "ARRAY-HEADER")
337 ("List/string utility" "LENGTH/LIST" "SXHASH" "BIT-BASH" "$LENGTH$")
338 ("Alien operations" "SAP" "ALLOC-NUMBER-STACK" "$CALL-OUT$")
339 ("Function call/return" "CALL" "RETURN" "ALLOCATE-FRAME"
340 "COPY-MORE-ARG" "LISTIFY-REST-ARG" "VERIFY-ARGUMENT-COUNT")
341 ("Allocation" "MAKE-" "ALLOC" "$CONS$" "$LIST$" "$LIST*$")
342 ("Float conversion" "%SINGLE-FLOAT" "%DOUBLE-FLOAT" "-BITS$")
343 ("Complex type predicate" "P$")))
344
345
346 ;;; MATCHES-PATTERN -- Internal
347 ;;;
348 ;;; Return true if Name patches a specified pattern. Pattern is a string
349 ;;; (or symbol) or a list of strings (or symbols). If any specified string
350 ;;; appears as a substring of name, the pattern is matched. #\$'s are wrapped
351 ;;; around name, allowing the use of $ to force a match at the beginning or
352 ;;; end.
353 ;;;
354 (defun matches-pattern (name pattern)
355 (declare (simple-string name))
356 (let ((name (concatenate 'string "$" name "$")))
357 (dolist (pat (if (listp pattern) pattern (list pattern)) nil)
358 (when (search (the simple-string (string pat))
359 name :test #'char=)
360 (return t)))))
361
362
363 ;;; FIND-MATCHES, WHAT-CLASS -- Interface
364 ;;;
365 ;;; Utilities for debugging classification rules. FIND-MATCHES returns a
366 ;;; list of all the VOP names in Table that match Pattern. WHAT-CLASS returns
367 ;;; the class that NAME would be placed in.
368 ;;;
369 (defun find-matches (table pattern)
370 (collect ((res))
371 (do-hash (key value table)
372 (declare (ignore value))
373 (when (matches-pattern key pattern) (res key)))
374 (res)))
375 ;;;
376 (defun what-class (name classes)
377 (dolist (class classes nil)
378 (when (matches-pattern name (rest class)) (return (first class)))))
379
380
381 ;;; CLASSIFY-COSTS -- Interface
382 ;;;
383 ;;; Given a VOP-STATS hash-table, return a new one with VOPs in the same
384 ;;; class merged into a single entry for that class. The classes are
385 ;;; represented as a list of lists: (class-name pattern*). Each pattern is a
386 ;;; string (or symbol) that can appear as a subsequence of the VOP name. A VOP
387 ;;; is placed in the first class that it matches, or is left alone if it
388 ;;; matches no class.
389 ;;;
390 (defun classify-costs (table classes)
391 (let ((res (make-hash-table-like table)))
392 (do-hash (key value table)
393 (let ((class (dolist (class classes nil)
394 (when (matches-pattern key (rest class))
395 (return (first class))))))
396 (if class
397 (let ((found (or (gethash class res)
398 (setf (gethash class res)
399 (%make-vop-stats class)))))
400 (incf (vop-stats-count found) (vop-stats-count value))
401 (incf (vop-stats-cost found) (vop-stats-cost value)))
402 (setf (gethash key res) value))))
403 res))
404
405
406 ;;;; Analysis:
407
408 ;;; COST-SUMMARY -- Internal
409 ;;;
410 ;;; Sum the count and costs.
411 ;;;
412 (defun cost-summary (table)
413 (let ((total-count 0d0)
414 (total-cost 0d0))
415 (do-hash (k v table)
416 (declare (ignore k))
417 (incf total-count (vop-stats-count v))
418 (incf total-cost (vop-stats-cost v)))
419 (values total-count total-cost)))
420
421
422 ;;; COMPENSATE-COSTS -- Internal
423 ;;;
424 ;;; Return a hash table of DYNCOUNT-INFO structures, with cost adjustments
425 ;;; according to the Costs table. Any VOPs in the list IGNORE are ignored.
426 ;;;
427 (defun compensate-costs (table costs &optional ignore)
428 (let ((res (make-hash-table-like table)))
429 (do-hash (key value table)
430 (unless (or (string= key "COUNT-ME")
431 (member key ignore :test #'string=))
432 (let ((cost (gethash key costs)))
433 (if cost
434 (let* ((count (vop-stats-count value))
435 (sum (+ (* cost count)
436 (vop-stats-cost value))))
437 (setf (gethash key res)
438 (make-vop-stats :name key :count count :cost sum)))
439 (setf (gethash key res) value)))))
440 res))
441
442
443 ;;; COMPARE-STATS -- Internal
444 ;;;
445 ;;; Take two tables of vop-stats and return a table of entries where the
446 ;;; entries have been compared. The counts are normalized to Compared. The
447 ;;; costs are the difference of the costs adjusted by the difference in counts:
448 ;;; the cost for Original is modified to correspond to the count in Compared.
449 ;;;
450 (defun compare-stats (original compared)
451 (declare (type hash-table original compared))
452 (let ((res (make-hash-table-like original)))
453 (do-hash (k cv compared)
454 (let ((ov (gethash k original)))
455 (when ov
456 (let ((norm-cnt (/ (vop-stats-count ov) (vop-stats-count cv))))
457 (setf (gethash k res)
458 (make-vop-stats
459 :name k
460 :count norm-cnt
461 :cost (- (/ (vop-stats-cost ov) norm-cnt)
462 (vop-stats-cost cv))))))))
463 res))
464
465
466 ;;; COMBINE-STATS -- Public
467 ;;;
468 (defun combine-stats (&rest tables)
469 "Sum the VOP stats for the specified tables, returning a new table with the
470 combined results."
471 (let ((res (make-hash-table-like (first tables))))
472 (dolist (table tables)
473 (do-hash (k v table)
474 (let ((found (or (gethash k res)
475 (setf (gethash k res) (%make-vop-stats k)))))
476 (incf (vop-stats-count found) (vop-stats-count v))
477 (incf (vop-stats-cost found) (vop-stats-cost v)))))
478 res))
479
480
481 ;;;; Report generation:
482
483 ;;; SORT-RESULT -- Internal
484 ;;;
485 (defun sort-result (table by)
486 (sort (hash-list table) #'>
487 :key #'(lambda (x)
488 (abs (ecase by
489 (:count (vop-stats-count x))
490 (:cost (vop-stats-cost x)))))))
491
492
493 ;;; ENTRY-REPORT -- Internal
494 ;;;
495 ;;; Report about VOPs in the list of stats structures.
496 ;;;
497 (defun entry-report (entries cut-off compensated compare total-cost)
498 (let ((counter (if (and cut-off (> (length entries) cut-off))
499 cut-off
500 most-positive-fixnum)))
501 (dolist (entry entries)
502 (let* ((cost (vop-stats-cost entry))
503 (name (vop-stats-name entry))
504 (entry-count (vop-stats-count entry))
505 (comp-entry (if compare (gethash name compare) entry))
506 (count (vop-stats-count comp-entry)))
507 (format t "~30<~A~>: ~:[~13:D~;~13,2F~] ~9,2F ~5,2,2F%~%"
508 (vop-stats-name entry)
509 compare
510 (if compare entry-count (round entry-count))
511 (/ cost count)
512 (/ (if compare
513 (- (vop-stats-cost (gethash name compensated))
514 (vop-stats-cost comp-entry))
515 cost)
516 total-cost))
517 (when (zerop (decf counter))
518 (format t "[End of top ~D]~%" cut-off))))))
519
520 ;;; FIND-CUT-OFF -- Internal
521 ;;;
522 ;;; Divide Sorted into two lists, the first cut-off elements long. Any VOP
523 ;;; names that match one of the report strings are moved into the report list
524 ;;; even if they would otherwise fall below the cut-off.
525 ;;;
526 (defun find-cut-off (sorted cut-off report)
527 (if (or (not cut-off) (<= (length sorted) cut-off))
528 (values sorted ())
529 (let ((not-cut (subseq sorted 0 cut-off)))
530 (collect ((select)
531 (reject))
532 (dolist (el (nthcdr cut-off sorted))
533 (let ((name (vop-stats-name el)))
534 (if (matches-pattern name report)
535 (select el)
536 (reject el))))
537 (values (append not-cut (select)) (reject))))))
538
539
540 ;;; CUT-OFF-REPORT -- Internal
541 ;;;
542 ;;; Display information about entries that were not displayed due to the
543 ;;; cut-off. Note: if compare, we find the total cost delta and the geometric
544 ;; mean of the normalized counts.
545 ;;
546 (defun cut-off-report (other compare total-cost)
547 (let ((rest-cost 0d0)
548 (rest-count 0d0)
549 (rest-entry-count (if compare 1d0 0d0)))
550 (dolist (entry other)
551 (incf rest-cost (vop-stats-cost entry))
552 (incf rest-count
553 (vop-stats-count
554 (if compare
555 (gethash (vop-stats-name entry) compare)
556 entry)))
557 (if compare
558 (setq rest-entry-count
559 (* rest-entry-count (vop-stats-count entry)))
560 (incf rest-entry-count (vop-stats-count entry))))
561
562 (let ((count (if compare
563 (expt rest-entry-count
564 (/ (coerce (length other) 'double-float)))
565 (round rest-entry-count))))
566 (format t "~30<Other~>: ~:[~13:D~;~13,2F~] ~9,2F ~@[~5,2,2F%~]~%"
567 compare count
568 (/ rest-cost rest-count)
569 (unless compare
570 (/ rest-cost total-cost))))))
571
572
573 ;;; COMPARE-REPORT -- Internal
574 ;;;
575 ;;; Report summary information about the difference between the comparison
576 ;;; and base data sets.
577 ;;;
578 (defun compare-report (total-count total-cost compare-total-count
579 compare-total-cost compensated compare)
580 (format t "~30<Relative total~>: ~13,2F ~9,2F~%"
581 (/ total-count compare-total-count)
582 (/ total-cost compare-total-cost))
583 (flet ((frob (a b sign wot)
584 (multiple-value-bind
585 (cost count) (cost-summary (hash-difference a b))
586 (unless (zerop count)
587 (format t "~30<~A~>: ~13:D ~9,2F ~5,2,2F%~%"
588 wot (* sign (round count))
589 (* sign (/ cost count))
590 (* sign (/ cost compare-total-cost)))))))
591 (frob compensated compare 1 "Not in comparison")
592 (frob compare compensated -1 "Only in comparison"))
593 (format t "~30<Comparison total~>: ~13,2E ~9,2E~%"
594 compare-total-count compare-total-cost))
595
596
597 ;;; The fraction of system time that we guess happened during GC.
598 ;;;
599 (defparameter *gc-system-fraction* 2/3)
600
601 ;;; FIND-CPI -- Interface
602 ;;;
603 ;;; Estimate CPI from CPU time and cycles accounted in profiling
604 ;;; information.
605 ;;;
606 (defun find-cpi (total-cost user system gc clock)
607 (let ((adj-time (if (zerop gc)
608 user
609 (- user (- gc (* system *gc-system-fraction*))))))
610 (/ (* adj-time clock) total-cost)))
611
612
613 ;;; GENERATE-REPORT -- Public
614 ;;;
615 ;;; Generate a report from the specified table.
616 ;;;
617 (defun generate-report (table &key (cut-off 15) (sort-by :cost)
618 (costs *native-costs*)
619 ((:compare uncomp-compare))
620 (compare-costs costs)
621 ignore report
622 (classes *basic-classes*)
623 user (system 0d0) (gc 0d0)
624 (clock 25d6))
625 (let* ((compensated
626 (classify-costs
627 (if costs
628 (compensate-costs table costs ignore)
629 table)
630 classes))
631 (compare
632 (when uncomp-compare
633 (classify-costs
634 (if compare-costs
635 (compensate-costs uncomp-compare compare-costs ignore)
636 uncomp-compare)
637 classes)))
638 (compared (if compare
639 (compare-stats compensated compare)
640 compensated))
641 (*gc-verbose* nil))
642 (multiple-value-bind (total-count total-cost)
643 (cost-summary compensated)
644 (multiple-value-bind (compare-total-count compare-total-cost)
645 (when compare (cost-summary compare))
646 (format t "~2&~30<Vop~> ~13<Count~> ~9<Cost~> ~6:@<Percent~>~%")
647 (let ((sorted (sort-result compared sort-by))
648 (base-total (if compare compare-total-cost total-cost)))
649 (multiple-value-bind
650 (report other)
651 (find-cut-off sorted cut-off report)
652 (entry-report report cut-off compensated compare base-total)
653 (when other
654 (cut-off-report other compare base-total))))
655
656 (when compare
657 (compare-report total-count total-cost compare-total-count
658 compare-total-cost compensated compare))
659
660 (format t "~30<Total~>: ~13,2E ~9,2E~%" total-count total-cost)
661 (when user
662 (format t "~%Cycles per instruction = ~,2F~%"
663 (find-cpi total-cost user system gc clock))))))
664 (values))
665
666
667 ;;; STATS-{READER,WRITER} -- Public
668 ;;;
669 ;;; Read & write VOP stats using hash IO utility.
670 ;;;
671 (defun stats-reader (stream key)
672 (make-vop-stats :name key :count (read stream) :cost (read stream)))
673 ;;;
674 (defun stats-writer (object stream)
675 (format stream "~S ~S" (vop-stats-count object) (vop-stats-cost object)))

  ViewVC Help
Powered by ViewVC 1.1.5