version 1.1, 2004/09/03 14:04:47
|
version 1.4, 2004/09/06 18:15:05
|
Line 45 true constant count-calls? \ do some pro
|
Line 45 true constant count-calls? \ do some pro
|
\ how many static calls are there to a word? How many of the dynamic |
\ how many static calls are there to a word? How many of the dynamic |
\ calls call just a single word? |
\ calls call just a single word? |
|
|
|
\ how much does inlining called-once words help? |
|
\ how much does inlining words without control flow help? |
|
\ how much does partial inlining help? |
|
\ what's the overlap? |
|
\ optimizing return-to-returns (tail calls), return-to-calls, call-to-calls |
|
|
struct |
struct |
cell% field profile-next |
cell% field list-next |
|
end-struct 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] |
count-calls? [if] |
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 |
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] |
[endif] |
end-struct profile% \ profile point |
end-struct profile% \ profile point |
|
|
|
list% |
|
cell% field calls-call \ ptr to profile point of bb containing the call |
|
end-struct calls% |
|
|
variable profile-points \ linked list of profile% |
variable profile-points \ linked list of profile% |
0 profile-points ! |
0 profile-points ! |
variable next-profile-point-p \ the address where the next pp will be stored |
variable next-profile-point-p \ the address where the next pp will be stored |
profile-points next-profile-point-p ! |
profile-points next-profile-point-p ! |
count-calls? [if] |
variable last-colondef-profile \ pointer to the pp of last colon definition |
variable last-colondef-profile \ pointer to the pp of last colon definition |
variable current-profile-point |
[endif] |
variable library-calls \ list of calls to library colon defs |
|
variable in-compile,? in-compile,? off |
|
|
|
\ list stuff |
|
|
|
: map-list ( ... list xt -- ... ) |
|
{ xt } begin { list } |
|
list while |
|
list xt execute |
|
list list-next @ |
|
repeat ; |
|
|
|
: drop-1+ drop 1+ ; |
|
|
|
: list-length ( list -- u ) |
|
0 swap ['] drop-1+ map-list ; |
|
|
|
: insert-list ( listp listpp -- ) |
|
\ insert list node listp into list pointed to by listpp in front |
|
tuck @ over list-next ! |
|
swap ! ; |
|
|
|
: insert-list-end ( listp listppp -- ) |
|
\ insert list node listp into list, with listppp indicating the |
|
\ position to insert at, and indicating the position behind the |
|
\ new element afterwards. |
|
2dup @ insert-list |
|
swap list-next swap ! ; |
|
|
|
\ calls |
|
|
|
: new-call ( profile-point -- call ) |
|
calls% %alloc tuck calls-call ! ; |
|
|
|
\ profile-point stuff |
|
|
: new-profile-point ( -- addr ) |
: new-profile-point ( -- addr ) |
profile% %alloc >r |
profile% %alloc >r |
0. r@ profile-count 2! |
0. r@ profile-count 2! |
Line 77 count-calls? [if]
|
Line 124 count-calls? [if]
|
r@ profile-straight-line on |
r@ profile-straight-line on |
0 r@ profile-calls-from ! |
0 r@ profile-calls-from ! |
[endif] |
[endif] |
0 r@ profile-next ! |
r@ next-profile-point-p insert-list-end |
r@ next-profile-point-p @ ! |
r@ current-profile-point ! |
r@ profile-next next-profile-point-p ! |
|
r> ; |
r> ; |
|
|
: print-profile ( -- ) |
: print-profile ( -- ) |
Line 89 count-calls? [if]
|
Line 135 count-calls? [if]
|
r@ profile-sourcepos 2@ .sourcepos ." :" |
r@ profile-sourcepos 2@ .sourcepos ." :" |
r@ profile-char @ 0 .r ." : " |
r@ profile-char @ 0 .r ." : " |
r@ profile-count 2@ 0 d.r cr |
r@ profile-count 2@ 0 d.r cr |
r> profile-next @ |
r> list-next @ |
repeat |
repeat |
drop ; |
drop ; |
|
|
Line 102 count-calls? [if]
|
Line 148 count-calls? [if]
|
r@ profile-char @ 3 .r ." : " |
r@ profile-char @ 3 .r ." : " |
r@ profile-count 2@ 10 d.r |
r@ profile-count 2@ 10 d.r |
r@ profile-straight-line @ space 2 .r |
r@ profile-straight-line @ space 2 .r |
r@ profile-calls @ 4 .r |
r@ profile-calls @ list-length 4 .r |
cr |
cr |
endif |
endif |
r> profile-next @ |
r> list-next @ |
repeat |
repeat |
drop ; |
drop ; |
|
|
|
: 1= ( u -- f ) |
|
1 = ; |
|
|
|
: 2= ( u -- f ) |
|
2 = ; |
|
|
|
: 3= ( u -- f ) |
|
3 = ; |
|
|
|
: 1u> ( u -- f ) |
|
1 u> ; |
|
|
|
: call-count+ ( ud1 callp -- ud2 ) |
|
calls-call @ profile-count 2@ d+ ; |
|
|
|
: add-calls ( ud-dyn-callee1 ud-dyn-caller1 u-stat1 xt-test profpp -- |
|
ud-dyn-callee2 ud-dyn-caller2 u-stat2 xt-test ) |
|
\ add the static and dynamic call counts to profpp up, if the |
|
\ number of static calls to profpp satisfies xt-test ( u -- f ) |
|
{ xt-test p } |
|
p profile-colondef? @ if ( u-dyn1 u-stat1 ) |
|
p profile-calls @ { calls } |
|
calls list-length { stat } |
|
stat xt-test execute if ( u-dyn u-stat ) |
|
stat + >r |
|
0. calls ['] call-count+ map-list d+ 2>r |
|
p profile-count 2@ d+ |
|
2r> r> |
|
endif |
|
endif |
|
xt-test ; |
|
|
|
: print-stat-line ( xt -- ) |
|
>r 0. 0. 0 r> profile-points @ ['] add-calls map-list drop |
|
( ud-dyn-callee ud-dyn-caller u-stat ) |
|
7 u.r 12 ud.r 12 ud.r space ; |
|
|
|
: print-statistics ( -- ) |
|
." static dyn-caller dyn-callee condition" cr |
|
['] 0= print-stat-line ." calls to coldefs with 0 callers" cr |
|
['] 1= print-stat-line ." calls to coldefs with 1 callers" cr |
|
['] 2= print-stat-line ." calls to coldefs with 2 callers" cr |
|
['] 3= print-stat-line ." calls to coldefs with 3 callers" cr |
|
['] 1u> print-stat-line ." calls to coldefs with >1 callers" cr |
|
; |
|
|
: dinc ( profilep -- ) |
: dinc ( profilep -- ) |
\ increment double pointed to by d-addr |
\ increment double pointed to by d-addr |
profile-count dup 2@ 1. d+ rot 2! ; |
profile-count dup 2@ 1. d+ rot 2! ; |
|
|
: profile-this ( -- ) |
: profile-this ( -- ) |
new-profile-point POSTPONE literal POSTPONE dinc ; |
in-compile,? @ in-compile,? on |
|
new-profile-point POSTPONE literal POSTPONE dinc |
|
in-compile,? ! ; |
|
|
\ Various words trigger PROFILE-THIS. In order to avoid getting |
\ Various words trigger PROFILE-THIS. In order to avoid getting |
\ several calls to PROFILE-THIS from a compiling word (like ?EXIT), we |
\ several calls to PROFILE-THIS from a compiling word (like ?EXIT), we |
Line 141 count-calls? [if]
|
Line 235 count-calls? [if]
|
\ 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 cock-profiler |
POSTPONE profile-this |
r@ @ compile, \ old hook behaviour |
r@ @ compile, \ old hook behaviour |
POSTPONE ; |
POSTPONE ; |
r> ! ; \ change hook behaviour |
r> ! ; \ change hook behaviour |
Line 177 Defer before-word-profile ( -- )
|
Line 271 Defer before-word-profile ( -- )
|
|
|
: note-call ( addr -- ) |
: note-call ( addr -- ) |
\ addr is the body address of a called colon def or does handler |
\ addr is the body address of a called colon def or does handler |
dup 3 cells + @ ['] dinc >body = if |
dup 3 cells + @ ['] dinc >body = if ( addr ) |
1 over cell+ @ profile-calls +! |
profile-this |
|
current-profile-point @ new-call over cell+ @ profile-calls insert-list |
endif |
endif |
drop ; |
drop ; |
|
|
: prof-compile, ( xt -- ) |
: prof-compile, ( xt -- ) |
|
in-compile,? @ if |
|
DEFERS compile, EXIT |
|
endif |
dup >does-code if |
dup >does-code if |
dup >does-code note-call |
dup >does-code note-call |
then |
then |
dup >code-address CASE |
dup >code-address CASE |
docol: OF dup >body note-call ENDOF |
docol: OF dup >body note-call ENDOF |
dodefer: OF note-execute ENDOF |
dodefer: OF note-execute ENDOF |
dofield: OF >body @ ['] lit+ peephole-compile, , EXIT ENDOF |
|
\ dofield: OF >body @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF |
\ dofield: OF >body @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF |
\ code words and ;code-defined words (code words could be optimized): |
\ code words and ;code-defined words (code words could be optimized): |
dup in-dictionary? IF drop POSTPONE literal ['] execute peephole-compile, EXIT THEN |
|
ENDCASE |
ENDCASE |
DEFERS compile, ; |
DEFERS compile, ; |
|
|
\ hook-profiling-into then-like |
|
\ \ hook-profiling-into if-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 begin-like |
|
\ hook-profiling-into again-like |
|
\ hook-profiling-into until-like |
|
|
|
: :-hook-profile ( -- ) |
: :-hook-profile ( -- ) |
defers :-hook |
defers :-hook |
next-profile-point-p @ |
next-profile-point-p @ |
Line 211 Defer before-word-profile ( -- )
|
Line 299 Defer before-word-profile ( -- )
|
@ dup last-colondef-profile ! |
@ dup last-colondef-profile ! |
profile-colondef? on ; |
profile-colondef? on ; |
|
|
|
\ hook-profiling-into then-like |
|
\ \ hook-profiling-into if-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 begin-like |
|
\ hook-profiling-into again-like |
|
\ hook-profiling-into until-like |
' :-hook-profile IS :-hook |
' :-hook-profile IS :-hook |
' prof-compile, IS compile, |
|
|
|
|
' prof-compile, IS compile, |