version 1.5, 2004/09/07 09:59:01
|
version 1.6, 2004/09/07 18:14:46
|
Line 58 end-struct list%
|
Line 58 end-struct list%
|
list% |
list% |
cell% 2* field profile-count |
cell% 2* field profile-count |
cell% 2* field profile-sourcepos |
cell% 2* field profile-sourcepos |
cell% field profile-char \ character position in line |
cell% field profile-char \ character position in line |
count-calls? [if] |
cell% field profile-bblen \ number of primitives in BB |
cell% field profile-colondef? \ is this a colon definition start |
cell% field profile-colondef? \ is this a colon definition start |
cell% field profile-calls \ static calls to the colon def (calls%) |
cell% field profile-calls \ static calls to the colon def (calls%) |
cell% field profile-straight-line \ may contain calls, but no other CF |
cell% field profile-straight-line \ may contain calls, but no other CF |
cell% field profile-calls-from \ static calls in the colon def |
cell% field profile-calls-from \ static calls in the colon def |
[endif] |
|
end-struct profile% \ profile point |
end-struct profile% \ profile point |
|
|
list% |
list% |
Line 79 variable last-colondef-profile \ pointer
|
Line 78 variable last-colondef-profile \ pointer
|
variable current-profile-point |
variable current-profile-point |
variable library-calls 0 library-calls ! \ list of calls to library colon defs |
variable library-calls 0 library-calls ! \ list of calls to library colon defs |
variable in-compile,? in-compile,? off |
variable in-compile,? in-compile,? off |
|
variable all-bbs 0 all-bbs ! \ list of all basic blocks |
|
|
\ list stuff |
\ list stuff |
|
|
Line 118 variable in-compile,? in-compile,? off
|
Line 118 variable in-compile,? in-compile,? off
|
0. r@ profile-count 2! |
0. r@ profile-count 2! |
current-sourcepos r@ profile-sourcepos 2! |
current-sourcepos r@ profile-sourcepos 2! |
>in @ r@ profile-char ! |
>in @ r@ profile-char ! |
[ count-calls? ] [if] |
r@ profile-colondef? off |
r@ profile-colondef? off |
0 r@ profile-bblen ! |
0 r@ profile-calls ! |
0 r@ profile-calls ! |
r@ profile-straight-line on |
r@ profile-straight-line on |
0 r@ profile-calls-from ! |
0 r@ profile-calls-from ! |
[endif] |
|
r@ next-profile-point-p insert-list-end |
r@ next-profile-point-p insert-list-end |
r@ current-profile-point ! |
r@ current-profile-point ! |
|
r@ new-call all-bbs insert-list |
r> ; |
r> ; |
|
|
: print-profile ( -- ) |
: print-profile ( -- ) |
Line 202 variable in-compile,? in-compile,? off
|
Line 202 variable in-compile,? in-compile,? off
|
library-calls @ count-dyncalls 12 ud.r \ dynamic callers |
library-calls @ count-dyncalls 12 ud.r \ dynamic callers |
13 spaces ; |
13 spaces ; |
|
|
|
: bblen+ ( u1 callp -- u2 ) |
|
calls-call @ profile-bblen @ + ; |
|
|
|
: dyn-bblen+ ( ud1 callp -- ud2 ) |
|
calls-call @ dup profile-count 2@ rot profile-bblen @ 1 m*/ d+ ; |
|
|
|
: print-bb-statistics ( -- ) |
|
." static dynamic" cr |
|
all-bbs @ list-length 6 u.r all-bbs @ count-dyncalls 12 ud.r ." basic blocks" cr |
|
0 all-bbs @ ['] bblen+ map-list 6 u.r |
|
0. all-bbs @ ['] dyn-bblen+ map-list 12 ud.r ." primitives" cr |
|
; |
|
|
: print-statistics ( -- ) |
: print-statistics ( -- ) |
." callee exec'd static dyn-caller dyn-callee condition" cr |
." callee exec'd static dyn-caller dyn-callee condition" cr |
['] 0= print-stat-line ." calls to coldefs with 0 callers" cr |
['] 0= print-stat-line ." calls to coldefs with 0 callers" cr |
Line 210 variable in-compile,? in-compile,? off
|
Line 223 variable in-compile,? in-compile,? off
|
['] 3= print-stat-line ." calls to coldefs with 3 callers" cr |
['] 3= print-stat-line ." calls to coldefs with 3 callers" cr |
['] 1u> print-stat-line ." calls to coldefs with >1 callers" cr |
['] 1u> print-stat-line ." calls to coldefs with >1 callers" cr |
print-library-stats ." library calls" cr |
print-library-stats ." library calls" cr |
|
print-bb-statistics |
; |
; |
|
|
: dinc ( profilep -- ) |
: dinc ( profilep -- ) |
Line 246 variable in-compile,? in-compile,? off
|
Line 260 variable in-compile,? in-compile,? off
|
\ better if we had a way of knowing whether we are in a colon def or |
\ better if we had a way of knowing whether we are in a colon def or |
\ not (and used that knowledge instead of STATE). |
\ not (and used that knowledge instead of STATE). |
|
|
\ Defer before-word-profile ( -- ) |
Defer before-word-profile ( -- ) |
\ ' noop IS before-word-profile |
' noop IS before-word-profile |
|
|
\ : before-word1 ( -- ) |
: before-word1 ( -- ) |
\ before-word-profile defers before-word ; |
before-word-profile defers before-word ; |
|
|
\ ' before-word1 IS before-word |
' before-word1 IS before-word |
|
|
\ : profile-this-compiling ( -- ) |
: profile-this-compiling ( -- ) |
\ state @ if |
state @ if |
\ profile-this |
profile-this |
\ ['] noop IS before-word-profile |
['] noop IS before-word-profile |
\ endif ; |
endif ; |
|
|
\ : cock-profiler ( -- ) |
: cock-profiler ( -- ) |
\ \ as in cock the gun - pull the trigger |
\ as in cock the gun - pull the trigger |
\ ['] profile-this-compiling IS before-word-profile |
['] profile-this-compiling IS before-word-profile |
\ [ count-calls? ] [if] \ we are at a non-colondef profile point |
[ count-calls? ] [if] \ we are at a non-colondef profile point |
\ last-colondef-profile @ profile-straight-line off |
last-colondef-profile @ profile-straight-line off |
\ [endif] |
[endif] |
\ ; |
; |
|
|
: hook-profiling-into ( "name" -- ) |
: hook-profiling-into ( "name" -- ) |
\ make (deferred word) "name" call cock-profiler, too |
\ make (deferred word) "name" call cock-profiler, too |
' >body >r :noname |
' >body >r :noname |
POSTPONE profile-this |
POSTPONE cock-profiler |
r@ @ compile, \ old hook behaviour |
r@ @ compile, \ old hook behaviour |
POSTPONE ; |
POSTPONE ; |
r> ! ; \ change hook behaviour |
r> ! ; \ change hook behaviour |
Line 297 variable in-compile,? in-compile,? off
|
Line 311 variable in-compile,? in-compile,? off
|
in-compile,? @ if |
in-compile,? @ if |
DEFERS compile, EXIT |
DEFERS compile, EXIT |
endif |
endif |
|
1 current-profile-point @ profile-bblen +! |
dup >does-code if |
dup >does-code if |
dup >does-code note-call |
dup >does-code note-call |
then |
then |
Line 315 variable in-compile,? in-compile,? off
|
Line 330 variable in-compile,? in-compile,? off
|
@ dup last-colondef-profile ! |
@ dup last-colondef-profile ! |
profile-colondef? on ; |
profile-colondef? on ; |
|
|
\ hook-profiling-into then-like |
hook-profiling-into then-like |
\ \ hook-profiling-into if-like \ subsumed by other-control-flow |
\ hook-profiling-into if-like \ subsumed by other-control-flow |
\ \ hook-profiling-into ahead-like \ subsumed by other-control-flow |
\ hook-profiling-into ahead-like \ subsumed by other-control-flow |
\ hook-profiling-into other-control-flow |
hook-profiling-into other-control-flow |
\ hook-profiling-into begin-like |
hook-profiling-into begin-like |
\ hook-profiling-into again-like |
hook-profiling-into again-like |
\ hook-profiling-into until-like |
hook-profiling-into until-like |
' :-hook-profile IS :-hook |
' :-hook-profile IS :-hook |
' prof-compile, IS compile, |
' prof-compile, IS compile, |