home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / iprofile.icn < prev    next >
Text File  |  2001-05-02  |  10KB  |  382 lines
  1. ############################################################################
  2. #
  3. #    File:     iprofile.icn
  4. #
  5. #    Subject:  Program to profile Icon procedure usage
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #  This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.5
  18. #
  19. ############################################################################
  20. #
  21. #  This very simple profiler takes a single argument - an Icon program
  22. #  compiled with the -t option.  Displays stats on which procedures
  23. #  were called the most often, and from what lines in what files they
  24. #  were called.  Use this program to figure out what procedures are
  25. #  getting worked the hardest and why.  Counts only invocations and
  26. #  resumptions; not suspensions, returns, failures.
  27. #
  28. #  If you are running a program that reads from a file, be sure to
  29. #  protect the redirection symbol from the shell (i.e. "profile
  30. #  'myprog < input'" instead of "profile myprog < input").  If a given
  31. #  program normally reads &input, please redirect stdin to read from
  32. #  another tty than the one you are running profile from.  If you
  33. #  forget to do this, the results might be very interesting....  Also,
  34. #  don't redirect stderr, as this contains the trace that profile will
  35. #  be reading and using to obtain run-time statistics.  Profile
  36. #  automatically redirects stdout to /dev/null.
  37. #
  38. #  Currently runs only under UNIX, but with some tweaking could be
  39. #  made to run elsewhere as well.
  40. #
  41. #  The display should be pretty much self-explanatory.  Filenames and
  42. #  procedures get truncated at nineteen characters (if the display
  43. #  gets too wide, it can become hard to read).  A star is prepended to
  44. #  procedures whose statistics have changed since the last screen
  45. #  update.
  46. #
  47. ############################################################################
  48. #
  49. #  Requires:  co-expressions, keyboard functions, pipes, UNIX
  50. #
  51. ############################################################################
  52. #
  53. #  Links:  itlib, iscreen
  54. #
  55. ############################################################################
  56.  
  57. link itlib
  58. link iscreen
  59. global CM, LI, CO, CE
  60.  
  61. procedure main(a)
  62.  
  63.     local whitespace, firstidchars, idchars, usage, in_data,
  64.     cmd, line, filename, linenum, procname, t, threshhold
  65.  
  66.     whitespace   := '\t '
  67.     firstidchars := &letters ++ '_'
  68.     idchars      := &digits ++ &letters ++ '_'
  69.     usage        := "usage:  profile filename _
  70.              (filename = Icon program compiled with -t option)"
  71.  
  72.     #
  73.     # If called with a program name as the first argument, open it,
  74.     # and pipe the trace output back to this program.  Assume the
  75.     # user knew enough to compile it with the "-t" option.
  76.     #
  77.     if *a > 0 then {
  78.     if find("UNIX", &features) then {
  79.         cmd := ""; every cmd ||:= !a || " "
  80.         if find("2>", cmd) then
  81.         stop("profile:  Please don't redirect stderr!")
  82.         in_data := open(cmd || " 2>&1 1> /dev/null", "pr") |
  83.         stop("profile:  Can't find or execute ", cmd, ".")
  84.     } else stop("profile:  Your OS is not (yet) supported.")
  85.     }
  86.     else stop(usage)
  87.  
  88.     # clear screen, set up global variables; initialize table
  89.     setup_screen()
  90.     t := table()
  91.  
  92.     threshhold := 0
  93.     while line := read(in_data) do {
  94.     threshhold +:= 1
  95.     #
  96.     # Break each line down into a file name, line number, and
  97.     # procedure name.
  98.     #
  99.     line ? {
  100.         tab(many(whitespace))
  101.         match(":") & next
  102.         { 
  103.         filename := trim(tab(find(":"))) &
  104.           tab(many(whitespace ++ ':')) &
  105.           linenum  := tab(many(&digits)) &
  106.           tab(many(whitespace ++ '|')) &
  107.           procname := tab(any(firstidchars)) || tab(many(idchars))
  108.         } | next
  109.         tab(many(whitespace))
  110.         # Count only invocations and resumptions.
  111.         match("suspended"|"failed"|"returned") & next
  112.     }
  113.  
  114.     #
  115.     # Enter statistics into table.
  116.     #
  117.     /t[procname] := table()
  118.     /t[procname][filename] := table(0)
  119.      t[procname][filename][linenum] +:= 1
  120.  
  121.     #
  122.     # Display stats interactively.
  123.     #
  124.     if threshhold > 90 then {
  125.         threshhold := 0
  126.         display_stats(t)
  127.     }
  128.     }
  129.  
  130.     display_stats(t)
  131.     # Write a nice exit message.
  132.     goodbye()
  133.  
  134. end
  135.  
  136.  
  137. #
  138. # display_stats:  display the information in t interactively
  139. #
  140. procedure display_stats(t)
  141.  
  142.     local l, input, c
  143.     static top, len, firstline
  144.     # sets global variables CM, LI, CO, and CE
  145.     initial {
  146.     top := 1
  147.     # The first line we can write data to on the screen.
  148.     firstline := 3
  149.     len := LI - 4 - firstline
  150.     }
  151.  
  152.     #
  153.     # Structure the information in t into a list.  Note that to obtain
  154.     # the number of procedures, one must divide l in half.
  155.     #
  156.     l := sort_table(t)
  157.  
  158.     #
  159.     # Check for user input.
  160.     #
  161.     while kbhit() do {
  162.     iputs(igoto(CM, 1, LI-1))
  163.     writes("Press j/k/^/$/p/q:  ")
  164.     iputs(CE)
  165.     writes(input := map(getch()))
  166.     case input of {
  167.         # Increase or decrease top by 4; don't go beyond 0 or
  168.         # *l; no even numbers for top (the 4 also must be even).
  169.         "j"    : top := (*l > (top+2) | *l-1)
  170.         "\r"   : top := (*l > (top+2) | *l-1)
  171.         "\n"   : top := (*l > (top+2) | *l-1)
  172.         "k"    : top := (0  < (top-2) | 1)
  173.         "\x02" : top := (0  < (top-4) | 1)
  174.         "\x15": top := (0  < (top-4) | 1)
  175.         " "    : top := (*l > (top+4) | *l-1)
  176.         "\x06" : top := (*l > (top+4) | *l-1)
  177.         "\x04" : top := (*l > (top+4) | *l-1)
  178.         "^"    : top := 1
  179.         "$"    : top := *l-1
  180.         "p"    : {
  181.         iputs(igoto(CM, 1, LI-1))
  182.         writes("Press any key to continue: "); iputs(CE)
  183.         until kbhit() & getch() do delay(500)
  184.         }
  185.             "q"    : goodbye()
  186.             "\x0C" : setup_screen()
  187.         "\x012": setup_screen()
  188.         default: {
  189.         if any(&digits, input) then {
  190.             while c := getche() do {
  191.             if c == ("\n"|"\r") then {
  192.                 if not (input <:= 1) then
  193.                 input +:= input % 2 - 1
  194.                 top := (0  < input | 1)
  195.                 top := (*l > input | *l-1)
  196.                 break
  197.             } else {
  198.                 if any(&digits, c)
  199.                 then input ||:= c & next
  200.                 else break
  201.             }
  202.             }
  203.         }
  204.         }
  205.     }
  206.     iputs(igoto(CM, 1, LI-1))
  207.     writes("Press j/k/^/$/p/q:  ")
  208.     iputs(CE)
  209.     }
  210.  
  211.     #
  212.     # Display the information contained in table t via list l2.
  213.     #
  214.     write_list(l, top, len, firstline)
  215.     return
  216.  
  217. end
  218.  
  219.  
  220. #
  221. # sort_table:  structure the info in t into a list
  222. #
  223. #     What a mess.  T is a table, keys = procedure names, values =
  224. #     another table.  These other tables are tables where keys = file
  225. #     names and values = yet another table.  These yet other tables
  226. #     are structured as follows: keys = line numbers, values = number
  227. #     of invocations.  The idea is to collapse all of these tables
  228. #     into sorted lists, and at the same time count up the total
  229. #     number of invocations for a given procedure name (going through
  230. #     all its invocations at every line in every file).  A new table
  231. #     is then created where keys = procedure names and values = total
  232. #     number of invocations.  Yet another sort is done on the basis of
  233. #     total number of invocations.
  234. #
  235. procedure sort_table(t)
  236.  
  237.     local t2, total_t, k, total, i, l, l2
  238.     static old_totals
  239.     initial old_totals := table()
  240.  
  241.     t2 := copy(t)
  242.     total_t := table()
  243.     every k := key(t2) do {
  244.     t2[k] := sort(t2[k], 3)
  245.     total := 0
  246.     every i := 2 to *t2[k] by 2 do {
  247.         every total +:= !t2[k][i]
  248.         t2[k][i] := sort(t2[k][i], 3)
  249.     }
  250.     insert(total_t, k, total)
  251.     }
  252.     l2 := list(); l := sort(total_t, 4)
  253.     every i := 1 to *l-1 by 2 do {
  254.     push(l2, t2[l[i]])
  255.     if not (total_t[l[i]] <= \old_totals[l[i]]) then
  256.         l[i] := "*" || l[i]
  257.     push(l2, l[i])
  258.     }
  259.  
  260.     old_totals := total_t
  261.     return l2
  262.  
  263. end
  264.  
  265.  
  266. #
  267. # write_list:  write statistics in the upper part of the screen
  268. #
  269. procedure write_list(l, top, len, firstline)
  270.  
  271.     local   i, j, k, z, w
  272.     static  last_i
  273.     #global CM, CE
  274.     initial last_i := 2
  275.  
  276.     # Arg1, l, is a sorted table of sorted tables of sorted tables!
  277.     # Firstline is the first line on the screen we can write data to.
  278.     #
  279.     i := firstline
  280.     iputs(igoto(CM, 1, i)); iputs(CE)
  281.     every j := top to *l by 2 do {
  282.     writes(left(l[j], 19, " "))
  283.     every k := 1 to *l[j+1]-1 by 2 do {
  284.         iputs(igoto(CM, 20, i))
  285.         writes(left(l[j+1][k], 19, " "))
  286.         every z := 1 to *l[j+1][k+1]-1 by 2 do {
  287.         iputs(igoto(CM, 40, i))
  288.         writes(left(l[j+1][k+1][z], 7, " "))
  289.         iputs(igoto(CM, 48, i))
  290.         writes(l[j+1][k+1][z+1])
  291.         if (i +:= 1) > (firstline + len) then
  292.             break break break
  293.         else iputs(igoto(CM, 1, i)) & iputs(CE)
  294.         }
  295.     }
  296.     }
  297.  
  298.     # Clear the remaining lines down to the status line.
  299.     #
  300.     every w := i to last_i do {
  301.     iputs(igoto(CM, 1, w))
  302.     iputs(CE)
  303.     }
  304.     last_i := i
  305.  
  306.     return
  307.  
  308. end
  309.  
  310.  
  311. #
  312. # setup_screen: clear screen, set up status line.
  313. #
  314. procedure setup_screen()
  315.  
  316.     # global CM, LI, CO, CE
  317.     initial {
  318.     CM := getval("cm") |
  319.         stop("setup_screen:  No cm capability!")
  320.     LI := getval("li")
  321.     CO := getval("co")
  322.     CE := getval("ce")
  323.     # UNIX-specific command to disable character echo.
  324.     system("stty -echo")
  325.     }
  326.  
  327.     clear()
  328.     iputs(igoto(CM, 1, 1))
  329.     emphasize()
  330.     writes(left(left("procedure name", 19, " ") ||
  331.         left("source file", 20, " ") ||
  332.         left("line", 8, " ") ||
  333.         "number of invocations/resumptions",
  334.         CO, " "))
  335.     normal()
  336.     status_line("- \"Profile,\" by Richard Goerwitz -")
  337.     iputs(igoto(CM, 1, LI-1))
  338.     writes("J or CR=down; k=up; ^=begin; $=end; p=pause; q=quit: ")
  339.     iputs(CE)
  340.  
  341.     return
  342.  
  343. end
  344.  
  345. #
  346. # goodbye: exit, say something nice
  347. #
  348. procedure goodbye()
  349.  
  350.     # UNIX-specific command.
  351.     system("stty echo")
  352.  
  353.     status_line("- \"Profile,\" by Richard Goerwitz -")
  354.     every boldface() | emphasize() | normal() |
  355.       boldface() | emphasize() | normal()
  356.     do {
  357.     delay(50)
  358.     iputs(igoto(CM, 1, LI-1))
  359.     writes("Hope you enjoyed using profile! ")
  360.     normal(); iputs(CE)
  361.     }
  362.     exit()
  363.  
  364. end
  365.  
  366.  
  367. #
  368. # stop_profile:  graceful exit after error
  369. # 
  370. procedure stop_profile(s)
  371.  
  372.     # UNIX-specific command.
  373.     system("stty echo")
  374.  
  375.     status_line("- \"Profile,\" by Richard Goerwitz -")
  376.     iputs(igoto(CM, 1, LI-1))
  377.     writes(s); iputs(CE)
  378.     iputs(igoto(CM, 1, LI))
  379.     stop()
  380.  
  381. end
  382.