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
9fdadb9c
Commit
9fdadb9c
authored
22 years ago
by
toy
Browse files
Options
Downloads
Patches
Plain Diff
Make the profile report print everything in neat, uniform columns even
when the individual entries vary greatly in length.
parent
572bae88
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/profile.lisp
+76
-16
76 additions, 16 deletions
code/profile.lisp
with
76 additions
and
16 deletions
code/profile.lisp
+
76
−
16
View file @
9fdadb9c
...
@@ -5,7 +5,7 @@
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.2
1
2002/
05/01 17:43:3
7 toy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/profile.lisp,v 1.2
2
2002/
10/30 18:05:4
7 toy Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -474,11 +474,53 @@ this, the functions are listed. If NIL, then always list the functions.")
...
@@ -474,11 +474,53 @@ this, the functions are listed. If NIL, then always list the functions.")
(
if
(
minusp
compensated
)
0.0
compensated
)))
(
if
(
minusp
compensated
)
0.0
compensated
)))
;; Compute and return the total time, total cons, total-calls, and the
;; width of the field needed to hold the total time, total cons,
;; total-calls, and the max time/call.
(
defun
compute-totals-and-widths
(
info
)
(
let
((
total-time
0
)
(
total-cons
0
)
(
total-calls
0
)
(
max-time/call
0
))
;; Find the total time, total consing, total calls, and the max
;; time/call
(
dolist
(
item
info
)
(
let
((
time
(
time-info-time
item
)))
(
incf
total-time
time
)
(
incf
total-cons
(
time-info-consing
item
))
(
incf
total-calls
(
time-info-calls
item
))
(
setf
max-time/call
(
max
max-time/call
(
/
time
(
float
(
time-info-calls
item
)))))))
;; Figure out the width needed for total-time, total-cons,
;; total-calls and the max-time/call. The total-cons is more
;; complicated because we print the consing with comma
;; separators. For total-time, we assume a default of "~10,3F";
;; for total-calls, "~7D"; for time/call, "~10,5F". This is where
;; the constants come from.
(
flet
((
safe-log10
(
x
)
;; log base 10 of x, but any non-positive value of x, 0
;; is ok for what we want.
(
if
(
zerop
x
)
0.0
(
log
x
10
))))
(
let
((
cons-length
(
ceiling
(
safe-log10
total-cons
))))
(
incf
cons-length
(
floor
(
safe-log10
total-cons
)
3
))
(
values
total-time
total-cons
total-calls
(
+
3
(
max
7
(
ceiling
(
safe-log10
total-time
))))
(
max
9
cons-length
)
(
max
7
(
ceiling
(
safe-log10
total-calls
)))
(
+
5
(
max
5
(
ceiling
(
safe-log10
max-time/call
)))))))))
(
defun
%report-times
(
names
)
(
defun
%report-times
(
names
)
(
declare
(
optimize
(
speed
0
)))
(
declare
(
optimize
(
speed
0
)))
(
unless
(
boundp
'*call-overhead*
)
(
unless
(
boundp
'*call-overhead*
)
(
compute-time-overhead
))
(
compute-time-overhead
))
(
let
((
info
()))
(
let
((
info
())
(
ext:*gc-verbose*
nil
)
separator
)
(
setf
*no-calls*
nil
)
(
setf
*no-calls*
nil
)
(
dolist
(
name
names
)
(
dolist
(
name
names
)
(
let
((
pinfo
(
profile-info-or-lose
name
)))
(
let
((
pinfo
(
profile-info-or-lose
name
)))
...
@@ -488,7 +530,7 @@ this, the functions are listed. If NIL, then always list the functions.")
...
@@ -488,7 +530,7 @@ this, the functions are listed. If NIL, then always list the functions.")
PROFILE it again to record calls to the new definition."
PROFILE it again to record calls to the new definition."
name
))
name
))
(
multiple-value-bind
(
multiple-value-bind
(
calls
time
consing
profile
callers
)
(
calls
time
consing
profile
callers
)
(
funcall
(
profile-info-read-time
pinfo
))
(
funcall
(
profile-info-read-time
pinfo
))
(
if
(
zerop
calls
)
(
if
(
zerop
calls
)
(
push
name
*no-calls*
)
(
push
name
*no-calls*
)
...
@@ -501,22 +543,36 @@ this, the functions are listed. If NIL, then always list the functions.")
...
@@ -501,22 +543,36 @@ this, the functions are listed. If NIL, then always list the functions.")
(
setq
info
(
sort
info
#'
>=
:key
#'
time-info-time
))
(
setq
info
(
sort
info
#'
>=
:key
#'
time-info-time
))
(
format
*trace-output*
(
multiple-value-bind
(
total-time
total-consed
total-calls
"~& Seconds | Consed | Calls | Sec/Call | Name:~@
time-width
cons-width
calls-width
------------------------------------------------------~%"
)
time/call-width
)
(
compute-totals-and-widths
info
)
;; Create the separator string of the appropriate length. The
;; 11 is for the column spacing and the 10 is for a reasonable
;; length for the name of the function.
(
setf
separator
(
make-string
(
+
11
10
time-width
cons-width
calls-width
time/call-width
)
:initial-element
#\-
))
(
format
*trace-output*
"~&~V@A | ~V@A | ~V@A | ~V@A | Name:~@
~A~%"
time-width
"Seconds"
cons-width
"Consed"
calls-width
"Calls"
time/call-width
"Sec/Call"
separator
)
(
let
((
total-time
0.0
)
(
total-consed
0
)
(
total-calls
0
))
(
dolist
(
time
info
)
(
dolist
(
time
info
)
(
incf
total-time
(
time-info-time
time
))
(
incf
total-calls
(
time-info-calls
time
))
(
incf
total-consed
(
time-info-consing
time
))
(
format
*trace-output*
(
format
*trace-output*
"~10,3F | ~9:D | ~7:D | ~10,5F | ~S~%"
"~V,3F | ~V:D | ~V:D | ~V,5F | ~S~%"
time-width
(
time-info-time
time
)
(
time-info-time
time
)
cons-width
(
time-info-consing
time
)
(
time-info-consing
time
)
calls-width
(
time-info-calls
time
)
(
time-info-calls
time
)
time/call-width
(
/
(
time-info-time
time
)
(
float
(
time-info-calls
time
)))
(
/
(
time-info-time
time
)
(
float
(
time-info-calls
time
)))
(
time-info-name
time
))
(
time-info-name
time
))
(
let
((
callers
(
time-info-callers
time
)))
(
let
((
callers
(
time-info-callers
time
)))
...
@@ -527,9 +583,13 @@ this, the functions are listed. If NIL, then always list the functions.")
...
@@ -527,9 +583,13 @@ this, the functions are listed. If NIL, then always list the functions.")
(
terpri
*trace-output*
))
(
terpri
*trace-output*
))
(
terpri
*trace-output*
))))
(
terpri
*trace-output*
))))
(
format
*trace-output*
(
format
*trace-output*
"------------------------------------------------------~@
"~A~@
~10,3F | ~9:D | ~7:D | | Total~%"
~V,3F | ~V:D | ~V:D | ~VA | Total~%"
total-time
total-consed
total-calls
)
separator
time-width
total-time
cons-width
total-consed
calls-width
total-calls
time/call-width
" "
)
(
format
*trace-output*
(
format
*trace-output*
"~%Estimated total profiling overhead: ~4,2F seconds~%"
"~%Estimated total profiling overhead: ~4,2F seconds~%"
...
...
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