Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; Runtime support for dynamic statistic collecting.
;;;
(in-package "C")
(eval-when (compile)
(when *collect-dynamic-statistics*
(error "Compiling this file with dynamic stat collection turn on would ~
be a very bad idea.")))
(eval-when (compile load eval)
(defparameter *count-adjustments*
'((return-multiple 152)
(tail-call-variable 88)
(unwind 92)
(throw 116)
(allocate-vector 72)
(sxhash-simple-string 248)
(sxhash-simple-substring 264)
(copy-to-system-area 1200)
(copy-from-system-area 1200)
(system-area-copy 1204)
(bit-bash-copy 1412)
(vm::generic-+ 72)
(vm::generic-- 72)
(vm::generic-* 184)
(vm::generic-< 68)
(vm::generic-> 68)
(vm::generic-eql 80)
(vm::generic-= 80)
(vm::generic-/= 104)
(%make-weak-pointer 60)
(make-value-cell 56)
(vm::make-funcallable-instance 76)
(make-closure 76)
(make-complex 60)
(make-ratio 60)
(%allocate-bignum 72)
(make-structure 72)
(cons 50))))
(defvar *count-adjustments-hashtable*
(let ((result (make-hash-table :test 'eq)))
(dolist (entry *count-adjustments*)
(setf (gethash (car entry) result) (cadr entry)))
result))
(defvar *vop-counts* nil)
(defun note-dyncount-info (info)
(declare (type dyncount-info info))
(let ((counts (dyncount-info-counts info))
(vops (dyncount-info-vops info)))
(dotimes (index (length counts))
(let ((count (aref counts index)))
(unless (zerop count)
(let* ((vop-info (svref vops index))
(length (length vop-info)))
(do ((i 0 (+ i 4)))
((>= i length))
(let* ((name (svref vop-info i))
(adjustment
(gethash name *count-adjustments-hashtable* 0))
(entry (gethash name *vop-counts*))
(counts (* (svref vop-info (1+ i)) count))
(cost (* (+ (svref vop-info (+ i 2)) adjustment)
count))
(elsewhere-cost (* (svref vop-info (+ i 3)) count)))
(unless entry
(setf entry (make-array 4 :initial-element 0))
(setf (svref entry 0) name)
(setf (gethash name *vop-counts*) entry))
(incf (svref entry 1) counts)
(incf (svref entry 2) cost)
(incf (svref entry 3) elsewhere-cost)))))))))
(defun clear-dyncount-info (info)
(declare (type dyncount-info info))
(fill (dyncount-info-counts info) 0)
nil)
(defun find-info-for (function)
(declare (type function function))
(let* ((function (%primitive closure-function function))
(component (di::function-code-header function)))
(do ((end (get-header-data component))
(i vm:code-constants-offset (1+ i)))
((= end i))
(let ((constant (code-header-ref component i)))
(when (dyncount-info-p constant)
(return constant))))))
#+nil
(defun find-dyncount-info ()
(declare (inline vm::map-allocated-objects)
(optimize (speed 3) (safety 0)))
(let ((results nil))
(dolist (space '(:read-only :static :dynamic))
(vm::map-allocated-objects
#'(lambda (object type-code size)
(declare (ignore type-code size))
(when (dyncount-info-p object)
(push object results)))
space))
(setf *all-dyncount-infos* results)
(length results)))
(defun generate-report (cut-off sort-by)
(let ((total-bytes 0)
(list nil))
(maphash #'(lambda (key value)
(push value list)
(unless (eq key 'c:count-me)
(incf total-bytes (svref value 2))))
*vop-counts*)
(format t "~30<Vop~> ~13<Count~> ~17<Cost~> ~5:@<Percent~>~%")
(let ((total-bytes (coerce total-bytes 'double-float))
(entries (sort list #'>
:key #'(lambda (x)
(svref x
(ecase sort-by
(:count 1)
(:cost 2)))))))
(dolist (entry entries)
(when (and cut-off (minusp (decf cut-off)))
(return))
(unless (eq (svref entry 0) 'c:count-me)
(format t "~30<~A~>: ~13:D ~17:D ~4,1,2F%~%"
(symbol-name (svref entry 0))
(svref entry 1)
(svref entry 2)
(/ (coerce (svref entry 2) 'double-float)
total-bytes))))))
(values))
(defun report-dynamic-vop-counts (&key spaces (cut-off 15) (sort-by :cost))
(let ((*vop-counts* (make-hash-table :test #'eq)))
(without-gcing
(dolist (space (or spaces '(:read-only :static :dynamic)))
(format t "Scanning ~S space...~%" space)
(locally
(declare (optimize (speed 3) (safety 0)))
(vm::map-allocated-objects
#'(lambda (object type-code size)
(declare (ignore type-code size))
(when (dyncount-info-p object)
(note-dyncount-info object)))
space))))
(generate-report cut-off sort-by)))
(defun clear-dynamic-vop-counts (&rest spaces)
(without-gcing
(dolist (space (or spaces '(:read-only :static :dynamic)))
(format t "Scanning ~S space...~%" space)
(locally
(declare (optimize (speed 3) (safety 0)))
(vm::map-allocated-objects
#'(lambda (object type-code size)
(declare (ignore type-code size))
(when (dyncount-info-p object)
(clear-dyncount-info object)))
space)))))
(defun check-dynamic-vop-counts (&rest spaces)
(without-gcing
(dolist (space (or spaces '(:read-only :static :dynamic)))
(format t "Scanning ~S space...~%" space)
(locally
(declare (optimize (speed 3) (safety 0)))
(vm::map-allocated-objects
#'(lambda (object type-code size)
(when (dyncount-info-p object)
(assert (= (length (dyncount-info-counts object))
(length (dyncount-info-vops object))))))
space)))))