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
24303cdd
Commit
24303cdd
authored
32 years ago
by
ram
Browse files
Options
Downloads
Patches
Plain Diff
Uh, more changes. CPI estimate, whatever.
parent
58b919e1
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
code/dyncount.lisp
+293
-36
293 additions, 36 deletions
code/dyncount.lisp
with
293 additions
and
36 deletions
code/dyncount.lisp
+
293
−
36
View file @
24303cdd
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dyncount.lisp,v 1.
2
1992/0
2/13 09:54:29
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/dyncount.lisp,v 1.
3
1992/0
5/27 00:33:00
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -55,7 +55,7 @@ VOP classification.
(
let
((
res
(
make-hash-table-like
table1
)))
(
do-hash
(
k
v
table1
)
(
unless
(
nth-value
1
(
gethash
k
table2
))
(
setf
(
gethash
res
k
)
v
)))
(
setf
(
gethash
k
res
)
v
)))
res
))
(
defun
hash-list
(
table
)
...
...
@@ -211,7 +211,7 @@ VOP classification.
;;; loop must avoid calling any functions outside this file to prevent adding
;;; noise to the data, since other files may be compiled with profiling.
;;;
(
defun
get-vop-counts
(
&optional
(
spaces
'
(
:dynamic
))
&key
(
clear
t
))
(
defun
get-vop-counts
(
&optional
(
spaces
'
(
:dynamic
))
&key
(
clear
nil
))
"Return a hash-table mapping string VOP names to VOP-STATS structures
describing the VOPs executed. If clear is true, then reset all counts to
zero as a side-effect."
...
...
@@ -234,7 +234,7 @@ VOP classification.
(
declare
(
ignore
v
))
(
let
((
stats
(
get
k
'vop-stats
)))
(
when
stats
(
setf
(
gethash
k
counts
)
stats
)
(
setf
(
gethash
(
symbol-name
k
)
counts
)
stats
)
(
when
clear
(
remprop
k
'vop-stats
)))))
counts
))
...
...
@@ -264,11 +264,14 @@ VOP classification.
(
clear-vop-counts
spaces
)
(
apply
function
args
)
(
if
by-space
(
mapcar
#'
get-vop-counts
spaces
)
(
mapcar
#'
(
lambda
(
space
)
(
get-vop-counts
(
list
space
)
:clear
t
))
spaces
)
(
get-vop-counts
spaces
)))
;;;; Adjustments:
#|
(defparameter *count-adjustments*
'((return-multiple 152)
(tail-call-variable 88)
...
...
@@ -298,6 +301,7 @@ VOP classification.
(%allocate-bignum 72)
(make-structure 72)
(cons 50)))
|#
;;; GET-VOP-COSTS -- Public
;;;
...
...
@@ -317,7 +321,102 @@ VOP classification.
"Costs of assember routines on this machine."
)
;;;; Analysis and report generation:
;;;; Classification:
(
defparameter
*basic-classes*
'
((
"Integer multiplication"
"*/FIXNUM"
"*/SIGNED"
"*/UNSIGNED"
"SIGNED-*"
"FIXNUM-*"
"GENERIC-*"
)
(
"Integer division"
"TRUNCATE"
)
(
"Generic arithmetic"
"GENERIC"
"TWO-ARG"
)
(
"Inline EQL"
"EQL"
)
(
"Inline compare less/greater"
"</"
">/"
"<-C/"
">-C/"
)
(
"Inline arith"
"*/"
"//"
"+/"
"-/"
"NEGATE"
"ABS"
"+-C"
"--C"
)
(
"Inline logic"
"-ASH"
"$ASH"
"LOG"
)
(
"CAR/CDR"
"CAR"
"CDR"
)
(
"Array type test"
"ARRAYP"
"VECTORP"
"ARRAY-HEADER-P"
)
(
"Simple type predicate"
"STRUCTUREP"
"LISTP"
"FIXNUMP"
)
(
"Simple type check"
"CHECK-LIST"
"CHECK-FIXNUM"
"CHECK-STRUCTURE"
)
(
"Array bounds check"
"CHECK-BOUND"
)
(
"Complex type check"
"$CHECK-"
"COERCE-TO-FUNCTION"
)
(
"Special read"
"SYMBOL-VALUE"
)
(
"Special bind"
"BIND$"
)
(
"Tagging"
"MOVE-FROM"
)
(
"Untagging"
"MOVE-TO"
"MAKE-FIXNUM"
)
(
"Move"
"MOVE"
)
(
"Non-local exit"
"CATCH"
"THROW"
"DYNAMIC-STATE"
"NLX"
"UNWIND"
)
(
"Array write"
"DATA-VECTOR-SET"
"$SET-RAW-BITS$"
)
(
"Array read"
"DATA-VECTOR-REF"
"$RAW-BITS$"
"VECTOR-LENGTH"
"LENGTH/SIMPLE"
"ARRAY-HEADER"
)
(
"List/string utility"
"LENGTH/LIST"
"SXHASH"
"BIT-BASH"
"$LENGTH$"
)
(
"Alien operations"
"SAP"
"ALLOC-NUMBER-STACK"
"$CALL-OUT$"
)
(
"Function call/return"
"CALL"
"RETURN"
"ALLOCATE-FRAME"
"COPY-MORE-ARG"
"LISTIFY-REST-ARG"
"VERIFY-ARGUMENT-COUNT"
)
(
"Allocation"
"MAKE-"
"ALLOC"
"$CONS$"
"$LIST$"
"$LIST*$"
)
(
"Float conversion"
"%SINGLE-FLOAT"
"%DOUBLE-FLOAT"
"-BITS$"
)
(
"Complex type predicate"
"P$"
)))
;;; MATCHES-PATTERN -- Internal
;;;
;;; Return true if Name patches a specified pattern. Pattern is a string
;;; (or symbol) or a list of strings (or symbols). If any specified string
;;; appears as a substring of name, the pattern is matched. #\$'s are wapped
;;; around name, allowing the use of $ to force a match at the beginning or
;;; end.
;;;
(
defun
matches-pattern
(
name
pattern
)
(
declare
(
simple-string
name
))
(
let
((
name
(
concatenate
'string
"$"
name
"$"
)))
(
dolist
(
pat
(
if
(
listp
pattern
)
pattern
(
list
pattern
))
nil
)
(
when
(
search
(
the
simple-string
(
string
pat
))
name
:test
#'
char=
)
(
return
t
)))))
;;; FIND-MATCHES, WHAT-CLASS -- Interface
;;;
;;; Utilities for debugging classification rules. FIND-MATCHES returns a
;;; list of all the VOP names in Table that match Pattern. WHAT-CLASS returns
;;; the class that NAME would be placed in.
;;;
(
defun
find-matches
(
table
pattern
)
(
collect
((
res
))
(
do-hash
(
key
value
table
)
(
declare
(
ignore
value
))
(
when
(
matches-pattern
key
pattern
)
(
res
key
)))
(
res
)))
;;;
(
defun
what-class
(
name
classes
)
(
dolist
(
class
classes
nil
)
(
when
(
matches-pattern
name
(
rest
class
))
(
return
(
first
class
)))))
;;; CLASSIFY-COSTS -- Interface
;;;
;;; Given a VOP-STATS hash-table, return a new one with VOPs in the same
;;; class merged into a single entry for that class. The classes are
;;; represented as a list of lists: (class-name pattern*). Each pattern is a
;;; string (or symbol) that can appear as a subsequence of the VOP name. A VOP
;;; is placed in the first class that it matches, or is left alone if it
;;; matches no class.
;;;
(
defun
classify-costs
(
table
classes
)
(
let
((
res
(
make-hash-table-like
table
)))
(
do-hash
(
key
value
table
)
(
let
((
class
(
dolist
(
class
classes
nil
)
(
when
(
matches-pattern
key
(
rest
class
))
(
return
(
first
class
))))))
(
if
class
(
let
((
found
(
or
(
gethash
class
res
)
(
setf
(
gethash
class
res
)
(
%make-vop-stats
class
)))))
(
incf
(
vop-stats-count
found
)
(
vop-stats-count
value
))
(
incf
(
vop-stats-cost
found
)
(
vop-stats-cost
value
)))
(
setf
(
gethash
key
res
)
value
))))
res
))
;;;; Analysis:
;;; COST-SUMMARY -- Internal
;;;
...
...
@@ -336,12 +435,13 @@ VOP classification.
;;; COMPENSATE-COSTS -- Internal
;;;
;;; Return a hashtable of DYNCOUNT-INFO structures, with cost adjustments
;;; according to the Costs table.
;;; according to the Costs table.
Any VOPs in the list IGNORE are ignored.
;;;
(
defun
compensate-costs
(
table
costs
)
(
defun
compensate-costs
(
table
costs
&optional
ignore
)
(
let
((
res
(
make-hash-table-like
table
)))
(
do-hash
(
key
value
table
)
(
unless
(
string=
key
"COUNT-ME"
)
(
unless
(
or
(
string=
key
"COUNT-ME"
)
(
member
key
ignore
:test
#'
string=
))
(
let
((
cost
(
gethash
key
costs
)))
(
if
cost
(
let*
((
count
(
vop-stats-count
value
))
...
...
@@ -353,15 +453,14 @@ VOP classification.
res
))
;;; COM
BIN
E-STATS -- Internal
;;; COM
PAR
E-STATS -- Internal
;;;
;;; Take two tables of vop-stats and return a table of entries where the
;;; entries have been compared somehow. The counts are normalized to Compared.
;;; The costs are the difference of the costs adjusted by the difference in
;;; counts: the cost for Original is modified to correspond to the count in
;;; Compared.
;;; entries have been compared. The counts are normalized to Compared. The
;;; costs are the difference of the costs adjusted by the difference in counts:
;;; the cost for Original is modified to correspond to the count in Compared.
;;;
(
defun
com
bin
e-stats
(
original
compared
)
(
defun
com
par
e-stats
(
original
compared
)
(
declare
(
type
hash-table
original
compared
))
(
let
((
res
(
make-hash-table-like
original
)))
(
do-hash
(
k
cv
compared
)
...
...
@@ -377,6 +476,23 @@ VOP classification.
res
))
;;; COMBINE-STATS -- Public
;;;
(
defun
combine-stats
(
&rest
tables
)
"Sum the VOP stats for the specified tables, returning a new table with the
combined results."
(
let
((
res
(
make-hash-table-like
(
first
tables
))))
(
dolist
(
table
tables
)
(
do-hash
(
k
v
table
)
(
let
((
found
(
or
(
gethash
k
res
)
(
setf
(
gethash
k
res
)
(
%make-vop-stats
k
)))))
(
incf
(
vop-stats-count
found
)
(
vop-stats-count
v
))
(
incf
(
vop-stats-cost
found
)
(
vop-stats-cost
v
)))))
res
))
;;;; Report generation:
;;; SORT-RESULT -- Internal
;;;
(
defun
sort-result
(
table
by
)
...
...
@@ -387,36 +503,177 @@ VOP classification.
(
:cost
(
vop-stats-cost
x
)))))))
;;; ENTRY-REPORT -- Internal
;;;
;;; Report about VOPs in the list of stats structures.
;;;
(
defun
entry-report
(
entries
cut-off
compensated
compare
total-cost
)
(
let
((
counter
(
if
(
and
cut-off
(
>
(
length
entries
)
cut-off
))
cut-off
most-positive-fixnum
)))
(
dolist
(
entry
entries
)
(
let*
((
cost
(
vop-stats-cost
entry
))
(
name
(
vop-stats-name
entry
))
(
entry-count
(
vop-stats-count
entry
))
(
comp-entry
(
if
compare
(
gethash
name
compare
)
entry
))
(
count
(
vop-stats-count
comp-entry
)))
(
format
t
"~30<~A~>: ~:[~13:D~;~13,2F~] ~9,2F ~5,2,2F%~%"
(
vop-stats-name
entry
)
compare
(
if
compare
entry-count
(
round
entry-count
))
(
/
cost
count
)
(
/
(
if
compare
(
-
(
vop-stats-cost
(
gethash
name
compensated
))
(
vop-stats-cost
comp-entry
))
cost
)
total-cost
))
(
when
(
zerop
(
decf
counter
))
(
format
t
"[End of top ~D]~%"
cut-off
))))))
;;; FIND-CUT-OFF -- Internal
;;;
;;; Divide Sorted into two lists, the first cut-off elements long. Any VOP
;;; names that match one of the report strings are moved into the report list
;;; even if they would otherwise fall below the cut-off.
;;;
(
defun
find-cut-off
(
sorted
cut-off
report
)
(
if
(
or
(
not
cut-off
)
(
<=
(
length
sorted
)
cut-off
))
(
values
sorted
())
(
let
((
not-cut
(
subseq
sorted
0
cut-off
)))
(
collect
((
select
)
(
reject
))
(
dolist
(
el
(
nthcdr
cut-off
sorted
))
(
let
((
name
(
vop-stats-name
el
)))
(
if
(
matches-pattern
name
report
)
(
select
el
)
(
reject
el
))))
(
values
(
append
not-cut
(
select
))
(
reject
))))))
;;; CUT-OFF-REPORT -- Internal
;;;
;;; Display information about entries that were not displayed due to the
;;; cut-off. Note: if compare, we find the total cost delta and the geometric
;; mean of the normalized counts.
;;
(
defun
cut-off-report
(
other
compare
total-cost
)
(
let
((
rest-cost
0d0
)
(
rest-count
0d0
)
(
rest-entry-count
(
if
compare
1d0
0d0
)))
(
dolist
(
entry
other
)
(
incf
rest-cost
(
vop-stats-cost
entry
))
(
incf
rest-count
(
vop-stats-count
(
if
compare
(
gethash
(
vop-stats-name
entry
)
compare
)
entry
)))
(
if
compare
(
setq
rest-entry-count
(
*
rest-entry-count
(
vop-stats-count
entry
)))
(
incf
rest-entry-count
(
vop-stats-count
entry
))))
(
let
((
count
(
if
compare
(
expt
rest-entry-count
(
/
(
coerce
(
length
other
)
'double-float
)))
(
round
rest-entry-count
))))
(
format
t
"~30<Other~>: ~:[~13:D~;~13,2F~] ~9,2F ~@[~5,2,2F%~]~%"
compare
count
(
/
rest-cost
rest-count
)
(
unless
compare
(
/
rest-cost
total-cost
))))))
;;; COMPARE-REPORT -- Internal
;;;
;;; Report summary information about the difference between the comparison
;;; and base data sets.
;;;
(
defun
compare-report
(
total-count
total-cost
compare-total-count
compare-total-cost
compensated
compare
)
(
format
t
"~30<Relative total~>: ~13,2F ~9,2F~%"
(
/
total-count
compare-total-count
)
(
/
total-cost
compare-total-cost
))
(
flet
((
frob
(
a
b
sign
wot
)
(
multiple-value-bind
(
cost
count
)
(
cost-summary
(
hash-difference
a
b
))
(
unless
(
zerop
count
)
(
format
t
"~30<~A~>: ~13:D ~9,2F ~5,2,2F%~%"
wot
(
*
sign
(
round
count
))
(
*
sign
(
/
cost
count
))
(
*
sign
(
/
cost
compare-total-cost
)))))))
(
frob
compensated
compare
1
"Not in comparison"
)
(
frob
compare
compensated
-1
"Only in comparison"
))
(
format
t
"~30<Comparison total~>: ~13,2E ~9,2E~%"
compare-total-count
compare-total-cost
))
;;; The fraction of system time that we guess happened during GC.
;;;
(
defparameter
*gc-system-fraction*
2/3
)
;;; FIND-CPI -- Interface
;;;
;;; Estimate CPI from CPU time and cycles accounted in profiling
;;; information.
;;;
(
defun
find-cpi
(
total-cost
user
system
gc
clock
)
(
let
((
adj-time
(
if
(
zerop
gc
)
user
(
-
user
(
-
gc
(
*
system
*gc-system-fraction*
))))))
(
/
(
*
adj-time
clock
)
total-cost
)))
;;; GENERATE-REPORT -- Public
;;;
;;; Generate a report from the specified table.
;;;
(
defun
generate-report
(
table
&key
(
cut-off
15
)
(
sort-by
:cost
)
(
costs
*native-costs*
)
compare
)
(
let*
((
compensated
(
if
costs
(
compensate-costs
table
costs
)
table
))
(
costs
*native-costs*
)
((
:compare
uncomp-compare
))
(
compare-costs
costs
)
ignore
report
(
classes
*basic-classes*
)
user
(
system
0d0
)
(
gc
0d0
)
(
clock
25d6
))
(
let*
((
compensated
(
classify-costs
(
if
costs
(
compensate-costs
table
costs
ignore
)
table
)
classes
))
(
compare
(
when
uncomp-compare
(
classify-costs
(
if
compare-costs
(
compensate-costs
uncomp-compare
compare-costs
ignore
)
uncomp-compare
)
classes
)))
(
compared
(
if
compare
(
com
bin
e-stats
compensated
compare
)
(
com
par
e-stats
compensated
compare
)
compensated
))
(
*gc-verbose*
nil
))
(
multiple-value-bind
(
total-count
total-cost
)
(
cost-summary
(
or
compare
compensated
))
(
format
t
"~30<Vop~> ~13<Count~> ~6<Cost~> ~6:@<Percent~>~%"
)
(
dolist
(
entry
(
sort-result
compared
sort-by
))
(
when
(
and
cut-off
(
minusp
(
decf
cut-off
)))
(
return
))
(
let*
((
cost
(
vop-stats-cost
entry
))
(
name
(
vop-stats-name
entry
))
(
entry-count
(
vop-stats-count
entry
))
(
comp-entry
(
if
compare
(
gethash
name
compare
)
entry
))
(
count
(
vop-stats-count
comp-entry
)))
(
format
t
"~30<~A~>: ~:[~13:D~;~13,2F~] ~6,1F ~4,1,2F%~%"
(
vop-stats-name
entry
)
compare
(
if
compare
entry-count
(
round
entry-count
))
(
/
cost
count
)
(
/
cost
total-cost
))))
(
format
t
"~%Total count ~,3E, total cost ~,3E.~%"
total-count
total-cost
)))
(
cost-summary
compensated
)
(
multiple-value-bind
(
compare-total-count
compare-total-cost
)
(
when
compare
(
cost-summary
compare
))
(
format
t
"~2&~30<Vop~> ~13<Count~> ~9<Cost~> ~6:@<Percent~>~%"
)
(
let
((
sorted
(
sort-result
compared
sort-by
))
(
base-total
(
if
compare
compare-total-cost
total-cost
)))
(
multiple-value-bind
(
report
other
)
(
find-cut-off
sorted
cut-off
report
)
(
entry-report
report
cut-off
compensated
compare
base-total
)
(
when
other
(
cut-off-report
other
compare
base-total
))))
(
when
compare
(
compare-report
total-count
total-cost
compare-total-count
compare-total-cost
compensated
compare
))
(
format
t
"~30<Total~>: ~13,2E ~9,2E~%"
total-count
total-cost
)
(
when
user
(
format
t
"~%Cycles per instruction = ~,2F~%"
(
find-cpi
total-cost
user
system
gc
clock
))))))
(
values
))
...
...
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