Received: from santra.hut.fi (santra.hut.fi [130.233.224.1]) by snake.hut.fi (8.7.3/8.7.3) with ESMTP id MAA08020 for ; Thu, 15 Feb 1996 12:19:54 +0200 (EET) Received: from nic.funet.fi (nic.funet.fi [128.214.248.6]) by santra.hut.fi (8.7.3/8.7.3) with ESMTP id MAA16590 for ; Thu, 15 Feb 1996 12:19:53 +0200 (EET) Received: from hermes.dur.ac.uk ([129.234.4.9]) by nic.funet.fi with SMTP id <1988-23401>; Thu, 15 Feb 1996 12:19:36 +0200 Received: from ws-mj3 by hermes.dur.ac.uk id (8.6.12/ for dur.ac.uk) with SMTP; Thu, 15 Feb 1996 10:19:26 GMT Received: from dse3.durham.mj (dse3.dur) by ws-mj3; Thu, 15 Feb 96 10:20:47 GMT Received: by dse3.durham.mj (5.x/SMI-SVR4) id AA20699; Thu, 15 Feb 1996 10:20:52 GMT Message-Id: <9602151020.AA20699@dse3.durham.mj> From: Martin.Ward@durham.ac.uk (Martin Ward) To: cpan-adm@nic.funet.fi Subject: Call graph drawing program Date: Thu, 15 Feb 1996 10:20:52 GMT The enclosed perl script takes a call graph in text form, eg: A: A 2 B 3 Z 4 B: A 5 Z 1 Z: and generates either a PostScript file or a LaTeX source file (the latter requires pstricks and dvips, but is useful if you want to edit the output or include it in a LaTeX document). The input format is: (source: target1 n1 target2 n2 ...) (source: target1 n1 target2 n2 ...) ... where the brackets are optional (but all targets must be on the same line if there are no brackets). If all the numbers are "1" (ie each source calls its targets exactly once each), then all the numbers can be omitted. For example: B1: B2 B3 B2: B1 B3 B3: B3 (where the optional brackets and integers are omitted). There are several options, but the main ones are: - -l Use landscape mode rather than portrait mode - -simple Use a simple algorithm which takes less memory for very large graphs - -ps Generate raw PostScript (using the prologue file call_graph.pro) - -c Produce colour PostScript. If you have ghostscript and xloadimage, then you can view the output on your screen by running: draw-call-graph -c -ps your-callgraph-file > call_graph.ps gs -r80 -sDEVICE=pcx256 -sOutputFile=call_graph call_graph.ps . # Source directory was `/local/home/user3/martin/PS/call-graph'. # # Existing files will *not* be overwritten unless `-c' is specified. # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 29973 -rwx------ draw-call-graph # 21026 -rw------- call_graph.pro # 29 -rw------- cg-small # 4912 -rw------- cg-big # save_IFS="${IFS}" IFS="${IFS}:" gettext_dir=FAILED locale_dir=FAILED first_param="$1" for dir in $PATH do if test "$gettext_dir" = FAILED && test -f $dir/gettext \ && ($dir/gettext --version >/dev/null 2>&1) then set `$dir/gettext --version 2>&1` if test "$3" = GNU then gettext_dir=$dir fi fi if test "$locale_dir" = FAILED && test -f $dir/shar \ && ($dir/shar --print-text-domain-dir >/dev/null 2>&1) then locale_dir=`$dir/shar --print-text-domain-dir` fi done IFS="$save_IFS" if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED then echo=echo else TEXTDOMAINDIR=$locale_dir export TEXTDOMAINDIR TEXTDOMAIN=sharutils export TEXTDOMAIN echo="$gettext_dir/gettext -s" fi touch -am 1231235999 $$.touch >/dev/null 2>&1 if test ! -f 1231235999 && test -f $$.touch; then shar_touch=touch else shar_touch=: echo $echo 'WARNING: not restoring timestamps. Consider getting and' $echo "installing GNU \`touch', distributed in GNU File Utilities..." echo fi rm -f 1231235999 $$.touch # if mkdir _sh19664; then $echo 'x -' 'creating lock directory' else $echo 'failed to create lock directory' exit 1 fi # ============= draw-call-graph ============== if test -f 'draw-call-graph' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'draw-call-graph' '(file already exists)' else $echo 'x -' extracting 'draw-call-graph' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'draw-call-graph' && #!/usr/local/bin/perl # # draw-call-graph: a perl script for drawing call graphs. # Copyright 1991 Martin Ward # Email: Martin.Ward@durham.ac.uk # or: Martin.Ward%DURHAM.AC.UK@CUNYVM.CUNY.EDU # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # # draw-call-graph [-s text_size -u unit_length -a arrowsize -D n -l -c -simple -ps] ... # (-l option means landscape mode) # (-D n means debug level n) # (-c produces colour PostScript!) # (-simple uses a simple but faster algorithm) # (-ps generate raw PostScript instead of TeX) # # draw-call-graph reads from standard input or files on the command line # a call graph in the form: # (source: target1 n1 target2 n2 ...) # (source: target1 n1 target2 n2 ...) # ... # where the brackets are optional (but all targets must be on the same line # if there are no brackets). The file lists each procedure/basic block name # with a list of the procedures/blocks that it calls, and optionally the # number of times each target is called. For example: # # B1: B2 B3 # B2: B1 B3 # B3: B3 # # (where the optional brackets and integers are omitted). # It produces a LaTeX file on standard output which uses PSTricks to # plot a pretty diagram of the call graph. By default it tries to minimise # the number of upward arrows in the diagram, so that (especially with the # colour option -c), it is easy to see where the loops are in the call graph. # # Defaults for unit length and arrow size are calculated from # text_size, so changing this option should suffice. # Also text_size can be "auto", when the largest size is selected # for which the diagram still fits on the page. (This is the default). # # The LaTeX file uses the commands: # \ROW{...} set a row of nodes # \N{name}{stuff} set one node (separate nodes with one space) # \LINE{from}{to}{n} set a streight arrow # \ARC{from}{to}{n} set a curved arrow (used for mutual recursion) # \LR{from}{to}{space}{n} set a horizontal arrow with given "indent" # \REC{name}{n} set a self-recursion arrow # where n is the numbers of calls (empty if no calls) # # Sends result to stdout # X X ($myname = $0) =~ s|(.*/)*||; # strip path component from name $Usage = "Usage: $myname [-s text_size -u unit_length -a arrowsize"; $Usage .= " -D n -l -c -simple -ps -r] ...\n"; X $HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} || X (getpwuid($<))[7] || die "You're homeless!\n"; $USER = $ENV{'USER'} || getlogin || X (getpwuid($<))[0] || die "Your'e nameless!\n"; X @text_sizes = ("auto", "tiny", "scriptsize", "small", "normalsize", X "large", "Large", "LARGE", "Huge"); @ex_heights = (-1, 2.15225, 3.01315, 3.87405, 4.3045, X 5.1654, 6.19847, 7.43707, 10.70938); @em_widths = (-1, 6.8039, 7.97028, 9.24774, 9.99756, X 11.74713, 14.09654, 16.23491, 23.37827); # Set defaults: $psprologue = "/usr/sml/lib/call_graph.pro"; $pagelength = 696; # points $pagewidth = 469; # points $x0 = 62; # X and Y coords of origin (lower left corner) $y0 = 75; $text_size = "auto"; $size = 0; $arrowsize = 5; $unit_length = "1ex"; $landscape = 0; $colour = 0; $simple = 0; $ps = 0; $rounded = 0; $debug = 0; X # read options: while ($ARGV[0] =~ /^-/) { X $opt = shift; X if ($opt eq "-s") { X $text_size = shift; X for ($size = 0; $size <= 9; $size++) { X last if ($text_size eq $text_sizes[$size]); X } X die $Usage unless ($size <= 8); X } elsif ($opt eq "-u") { X $unit_length = shift; X die $Usage unless ($unit_length); X } elsif ($opt eq "-a") { X $arrowsize = shift; X die $Usage unless ($arrowsize =~ /^\d+$/); X } elsif ($opt eq "-D") { X $debug = shift; X die $Usage unless ($debug =~ /^\d+$/); X } elsif ($opt eq "-l") { X $landscape = 1; X } elsif ($opt eq "-c") { X $colour = 1; X } elsif ($opt eq "-simple") { X $simple = 1; X } elsif ($opt eq "-ps") { X $ps = 1; X } elsif ($opt eq "-r") { X $rounded = 1; X } else { X die $Usage; X } } X ($pagelength, $pagewidth) = ($pagewidth, $pagelength) if ($landscape); X if ($colour && $ps) { X $upcol = "1 0 0 setrgbcolor"; X $downcol = "0 1 0 setrgbcolor"; X $reccol = "1 0 1 setrgbcolor"; X $lrcol = "0 0 1 setrgbcolor"; } elsif ($colour && !$ps) { X $upcol = "{red}"; X $downcol = "{green}"; X $reccol = "{magenta}"; X $lrcol = "{blue}"; } else { X $upcol = ""; X $downcol = ""; X $reccol = ""; X $lrcol = ""; } X # Read in the source file, first name is the root of the graph. # Input is one line per procedure, unless brackets are used. # Brackets are optional. # Lines which start with "#" are comments (ignored) X @succs = (); # list of procs called by each proc %calls = (); # $calls{$from,$to} is number of calls @name = (); # name of each proc %no = (); # proc no. of each name X print STDERR "Reading cross reference file...\n"; X $n = 1; while (<>) { X next if (/^#/); X next unless (/:/); X chop; X # If "(" is present, read up to ")": X while (/\(/ && !m/\)/) { X die "No closing bracket found!\n" if eof(); X $_ .= " " . <>; X chop; X } X # remove brackets X s/\(|\)//g; X # Fix LaTeX special characters: X # (unless already fixed) X s/(^|[^\\])([\_\#\$\%\^\&])/$1\\$2/g unless ($ps); X # fix pairs of specials: X s/(^|[^\\])([\_\#\$\%\^\&])/$1\\$2/g unless ($ps); X X next unless (s/^\s*(\S*)\s*:\s*//); X $from = &number("$1"); # also sets $name[] X # If there are no no-of-calls items, add default values (1): X s/\b(\S+)\b/$1 1/g unless (/\b\d+\b/); X @succslist = split; X print STDERR "$from -> @succslist\n" if $debug > 2; X # @succslist is a list of name, no-of-calls pairs. X # check an even no. of entries: X die "Odd number of entries: $_\n" if (($#succslist % 2) == 0); X while ($#succslist >= 0) { X $to = shift(@succslist); X $calls = shift(@succslist); X die "Bad number of calls: `$to' `$calls' `$_'\n" unless ($calls =~ /^\d+$/); X $to = &number("$to"); X $succs[$from] .= "$to " unless ($succs[$from] =~ m/\b$to\b/); X $calls{$from,$to} += $calls; X } } $nodes = $n - 1; X # The nodes are numbered 1..$nodes # $name[], $no{}, $succs[] and $calls{} are set up. # Remove trailing space from each @succs item: chop(@succs); X # If there are >50 nodes, then delete trivial ones: @merged = (); # record which nodes are merged so we don't complain X # if they are now unreachable $merges = 0; if ($nodes > 50) { X &calculate_preds; # $preds[$n] is the list of nodes which call $n X print STDERR "Deleting trivial nodes"; X # Don't merge with node 1: X $i = 2; $j = 0; X while ($i <= $nodes) { X while (($succs[$i] !~ / /) && $succs[$i]) { X # Don't merge a node with >1 predecessor: X last if ($preds[$succs[$i]] =~ / /); X $j++; X print STDERR "."; X # node $i has exactly one successor, so merge the successor with $i: X $isucc = $succs[$i]; X $merged[$isucc] = 1; X $merges++; X $name[$i] .= "; $name[$isucc]"; X $succs[$i] = $succs[$isucc]; X $succs[$isucc] = ""; X $calls{$i,$isucc} = 0; X foreach $isucc2 (split(/ /, $succs[$i])) { X $calls{$i,$isucc2} = $calls{$isucc,$isucc2}; X $calls{$isucc,$isucc2} = 0; X } X } X $i++; $j = 0; X } X print STDERR "\n"; X # Trim extra long names: X foreach $name (@name) { X if (length($name) > 30) { X $name = substr($name,0,18) . "..." . substr($name,-9); X } X } } X if ($merges > 0) { X # Recompute $nodes, $name[], $no{}, $succs[] and $calls{} X # so that all the arrays are smaller: X # $i is old number, $j is new number X @new_name = (); X %new_no = (); X @new_succs = (); X %new_calls = (); X $i = 1; $j = 1; X while ($i <= $nodes) { X $index[$i] = $j; X $new_succs[$j] = $succs[$i]; X $new_name[$j] = $name[$i]; X $i++; $j++; X while (($i <= $nodes) && $merged[$i]) { X $i++; X } X } X $new_nodes = $j - 1; X X print STDERR "$nodes nodes merged down to $new_nodes nodes.\n"; X X # Use $index to compute new $succs[] and $calls{} X foreach $i (1..$nodes) { X ($new_succs[$index[$i]] = $succs[$i]) =~ s/\d+/$index[$&]/ge unless ($merged[$i]); X } X foreach $name (keys(%no)) { X $new_no{$name} = $index[$no{$name}]; X } X foreach $pair (keys(%calls)) { X ($new_pair = $pair) =~ s/\d+/$index[$&]/ge; X $new_calls{$new_pair} = $calls{$pair} if ($calls{$pair} > 0); X } X @name = @new_name; @new_name = (); X %calls = %new_calls; %new_calls = (); X @succs = @new_succs; @new_succs = (); X %no = %new_no; %new_no = (); X @merged = (); } X $nodes = $new_nodes; X if ($debug > 2) { X for ($n = 1; $n <= $nodes; $n++) { X print STDERR "succs[$n] = $succs[$n]\n"; X } } X if (!$simple && ($nodes > 1000)) { X print STDERR "Too many nodes ($nodes) for complex algorithm, switching to simple.\n"; X $simple = 1; } if ($simple) { X &simple_algorithm; } else { X # &add_omega; # add unique exit node and increment $nodes X print STDERR "Calculating preds array...\n"; X &calculate_preds; # $preds[$n] is the list of nodes which call $n X print STDERR "Calculating BFS node list...\n"; X &calculate_BFS_node_list; # Breadth-first-search order list of nodes X print STDERR "Calculating dominator sets...\n"; X &calculate_D; # $D[$n] is the list of nodes dominated by $n X # ie $m is in $D[$n] iff $n appears on every path X # from 1 to $m X print STDERR "Removing back edges...\n"; X &remove_back_edges; # Back edges are edges where $m calls $n and X # $m is in $D[$n]. Remove $m from $preds[$n] X print STDERR "Doing topological sort...\n"; X &topological_sort; # Produce topologically sorted list @L from @preds X print STDERR "Assigning row numbers...\n"; X &calculate_rows; # Produce @rows array from @L X &re_arrange_rows; # Re-arrange elements on each row X # to reduce total arrow length. } X &select_size; X &calculate_arrow_commands; X if ($ps) { X &postscript_output; } else { X &latex_output; } X exit(0); X sub postscript_output { X # Compute the position of each node X # NB we need to compute the arrow commands _before_ we can X # compute the positions -- record the commands in a "generic" format: X # [command, from, to, label, colour, indent] X # (indent is required for the LR command) X # Convert to latex or calculate positions and convert to postscript X # Protect () in @name X X # print prologue: X open(PRO, "$psprologue") || die "Can't open prologue file $psprologue: $!\n"; X while () { X print; X } X close(PRO); X X if ($landscape) { X print <<'END_OF_LANDSCAPE'; gsave clippath pathbbox grestore 4 dict begin /ury exch def /urx exch def /lly exch def /llx exch def %90 rotate llx neg ury neg translate % llx,ury 90 rotate llx neg llx urx sub lly sub translate % llx,lly %90 rotate ury lly sub urx sub ury neg translate % urx,ury %90 rotate ury lly sub urx sub llx urx sub lly sub translate % urx,lly %-90 rotate urx neg lly neg translate % urx,lly %-90 rotate urx neg urx llx sub ury sub translate % urx,ury %-90 rotate llx lly add ury sub urx llx sub ury sub translate % llx,ury %-90 rotate llx lly add ury sub lly neg translate % llx,lly end END_OF_LANDSCAPE X } X print "\n/frame_arc $rounded def\n"; X print "/Times-Roman $ps_size set_text_size\n\n"; X X # Use @rows and @sp to compute the xy coordinates of each node X @x = (); X @y = (); X # $total_height is 8 units per row plus 1 per extra separation: X $dy = $pagelength / ($total_height + 8); X $y = $y0 + $pagelength - (8 * $dy); # y coord of top row X foreach $r (0..$#rows) { X @n = split(/ /, $rows[$r]); # list of nodes on current row X # compute the total size of the nodes on this row: X $node_size = 0; X foreach $node (@n) { X $node_size += &width($node); X } X # Remaining space is distributed equally: X $dx = ($pagewidth - $node_size) / (@n + 1); X # x coordinate of the left edge of first node in row: X $x = $x0 + $dx; X foreach $node (@n) { X $x[$node] = $x + &width($node)/2; X $y[$node] = $y; X $x = $x + &width($node) + $dx; X } X $y = $y - (8 * $dy) - $extra[$r]; X } X X # print rows: X $r = 0; X foreach $row (@rows) { X foreach $node (split(/ /, $row)) { X print &node($node), " N\n"; X } X print "\n"; X } X print "% ARROWS:\n\n"; X X # print arrows: X # Record current colour and label: X $curcol = ""; X $curlabel = ""; X foreach $ar (@ar) { X ($cmd, $from, $to, $calls, $col, $sp) = @$ar; X if ($col ne $curcol) { X $curcol = $col; X print "$col\n"; X } X $calls = "" if ($calls == 1); X if ($calls ne $curlabel) { X $curlabel = $calls; X print "/label ", &ps($calls), " def\n"; X } X if ($cmd eq REC) { X print &node($from), " $cmd\n"; X } elsif (($cmd eq ARC) || ($cmd eq LINE)) { X print &node($from), " ", &node($to), " $cmd\n"; X } elsif ($cmd eq LR) { X print &node($from), " ", &node($to), " $sp $cmd\n"; X } X } X X # finish off: X print "\nshowpage\n"; } X # width of a node: sub width { X my ($node) = @_; X return(length($name[$node]) * $x_unit + 1); } X X # Return a string in PostScript form: sub ps { X my ($str) = @_; X $str =~ s/[\(\)]/\\$&/g; X return("($str)"); } X # Return a PostScript node (contents plus coordinates): sub node { X my ($n) = @_; X return(&ps($name[$n]) . sprintf(" %.3f %.3f", $x[$n], $y[$n])); } X X X # Calculate commands for the arrows # and amount of extra space required for each row. sub calculate_arrow_commands { X @ar = (); # list of arrow commands: [cmd, from, to, label, col, indent] X @sp = (); # extra space for each row X $r = 0; X foreach $row (@rows) { X # used space below each proc on this row (for LR calls): X %indents = (); X $maxsp = 0; X foreach $from (split(/ /, $row)) { X foreach $to (split(/ /, $succs[$from])) { X next unless ($calls{$from,$to} > 0); X $calls = $calls{$from,$to}; X $col = ($rowno[$to] < $rowno[$from]) ? $upcol : $downcol; X if ($from == $to) { X # Simple recursion: X push(@ar, [REC, $from, "", $calls, $reccol, 0]); X } elsif (($rowno[$to] != $rowno[$from]) && ($calls{$to,$from} > 0)) { X # Mutual recursion: X push (@ar, [ARC, $from, $to, $calls, $col, 0]); X } elsif ($rowno[$to] != $rowno[$from]) { X # up/down call, no recursion: X push(@ar, [LINE, $from, $to, $calls, $col, 0]); X } else { X # Horizontal call: X # If not simple, then use \LINE for left-to-right to the next col: X if (!$simple && ($colno[$to] == $colno[$from] + 1)) { X push(@ar, [LINE, $from, $to, $calls, $lrcol, 0]); X } else { X $sp = &getindent($colno[$from], $colno[$to]); X push(@ar, [LR, $from, $to, $calls, $lrcol, $sp]); X $maxsp = $sp if ($sp > $maxsp); X } X } X } X } X $extra[$r++] = $maxsp; X } # next row } X X sub latex_output { X &print_header(); # does a \begingroup X X # print rows: X $r = 0; X foreach $row (@rows) { X print '\ROW{', X join(" ", grep($_ = "\\N\{n$_\}\{$name[$_]\}", split(/ /, $row))), X "}"; X $e = $extra[$r++]; X if ($e > 0) { X print "\\vspace\{$e\\X\}\n"; X } else { X print "\n"; X } X } X print "\\endgroup\n"; X X # print LaTeX commands for arrows: X foreach $ar (@ar) { X ($cmd, $from, $to, $calls, $col, $sp) = @$ar; X $name = "\\$cmd"; X if ($calls > 1) { X $name .= "l"; $col = "{$calls}$col"; X } X $from = "{n$from}"; $to = "{n$to}"; $sp = "{$sp}"; X if ($cmd eq REC) { X print $name, $from, $col, "\n"; X } elsif (($cmd eq ARC) || ($cmd = LINE)) { X print $name, $from, $to, $col, "\n"; X } elsif ($cmd eq LR) { X print $name, $from, $to, $sp, $col, "\n"; X } X } X X # finish off: X print "\\end\{document\}\n"; } X X # Return the number assoc to a given name. Give it number $n # if it doesn't have a number (and increment $n): sub number { X local ($name) = @_; X if ($no{$name} == 0) { X $no{$name} = $n; X $name[$n] = $name; X print STDERR "$n = $name\n" if ($debug > 1); X $n++; X } X return ($no{$name}); } X X # Version from makegraph: # find and return smallest indent value which is unused over whole # range from..to. Record it's destination in the %indents table # Update $maxsp with the largest result returned so far sub getindent { X local ($from, $to) = @_; X $from++; $to++; X local ($res, $i); X local ($source, $dest); X $source = $from; X $dest = $to; X # if $from > $to then swap them: X ($from, $to) = ($to, $from) if ($from > $to); X $res = 2; # smallest indent. resloop: X for (;;) { X # $indents{$res,$i} refers to the space between $i and $i+1: X for $i ($from..$to-1) { X if (($indents{$res,$i} > 0) && ($indents{$res,$i} != $dest)) { X $res += 1; X next resloop; X } X } X last resloop; X } X # record the result ($res): X for ($i = $from; $i < $to; $i++) { X $indents{$res,$i} = $dest; X } X # Use 2\X space between LR lines: X $res = ($res - 1) * 2; X $maxsp = $res if ($res > $maxsp); X return ($res); } X X sub print_header { X print '\documentstyle[a4'; X print 'land' if ($landscape); X print ',sober]{article}', "\n"; X print <<'END'; \makeatletter \input{pstricks}\input{pst-node}\input{pst-beta} \makeatother \setlength{\parskip}{0pt} \setlength{\parindent}{0pt} % The basic unit length: \newlength{\X} X % Set a row of nodes separated by spaces: % Make space=\hss within body of \ROW: {% \makeatletter\catcode`\ \active% \gdef\ROW{\begingroup\obeyspaces\let =\hss\ROW@}% \gdef\ROW@#1{\makebox[\textwidth]{#1}\endgroup}% } X % Set a node in a box: \def\N#1#2{\rnode{#1}{\psframebox{\strut#2}}} %\def\N#1#2{\rnode{#1}{\psframebox{#2}}} X % l forms have a label on the line: X END X if ($colour) { X print <<'END'; % Colour Version: % An up or down straight line: \def\LINE#1#2#3{\ncline[linecolor=#3]{#1}{#2}} \def\LINEl#1#2#3#4{\ncline[linecolor=#4]{#1}{#2}\ncput*{#3}} X % An up or down curved line (mutual recursion): \def\ARC#1#2#3{\ncarc[linecolor=#3]{#1}{#2}} \def\ARCl#1#2#3#4{\ncarc[linecolor=#4]{#1}{#2}\ncput*{#3}} X % A left or right arrow (arrow head in middle of line): \def\LR#1#2#3#4{\ncangle[linecolor=#4, arrows=-, arm=#3\X, angleA=-90, angleB=-90]% X {#1}{#2}\lput{:D}% X {\psline[linestyle=none, arrows=<-](-3\X,0)(1,0)}} \def\LRl#1#2#3#4#5{\ncangle[linecolor=#5, arrows=-, arm=#3\X, angleA=-90, angleB=-90]% X {#1}{#2}\ncput*{#4}\lput{:D}% X {\psline[linestyle=none, arrows=<-](-3\X,0)(1,0)}} X % A recursion arrow: \def\REC#1#2{\ncangles[linecolor=#2, angleA=0, % X armA=2\X, armB=2\X, angleB=90]{#1}{#1}} \def\RECl#1#2#3{\ncangles[linecolor=#3, angleA=0, % X armA=2\X, armB=2\X, angleB=90]{#1}{#1}\ncput*{#2}} X \begin{document} X %%%%%%%%%%%%%%%%%%%%%%%%%%% Customise for size: %%%%%%%%%%%%%%%%%%%%%%% END X X } else { X print <<'END'; % Monochrome version: % An up or down straight line: \def\LINE#1#2{\ncline{#1}{#2}} \def\LINEl#1#2#3{\ncline{#1}{#2}\ncput*{#3}} X % An up or down curved line (mutual recursion): \def\ARC#1#2{\ncarc{#1}{#2}} \def\ARCl#1#2#3{\ncarc{#1}{#2}\ncput*{#3}} X % A left or right arrow (arrow head in middle of line): \def\LR#1#2#3{\ncangle[arrows=-, arm=#3\X, angleA=-90, angleB=-90]% X {#1}{#2}\lput{:D}% X {\psline[linestyle=none, arrows=<-](-3\X,0)(1,0)}} \def\LRl#1#2#3#4{\ncangle[arrows=-, arm=#3\X, angleA=-90, angleB=-90]% X {#1}{#2}\ncput*{#4}\lput{:D}% X {\psline[linestyle=none, arrows=<-](-3\X,0)(1,0)}} X % A recursion arrow: \def\REC#1{\ncangles[angleA=0, % X armA=2\X, armB=2\X, angleB=90]{#1}{#1}} \def\RECl#1#2{\ncangles[angleA=0, % X armA=2\X, armB=2\X, angleB=90]{#1}{#1}\ncput*{#2}} X \begin{document} X %%%%%%%%%%%%%%%%%%%%%%%%%%% Customise for size: %%%%%%%%%%%%%%%%%%%%%%% END X X } X X print "\\$text_size\n"; X print "\\setlength{\\X}{$unit_length}\n"; X #print '\psset{nodesep=0.5\X}', "\n"; X print '\psset{framesep=0.5\X}', "\n"; X print '\psset{arrows=->, linearc=\X, linewidth=0.2\X}', "\n"; X print "\\psset{arrowsize=2pt $arrowsize}\n"; X X print <<'END_OF_HEADER'; \pagestyle{empty} \vspace*{0pt} \begingroup \obeylines\def^^M{\vfill} %%%%%%%%%%%%%%%%%% Newlines and spaces are significant! %%%%%%%%%%%%%%% END_OF_HEADER } X X # Do a breadth-first search from node 1 to produce the layout, # set up array $rows[] with the data, sub simple_algorithm { X @rows = (); # list of procs for each row X @rowno = (); # row no of each proc X @colno = (); # col no of each proc X $row = 0; # row number X $col = 0; # col no for this row X $colwidth = 0;# width of this col X $widest = 0; # width of widest col X X @todo = (1); # Add things calld by these to next row X @next = (); # build up next row here X @done = (); # Mark each proc when done X while (1) { X if ($#todo < 0) { X # start a new line: X last if ($#next < 0); X $row++; @todo = @next; @next = (); $col = 0; X $colwidth = 0; X } X $x = shift(@todo); X next if ($done[$x]); X $rows[$row] .= "$x "; X $rowno[$x] = $row; X $colno[$x] = $col; X $col++; X # push the numbers called by $x$ onto @next: X $done[$x]++; X push (@next, split(/ /, $succs[$x])); X $colwidth += length($name[$x]) + 1; # allow one extra char for the box. X $widest = $colwidth if ($colwidth > $widest); X } X # Remove extra space on each row: X chop(@rows); } X X # Breadth-first-search order list of nodes in @BFS_node_list sub calculate_BFS_node_list { X local (@todo) = (1); X local (@done) = (); X $done[$nodes] = 0; # pre-allocate @done; X local ($x); X @BFS_node_list = (); X while ($#todo >= 0) { X $x = shift(@todo); X next if ($done[$x]); X $done[$x] = 1; X push(@BFS_node_list, $x); X # push the procs called by $x onto @todo: X push(@todo, split(/ /, $succs[$x])); X } X $BFS_node_list = join(" ", @BFS_node_list); X @node_list = (1..$nodes); X $node_list = join(" ", @node_list); X print STDERR "BFS Order: @BFS_node_list\n" if ($debug > 1); } X X # Add unique exit node $nodes+1 called by every "leaf" node (no succs): sub add_omega { X local ($i); X $omega = $nodes + 1; X $succs[$omega] = ""; X $name[$omega] = "*EXIT*"; X $no{"*EXIT*"} = $omega; X for ($i = 1; $i <= $nodes; $i++) { X if ($succs[$i] eq "") { X $succs[$i] = $omega; X $calls{$i,$omega} = 1; X } X } X $nodes++; } X X # calculate $preds[$n], the list of procs which call $n: sub calculate_preds { X local ($j, @suclist); X @preds = (); X for ($i = 1; $i <= $nodes; $i++) { X next unless ($succs[$i]); X @succlist = split(/ /, $succs[$i]); X foreach $j (@succlist) { X # have a call $i -> $j so add $i to $j's preds: X $preds[$j] .= " " if ($preds[$j]); X $preds[$j] .= "$i"; X } X } X for ($i = 2; $i <= $nodes; $i++) { X # Add $omega as a predecessor if there are none X # (an unreachable node): X if ((! $preds[$i]) && ($merged[$i] == 0)) { X warn "$i ($name[$i]) is unreachable!\n"; X $preds[$i] = "$omega"; X $succs[$omega] .= " $i"; X $calls{$omega,$i} = 1; X } X print STDERR "preds[$i] = $preds[$i]\n" if ($debug > 2); X } } X X # Calculate the (sorted) list of dominators $D[n] for each node, ie the nodes # which dominate n (appear on every path from 1 to n). sub calculate_D { X local ($n, $change, $newD, $p); X local (@preds_n, @newD, @Dp, @new); X local ($i, $j); X @D = (); X $D[1] = "1"; X for ($n = 2; $n <= $nodes; $n++) { X $D[$n] = $node_list; X } X $change = 1; X while ($change) { X $change = 0; X foreach $n (@BFS_node_list) { X # skip node 1: X next if ($n == 1); X # add the nodes in $D[$p] (for every pred $p of $n) to $newD: X @preds_n = split(/ /, $preds[$n]); X @newD = split(/ /, $D[shift(@preds_n)]); X foreach $p (@preds_n) { X # remove from @newD the elements not in $D[$p] X @Dp = split(/ /, $D[$p]); X # intersect @newD with @Dp, result to @newD: X @new = (); X while (($#Dp >= 0) && ($#newD >= 0)) { X if ($Dp[0] == $newD[0]) { X push(@new, shift(@newD)); shift(@Dp); X } elsif ($Dp[0] < $newD[0]) { X shift(@Dp); X } else { X shift(@newD); X } X } X @newD = @new; X } X $newD = join(" ", $n, @newD); X if ($newD ne $D[$n]) { X $D[$n] = $newD; X $change = 1; X } X } # next $n in BFS order X } # next while($change) loop X # Finally, calculate %D from @D X # where $D{$n,$m} = 1 iff $m is in $D[$m]: X %D = (); X for ($n = 1; $n <= $nodes; $n++) { X print STDERR "D[$n] = $D[$n]\n" if ($debug > 2); X grep($D{$n,$_} = 1, split(/ /, $D[$n])); X } } X X # Back edges are edges where $m calls $n and $m is in $D[$n]. # Remove $m from $preds[$n] if $n is in $D[$m] sub remove_back_edges { X @orig_preds = @preds; X for $n (@node_list) { X if ($debug > 0) { X for $m (split(/ /, $preds[$n])) { X print STDERR "Back edge: $name[$m] -> $name[$n]\n" if ($D{$m,$n}); X } X } X # Remove preds $m of $n where $n dominates $m: X $preds[$n] = join(" ", grep(!$D{$_,$n}, split(/ /, $preds[$n]))); X } } X X # Produce topologically sorted list @L from @preds sub topological_sort { X local ($p); X local (@todo); # Remaining elements X local (@mins); # list of minimal elements in @todo X local (@numpreds); # Number of predecessors of each @todo element X @L = (); X @todo = @BFS_node_list; X foreach $elt (@todo) { X $numpreds[$elt] = split(/ /, $preds[$elt]); X push(@mins, $elt) if ($numpreds[$elt] == 0); X } X while ($#todo >= 0) { X # Pick an element with the smallest number of predecessors X # and remove it from preds. The edges to this element are X # "retreating" edges X # First check for an element with no preds (fast): X if (@mins) { X $minelt = min(@mins); X @mins = grep { $_ != $minelt } @mins; X $minpreds = 0; X } else { X # there must be a retreating edge, all elements have predecessors. X # Find an element with the smallest number of predecessors X $minpreds = $nodes; # larger than any number of predecessors X foreach $elt (@todo) { X if ($numpreds[$elt] < $minpreds) { X $minpreds = $numpreds[$elt]; $minelt = $elt; X # There won't be any elts with fewer than one predecessor: X last if ($minpreds == 1); X } X } X # Treat $minelt as if it were a real minimal element: X $numpreds[$minelt] = 0; X } X # decrement $numpreds for each sucessor of $minelt X # and update @mins if any element now has no predecessors: X foreach $succ (split(/ /, $succs[$minelt])) { X $numpreds[$succ]--; X push(@mins, $succ) if ($numpreds[$succ] == 0); X } X print STDERR "Retreating Edge(s): @{$preds[$minelt]} -> $minelt\n" X if (($debug > 0) && ($minpreds > 0)); X push (@L, $minelt); X @todo = grep(($_ ne $minelt), @todo); X } # next @todo X print STDERR "Sorted order: @L\n" if ($debug > 2); } X X # Return the smallest element in the given list: sub min { X my (@l) = @_; X my ($min) = shift(@l); X foreach $i (@l) { X $min = $i if ($i < $min); X } X return ($min); } X X # Produce @rows array from @L # Put elements on each row as long as there are no LR arrows # of more than one step and the width is less than $maxcol # Uses %calls sub calculate_rows { X @rowno = (); X @colno = (); X $totalwidth = 0; X $rowno[$L[0]] = 0; $colno[$L[0]] = 0; X $rowno[$L[1]] = 1; $colno[$L[1]] = 0; X $col = 0; $colwidth = 0; X @rows = (shift(@L), shift(@L)); X $i = 1; X grep ($totalwidth += length($_)+1, @name); X $t = int($totalwidth / 20); X $maxcol = 100; X $maxcol = $t if ($t < $maxcol); # max chars per line X $maxcol = 30 if ($maxcol < 30); X $maxcol *= 1.4 if ($landscape); X $widest = 0; # no of characters in widest line X foreach $x (@L) { X # current row must be non-empty here. X # if any calls to/from $x on $rows[$i] then increment $i X # check for an LR call to/from $x to a previous element on X # this row (other than from immediately previous element): X $LR = 0; X @row = split(/ /, $rows[$i]); X foreach $y (@row) { X if (($calls{$x,$y} > 0) X || (($calls{$y,$x} > 0) && ($y != $row[$#row]))) { X $LR = 1; last; X } X } X # Decide whether to start a new row: X if ($LR || (($colwidth + length($name[$x]) + 1) >= $maxcol)) { X # start a new row: X $i++; $col = 0; $colwidth = 0; X $rows[$i] = $x; X } else { X # Add to current row: X $col++; X $rows[$i] .= " $x"; X } X $rowno[$x] = $i; $colno[$x] = $col; X $colwidth += length($name[$x]) + 1; # allow one extra char for the box. X $widest = $colwidth if ($colwidth > $widest); X } # next element X if ($debug > 1) { X print STDERR "Rows:\n"; X foreach (@rows) { X print STDERR "$_\n"; X } X } } X X sub select_size { X # If $size == 0 (auto) then pick largest size which fits X # and set $text_size accordingly. X if ($size == 0) { X $total_height = ($#rows + 1) * 8; # allow 8ex per row X grep($total_height += $_, @extra); X for ($i = 8; $i > 0; $i--) { X if (($ex_heights[$i] * $total_height <= $pagelength) X && ($widest * $em_widths[$i] / 1.4 <= $pagewidth)) { X $size = $i; X last; X } X } X if ($size == 0) { X warn "Diagram may not fit on page!\n" unless ($ps); X $size = 1; X } X $text_size = $text_sizes[$size]; X # text size for postscript output: X $ps_size = 3 * $pagelength / $total_height; X $x_unit = $ps_size/2; # approx width of a character X if ($x_unit * $widest > $pagewidth) { X # Recalculate ps size for wide lines X warn "Landscape mode may be better...\n" unless ($landscape); X $x_unit = $pagewidth / $widest; X $ps_size = $x_unit * 2; X } X $ps_size = 24 if ($ps_size > 24); X if ($ps) { X print STDERR "Size selected=$ps_size, "; X } else { X print STDERR "Size selected=$text_size, "; X } X print STDERR "(h=$total_height, w=$widest, m=$maxcol, tot=$totalwidth)\n"; X } } X # Re-arrange elements on each row to reduce total arrow length: sub re_arrange_rows { X } SHAR_EOF $shar_touch -am 0214173496 'draw-call-graph' && chmod 0700 'draw-call-graph' || $echo 'restore of' 'draw-call-graph' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'draw-call-graph:' 'MD5 check failed' a363165a2fec7c183ba727cc8f02af1e draw-call-graph SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'draw-call-graph'`" test 29973 -eq "$shar_count" || $echo 'draw-call-graph:' 'original size' '29973,' 'current size' "$shar_count!" fi fi # ============= call_graph.pro ============== if test -f 'call_graph.pro' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'call_graph.pro' '(file already exists)' else $echo 'x -' extracting 'call_graph.pro' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'call_graph.pro' && %!PS-Adobe-2.0 %%Pages: atend %%PageOrder: Ascend %%BoundingBox: 0 0 596 842 %%EndComments %%BeginProcSet: call_graph.pro % % Call graph prologue file % X % First define some parameters: %% A4 594 x 846 X /arc_angle 8 def /text_size 10 def /arrow_dim 2 def /arrow_size 3 def /arrow_length 1.4 def /arrow_inset 0.4 def /unit_length 5 def /frame_sep 2.5 def /frame_arc 5 def /line_arc 5 def X % If label is a non-empty string, then use it to label the line/arc etc: /label () def X 1 setlinecap % line cap style (0=butt, 1=round, 2=projecting) X % These are computed from arrow_length: /ar_width 4.4 def /ar_length 6.16 def /ar_inset 2.464 def X /ED { exch def } bind def X X % Set the text size and calculate text height and depth: % stack: font size --> /set_text_size { X dup /text_size ED X exch X findfont exch scalefont setfont X % compute the bounding box for "(" to get the height and depth of a "strut": X newpath 0 0 moveto X (\() true charpath flattenpath pathbbox X % stack contains llx lly urx ury, X % where lly is text depth and ury is text height X /text_height ED pop neg /text_depth ED pop X % Use "0" to get the height and depth of a label: X newpath 0 0 moveto X (0) true charpath flattenpath pathbbox X /label_height ED pop neg /label_depth ED pop X % compute the bounding box for "x" to get unit_length (1ex) X % from the height of "x" (ie ury) X newpath 0 0 moveto X (x) true charpath flattenpath pathbbox % stack: llx lly urx ury X % top of stack is the required unit_length X X dup 2 div /frame_sep ED % frame_sep is unit_length/2 X dup 5 div setlinewidth % line_width is unit_length/5 X dup /line_arc ED % line_arc is unit_length X frame_arc 0 ne { X dup /frame_arc ED % frame_arc is unit_length, if non-zero X } if X 5 /arrow_size ED % arrow_size X X /unit_length ED pop pop pop % stack is empty X % text_vadjust is the distance between the baseline and the midline: X % /text_vadjust = (text_height - text_depth)/2 X text_height text_depth sub 2 div /text_vadjust ED X X % Compute other arrow dimensions from arrow_size: X /ar_width arrow_size currentlinewidth mul arrow_dim add def X /ar_length arrow_length ar_width mul def X /ar_inset arrow_inset ar_length mul def X } def X X % plot a framed box around the given text at the given position % If frame_arc > 0 then the corners are rounded with that radius % stack: (text) x y --> % where (x,y) is to be the midpoint of the box /fbox { X plot_text % stack: frame_width frame_height X % currentpoint is now bottom left corner of box X draw_frame X stroke } def X X % plot contents of label (if any) at given posn: % stack: x y --> /plot_label { X 0 begin X label () eq { X pop pop X } { X /y ED /x ED X label stringwidth pop % stack: width X frame_sep 2 mul add /w ED % stack empty X label_height label_depth add X frame_sep 2 mul add /h ED X % plot a white box, then plot the label: X currentrgbcolor % stack: r g b X 1 setgray X newpath X x w 2 div sub y h 2 div sub moveto % currentpoint = ll X 0 h rlineto X w 0 rlineto X 0 h neg rlineto X closepath X fill X setrgbcolor % stack empty X label x y text_depth label_depth add 2 div sub X plot_text pop pop % throw away the returned width/height X } ifelse X end } def X /plot_label load 0 4 dict put % replace 0 by an anon dict X X % plot the text centered on the given position % and prepare for drawing a rectangular frame or rounded frame % stack: (text) x y --> frame_width frame_height % Current posn is moved to (llx, lly) of text bounding box /plot_text{ X newpath X moveto % stack: (text) X % calculate the width of the text, then move right by width/2 X % and down by text_vadjust, print the text without changing the position. X dup stringwidth pop % stack: (text) width X dup 2 div neg text_vadjust neg rmoveto % stack: (text) width X exch gsave show grestore % stack: width X % current point is now at the start of the text X 0 text_depth neg rmoveto % move to llx lly of text bounding box X frame_sep neg currentlinewidth 2 div sub % calculate drawing adjustment X dup rmoveto % move to bottom left corner of frame X % Now calculate width and height of frame for drawing, stack = width X frame_sep 2 mul add X currentlinewidth add % stack: frame_width X text_depth text_height add X frame_sep 2 mul add X currentlinewidth add % stack: frame_width frame_height X % current point is now at llx lly of required box } def X X % plot a box with bottom left corner at current position, % stack: width height --> /draw_frame { X 0 begin X frame_arc 0 eq { X 2 copy % stack: width height width height X 0 exch rlineto % stack: width height width X 0 rlineto % stack: width height X neg 0 exch rlineto % stack: width X pop X closepath X } { X /w ED /h ED % stack is empty X % move the origin to corner of box and keep on stack: X currentpoint 2 copy translate X % move up to start of first vertical segment X 0 frame_arc moveto X 0 w h w frame_arc arcto pop4 X h w h 0 frame_arc arcto pop4 X h 0 0 0 frame_arc arcto pop4 X 0 0 0 w frame_arc arcto pop4 X closepath X % restore the original origin: X neg exch neg exch translate X } ifelse X end } def X /draw_frame load 0 2 dict put % replace 0 by an anon dict X /pop4 { X pop pop pop pop } def X X % Calculate the size of a box around the given text, including the line width % stack: (text) --> frame_width frame_height /frame_size { X stringwidth pop % stack: width X % calculate the amount to add to both width and height X frame_sep currentlinewidth add 2 mul % stack: width adjustment X add % stack: frame_width X text_depth text_height add % stack: frame_width height X frame_sep currentlinewidth add 2 mul % stack: frame_width height adjustment X add % stack: frame_width frame_height } def X X % Find the intersection point of a line from (0,0) at a given angle % with the frame of a given (external) size, centered at (0,0). % (ie the result is the adjustment to add to the line endpoint % so that it just reaches the frame). % stack: width height theta --> dx dy /frame_line_intersect { X 0 begin X mod360 /theta ED % stack: width height X 2 div /y ED 2 div /x ED % stack empty X /xs 1 def X /ys 1 def X /phi y x atan def % phi = angle of line to (urx, ury) X % determine which quadrant the line is in: X theta 180 ge { % IF theta >= 180 THEN X /ys ys neg def % flip about y axis, ie invert dy X /theta 360 theta sub def % and subtract theta from 360 X } if X theta 90 ge { % IF theta >= 90 THEN X /xs xs neg def % flip about x axis, ie invert x X /theta 180 theta sub def % and subtract theta from 180 X } if X phi theta le { % IF phi <= theta THEN X y theta cos theta sin div mul xs mul X y ys mul X } { X x xs mul X x theta sin theta cos div mul ys mul X } ifelse X end } def X /frame_line_intersect load 0 6 dict put % replace 0 by an anon dict X % Adjust top of stack to range 0..360 (for frame_line_intersect) % stack: theta --> theta mod 360 /mod360 { X { % DO X dup 360 gt { % IF theta > 360 THEN X 360 sub % theta := theta - 360 X } { % ELSE X dup 0 lt { % IF theta < 0 THEN X 360 add % theta := theta + 360 X } { % ELSE X exit % EXIT X } ifelse % FI X } ifelse % FI X } loop % OD } def X X % Calculate the start/end coordinates of a line from: % (foo) x1 y1 % to: % (bar) x2 y2 % stack: str1 x1 y1 str2 x2 y2 --> X1 Y1 X2 Y2 % NB: If either string is empty, then the corresponding coordinates % are not adjusted. /calculate_line_coords { X 0 begin X /y2 ED /x2 ED /str2 ED X /y1 ED /x1 ED /str1 ED X % First calculate the angle theta: (x1, y1) -> (x2, y2) X /theta y2 y1 sub x2 x1 sub atan def X % Check for an empty str1: X str1 () ne { X % Calculate dx1 dy1 from the frame size for str1: X str1 frame_size % stack: width1 height1 X theta X frame_line_intersect % stack: dx1 dy1 X % adjust x1 and y1: X y1 add /y1 ED % stack: dx1 X x1 add /x1 ED % stack empty X } if X str2 () ne { X % For x2 y2, the angle direction must be reversed (add 180 mod 360) X str2 frame_size % stack: width2 height2 X theta 180 add % stack: reversed_theta X frame_line_intersect % stack: dx2 dy2 X % adjust x2 and y2: X y2 add /y2 ED % stack: dx2 X x2 add /x2 ED % stack empty X } if X X % push the result onto the stack: X x1 y1 x2 y2 X end } def X /calculate_line_coords load 0 7 dict put X X % draw a line from x1 y1 to x2 y2 /line { X 0 begin X newpath X /y2 ED /x2 ED X moveto X x2 y2 lineto X stroke X end } def X /line load 0 2 dict put X X % draw a line with an arrow head from x1 y1 to x2 y2 % The basic method: (1) calculate theta, and line length, % (3) translate to x2 y2, (4) rotate coordinates by theta, % (4) draw the line: (-length, 0) to (-(ar_length - ar_inset), 0) % (5) draw an arrow head pointing right to (0,0) % (6) add a label if required /arrow { X 0 begin X /y2 ED /x2 ED X /y1 ED /x1 ED % stack empty X x2 x1 sub dup mul % stack: dx^2 X y2 y1 sub dup mul % stack: dx^2 dy^2 X add sqrt /line_length ED % stack empty X /theta y2 y1 sub x2 x1 sub atan def X % Store the current transformation matrix: X /savematrix matrix currentmatrix def X x2 y2 translate X theta rotate X newpath X line_length neg 0 moveto X ar_length ar_inset sub neg 0 lineto X stroke X arrow_head X savematrix setmatrix X x1 x2 add 2 div y1 y2 add 2 div plot_label X end } def X /arrow load 0 7 dict put X % draw an arrow head pointing right to coordinate (0,0): /arrow_head { X 0 0 moveto X ar_length neg ar_width 2 div lineto X ar_length neg ar_inset add 0 lineto X ar_length neg ar_width 2 div neg lineto X closepath fill } def X X % A "recursion arrow" on a frame -- it comes out of the right % edge, bends around the corner and goes in at the top % with an arrowhead. % The label is half way up the vertical segment (x2, y1) -> (x2 y2) % stack: str x y --> /rec { X 0 begin X /y ED /x ED % stack: str X frame_size 2 copy % stack: width height width height X % Starting angle is 0: X 0 frame_line_intersect % stack: width height dx dy X % Calculate the start point: X y add /y1 ED % stack: width height dx X x add /x1 ED % stack: width height X % Ending angle is 90: X 90 frame_line_intersect % stack: dx dy X % Calculate the end point: X y add /y3 ED X x add /x3 ED % stack empty X % Calculate the coordinates of the upper right control point: X % The arms are unit_length, so add line_arc to get the control point: X x1 unit_length add line_arc add /x2 ED X y3 unit_length add line_arc add /y2 ED X newpath X x1 y1 moveto X x2 y1 x2 y3 line_arc arcto pop4 X x2 y3 x2 y2 line_arc arcto pop4 X x2 y2 x3 y2 line_arc arcto pop4 X x3 y2 x3 y3 line_arc arcto pop4 X currentpoint % stack: x y (for start of arrow) X stroke X % Draw the final arrow (but don't label it!): X x3 y3 unlabelled_arrow % stack empty X x2 y1 y2 add 2 div plot_label X end } def X /rec load 0 9 dict put X X /unlabelled_arrow { X 0 begin X /label () def X arrow X end } def X /unlabelled_arrow load 0 1 dict put X X % draw a curved line with an arrow head from str1 x1 y1 to str2 x2 y2 % The basic method: (1) Calculate the control point of the curve: x3 y3 % (2) Treat as two separate lines, 1 -> 3 and 3 -> 2 % (3) Adjust the end points x1 y1 and x2 y2 % (4) Adjust x2 y2 to shorten the curve by (ar_length - ar_inset) % to give x4 y4 % (5) Use curveto to draw the curve: x1 y1 x3 y3 x3 y3 x4 y4 % (6) Translate to x2 y2, rotate by (theta - arc_angle) and draw arrow_head % (7) Add a label if needed, midway between the control points 3 & 4 % % stack: str1 x1 y1 str2 x2 y2 /curve { X 0 begin X /y2 ED /x2 ED /str2 ED X /y1 ED /x1 ED /str1 ED % stack empty X x2 x1 sub dup mul % stack: dx^2 X y2 y1 sub dup mul % stack: dx^2 dy^2 X add sqrt /line_length ED % stack empty X /theta y2 y1 sub x2 x1 sub atan def X X % Calculate the angles of the two lines: X /theta1 theta arc_angle add def X /theta2 180 theta add arc_angle sub def X X % Calculate x3 y3: X line_length 3 div dup dup dup X theta1 sin mul y1 add /y3 ED X theta1 cos mul x1 add /x3 ED % stack: l/3 l/3 X X % Calculate x4 y4: X theta2 sin mul y2 add /y4 ED X theta2 cos mul x2 add /x4 ED % stack empty X X % Adjust the end points using theta1 and theta2: X str1 frame_size X theta1 frame_line_intersect % stack dx1 dy1 X y1 add /y1 ED X x1 add /x1 ED % stack empty X str2 frame_size X theta2 frame_line_intersect % stack dx2 dy2 X y2 add /y2 ED X x2 add /x2 ED % stack empty X X % We now have all four control points X % Adjust x2 y2 in direction theta2 by (ar_length - ar_inset) X % (to make space for the arrow head): X ar_length ar_inset sub dup X theta2 sin mul y2 add /y5 ED X theta2 cos mul x2 add /x5 ED X X % Draw the curve (at last!) X x1 y1 moveto x3 y3 x4 y4 x5 y5 curveto X stroke X X % translate, rotate and draw the arrow head: X % Store the current transformation matrix: X /savematrix matrix currentmatrix def X x2 y2 translate X theta2 180 add rotate X newpath X arrow_head X savematrix setmatrix X X % Label is midway between points 3 and 4: X x3 x4 add 2 div y3 y4 add 2 div plot_label X end } def X /curve load 0 17 dict put X X % Draw a line with the arrow head in the middle: % stack: x1 y1 x2 y2 /midarrow { X 0 begin X /y2 ED /x2 ED X /y1 ED /x1 ED % stack empty X % compute x3 y3 to be 2/3 along the line: X /x3 x1 x2 2 mul add 3 div def X /y3 y1 y2 2 mul add 3 div def X x1 y1 x2 y2 line X x1 y2 x3 y3 unlabelled_arrow X x1 x2 add 2 div y1 y2 add 2 div plot_label X end } def X /midarrow load 0 6 dict put X X % Draw a U-shaped line: down, along, up % with given amount of space created (in unit_length units) % Add an arrow head two-thirds along the straight bit, % with a label one third along. % NB there is no need to call frame_line_intersect, since the offset % for an angle of 270 degrees is text_vadjust + frame_sep + linewidth % stack: str1 x1 y1 str2 x2 y2 indent /u_shape { X 0 begin X /indent ED X /y2 ED /x2 ED pop X /y1 ED /x1 ED pop % stack empty X % calculate y adjustment: X text_vadjust text_depth add frame_sep add currentlinewidth add dup X y1 exch sub /y1 ED % stack: y-adjustment X y2 exch sub /y2 ED % stack empty X % Compute the control point's y-coordinate: y3 X y1 y2 min indent unit_length mul sub line_arc sub /y3 ED X % draw the shape X x1 y1 moveto X x1 y3 x2 y3 line_arc arcto pop4 X x2 y3 x2 y2 line_arc arcto pop4 X x2 y2 lineto X stroke X % draw the arrow plus label: X x1 line_arc add y3 X x1 x2 2 mul add 3 div y3 arrow X end } def X /u_shape load 0 6 dict put X X % Compute the midpoint of a line segment: % stack: x1 y1 x2 y2 --> xm ym /midpoint { X 0 begin X /y2 ED /x2 ED X /y1 ED /x1 ED % stack empty X % compute the midpoint: X x1 x2 add 2 div X y1 y2 add 2 div X end } def X /midpoint load 0 4 dict put X X % atan takes a num and den and returns an angle, % tan returns sin(a) cos(a): /tan { X dup sin exch cos } def X X % A useful test routine to find out where you are: % draw crosshairs at the current point /cross { X gsave X 0 setlinewidth X 0 20 rmoveto X 0 -40 rlineto X -20 20 rmoveto X 40 0 rlineto X -20 0 rmoveto X currentpoint 10 0 360 arc X stroke X grestore } def X % Return the min of two numbers: % a b --> min(a,b) /min { X 2 copy lt { X pop X } { X exch pop X } ifelse } def X X X % plot the text at currentpoint, draw a box around it, record % the coords of the lower middle point in itemB % the coord of the right middle point in itemR % stack: str --> /ANNOTATE { X 0 begin X currentpoint % stack: str x1 y1 X /y1 ED /x1 ED X dup stringwidth pop % stack: str width X x1 add /x2 ED % stack: str X % Compute the midpoint of the box: X x1 x2 add 2 div % stack: str xm X y1 text_vadjust add % stack: str xm ym X fbox % stack empty X % calculate and record the nodes: X node_dict begin X /itemR [ x2 frame_sep add X y1 text_vadjust add ] def X /itemB [ x1 x2 add 2 div X y1 text_depth sub frame_sep sub ] def X end X x2 y1 moveto X end } def X /ANNOTATE load 0 4 dict put X /HIGHLIGHT { ANNOTATE } def X X % move to beginning of line, save the node and plot the text: % stack: ypos node str /ASSEM { X 0 begin X /str ED /node ED /ypos ED % stack empty X % Calculate starting point: X [ x0 frame_sep sub y0 ypos vstep mul sub ] % stack: [x y] X node_dict begin X aload node ED % stack: x y X end X moveto % stack empty X str show X end } def X /ASSEM load 0 4 dict put X X % Plot the text in the right margin, with a box around it % and an arrow to the ANNOTATE node % stack: ypos str /TEXT { X 0 begin X /str ED /ypos ED % stack empty X % switch to slanted font: X slanted setfont X str dup stringwidth pop /width ED % stack: str X % calculate the centre of the box: X xrm width 2 div sub % stack: str x X y0 ypos vstep mul sub X text_vadjust add % stack: str x y X dup /y ED % stack: str x y X gsave fbox grestore % stack empty X % switch back to Courier: X courier setfont X % Set up for a dotted line: X [ currentlinewidth currentlinewidth 6 mul] 0 setdash X % move to the start point: X xrm width sub frame_sep sub currentlinewidth sub y X moveto % stack empty X expanded { % IF expanded THEN X node_dict begin X itemB aload pop % stack: x2 y2 X pop y % stack: x2 y X 2 copy lineto stroke % stack: x2 y X itemB aload pop % stack: x2 y x2 y2 X end X arrow X } { % ELSE X currentpoint % stack: x1 y1 X node_dict begin X itemR aload pop % stack: x1 y1 x2 y2 X end X arrow X } ifelse % FI X % restore solid lines: X [ ] 0 setdash X end } def X /TEXT load 0 4 dict put X X % draw an up/down arrow from the given nodes with given (left) indent: % stack: indent from to /UD { X 0 begin X node_dict exch get % stack: indent from [x2 y2] X aload pop % stack: indent from x2 y2 X text_vadjust add /y2 ED /x2 ED % stack: indent from X node_dict exch get % stack: indent [x1 y1] X aload pop % stack: indent x1 y1 X text_vadjust add /y1 ED /x1 ED % stack: indent X /indent ED % stack empty X % set up dashed line: X [ indent indent ] 0 setdash X % compute the control points: X /x3 x1 x2 min indent indent_step mul sub def X % draw the curve: X x1 y1 moveto X x3 y1 x3 y2 line_arc arcto pop4 X x3 y2 x2 y2 line_arc arcto pop4 X x2 y2 lineto stroke X % compute the position of the arrow head, and plot it: X x3 y1 y2 add 2 div ar_length 2 div % stack: x3 y4 a_l/2 X y1 y2 lt { X add X gsave X translate % stack empty X 90 rotate arrow_head X grestore X } { X gsave X translate % stack empty X -90 rotate arrow_head X grestore X } ifelse X end } def X /UD load 0 6 dict put X X X /STARTPIC { X /Courier 6.166667 set_text_size X /Helvetica-Oblique findfont text_size scalefont /slanted ED X /Courier findfont text_size scalefont /courier ED X /vstep 8.5 def X /indent_step 8.5 def X % x0 y0 is the position for the first ASSEM line: X /x0 127.5 def X /y0 vstep 94 mul def X /xrm 570 def % x coord of the right margin X /expanded true def % TEXT puts the annotation on the next line X % (which will be left blank on purpose) X /label () def % no labels on arrows X % Clear node dictionary -- holds first, last, itemR, itemB, Nnnn etc. X /node_dict 500 dict def X % save first and last nodes in node_dict: X node_dict begin X /first [ x0 frame_sep sub y0 vstep 2 mul add ] def X /last [ x0 frame_sep sub y0 vstep 94 mul sub ] def X end } def X /ENDPIC { X showpage } def X X % PostScript page header stuff: /Helvetica-Oblique findfont 10 scalefont /lhead_font ED /Courier findfont 10 scalefont /chead_font ED /Times-Roman findfont 10 scalefont /rhead_font ED X % stack: str --> /lhead { X gsave X x0 y0 vstep 2 mul add moveto X lhead_font setfont X show X x0 y0 vstep 2 mul add vstep 2 div sub moveto X 0.4 setlinewidth X xrm x0 sub 0 rlineto stroke X grestore } def X % stack: str --> /chead { X gsave X x0 xrm add 2 div y0 vstep 2 mul add moveto X chead_font setfont X dup stringwidth pop 2 div neg 0 rmoveto show X grestore } def X X % stack: str --> /rhead { X gsave X xrm y0 vstep 2 mul add moveto X rhead_font setfont X dup stringwidth pop neg 0 rmoveto show X grestore } def X X %%EndProcSet %%EndProlog %%BeginSetup %%Feature: *Resolution 300dpi %%PaperSize: a4 X %%EndSetup X %%% High level interface for makepict (call graph plotter) %%% -- short names to reduce ps file size! X /LINE { calculate_line_coords arrow } def /ARC { curve } def /REC { rec } def /N { fbox } def /LR { u_shape } def X X SHAR_EOF $shar_touch -am 0212175996 'call_graph.pro' && chmod 0600 'call_graph.pro' || $echo 'restore of' 'call_graph.pro' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'call_graph.pro:' 'MD5 check failed' 20d02649bfb69748b9d9a5baeb2f5a7a call_graph.pro SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'call_graph.pro'`" test 21026 -eq "$shar_count" || $echo 'call_graph.pro:' 'original size' '21026,' 'current size' "$shar_count!" fi fi # ============= cg-small ============== if test -f 'cg-small' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'cg-small' '(file already exists)' else $echo 'x -' extracting 'cg-small' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'cg-small' && A: A 2 B 3 Z 4 B: A 5 Z 1 Z: SHAR_EOF $shar_touch -am 0208154896 'cg-small' && chmod 0600 'cg-small' || $echo 'restore of' 'cg-small' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'cg-small:' 'MD5 check failed' 1dbe0449144f6378febae32127123ca9 cg-small SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'cg-small'`" test 29 -eq "$shar_count" || $echo 'cg-small:' 'original size' '29,' 'current size' "$shar_count!" fi fi # ============= cg-big ============== if test -f 'cg-big' && test "$first_param" != -c; then $echo 'x -' SKIPPING 'cg-big' '(file already exists)' else $echo 'x -' extracting 'cg-big' '(text)' sed 's/^X//' << 'SHAR_EOF' > 'cg-big' && (ABC : ) (ABC : g148 1) (g148 : g149 1) (g149 : g150 1) (g150 : g151 1) (g151 : g152 1) (g152 : g153 1) (g153 : g154 1) (g154 : g155 1) (g155 : g156 1) (g156 : g157 1) (g157 : g158 1) (g158 : g159 1) (g159 : g160 1) (g160 : g161 1) (g161 : g162 1) (g162 : g163 1) (g163 : g164 1) (g164 : g165 1) (g165 : g166 1) (g166 : g167 1) (SCV : ) (PJJ : ) (g167 : g168 1) (g168 : g169 1) (g169 : g170 1) (g170 : g171 1) (g171 : g172 1) (g172 : g173 1) (g173 : g174 1) (g174 : g175 1) (g175 : g176 1) (g176 : g177 1) (g177 : g178 1) (g178 : g179 1) (g179 : g180 1) (g180 : g181 1) (g181 : g182 1) (g182 : g183 1) (g183 : g184 1) (g184 : g185 1) (g185 : g186 1) (g186 : g187 1) (g187 : g188 1) (g188 : g189 1) (g189 : LABEL1 1 g190 1) (g190 : g191 1) (g191 : g192 1) (g192 : g193 1) (LABEL1 : g193 1) (LABEL2 : g193 1) (LABEL3 : g193 1) (LABEL4 : g193 1) (LABEL5 : g193 1) (LABEL6 : g193 1) (g193 : g194 1 g195 1) (g194 : LABEL2 1 g196 1) (g196 : g195 1) (g195 : g197 1 g198 1) (g197 : LABEL3 1 g199 1) (g199 : g198 1) (g198 : g200 1) (g200 : g201 1 g202 1) (g201 : g203 1) (g203 : g202 1) (g202 : g204 1) (g204 : g205 1 g206 1) (g205 : g207 1) (g207 : g206 1) (g206 : g208 1) (g208 : g209 1 g210 1) (g209 : g211 1) (g211 : g210 1) (g210 : g212 1) (g212 : g214 1 g213 1 g215 1) (g214 : LABEL1 1 g216 1) (g216 : g213 1) (g215 : g217 1 g213 1 g218 1) (g217 : LABEL2 1 g219 1) (g219 : g213 1) (g218 : g220 1 g213 1 g221 1) (g220 : LABEL3 1 g222 1) (g222 : g213 1) (g221 : g223 1 g213 1 g224 1) (g223 : LABEL4 1 g225 1) (g225 : g213 1) (g213 : g224 1) (g224 : g226 1) (g226 : g227 1 g228 1) (g227 : g229 1 g230 1) (g229 : g231 1 g232 1) (g231 : g233 1) (g233 : g232 1) (g232 : g234 1) (g234 : g230 1) (g230 : g228 1) (g228 : g235 1) (g235 : FORLA101 1) (FORLA101 : g236 1 g237 1) (g236 : LABEL1 1 g238 1) (g238 : g237 1) (g237 : g239 1 g240 1) (g239 : LABEL1 1 g241 1) (g241 : g240 1) (g240 : g242 1 g243 1) (g242 : LABEL1 1 g244 1) (g244 : g243 1) (g243 : FORTA101 1) (FORTA101 : FOREA101 1) (FOREA101 : g245 1) (g245 : FORLA102 1) (FORLA102 : g246 1 g247 1) (g246 : g248 1) (g248 : g247 1) (g247 : FORTA102 1) (FORTA102 : FOREA102 1 FORLA102 1) (FOREA102 : g249 1) (g249 : FORLA103 1) (FORLA103 : g250 1 g251 1) (g250 : FOREA103 1 g252 1) (g252 : g251 1) (g251 : g253 1 g254 1) (g253 : FORTA103 1 g255 1) (g255 : g254 1) (g254 : g256 1) (g256 : FORTA103 1) (FORTA103 : FORLA103 1) (FOREA103 : g257 1) (g257 : FORLA104 1) (FORLA104 : g258 1) (g258 : FORTA104 1) (FORTA104 : FOREA104 1 FORLA104 1) (FOREA104 : g259 1) (g259 : FORLA105 1) (FORLA105 : FORLB105 1) (FORLB105 : FORLC105 1) (FORLC105 : g262 1) (g262 : g263 1) (g263 : g264 1) (g264 : g265 1) (g265 : g266 1) (g266 : g267 1) (g267 : g260 1 g261 1) (g260 : g268 1) (g268 : g261 1) (g261 : FORTB105 1 g269 1) (g269 : FORTC105 1) (FORTC105 : FOREC105 1) (FOREC105 : FORTB105 1) (FORTB105 : FOREB105 1) (FOREB105 : FORTA105 1) (FORTA105 : FOREA105 1 FORLA105 1) (FOREA105 : g270 1) (g270 : FORLA106 1) (FORLA106 : g271 1) (g271 : FORLB106 1) (FORLB106 : g272 1 g273 1) (g272 : g274 1) (g274 : FOREB106 1 g275 1) (g275 : g273 1) (g273 : FORTB106 1) (FORTB106 : FORLB106 1) (FOREB106 : FORTA106 1) (FORTA106 : FOREA106 1) (FOREA106 : g276 1) (g276 : FORLA107 1) (FORLA107 : FORTA107 1 FOREA107 1) (g277 : FORTA107 1) (FORTA107 : FOREA107 1 FORLA107 1) (FOREA107 : g278 1) (g278 : g279 1) (g279 : FORLA108 1) (FORLA108 : FORLB108 1) (FORLB108 : g280 1 g281 1) (g280 : g282 1) (g282 : FORTA108 1 g283 1) (g283 : g281 1) (g281 : FORTB108 1) (FORTB108 : FOREB108 1 FORLB108 1) (FOREB108 : FORTA108 1) (FORTA108 : FOREA108 1 FORLA108 1) (FOREA108 : g284 1) (g284 : g285 1) (g285 : g286 1) (g286 : g287 1) (g287 : g288 1) (g288 : g289 1) (g289 : g290 1) (g290 : g291 1) (g291 : g292 1) (g292 : g293 1) (g293 : CCPROC 1 g294 1) (g294 : g295 1) (g295 : SCV 1 g296 1) (g296 : PJJ 1 g297 1) (g297 : g298 1) (g298 : g299 1) (g299 : g300 1) (g300 : g301 1) (g301 : g302 1) (g302 : g303 1) (g303 : g304 1) (g304 : g305 1) (g305 : g306 1) (g306 : g307 1) (g307 : g308 1) (g308 : g309 1) (g309 : g310 1) (g310 : g311 1) (g311 : g312 1) (g313 : Z 1) (g312 : g321 1) (g321 : g322 1) (g322 : g323 1) (g323 : g324 1) (g324 : g325 1) (g325 : g326 1) (g326 : g327 1 g328 1) (g327 : CHECK 1 g329 1) (g329 : g328 1) (g328 : ENDWS 1 g330 1) (CHECK : AA 1 BB 1 CC 1) (AA : g330 1) (g330 : g331 1) (BB : g331 1) (g331 : g332 1) (CC : g332 1) (g332 : g333 1) (ENDWS : g333 1) (g333 : SWIT2 1 g334 1) (g334 : END2 1 g335 1) (SWIT2 : LAB1 1 LAB2 1 LAB4 1) (LAB1 : g335 1) (g335 : g336 1) (LAB2 : g336 1) (g336 : g337 1) (LAB4 : g337 1) (g337 : g338 1) (END2 : g338 1) (g338 : g339 1) (g339 : Z 1 g340 1) (g340 : g341 1) (CCPROC : g342 1) (g342 : ) (g341 : Z 1) SHAR_EOF $shar_touch -am 0207173496 'cg-big' && chmod 0600 'cg-big' || $echo 'restore of' 'cg-big' 'failed' if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \ && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then md5sum -c << SHAR_EOF >/dev/null 2>&1 \ || $echo 'cg-big:' 'MD5 check failed' 11fd507795af9d6513d203befa86ca21 cg-big SHAR_EOF else shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'cg-big'`" test 4912 -eq "$shar_count" || $echo 'cg-big:' 'original size' '4912,' 'current size' "$shar_count!" fi fi rm -fr _sh19664 exit 0 ------- end -------