(* * LANGUAGE : ANS Forth * PROJECT : Forth Environments * DESCRIPTION : Inspired by Jon Bentley's ``More Programming Pearls'' * CATEGORY : Tools * AUTHOR : Marcel Hendrix * LAST CHANGE : Sunday, July 28, 2002 10:53 PM, Marcel Hendrix; two algorithms: column 1 = relative, 2 absolute * LAST CHANGE : Sunday, July 28, 2002 3:45 PM, Marcel Hendrix; accurate timing words * LAST CHANGE : May 26, 1997, Marcel Hendrix general butchering for publication * LAST CHANGE : September 8, 1995, Marcel Hendrix removed ARRAY * LAST CHANGE : September 8, 1993, Marcel Hendrix redefined : * LAST CHANGE : March 8, 1993, Marcel Hendrix *) NEEDS -miscutil NEEDS -quads REVISION -lprof "ÄÄÄ Forth Line Profiler Version 2.02 ÄÄÄ" PRIVATES DOC Line Profiler (* Profiling? ---------- Sometimes it is useful to know where a program is spending its runtime. Although schemes exist where : and ; get redefined to compile counters, there is no direct link to the source code with this solution. Editing in a special word in the source is very flexible -- it limits output to just the words and constructs you're interested in. However, sometimes the exact troublespot is unknown. Furthermore, some programmers hate it to have to modify the source code by hand after it is finished and debugged. The solution presented here is to have the profiler read in the source and write a modified version of it to a temporary file. The latter is then included. The modifications made allow one to list the original source with an execution count in the left margin. Regrettably the idea will not work on all ANS Forth systems. The main stumbling block will be the availability of the variable SOURCELINE#, counting the lines compiled. Implementation -------------- The source file is read in line by line. Each line is prepended by the string "^ " (The caret character plus a TAB). The word '^' is immediate and does nothing in execute mode. However, when compiling it compiles code to increment a counter in the array PROBES , at the position corresponding to the line where it executes (is: compiles). The modified lines are copied to the file !!!!!!!!.$$$ , which is subsequently included (in that way executing / compiling ^ for every line). With .PROFILE the file !!!!!!!!.$$$ is read in and displayed without the prepended "^ " string. Instead of this string the contents of the corresponding counter in PROBES are displayed. This is of course only meaningful when the words in this file have been executed at least once. *) ENDDOC DOC (* comp.lang.forth #28594 From: anton@mips.complang.tuwien.ac.at (Anton Ertl) Subject: Re: lprofiler Forth tool Date: Sat Jul 27 11:46:06 CEST 2002 Lines: 49 [..] > If you want the time to be attributed to only one location, instead of > the location and all its ancestors, the way to go is to end timing the > current location when you enter the next location. That's easy, > except that you need to find out the current location after EXITing a > definition (and after THROWing). As additional benefit, you can > arrange to turn off timing at the start of the bookkeeping, and turning > on timing the next location at the end, so you don't time most of the > bookkeeping work. Very good point. You mean: When a word starts using the timer it first stops and updates the accumulator of whoever is using the device now (global variable). It records a link to the previous user in its private datastructure and sets the global variable to its own ID. When the newer word stops it fetches the previous user from its datastructure and re-enables it using the counters (and the global variable). Wow, so simple that it's hard to believe that it wasn't available on the Amiga in 1986 :-) [..] *) ENDDOC ( The profiler tool ) 0 VALUE thisword PRIVATE \ compile : index of word being compiled; used by new ':' and ';'. 0 VALUE oldword PRIVATE \ exec : contains pointer to current owner of the tickcounter 0 VALUE #words PRIVATE 0 VALUE t-flag? PRIVATE 0 VALUE l-flag? PRIVATE 0. DVALUE totalticks PRIVATE #1000 =: /maxwords PRIVATE \ maximum number of colon definitions in source file #4000 =: /maxlines PRIVATE \ maximum number of lines in source file /maxwords 4 2* 4 + * CELLS ALLOCATE ?ALLOCATE =: 'timers PRIVATE /maxwords CELLS ALLOCATE ?ALLOCATE =: 'sortindex PRIVATE /maxlines CELLS ALLOCATE ?ALLOCATE =: 'probes PRIVATE DOC (* [d1][d2][d3][d4][#calls][link][line][nfa] d1 is the tick accumulator d2 is set to the ticker value at definition start d3 is the tick accumulator2 d4 is set to the ticker value2 at definition start ccnt is the call counter link points to the four fields of the word that was using the tick counter (we find this pointer in the global value "oldword") line is the line# in the file where this call is done nfa is the dea of the word owning these fields *) ENDDOC :INLINE tick-accu+ ; PRIVATE :INLINE tick-prev+ 2 CELLS + ; PRIVATE :INLINE tick-accu2+ 4 CELLS + ; PRIVATE :INLINE tick-prev2+ 6 CELLS + ; PRIVATE :INLINE #calls+ 8 CELLS + ; PRIVATE :INLINE previous^+ 9 CELLS + ; PRIVATE :INLINE line#+ #10 CELLS + ; PRIVATE :INLINE current-dea+ #11 CELLS + ; PRIVATE :INLINE []t 6 * 'timers []DOUBLE ; PRIVATE :INLINE .tick-accu S tick-accu+ ; PRIVATE :INLINE .tick-prev S tick-prev+ ; PRIVATE :INLINE .tick-accu2 S tick-accu2+ ; PRIVATE :INLINE .tick-prev2 S tick-prev2+ ; PRIVATE :INLINE .#calls S #calls+ ; PRIVATE :INLINE .previous^ S previous^+ ; PRIVATE :INLINE .line# S line#+ ; PRIVATE :INLINE .current-dea S current-dea+ ; PRIVATE :INLINE []t.dea []t current-dea+ ; PRIVATE :INLINE []t.accu []t tick-accu+ ; PRIVATE :INLINE []t.accu2 []t tick-accu2+ ; PRIVATE :INLINE []t.line# []t line#+ ; PRIVATE :INLINE []t.#calls []t #calls+ ; PRIVATE : tick[ ( dticks addr -- ) tick-prev+ 2! ;P : ]tick ( dticks addr -- ) >S .tick-prev 2@ D0<> IF .tick-prev 2@ D- .tick-accu 2+! ELSE 2DROP ENDIF .tick-prev D0! -S ;P : tick-on ( ix -- ) []t >S TICKS-GET oldword IF 2DUP oldword ]tick ( stop accu of current tick user ) oldword .previous^ ! ( update previous owner field ) ENDIF 2DUP .tick-prev 2! .tick-prev2 2! 1 .#calls +! S> TO oldword ;P \ update d1 unless d2 is 0, then set d2 to 0. The idea is that d1 d2 should be paired. : tick-off ( ix -- ) []t >S TICKS-GET .previous^ @ TO oldword ( set it as current again ) oldword IF 2DUP oldword tick[ ENDIF ( there IS an active word to restore ) .tick-prev 2@ D0<> IF 2DUP .tick-prev 2@ D- .tick-accu 2+! ENDIF .tick-prev2 2@ D0<> IF .tick-prev2 2@ D- .tick-accu2 2+! ELSE 2DROP ENDIF .tick-prev D0! .tick-prev2 D0! -S ;P : TIMEINIT ( -- ) /maxwords 0 ?DO I []t #10 CELLS ERASE LOOP ( keep line and dea ) CLEAR oldword TRUE TO t-flag? ;P : TIMEEXIT ( -- ) FALSE TO t-flag? ;P : ton, t-flag? 0= ?EXIT STATE @ 0= ?EXIT #words /maxwords U> ABORT" ton, :: array bounds exceeded" #words POSTPONE LITERAL POSTPONE tick-on S TO thisword SOURCELINE# 1- #words []t.line# ! ;P IMMEDIATE : toff, t-flag? 0= ?EXIT thisword 0= ?EXIT STATE @ 0= ?EXIT #words /maxwords U> ABORT" toff, :: array bounds exceeded" #words POSTPONE LITERAL POSTPONE tick-off thisword #words []t.dea ! 1 +TO #words CLEAR thisword ;P IMMEDIATE -- ======================================================================================================================== -- Toolkit: ud1/ud2 in percent. : d%16 ( ud1 ud2 -- c-addr u ) 2>R #1000 UT* DROP 2R> UD/ <# '%' HOLD # '.' HOLD #S #> ;P :INLINE K[] ( ix -- addr ) 'sortindex []CELL ; PRIVATE : .HEADER ." ____________ NAME ______________.__ #CALLED ___ EXCL __ TOTAL" ;P : .COMPACT ( index -- ) LOCAL index CR ." [" index []t.#calls @ DUP 0 .R ." call" ?s ." to " index []t.dea @ ID$ TYPE DROP ." , exclusive/total = " index []t.accu 2@ totalticks d%16 TYPE ." , cumulative/total = " index []t.accu2 2@ totalticks d%16 TYPE ." ]" ;P : .VERBOSE ( index -- ) LOCAL index index []t.dea @ ID$ TYPE DROP #32 HTAB index []t.#calls @ #11 .R index []t.accu 2@ totalticks d%16 9 OVER - SPACES TYPE index []t.accu2 2@ totalticks d%16 9 OVER - SPACES TYPE ;P : .DISPLAY ( #rows -- ) #words UMIN 0 ?DO CR I K[] @ .VERBOSE LOOP ;P : ?.COMPACT-INFO ( line# -- ) -1 LOCALS| found? l# | #words 0 ?DO I []t.line# @ l# = IF I TO found? LEAVE ENDIF LOOP found? -1 = ?EXIT found? .COMPACT ;P : Exchange ( ix1 ix2 -- ) \ swap referencers to data elements at indices >R >S S K[] @ R@ K[] @ S> K[] ! R> K[] ! ;P DEFER Precedes ( ix1 ix2 -- bool ) PRIVATE : GREATER.col0 ( ix1 ix2 -- bool ) \ compare keys >R K[] @ []t.#calls @ R> K[] @ []t.#calls @ > ;P : GREATER.col1 ( ix1 ix2 -- bool ) \ compare keys >R K[] @ []t.accu 2@ R> K[] @ []t.accu 2@ D> ;P : GREATER.col2 ( ix1 ix2 -- bool ) \ compare keys >R K[] @ []t.accu2 2@ R> K[] @ []t.accu2 2@ D> ;P ' GREATER.col0 IS Precedes : BUBBLE ( size -- ) LOCAL #w BEGIN TRUE >S #w 1- 0 DO I 1+ I Precedes IF I 1+ I Exchange -S FALSE >S ENDIF LOOP S> UNTIL ;P : (SCOL) ( column# #rows -- ) SWAP CASE 2 MIN 0 MAX 0 OF ['] GREATER.col0 ENDOF 1 OF ['] GREATER.col1 ENDOF 2 OF ['] GREATER.col2 ENDOF ['] GREATER.col0 SWAP ENDCASE IS Precedes #words 0 ?DO I I K[] ! LOOP #words BUBBLE ( #rows -- ) .DISPLAY ;P : SCOL ( column# #rows -- ) CR CR .HEADER (SCOL) ; -- ======================================================================================================================== : probes@ ( ix -- n ) CELLS 'probes + @ ;P : probes+! ( n ix -- ) CELLS 'probes + +! ;P : PROINIT ( -- ) TIMEINIT 'probes /maxlines CELLS ERASE TRUE TO l-flag? ;P : PROINIT+ ( -- ) CLEAR #words PROINIT ; : PROEXIT ( -- ) FALSE TO l-flag? TIMEEXIT ;P : LPROF PROINIT TICKS-GET 2>R ' EXECUTE TICKS-GET 2R> D- TO totalticks PROEXIT ; :NONAME ( pfa -- ) DROP 'probes FREE DROP 'sortindex FREE DROP 'timers FREE DROP ; IS-FORGET LPROF \ User marker: probe this line if compiling, else do nothing. \ Note that ':' must be redefined too, but let's delay that ... : ^ l-flag? 0= ?EXIT STATE @ 0= ?EXIT 1 POSTPONE LITERAL SOURCELINE# 1- DUP /maxlines U> ABORT" ^ :: array bounds exceeded" POSTPONE LITERAL POSTPONE probes+! ; IMMEDIATE -- The strings to type start with "^ ", which we'll throw away. : TTYPE 2 /STRING 0 LOCAL pos \ --- <> 0 ?DO C@+ DUP ^I = IF DROP 8 pos 8 MOD - DUP SPACES ELSE EMIT 1 ENDIF +TO pos pos C/L #13 - U> ?LEAVE LOOP DROP ;P CREATE "^"buf PRIVATE BL C, '^' C, ^I C, #256 ALLOT : EDIT-FILE LOCALS| hof hif | \ --- <> BEGIN "^"buf 3 + #256 hif READ-LINE ?FILE WHILE "^"buf SWAP 3 + hof WRITE-LINE ?FILE REPEAT DROP ;P \ Instead of INCLUDE name , IN name , S" name" INCLUDED etcetera : PROFILE /PARSE R/O OPEN-FILE \ ## --- <> ?FILE LOCAL handle-if S" !!!!!!!!.$$$" W/O CREATE-FILE ?FILE LOCAL handle-of handle-if handle-of ['] EDIT-FILE CATCH IF 2DROP ." oeps!" ENDIF handle-of CLOSE-FILE ?FILE handle-if CLOSE-FILE ?FILE PROINIT+ S" !!!!!!!!.$$$" INCLUDED PROEXIT ; : (.PROFILE) 0 LOCALS| line# handle | \ --- <> BEGIN PAD #256 handle READ-LINE ?FILE WAIT? 0= AND WHILE line# ?.COMPACT-INFO CR line# probes@ DUP 0> IF 8 .R ." * " ELSE 8 SPACES ." | " DROP ENDIF PAD SWAP TTYPE 1 +TO line# REPEAT DROP ;P : .PROFILE S" !!!!!!!!.$$$" R/O \ ## --- <> OPEN-FILE ?FILE DUP LOCAL handle 0 0 (SCOL) ['] (.PROFILE) CATCH IF DROP ." oeps!" ENDIF handle CLOSE-FILE ?FILE ; : EXIT #words thisword 2>R POSTPONE toff, 2R> TO thisword TO #words POSTPONE EXIT ; IMMEDIATE : ; POSTPONE toff, POSTPONE ; ; IMMEDIATE ( note t-flag?/l-flag? OFF ) : : : POSTPONE ^ POSTPONE ton, ; IMMEDIATE :ABOUT CR ." A file to be profiled must be loaded with PROFILE name" CR ." Execute LPROF , then type .PROFILE for a listing." CR ." Instead of .PROFILE, try ( column# #rows -- ) SCOL, e.g. 0 10 SCOL" CR ." To use only timers do PROINIT+, load the file, execute the main word." ; .ABOUT -lprof CR DEPRIVE (* End of Source *)