Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
92d52f8c
Commit
92d52f8c
authored
33 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Initial revision
parent
3ee30c4c
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
code/dyncount.lisp
+192
-0
192 additions, 0 deletions
code/dyncount.lisp
with
192 additions
and
0 deletions
code/dyncount.lisp
0 → 100644
+
192
−
0
View file @
92d52f8c
;;; -*- 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
)))))
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment