diff options
Diffstat (limited to 'ipl/progs/iprofile.icn')
| -rw-r--r-- | ipl/progs/iprofile.icn | 381 |
1 files changed, 381 insertions, 0 deletions
diff --git a/ipl/progs/iprofile.icn b/ipl/progs/iprofile.icn new file mode 100644 index 0000000..98e0ded --- /dev/null +++ b/ipl/progs/iprofile.icn @@ -0,0 +1,381 @@ +############################################################################ +# +# File: iprofile.icn +# +# Subject: Program to profile Icon procedure usage +# +# Author: Richard L. Goerwitz +# +# Date: May 2, 2001 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# Version: 1.5 +# +############################################################################ +# +# This very simple profiler takes a single argument - an Icon program +# compiled with the -t option. Displays stats on which procedures +# were called the most often, and from what lines in what files they +# were called. Use this program to figure out what procedures are +# getting worked the hardest and why. Counts only invocations and +# resumptions; not suspensions, returns, failures. +# +# If you are running a program that reads from a file, be sure to +# protect the redirection symbol from the shell (i.e. "profile +# 'myprog < input'" instead of "profile myprog < input"). If a given +# program normally reads &input, please redirect stdin to read from +# another tty than the one you are running profile from. If you +# forget to do this, the results might be very interesting.... Also, +# don't redirect stderr, as this contains the trace that profile will +# be reading and using to obtain run-time statistics. Profile +# automatically redirects stdout to /dev/null. +# +# Currently runs only under UNIX, but with some tweaking could be +# made to run elsewhere as well. +# +# The display should be pretty much self-explanatory. Filenames and +# procedures get truncated at nineteen characters (if the display +# gets too wide, it can become hard to read). A star is prepended to +# procedures whose statistics have changed since the last screen +# update. +# +############################################################################ +# +# Requires: co-expressions, keyboard functions, pipes, UNIX +# +############################################################################ +# +# Links: itlib, iscreen +# +############################################################################ + +link itlib +link iscreen +global CM, LI, CO, CE + +procedure main(a) + + local whitespace, firstidchars, idchars, usage, in_data, + cmd, line, filename, linenum, procname, t, threshhold + + whitespace := '\t ' + firstidchars := &letters ++ '_' + idchars := &digits ++ &letters ++ '_' + usage := "usage: profile filename _ + (filename = Icon program compiled with -t option)" + + # + # If called with a program name as the first argument, open it, + # and pipe the trace output back to this program. Assume the + # user knew enough to compile it with the "-t" option. + # + if *a > 0 then { + if find("UNIX", &features) then { + cmd := ""; every cmd ||:= !a || " " + if find("2>", cmd) then + stop("profile: Please don't redirect stderr!") + in_data := open(cmd || " 2>&1 1> /dev/null", "pr") | + stop("profile: Can't find or execute ", cmd, ".") + } else stop("profile: Your OS is not (yet) supported.") + } + else stop(usage) + + # clear screen, set up global variables; initialize table + setup_screen() + t := table() + + threshhold := 0 + while line := read(in_data) do { + threshhold +:= 1 + # + # Break each line down into a file name, line number, and + # procedure name. + # + line ? { + tab(many(whitespace)) + match(":") & next + { + filename := trim(tab(find(":"))) & + tab(many(whitespace ++ ':')) & + linenum := tab(many(&digits)) & + tab(many(whitespace ++ '|')) & + procname := tab(any(firstidchars)) || tab(many(idchars)) + } | next + tab(many(whitespace)) + # Count only invocations and resumptions. + match("suspended"|"failed"|"returned") & next + } + + # + # Enter statistics into table. + # + /t[procname] := table() + /t[procname][filename] := table(0) + t[procname][filename][linenum] +:= 1 + + # + # Display stats interactively. + # + if threshhold > 90 then { + threshhold := 0 + display_stats(t) + } + } + + display_stats(t) + # Write a nice exit message. + goodbye() + +end + + +# +# display_stats: display the information in t interactively +# +procedure display_stats(t) + + local l, input, c + static top, len, firstline + # sets global variables CM, LI, CO, and CE + initial { + top := 1 + # The first line we can write data to on the screen. + firstline := 3 + len := LI - 4 - firstline + } + + # + # Structure the information in t into a list. Note that to obtain + # the number of procedures, one must divide l in half. + # + l := sort_table(t) + + # + # Check for user input. + # + while kbhit() do { + iputs(igoto(CM, 1, LI-1)) + writes("Press j/k/^/$/p/q: ") + iputs(CE) + writes(input := map(getch())) + case input of { + # Increase or decrease top by 4; don't go beyond 0 or + # *l; no even numbers for top (the 4 also must be even). + "j" : top := (*l > (top+2) | *l-1) + "\r" : top := (*l > (top+2) | *l-1) + "\n" : top := (*l > (top+2) | *l-1) + "k" : top := (0 < (top-2) | 1) + "\x02" : top := (0 < (top-4) | 1) + "\x15": top := (0 < (top-4) | 1) + " " : top := (*l > (top+4) | *l-1) + "\x06" : top := (*l > (top+4) | *l-1) + "\x04" : top := (*l > (top+4) | *l-1) + "^" : top := 1 + "$" : top := *l-1 + "p" : { + iputs(igoto(CM, 1, LI-1)) + writes("Press any key to continue: "); iputs(CE) + until kbhit() & getch() do delay(500) + } + "q" : goodbye() + "\x0C" : setup_screen() + "\x012": setup_screen() + default: { + if any(&digits, input) then { + while c := getche() do { + if c == ("\n"|"\r") then { + if not (input <:= 1) then + input +:= input % 2 - 1 + top := (0 < input | 1) + top := (*l > input | *l-1) + break + } else { + if any(&digits, c) + then input ||:= c & next + else break + } + } + } + } + } + iputs(igoto(CM, 1, LI-1)) + writes("Press j/k/^/$/p/q: ") + iputs(CE) + } + + # + # Display the information contained in table t via list l2. + # + write_list(l, top, len, firstline) + return + +end + + +# +# sort_table: structure the info in t into a list +# +# What a mess. T is a table, keys = procedure names, values = +# another table. These other tables are tables where keys = file +# names and values = yet another table. These yet other tables +# are structured as follows: keys = line numbers, values = number +# of invocations. The idea is to collapse all of these tables +# into sorted lists, and at the same time count up the total +# number of invocations for a given procedure name (going through +# all its invocations at every line in every file). A new table +# is then created where keys = procedure names and values = total +# number of invocations. Yet another sort is done on the basis of +# total number of invocations. +# +procedure sort_table(t) + + local t2, total_t, k, total, i, l, l2 + static old_totals + initial old_totals := table() + + t2 := copy(t) + total_t := table() + every k := key(t2) do { + t2[k] := sort(t2[k], 3) + total := 0 + every i := 2 to *t2[k] by 2 do { + every total +:= !t2[k][i] + t2[k][i] := sort(t2[k][i], 3) + } + insert(total_t, k, total) + } + l2 := list(); l := sort(total_t, 4) + every i := 1 to *l-1 by 2 do { + push(l2, t2[l[i]]) + if not (total_t[l[i]] <= \old_totals[l[i]]) then + l[i] := "*" || l[i] + push(l2, l[i]) + } + + old_totals := total_t + return l2 + +end + + +# +# write_list: write statistics in the upper part of the screen +# +procedure write_list(l, top, len, firstline) + + local i, j, k, z, w + static last_i + #global CM, CE + initial last_i := 2 + + # Arg1, l, is a sorted table of sorted tables of sorted tables! + # Firstline is the first line on the screen we can write data to. + # + i := firstline + iputs(igoto(CM, 1, i)); iputs(CE) + every j := top to *l by 2 do { + writes(left(l[j], 19, " ")) + every k := 1 to *l[j+1]-1 by 2 do { + iputs(igoto(CM, 20, i)) + writes(left(l[j+1][k], 19, " ")) + every z := 1 to *l[j+1][k+1]-1 by 2 do { + iputs(igoto(CM, 40, i)) + writes(left(l[j+1][k+1][z], 7, " ")) + iputs(igoto(CM, 48, i)) + writes(l[j+1][k+1][z+1]) + if (i +:= 1) > (firstline + len) then + break break break + else iputs(igoto(CM, 1, i)) & iputs(CE) + } + } + } + + # Clear the remaining lines down to the status line. + # + every w := i to last_i do { + iputs(igoto(CM, 1, w)) + iputs(CE) + } + last_i := i + + return + +end + + +# +# setup_screen: clear screen, set up status line. +# +procedure setup_screen() + + # global CM, LI, CO, CE + initial { + CM := getval("cm") | + stop("setup_screen: No cm capability!") + LI := getval("li") + CO := getval("co") + CE := getval("ce") + # UNIX-specific command to disable character echo. + system("stty -echo") + } + + clear() + iputs(igoto(CM, 1, 1)) + emphasize() + writes(left(left("procedure name", 19, " ") || + left("source file", 20, " ") || + left("line", 8, " ") || + "number of invocations/resumptions", + CO, " ")) + normal() + status_line("- \"Profile,\" by Richard Goerwitz -") + iputs(igoto(CM, 1, LI-1)) + writes("J or CR=down; k=up; ^=begin; $=end; p=pause; q=quit: ") + iputs(CE) + + return + +end + +# +# goodbye: exit, say something nice +# +procedure goodbye() + + # UNIX-specific command. + system("stty echo") + + status_line("- \"Profile,\" by Richard Goerwitz -") + every boldface() | emphasize() | normal() | + boldface() | emphasize() | normal() + do { + delay(50) + iputs(igoto(CM, 1, LI-1)) + writes("Hope you enjoyed using profile! ") + normal(); iputs(CE) + } + exit() + +end + + +# +# stop_profile: graceful exit after error +# +procedure stop_profile(s) + + # UNIX-specific command. + system("stty echo") + + status_line("- \"Profile,\" by Richard Goerwitz -") + iputs(igoto(CM, 1, LI-1)) + writes(s); iputs(CE) + iputs(igoto(CM, 1, LI)) + stop() + +end |