home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / forthmacs / !Forthmacs / extend / runtime < prev   
Encoding:
Text File  |  1994-05-03  |  5.2 KB  |  143 lines
  1. \ portable RUNTIMER  Version 1.02
  2. \ USE:  -- runtime-profiling of colon definitions.
  3. \ mini manual:
  4. \ 1) load the cpu specific runtimer file, this file should be loaded automatically.
  5. \       fload extend\??cpu??\runtimer.fth
  6. \       fload extend\runtime.fth
  7. \ 2) From now on all colon definitions have an internal time measuring code part which is
  8. \       executed by calling the word.
  9. \ 3) Glossary:
  10. \ new ( -- )
  11. \       clear all timing information
  12. \ .times ( -- )
  13. \       display timing information
  14. \ profile ( -- ) name
  15. \       the word name is executed and the timing takes place. name could be a "benchmark" or
  16. \       the timing critical part of your application.       
  17. \ see   is patched, it will give correct information and knows about the timer information data
  18. \       structure
  19. \
  20. \ 4) example
  21. \ : test1       dup dup dup ;
  22. \ : test2       drop drop drop ;
  23. \ : test3       swap swap swap ;
  24. \ : test4       test1 test3 test2 test1 test3 test2 ;
  25. \ : test5       10000 0 do test4 test4 loop ;
  26. \ profile test5 .times
  27.  
  28. \
  29. \ User words of runtimer Version 1.0
  30. \       new (-- )             set all calls and ticks to 0
  31. \       .times ( -- )         print runtimes
  32. \       profile  name ( -- )  make a runtime profile of word name)
  33. \ Lit.  [1] "Laufzeitmessung von Forthworten", Bernd Pennemann, VD2/87
  34. \       [2] Formacs User's Guide, Mitch Bradley 
  35. \
  36. \ After loading the runtimer every colon definition is linked by an extra
  37. \ link-list for easy finding of all words.
  38.  
  39. \ Structure of new colon definition:
  40. \       timer-link-list long
  41. \       standard forthmacs header
  42. \       apf parameter field address of word
  43. \        0 (time
  44. \        4 calls
  45. \        8 #time
  46. \       12 compiled code continues ......
  47.  
  48. only forth also hidden also definitions  decimal
  49.  
  50. ifdef   profile                 \ this file shouldn't be compiled twice
  51.         ??cr error-output .( don't load runtimer twice ! )  cr restore-output fexit
  52. ifend
  53.  
  54. ifndef  (time                   \ defined in cpu-specific file
  55.         ??cr error-output .( needs cpu-specific runtimer-file first!)
  56.         restore-output cr abort
  57. ifend
  58.  
  59.  
  60. variable timer-link             \ base of link-list bound to 0
  61.         here timer-link token!  0 ,
  62. variable used-time
  63. defer scan-action               \ ( anf -- )
  64.  
  65. : scan-all      \ ( -- ) scan-action is done with all timer-linked words
  66.         timer-link
  67.         begin @ dup @  exit? not and
  68.         while dup /n +  l>name   scan-action
  69.         repeat  drop ;
  70.  
  71. : ticker-data   \ ( anf -- adr-timer adr-data )
  72.       name> >body ta1+ dup ta1+ swap ;
  73. : new-data      \ ( anf -- ) Call-nr und Time-nr  = 0
  74.         ticker-data off off  used-time off ;
  75. : legal-data    \ ( anf -- )
  76.         ticker-data drop @ 2-  used-time @ >
  77.         if used-time off then ; 
  78. : .percent      \ ( n -- )
  79.         used-time @ dup 100000 >
  80.         if 100 / else swap 1005 * 10 / swap then /      ( n -- )
  81.         ?dup if 4 .r else ."  < 1" then ." %" ;
  82.  
  83. : .usec         \ ( usec -- )
  84.         dup 30000 >
  85.         if 499 +  1000 /  ascii m >r  dup 30000 >
  86.            if 499 +  1000 /  r> drop  bl >r  then
  87.         else  ascii u >r
  88.         then    ( n -- )
  89.         ?dup if 8 .r else ."        -" then  space r> emit  ." sec" ;   
  90. : .one-data     \ ( anf -- ) prints data of one word
  91.         dup ticker-data @  swap @ swap
  92.         dup 0=  ( anf #time calls flag ) 
  93.         if 2drop drop exit then
  94.         rot .id  20 to-column
  95.         2dup   8 .r ."  Calls"    usec/tick * .usec
  96.         2dup swap usec/tick * swap /  .usec ." /call"
  97.         drop  used-time @
  98.         if  .percent else drop then ??cr ;
  99.  
  100. \ support for the decompiler, this isn't portable at all!!
  101. ifdef see
  102.         : my->body       (s cfa -- )
  103.                 >body dup token@  ['] (time <> ?exit
  104.                 ['] legal-data is scan-action scan-all
  105.                 dup >name ticker-data @ swap @ or
  106.                 if      ." \ Runtimer info: " dup  >name .one-data indent
  107.                 then d# 12 + ;
  108.         ' .pfa >body dup token@ ' dup =   over ta1+ token@ ' scan-pfa @ and
  109.         iftrue        patch my->body >body .pfa
  110.         ifend
  111. ifend
  112.                 
  113. : (forget       true abort" forget is not allowed with runtimer loaded!" ;
  114. : (save-forth   true abort" save-forth is not allowed with runtimer loaded!" ; 
  115.         ' (forget ' forget >body token!
  116.         ' (save-forth ' save-forth >body token!
  117.  
  118. forth definitions
  119.  
  120. variable runtimer  runtimer off     \ on -> the runtimer code is compiled
  121. : new           \ ( -- ) set all ticks and calls to 0
  122.         ['] new-data is scan-action  scan-all ;
  123. : .times        \ ( -- ) prints data of all words
  124.         ??cr cr ." Runtime profiler V 1.02 (c) 1993 Hanno Schwalm"
  125.         cr #columns 0 do ascii _ emit loop cr cr
  126.         ['] legal-data is scan-action scan-all
  127.         ['] .one-data is scan-action
  128.         base @ >r decimal scan-all  r> base !
  129.         cr #columns 0 do ascii _ emit loop cr cr ;
  130.  
  131. : profile       \ name ( -- ) make runtime-profile of name
  132.         new '
  133.         ticker @ @ >r execute ticker @ @ r> -  used-time ! ;
  134.  
  135. : :             \ name ( -- ) redefined colon, using runtimer
  136.         runtimer @ 0= if [compile] : beep exit then 
  137.         here  timer-link token@ token,  timer-link token!
  138.         [compile] :                     \ make a colon definition
  139.         compile (time 0 , 0 , ; immediate
  140.  
  141. only  forth also  definitions  decimal
  142. runtimer on
  143.