From: goer@ellis.uchicago.edu (Richard L. Goerwitz)
Subject: simple profiler
Reply-To: goer@midway.uchicago.edu
Organization: University of Chicago Computing Organizations
Date: Sun, 13 Sep 1992 01:28:56 GMT

Appended to this posting is part 1 of a three-part shell archive containing
a simple Icon profiler for UNIX.  I needed it to determine why a program I
wrote was running so slowly.  It's not extensively tested, but I thought I'd
post it, since I'd guess it would be the sort of thing a lot of people would
want.

-Richard

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 09/13/1992 01:04 UTC by goer@midway.uchicago.edu
# Source directory /u/richard/Profile
#
# existing files will NOT be overwritten unless -c is specified
# This format requires very little intelligence at unshar time.
# "if test", "cat", "rm", "echo", "true", and "sed" may be needed.
#
# This is part 1 of a multipart archive                                    
# do not concatenate these parts, unpack them in order with /bin/sh        
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   9756 -r--r--r-- profile.icn
#  13556 -r--r--r-- itlib.icn
#  18055 -r--r--r-- iolib.icn
#   7164 -r--r--r-- iscreen.icn
#   1126 -rw-r--r-- Makefile.dist
#
if test -r _shar_seq_.tmp; then
	echo 'Must unpack archives in sequence!'
	echo Please unpack part `cat _shar_seq_.tmp` next
	exit 1
fi
# ============= profile.icn ==============
if test -f 'profile.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping profile.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting profile.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'profile.icn' &&
X############################################################################
X#
X#	Name:	 profile.icn
X#
X#	Title:	 simple Icon profiler for UNIX
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.3
X#
X############################################################################
X#
X#  This very simple profiler takes a single argument - an Icon program
X#  compiled with the -t option.  Displays stats on which procedures
X#  were called the most often, and from what lines in what files they
X#  were called.  Use this program to figure out what procedures are
X#  getting worked the hardest and why.  Counts only invocations and
X#  resumptions; not suspensions, returns, failures.
X#
X#  If you are running a program that reads from a file, be sure to
X#  protect the redirection symbol from the shell (i.e. "profile
X#  'myprog < input'" instead of "profile myprog < input").  If a given
X#  program normally reads &input, please redirect stdin to read from
X#  another tty than the one you are running profile from.  If you
X#  forget to do this, the results might be very interesting....  Also,
X#  don't redirect stderr, as this contains the trace that profile will
X#  be reading and using to obtain run-time statistics.  Profile
X#  automatically redirects stdout to /dev/null.
X#
X#  Currently runs only under UNIX, but with some tweaking could be
X#  made to run elsewhere as well.
X#
X#  The display should be pretty much self-explanatory.  Filenames and
X#  procedures get truncated at nineteen characters (if the display
X#  gets too wide, it can become hard to read).  A star is prepended to
X#  procedures whose statistics have changed since the last screen
X#  update.
X#
X############################################################################
X#
X#  Requires:  coexpressions, keyboard functions, pipes, UNIX
X#
X#  Links:  iolib or itlib, iscreen
X#
X############################################################################
X
X# link iscreen
Xglobal CM, LI, CO, CE
X
Xprocedure main(a)
X
X    local whitespace, firstidchars, idchars, usage, in_data,
X	cmd, line, filename, linenum, procname, t, threshhold
X
X    whitespace   := '\t '
X    firstidchars := &letters ++ '_'
X    idchars      := &digits ++ &letters ++ '_'
X    usage        := "usage:  profile filename _
X		     (filename = Icon program compiled with -t option)"
X
X    #
X    # If called with a program name as the first argument, open it,
X    # and pipe the trace output back to this program.  Assume the
X    # user knew enough to compile it with the "-t" option.
X    #
X    if *a > 0 then {
X	if find("UNIX", &features) then {
X	    cmd := ""; every cmd ||:= !a || " "
X	    if find("2>"|"2>&1", cmd) then
X		stop("profile:  Please don't redirect stderr!")
X	    in_data := open(cmd || " 2>&1 1> /dev/null", "pr") |
X		stop("profile:  Can't find or execute ", cmd, ".")
X	} else stop("profile:  Your OS is not (yet) supported.")
X    }
X    else stop(usage)
X
X    # clear screen, set up global variables; initialize table
X    setup_screen()
X    t := table()
X
X    threshhold := 0
X    while line := read(in_data) do {
X	threshhold +:= 1
X	#
X	# Break each line down into a file name, line number, and
X	# procedure name.
X	#
X	line ? {
X	    tab(many(whitespace))
X	    match(":") & next
X	    { 
X		filename := trim(tab(find(":"))) &
X		  tab(many(whitespace ++ ':')) &
X		  linenum  := tab(many(&digits)) &
X		  tab(many(whitespace ++ '|')) &
X		  procname := tab(any(firstidchars)) || tab(many(idchars))
X	    } | next
X	    tab(many(whitespace))
X	    # Count only invocations and resumptions.
X	    match("suspended"|"failed"|"returned") & next
X	}
X
X	#
X	# Enter statistics into table.
X	#
X	/t[procname] := table()
X	/t[procname][filename] := table(0)
X	 t[procname][filename][linenum] +:= 1
X
X	#
X	# Display stats interactively.
X	#
X	if threshhold > 50 then {
X	    threshhold := 0
X	    display_stats(t)
X	}
X    }
X
X    display_stats(t)
X    # Write a nice exit message.
X    goodbye()
X
Xend
X
X
X#
X# display_stats:  display the information in t interactively
X#
Xprocedure display_stats(t)
X
X    local l, input, c
X    static top, len, firstline
X	# sets global variables CM, LI, CO, and CE
X    initial {
X	top := 1
X	# The first line we can write data to on the screen.
X	firstline := 3
X	len := LI - 4 - firstline
X    }
X
X    #
X    # Structure the information in t into a list.  Note that to obtain
X    # the number of procedures, one must divide l in half.
X    #
X    l := sort_table(t)
X
X    #
X    # Check for user input.
X    #
X    while kbhit() do {
X	iputs(igoto(CM, 1, LI-1))
X	writes("Press j/k/^/$/p/q:  ")
X	iputs(CE)
X	writes(input := map(getch()))
X	case input of {
X	    # Increase or decrease top by 4; don't go beyond 0 or
X	    # *l; no even numbers for top (the 4 also must be even).
X	    "j"    : top := (*l > (top+2) | *l-1)
X	    "\r"   : top := (*l > (top+2) | *l-1)
X	    "\n"   : top := (*l > (top+2) | *l-1)
X	    "k"    : top := (0  < (top-2) | 1)
X	    "\x02" : top := (0  < (top-4) | 1)
X	    "\x15": top := (0  < (top-4) | 1)
X	    " "    : top := (*l > (top+4) | *l-1)
X	    "\x06" : top := (*l > (top+4) | *l-1)
X	    "\x04" : top := (*l > (top+4) | *l-1)
X	    "^"    : top := 1
X	    "$"    : top := *l-1
X	    "p"    : {
X		iputs(igoto(CM, 1, LI-1))
X		writes("Press any key to continue: "); iputs(CE)
X		until kbhit() & getch() do delay(500)
X	    }
X            "q"    : goodbye()
X            "\x0C" : setup_screen()
X	    "\x012": setup_screen()
X	    default: {
X		if any(&digits, input) then {
X		    while c := getche() do {
X			if c == ("\n"|"\r") then {
X			    if not (input <:= 1) then
X				input +:= input % 2 - 1
X			    top := (0  < input | 1)
X			    top := (*l > input | *l-1)
X			    break
X			} else {
X			    if any(&digits, c)
X			    then input ||:= c & next
X			    else break
X			}
X		    }
X		}
X	    }
X	}
X	iputs(igoto(CM, 1, LI-1))
X	writes("Press j/k/^/$/p/q:  ")
X	iputs(CE)
X    }
X
X    #
X    # Display the information contained in table t via list l2.
X    #
X    write_list(l, top, len, firstline)
X    return
X
Xend
X
X
X#
X# sort_table:  structure the info in t into a list
X#
X#     What a mess.  T is a table, keys = procedure names, values =
X#     another table.  These other tables are tables where keys = file
X#     names and values = yet another table.  These yet other tables
X#     are structured as follows: keys = line numbers, values = number
X#     of invocations.  The idea is to collapse all of these tables
X#     into sorted lists, and at the same time count up the total
X#     number of invocations for a given procedure name (going through
X#     all its invocations at every line in every file).  A new table
X#     is then created where keys = procedure names and values = total
X#     number of invocations.  Yet another sort is done on the basis of
X#     total number of invocations.
X#
Xprocedure sort_table(t)
X
X    local t2, total_t, k, total, i, l, l2
X    static old_totals
X    initial old_totals := table()
X
X    t2 := copy(t)
X    total_t := table()
X    every k := key(t2) do {
X	t2[k] := sort(t2[k], 3)
X	total := 0
X	every i := 2 to *t2[k] by 2 do {
X	    every total +:= !t2[k][i]
X	    t2[k][i] := sort(t2[k][i], 3)
X	}
X	insert(total_t, k, total)
X    }
X    l2 := list(); l := sort(total_t, 4)
X    every i := 1 to *l-1 by 2 do {
X	push(l2, t2[l[i]])
X	if not (total_t[l[i]] <= \old_totals[l[i]]) then
X	    l[i] := "*" || l[i]
X	push(l2, l[i])
X    }
X
X    old_totals := total_t
X    return l2
X
Xend
X
X
X#
X# write_list:  write statistics in the upper part of the screen
X#
Xprocedure write_list(l, top, len, firstline)
X
X    local   i, j, k, z, w
X    static  last_i
X    #global CM, CE
X    initial last_i := 2
X
X    # Arg1, l, is a sorted table of sorted tables of sorted tables!
X    # Firstline is the first line on the screen we can write data to.
X    #
X    i := firstline
X    iputs(igoto(CM, 1, i)); iputs(CE)
X    every j := top to *l by 2 do {
X	writes(left(l[j], 19, " "))
X	every k := 1 to *l[j+1]-1 by 2 do {
X	    iputs(igoto(CM, 20, i))
X	    writes(left(l[j+1][k], 19, " "))
X	    every z := 1 to *l[j+1][k+1]-1 by 2 do {
X		iputs(igoto(CM, 40, i))
X		writes(left(l[j+1][k+1][z], 7, " "))
X		iputs(igoto(CM, 48, i))
X		writes(l[j+1][k+1][z+1])
X		if (i +:= 1) > (firstline + len) then
X		    break break break
X		else iputs(igoto(CM, 1, i)) & iputs(CE)
X	    }
X	}
X    }
X
X    # Clear the remaining lines down to the status line.
X    #
X    every w := i to last_i do {
X	iputs(igoto(CM, 1, w))
X	iputs(CE)
X    }
X    last_i := i
X
X    return
X
Xend
X
X
X#
X# setup_screen: clear screen, set up status line.
X#
Xprocedure setup_screen()
X
X    # global CM, LI, CO, CE
X    initial {
X	CM := getval("cm") |
X	    stop("setup_screen:  No cm capability!")
X	LI := getval("li")
X	CO := getval("co")
X	CE := getval("ce")
X	# UNIX-specific command to disable character echo.
X	system("stty -echo")
X    }
X
X    clear()
X    iputs(igoto(CM, 1, 1))
X    emphasize()
X    writes(left(left("procedure name", 19, " ") ||
X		left("source file", 20, " ") ||
X		left("line", 8, " ") ||
X		"number of invocations/resumptions",
X		CO, " "))
X    normal()
X    status_line("- \"Profile,\" by Richard Goerwitz -")
X    iputs(igoto(CM, 1, LI-1))
X    writes("J or CR=down; k=up; ^=begin; $=end; p=pause; q=quit: ")
X    iputs(CE)
X
X    return
X
Xend
X
X#
X# goodbye: exit, say something nice
X#
Xprocedure goodbye()
X
X    # UNIX-specific command.
X    system("stty echo")
X
X    status_line("- \"Profile,\" by Richard Goerwitz -")
X    every boldface() | emphasize() | normal() |
X	  boldface() | emphasize() | normal()
X    do {
X	delay(50)
X	iputs(igoto(CM, 1, LI-1))
X	writes("Hope you enjoyed using profile! ")
X	normal(); iputs(CE)
X    }
X    exit()
X
Xend
X
X
X#
X# stop_profile:  graceful exit after error
X# 
Xprocedure stop_profile(s)
X
X    # UNIX-specific command.
X    system("stty echo")
X
X    status_line("- \"Profile,\" by Richard Goerwitz -")
X    iputs(igoto(CM, 1, LI-1))
X    writes(s); iputs(CE)
X    iputs(igoto(CM, 1, LI))
X    stop()
X
Xend
SHAR_EOF
true || echo 'restore of profile.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= itlib.icn ==============
if test -f 'itlib.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping itlib.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting itlib.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'itlib.icn' &&
X########################################################################
X#    
X#	Name:	itlib.icn
X#	
X#	Title:	Icon termlib-type tools
X#	
X#	Author:	Richard L. Goerwitz
X#
X#	Version: 1.33
X#
X#########################################################################
X#
X#  I place this and future versions of itlib in the public domain - RLG
X#
X#########################################################################
X#
X#  The following library represents a series of rough functional
X#  equivalents to the standard Unix low-level termcap routines.  They
X#  are not meant as exact termlib clones.  Nor are they enhanced to
X#  take care of magic cookie terminals, terminals that use \D in their
X#  termcap entries, or, in short, anything I felt would not affect my
X#  normal, day-to-day work with ANSI and vt100 terminals.  There are
X#  some machines with incomplete or skewed implementations of stty for
X#  which itlib will not work.  See the BUGS section below for work-
X#  arounds.
X#
X#  Requires:  A unix platform & co-expressions.  There is an MS-DOS
X#  version, itlibdos.icn.
X#
X#  setname(term)
X#	Use only if you wish to initialize itermlib for a terminal
X#  other than what your current environment specifies.  "Term" is the
X#  name of the termcap entry to use.  Normally this initialization is
X#  done automatically, and need not concern the user.
X#
X#  getval(id)
X#	Works something like tgetnum, tgetflag, and tgetstr.  In the
X#  spirit of Icon, all three have been collapsed into one routine.
X#  Integer valued caps are returned as integers, strings as strings,
X#  and flags as records (if a flag is set, then type(flag) will return
X#  "true").  Absence of a given capability is signalled by procedure
X#  failure.
X#
X#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
X#	Analogous to tgoto.  "Cm" is the cursor movement command for
X#  the current terminal, as obtained via getval("cm").  Igoto()
X#  returns a string which, when output via iputs, will cause the
X#  cursor to move to column "destcol" and line "destline."  Column and
X#  line are always calculated using a *one* offset.  This is far more
X#  Iconish than the normal zero offset used by tgoto.  If you want to
X#  go to the first square on your screen, then include in your program
X#  "iputs(igoto(getval("cm"),1,1))."
X#
X#  iputs(cp,affcnt)
X#	Equivalent to tputs.  "Cp" is a string obtained via getval(),
X#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
X#  count of affected lines.  It is only relevant for terminals which
X#  specify proportional (starred) delays in their termcap entries.
X#
X#  BUGS:  I have not tested these routines much on terminals that
X#  require padding.  These routines WILL NOT WORK if your machine's
X#  stty command has no -g option (tisk, tisk).  This includes 1.0 NeXT
X#  workstations, and some others that I haven't had time to pinpoint.
X#  If you are on a BSD box, try typing "sh -c 'stty -g | more'" it may
X#  be that your stty command is too clever (read stupid) to write its
X#  output to a pipe.  The current workaround is to replace every in-
X#  stance of /bin/stty with /usr/5bin/stty (or whatever your system
X#  calls the System V stty command) in this file.  If you have no SysV
X#  stty command online, try replaceing "stty -g 2>&1" below with, say,
X#  "stty -g 2>&1 1> /dev/tty."  If you are using mainly modern ter-
X#  minals that don't need padding, consider using iolib.icn instead of
X#  itlib.icn.
X#
X##########################################################################
X#
X#  Requires: UNIX, co-expressions
X#
X#  See also: iscreen.icn (a set of companion utilities), iolib.icn
X#
X##########################################################################
X
X
Xglobal tc_table, tty_speed
Xrecord true()
X
X
Xprocedure check_features()
X
X    local in_params, line
X    # global tty_speed
X
X    initial {
X	find("unix",map(&features)) |
X	    er("check_features","unix system required",1)
X	find("o-expres",&features) |
X	    er("check_features","co-expressions not implemented - &$#!",1)
X	system("/bin/stty tabs") |
X	    er("check_features","can't set tabs option",1)
X    }
X
X    # clumsy, clumsy, clumsy, and probably won't work on all systems
X    tty_speed := getspeed()
X    return "term characteristics reset; features check out"
X
Xend
X
X
X
Xprocedure setname(name)
X
X    # Sets current terminal type to "name" and builds a new termcap
X    # capability database (residing in tc_table).  Fails if unable to
X    # find a termcap entry for terminal type "name."  If you want it
X    # to terminate with an error message under these circumstances,
X    # comment out "| fail" below, and uncomment the er() line.
X
X    #tc_table is global
X    
X    check_features()
X
X    tc_table := table()
X    tc_table := maketc_table(getentry(name)) | fail
X    # er("setname","no termcap entry found for "||name,3)
X    return "successfully reset for terminal " || name
X
Xend
X
X
X
Xprocedure getname()
X
X    # Getname() first checks to be sure we're running under Unix, and,
X    # if so, tries to figure out what the current terminal type is,
X    # checking successively the value of the environment variable
X    # TERM, and then the output of "tset -".  Terminates with an error
X    # message if the terminal type cannot be ascertained.
X
X    local term, tset_output
X
X    check_features()
X
X    if not (term := getenv("TERM")) then {
X	tset_output := open("/bin/tset -","pr") |
X	    er("getname","can't find tset command",1)
X	term := !tset_output
X	close(tset_output)
X    }
X    return \term |
X	er("getname","can't seem to determine your terminal type",1)
X
Xend
X
X
X
Xprocedure er(func,msg,errnum)
X
X    # short error processing utility
X    write(&errout,func,":  ",msg)
X    exit(errnum)
X
Xend
X
X
X
Xprocedure getentry(name, termcap_string)
X
X    # "Name" designates the current terminal type.  Getentry() scans
X    # the current environment for the variable TERMCAP.  If the
X    # TERMCAP string represents a termcap entry for a terminal of type
X    # "name," then getentry() returns the TERMCAP string.  Otherwise,
X    # getentry() will check to see if TERMCAP is a file name.  If so,
X    # getentry() will scan that file for an entry corresponding to
X    # "name."  If the TERMCAP string does not designate a filename,
X    # getentry() will scan /etc/termcap for the correct entry.
X    # Whatever the input file, if an entry for terminal "name" is
X    # found, getentry() returns that entry.  Otherwise, getentry()
X    # fails.
X
X    local f, getline, line, nm, ent1, ent2
X
X    # You can force getentry() to use a specific termcap file by cal-
X    # ling it with a second argument - the name of the termcap file
X    # to use instead of the regular one, or the one specified in the
X    # termcap environment variable.
X    /termcap_string := getenv("TERMCAP")
X
X    if \termcap_string ? (not match("/"), pos(1) | tab(find("|")+1), =name)
X    then {
X	# if entry ends in tc= then add in the named tc entry
X	termcap_string ?:= tab(find("tc=")) ||
X	    # Recursively fetch the new termcap entry w/ name trimmed.
X	    (move(3), getentry(tab(find(":")), "/etc/termcap") ?
X	     (tab(find(":")+1), tab(0)))
X	return termcap_string
X    }
X    else {
X
X	# The logic here probably isn't clear.  The idea is to try to use
X	# the termcap environment variable successively as 1) a termcap en-
X	# try and then 2) as a termcap file.  If neither works, 3) go to
X	# the /etc/termcap file.  The else clause here does 2 and, if ne-
X	# cessary, 3.  The "\termcap_string ? (not match..." expression
X	# handles 1.
X
X	if find("/",\termcap_string)
X	then f := open(termcap_string)
X	/f := open("/etc/termcap") |
X	    er("getentry","I can't access your /etc/termcap file",1)
X
X	getline := create read_file(f)
X    
X	while line := @getline do {
SHAR_EOF
true || echo 'restore of itlib.icn failed'
fi
echo 'End of  part 1'
echo 'File itlib.icn is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0
-- 

   -Richard L. Goerwitz              goer%midway@uchicago.bitnet
   goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer