--- gforth/prof-inline.fs 2004/09/06 13:44:56 1.3 +++ gforth/prof-inline.fs 2004/09/07 18:14:46 1.6 @@ -58,13 +58,12 @@ end-struct list% list% cell% 2* field profile-count cell% 2* field profile-sourcepos - cell% field profile-char \ character position in line - count-calls? [if] - cell% field profile-colondef? \ is this a colon definition start - 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-calls-from \ static calls in the colon def - [endif] + cell% field profile-char \ character position in line + cell% field profile-bblen \ number of primitives in BB + cell% field profile-colondef? \ is this a colon definition start + 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-calls-from \ static calls in the colon def end-struct profile% \ profile point list% @@ -77,7 +76,9 @@ variable next-profile-point-p \ the addr profile-points next-profile-point-p ! variable last-colondef-profile \ pointer to the pp of last colon definition variable current-profile-point -variable 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 all-bbs 0 all-bbs ! \ list of all basic blocks \ list stuff @@ -117,14 +118,14 @@ variable library-calls \ list of calls t 0. r@ profile-count 2! current-sourcepos r@ profile-sourcepos 2! >in @ r@ profile-char ! - [ count-calls? ] [if] - r@ profile-colondef? off - 0 r@ profile-calls ! - r@ profile-straight-line on - 0 r@ profile-calls-from ! - [endif] + r@ profile-colondef? off + 0 r@ profile-bblen ! + 0 r@ profile-calls ! + r@ profile-straight-line on + 0 r@ profile-calls-from ! r@ next-profile-point-p insert-list-end r@ current-profile-point ! + r@ new-call all-bbs insert-list r> ; : print-profile ( -- ) @@ -169,35 +170,60 @@ variable library-calls \ list of calls t : 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 ) +: count-dyncalls ( calls -- ud ) + 0. rot ['] call-count+ map-list ; + +: add-calls ( statistics1 xt-test profpp -- statistics2 xt-test ) + \ add statistics for callee profpp up, if the number of static + \ calls to profpp satisfies xt-test ( u -- f ); see below for what + \ statistics are computed. { xt-test p } - p profile-colondef? @ if ( u-dyn1 u-stat1 ) + p profile-colondef? @ if 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> + stat xt-test execute if + { d: ud-dyn-callee d: ud-dyn-caller u-stat u-exec-callees u-callees } + ud-dyn-callee p profile-count 2@ 2dup { d: de } d+ + ud-dyn-caller calls count-dyncalls 2dup { d: dr } d+ + u-stat stat + + u-exec-callees de dr d<> - + u-callees 1+ endif endif xt-test ; : print-stat-line ( xt -- ) - >r 0. 0. 0 r> profile-points @ ['] add-calls map-list drop + >r 0. 0. 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 ; + 6 u.r 7 u.r 7 u.r 12 ud.r 12 ud.r space ; + +: print-library-stats ( -- ) + library-calls @ list-length 20 u.r \ static callers + library-calls @ count-dyncalls 12 ud.r \ dynamic callers + 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 ( -- ) - ." 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 ['] 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 + print-library-stats ." library calls" cr + print-bb-statistics ; : dinc ( profilep -- ) @@ -205,7 +231,9 @@ variable library-calls \ list of calls t profile-count dup 2@ 1. d+ rot 2! ; : 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 \ several calls to PROFILE-THIS from a compiling word (like ?EXIT), we @@ -268,33 +296,33 @@ Defer before-word-profile ( -- ) : note-call ( addr -- ) \ addr is the body address of a called colon def or does handler - dup 3 cells + @ ['] dinc >body = if ( addr ) - current-profile-point @ new-call over cell+ @ profile-calls insert-list + dup ['] (does>2) >body = if \ adjust does handler address + 4 cells here 1 cells - +! endif - drop ; - + profile-this current-profile-point @ new-call + over 3 cells + @ ['] dinc >body = if ( addr call-prof-point ) + \ non-library call + swap cell+ @ profile-calls insert-list + else ( addr call-prof-point ) + library-calls insert-list drop + endif ; + : prof-compile, ( xt -- ) + in-compile,? @ if + DEFERS compile, EXIT + endif + 1 current-profile-point @ profile-bblen +! dup >does-code if dup >does-code note-call then dup >code-address CASE docol: OF dup >body note-call ENDOF dodefer: OF note-execute ENDOF - dofield: OF >body @ ['] lit+ peephole-compile, , EXIT ENDOF \ dofield: OF >body @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF \ code words and ;code-defined words (code words could be optimized): - dup in-dictionary? IF drop POSTPONE literal ['] execute peephole-compile, EXIT THEN ENDCASE 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 ( -- ) defers :-hook next-profile-point-p @ @@ -302,5 +330,12 @@ Defer before-word-profile ( -- ) @ dup last-colondef-profile ! 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 -' prof-compile, IS compile, \ No newline at end of file +' prof-compile, IS compile,