--- gforth/prof-inline.fs 2004/09/07 09:59:01 1.5 +++ gforth/prof-inline.fs 2004/09/13 07:32:37 1.7 @@ -56,16 +56,22 @@ struct end-struct list% list% - cell% 2* field profile-count + cell% 2* field profile-count \ how often this profile point is performed 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] -end-struct profile% \ profile point + cell% field profile-char \ character position in line + cell% field profile-bblen \ number of primitives in BB + cell% field profile-bblenpi \ bblen after partial inlining + cell% field profile-callee-postlude \ 0 or (for calls) callee postlude len + cell% field profile-tailof \ 0 or (for tail bbs) pointer to coldef 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 + cell% field profile-exits \ number of exits in this colon def + cell% 2* field profile-execs \ number of EXECUTEs etc. of this colon def + cell% field profile-prelude \ first BB-len of colon def (incl. callee) + cell% field profile-postlude \ last BB-len of colon def (incl. callee) +end-struct profile% \ profile point list% cell% field calls-call \ ptr to profile point of bb containing the call @@ -79,6 +85,7 @@ variable last-colondef-profile \ pointer variable current-profile-point 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 @@ -118,14 +125,24 @@ variable in-compile,? in-compile,? off 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] + 0 r@ profile-callee-postlude ! + 0 r@ profile-tailof ! + r@ profile-colondef? off + 0 r@ profile-bblen ! + -100000000 r@ profile-bblenpi ! + current-profile-point @ profile-bblenpi @ -100000000 = if + current-profile-point @ dup profile-bblen @ swap profile-bblenpi ! + endif + 0 r@ profile-calls ! + r@ profile-straight-line on + 0 r@ profile-calls-from ! + 0 r@ profile-exits ! + 0. r@ profile-execs 2! + 0 r@ profile-prelude ! + 0 r@ profile-postlude ! r@ next-profile-point-p insert-list-end r@ current-profile-point ! + r@ new-call all-bbs insert-list r> ; : print-profile ( -- ) @@ -202,6 +219,19 @@ variable in-compile,? in-compile,? off 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 ( -- ) ." callee exec'd static dyn-caller dyn-callee condition" cr ['] 0= print-stat-line ." calls to coldefs with 0 callers" cr @@ -210,6 +240,7 @@ variable in-compile,? in-compile,? off ['] 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 -- ) @@ -246,38 +277,40 @@ variable in-compile,? in-compile,? off \ better if we had a way of knowing whether we are in a colon def or \ not (and used that knowledge instead of STATE). -\ Defer before-word-profile ( -- ) -\ ' noop IS before-word-profile +Defer before-word-profile ( -- ) +' noop IS before-word-profile -\ : before-word1 ( -- ) -\ before-word-profile defers before-word ; +: before-word1 ( -- ) + before-word-profile defers before-word ; -\ ' before-word1 IS before-word +' before-word1 IS before-word -\ : profile-this-compiling ( -- ) -\ state @ if -\ profile-this -\ ['] noop IS before-word-profile -\ endif ; - -\ : cock-profiler ( -- ) -\ \ as in cock the gun - pull the trigger -\ ['] profile-this-compiling IS before-word-profile -\ [ count-calls? ] [if] \ we are at a non-colondef profile point -\ last-colondef-profile @ profile-straight-line off -\ [endif] -\ ; +: profile-this-compiling ( -- ) + state @ if + profile-this + ['] noop IS before-word-profile + endif ; + +: cock-profiler ( -- ) + \ as in cock the gun - pull the trigger + ['] profile-this-compiling IS before-word-profile + [ count-calls? ] [if] \ we are at a non-colondef profile point + last-colondef-profile @ profile-straight-line off + [endif] +; : hook-profiling-into ( "name" -- ) \ make (deferred word) "name" call cock-profiler, too ' >body >r :noname - POSTPONE profile-this + POSTPONE cock-profiler r@ @ compile, \ old hook behaviour POSTPONE ; r> ! ; \ change hook behaviour : note-execute ( -- ) - \ end of BB due to execute + \ end of BB due to execute, dodefer, perform + profile-this \ should actually happen after the word, but the + \ error is probably small ; : note-call ( addr -- ) @@ -285,26 +318,38 @@ variable in-compile,? in-compile,? off dup ['] (does>2) >body = if \ adjust does handler address 4 cells here 1 cells - +! endif - profile-this current-profile-point @ new-call - over 3 cells + @ ['] dinc >body = if ( addr call-prof-point ) + { addr } + current-profile-point @ { lastbb } + profile-this + current-profile-point @ { thisbb } + thisbb new-call { call-node } + over 3 cells + @ ['] dinc >body = if \ non-library call - swap cell+ @ profile-calls insert-list + !! update profile-bblenpi of last and current pp + addr cell+ @ { callee-pp } + callee-pp profile-postlude @ thisbb profile-callee-postlude ! + call-node callee-pp profile-calls insert-list else ( addr call-prof-point ) - library-calls insert-list drop + call-node library-calls insert-list endif ; : prof-compile, ( xt -- ) in-compile,? @ if DEFERS compile, EXIT endif - 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 @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF - \ code words and ;code-defined words (code words could be optimized): + 1 current-profile-point @ profile-bblen +! + dup CASE + ['] execute of note-execute endof + ['] perform of note-execute endof + 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 @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF + \ code words and ;code-defined words (code words could be optimized): + ENDCASE ENDCASE DEFERS compile, ; @@ -312,15 +357,36 @@ variable in-compile,? in-compile,? off defers :-hook next-profile-point-p @ profile-this - @ dup last-colondef-profile ! + @ dup last-colondef-profile ! ( current-profile-point ) + 1 over profile-bblenpi ! 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 +: exit-hook-profile ( -- ) + defers exit-hook + 1 last-colondef-profile @ profile-exits +! ; + +: ;-hook-profile ( -- ) + \ ;-hook is called before the POSTPONE EXIT + defers ;-hook + last-colondef-profile @ { col } + current-profile-point @ { bb } + col profile-bblen @ col profile-prelude +! + col profile-exits @ 0= if + col bb profile-tailof ! + bb profile-bblen @ bb profile-callee-postlude @ + + col profile-postlude ! + 1 bb profile-bblenpi ! + \ not counting the EXIT + endif ; + +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, +' exit-hook-profile IS exit-hook +' ;-hook-profile IS ;-hook