summaryrefslogtreecommitdiff
path: root/ghc/utils
diff options
context:
space:
mode:
authorpartain <unknown>1996-07-25 21:33:42 +0000
committerpartain <unknown>1996-07-25 21:33:42 +0000
commit5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d (patch)
treeadb07110e00f00b2b2ef6365e16d5f58b260ce3c /ghc/utils
parentf7ecf7234c224489be8a5e63fced903b655d92ee (diff)
downloadhaskell-5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d.tar.gz
[project @ 1996-07-25 20:43:49 by partain]
Bulk of final changes for 2.01
Diffstat (limited to 'ghc/utils')
-rw-r--r--ghc/utils/Jmakefile5
-rw-r--r--ghc/utils/hp2ps/TraceElement.h2
-rw-r--r--ghc/utils/hstags/README4
-rw-r--r--ghc/utils/mkdependHS/mkdependHS.prl120
-rw-r--r--ghc/utils/parallel/AVG.pl108
-rw-r--r--ghc/utils/parallel/GrAnSim.el432
-rw-r--r--ghc/utils/parallel/Jmakefile62
-rw-r--r--ghc/utils/parallel/RTS2gran.pl684
-rw-r--r--ghc/utils/parallel/SN.pl280
-rw-r--r--ghc/utils/parallel/SPLIT.pl379
-rw-r--r--ghc/utils/parallel/aux.pl89
-rw-r--r--ghc/utils/parallel/avg-RTS.pl15
-rw-r--r--ghc/utils/parallel/get_SN.pl40
-rw-r--r--ghc/utils/parallel/gp-ext-imp.pl86
-rw-r--r--ghc/utils/parallel/gr2RTS.pl138
-rw-r--r--ghc/utils/parallel/gr2ap.bash124
-rw-r--r--ghc/utils/parallel/gr2gran.bash113
-rw-r--r--ghc/utils/parallel/gr2java.pl322
-rw-r--r--ghc/utils/parallel/gr2jv.bash123
-rw-r--r--ghc/utils/parallel/gr2pe.pl1434
-rw-r--r--ghc/utils/parallel/gr2ps.bash135
-rw-r--r--ghc/utils/parallel/gr2qp.pl290
-rw-r--r--ghc/utils/parallel/gran-extr.pl2114
-rw-r--r--ghc/utils/parallel/grs2gr.pl9
-rw-r--r--ghc/utils/parallel/ps-scale-y.pl188
-rw-r--r--ghc/utils/parallel/qp2ap.pl495
-rw-r--r--ghc/utils/parallel/qp2ps.pl687
-rw-r--r--ghc/utils/parallel/sn_filter.pl92
-rw-r--r--ghc/utils/parallel/stats.pl168
-rw-r--r--ghc/utils/parallel/template.pl141
-rw-r--r--ghc/utils/parallel/tf.pl148
-rw-r--r--ghc/utils/pvm/README3
32 files changed, 8635 insertions, 395 deletions
diff --git a/ghc/utils/Jmakefile b/ghc/utils/Jmakefile
index ab32c2b229..eac3396d58 100644
--- a/ghc/utils/Jmakefile
+++ b/ghc/utils/Jmakefile
@@ -2,13 +2,16 @@
SUBDIRS = hp2ps \
hscpp \
- hstags \
mkdependHS \
parallel \
stat2resid \
ugen \
unlit
+/* hstags
+ not ready to go for 2.01
+*/
+
/* "heap-view" is not in the list because (a) it requires
a Haskell compiler (which you may not have yet), and (b) you are
unlikely to want it desperately. It is easy to build once you have
diff --git a/ghc/utils/hp2ps/TraceElement.h b/ghc/utils/hp2ps/TraceElement.h
index 03b151cc41..d843392a23 100644
--- a/ghc/utils/hp2ps/TraceElement.h
+++ b/ghc/utils/hp2ps/TraceElement.h
@@ -1,6 +1,6 @@
#ifndef TRACE_ELEMENT_H
#define TRACE_ELEMENT_H
-TraceElement PROTO((void));
+void TraceElement PROTO((void));
#endif /* TRACE_ELEMENT_H */
diff --git a/ghc/utils/hstags/README b/ghc/utils/hstags/README
index 388a8e869b..b457ef125a 100644
--- a/ghc/utils/hstags/README
+++ b/ghc/utils/hstags/README
@@ -3,8 +3,8 @@ files for Glasgow-Haskell-compilable programs. (It is "sophisticated"
only in that it uses the GHC parser to find "interesting" things in
the source files.)
+With GHC 2.01: doesn't work yet.
+
A simpler alternative is Denis Howe's "fptags" script, which is
distributed in the ghc/CONTRIB directory.
-Will Partain
-Sept 1994
diff --git a/ghc/utils/mkdependHS/mkdependHS.prl b/ghc/utils/mkdependHS/mkdependHS.prl
index c216394416..46047e1633 100644
--- a/ghc/utils/mkdependHS/mkdependHS.prl
+++ b/ghc/utils/mkdependHS/mkdependHS.prl
@@ -83,15 +83,15 @@ if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables
} else {
$TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'};
- if ( '$(INSTLIBDIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
+ if ('$(INSTLIBDIR_GHC)' =~ /.*(\/lib\/ghc\/\d\.\d\d\/[^-]-[^-]-[^-]\/.*)/) {
$InstLibDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
} else {
print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTLIBDIR_GHC).\n(Installation error)\n";
exit(1);
}
- if ( '$(INSTDATADIR_GHC)' =~ /\/local\/fp(\/.*)/ ) {
- $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $1;
+ if ('$(INSTDATADIR_GHC)' =~ /.*(\/lib\/ghc\/\d\.\d\d\/.*)/) {
+ $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $2;
} else {
print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTDATADIR_GHC).\n(Installation error)\n";
exit(1);
@@ -104,72 +104,27 @@ $Unlit = ( $(INSTALLING) ) ? "$InstLibDirGhc/unlit"
$Begin_magic_str = "# DO NOT DELETE: Beginning of Haskell dependencies\n";
$End_magic_str = "# DO NOT DELETE: End of Haskell dependencies\n";
$Obj_suffix = '.o';
-$ghc_version_info = $(PROJECTVERSION) * 100;
+$ghc_version_info = int ( $(PROJECTVERSION) * 100 );
$Import_dirs = '.';
%Syslibs = ();
+%LibIfaces = (); # known prelude/syslib ifaces; read from a file
%IgnoreMe = ();
-%PreludeIfaces = ( 'Prelude', '1',
- , 'Array', '1'
- , 'Char', '1'
- , 'Complex', '1'
- , 'Directory', '1'
- , 'IO', '1'
- , 'Ix', '1'
- , 'List', '1'
- , 'Maybe', '1'
- , 'Monad', '1'
- , 'Ratio', '1'
- , 'System', '1'
- , 'PreludeGlaST', '1'
- , 'PreludeGlaMisc','1'
- , 'Concurrent', '1'
- , 'Parallel', '1');
-%GhcLibIfaces = ( 'Bag', '1',
- 'BitSet', '1',
- # CharSeq not supposed to be used by user (I think. WDP)
- 'FiniteMap', '1',
- 'ListSetOps', '1',
- 'Maybes', '1',
- 'PackedString', '1',
- 'Regex', '1',
- 'MatchPS', '1',
- 'Readline', '1',
- 'Socket', '1',
- 'SocketPrim', '1',
- 'BSD', '1',
- 'Pretty', '1',
- 'Set', '1',
- 'Util', '1' );
-%HbcLibIfaces = ( 'Algebra', '1',
- 'Hash', '1',
- 'ListUtil', '1',
- 'Miranda', '1',
- 'NameSupply', '1',
- 'Native', '1',
- 'Number', '1',
- 'Parse', '1',
- 'Pretty', '1',
- 'Printf', '1',
- 'QSort', '1',
- 'Random', '1',
- 'SimpleLex', '1',
- 'Time', '1',
- 'Trace', '1',
- 'Word', '1' );
-%IO13Ifaces = ( 'LibSystem', '1',
- 'LibCPUTime', '1',
- 'LibDirectory', '1',
- 'LibPosix', '1',
- 'LibTime', '1' );
-
-$Haskell_1 = 2; # assume Haskell 1.2, still. Changed by -fhaskell-1.3
+
+$Haskell_1 = 3; # assume Haskell 1.3. Changed by -fhaskell-1.?
$Include_dirs = '-I.';
$Makefile = '';
@Src_files = ();
&mangle_command_line_args();
+# load up LibIfaces tables:
+&read_MODULES('prelude', 'prelude');
+foreach $lib ( @Syslibs ) {
+ &read_MODULES('syslib', $lib);
+}
+#print STDERR "libs provide:",(keys %LibIfaces),"\n";
+
if ( $Status ) {
print stderr $Usage;
exit(1);
@@ -206,7 +161,7 @@ foreach $sf (@Src_files) {
# builds up @Depend_lines
print STDERR "Here we go for source file: $sf\n" if $Verbose;
($bf = $sf) =~ s/\.l?hs$//;
- push(@Depend_lines, "$bf$Obj_suffix : $sf\n");
+ push(@Depend_lines, "$bf$Obj_suffix $bf.hi : $sf\n");
foreach $suff (@File_suffix) {
push(@Depend_lines, "$bf$suff$Obj_suffix : $sf\n");
}
@@ -297,6 +252,31 @@ sub mangle_command_line_args {
@File_suffix = sort (@File_suffix);
}
+sub read_MODULES {
+ local($flavor,$lib) = @_;
+
+ local($m_dir) = '';
+ if ($flavor eq 'prelude') {
+ $m_dir = ( $(INSTALLING) ) ? "$InstDataDirGhc/imports" : "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)";
+ } else {
+ $m_dir = ( $(INSTALLING) ) ? "$InstSysLibDir/$lib" : "$TopPwd/hslibs/$lib";
+ }
+ local($m_file) = "$m_dir/MODULES";
+
+ open(MFILE, "< $m_file") || die "$Pgm: can't open $m_file to read\n";
+ while (<MFILE>) {
+ chop;
+ # strip comments and leading/trailing whitespace
+ s/#.*//;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^$/; # nothing left!
+
+ $LibIfaces{"$lib:$_"} = 1; # record that this library provides this iface
+ }
+ close(MFILE);
+}
+
sub grab_arg_arg {
local($option, $rest_of_arg) = @_;
@@ -351,9 +331,9 @@ sub slurp_file_for_imports {
|| die "$Pgm: Can't open $file_to_read: $!\n";
while (<SRCFILE>) {
- next unless (/^>?\s*(import)\s+([A-Z][A-Za-z0-9_']*)/ || /^!(include)\s+"(\S+)"/);
+ next unless (/^>?\s*(import)(\s+qualified)?\s+([A-Z][A-Za-z0-9_']*)/ || /^!(include)(\s+)"(\S+)"/);
$todo = $1;
- $modname = $2;
+ $modname = $3;
if ($todo eq 'import') {
if ( $IgnoreMe{$modname} eq 'y' ) {
@@ -462,24 +442,14 @@ sub find_in_Import_dirs {
print STDERR "trying... $name_to_check\n" if $Verbose >= 2; # very verbose
return($name_to_check) if -f $name_to_check;
}
+
# OK, maybe it's referring to something in a system library
foreach $lib ( @Syslibs ) {
- if ( $lib eq 'ghc' ) {
- return('__ignore__') if $GhcLibIfaces{$modname};
- } elsif ( $lib eq 'hbc' ) {
- return('__ignore__') if $HbcLibIfaces{$modname};
- } else {
- die "Unrecognised syslib: $lib\n";
- }
- }
-
- # Might be a Haskell 1.3 Module (but only if we've said -fhaskell-1.3)
- if ( $Haskell_1 >= 3 ) {
- return('__ignore__') if $IO13Ifaces{$modname};
+ return('__ignore__') if $LibIfaces{"$lib:$modname"};
}
# Last hope: referring to a Prelude interface
- return('__ignore__') if $PreludeIfaces{$modname};
+ return('__ignore__') if $LibIfaces{"prelude:$modname"};
die "No file `$modname.hi', `$modname.lhs' or `$modname.hs' (reqd from file `$orig_src_file')\namong import directories:\n\t$Import_dirs\n";
}
diff --git a/ghc/utils/parallel/AVG.pl b/ghc/utils/parallel/AVG.pl
new file mode 100644
index 0000000000..9ec42aee2f
--- /dev/null
+++ b/ghc/utils/parallel/AVG.pl
@@ -0,0 +1,108 @@
+#!/usr/local/bin/perl
+# (C) Hans Wolfgang Loidl, October 1995
+#############################################################################
+# Time-stamp: <Thu Oct 26 1995 18:30:54 Stardate: [-31]6498.64 hwloidl>
+#
+# Usage: AVG [options] <gr-file>
+#
+# A quich hack to get avg runtimes of different spark sites. Similar to SPLIT.
+#
+# Options:
+# -s <list> ... a perl list of spark names; the given <gr-file> is scanned
+# for each given name in turn and granularity graphs are
+# generated for each of these sparks
+# -O ... use gr2RTS and RTS2gran instead of gran-extr;
+# this generates fewer output files (only granularity graphs)
+# but should be faster and far less memory consuming
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+#############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvOs:');
+
+do process_options();
+
+if ( $opt_v ) { do print_verbose_message(); }
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+foreach $s (@sparks) {
+ # extract END events for this spark-site
+ open (GET,"cat $input | tf -s $s | avg-RTS") || die "!$\n";
+}
+
+exit 0;
+
+exit 0;
+
+# -----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $opt_s ) {
+ $opt_s =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $opt_s);
+ } else {
+ @sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
+ }
+
+ if ( $#ARGV != 0 ) {
+ print "Usage: $0 [options] <gr-file>\n;";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $gr_file = $ARGV[0];
+ ($basename = $gr_file) =~ s/\.gr//;
+ $rts_file = $basename . ".rts"; # "RTS";
+ $gran_file = "g.ps"; # $basename . ".ps";
+ #$rts_file = $gr_file;
+ #$rts_file =~ s/\.gr/.rts/g;
+
+ if ( $opt_o ) {
+ $va_file = $opt_o;
+ $va_dvi_file = $va_file;
+ $va_dvi_file =~ s/\.tex/.dvi/g;
+ $va_ps_file = $va_file;
+ $va_ps_file =~ s/\.tex/.ps/g;
+ } else {
+ $va_file = "va.tex";
+ $va_dvi_file = "va.dvi";
+ $va_ps_file = "va.ps";
+ }
+
+ if ( $opt_t ) {
+ $template_file = $opt_t;
+ } else {
+ $template_file = "TEMPL";
+ }
+
+ $tmp_file = ",t";
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_verbose_message {
+ print "Sparks: (" . join(',',@sparks) . ")\n";
+ print "Files: .gr " . $gr_file . " template " . $template_file .
+ " va " . $va_file . "\n";
+}
+
+# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/GrAnSim.el b/ghc/utils/parallel/GrAnSim.el
new file mode 100644
index 0000000000..49330a9749
--- /dev/null
+++ b/ghc/utils/parallel/GrAnSim.el
@@ -0,0 +1,432 @@
+;; ---------------------------------------------------------------------------
+;; Time-stamp: <Tue Jun 11 1996 18:01:28 Stardate: [-31]7643.54 hwloidl>
+;;
+;; Mode for GrAnSim profiles
+;; ---------------------------------------------------------------------------
+
+(defvar gransim-auto-hilit t
+ "Automagically invoke hilit19.")
+
+(defvar grandir (getenv "GRANDIR")
+ "Root of the GrAnSim installation. Executables should be in grandir/bin")
+
+(defvar hwl-hi-node-face 'highlight
+ "Face to be used for specific highlighting of a node")
+
+(defvar hwl-hi-thread-face 'holiday-face
+ "Face to be used for specific highlighting of a thread")
+
+;; ---------------------------------------------------------------------------
+
+(setq exec-path (cons (concat grandir "/bin") exec-path))
+
+;; Requires hilit19 for highlighting parts of a GrAnSim profile
+(cond (window-system
+ (setq hilit-mode-enable-list '(not text-mode)
+ hilit-background-mode 'light
+ hilit-inhibit-hooks nil
+ hilit-inhibit-rebinding nil);
+
+ (require 'hilit19)
+))
+
+
+(setq auto-mode-alist
+ (append '(("\\.gr" . gr-mode))
+ auto-mode-alist))
+
+(defvar gr-mode-map (make-keymap "GrAnSim Profile Mode SetUp")
+ "Keymap for GrAnSim profiles.")
+
+; (fset 'GrAnSim-mode-fiddly gr-mode-map)
+
+;(define-key gr-mode-map [wrap]
+; '("Wrap lines" . hwl-wrap))
+
+;(define-key gr-mode-map [truncate]
+; '("Truncate lines" . hwl-truncate))
+
+;(define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
+
+;(modify-frame-parameters (selected-frame)
+; '((menu-bar-lines . 2)))
+
+;(define-key-after gr-mode-map [menu-bar GrAnSim]
+; '("GrAnSim" . (make-sparse-keymap "GrAnSim")) 'edit)
+
+;(defvar GrAnSim-menu-map (make-sparse-keymap "GrAnSim"))
+
+(define-key gr-mode-map [menu-bar GrAnSim]
+ (cons "GrAnSim" (make-sparse-keymap "GrAnSim"))) ; 'edit)
+
+(define-key gr-mode-map [menu-bar GrAnSim wrap]
+ '("Wrap lines" . hwl-wrap))
+
+(define-key gr-mode-map [menu-bar GrAnSim truncate]
+ '("Truncate lines" . hwl-truncate))
+
+(define-key gr-mode-map [menu-bar GrAnSim toggle-truncate]
+ '("Toggle truncate/wrap" . hwl-toggle-truncate-wrap) )
+
+(define-key gr-mode-map [menu-bar GrAnSim hi-clear]
+ '("Clear highlights" . hwl-hi-clear))
+
+(define-key gr-mode-map [menu-bar GrAnSim hi-thread]
+ '("Highlight specific Thread" . hwl-hi-thread))
+
+(define-key gr-mode-map [menu-bar GrAnSim hi-node]
+ '("Highlight specific Node" . hwl-hi-node))
+
+(define-key gr-mode-map [menu-bar GrAnSim highlight]
+ '("Highlight buffer" . hilit-rehighlight-buffer))
+
+(define-key gr-mode-map [menu-bar GrAnSim narrow-event]
+ '("Narrow to Event" . hwl-narrow-to-event))
+
+(define-key gr-mode-map [menu-bar GrAnSim narrow-thread]
+ '("Narrow to Thread" . hwl-narrow-to-thread))
+
+(define-key gr-mode-map [menu-bar GrAnSim narrow-pe]
+ '("Narrow to PE" . hwl-narrow-to-pe))
+
+
+
+; (define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
+
+
+(defvar gr-mode-hook nil
+ "Invoked in gr mode.")
+
+
+;;; Ensure new buffers won't get this mode if default-major-mode is nil.
+;(put 'gr-mode 'mode-class 'special)
+
+(defun gr-mode ()
+ "Major mode for GrAnSim profiles."
+ (interactive)
+ (kill-all-local-variables)
+ ;(use-local-map gr-mode-map)
+ (use-local-map gr-mode-map) ; This provides the local keymap.
+ (setq major-mode 'gr-mode)
+ (setq mode-name "GrAnSim Profile Mode")
+ (setq local-abbrev-table text-mode-abbrev-table)
+ (set-syntax-table text-mode-syntax-table)
+ (setq truncate-lines t) ; do not wrap lines (truncates END lines!)
+ (auto-save-mode -1)
+ ;(setq buffer-offer-save t)
+ (run-hooks 'gr-mode-hook))
+
+;; same as mh-make-local-vars
+(defun gr-make-local-vars (&rest pairs)
+ ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
+ ;; value.
+ (while pairs
+ (make-variable-buffer-local (car pairs))
+ (set (car pairs) (car (cdr pairs)))
+ (setq pairs (cdr (cdr pairs)))))
+
+;; ----------------------------------------------------------------------
+;; Highlighting stuff (currently either hilit19 or fontlock is used)
+;; ----------------------------------------------------------------------
+
+(hilit-set-mode-patterns
+ 'gr-mode
+ '(;; comments
+ ("--.*$" nil comment)
+ ("\\+\\+.*$" nil comment)
+ ;; hilight important bits in the header
+ ("^Granularity Simulation for \\(.*\\)$" 1 glob-struct)
+ ("^PEs[ \t]+\\([0-9]+\\)" 1 decl)
+ ("^Latency[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Arith[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Branch[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Load[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Store[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Float[ \t]+\\([0-9]+\\)" 1 decl)
+ ("Alloc[ \t]+\\([0-9]+\\)" 1 decl)
+ ;; hilight PE number and time in each line
+ ("^PE[ \t]+\\([0-9]+\\)" 1 glob-struct)
+ (" \\[\\([0-9]+\\)\\]:" 1 define)
+ ;; in this case the events are the keyword
+ ; ("\\(FETCH\\|REPLY\\|RESUME\\|RESUME(Q)\\|SCHEDULE\\|SCHEDULE(Q)\\|BLOCK\\|STEALING\\|STOLEN\\|STOLEN(Q)\\)[ \t]" 1 keyword)
+ ("\\(FETCH\\|BLOCK\\)[ \t]" 1 label)
+ ("\\(REPLY\\|RESUME(Q)\\|SCHEDULE(Q)\\|STOLEN(Q)\\)[ \t]" 1 named-param)
+ ("\\(RESUME\\|SCHEDULE\\|STOLEN\\)[ \t]" 1 msg-quote)
+ ("\\(STEALING\\)[ \t]" 1 keyword)
+ ("\\(START\\|END\\)[ \t]" 1 defun)
+ ("\\(SPARK\\|SPARKAT\\|USED\\|PRUNED\\)[ \t]" 1 crossref)
+ ("\\(EXPORTED\\|ACQUIRED\\)[ \t]" 1 string)
+ ;; especially interesting are END events; hightlight runtime etc
+ (",[ \t]+RT[ \t]+\\([0-9]+\\)" 1 define)
+ ;; currently unused but why not?
+ ("\"" ".*\"" string))
+)
+
+;; --------------------------------------------------------------------------
+;; Own fcts for selective highlighting
+;; --------------------------------------------------------------------------
+
+(defun hwl-hi-node (node)
+ "Highlight node in GrAnSim profile."
+ (interactive "sNode (hex): ")
+ (save-excursion
+ (let* ( (here (point))
+ (len (length node)) )
+ (goto-char (point-min))
+ (while (search-forward node nil t)
+ (let* ( (end (point))
+ (start (- end len)) )
+ (add-text-properties start end `(face ,hwl-hi-node-face))
+ )
+ ) )
+ )
+)
+
+(defun hwl-hi-thread (task)
+ "Highlight task in GrAnSim profile."
+ (interactive "sTask: ")
+ (save-excursion
+ (let* ( (here (point))
+ (len (length task))
+ (se-str (format "[A-Z)]\\s-+%s\\(\\s-\\|,\\)" task))
+ )
+ (goto-char (point-min))
+ (while (re-search-forward se-str nil t)
+ (let ( (c (current-column)) )
+ (if (and (> c 10) (< c 70))
+ (let* ( (end (1- (point)))
+ (start (- end len)) )
+ (add-text-properties start end `(face ,hwl-hi-thread-face))
+ ) ) )
+ ) )
+ )
+)
+
+(defun hwl-hi-line ()
+ "Highlight the current line."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (let ( (beg (point)) )
+ (end-of-line)
+ (add-text-properties beg (point) '(face highlight))
+ )
+ )
+)
+
+(defun hwl-unhi-line ()
+ "Unhighlight the current line."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (let ( (beg (point)) )
+ (end-of-line)
+ (add-text-properties beg (point) '(face nil))
+ )
+ )
+)
+
+; Doesn't work yet
+(defun hwl-hi-from-to (from to)
+ "Highlight region between two timestamps."
+ (interactive "nFrom: \nnTo:")
+ (save-excursion
+ (let* ( (here (point))
+ (now 0)
+ start end
+ (separator '"+++++")
+ )
+ (goto-char (point-min))
+ ; (re-search-forward REGEXP)
+ (search-forward separator nil t)
+ (forward-line)
+ (while (< now from)
+ (beginning-of-line)
+ (forward-line)
+ (forward-char 7)
+ (setq beg (point))
+ (search-forward "]")
+ (setq time-str (buffer-substring beg (- (point) 2)))
+ (setq now (string-to-number time-str))
+ )
+ (if (< now from)
+ nil
+ (setq start (point))
+ (while (< now to)
+ (beginning-of-line)
+ (forward-line)
+ (forward-char 7)
+ (setq beg (point))
+ (search-forward "]")
+ (setq time-str (buffer-substring beg (- (point) 2)))
+ (setq now (string-to-number time-str))
+ )
+ (if (< now to)
+ nil
+ (setq end (point))
+ (add-text-properties start end '(face paren-match-face))
+ )
+ )
+ ) ; let
+ ) ; excursion
+)
+
+(defun hwl-hi-clear ()
+ (interactive)
+ (let ( (start (point-min) )
+ (end (point-max)) )
+ (remove-text-properties start end '(face nil))
+ )
+)
+
+;; --------------------------------------------------------------------------
+;; Misc Elisp functions
+;; --------------------------------------------------------------------------
+
+(defun hwl-wrap ()
+ (interactive)
+ (setq truncate-lines nil)
+ (hilit-recenter nil)
+)
+
+(defun hwl-truncate ()
+ (interactive)
+ (setq truncate-lines t)
+ (hilit-recenter nil)
+)
+
+(defun hwl-toggle-truncate-wrap ()
+ (interactive)
+ (if truncate-lines (setq truncate-lines nil)
+ (setq truncate-lines t))
+ (hilit-recenter nil)
+)
+
+(defun hwl-narrow-to-pe (pe)
+ (interactive "nPE: ")
+ (hwl-narrow 1 pe "")
+)
+
+(defun hwl-narrow-to-thread (thread)
+ (interactive "sThread: ")
+ (hwl-narrow 2 thread "")
+)
+
+(defun hwl-narrow-to-event (event)
+ (interactive "sEvent: ")
+ (hwl-narrow 3 0 event)
+)
+
+(defun hwl-narrow (mode id str)
+ ( let* ((outbuffer (get-buffer-create "*GrAnSim Narrowed*"))
+ ;(from (beginning-of-buffer))
+ ;(to (end-of-buffer))
+ ;(to (point)) ; (region-end))
+ ;(text (buffer-substring from to)) ; contains text in region
+ (w (selected-window))
+ ;(nh 5) ; height of new window
+ ;(h (window-height w)) ; height of selcted window
+ ;(h1 (if (<= h nh) (- h 1) (- h nh))) ; height of old window
+ (w1 (get-buffer-window outbuffer 'visible))
+
+ (infile (buffer-file-name)) ; or
+ (inbuffer (current-buffer))
+ (command "tf")
+ ;(mode_opt (cond ((eq mode 1) "-p")
+ ; ((eq mode 2) "-t")
+ ; ((eq mode 3) "-e")
+ ; (t "-v")))
+ )
+ (if w1 (message "Window *GrAnSim Narrowed* already visible")
+ (split-window w nil nil))
+ (switch-to-buffer-other-window outbuffer)
+ (erase-buffer)
+ (setq truncate-lines t)
+ (gr-mode)
+ ;(beginning-of-buffer)
+ ;(set-mark)
+ ;(end-of-buffer)
+ ;(delete-region region-beginning region-end)
+ (cond ((eq mode 1)
+ ;(message (format "Narrowing to Processor %d" id))
+ (call-process command nil outbuffer t "-p" (format "%d" id) infile ))
+ ((eq mode 2)
+ ;(message (format "Narrowing to Thread %d" id))
+ (call-process command nil outbuffer t "-t" (format "%s" id) infile ))
+ ((eq mode 3)
+ ;(message (format "Narrowing to Event %s" str))
+ (call-process command nil outbuffer t "-e" str infile ))
+ )
+ )
+)
+
+(defun hwl-command-on-buffer (prg opts file)
+ (interactice "CProgram:\nsOptions:\nfFile:")
+ ( let* ((outbuffer (get-buffer-create "*GrAnSim Command*"))
+ (from (beginning-of-buffer))
+ (to (end-of-buffer))
+ ;(to (point)) ; (region-end))
+ ;(text (buffer-substring from to)) ; contains text in region
+ (w (selected-window))
+ ;(nh 5) ; height of new window
+ ;(h (window-height w)) ; height of selcted window
+ ;(h1 (if (<= h nh) (- h 1) (- h nh))) ; height of old window
+ (w1 (get-buffer-window outbuffer 'visible))
+
+ (infile (buffer-file-name)) ; or
+ (inbuffer (current-buffer))
+ ;(command "tf")
+ ;(mode_opt (cond ((eq mode 1) "-p")
+ ; ((eq mode 2) "-t")
+ ; ((eq mode 3) "-e")
+ ; (t "-v")))
+ )
+ (if w1 (message "Window *GrAnSim Command* already visible")
+ (split-window w nil nil))
+ (switch-to-buffer-other-window outbuffer)
+ (erase-buffer)
+ (setq truncate-lines t)
+ (gr-mode)
+ (call-process prg nil outbuffer opts file)
+ )
+)
+
+;; ToDo: Elisp Fcts for calling scripts like gr3ps etc
+
+(define-key gr-mode-map "\C-ct" 'hwl-truncate)
+(define-key gr-mode-map "\C-cw" 'hwl-wrap)
+(define-key gr-mode-map "\C-ch" 'hilit-rehighlight-buffer)
+(define-key gr-mode-map "\C-cp" 'hwl-narrow-to-pe)
+(define-key gr-mode-map "\C-ct" 'hwl-narrow-to-thread)
+(define-key gr-mode-map "\C-ce" 'hwl-narrow-to-event)
+(define-key gr-mode-map "\C-c\C-e" '(lambda () (hwl-narrow-to-event "END")))
+(define-key gr-mode-map "\C-c " 'hwl-toggle-truncate-wrap)
+(define-key gr-mode-map "\C-cN" 'hwl-hi-node)
+(define-key gr-mode-map "\C-cT" 'hwl-hi-thread)
+(define-key gr-mode-map "\C-c\C-c" 'hwl-hi-clear)
+
+;; ---------------------------------------------------------------------------
+;; Mode for threaded C files
+;; ---------------------------------------------------------------------------
+
+(setq auto-mode-alist
+ (append '(("\\.hc" . hc-mode))
+ auto-mode-alist))
+
+(define-derived-mode hc-mode c-mode "hc Mode"
+ "Derived mode for Haskell C files."
+)
+
+(hilit-set-mode-patterns
+ 'hc-mode
+ '(
+ ("\\(GRAN_FETCH\\|GRAN_RESCHEDULE\\|GRAN_FETCH_AND_RESCHEDULE\\|GRAN_EXEC\\|GRAN_YIELD\\)" 1 keyword)
+ ("FB_" nil defun)
+ ("FE_" nil define)
+ ("__STG_SPLIT_MARKER" nil msg-note)
+ ("^.*_ITBL.*$" nil defun)
+ ("^\\(I\\|E\\|\\)FN.*$" nil define)
+ )
+)
+
+; (define-key global-map [S-pause] 'hc-mode)
diff --git a/ghc/utils/parallel/Jmakefile b/ghc/utils/parallel/Jmakefile
index 371785c667..3967047e52 100644
--- a/ghc/utils/parallel/Jmakefile
+++ b/ghc/utils/parallel/Jmakefile
@@ -2,7 +2,25 @@ PROGRAMS = grs2gr \
gr2ps \
gr2qp \
qp2ps \
- ghc-fool-sort ghc-unfool-sort
+ ghc-fool-sort ghc-unfool-sort \
+ gr2pe \
+ gr2java \
+ gr2jv \
+ gr2ap \
+ qp2ap \
+ gr2gran \
+ gr2RTS \
+ RTS2gran \
+ gran-extr \
+ gp-ext-imp \
+ tf \
+ avg-RTS \
+ SPLIT \
+ AVG \
+ SN \
+ get_SN \
+ sn_filter \
+ ps-scale-y
all:: $(PROGRAMS)
/* stuff to have before we get going */
@@ -17,6 +35,27 @@ MsubProgramScriptTarget(PerlCmd,qp2ps,qp2ps.pl,,)
MsubProgramScriptTarget(PerlCmd,ghc-fool-sort,ghc-fool-sort.pl,,)
MsubProgramScriptTarget(PerlCmd,ghc-unfool-sort,ghc-unfool-sort.pl,,)
+MsubProgramScriptTarget(PerlCmd,gr2pe,gr2pe.pl,,)
+MsubProgramScriptTarget(PerlCmd,gr2java,gr2java.pl,,)
+MsubProgramScriptTarget(/usr/local/bin/bash,gr2jv,gr2jv.bash,,)
+MsubProgramScriptTarget(/usr/local/bin/bash,gr2ap,gr2ap.bash,,)
+MsubProgramScriptTarget(PerlCmd,qp2ap,qp2ap.pl,,)
+
+MsubProgramScriptTarget(/usr/local/bin/bash,gr2gran,gr2gran.bash,,)
+MsubProgramScriptTarget(PerlCmd,gr2RTS,gr2RTS.pl,,)
+MsubProgramScriptTarget(PerlCmd,RTS2gran,RTS2gran.pl,,)
+MsubProgramScriptTarget(PerlCmd,gran-extr,gran-extr.pl,,)
+
+MsubProgramScriptTarget(PerlCmd,gp-ext-imp,gp-ext-imp.pl,,)
+MsubProgramScriptTarget(PerlCmd,tf,tf.pl,,)
+MsubProgramScriptTarget(PerlCmd,avg-RTS,avg-RTS.pl,,)
+MsubProgramScriptTarget(PerlCmd,SPLIT,SPLIT.pl,,)
+MsubProgramScriptTarget(PerlCmd,AVG,AVG.pl,,)
+MsubProgramScriptTarget(PerlCmd,SN,SN.pl,,)
+MsubProgramScriptTarget(PerlCmd,get_SN,get_SN.pl,,)
+MsubProgramScriptTarget(PerlCmd,sn_filter,sn_filter.pl,,)
+MsubProgramScriptTarget(PerlCmd,ps-scale-y,ps-scale-y.pl,,)
+
/* === INSTALLATION ======== */
/* the rest of these vary from std/useful to hackish dans le extreme */
@@ -29,6 +68,27 @@ InstallScriptTarget(qp2ps, $(INSTSCRIPTDIR))
InstallScriptTarget(ghc-fool-sort, $(INSTSCRIPTDIR))
InstallScriptTarget(ghc-unfool-sort,$(INSTSCRIPTDIR))
+InstallScriptTarget(gr2pe, $(INSTSCRIPTDIR))
+InstallScriptTarget(gr2java, $(INSTSCRIPTDIR))
+InstallScriptTarget(gr2jv, $(INSTSCRIPTDIR))
+InstallScriptTarget(gr2ap, $(INSTSCRIPTDIR))
+InstallScriptTarget(qp2ap, $(INSTSCRIPTDIR))
+
+InstallScriptTarget(gr2gran, $(INSTSCRIPTDIR))
+InstallScriptTarget(gr2RTS, $(INSTSCRIPTDIR))
+InstallScriptTarget(RTS2gran, $(INSTSCRIPTDIR))
+InstallScriptTarget(gran-extr, $(INSTSCRIPTDIR))
+
+InstallScriptTarget(gp-ext-imp, $(INSTSCRIPTDIR))
+InstallScriptTarget(tf, $(INSTSCRIPTDIR))
+InstallScriptTarget(avg-RTS, $(INSTSCRIPTDIR))
+InstallScriptTarget(SPLIT, $(INSTSCRIPTDIR))
+InstallScriptTarget(AVG, $(INSTSCRIPTDIR))
+InstallScriptTarget(SN, $(INSTSCRIPTDIR))
+InstallScriptTarget(get_SN, $(INSTSCRIPTDIR))
+InstallScriptTarget(sn_filter, $(INSTSCRIPTDIR))
+InstallScriptTarget(ps-scale-y, $(INSTSCRIPTDIR))
+
/* === OTHER STUFF ========= */
ExtraStuffToClean($(PROGRAMS))
diff --git a/ghc/utils/parallel/RTS2gran.pl b/ghc/utils/parallel/RTS2gran.pl
new file mode 100644
index 0000000000..32012afac8
--- /dev/null
+++ b/ghc/utils/parallel/RTS2gran.pl
@@ -0,0 +1,684 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Mon May 20 1996 17:22:45 Stardate: [-31]7533.41 hwloidl>
+#
+# Usage: RTS2gran <RTS-file>
+#
+# Options:
+# -t <file> ... use <file> as template file (<,> global <.> local template)
+# -p <file> ... use <file> as gnuplot .gp file (default: gran.gp)
+# -x <x-size> ... of gnuplot graph
+# -y <y-size> ... of gnuplot graph
+# -n <n> ... use <n> as number of PEs in title
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+##############################################################################
+
+# ----------------------------------------------------------------------------
+# Command line processing and initialization
+# ----------------------------------------------------------------------------
+
+$gran_dir = $ENV{'GRANDIR'};
+if ( $gran_dir eq "" ) {
+ print STDERR "RTS2gran: Warning: Env variable GRANDIR is undefined\n";
+}
+
+push(@INC, $gran_dir, $gran_dir . "/bin");
+# print STDERR "INC: " . join(':',@INC) . "\n";
+
+require "getopts.pl";
+require "template.pl"; # contains read_template for parsing template file
+require "stats.pl"; # statistics package with corr and friends
+
+&Getopts('hvt:p:x:y:n:Y:Z:');
+
+$OPEN_INT = 1;
+$CLOSED_INT = 0;
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message ();
+}
+
+# ----------------------------------------------------------------------------
+# The real thing
+# ----------------------------------------------------------------------------
+
+$max_y = &pre_process($input);
+
+open(INPUT,"<$input") || die "Couldn't open input file $input";
+open(OUT_CUMU,">$cumulat_rts_file_name") || die "Couldn't open output file $cumulat_rts_file_name";
+open(OUT_CUMU0,">$cumulat0_rts_file_name") || die "Couldn't open output file $cumulat0_rts_file_name";
+
+#do skip_header();
+
+$tot_total_rt = 0;
+$tot_rt = 0;
+$count = 0;
+$last_rt = 0;
+$last_x = 0;
+$last_y = ($logscale{"'g'"} ne "") ? 1 : 0;
+
+$line_no = 0;
+while (<INPUT>) {
+ $line_no++;
+ next if /^--/; # Comment lines start with --
+ next if /^\s*$/; # Skip empty lines
+ $rt = $1 if /^(\d+)/;
+ $count++;
+
+ if ( $opt_D ) {
+ print STDERR "Error @ line $line_no: RTS file not sorted!\n";
+ }
+
+ #push(@all_rts,$rt);
+ $sum_rt += $rt;
+
+ $index = do get_index_open_int($rt,@exec_times);
+ $exec_class[$index]++;
+
+ if ( $last_rt != $rt ) {
+ print OUT_CUMU "$rt \t" . int($last_y/$max_y) . "\n";
+ print OUT_CUMU0 "$rt \t$last_y\n";
+ print OUT_CUMU "$rt \t" . int($count/$max_y) . "\n";
+ print OUT_CUMU0 "$rt \t$count\n";
+ $last_x = $rt;
+ $last_y = $count;
+ }
+
+ $last_rt = $rt;
+}
+print OUT_CUMU "$rt \t" . int($last_y/$max_y) . "\n";
+print OUT_CUMU0 "$rt \t$last_y\n";
+print OUT_CUMU "$rt \t" . int($count/$max_y) . "\n";
+print OUT_CUMU0 "$rt \t$count\n";
+
+close OUT_CUMU;
+close OUT_CUMU0;
+
+$tot_tasks = $count; # this is y-max in cumulat graph
+$max_rt = $rt; # this is x-max in cumulat graph
+
+$max_rt_class = &list_max(@exec_class);
+
+do write_data($gran_file_name, $OPEN_INT, $logscale{"'g'"}, $#exec_times+1,
+ @exec_times, @exec_class);
+
+# ----------------------------------------------------------------------------
+# Run GNUPLOT over the data files and create figures
+# ----------------------------------------------------------------------------
+
+do gnu_plotify($gp_file_name);
+
+# ----------------------------------------------------------------------------
+
+if ( $max_y != $tot_tasks ) {
+ if ( $pedantic ) {
+ die "ERROR: pre-processed number of tasks ($max_y) does not match computed one ($tot_tasks)\n";
+ } else {
+ print STDERR "Warning: pre-processed number of tasks ($max_y) does not match computed one ($tot_tasks)\n" if $opt_v;
+ }
+}
+
+exit 0;
+
+# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+# ToDo: Put these routines into an own package
+# ----------------------------------------------------------------------------
+# Basic Operations on the intervals
+# ----------------------------------------------------------------------------
+
+sub get_index_open_int {
+ local ($value,@list) = @_;
+ local ($index,$right);
+
+ # print "get_index: searching for index of" . $value;
+ # print " in " . join(':',@list);
+
+ $index = 0;
+ $right = $list[$index];
+ while ( ($value >= $right) && ($index < $#list) ) {
+ $index++;
+ $right = $list[$index];
+ }
+
+ return ( ($index == $#list) && ($value > $right) ) ? $index+1 : $index;
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_index_closed_int {
+ local ($value,@list) = @_;
+ local ($index,$right);
+
+ if ( ($value < $list[0]) || ($value > $list[$#list]) ) {
+ return ( -1 );
+ }
+
+ $index = 0;
+ $left = $list[$index];
+ while ( ($left <= $value) && ($index < $#list) ) {
+ $index++;
+ $left = $list[$index];
+ }
+ return ( $index-1 );
+}
+
+# ----------------------------------------------------------------------------
+# Write operations
+# ----------------------------------------------------------------------------
+
+sub write_data {
+ local ($file_name, $open_int, $logaxes, $n, @rest) = @_;
+ local (@times) = splice(@rest,0,$n);
+ local (@class) = @rest;
+
+ open(GRAN,">$file_name") || die "Couldn't open file $file_name for output";
+
+ if ( $open_int == $OPEN_INT ) {
+
+ for ($i=0,
+ $left = ( index($logaxes,"x") != -1 ? int($times[0]/2) : 0 ),
+ $right = 0;
+ $i < $n;
+ $i++, $left = $right) {
+ $right = $times[$i];
+ print GRAN int(($left+$right)/2) . " " .
+ ($class[$i] eq "" ? "0" : $class[$i]) . "\n";
+ }
+ print GRAN $times[$n-1]+(($times[$n-1]-$times[$n-2])/2) . " " .
+ ($class[$n] eq "" ? "0" : $class[$n]) . "\n";
+
+ } else {
+
+ print GRAN ( (index($logaxes,"x") != -1) && ($times[0] == 0 ? int($times[1]/2) : ($times[$1] + $times[0])/2 ) . " " . $class[0] . "\n");
+ for ($i=1; $i < $n-2; $i++) {
+ $left = $times[$i];
+ $right = $times[$i+1];
+ print(GRAN ($left+$right)/2 . " " .
+ ($class[$i] eq "" ? "0" : $class[$i]) . "\n");
+ }
+ print GRAN ($times[$n-1]+$times[$n-2])/2 . " " . $class[$n-2] if $n >= 2;
+ }
+
+ close(GRAN);
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_array {
+ local ($file_name,$n,@list) = @_;
+
+ open(FILE,">$file_name") || die "$file_name: $!";
+ for ($i=0; $i<=$#list; $i++) {
+ print FILE $i . " " . ( $list[$i] eq "" ? "0" : $list[$i] ) . "\n";
+ }
+
+ if ( $opt_D ) {
+ print "write_array: (" . join(", ",1 .. $#list) . ")\n for file $file_name returns: \n (0, $#list, &list_max(@list)\n";
+ }
+
+ return ( (0, $#list, &list_max(@list),
+ "(" . join(", ",1 .. $#list) . ")\n") );
+}
+
+# ----------------------------------------------------------------------------
+
+sub gnu_plotify {
+ local ($gp_file_name) = @_;
+
+ @open_xrange = &range($OPEN_INT,$logscale{"'g'"},@exec_times);
+
+ $exec_xtics = $opt_T ? &get_xtics($OPEN_INT,@exec_times) : "" ;
+
+ open(GP_FILE,">$gp_file_name") ||
+ die "Couldn't open gnuplot file $gp_file_name for output\n";
+
+ print GP_FILE "set term postscript \"Roman\" 20\n";
+ do write_gp_record(GP_FILE,
+ $gran_file_name, &dat2ps_name($gran_file_name),
+ "Granularity (pure exec. time)", "Number of threads",
+ $logscale{"'g'"},
+ @open_xrange,$max_rt_class,$exec_xtics);
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat_rts_file_name, &dat2ps_name($cumulat_rts_file_name),
+ "Cumulative pure exec. times","% of threads",
+ "",
+ $max_rt, 100, "");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat0_rts_file_name, &dat2ps_name($cumulat0_rts_file_name),
+ "Cumulative pure exec. times","Number of threads",
+ $logscale{"'Cg'"},
+ $max_rt, $tot_tasks, "");
+ # $xtics_cluster_rts as last arg?
+
+ close GP_FILE;
+
+ print "Gnu plotting figures ...\n";
+ system "gnuplot $gp_file_name";
+
+ print "Extending thickness of impulses ...\n";
+ do gp_ext($gran_file_name);
+}
+
+# ----------------------------------------------------------------------------
+
+sub gp_ext {
+ local (@file_names) = @_;
+ local ($file_name);
+ local ($ps_file_name);
+ local ($prg);
+
+ #$prg = system "which gp-ext-imp";
+ #print " Using script $prg for impuls extension\n";
+ $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp"
+ : $ENV{HOME} . "/bin/gp-ext-imp" ;
+ if ( $opt_v ) {
+ print " (using script $prg)\n";
+ }
+
+ foreach $file_name (@file_names) {
+ $ps_file_name = &dat2ps_name($file_name);
+ system "$prg -w $ext_size -g $gray " .
+ $ps_file_name . " " .
+ $ps_file_name . "2" ;
+ system "mv " . $ps_file_name . "2 " . $ps_file_name;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xstart,$xend,$ymax,$xtics) = @_;
+
+ if ( $xstart >= $xend ) {
+ print ("WARNING: empty xrange [$xstart:$xend] changed to [$xstart:" . $xstart+1 . "]\n") if ( $pedantic || $opt_v );
+ $xend = $xstart + 1;
+ }
+
+ if ( $ymax <=0 ) {
+ $ymax = 2;
+ print "WARNING: empty yrange changed to [0:$ymax]\n" if ( $pedantic || $opt_v );
+ }
+
+ $str = "set size " . $xsize . "," . $ysize . "\n" .
+ "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ ($xstart eq "" ? ""
+ : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
+ ($opt_Y ?
+ ("set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . ":$opt_Y]\n") :
+ ($ymax eq "" ? ""
+ : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) .
+ ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n")) .
+ ($xtics ne "" ? "set xtics $xtics" : "") .
+ "set tics out\n" .
+ "set border\n" .
+ ( $nPEs!=0 ? "set title \"$nPEs PEs\"\n" : "" ) .
+ "set nokey \n" .
+ "set nozeroaxis\n" .
+ "set format xy \"%8.8g\"\n" .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with impulses\n\n";
+ print $file $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_lines_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xend,$yend,$xtics) = @_;
+
+ local ($str);
+
+ $str = "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ "set xrange [" . ( index($logaxes,"x") != -1 ? 1 : 0 ) . ":$xend]\n" .
+ "set yrange [" . ( index($logaxes,"y") != -1 ? 1 : 0 ) .
+ ($yend!=100 && $opt_Z ? ":$opt_Z]\n" : ":$yend]\n") .
+ "set border\n" .
+ "set nokey\n" .
+ ( $xtics ne "" ? "set xtics $xtics" : "" ) .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set nozeroaxis\n" .
+ "set format xy \"%8.8g\"\n" .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with lines\n\n";
+ print $file $str;
+}
+
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_simple_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xstart,$xend,$ymax,$xtics) = @_;
+
+ $str = "set size " . $xsize . "," . $ysize . "\n" .
+ "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ ($xstart eq "" ? ""
+ : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
+ ($ymax eq "" ? ""
+ : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) .
+ ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
+ ($xtics ne "" ? "set xtics $xtics" : "") .
+ "set border\n" .
+ "set nokey\n" .
+ "set tics out\n" .
+ "set nozeroaxis\n" .
+ "set format xy \"%8.8g\"\n" .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with impulses\n\n";
+ print $file $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub range {
+ local ($open_int, $logaxes, @ints) = @_;
+
+ local ($range, $left_margin, $right_margin);
+
+ $range = $ints[$#ints]-$ints[0];
+ $left_margin = 0; # $range/10;
+ $right_margin = 0; # $range/10;
+
+ if ( $opt_D ) {
+ print "\n==> Range: logaxes are $logaxes i.e. " .
+ (index($logaxes,"x") != -1 ? "matches x axis\n"
+ : "DOESN'T match x axis\n");
+ }
+ if ( index($logaxes,"x") != -1 ) {
+ if ( $open_int == $OPEN_INT ) {
+ return ( ($ints[0]/2-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ } else {
+ return ( ( &list_max(1,$ints[0]-$left_margin),
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ }
+ } else {
+ if ( $open_int == $OPEN_INT ) {
+ return ( ($ints[0]/2-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ } else {
+ return ( ($ints[0]-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ }
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0)";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+
+ # system "cat $0 | awk 'BEGIN { n = 0; } \
+ # /^$/ { print n; \
+ # exit; } \
+ # { n++; }'"
+ exit ;
+ }
+
+ $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
+
+ if ( $#ARGV != 0 ) {
+ #print "Usage: gran-extr [options] <sim-file>\n";
+ #print "Use -h option to get details\n";
+ #exit 1;
+
+ }
+
+ # Default settings:
+ $gp_file_name = "gran.gp";
+ $gran_file_name = "gran.dat";
+ $cumulat_rts_file_name = "cumu-rts.dat";
+ $cumulat0_rts_file_name = "cumu-rts0.dat";
+ $xsize = 1;
+ $ysize = 1;
+
+ if ( $opt_p ) {
+ $gp_file_name = $opt_p;
+ } else {
+ $gp_file_name = "gran.gp";
+ }
+
+ #if ( $opt_s ) {
+ # $gp_file_name =~ s|\.|${opt_s}.|;
+ # $gran_file_name =~ s|\.|${opt_s}.|;
+ # $cumulat_rts_file_name =~ s|\.|${opt_s}.|;
+ # $cumulat0_rts_file_name =~ s|\.|${opt_s}.|;
+ #}
+
+ if ( $opt_x ) {
+ $xsize = $opt_x;
+ } else {
+ $xsize = 1;
+ }
+
+ if ( $opt_y ) {
+ $ysize = $opt_y;
+ } else {
+ $ysize = 1;
+ }
+
+ if ( $opt_t ) {
+ do read_template($opt_t,$input);
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ print "-" x 70 . "\n";
+ print "Setup: \n";
+ print "-" x 70 . "\n";
+ print "\nFilenames: \n";
+ print " Input file: $input\n";
+ print " Gran files: $gran_file_name $gran_global_file_name $gran_local_file_name\n";
+ print " Comm files: $comm_file_name $comm_global_file_name $comm_local_file_name\n";
+ print " Sparked threads file: $spark_file_name $spark_local_file_name $spark_global_file_name\n";
+ print " Heap file: $ha_file_name\n";
+ print " GNUPLOT file name: $gp_file_name Correlation file name: $corr_file_name\n";
+ print " Cumulative RT file name: $cumulat_rts_file_name ($cumulat0_rts_file_name) \n Cumulative HA file name: $cumulat_has_file_name\n";
+ print " Cluster RT file name: $clust_rts_file_name \n Cluster HA file name: $clust_has_file_name\n";
+ print " Cumulative runtimes file name: $cumulat_rts_file_name\n";
+ print " Cumulative heap allocations file name $cumulat_has_file_name\n";
+ print " Cluster run times file name: $clust_rts_file_name\n";
+ print " Cluster heap allocations file name: $clust_has_file_name\n";
+ print " PE load file name: $pe_file_name\n";
+ print " Site size file name: $sn_file_name\n";
+ print "\nBoundaries: \n";
+ print " Gran boundaries: (" . join(',',@exec_times) . ")\n";
+ print " Comm boundaries: (" . join(',',@comm_percs) . ")\n";
+ print " Sparked threads boundaries: (" . join(',',@sparks) . ")\n";
+ print " Heap boundaries: (" . join(',',@has) .")\n";
+ print "\nOther pars: \n";
+ print " Left margin: $left_margin Right margin: $right_margin\n";
+ print " GP-extension: $ext_size GP xsize: $xsize GP ysize: $ysize\n";
+ print " Gray scale: $gray Smart x-tics is " . ($opt_T ? "ON" : "OFF") .
+ " Percentage y-axis is " . ($opt_P ? "ON" : "OFF") . "\n";
+ print " Log. scaling assoc list: ";
+ while (($key,$value) = each %logscale) {
+ print "$key: $value, ";
+ }
+ print "\n";
+ print " Active template file: $templ_file\n" if $opt_t;
+ print "-" x 70 . "\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub pre_process {
+ local ($file) = @_;
+
+ open(PIPE,"wc -l $input |") || die "Couldn't open pipe";
+
+ while (<PIPE>) {
+ if (/^\s*(\d+)/) {
+ $res = $1;
+ } else {
+ die "Error in pre-processing: Last line of $file does not match RTS!\n";
+ }
+ }
+ close(PIPE);
+
+ return ($res-1);
+}
+
+# ----------------------------------------------------------------------------
+
+
+# ----------------------------------------------------------------------------
+#
+# Old version (eventually delete it)
+# New version is in template.pl
+#
+# sub read_template {
+# local ($f);
+#
+# if ( $opt_v ) {
+# print "Reading template file $templ_file_name ...\n";
+# }
+#
+# ($f = ($input eq "-" ? "stdin" : $input)) =~ s/.rts//;
+#
+# open(TEMPLATE,"cat $templ_file_name | sed -e 's/\$0/$f/' |")
+# || die "Couldn't open file $templ_file_name";
+#
+# while (<TEMPLATE>) {
+# next if /^\s*$/ || /^--/;
+# if (/^\s*G[:,;.\s]+([^\n]+)$/) {
+# $list_str = $1;
+# $list_str =~ s/[\(\)\[\]]//g;
+# @exec_times = split(/[,;. ]+/, $list_str);
+# } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
+# $list_str = $1;
+# $list_str =~ s/[\(\)\[\]]//g;
+# @fetch_times = split(/[,;. ]+/, $list_str);
+# } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
+# $list_str = $1;
+# $list_str =~ s/[\(\)\[\]]//g;
+# @has = split(/[,;. ]+/, $list_str);
+# } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
+# $list_str = $1;
+# $list_str =~ s/[\(\)\[\]]//g;
+# @comm_percs = split(/[,;. ]+/, $list_str);
+# } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
+# $list_str = $1;
+# $list_str =~ s/[\(\)\[\]]//g;
+# @sparks = split(/[,;. ]+/, $list_str);
+# } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
+# ($gran_file_name,$gran_global_file_name, $gran_local_file_name) =
+# &mk_global_local_names($1);
+# } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
+# ($ft_file_name,$ft_global_file_name, $ft_local_file_name) =
+# &mk_global_local_names($1);
+# } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
+# ($comm_file_name, $comm_global_file_name, $comm_local_file_name) =
+# &mk_global_local_names($1);
+# } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
+# ($spark_file_name, $spark_global_file_name, $spark_local_file_name) =
+# &mk_global_local_names($1);
+# } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
+# ($ha_file_name, $ha_global_file_name, $ha_local_file_name) =
+# &mk_global_local_names($1);
+# } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
+# $gp_file_name = $1;
+# $ps_file_name = &dat2ps_name($gp_file_name);
+#
+# } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
+# $corr_file_name = $1;
+# } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
+# $cumulat_rts_file_name = $1;
+# ($cumulat0_rts_file_name = $1) =~ s/\./0./;
+# } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
+# $cumulat_has_file_name = $1;
+# } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
+# $cumulat_fts_file_name = $1;
+# } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
+# $cumulat_cps_file_name = $1;
+# } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
+# $clust_rts_file_name = $1;
+# } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
+# $clust_has_file_name = $1;
+# } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
+# $clust_fts_file_name = $1;
+# } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
+# $clust_cps_file_name = $1;
+# } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
+# $pe_file_name = $1;
+# } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
+# $sn_file_name = $1;
+#
+# } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
+# $rts_file_name = $1;
+# } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
+# $has_file_name = $1;
+# } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
+# $fts_file_name = $1;
+# } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
+# $lsps_file_name = $1;
+# } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
+# $gsps_file_name = $1;
+# } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
+# $cps_file_name = $1;
+# } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
+# $ccps_file_name = $1;
+#
+# } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
+# $input = $1;
+# } elsif (/^\s*L[:,;\s]+(.*)$/) {
+# $str = $1;
+# %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next if $str eq ".";
+# $str =~ s/[\(\)\[\]]//g;
+# %logscale = split(/[,;. ]+/, $str);
+# } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
+# $gray = $1;
+# } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
+# $no_of_clusters = $1;
+# } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
+# $ext_size = $1;
+# } elsif (/^\s*v.*$/) {
+# $verbose = 1;
+# } elsif (/^\s*T.*$/) {
+# $opt_T = 1;
+# }
+# }
+# close(TEMPLATE);
+# }
diff --git a/ghc/utils/parallel/SN.pl b/ghc/utils/parallel/SN.pl
new file mode 100644
index 0000000000..0711d687a5
--- /dev/null
+++ b/ghc/utils/parallel/SN.pl
@@ -0,0 +1,280 @@
+#!/usr/local/bin/perl
+# (C) Hans Wolfgang Loidl, November 1995
+#############################################################################
+# Time-stamp: <Sun Nov 5 1995 00:23:45 Stardate: [-31]6545.08 hwloidl>
+#
+# Usage: SN [options] <gr-file>
+#
+# Create a summary of spark names that occur in gr-file (only END events in
+# gr-file are necessary). Creates a gnuplot impulses graph (spark names by
+# number of threads) as summary.
+#
+# Options:
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+#############################################################################
+
+$gran_dir = $ENV{'GRANDIR'};
+if ( $gran_dir eq "" ) {
+ print STDERR "SN: Warning: Env variable GRANDIR is undefined\n";
+}
+
+push(@INC, $gran_dir, $gran_dir . "/bin");
+# print STDERR "INC: " . join(':',@INC) . "\n";
+
+require "getopts.pl";
+require "aux.pl";
+require "stats.pl";
+
+&Getopts('hv');
+
+do process_options();
+
+if ( $opt_v ) { do print_verbose_message(); }
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+chop($date = `date`);
+chop($stardate = `stardate`);
+
+open (IN,"<$input") || die "$!: $input";
+$n = 0;
+$is_end=0;
+while (<IN>) {
+ $is_end = 1 if /END\s+(\w+).*SN\s+(\d+).*RT\s*(\d+)/;
+ next unless $is_end;
+ $n++;
+ $sn = $2;
+ $rt = $3;
+ #$sn_dec = hex($sn);
+ $num_sns{$sn}++;
+ $rts_sns{$sn} += $rt;
+ #do inc ($sn_dec);
+ $is_end=0;
+}
+close (IN);
+
+@sorted_keys=sort {$a<=>$b} keys(%num_sns);
+#$max_val=&list_max(@sorted_keys);
+
+open (SUM,">$summary") || die "$!: $summary";
+
+print SUM "# Generated by SN at $date $stardate\n";
+print SUM "# Input file: $input\n";
+print SUM "#" . "-"x77 . "\n";
+print SUM "Total number of threads: $n\n";
+print SUM "# Format: SN: Spark Site N: Number of threads AVG: average RT\n";
+# . "RTS: Sum of RTs ";
+
+foreach $k (@sorted_keys) {
+ $num = $num_sns{$k};
+ $rts = $rts_sns{$k};
+ $avg = $rts/$num;
+ #print SUM "SN: $k \tN: $num \tRTS: $rts \tAVG: $avg\n";
+ print SUM "$k \t$num \t$avg\n";
+}
+close (SUM);
+
+open (OUT,">$output") || die "$!: $output";
+print OUT "# Generated by SN at $date $stardate\n";
+print OUT "# Input file: $input\n";
+print OUT "#" . "-"x77 . "\n";
+
+$max_val=0;
+foreach $k (@sorted_keys) {
+ $num = $num_sns{$k};
+ $max_val = $num if $num > $max_val;
+ print OUT "$k\t$num\n";
+}
+close (OUT);
+
+do write_gp($gp_file,$ps_file);
+
+print "Gnu plotting figures ...\n";
+system "gnuplot $gp_file";
+
+print "Extending thickness of impulses ...\n";
+$ext_size = 100;
+$gray = 0.3;
+do gp_ext($ps_file);
+
+exit (0);
+
+# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+sub inc {
+ local ($sn) = @_;
+ local (@k);
+
+ @k = keys(%num_sns);
+ if ( &is_elem($sn, @k) ) {
+ $num_sns{$sn}++;
+ } else {
+ $num_sns{$sn} = 1;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub is_elem {
+ local ($x,@list) = @_;
+ local ($found);
+
+ for ($found = 0, $y = shift(@list);
+ $#list == -1 || $found;
+ $found = ($x == $y), $y = shift(@list)) {}
+
+ return ($found);
+}
+
+# ----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $opt_s ) {
+ $opt_s =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $opt_s);
+ } else {
+ @sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
+ }
+
+ if ( $#ARGV != 0 ) {
+ print "Usage: $0 [options] <gr-file>\n;";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $input = $ARGV[0];
+ ($ps_file = $input) =~ s/\.gr/-SN.ps/;
+ ($gp_file = $input) =~ s/\.gr/-SN.gp/;
+ ($summary = $input) =~ s/\.gr/-SN.sn/;
+
+ #($basename = $gr_file) =~ s/\.gr//;
+ #$rts_file = $basename . ".rts"; # "RTS";
+ #$gran_file = "g.ps"; # $basename . ".ps";
+ #$rts_file = $gr_file;
+ #$rts_file =~ s/\.gr/.rts/g;
+
+ if ( $opt_o ) {
+ $output = $opt_o;
+ } else {
+ ($output = $input) =~ s/\.gr/-SN.dat/;
+ }
+
+ if ( $opt_e ) {
+ $ext_size = $opt_e;
+ } else {
+ $ext_size = 100;
+ }
+
+ if ( $opt_i ) {
+ $gray = $opt_i;
+ } else {
+ $gray = 0;
+ }
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_verbose_message {
+ print "Input: $input \tOutput: $output\n";
+}
+
+# -----------------------------------------------------------------------------
+
+# ToDo: Takes these from global module:
+
+# ----------------------------------------------------------------------------
+
+sub gp_ext {
+ local (@file_names) = @_;
+ local ($file_name);
+ local ($ps_file_name);
+ local ($prg);
+
+ #$prg = system "which gp-ext-imp";
+ #print " Using script $prg for impuls extension\n";
+ $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp"
+ : $ENV{HOME} . "/bin/gp-ext-imp" ;
+ if ( $opt_v ) {
+ print " (using script $prg)\n";
+ }
+
+ foreach $file_name (@file_names) {
+ $ps_file_name = $file_name; # NB change to orig !!!!&dat2ps_name($file_name);
+ system "$prg -w $ext_size -g $gray " .
+ $ps_file_name . " " .
+ $ps_file_name . "2" ;
+ system "mv " . $ps_file_name . "2 " . $ps_file_name;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_gp {
+ local ($gp_file,$ps_file) = @_;
+ local ($str);
+
+ $xsize = 1;
+ $ysize = 1;
+ $xlabel = "Spark sites";
+ $ylabel = "Number of threads";
+ $xstart = &list_min(@sorted_keys);
+ $xend = &list_max(@sorted_keys);
+ $ymax = $max_val;
+ $xtics = ""; "(" . join(',',@sorted_keys) . ")\n";
+ $in_file = $output;
+ $out_file = $ps_file;
+
+ open (GP,">$gp_file") || die "$!: $gp_file";
+ print GP "set term postscript \"Roman\" 20\n";
+
+ # identical to the part in write_gp_record of RTS2gran
+
+ $str = "set size " . $xsize . "," . $ysize . "\n" .
+ "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ ($xstart eq "" ? ""
+ : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
+ ($opt_Y ?
+ ("set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . ":$opt_Y]\n") :
+ ($ymax eq "" ? ""
+ : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) .
+ ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n")) .
+ ($xtics ne "" ? "set xtics $xtics" : "") .
+ "set tics out\n" .
+ "set border\n" .
+ ( $nPEs!=0 ? "set title \"$nPEs PEs\"\n" : "" ) .
+ "set nokey \n" .
+ "set nozeroaxis\n" .
+ "set format xy \"%8.8g\"\n" .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with impulses\n\n";
+ print GP $str;
+ close (GP);
+}
+
+# ----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/SPLIT.pl b/ghc/utils/parallel/SPLIT.pl
new file mode 100644
index 0000000000..b4fe46f5b0
--- /dev/null
+++ b/ghc/utils/parallel/SPLIT.pl
@@ -0,0 +1,379 @@
+#!/usr/local/bin/perl
+# (C) Hans Wolfgang Loidl, July 1995
+#############################################################################
+# Time-stamp: <Thu Oct 26 1995 18:23:00 Stardate: [-31]6498.62 hwloidl>
+#
+# Usage: SPLIT [options] <gr-file>
+#
+# Generate a set of granularity graphs out of the GrAnSim profile <gr-file>.
+# The granularity graphs are put into subdirs of the structure:
+# <basename of gr-file>-<spark-name>
+#
+# Options:
+# -s <list> ... a perl list of spark names; the given <gr-file> is scanned
+# for each given name in turn and granularity graphs are
+# generated for each of these sparks
+# -O ... use gr2RTS and RTS2gran instead of gran-extr;
+# this generates fewer output files (only granularity graphs)
+# but should be faster and far less memory consuming
+# -d <dir> ... use <dir> as basename for the sub-directories
+# -o <file> ... use <file> as basename for the generated latex files;
+# the overall result is in <file>.ps
+# -t <file> ... use <file> as gran-extr type template file
+# ('.' for local template, ',' for global template)
+# -A ... surpress generation of granularity profiles for overall .gr
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+#############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvOAd:o:s:t:');
+
+do process_options();
+
+if ( $opt_v ) { do print_verbose_message(); }
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+$latex = "/usr/local/tex/bin/latex2e"; # or "/usr/local/tex/bin/latex2e"
+
+do all() if !$opt_A;
+
+foreach $s (@sparks) {
+ if ( -f $tmp_file ) { system "rm -f $tmp_file"; }
+ system "tf -H -s $s $gr_file > $tmp_file"
+ || die "Can't open pipe: tf -s $s $gr_file > $tmp_file\n";
+
+ if ( $opt_d ) {
+ $dir = $opt_d;
+ } else {
+ $dir = $gr_file;
+ }
+ $dir =~ s/\.gr//g;
+ $dir .= "-$s";
+
+ if ( ! -d $dir ) {
+ mkdir($dir,"755"); # system "mkdir $dir";
+ system "chmod u+rwx $dir";
+ }
+
+ system "mv $tmp_file $dir/$gr_file";
+ chdir $dir;
+ do print_template();
+ do print_va("Title",$s);
+ if ( -f $va_ps_file ) {
+ local ($old) = $va_ps_file;
+ $old =~ s/\.ps/-o.ps/g;
+ system "mv $va_ps_file $old";
+ }
+ if ( $opt_O ) {
+ system "gr2RTS -o $rts_file $gr_file; " .
+ "RTS2gran -t $template_file $rts_file; " .
+ "$latex $va_file; dvips $va_dvi_file > $va_ps_file";
+ } else {
+ system "gran-extr -t $template_file $gr_file; " .
+ "$latex $va_file; dvips $va_dvi_file > $va_ps_file";
+ }
+ chdir ".."; # system "cd ..";
+}
+
+exit 0;
+
+# -----------------------------------------------------------------------------
+
+sub all {
+
+ $dir = $gr_file;
+ $dir =~ s/\.gr//g;
+ $dir .= "-all";
+
+ if ( ! -d $dir ) {
+ mkdir($dir,"755"); # system "mkdir $dir";
+ system "chmod u+rwx $dir";
+ }
+
+ system "cp $gr_file $dir/$gr_file";
+ chdir $dir;
+ do print_template();
+ do print_va("All","all");
+ if ( -f $va_ps_file ) {
+ local ($old) = $va_ps_file;
+ $old =~ s/\.ps/-o.ps/g;
+ system "mv $va_ps_file $old";
+ }
+ if ( $opt_O ) {
+ system "gr2RTS -o $rts_file $gr_file; " .
+ "RTS2gran -t $template_file $rts_file; " .
+ "$latex $va_file; dvips $va_dvi_file > $va_ps_file";
+ } else {
+ system "gran-extr -t $template_file $gr_file; " .
+ "$latex $va_file; dvips $va_dvi_file > $va_ps_file";
+ }
+ chdir ".."; # system "cd ..";
+}
+
+# ---------------------------------------------------------------------------
+
+sub print_template {
+
+ open (TEMPL,">$template_file") || die "Can't open $template_file\n";
+
+ print TEMPL <<EOF;
+-- Originally copied from the master template: GrAn/bin/TEMPL
+-- Intervals for pure exec. times
+G: (1000, 2000, 3000, 4000, 5000, 10000, 20000, 30000, 40000, 50000, 100000, 200000, 300000)
+-- Intervals for communication (i.e. fetch) times
+F: (1000, 2000, 3000, 4000, 5000, 10000, 20000, 30000, 40000, 50000, 100000, 200000, 300000)
+-- Intervals for communication percentages
+C: (0, 1, 2, 5, 8, 10, 20, 30, 40, 50, 100)
+-- Intervals for no. of sparks
+S: (1, 2, 5)
+-- Intervals for heap allocations
+A: (10,20,30,40,50,100,200,300,400,500,1000,2000,3000)
+-- A: (100, 50000, 66000, 100000)
+
+
+g: g.dat
+f: f.dat
+c: c.dat
+s: s.dat
+a: a.dat
+
+-- Select file name corr coeff file
+Xcorr: CORR
+
+-- Select file names for GNUPLOT data files for cumulative runtime and
+-- cluster graphs
+Xcumulat-rts: cumu-rts.dat
+Xcumulat-fts: cumu-fts.dat
+Xcumulat-has: cumu-has.dat
+Xcumulat-cps: cumu-cps.dat
+Xclust-rts: clust-rts.dat
+Xclust-has: clust-has.dat
+Xclust-cps: clust-cps.dat
+
+-- Select file names for GNUPLOT data files for per proc. runnable time
+-- and per spark site runtime
+Xpe: pe.dat
+Xsn: sn.dat
+
+-- Select file names for sorted lists of runtimes, heap allocs, number of
+-- local and global sparks and communication percentage
+XRTS: RTS
+XFTS: FTS
+XHAS: HAS
+XLSPS: LSPS
+XGSPS: GSPS
+XCPS: CPS
+XCCPS: CPS
+
+-- Std log scaling
+L: .
+-- ('g',"xy",'Cg',"xy",'Ca',"xy")
+
+-- Gray level of impulses in the graph (0=black)
+i: 0.3
+
+-- Number of clusters
+k: 2
+
+-- Width of impulses (needed for gp-ext-imp)
+e: 150
+
+-- Input file
+-- -: soda.gr
+EOF
+
+ close(TEMPL);
+}
+
+# -----------------------------------------------------------------------------
+# NB: different file must be generated for $opt_O and default setup.
+# -----------------------------------------------------------------------------
+
+sub print_va {
+ local ($title, $spark) = @_;
+
+ open (VA,">$va_file") || die "Can't open $va_file\n";
+
+ if ( $opt_O ) {
+ print VA <<EOF;
+% Originally copied from master va-file: grasp/tests/va.tex
+\\documentstyle[11pt,psfig]{article}
+
+% Page Format
+\\topmargin=0cm %0.5cm
+\\textheight=24cm %22cm
+\\footskip=0cm
+\\oddsidemargin=0cm %0.75cm
+\\evensidemargin=0cm %0.75cm
+\\rightmargin=0cm %0.75cm
+\\leftmargin=0cm %0.75cm
+\\textwidth=16cm %14.5cm
+
+\\title{SPLIT}
+\\author{Me}
+\\date{Today}
+
+\\pssilent
+
+\\begin{document}
+
+\\pagestyle{empty}
+\%\\maketitle
+
+\\nopagebreak
+
+\\begin{figure}[t]
+\\begin{center}
+\\begin{tabular}{c}
+\\centerline{\\psfig{angle=270,width=7cm,file=$gran_file}}
+\\end{tabular}
+\\end{center}
+\\caption{Granularity {\\bf $spark}}
+\\end{figure}
+
+\\begin{figure}[t]
+\\begin{center}
+\\begin{tabular}{cc}
+\\psfig{angle=270,width=7cm,file=cumu-rts.ps} &
+\\psfig{angle=270,width=7cm,file=cumu-rts0.ps}
+\\end{tabular}
+\\end{center}
+\\caption{Cumulative Execution Times {\\bf $spark}}
+\\end{figure}
+
+\\end{document}
+EOF
+ } else {
+ print VA <<EOF;
+% Originally copied from master va-file: grasp/tests/va.tex
+\\documentstyle[11pt,psfig]{article}
+
+% Page Format
+\\topmargin=0cm %0.5cm
+\\textheight=24cm %22cm
+\\footskip=0cm
+\\oddsidemargin=0cm %0.75cm
+\\evensidemargin=0cm %0.75cm
+\\rightmargin=0cm %0.75cm
+\\leftmargin=0cm %0.75cm
+\\textwidth=16cm %14.5cm
+
+\\title{$title; Spark: $spark}
+\\author{}
+\\date{}
+
+\\begin{document}
+
+\\pagestyle{empty}
+%\\maketitle
+
+\\nopagebreak
+
+\\begin{figure}[t]
+\\begin{center}
+\\begin{tabular}{cc}
+\\psfig{angle=270,width=7cm,file=$gran_file} &
+\\psfig{angle=270,width=7cm,file=a.ps}
+\\end{tabular}
+\\end{center}
+\\caption{Granularity \\& Heap Allocations {\\bf $spark}}
+\\end{figure}
+
+\\begin{figure}[t]
+\\begin{center}
+\\begin{tabular}{cc}
+\\psfig{angle=270,width=7cm,file=f.ps} &
+\\psfig{angle=270,width=7cm,file=c.ps}
+\\end{tabular}
+\\end{center}
+\\caption{Fetching Profile {\\bf $spark}}
+\\end{figure}
+
+\\begin{figure}[t]
+\\begin{center}
+\\begin{tabular}{cc}
+\\psfig{angle=270,width=7cm,file=cumu-rts.ps} &
+\\psfig{angle=270,width=7cm,file=cumu-rts0.ps}
+\\end{tabular}
+\\end{center}
+\\caption{Cumulative Execution Times {\\bf $spark}}
+\\end{figure}
+
+\\end{document}
+EOF
+}
+ close (VA);
+}
+
+# -----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $opt_s ) {
+ $opt_s =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $opt_s);
+ } else {
+ @sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
+ }
+
+ if ( $#ARGV != 0 ) {
+ print "Usage: $0 [options] <gr-file>\n;";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $gr_file = $ARGV[0];
+ ($basename = $gr_file) =~ s/\.gr//;
+ $rts_file = $basename . ".rts"; # "RTS";
+ $gran_file = "g.ps"; # $basename . ".ps";
+ #$rts_file = $gr_file;
+ #$rts_file =~ s/\.gr/.rts/g;
+
+ if ( $opt_o ) {
+ $va_file = $opt_o;
+ $va_dvi_file = $va_file;
+ $va_dvi_file =~ s/\.tex/.dvi/g;
+ $va_ps_file = $va_file;
+ $va_ps_file =~ s/\.tex/.ps/g;
+ } else {
+ $va_file = "va.tex";
+ $va_dvi_file = "va.dvi";
+ $va_ps_file = "va.ps";
+ }
+
+ if ( $opt_t ) {
+ $template_file = $opt_t;
+ } else {
+ $template_file = "TEMPL";
+ }
+
+ $tmp_file = ",t";
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_verbose_message {
+ print "Sparks: (" . join(',',@sparks) . ")\n";
+ print "Files: .gr " . $gr_file . " template " . $template_file .
+ " va " . $va_file . "\n";
+}
+
+# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/aux.pl b/ghc/utils/parallel/aux.pl
new file mode 100644
index 0000000000..8484057aab
--- /dev/null
+++ b/ghc/utils/parallel/aux.pl
@@ -0,0 +1,89 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Sat Oct 28 1995 22:41:09 Stardate: [-31]6509.51 hwloidl>
+#
+# Usage: do ...
+#
+# Various auxiliary Perl subroutines that are mainly used in gran-extr and
+# RTS2gran.
+# This module contains the following `exported' routines:
+# - mk_global_local_names
+# - dat2ps_name
+# The following routines should be local:
+# - basename
+# - dirname
+#
+##############################################################################
+
+# ----------------------------------------------------------------------------
+# Usage: do mk_global_local_names (<file_name>);
+# Returns: (<file_name>,<local_file_name>, <global_file_name>)
+#
+# Take a filename and create names for local and global variants.
+# E.g.: foo.dat -> foo-local.dat and foo-global.dat
+# ----------------------------------------------------------------------------
+
+sub mk_global_local_names {
+ local ($file_name) = @_;
+
+ $file_name .= ".dat" unless $file_name =~ /\.dat$/;
+ $global_file_name = $file_name;
+ $global_file_name =~ s/\.dat/\-global\.dat/ ;
+ $local_file_name = $file_name;
+ $local_file_name =~ s/\.dat/\-local\.dat/ ;
+
+ return ( ($file_name, $global_file_name, $local_file_name) );
+}
+
+
+# ----------------------------------------------------------------------------
+# Usage: do dat2ps(<dat_file_name>);
+# Returns: (<ps_file_name>);
+# ----------------------------------------------------------------------------
+
+sub dat2ps_name {
+ local ($dat_name) = @_;
+
+ $dat_name =~ s/\.dat$/\.ps/;
+ return ($dat_name);
+}
+
+# ----------------------------------------------------------------------------
+# ----------------------------------------------------------------------------
+
+sub basename {
+ local ($in_str) = @_;
+ local ($str,$i) ;
+
+ $i = rindex($in_str,"/");
+ if ($i == -1) {
+ $str = $in_str;
+ } else {
+ $str = substr($in_str,$i+1) ;
+ }
+
+ return $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub dirname {
+ local ($in_str) = @_;
+ local ($str,$i) ;
+
+ $i = rindex($in_str,"/");
+ if ($i == -1) {
+ $str = "";
+ } else {
+ $str = substr($in_str,0,$i+1) ;
+ }
+
+ return $str;
+}
+
+# ----------------------------------------------------------------------------
+
+
+# ----------------------------------------------------------------------------
+
+1;
diff --git a/ghc/utils/parallel/avg-RTS.pl b/ghc/utils/parallel/avg-RTS.pl
new file mode 100644
index 0000000000..4f25d55f80
--- /dev/null
+++ b/ghc/utils/parallel/avg-RTS.pl
@@ -0,0 +1,15 @@
+#!/usr/local/bin/perl
+
+$n=0;
+$sum=0;
+$last=0;
+while (<>) {
+ next unless /^\d+/;
+ @c = split;
+ $sum += $c[0];
+ $last = $c[0];
+ $n++;
+}
+
+print "Average Runtimes: n=$n; sum=$sum; avg=" . ($sum/$n) . "; max=$last\n";
+
diff --git a/ghc/utils/parallel/get_SN.pl b/ghc/utils/parallel/get_SN.pl
new file mode 100644
index 0000000000..e9426855bf
--- /dev/null
+++ b/ghc/utils/parallel/get_SN.pl
@@ -0,0 +1,40 @@
+#!/usr/local/bin/perl
+#############################################################################
+
+#do get_SN($ARGV[0]);
+
+#exit 1;
+
+# ---------------------------------------------------------------------------
+
+sub get_SN {
+ local ($file) = @_;
+ local ($id,$idx,$sn);
+
+ open (FILE,$file) || die "get_SN: Can't open file $file\n";
+
+ $line_no=0;
+ while (<FILE>) {
+ next unless /END/;
+ # PE 0 [3326775]: END 0, SN 0, ST 0, EXP F, BB 194, HA 1464, RT 983079, BT 1449032 (7), FT 0 (0), LS 0, GS 27, MY T
+
+ if (/^PE\s*(\d+) \[(\d+)\]: END ([0-9a-fx]+), SN (\d+)/) {
+ $line_no++;
+ $idx = $3;
+ $id = hex($idx);
+ $sn = $4;
+ #print STDERR "Id: $id ($idx) --> $sn\n";
+ $id2sn{$id} = $sn;
+ }
+ }
+
+ # print STDERR "get_SN: $line_no lines processed\n";
+ close (FILE);
+
+ # print STDERR "Summary: " . "="x15 . "\n";
+ # foreach $key (keys %id2sn) {
+ # print STDERR "> $key --> $id2sn{$key}\n";
+ #}
+}
+
+1;
diff --git a/ghc/utils/parallel/gp-ext-imp.pl b/ghc/utils/parallel/gp-ext-imp.pl
new file mode 100644
index 0000000000..fa7c4e06d8
--- /dev/null
+++ b/ghc/utils/parallel/gp-ext-imp.pl
@@ -0,0 +1,86 @@
+#!/usr/local/bin/perl
+# #############################################################################
+#
+# Usage: gp-ext-imp [options] [<input-file>] [<output-file>]
+#
+# A small script to produce half-useful bar graphs from the PostScript
+# output produced by gnuplot.
+# Translation is done in the X axis automatically, and should
+# be `good enough' for graphs with smallish numbers of bars.
+#
+# Original version: Bryan O'Sullivan <bos@dcs.glasgow.ac.uk> 09.94
+# New and improved version: Hans Wolfgang Loidl <hwloidl@dcs.glasgow.ac.uk>
+#
+# Options:
+# -w <width> ... width of vertical bars
+# -g <gray-level> ... set gray-level (between 0 and 1; 0 means black)
+# -m <move> ... move the graph <move> pixels to the right
+# -h ... help; print this text
+# -v ... verbose mode
+#
+# #############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvm:w:g:');
+
+if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0)";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+
+ exit ;
+}
+
+$size = $opt_w ? $opt_w : 200;
+$gray = $opt_g ? $opt_g : 0;
+$move = $opt_m ? $opt_m : 150;
+
+$from = $#ARGV >= 0 ? $ARGV[0] : "-";
+$to = $#ARGV >= 1 ? $ARGV[1] : "-";
+
+if ( $opt_v ) {
+ print 70 x "-" . "\n";
+ print "\nSetup: \n";
+ print " Input file: $from Output file: $to\n";
+ print " Width: $size Gray level: $gray Move is " .
+ ($opt_m ? "ON" : "OFF") . " with value $move\n";
+ print 70 x "-" . "\n";
+}
+
+open(FROM, "<$from") || die "$from: $!";
+open(TO, ">$to") || die "$to: $!";
+
+$l = -1;
+
+foreach (<FROM>) {
+ if ($l >= 0) {
+ $l--;
+ }
+ if ($l == 0) {
+ if ( $opt_m ) {
+ # This seems to shift everything a little to the right;
+ print TO "$move 0 translate\n";
+ }
+ print TO "$gray setgray\n";
+ print TO "$size setlinewidth\n";
+ }
+ if (/^LT0$/) {
+ $l = 3;
+ } elsif (/^LT1$/) {
+ print TO "-150 0 translate\n";
+ }
+ print TO;
+}
+
+
+
+
+
+
+
diff --git a/ghc/utils/parallel/gr2RTS.pl b/ghc/utils/parallel/gr2RTS.pl
new file mode 100644
index 0000000000..c609334c28
--- /dev/null
+++ b/ghc/utils/parallel/gr2RTS.pl
@@ -0,0 +1,138 @@
+#!/usr/local/bin/perl
+# (C) Hans Wolfgang Loidl, July 1995
+##############################################################################
+# Time-stamp: <Thu Oct 26 1995 18:40:10 Stardate: [-31]6498.68 hwloidl>
+#
+# Usage: gr2RTS [options] <sim-file>
+#
+# Options:
+# -o <file> ... write output to <file>
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+##############################################################################
+
+# ----------------------------------------------------------------------------
+# Command line processing and initialization
+# ----------------------------------------------------------------------------
+
+require "getopts.pl";
+
+&Getopts('hvo:');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message ();
+}
+
+# ----------------------------------------------------------------------------
+# The real thing
+# ----------------------------------------------------------------------------
+
+open(INPUT,"<$input") || die "Couldn't open input file $input";
+open(OUTPUT,"| sort -n > $output") || die "Couldn't open output file $output";
+
+#do skip_header();
+
+$tot_total_rt = 0;
+$tot_rt = 0;
+
+$line_no = 0;
+while (<INPUT>) {
+ next if /^--/; # Comment lines start with --
+ next if /^\s*$/; # Skip empty lines
+ $line_no++;
+ @fields = split(/[:,]/,$_);
+ $has_end = 0;
+
+ foreach $elem (@fields) {
+ foo : {
+ $pe = $1, $end = $2 , last foo if $elem =~ /^\s*PE\s+(\d+)\s+\[(\d+)\].*$/;
+ $tn = $1, $has_end = 1 , last foo if $elem =~ /^\s*END\s+(\w+).*$/;
+ # $tn = $1 , last foo if $elem =~ /^\s*TN\s+(\w+).*$/;
+ $sn = $1 , last foo if $elem =~ /^\s*SN\s+(\d+).*$/;
+ $start = $1 , last foo if $elem =~ /^\s*ST\s+(\d+).*$/;
+ $is_global = $1 , last foo if $elem =~ /^\s*EXP\s+(T|F).*$/;
+ $bbs = $1 , last foo if $elem =~ /^\s*BB\s+(\d+).*$/;
+ $ha = $1 , last foo if $elem =~ /^\s*HA\s+(\d+).*$/;
+ $rt = $1 , last foo if $elem =~ /^\s*RT\s+(\d+).*$/;
+ $bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
+ $ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
+ $lsp = $1 , last foo if $elem =~ /^\s*LS\s+(\d+).*$/;
+ $gsp = $1 , last foo if $elem =~ /^\s*GS\s+(\d+).*$/;
+ $my = $1 , last foo if $elem =~ /^\s*MY\s+(T|F).*$/;
+ }
+ }
+
+ next unless $has_end == 1;
+
+ $total_rt = $end - $start;
+ $tot_total_rt += $total_rt;
+ $tot_rt += $rt;
+
+ print OUTPUT "$rt\n";
+ $sum_rt += $rt;
+ $max_rt = $rt if $rt > $max_rt;
+}
+
+close INPUT;
+close OUTPUT;
+
+# Hack to fake a filter
+if ( $output eq $filter_output ) {
+ system "cat $output";
+ system "rm $output";
+}
+
+exit 0;
+
+# ---------------------------------------------------------------------------
+
+sub process_options {
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0)";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+
+ # system "cat $0 | awk 'BEGIN { n = 0; } \
+ # /^$/ { print n; \
+ # exit; } \
+ # { n++; }'"
+ exit ;
+ }
+
+ $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
+
+ if ( $#ARGV != 0 ) {
+ #print "Usage: gran-extr [options] <sim-file>\n";
+ #print "Use -h option to get details\n";
+ #exit 1;
+
+ }
+
+ $filter_output = $ENV{'TMPDIR'} . "./,gr2RTS-out";
+ if ( $opt_o ) {
+ $output = $opt_o;
+ } else {
+ if ( $input eq "-" ) {
+ $output = $filter_output;
+ } else {
+ $output = $input; # "RTS";
+ $output =~ s/\.gr$/.rts/g;
+ } #
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+ print "Input file: $input\t Output file: $output\n";
+}
+
+# ----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/gr2ap.bash b/ghc/utils/parallel/gr2ap.bash
new file mode 100644
index 0000000000..7818fe112b
--- /dev/null
+++ b/ghc/utils/parallel/gr2ap.bash
@@ -0,0 +1,124 @@
+#!/usr/local/bin/bash
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 20:53:36 Stardate: [-31]7859.14 hwloidl>
+#
+# Usage: gr2ap [options] <gr-file>
+#
+# Create a per-thread activity graph from a GrAnSim (or GUM) profile.
+# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
+# profile (a .qp file) using gr2qp and then into a PostScript file using qp2ap.
+# The generated PostScript file shows one horizontal line for each task. The
+# thickness of the line indicates the state of the thread:
+# thick ... active, medium ... suspended, thin ... fetching remote data
+#
+# Options:
+# -o <file> ... write .ps file to <file>
+# -m ... create mono PostScript file instead a color one.
+# -O ... optimise i.e. try to minimise the size of the .ps file.
+# -v ... be talkative.
+# -h ... print help message (this header).
+#
+##############################################################################
+
+progname="`basename $0`"
+args="$*"
+
+verb=0
+help=0
+mono=""
+apfile=""
+optimise=""
+scale=""
+width=""
+
+getopts "hvmo:s:w:OD" name
+while [ "$name" != "?" ] ; do
+ case $name in
+ h) help=1;;
+ v) verb=1;;
+ m) mono="-m";;
+ o) apfile="$OPTARG";;
+ s) scale="-s $OPTARG";;
+ w) width="-w $OPTARG";;
+ O) optimise="-O";;
+ D) debug="-D";;
+ esac
+ getopts "hvmo:s:w:OD" name
+done
+
+opts="$mono $optimise $scale $width"
+
+shift $[ $OPTIND - 1 ]
+
+if [ $help -eq 1 ]
+ then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
+ /^$/ { print n; \
+ exit; } \
+ { n++; }'`
+ echo "`head -$no_of_lines $0`"
+ exit
+fi
+
+
+if [ -z "$1" ]
+ then echo "Usage: $progname [options] file[.gr]"
+ echo "Use -h option for details"
+ exit 1;
+fi
+
+f="`basename $1 .gr`"
+grfile="$f".gr
+qpfile="${TMPDIR:-.}/$f".qp
+ppfile="${TMPDIR:-.}/$f".pp
+
+if [ -z "$apfile" ]
+ then apfile="$f"_ap.ps
+fi
+
+if [ $verb -eq 1 ]
+ then echo "Input file: $grfile"
+ echo "Quasi-parallel file: $qpfile"
+ echo "PostScript file: $apfile"
+ echo "Options forwarded to qp2ap: $opts"
+ if [ "$mono" = "-m" ]
+ then echo "Producing monochrome PS file"
+ else echo "Producing color PS file"
+ fi
+ if [ "$debug" = "-D" ]
+ then echo "Debugging is turned ON"
+ else echo "Debugging is turned OFF"
+ fi
+fi
+
+
+# unset noclobber
+
+if [ ! -f "$grfile" ]
+ then
+ echo "$grfile does not exist"
+ exit 1
+ else
+ # rm -f "$qpfile" "$apfile"
+ prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
+ echo "$prog" >| "$qpfile"
+ if [ $verb -eq 1 ]
+ then echo "Executed program: $prog"
+ fi
+ date >> "$qpfile"
+ #date="`date`" # This is the date of running the script
+ date="`tail +2 $grfile | head -1 | sed -e 's/Start time: //'`"
+ cat "$grfile" | gr2qp >> "$qpfile"
+ # Sorting is part of gr2qp now.
+ # | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
+ # max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
+ xmax=`tail -1 "$qpfile" | awk '{ print $2; }'`
+ ymax=`tail -1 "$qpfile" | awk '{ print $8; }'`
+ if [ $verb -eq 1 ]
+ then echo "Total runtime: $xmax"
+ echo "Total number of tasks: $ymax"
+ fi
+ tail +3 "$qpfile" | qp2ap $opts "$xmax" "$ymax" "$prog" "$date" >| "$apfile"
+ rm -f "$qpfile"
+ # Old: qp2ap.pl $mono $max "$prog" "$date" < "$qpfile" > "$apfile"
+fi
+
diff --git a/ghc/utils/parallel/gr2gran.bash b/ghc/utils/parallel/gr2gran.bash
new file mode 100644
index 0000000000..0db4dab604
--- /dev/null
+++ b/ghc/utils/parallel/gr2gran.bash
@@ -0,0 +1,113 @@
+#!/usr/local/bin/bash
+##############################################################################
+# Last modified: Time-stamp: <95/08/01 02:21:56 hwloidl>
+#
+# Usage: gr2gran [options] <sim-file>
+#
+# Create granularity graphs for the GrAnSim profile <sim-file>. This creates
+# a bucket statistics and a cumulative runtimes graph.
+# This script is derived from the much more complex gran-extr script, which
+# also produces such graphs and much more information, too.
+#
+# Options:
+# -t <file> ... use <file> as template file (<,> global <.> local template)
+# -p <file> ... use <file> as gnuplot .gp file (default: gran.gp)
+# -x <x-size> ... of gnuplot graph
+# -y <y-size> ... of gnuplot graph
+# -n <n> ... use <n> as number of PEs in title
+# -o <file> ... keep the intermediate <file> (sorted list of all runtimes)
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+##############################################################################
+
+progname="`basename $0`"
+args="$*"
+
+help=0
+verb=0
+template=""
+plotfile=""
+x=""
+y=""
+n=""
+rtsfile=""
+keep_rts=0
+
+getopts "hvt:p:x:y:n:o:" name
+while [ "$name" != "?" ] ; do
+ case $name in
+ h) help=1;;
+ v) verb=1;;
+ t) template="-t $OPTARG";;
+ p) plotfile="-p $OPTARG";;
+ x) x="-x $OPTARG";;
+ y) y="-y $OPTARG";;
+ n) n="-n $OPTARG";;
+ o) rtsfile="$OPTARG";;
+ esac
+ getopts "hvt:p:x:y:n:o:" name
+done
+
+shift $[ $OPTIND - 1 ]
+
+if [ $help -eq 1 ]
+ then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
+ /^$/ { print n; \
+ exit; } \
+ { n++; }'`
+ echo "`head -$no_of_lines $0`"
+ exit
+fi
+
+if [ -z "$1" ]
+ then echo "Usage: $progname [options] file[.gr]"
+ echo "Use -h option for details"
+ exit 1;
+fi
+
+f="`basename $1 .gr`"
+grfile="${f}.gr"
+if [ -z "$rtsfile" ]
+ then rtsfile="${f}.rts"
+ rtsopt="-o $rtsfile"
+ else rtsopt="-o $rtsfile"
+ keep_rts=1
+fi
+
+opts_RTS="$rtsopt "
+opts_ps="$template $plotfile $x $y $n "
+
+if [ $verb -eq 1 ]
+ then echo "Input file: $grfile"
+ if [ ${keep_rts} -eq 1 ]
+ then echo "Intermediate file: $rtsfile (kept after termination)"
+ else echo "Intermediate file: $rtsfile (discarded at end)"
+ fi
+ verb_opt="-v "
+ opts_RTS="${opts_RTS} $verb_opt "
+ opts_ps="${opts_ps} $verb_opt "
+ echo "Options for gr2RTS: ${opts_RTS}"
+ echo "Options for RTS2gran: ${opts_ps}"
+fi
+
+
+# unset noclobber
+if [ ! -f "$grfile" ]
+ then
+ echo "$grfile does not exist"
+ exit 1
+ else
+ # rm -f "$rtsfile"
+ if [ $verb -eq 1 ]
+ then echo "gr2RTS ..."
+ fi
+ gr2RTS ${opts_RTS} $grfile
+ if [ $verb -eq 1 ]
+ then echo "RTS2gran ..."
+ fi
+ RTS2gran ${opts_ps} $rtsfile
+ if [ ${keep_rts} -ne 1 ]
+ then rm -f $rtsfile
+ fi
+fi \ No newline at end of file
diff --git a/ghc/utils/parallel/gr2java.pl b/ghc/utils/parallel/gr2java.pl
new file mode 100644
index 0000000000..acd0b5e631
--- /dev/null
+++ b/ghc/utils/parallel/gr2java.pl
@@ -0,0 +1,322 @@
+#!/usr/local/bin/perl
+##############################################################################
+#
+# Usage: gr2java [options]
+#
+# Filter that transforms a GrAnSim profile (a .gr file) at stdin to
+# a quasi-parallel profile (a .qp file). It is the common front-end for most
+# visualization tools (except gr2pe). It collects running,
+# runnable and blocked tasks in queues of different `colours', whose meaning
+# is:
+# G ... green; queue of all running tasks
+# A ... amber; queue of all runnable tasks
+# R ... red; queue of all blocked tasks
+# Y ... cyan; queue of fetching tasks
+# C ... crimson; queue of tasks that are being stolen
+# B ... blue; queue of all sparks
+#
+# Options:
+# -i <int> ... info level from 1 to 7; number of queues to count (see qp3ps)
+# -I <str> ... count tasks that are in one of the given queues; encoding:
+# 'a' ... active (running)
+# 'r' ... runnable
+# 'b' ... blocked
+# 'f' ... fetching
+# 'm' ... migrating
+# 's' ... sparks
+# (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
+# -c ... check consistency of data (e.g. no neg. number of tasks)
+# -v ... be talkative.
+# -h ... print help message (this header).
+#
+##############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvDSci:I:');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+$max = 0;
+$pmax = 0;
+$ptotal = 0;
+$n = 0;
+
+$active = 0;
+$runnable = 0;
+$blocked = 0;
+$fetching = 0;
+$migrating = 0;
+$sparks = 0;
+
+$improved_sort_option = $opt_S ? "-S" : "";
+
+open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
+
+$in_header = 9;
+while(<>) {
+ if ( $in_header == 9 ) {
+ if (/^=/) {
+ $gum_style_gr = 1;
+ $in_header = 0;
+ } else {
+ $gum_style_gr = 0;
+ $in_header = 1;
+ }
+
+ }
+ if (/^\++$/) {
+ $in_header=0;
+ next;
+ }
+ next if $in_header;
+ next if /^$/;
+ next if /^=/;
+ chop;
+ ($PE, $pe, $time, $act, $tid, $rest) = split;
+ $time =~ s/[\[\]:]//g;
+ # next if $act eq 'REPLY';
+ chop($tid) if $act eq 'END';
+ $from = $queue{$tid};
+ $extra = "";
+ if ($act eq 'START') {
+ $from = '*';
+ $to = 'G';
+ $n++;
+ if ( $n > $pmax ) { $pmax = $n; }
+ $ptotal++;
+ } elsif ($act eq 'START(Q)') {
+ $from = '*';
+ $to = 'A';
+ $n++;
+ if ( $n > $pmax ) { $pmax = $n; }
+ $ptotal++;
+ } elsif ($act eq 'STEALING') {
+ $to = 'C';
+ } elsif ($act eq 'STOLEN') {
+ $to = 'G';
+ } elsif ($act eq 'STOLEN(Q)') {
+ $to = 'A';
+ } elsif ($act eq 'FETCH') {
+ $to = 'Y';
+ } elsif ($act eq 'REPLY') {
+ $to = 'R';
+ } elsif ($act eq 'BLOCK') {
+ $to = 'R';
+ } elsif ($act eq 'RESUME') {
+ $to = 'G';
+ $extra = " 0 0x0";
+ } elsif ($act eq 'RESUME(Q)') {
+ $to = 'A';
+ $extra = " 0 0x0";
+ } elsif ($act eq 'END') {
+ $to = '*';
+ $n--;
+ if ( $opt_c && $n < 0 ) {
+ print STDERR "Error at time $time: neg. number of tasks: $n\n";
+ }
+ } elsif ($act eq 'SCHEDULE') {
+ $to = 'G';
+ } elsif ($act eq 'DESCHEDULE') {
+ $to = 'A';
+ # The following are only needed for spark profiling
+ } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
+ $from = '*';
+ $to = 'B';
+ } elsif ($act eq 'USED') {
+ $from = 'B';
+ $to = '*';
+ } elsif ($act eq 'PRUNED') {
+ $from = 'B';
+ $to = '*';
+ } elsif ($act eq 'EXPORTED') {
+ $from = 'B';
+ $to = 'B';
+ } elsif ($act eq 'ACQUIRED') {
+ $from = 'B';
+ $to = 'B';
+ } else {
+ print STDERR "Error at time $time: unknown event $act\n";
+ }
+ $queue{$tid} = $to;
+
+ if ( $from eq '' ) {
+ print STDERRR "Error at time $time: process $tid has no from queue\n";
+ }
+ if ($to ne $from) {
+ print FOOL $time, " ", $pe, " ",
+ $from, $to, "\n";
+ }
+
+ if ($to ne $from) {
+ # Compare with main loop in qp3ps
+ if ($from eq '*') {
+ } elsif ($from eq 'G') {
+ --$active;
+ } elsif ($from eq 'A') {
+ --$runnable;
+ } elsif ($from eq 'R') {
+ --$blocked;
+ } elsif ($from eq 'B') {
+ --$sparks;
+ } elsif ($from eq 'C') {
+ --$migrating;
+ } elsif ($from eq 'Y') {
+ --$fetching;
+ } else {
+ print STDERR "Illegal from char: $from at $time\n";
+ }
+
+ if ($to eq '*') {
+ } elsif ($to eq 'G') {
+ ++$active;
+ } elsif ($to eq 'A') {
+ ++$runnable;
+ } elsif ($to eq 'R') {
+ ++$blocked;
+ } elsif ($to eq 'B') {
+ ++$sparks;
+ } elsif ($to eq 'C') {
+ ++$migrating;
+ } elsif ($to eq 'Y') {
+ ++$fetching;
+ } else {
+ print STDERR "Illegal to char: $to at $time\n";
+ }
+
+ }
+
+ $curr = &count();
+ if ( $curr > $max ) {
+ $max = $curr;
+ }
+
+ if ( 0 ) {
+ print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
+ "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
+ " max = $max\n" ;
+ }
+
+ #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n" if $opt_D;
+
+ if ( $time > $tmax ) {
+ $tmax = $time;
+ }
+ delete $queue{$tid} if $to eq '*';
+
+}
+
+print "Time: ", $tmax, " Max_selected_tasks: ", $max,
+ " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
+
+close(FOOL);
+
+exit 0;
+
+# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+# Copied from qp3ps and slightly modified (we don't keep a list for each queue
+# but just compute the max value we get out of all calls to count during the
+# execution of the script).
+# -----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+
+sub queue_on {
+ local ($queue) = @_;
+
+ return index($show,$queue)+1;
+}
+
+# -----------------------------------------------------------------------------
+
+sub count {
+ local ($res);
+
+ $res = (($queue_on_a) ? $active : 0) +
+ (($queue_on_r) ? $runnable : 0) +
+ (($queue_on_b) ? $blocked : 0) +
+ (($queue_on_f) ? $fetching : 0) +
+ (($queue_on_m) ? $migrating : 0) +
+ (($queue_on_s) ? $sparks : 0);
+
+ return $res;
+}
+
+# -----------------------------------------------------------------------------
+# DaH 'oH lo'lu'Qo'
+# -----------------------------------------------------------------------------
+
+sub set_values {
+ local ($samples,
+ $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
+
+ $G[$samples] = queue_on_a ? $active : 0;
+ $A[$samples] = queue_on_r ? $runnable : 0;
+ $R[$samples] = queue_on_b ? $blocked : 0;
+ $Y[$samples] = queue_on_f ? $fetching : 0;
+ $B[$samples] = queue_on_s ? $sparks : 0;
+ $C[$samples] = queue_on_m ? $migrating : 0;
+}
+
+# -----------------------------------------------------------------------------
+
+sub process_options {
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ $show = "armfb";
+
+ if ( $opt_i ) {
+ $show = "a" if info_level == 1;
+ $show = "ar" if info_level == 2;
+ $show = "arb" if info_level == 3;
+ $show = "arfb" if info_level == 4;
+ $show = "armfb" if info_level == 5;
+ $show = "armfbs" if info_level == 6;
+ }
+
+ if ( $opt_I ) {
+ $show = $opt_I;
+ }
+
+ if ( $opt_v ){
+ $verbose = 1;
+ }
+
+ $queue_on_a = &queue_on("a");
+ $queue_on_r = &queue_on("r");
+ $queue_on_b = &queue_on("b");
+ $queue_on_f = &queue_on("f");
+ $queue_on_s = &queue_on("s");
+ $queue_on_m = &queue_on("m");
+}
+
+sub print_verbose_message {
+
+ print STDERR "Info-str: $show\n";
+ print STDERR "The following queues are turned on: " .
+ ( $queue_on_a ? "active, " : "") .
+ ( $queue_on_r ? "runnable, " : "") .
+ ( $queue_on_b ? "blocked, " : "") .
+ ( $queue_on_f ? "fetching, " : "") .
+ ( $queue_on_m ? "migrating, " : "") .
+ ( $queue_on_s ? "sparks" : "") .
+ "\n";
+}
diff --git a/ghc/utils/parallel/gr2jv.bash b/ghc/utils/parallel/gr2jv.bash
new file mode 100644
index 0000000000..7eeacfe556
--- /dev/null
+++ b/ghc/utils/parallel/gr2jv.bash
@@ -0,0 +1,123 @@
+#!/usr/local/bin/bash
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 20:38:02 Stardate: [-31]7859.09 hwloidl>
+#
+# Usage: gr3jv [options] <gr-file>
+#
+# Create a per-thread activity graph from a GrAnSim (or GUM) profile.
+# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
+# profile (a .qp file) using gr3qp and then into a PostScript file using qp3ap.
+# The generated PostScript file shows one horizontal line for each task. The
+# thickness of the line indicates the state of the thread:
+# thick ... active, medium ... suspended, thin ... fetching remote data
+#
+# Options:
+# -o <file> ... write .ps file to <file>
+# -m ... create mono PostScript file instead a color one.
+# -O ... optimise i.e. try to minimise the size of the .ps file.
+# -v ... be talkative.
+# -h ... print help message (this header).
+#
+##############################################################################
+
+progname="`basename $0`"
+args="$*"
+
+verb=0
+help=0
+mono=""
+apfile=""
+optimise=""
+scale=""
+width=""
+
+getopts "hvmo:s:w:OD" name
+while [ "$name" != "?" ] ; do
+ case $name in
+ h) help=1;;
+ v) verb=1;;
+ m) mono="-m";;
+ o) apfile="$OPTARG";;
+ s) scale="-s $OPTARG";;
+ w) width="-w $OPTARG";;
+ O) optimise="-O";;
+ D) debug="-D";;
+ esac
+ getopts "hvmo:s:w:OD" name
+done
+
+opts="$mono $optimise $scale $width"
+
+shift $[ $OPTIND - 1 ]
+
+if [ $help -eq 1 ]
+ then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
+ /^$/ { print n; \
+ exit; } \
+ { n++; }'`
+ echo "`head -$no_of_lines $0`"
+ exit
+fi
+
+
+if [ -z "$1" ]
+ then echo "Usage: $progname [options] file[.gr]"
+ echo "Use -h option for details"
+ exit 1;
+fi
+
+f="`basename $1 .gr`"
+grfile="$f".gr
+qpfile="$f".qp
+ppfile="$f".pp
+jvfile="$f".jv
+
+if [ -z "$apfile" ]
+ then apfile="$f"-ap.ps
+fi
+
+if [ $verb -eq 1 ]
+ then echo "Input file: $grfile"
+ echo "Quasi-parallel file: $qpfile"
+ echo "PostScript file: $apfile"
+ echo "Options forwarded to qp3ap: $opts"
+ if [ "$mono" = "-m" ]
+ then echo "Producing monochrome PS file"
+ else echo "Producing color PS file"
+ fi
+ if [ "$debug" = "-D" ]
+ then echo "Debugging is turned ON"
+ else echo "Debugging is turned OFF"
+ fi
+fi
+
+
+# unset noclobber
+
+if [ ! -f "$grfile" ]
+ then
+ echo "$grfile does not exist"
+ exit 1
+ else
+ # rm -f "$qpfile" "$apfile"
+ prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
+ echo "$prog" >| "$jvfile"
+ if [ $verb -eq 1 ]
+ then echo "Executed program: $prog"
+ fi
+ date >> "$jvfile"
+ #date="`date`" # This is the date of running the script
+ date="`tail +2 $grfile | head -1 | sed -e 's/Start-Time: //'`"
+ cat "$grfile" | gr2java >> "$jvfile"
+ # Sorting is part of gr2qp now.
+ # | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
+ # max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
+ xmax=`tail -1 "$jvfile" | awk '{ print $2; }'`
+ ymax=`tail -1 "$jvfile" | awk '{ print $8; }'`
+ if [ $verb -eq 1 ]
+ then echo "Total runtime: $xmax"
+ echo "Total number of tasks: $ymax"
+ fi
+ # Old: qp2ap.pl $mono $max "$prog" "$date" < "$qpfile" > "$apfile"
+fi
+
diff --git a/ghc/utils/parallel/gr2pe.pl b/ghc/utils/parallel/gr2pe.pl
new file mode 100644
index 0000000000..6026300758
--- /dev/null
+++ b/ghc/utils/parallel/gr2pe.pl
@@ -0,0 +1,1434 @@
+#!/usr/local/bin/perl
+# (C) Hans Wolfgang Loidl, November 1994
+# ############################################################################
+# Time-stamp: <Fri Jun 14 1996 20:21:17 Stardate: [-31]7659.03 hwloidl>
+#
+# Usage: gr2pe [options] <gr-file>
+#
+# Create per processor activity profile (as ps-file) from a given gr-file.
+#
+# Options:
+# -o <file> ... output file (ps file) has name <file>
+# -m ... produce monochrome output
+# -M ... produce a migration graph
+# -S ... produce a spark graph in a separate file (based on the no. of
+# sparks rather than the no. of runnable threads)
+# -t ... produce trace of runnable, blocked, fetching threads
+# -i <n> ... ``infinity'' for number of blocked tasks (default: 20)
+# all values larger than that are shown with the same width
+# -C ... do consistency check at each event (mainly for debugging)
+# -h ... print help message (this text)
+# -v ... be talkative
+#
+# ############################################################################
+
+# die "This script is still under development -- HWL\n";
+
+# ----------------------------------------------------------------------------
+# Command line processing and initialization
+# ----------------------------------------------------------------------------
+
+require "getopts.pl";
+
+&Getopts('hvDCMNmSGti:o:l:p:');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ----------------------------------------------------------------------------
+# Global Variables
+# ----------------------------------------------------------------------------
+
+$RUNNING = "RUNNING";
+$RUNNABLE = "RUNNABLE";
+$BLOCKED = "BLOCKED";
+$START = "START";
+$END = "END";
+
+# Modes for hline
+#$LITERATE = 1;
+#$NORMALIZING = 2;
+
+%GRAY = (
+ $RUNNING, 0.6,
+ $RUNNABLE, 0.3,
+ $BLOCKED, 0,
+ $START, 0,
+ $END, 0.5);
+
+# Special value showing that no task is running on $pe if in $running[$pe]
+$NO_ID = -1;
+$NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;
+
+# The number of PEs we have
+$nPEs = 32;
+
+# Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
+$width_unit = 1;
+
+# Width of line for RUNNING
+$running_width = 1;
+
+# Offset of BLOCKED and RUNNABLE lines from the center line
+$offset = 10;
+
+# Left and right border of the picture; Width of the picture
+$left_border = 0;
+$right_border = 700;
+$total_width = $right_border - $left_border;
+$x_scale = 1;
+
+# Height of the picture measured from y-val of first to y-val of last PE
+$lower_border = 10;
+$upper_border = 490;
+$total_height = $upper_border - $lower_border;
+$y_scale = 1;
+
+# Constant from where shrinking of x-values (+scaling as usual) is enabled
+$very_big = 1E8;
+
+# Factor by which the x values are shrunk (if very big)
+$shrink_x = 10000;
+
+# Set format of output of numbers
+$# = "%.2g";
+
+# Width of stripes in migration graph
+$tic_width = 2;
+
+# If no spark profile should be generate we count the number of spark events
+# in the profile to inform the user about existing spark information
+if ( !$opt_S ) {
+ $spark_events = 0;
+}
+
+# ----------------------------------------------------------------------------
+# The real thing starts here
+# ----------------------------------------------------------------------------
+
+open (IN,"<$input") || die "$input: $!\n";
+open (OUT,">$output") || die "$output: $!\n";
+open (OUT_MIG,">$output_mig") || die "$output_mig: $!\n" if $opt_M;
+open (OUT_SP,">$output_sp") || die "$output_sp: $!\n" if $opt_S;
+# open (OUT_B,">$output_b") || die "$output_b: $!\n";
+# open (OUT_R,">$output_r") || die "$output_r: $!\n";
+
+open(OUT_RA, ">$RUNNABLE_file") || die "$RUNNABLE_file: $!\n" if $opt_t;
+print OUT_RA "# Number of Runnable tasks on all PEs $i\n" if $opt_t;
+open(OUT_BA, ">$BLOCKED_file") || die "$BLOCKED_file: $!\n" if $opt_t;
+print OUT_BA "# Number of Blocked tasks on all PEs $i\n" if $opt_t;
+open(OUT_FA, ">$FETCHING_file") || die "$FETCHING_file: $!\n" if $opt_t;
+print OUT_FA "# Number of Fetching tasks on all PEs $i\n" if $opt_t;
+
+($pname,$pars,$nPEs,$lat) = &skip_header(IN);
+
+
+# Fill in the y_val table for all PEs
+$offset = (&generate_y_val_table($nPEs)/2);
+
+$x_min = 0;
+$x_max = &get_x_max($input);
+$y_max = $total_height;
+#$y_max = $y_val[$nPEs-1] + offset;
+
+$is_very_big = $x_max > $very_big;
+
+# Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
+$max_width = $offset;
+
+# General init
+do init($nPEs);
+
+do write_prolog(OUT,$x_max,$y_max);
+do write_prolog(OUT_MIG,$x_max,$y_max) if $opt_M;
+do write_prolog(OUT_SP,$x_max,$y_max) if $opt_S;
+# do write_prolog(OUT_B,$x_max,$y_max);
+# do write_prolog(OUT_R,$x_max,$y_max);
+
+while (<IN>) {
+ next if /^$/; # Omit empty lines;
+ next if /^--/; # Omit comment lines;
+
+ ($event, $time, $id, $pe) = &get_line($_);
+ $x_max_ = $time if $time > $x_max_;
+
+ print OUT_RA "TIME: $time PEs: " . join(", ",@runnable) .
+ " SUM: " . &list_sum(@runnable) . "\n" if $opt_t;
+ print OUT_BA "TIME: $time PEs: " . join(", ",@blocked) .
+ " SUM: " . &list_sum(@blocked) . "\n" if $opt_t;
+ print OUT_FA "TIME: $time PEs: " . join(", ",@fetching) .
+ " SUM: " . &list_sum(@fetching) . "\n" if $opt_t;
+
+ foo : {
+ ($event eq "START") && do {
+ # do draw_tic($pe, $time, $START);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ $running[$pe] = $id;
+ # $where{$id} = $pe + 1;
+ last foo;
+ };
+ ($event eq "START(Q)") && do {
+ #do draw_segment($pe, $time, $RUNNABLE);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ #$last_runnable[$pe] = $time;
+ $runnable[$pe]++;
+ # $where{$id} = $pe + 1;
+ last foo;
+ };
+ ($event eq "STEALING") && do {
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ $runnable[$pe]--;
+ $where{$id} = $pe + 1;
+ if ( $opt_M ) {
+ $when{$id} = $time;
+ do draw_tic($pe, $time, $event);
+ }
+ last foo;
+ };
+ ($event eq "STOLEN") && do {
+ # do draw_tic($pe, $time, $START);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ $running[$pe] = $id;
+ if ( $where{$id} ) {
+ # Ok
+ } else {
+ $warn++;
+ print "WARNING: No previous location for STOLEN task $id found!" .
+ " Check the gr file!\n";
+ }
+ if ( $opt_M ) {
+ do draw_tic($pe, $time, $event);
+ do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
+ }
+ last foo;
+ };
+ ($event eq "STOLEN(Q)") && do {
+ #do draw_segment($pe, $time, $RUNNABLE);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ #$last_runnable[$pe] = $time;
+ $runnable[$pe]++;
+ if ( $where{$id} ) {
+ # Ok
+ } else {
+ $warn++;
+ print "WARNING: No previous location for STOLEN(Q) task $id found!" .
+ " Check the gr file!\n";
+ }
+ if ( $opt_M ) {
+ do draw_tic($pe, $time, $event);
+ do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
+ }
+ last foo;
+ };
+ ($event eq "BLOCK") && do {
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ do draw_segment($pe, $time, $BLOCKED) unless $blocked[$pe] == 0 ;
+ $last_blocked[$pe] = $time;
+ #do draw_segment($pe, $time, $RUNNING);
+ $blocked[$pe]++;
+ $running[$pe] = $NO_ID;
+ last foo;
+ };
+ ($event eq "RESUME") && do {
+ # do draw_tic($pe, $time, $START);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ do draw_segment($pe, $time, $BLOCKED);
+ $last_blocked[$pe] = $time;
+ $blocked[$pe]--;
+ $running[$pe] = $id;
+ last foo;
+ };
+ ($event eq "RESUME(Q)") && do {
+ #do draw_segment($pe, $time, $RUNNABLE);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ do draw_segment($pe, $time, $BLOCKED);
+ $last_blocked[$pe] = $time;
+ #$last_runnable[$pe] = $time;
+ $blocked[$pe]--;
+ $runnable[$pe]++;
+ last foo;
+ };
+ ($event eq "END") && do {
+ # do draw_tic($pe, $time, $END);
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ $running[$pe] = $NO_ID;
+ # do draw_segment($pe, $time, $RUNNING);
+ # $last_blocked[$pe] = $time;
+ last foo;
+ };
+ ($event eq "SCHEDULE") && do {
+ # do draw_tic($pe, $time);
+ $last_start[$pe] = $time;
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ $runnable[$pe]--;
+ $running[$pe] = $id;
+ last foo;
+ };
+ # NB: Check these; they are not yet tested
+ ($event eq "FETCH") && do {
+ # Similar to BLOCK; but don't draw a block segment
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ #do draw_segment($pe, $time, $BLOCKED) unless $blocked[$pe] == 0 ;
+ #$last_blocked[$pe] = $time;
+ #$blocked[$pe]++;
+ $fetching[$pe]++;
+ $running[$pe] = $NO_ID;
+ last foo;
+ };
+ ($event eq "REPLY") && do {
+ do draw_bg($pe, $time);
+ $last_bg[$pe] = $time;
+ #do draw_segment($pe, $time, $BLOCKED);
+ #$last_blocked[$pe] = $time;
+ #$blocked[$pe]--;
+ $fetching[$pe]--;
+ $blocked[$pe]++;
+ last foo;
+ };
+ # These are only processed if a spark pofile is generated, too
+ (($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
+ if ( !opt_S ) {
+ $spark_events++;
+ last foo;
+ }
+ do draw_sp_bg($pe, $time);
+ $last_sp_bg[$pe] = $time;
+ $sparks[$pe]++;
+ last foo;
+ };
+
+ (($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
+ if ( !opt_S ) {
+ $spark_events++;
+ last foo;
+ }
+ do draw_sp_bg($pe, $time);
+ $last_sp_bg[$pe] = $time;
+ $sparks[$pe]--;
+ if ( $sparks[$pe]<0 ) {
+ print STDERR "Error: Neg. number of sparks @ $time\n";
+ }
+ last foo;
+ };
+
+ $warn++;
+ print "WARNING: Unknown event: $event\n";
+ }
+ do check_consistency() if $opt_M;
+}
+
+do write_epilog(OUT,$x_max,$y_max);
+do write_epilog(OUT_MIG,$x_max,$y_max) if $opt_M;
+do write_epilog(OUT_SP,$x_max,$y_max) if $opt_S;
+# do write_epilog(OUT_B,$x_max,$y_max);
+# do write_epilog(OUT_R,$x_max,$y_max);
+
+close(IN);
+close(OUT);
+# close(OUT_B);
+# close(OUT_R);
+
+close(OUT_MIG) if $opt_M;
+close(OUT_SP) if $opt_S;
+close(OUT_BA) if $opt_t;
+close(OUT_RA) if $opt_t;
+close(OUT_FA) if $opt_t;
+
+#for ($i=0; $i<$nPEs; $i++) {
+# close($OUT_BA[$i]);
+# close($OUT_RA[$i]);
+#}
+
+if ($x_max != $x_max_ ) {
+ print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
+}
+
+print "Number of suppressed warnings: $warn\n" if $warn>0;
+print "FYI: The file $input contains $spark_events lines of spark information\n" if !opt_S && ($spark_events>0);
+
+system "gzip -f1 $RUNNABLE_file" if $opt_t;
+system "gzip -f1 $BLOCKED_file" if $opt_t;
+system "gzip -f1 $FETCHING_file" if $opt_t;
+
+system "fortune -s" if $opt_v;
+
+exit 0;
+
+# ----------------------------------------------------------------------------
+# This translation is mainly taken from gr2qp.awk
+# This subroutine returns the event found on the current line together with
+# the relevant information for that event. The possible EVENTS are:
+# START, STARTQ, STOLEN, BLOCK, RESUME, RESUMEQ, END, SCHEDULE
+# ----------------------------------------------------------------------------
+
+sub get_line {
+ local ($line) = @_;
+ local ($f, @fs);
+ local ($event, $time, $id, $pe);
+
+ @fs = split(/[:\[\]\s]+/,$line);
+ $event = $fs[3];
+ $time = $fs[2];
+ $id = $fs[4];
+ $pe = $fs[1];
+
+ print OUT "% > " . $_ if $opt_D;
+ print OUT "% EVENT = $event; TIME = $time; ID = $id; PE = $pe\n" if $opt_D;
+ print OUT "% --> this task comes from PE " . ($where{$id}-1) . "\n" if $opt_D && $event eq "STOLEN";
+
+ return ($event, $time, $id, $pe);
+
+ # if ($fs[3] eq "START") {
+ # partprofile = 0;
+ # print (substr($3,2,length($3)-3))," *G 0 0x" $5;
+ # }
+ # if ($fs[3] eq "START(Q)") {
+ # print (substr($3,2,length($3)-3))," *A 0 0x" $5;
+ # }
+
+ # if ($fs[3] eq "STOLEN") {
+ # print (substr($3,2,length($3)-3))," AG 0 0x" $5;
+ # }
+
+ # if ($fs[3] eq "BLOCK") {
+ # print (substr($3,2,length($3)-3))," GR 0 0x" $5;
+ # }
+ # if ($fs[3] eq "RESUME") {
+ # print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0";
+ # }
+ # if ($fs[3] eq "RESUME(Q)") {
+ # print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0";
+ # }
+ # if ($fs[3] eq "END") {
+ # if (partprofile) {
+ # p rint (substr($9,1,length($9)-1))," *G 0 0x" (substr($5,1,length($5)-1));
+ # p rint (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
+ # } else {
+ # print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
+ # }
+ # }
+ # if ($fs[3] eq "SCHEDULE") {
+ # print (substr($3,2,length($3)-3))," AG 0 0x" $5;
+ # }
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub check_consistency {
+ local ($i);
+
+ for ($i=0; $i<$nPEs; $i++) {
+ if ( $runnable[$i] < 0 ) {
+ print "INCONSISTENCY: PE $i: Size of runnable queue: $runnable[$i] at time $time\n";
+ $runnable[$i] = 0 ;
+ }
+ if ( $blocked[$i] < 0 ) {
+ print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
+ $blocked[$i] = 0 ;
+ }
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_width {
+ local ($n, $type) = @_;
+
+ $warn++ if $n <0;
+ print "WARNING: Neg. number of tasks in $type queue: $n!!\n" if $n <0;
+ $n = 0 if $n <0;
+ return ( ($type eq $RUNNING) ? ($running_width * $width_unit) :
+ &min($max_width, $n * $width_unit) );
+}
+
+# ----------------------------------------------------------------------------
+# Use an intensity between 0 (empty runnable queue) and 1 (`full' runnable
+# queue) to abstract from monchrome/color values
+# The concrete grayshade/color is computed via PS macros.
+# ----------------------------------------------------------------------------
+
+sub get_intensity {
+ local ($n) = @_;
+
+ print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n" if $n<0;
+
+ if ($n >= $inf_block) {
+ return 1.0;
+ } else {
+ return ($n+1)/$inf_block;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_sp_intensity {
+ local ($n) = @_;
+
+ print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n" if $n<0;
+
+ if ($n >= $inf_block) {
+ return 1.0;
+ } else {
+ return ($n+1)/$inf_block;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_shade {
+ local ($n) = @_;
+
+
+ if ($n > $inf_block) {
+ return 0.2;
+ } else {
+ return 0.8 - ($n/$inf_block);
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub max {
+ local($x, $y) = @_;
+
+ return ($x>$y ? $x : $y);
+}
+
+# ----------------------------------------------------------------------------
+
+sub min {
+ local($x, $y) = @_;
+
+ return ($x<$y ? $x : $y);
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_sum {
+ local (@list) = @_;
+
+ local ($sum);
+
+ foreach $x (@list) {
+ $sum += $x;
+ }
+
+ return ($sum);
+}
+
+# ----------------------------------------------------------------------------
+# Drawing functions.
+# Put on top of funtions that directly generate PostScript.
+# ----------------------------------------------------------------------------
+
+sub draw_segment {
+ local ($pe, $time, $type) = @_;
+ local ($x, $y, $width, $gray);
+
+ if ( $type eq $BLOCKED ) {
+ if ( $last_blocked[$pe] == $NO_LAST_BLOCKED ) { return; };
+ $width = &get_width($blocked[$pe], $type);
+ if ( $width == 0 ) { return; };
+ $y = $stripes_low[$pe] + int($width/2 + 0.5);
+ $x = $last_blocked[$pe];
+
+ if ( $is_very_big ) {
+ $x = int($x/$shrink_x) + 1; # rounded up
+ }
+
+ # $gray = 0.5; # Ignoring gray level; doesn't change!
+ do ps_draw_hline(OUT,$x,$y,$time,$width);
+ } else {
+ die "ERROR: Unknow type of line: $type in draw segment\n";
+ }
+
+ if ($x < 0 || $y<0) {
+ die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
+ }
+ if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
+ die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub draw_tic {
+ local ($pe, $time, $event) = @_;
+ local ($x, $y, $lit);
+
+ $ystart = $stripes_low[$pe];
+ $yend = $stripes_high[$pe];
+ $x = $time;
+ if ( $event eq "STEALING" ) {
+ $lit = 0; # i.e. FROM
+ } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
+ $lit = 1; # i.e. TO
+ } else {
+ die "ERROR: Wrong event $event in draw_tic\n";
+ }
+
+ if ( $is_very_big ) {
+ $x = int($x/$shrink_x) + 1; # rounded up
+ }
+
+ if ($x < 0 || $ystart<0 || $yend<0) {
+ die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
+ }
+ do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
+}
+
+# ----------------------------------------------------------------------------
+
+sub draw_bg {
+ local ($pe,$time) = @_;
+ local ($x_start, $x_end, $intensity, $secondary_intensity);
+
+ if ( $last_bg[$pe] == $NO_LAST_BG ) {
+ print OUT "% Omitting BG: NO LAST BG\n" if $opt_D;
+ return;
+ }
+ if ( $running[$pe] == $NO_ID ) {
+ print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D;
+ # return;
+ }
+ $x_start = $last_bg[$pe];
+ $x_end = $time;
+ $intensity = ( $running[$pe] == $NO_ID ?
+ 0 :
+ &get_intensity($runnable[$pe]) );
+ $secondary_intensity = ( $running[$pe] == $NO_ID ?
+ 0 :
+ &get_intensity($fetching[$pe]) );
+ do ps_draw_bg(OUT,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
+ $intensity,$secondary_intensity);
+
+ if ( $opt_M ) {
+ do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end,
+ $mig_width);
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+# Variant of draw_bg; used for spark profile
+# ----------------------------------------------------------------------------
+
+sub draw_sp_bg {
+ local ($pe,$time) = @_;
+ local ($x_start, $x_end, $intensity, $secondary_intensity);
+
+ if ( $last_sp_bg[$pe] == $NO_LAST_BG ) {
+ print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D;
+ return;
+ }
+ $x_start = $last_sp_bg[$pe];
+ $x_end = $time;
+ $intensity = ( $sparks[$pe] <= 0 ?
+ 0 :
+ &get_sp_intensity($sparks[$pe]) );
+ $secondary_intensity = 0;
+ do ps_draw_bg(OUT_SP,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
+ $intensity,$secondary_intensity);
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub draw_arrow {
+ local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
+ local ($ystart,$yend);
+
+ $ystart = $stripes_high[$from_pe];
+ $yend = $stripes_low[$to_pe];
+ do ps_draw_arrow(OUT_MIG,$send_time,$arrive_time,$ystart,$yend);
+}
+
+# ----------------------------------------------------------------------------
+# Normalize the x value s.t. it fits onto the page without scaling.
+# The global values $left_border and $right_border and $total_width
+# determine the borders
+# of the graph.
+# This fct is only called from within ps_... fcts. Before that the $x values
+# are always times.
+# ----------------------------------------------------------------------------
+
+sub normalize {
+ local ($x) = @_;
+
+ return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
+}
+
+# ----------------------------------------------------------------------------
+# PostScript generation functions.
+# Lowest level of writing output file.
+# Now there is only normalizing mode supported.
+# The following is out of date:
+# $mode can be $LITERATE i.e. assuming scaling has been done
+# or $NORMALIZING i.e. no scaling has been done so far (do it in
+# macros for drawing)
+# ----------------------------------------------------------------------------
+
+sub ps_draw_hline {
+ local ($OUT,$xstart,$y,$xend,$width) = @_;
+ local ($xlen);
+
+ print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D;
+
+ if ( ! $opt_N ) {
+ $xstart = &normalize($xstart);
+ $xend = &normalize($xend);
+ }
+
+ $xlen = $xend - $xstart;
+
+ printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
+ # ( $mode == $LITERATE ? " L\n" : " N\n");
+
+ # Old version:
+ # print $OUT "newpath\n";
+ # print $OUT "$GRAY{$type} setgray\n";
+ # print $OUT $xend . " " . $y . " " . $xstart . " " . $y . " " . $width .
+ # " line\n";
+ # print $OUT "stroke\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub ps_draw_vline {
+ local ($OUT,$x,$ystart,$yend,$width) = @_;
+
+ print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D;
+
+ if ( ! $opt_N ) {
+ $x = &normalize($x);
+ }
+
+ print $OUT "newpath\n";
+ print $OUT "0 setgray\n"; # constant gray level
+ printf $OUT ("%d %d %d %d %.1g line\n",
+ $x,$yend ,$x,$ystart,$width);
+ print $OUT "stroke\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub ps_draw_tic {
+ local ($OUT,$x,$ystart,$yend,$lit) = @_;
+
+ print $OUT "% TIC at ($x,$ystart-$yend)\n" if $opt_D;
+
+ if ( ! $opt_N ) {
+ $x = &normalize($x);
+ }
+
+ printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);
+
+ # Old version without PostScript macro /tic:
+ # print $OUT "newpath\n";
+ # print $OUT "ticwidth setlinewidth\n" .
+ # $x . " " . $y . " ticlen sub moveto\n" .
+ # $x . " " . $y . " ticlen add lineto\n";
+ #print $OUT "stroke\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub ps_draw_arrow {
+ local ($OUT,$xstart,$xend,$ystart,$yend) = @_;
+
+ print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n" if $opt_D;
+
+ if ( ! $opt_N ) {
+ $xstart = &normalize($xstart);
+ $xend = &normalize($xend);
+ }
+
+ printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
+}
+
+# ----------------------------------------------------------------------------
+
+sub ps_draw_bg {
+ local ($OUT,$xstart, $xend, $ystart, $yend,
+ $intensity, $secondary_intensity) = @_;
+ local ($xlen, $ylen);
+
+ print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
+ " (intensity: $intensity, $secondary_intensity)\n" if $opt_D;
+
+ if ( ! $opt_N ) {
+ $xstart = &normalize($xstart);
+ $xend = &normalize($xend);
+ }
+
+ $xlen = $xend - $xstart;
+ $ylen = $yend - $ystart;
+
+ printf $OUT ("%d %d %d %d %.2g %.2g R\n",
+ $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);
+
+ # Old version without PostScript macro /rect:
+ #print $OUT "newpath\n";
+ #print $OUT " $x_start $y_start moveto\n";
+ #print $OUT " $x_end $y_start lineto\n";
+ #print $OUT " $x_end $y_end lineto\n";
+ #print $OUT " $x_start $y_end lineto\n";
+ #print $OUT "closepath\n";
+ #print $OUT "$gray setgray\n";
+ #print $OUT "fill\n";
+}
+
+# ----------------------------------------------------------------------------
+# Initialization and such
+# ----------------------------------------------------------------------------
+
+sub write_prolog {
+ local ($OUT, $x_max, $y_max) = @_;
+ local ($date, $dist, $y, $i);
+
+ $date = &get_date();
+
+ if ( $opt_N ) {
+ $x_scale = $total_width/$x_max;
+ $y_scale = $total_height/$y_max;
+ }
+
+ # $tic_width = 2 * $x_max/$total_width; constant now
+ # $tic_len = 4 * $y_max/$total_height;
+
+ print $OUT "%!PS-Adobe-2.0\n";
+ print $OUT "%%BoundingBox: \t0 0 560 800\n";
+ print $OUT "%%Title: \t$pname $pars\n";
+ print $OUT "%%Creator: \tgr2pe\n";
+ print $OUT "%%CreationDate: \t$date\n";
+ # print $OUT "%%Orientation: \tSeascape\n";
+ print $OUT "%%EndComments\n";
+
+ # print $OUT "%%BeginSetup\n";
+ # print $OUT "%%PageOrientation: \tSeascape\n";
+ # print $OUT "%%EndSetup\n";
+
+ print $OUT "%/runlineto {1.5 setlinewidth lineto} def\n";
+ print $OUT "%/suspendlineto {0.5 setlinewidth lineto} def\n";
+ print $OUT "%/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n";
+ print $OUT "%/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n";
+ print $OUT "\n";
+ print $OUT "/total-len $x_max def\n";
+ print $OUT "/show-len $total_width def\n";
+ print $OUT "/normalize { show-len mul total-len div } def\n";
+ print $OUT "/x-normalize { exch show-len mul total-len div exch } def\n";
+ print $OUT "/str-len 12 def\n";
+ #print $OUT "/prt-n { str-len string cvs show } def" .
+ # " % print top-of-stack integer\n";
+ print $OUT "/prt-n { cvi str-len string cvs \n" .
+ " dup stringwidth pop \n" .
+ " currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
+ " neg 0 rmoveto \n" .
+ " show } def \n" .
+ " % print top-of-stack integer centered at the current point\n";
+ print $OUT "/ticwidth $tic_width def\n";
+ print $OUT "%/ticlen $tic_len def % actually half of the tic-length\n";
+ print $OUT "/T % Draw a tic mark\n" .
+ " { % Operands: x, y-start, y-end of tic, from/to flag \n" .
+ " newpath\n" .
+ " 0 eq { " . ( $opt_m ? " 0.2 setgray }"
+ : " 0 0.7 0.2 setrgbcolor }" ) .
+ " { " . ( $opt_m ? " 0.8 setgray }"
+ : " 0.7 0 0.2 setrgbcolor }" ) . " ifelse\n" .
+ " ticwidth setlinewidth\n" .
+ " 3 copy pop moveto\n" .
+ " exch pop lineto\n" .
+ " stroke\n" .
+ " } def\n";
+ # " 3 copy pop x-normalize moveto\n" .
+ # " exch pop x-normalize lineto\n" .
+ # " stroke\n" .
+ # " } def\n";
+ print $OUT "/blocked-gray 0 def\n";
+ print $OUT "/idle-gray 1 def\n";
+ print $OUT "/blocked-color { 0.2 0.1 0.8 } def\n";
+ print $OUT "/idle-color { 0.8 0.1 0.2 } def\n";
+ print $OUT "/idle-color-fetch { 0.5 0.6 0.4 } def\n";
+ print $OUT "/L % Draw a line (for blocked tasks)\n" .
+ " { % Operands: (x,y)-start xlen width\n" .
+ " newpath \n" .
+ ( $opt_m ? " blocked-gray setgray\n" :
+ " blocked-color setrgbcolor\n") .
+ " setlinewidth 3 copy pop moveto 0 rlineto pop pop stroke} def\n";
+ print $OUT "/N % Draw a normalized line\n" .
+ " { % Operands: (x,y)-start xlen width\n" .
+ " newpath \n" .
+ ( $opt_m ? " blocked-gray setgray\n" :
+ " blocked-color setrgbcolor\n") .
+ " setlinewidth 3 copy pop x-normalize moveto normalize 0 rlineto pop pop stroke} def\n";
+ print $OUT "% /L line def\n";
+ print $OUT "/printText { 0 0 moveto (GrAnSim) show } def\n";
+ if ( $opt_m ) {
+ print $OUT "/logo { gsave \n" .
+ " translate \n" .
+ " .95 -.05 0 " .
+ " { setgray printText 1 -.5 translate } for \n" .
+ " 1 setgray printText\n" .
+ " grestore } def\n";
+ } else {
+ print $OUT "/logo { gsave \n" .
+ " translate \n" .
+ " .95 -.05 0\n" .
+ " { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
+ " 1 0 0 setrgbcolor printText\n" .
+ " grestore} def\n";
+ }
+
+ print $OUT "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
+ print $OUT "/starside \n" .
+ " {starlen 0 lineto currentpoint translate \n" .
+ " -144 rotate } def\n";
+
+ print $OUT "/star \n" .
+ " { moveto \n" .
+ " currentpoint translate \n" .
+ " 4 {starside} repeat \n" .
+ " closepath \n" .
+ " gsave \n" .
+ " .7 setgray fill \n" .
+ " grestore \n" .
+ " % stroke \n" .
+ " } def \n";
+ #print $OUT "/get-shade % compute shade from intensity\n" .
+ # " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
+ if ( $opt_m ) {
+ print $OUT "/from 0.2 def\n";
+ print $OUT "/to 0.8 def\n";
+ print $OUT "/get-shade % compute shade from intensity\n" .
+ " { pop dup 0 eq { pop idle-gray }\n " .
+ " { 1 exch sub to from sub mul from add } ifelse } def\n";
+ " { pop 1 exch sub to from sub mul from add } def\n";
+ } else {
+ print $OUT "/from 0.5 def\n";
+ print $OUT "/to 0.9 def\n";
+ }
+ print $OUT "/epsilon 0.01 def\n";
+ print $OUT "/from-blue 0.7 def\n";
+ print $OUT "/to-blue 0.95 def\n";
+ print $OUT "/m 1 def\n";
+ print $OUT "/magnify { m mul dup 1 gt { pop 1 } if } def\n";
+ print $OUT "%\n" .
+ "% show no. of runnable threads and the current degree of fetching\n" .
+ "%\n" .
+ "/get-color % compute color from intensity\n" .
+ " { 4 mul dup % give more weight to second intensity\n" .
+ " 0 eq { pop 0 exch } \n" .
+ " { from-blue to-blue sub mul from-blue add dup \n" .
+ " 1 gt { pop 1 } if exch } ifelse \n" .
+ " dup 0 eq { pop pop idle-color }\n" .
+ " { 1 exch sub to from sub mul from add % green val is top of stack\n" .
+ " exch 0 3 1 roll } ifelse } def\n";
+
+ print $OUT "%\n";
+ print $OUT "% show no. of runable threads only\n";
+ print $OUT "%\n";
+ print $OUT "/get-color-runnable % compute color from intensity\n";
+ print $OUT "{ pop dup 0 eq { pop idle-color }\n";
+ print $OUT " { 1 exch sub to from sub mul from add % green val is top of stack\n";
+ print $OUT " 0.2 0 3 1 roll } ifelse } def\n";
+
+ print $OUT "%\n";
+ print $OUT "% show no. of fetching threads only\n";
+ print $OUT "%\n";
+ print $OUT "/get-color-fetch % compute color from intensity\n";
+ print $OUT "{ exch pop dup 0 eq { pop idle-color-fetch }\n";
+ print $OUT " { 1 exch sub to from sub mul from add % blue val is top of stack\n";
+ print $OUT " 0.2 0.6 3 2 roll } ifelse } def\n";
+
+ #print $OUT "/get-color % compute color from intensity\n" .
+ # " { dup 0 eq { pop idle-color }\n" .
+ # " { 1 exch sub to from sub mul from add 0 exch 0 } ifelse } def\n";
+ # " { dup 0.4 le { 0.4 exch sub 0.2 add 2 mul 0 0 setrgbcolor} " .
+ # " { 1 exch sub 0.4 add 0 exch 0 setrgbcolor} ifelse \n" .
+ print $OUT "/R % Draw a rectangle \n" .
+ " { % Operands: x y xlen ylen i j \n" .
+ " % (x,y) left lower start point of rectangle\n" .
+ " % xlen length of rec in x direction\n" .
+ " % ylen length of rec in y direction\n" .
+ " % i intensity of rectangle [0,1] \n" .
+ " % j intensity blue to indicate fetching\n" .
+ " % (ignored in mono mode)\n" .
+ ( $opt_m ? " get-shade setgray\n"
+ : " get-color-runnable setrgbcolor\n" ) .
+ " newpath\n" .
+ " 4 copy pop pop moveto\n" .
+ " 1 index 0 rlineto\n" .
+ " 0 index 0 exch rlineto\n" .
+ " 1 index neg 0 rlineto\n" .
+ " 0 index neg 0 exch rlineto\n" .
+ " pop pop pop pop\n" .
+ " closepath\n" .
+ " fill % Note: No stroke => no border\n" .
+ " } def\n";
+ print $OUT "% /R rect def\n";
+ print $OUT "%/A % Draw an arrow (for migration graph)\n" .
+ "% { % Operands: x y x' y' \n" .
+ "% % (x,y) start point \n" .
+ "% % (x',y') end point \n" .
+ ( $opt_m ? "% 0 setgray\n" : "% 0 0 0 setrgbcolor\n" ) .
+ "% 1 setlinewidth\n" .
+ "% newpath 4 2 roll x-normalize moveto x-normalize lineto stroke } def\n";
+
+ print $OUT "/A % No arrows \n" .
+ " { pop pop pop pop } def\n";
+ print $OUT "-90 rotate\n";
+
+ print $OUT "-785 30 translate\n";
+ print $OUT "/HE10 /Helvetica findfont 10 scalefont def\n";
+ print $OUT "/HE12 /Helvetica findfont 12 scalefont def\n";
+ print $OUT "/HE14 /Helvetica findfont 14 scalefont def\n";
+ print $OUT "/TI16 /Times-Italic findfont 16 scalefont def\n";
+ print $OUT "/HB16 /Helvetica-Bold findfont 16 scalefont def\n";
+ print $OUT "% " . "-" x 77 . "\n";
+
+ print $OUT "newpath\n";
+ print $OUT "0 8.000000 moveto\n";
+ print $OUT "0 525.000000 760.000000 525.000000 8.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "760.000000 525.000000 760.000000 0 8.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "760.000000 0 0 0 8.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "0 0 0 525.000000 8.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "0.500000 setlinewidth\n";
+ print $OUT "stroke\n";
+ print $OUT "newpath\n";
+ print $OUT "4.000000 505.000000 moveto\n";
+ print $OUT "4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n";
+ print $OUT "4 {pop} repeat\n";
+ print $OUT "0.500000 setlinewidth\n";
+ print $OUT "stroke\n";
+
+ print $OUT "% ----------------------------------------------------------\n";
+ print $OUT "% Print pallet\n";
+ print $OUT "% NOTE: the values for the tics must correspond to start and\n";
+ print $OUT "% end values in /get-color\n";
+ print $OUT "gsave \n";
+ print $OUT "340 508 translate\n";
+ print $OUT "0.0 0.05 1.00 \n";
+ print $OUT " { \n";
+ print $OUT " dup dup \n";
+ print $OUT " from epsilon sub gt exch \n";
+ print $OUT " from epsilon add lt \n";
+ print $OUT " and\n";
+ print $OUT " { newpath " .
+ ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
+ "0 0 moveto 0 -3 rlineto stroke } if\n";
+ print $OUT " dup dup \n";
+ print $OUT " to epsilon 2 mul sub gt exch \n";
+ print $OUT " to epsilon 2 mul add lt \n";
+ print $OUT " and\n";
+ print $OUT " { newpath " .
+ ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
+ "10 0 moveto 0 -3 rlineto stroke } if\n";
+ print $OUT ($opt_m ? " setgray\n" : " 0 exch 0 setrgbcolor\n");
+ print $OUT " newpath\n";
+ print $OUT " 0 0 moveto\n";
+ print $OUT " 10 0 rlineto\n";
+ print $OUT " 0 10 rlineto\n";
+ print $OUT " -10 0 rlineto\n";
+ print $OUT " closepath\n";
+ print $OUT " fill\n";
+ print $OUT " 10 0 translate \n";
+ print $OUT " } for\n";
+ print $OUT "grestore\n";
+
+ print $OUT "% Print pallet for showing fetch\n";
+ print $OUT "% NOTE: the values for the tics must correspond to start and\n";
+ print $OUT "% end values in /get-color\n";
+ print $OUT "%gsave \n";
+ print $OUT "%340 508 translate\n";
+ print $OUT "%0.0 0.05 1.00 \n";
+ print $OUT "%{ \n";
+ print $OUT "% dup dup \n";
+ print $OUT "% from epsilon sub gt exch \n";
+ print $OUT "% from epsilon add lt \n";
+ print $OUT "% and\n";
+ print $OUT "% { newpath 0 0 0 setrgbcolor 0 0 moveto 0 -3 rlineto stroke } if\n";
+ print $OUT "% dup dup \n";
+ print $OUT "% to epsilon 2 mul sub gt exch \n";
+ print $OUT "% to epsilon 2 mul add lt \n";
+ print $OUT "% and\n";
+ print $OUT "% { newpath 0 0 0 setrgbcolor 10 0 moveto 0 -3 rlineto stroke } if\n";
+ print $OUT "% 0.2 exch 0.6 exch setrgbcolor \n";
+ print $OUT "% newpath\n";
+ print $OUT "% 0 0 moveto\n";
+ print $OUT "% 10 0 rlineto\n";
+ print $OUT "% 0 10 rlineto\n";
+ print $OUT "% -10 0 rlineto\n";
+ print $OUT "% closepath\n";
+ print $OUT "% fill\n";
+ print $OUT "% 10 0 translate \n";
+ print $OUT "% } for\n";
+ print $OUT "% grestore\n";
+
+ print $OUT "% Print double pallet\n";
+ print $OUT "% NOTE: the values for the tics must correspond to start and\n";
+ print $OUT "% end values in /get-color\n";
+ print $OUT "% gsave \n";
+ print $OUT "% 340 500 translate\n";
+ print $OUT "% 0.0 0.05 1.00 \n";
+ print $OUT "% { \n";
+ print $OUT "% 0 exch 0 setrgbcolor \n";
+ print $OUT "% newpath\n";
+ print $OUT "% 0 0 moveto\n";
+ print $OUT "% 10 0 rlineto\n";
+ print $OUT "% 0 10 rlineto\n";
+ print $OUT "% -10 0 rlineto\n";
+ print $OUT "% closepath\n";
+ print $OUT "% fill\n";
+ print $OUT "% 10 0 translate \n";
+ print $OUT "% } for\n";
+ print $OUT "% grestore\n";
+ print $OUT "% gsave \n";
+ print $OUT "% 340 510 translate\n";
+ print $OUT "% 0.0 0.05 1.00 \n";
+ print $OUT "% { \n";
+ print $OUT "% dup dup \n";
+ print $OUT "% from epsilon sub gt exch \n";
+ print $OUT "% from epsilon add lt \n";
+ print $OUT "% and\n";
+ print $OUT "% { newpath 0 0 0 setrgbcolor 0 3 moveto 0 -6 rlineto stroke } if\n";
+ print $OUT "% dup dup \n";
+ print $OUT "% to epsilon 2 mul sub gt exch \n";
+ print $OUT "% to epsilon 2 mul add lt \n";
+ print $OUT "% and\n";
+ print $OUT "% { newpath 0 0 0 setrgbcolor 10 3 moveto 0 -6 rlineto stroke } if\n";
+ print $OUT "% 0.7 exch 0 setrgbcolor \n";
+ print $OUT "% newpath\n";
+ print $OUT "% 0 0 moveto\n";
+ print $OUT "% 10 0 rlineto\n";
+ print $OUT "% 0 10 rlineto\n";
+ print $OUT "% -10 0 rlineto\n";
+ print $OUT "% closepath\n";
+ print $OUT "% fill\n";
+ print $OUT "% 10 0 translate \n";
+ print $OUT "% } for\n";
+ print $OUT "% grestore\n";
+ print $OUT "% ----------------------------------------------------------\n";
+ print $OUT "HE14 setfont\n";
+ print $OUT "100.000000 508.000000 moveto\n";
+ print $OUT "($pname PEs: $nPEs Lat.: $lat ) show\n";
+
+ print $OUT "($date) dup stringwidth pop 750.000000 exch sub 508.000000 moveto show\n";
+ print $OUT ( $opt_m ? "5 512 asciilogo\n" : "5 512 logo\n");
+ print $OUT "% 100 500 moveto\n";
+
+ print $OUT "0 20 translate\n";
+
+ print $OUT "HE14 setfont\n";
+ for ($i=0; $i<$nPEs; $i++) {
+ $dist = $stripes_high[$i] - $stripes_low[$i];
+ $y = $stripes_low[$i] + $dist/2;
+ # print $OUT "/starlen $dist def\n";
+ # print $OUT "gsave 2 $y star grestore\n";
+ print $OUT " 2 " . ($stripes_low[$i]+1) . " moveto ($i) show\n";
+ }
+
+ print $OUT "20 0 translate\n";
+
+ print $OUT "% Print x-axis:\n";
+ print $OUT "1 setlinewidth\n";
+ print $OUT "0 -5 moveto total-len normalize 0 rlineto stroke\n";
+ print $OUT "gsave\n" .
+ "[2 4] 1 setdash\n" .
+ "0 0 moveto 0 $total_height rlineto stroke\n" .
+ "% $x_max 0 moveto 0 $total_height rlineto stroke\n" .
+ "grestore\n";
+ print $OUT "0 total-len 10 div total-len\n" .
+ " { dup normalize dup -5 moveto 0 -2 rlineto stroke % tic\n" .
+ " -17 moveto HE10 setfont round prt-n % print label \n" .
+ " } for \n";
+
+
+ print $OUT "$x_scale $y_scale scale\n";
+
+ print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
+
+ if ( $opt_D ) {
+ print $OUT "% Debugging info : \n";
+
+ print $OUT "% Offset is: $offset\n";
+
+ print $OUT "% y_val table: \n";
+ for ($i=0; $i<$nPEs; $i++) {
+ print $OUT "% y_val of $i: $y_val[$i]\n";
+ }
+
+ print $OUT "% x-max: $x_max; y-max: $y_max\n";
+ print $OUT "% Info from header: Prg: $pname; PEs: $nPEs; Lat.: $lat\n";
+
+ print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_epilog {
+ local ($OUT,$x_max, $y_max) = @_;
+ local($x_scale,$y_scale);
+
+ print $OUT "showpage\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_x_max {
+ local ($file) = @_;
+ local ($last_line, @fs);
+
+ open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
+ while (<TMP>) {
+ $last_line = $_;
+ }
+ close(TMP);
+
+ @fs = split(/[:\[\]\s]+/,$last_line);
+
+ return $fs[2];
+}
+
+# ----------------------------------------------------------------------------
+#
+#sub get_date {
+# local ($now,$today,@lt);
+#
+# @lt = localtime(time);
+# $now = join(":",reverse(splice(@lt,0,3)));
+# $today = join(".",splice(@lt,0,3));
+#
+# return $now . " on " . $today;
+#}
+#
+# ----------------------------------------------------------------------------
+
+sub get_date {
+ local ($date);
+
+ open (DATE,"date |") || die ("$!");
+ while (<DATE>) {
+ $date = $_;
+ }
+ close (DATE);
+
+ return ($date);
+}
+
+# -----------------------------------------------------------------------------
+
+sub generate_y_val_table {
+ local ($nPEs) = @_;
+ local($i, $y, $dist);
+
+ $dist = int($total_height/$nPEs);
+ for ($i=0, $y=1; $i<$nPEs; $i++, $y+=$dist) {
+ $y_val[$i] = $y + $lower_border;
+ $stripes_low[$i] = $y;
+ $stripes_high[$i] = $y+$dist-2;
+ }
+
+ # print $OUT "10 5 translate\n";
+
+ return ($dist);
+}
+
+# ----------------------------------------------------------------------------
+
+sub init {
+ local ($nPEs) = @_;
+ local($i);
+
+ for ($i=0; $i<$nPEs; $i++) {
+ if ( $opt_S ) {
+ $sparks[$i] = 0;
+ }
+ $blocked[$i] = 0;
+ $runnable[$i] = 0;
+ $fetching[$i] = 0;
+ $running[$i] = $NO_ID;
+ if ( $opt_S ) {
+ $last_sp_bg[$i] = $NO_LAST_BG;
+ }
+ $last_bg[$i] = $NO_LAST_BG;
+ $last_start[$i] = $NO_LAST_START;
+ $last_blocked[$i] = $NO_LAST_BLOCKED;
+ $last_runnable[$i] = 0;
+ #open($OUT_RA[$i], "PE". $i . ".dat") || die "PE".$i."-R.dat: $!\n";
+ #print $OUT_RA[$i] "# Number of Runnable tasks on PE $i\n";
+ #open($OUT_BA[$i], "PE". $i . ".dat") || die "PE".$i."-B.dat: $!\n";
+ #print $OUT_BA[$i] "# Number of Blocked tasks on PE $i\n";
+ }
+
+}
+
+
+# ----------------------------------------------------------------------------
+
+sub skip_header {
+ local ($FILE) = @_;
+ local($prg, $pars, $nPEs, $lat, $fetch, $in_header);
+
+ $in_header = 9;
+ while (<$FILE>) {
+ if ( $in_header = 9 ) {
+ if (/^=/) {
+ $gum_style_gr = 1;
+ $in_header = 0;
+ $prg = "????"; #
+ $pars = "-b??????"; #
+ $nPEs = $opt_p ? $opt_p : 1; #
+ $lat = $opt_l ? $opt_l : 1;
+ return ($prg, $pars, $nPEs, $lat);
+ } else {
+ $gum_style_gr = 0;
+ $in_header = 1;
+ }
+
+ }
+ $prg = $1, $pars = $2 if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
+ $nPEs = $1 if /^PEs\s+(\d+)/;
+ $lat = $1, $fetch = $2 if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
+ die "Can't process GranSim-Light profiles!\n" if /^GrAnSim-Light$/i;
+
+ last if /^\+\+\+\+\+/;
+ }
+
+ return ($prg, $pars, $nPEs, $lat);
+}
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $#ARGV != 0 ) {
+ print "Usage: $0 [options] <gr-file>\n";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $input = $ARGV[0] ;
+ $input =~ s/\.gr//;
+ $input .= ".gr";
+
+ if ( $opt_o ) {
+ ($output = $opt_o) =~ s/\.ps// ;
+ $output_b = $output . "_peb.ps";
+ $output_r = $output . "_per.ps";
+ $output_mig = $output . "_mig.ps" if $opt_M;
+ $output_sp = $output . "_sp.ps" if $opt_S;
+ $output = $output . "_pe.ps";
+ #($output_b = $opt_o) =~ s/\./-b./ ;
+ #($output_r = $opt_o) =~ s/\./-r./ ;
+ #($output_mig = $opt_o) =~ s/\./-mig./ if $opt_M;
+ #($output_sp = $opt_o) =~ s/\./-sp./ if $opt_S;
+ } else {
+ ($output = $input) =~ s/\.gr// ;
+ $output_b = $output . "_peb.ps";
+ $output_r = $output . "_per.ps";
+ $output_mig = $output . "_mig.ps" if $opt_M;
+ $output_sp = $output . "_sp.ps" if $opt_S;
+ $output = $output . "_pe.ps";
+ }
+
+ if ( $opt_v ){
+ $verbose = 1;
+ }
+
+ if ( $opt_i ) {
+ $inf_block = $opt_i;
+ } else {
+ $inf_block = 20;
+ }
+
+ $RUNNABLE_file = $input;
+ $RUNNABLE_file =~ s/\.gr//;
+ $RUNNABLE_file .= "-R";
+
+ $BLOCKED_file = $input;
+ $BLOCKED_file =~ s/\.gr//;
+ $BLOCKED_file .= "-B";
+
+ $FETCHING_file = $input;
+ $FETCHING_file =~ s/\.gr//;
+ $FETCHING_file .= "-F";
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ print "Input file: $input\n";
+ print "Output files: $output, $output_b, $output_r; ".
+ ($opt_M ? "Migration: $output_mig" : "") .
+ ($opt_S ? "Sparks: $output_sp" : "") .
+ "\n";
+}
+
+# ----------------------------------------------------------------------------
+# Junk from draw_segment:
+#
+# if ( $type eq $RUNNING ) {
+# die "ERROR: This version should never draw a RUNNING segment!";
+# $y = $y_val[$pe];
+# $x = $last_start[$pe];
+# $width = &get_width(0, $type);
+# # $gray = 0;
+#
+# if ( $is_very_big ) {
+# $x = int($x/$shrink_x) + 1; # rounded up
+# }
+#
+# do ps_draw_hline(OUT_B,$x,$y,$time,$width);
+# do ps_draw_hline(OUT_R,$x,$y,$time,$width);
+#
+# } elsif ( $type eq $RUNNABLE ) {
+# die "ERROR: This version should never draw a RUNNABLE segment (shades are used instead)!";
+# $y = $y_val[$pe] + $offset;
+# $x = $last_runnable[$pe];
+# $width = &get_width($runnable[$pe], $type);
+#
+# if ( $is_very_big ) {
+# $x = int($x/$shrink_x) + 1; # rounded up
+# }
+#
+# # $gray = 0.5;
+# do ps_draw_hline(OUT_R,$x,$y,$time,$width);
diff --git a/ghc/utils/parallel/gr2ps.bash b/ghc/utils/parallel/gr2ps.bash
index 28099fbff0..4d4d3da3e6 100644
--- a/ghc/utils/parallel/gr2ps.bash
+++ b/ghc/utils/parallel/gr2ps.bash
@@ -1,34 +1,41 @@
#!/usr/local/bin/bash
##############################################################################
+# Time-stamp: <Wed Jul 24 1996 22:11:13 Stardate: [-31]7859.41 hwloidl>
#
# Usage: gr2ps [options] <gr-file>
#
+# Create an overall activity graph from a GrAnSim (or GUM) profile.
# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
-# profile (a .qp file) and then into a PostScript file, showing essentially
-# the total number of running, runnable and blocked tasks.
+# profile (a .qp file) using gr2qp and then into a PostScript file using qp2ps.
+# The generated PostScript file shows essentially the number of running,
+# runnable and blocked tasks during the execution of the program.
#
# Options:
-# -o <file> ... write PS file to <file>
+# -o <file> ... write .ps file to <file>
+# -I <str> ... queues to be displayed (in the given order) with the encoding
+# 'a' ... active (running)
+# 'r' ... runnable
+# 'b' ... blocked
+# 'f' ... fetching
+# 'm' ... migrating
+# 's' ... sparks
+# (e.g. -I "arb" shows active, runnable, blocked tasks)
# -i <int> ... info level from 1 to 7; number of queues to display
# -m ... create mono PostScript file instead a color one.
-# -O ... optimize the produced .ps w.r.t. size
+# -O ... optimise the produced .ps w.r.t. size
# NB: With this option info is lost. If there are several values
# with same x value only the first one is printed, all
# others are dropped.
# -s <str> ... print <str> in the top right corner of the generated graph
+# -S ... improved version of sorting events
+# -l <int> ... length of slice in the .ps file; (default: 100)
+# small value => less memory consumption of .ps file & script
+# -d ... Print date instead of average parallelism
# -v ... be talkative.
# -h ... print help message (this header).
#
##############################################################################
-##############################################################################
-# Internal comments:
-# ----------------------------------------------------------------------
-# This version works on both Suns and Alphas -- KH
-# Any volunteers to convert it to /bin/sh?
-# Next time somebody calls for volunteers I'd better keep my mouth shut ... HWL
-##############################################################################
-
progname="`basename $0`"
args="$*"
@@ -37,70 +44,90 @@ help=0
mono=""
psfile=""
debug=""
-optimize=""
-info_level=0
+optimise=""
+info_level=""
info_mask=""
string=""
+length=""
+force_date=""
+hack=""
-getopts "hvmDOSs:o:i:I:" name
+getopts "hvmDCOHSdl:s:o:i:I:" name
while [ "$name" != "?" ] ; do
case $name in
h) help=1;;
v) verb=1;;
m) mono="-m";;
D) debug="-D";;
- O) optimize="-O";;
- S) lines="-S";;
- s) string=$OPTARG;;
- i) info_level=$OPTARG;;
- I) info_mask=$OPTARG;;
+ C) check="-C";;
+ O) optimise="-O";;
+ d) force_date="-d";;
+ H) hack="-H";;
+ S) improved_sort="-S";;
+ s) string="-s $OPTARG";;
+ l) length="-l $OPTARG";;
+ i) info_level="-i $OPTARG";;
+ I) info_mask="-I $OPTARG";;
o) psfile=$OPTARG;;
esac
- getopts "hvmDOSs:o:i:I:" name
+ getopts "hvmDCOHSdl:s:o:i:I:" name
done
+opts_qp="$debug $info_level $info_mask $improved_sort "
+opts_ps="$debug $check $optimise $mono $string $length $info_level $info_mask $force_date $hack "
+
shift $[ $OPTIND - 1 ]
+if [ $help -eq 1 ]
+ then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
+ /^$/ { print n; \
+ exit; } \
+ { n++; }'`
+ echo "`head -$no_of_lines $0`"
+ exit
+fi
+
if [ -z "$1" ]
- then echo "usage: $progname [-m] file[.gr]"
+ then echo "Usage: $progname [options] file[.gr]"
+ echo "Use -h option for details"
exit 1;
fi
f="`basename $1 .gr`"
grfile="$f".gr
-qpfile="$f".qp
-ppfile="$f".pp
+qpfile="${TMPDIR:-.}/$f".qp
+ppfile="${TMPDIR:-.}/$f".pp
if [ -z "$psfile" ]
then psfile="$f".ps
fi
-if [ $help -eq 1 ]
- then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
- /^$/ { print n; \
- exit; } \
- { n++; }'`
- echo "`head -$no_of_lines $0`"
- exit
-fi
-
if [ $verb -eq 1 ]
then echo "Input file: $grfile"
echo "Quasi-parallel file: $qpfile"
echo "PP file: $ppfile"
echo "PostScript file: $psfile"
- if [ "$mono" = "-m" ]
+ if [ -n "$mono" ]
then echo "Producing monochrome PS file"
else echo "Producing color PS file"
fi
- if [ "$optimize" = "-O" ]
- then echo "Optimization is ON"
- else echo "Optimization is OFF"
+ if [ -n "$optimise" ]
+ then echo "Optimisation is ON"
+ else echo "Optimisation is OFF"
fi
- if [ "$debug" = "-D" ]
+ if [ -n "$debug" ]
then echo "Debugging is turned ON"
else echo "Debugging is turned OFF"
fi
+ if [ -n "$improved_sort" ]
+ then echo "Improved sort is turned ON"
+ else echo "Improved sort is turned OFF"
+ fi
+ verb_opt="-v "
+ opts_qp="${opts_qp} $verb_opt "
+ opts_ps="${opts_ps} $verb_opt "
+ echo "Options for gr2qp: ${opts_qp}"
+ echo "Options for qp2ps: ${opts_ps}"
fi
@@ -113,22 +140,28 @@ if [ ! -f "$grfile" ]
rm -f "$qpfile" "$psfile"
prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
echo "$prog" >| "$qpfile"
- if [ $verb -eq 1 ]; then echo "Executed program: $prog"; fi
+ if [ $verb -eq 1 ]
+ then echo "Executed program: $prog"
+ fi
date >> "$qpfile"
- date="`date`"
- cat "$grfile" | gr2qp | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
+ #date="`date`" # This is the date of running the script
+ date="`tail +2 $grfile | head -1 | sed -e 's/Start time: //'`"
+ cat "$grfile" | gr2qp ${opts_qp} >> "$qpfile"
+ # Sorting is part of gr2qp now.
+ # | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
# max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
- max=`tail -1 "$qpfile" | awk '{ print $1; }'`
- if [ $verb -eq 1 ]; then echo "Total runtime: $max"; fi
- opts="";
- if [ $info_level -gt 0 ]
- then opts="-i $info_level";
- fi
- if [ -n "$info_mask" ]
- then opts="-I $info_mask";
- fi
- tail +3 "$qpfile" | qp2ps $debug $optimize $mono $lines "-s" "$string" $opts "$max" "$prog" "$date" >| "$psfile"
+ xmax=`tail -1 "$qpfile" | awk '{ print $2; }'`
+ ymax=`tail -1 "$qpfile" | awk '{ print $4; }'`
+ if [ $verb -eq 1 ]
+ then echo "Total runtime: $xmax"
+ echo "Maximal number of tasks: $ymax"
+ fi
+ tail +3 "$qpfile" | qp2ps ${opts_ps} "$xmax" "$ymax" "$prog" "$date" >| "$psfile"
rm -f "$qpfile"
+ if [ $verb -eq 1 ]
+ then echo "Scaling (maybe): ps-scale-y $psfile "
+ fi
+ ps-scale-y "$psfile"
fi
diff --git a/ghc/utils/parallel/gr2qp.pl b/ghc/utils/parallel/gr2qp.pl
index c0844622d8..e87f21b1e4 100644
--- a/ghc/utils/parallel/gr2qp.pl
+++ b/ghc/utils/parallel/gr2qp.pl
@@ -1,16 +1,111 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 20:35:01 Stardate: [-31]7859.07 hwloidl>
+#
+# Usage: gr2qp [options]
+#
+# Filter that transforms a GrAnSim profile (a .gr file) at stdin to
+# a quasi-parallel profile (a .qp file). It is the common front-end for most
+# visualization tools (except gr2pe). It collects running,
+# runnable and blocked tasks in queues of different `colours', whose meaning
+# is:
+# G ... green; queue of all running tasks
+# A ... amber; queue of all runnable tasks
+# R ... red; queue of all blocked tasks
+# Y ... cyan; queue of fetching tasks
+# C ... crimson; queue of tasks that are being stolen
+# B ... blue; queue of all sparks
+#
+# Options:
+# -i <int> ... info level from 1 to 7; number of queues to count (see qp3ps)
+# -I <str> ... count tasks that are in one of the given queues; encoding:
+# 'a' ... active (running)
+# 'r' ... runnable
+# 'b' ... blocked
+# 'f' ... fetching
+# 'm' ... migrating
+# 's' ... sparks
+# (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
+# -c ... check consistency of data (e.g. no neg. number of tasks)
+# -v ... be talkative.
+# -h ... print help message (this header).
+#
+##############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvDSci:I:');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+$max = 0;
+$pmax = 0;
+$ptotal = 0;
+$n = 0;
+
+$active = 0;
+$runnable = 0;
+$blocked = 0;
+$fetching = 0;
+$migrating = 0;
+$sparks = 0;
+
+$improved_sort_option = $opt_S ? "-S" : "";
+
+open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
+
+$in_header = 9;
while(<>) {
+ if ( $in_header == 8 ) {
+ $start_time = $1 if /^Start-Time: (.*)$/;
+ $in_header = 0;
+ next;
+ }
+ if ( $in_header == 9 ) {
+ if (/^=/) {
+ $gum_style_gr = 1;
+ $in_header = 8;
+ next;
+ } else {
+ $gum_style_gr = 0;
+ $in_header = 1;
+ }
+
+ }
+ if (/^\++$/) {
+ $in_header=0;
+ next;
+ }
+ next if $in_header;
+ next if /^$/;
+ next if /^=/;
chop;
($PE, $pe, $time, $act, $tid, $rest) = split;
- next if $act eq 'REPLY';
+ $time =~ s/[\[\]:]//g;
+ # next if $act eq 'REPLY';
chop($tid) if $act eq 'END';
$from = $queue{$tid};
$extra = "";
if ($act eq 'START') {
$from = '*';
$to = 'G';
+ $n++;
+ if ( $n > $pmax ) { $pmax = $n; }
+ $ptotal++;
} elsif ($act eq 'START(Q)') {
$from = '*';
$to = 'A';
+ $n++;
+ if ( $n > $pmax ) { $pmax = $n; }
+ $ptotal++;
} elsif ($act eq 'STEALING') {
$to = 'C';
} elsif ($act eq 'STOLEN') {
@@ -19,6 +114,8 @@ while(<>) {
$to = 'A';
} elsif ($act eq 'FETCH') {
$to = 'Y';
+ } elsif ($act eq 'REPLY') {
+ $to = 'R';
} elsif ($act eq 'BLOCK') {
$to = 'R';
} elsif ($act eq 'RESUME') {
@@ -29,17 +126,204 @@ while(<>) {
$extra = " 0 0x0";
} elsif ($act eq 'END') {
$to = '*';
+ $n--;
+ if ( $opt_c && $n < 0 ) {
+ print STDERR "Error at time $time: neg. number of tasks: $n\n";
+ }
} elsif ($act eq 'SCHEDULE') {
$to = 'G';
} elsif ($act eq 'DESCHEDULE') {
$to = 'A';
+ # The following are only needed for spark profiling
+ } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
+ $from = '*';
+ $to = 'B';
+ } elsif ($act eq 'USED') {
+ $from = 'B';
+ $to = '*';
+ } elsif ($act eq 'PRUNED') {
+ $from = 'B';
+ $to = '*';
+ } elsif ($act eq 'EXPORTED') {
+ $from = 'B';
+ $to = 'B';
+ } elsif ($act eq 'ACQUIRED') {
+ $from = 'B';
+ $to = 'B';
+ } else {
+ print STDERR "Error at time $time: unknown event $act\n";
}
$queue{$tid} = $to;
+ if ( $from eq '' ) {
+ print STDERRR "Error at time $time: process $tid has no from queue\n";
+ }
if ($to ne $from) {
- print substr($time,1,length($time)-3), " ",
+ print FOOL $time, " ",
$from, $to, " 0 0x", $tid, $extra, "\n";
}
+
+ if ($to ne $from) {
+ # Compare with main loop in qp3ps
+ if ($from eq '*') {
+ } elsif ($from eq 'G') {
+ --$active;
+ } elsif ($from eq 'A') {
+ --$runnable;
+ } elsif ($from eq 'R') {
+ --$blocked;
+ } elsif ($from eq 'B') {
+ --$sparks;
+ } elsif ($from eq 'C') {
+ --$migrating;
+ } elsif ($from eq 'Y') {
+ --$fetching;
+ } else {
+ print STDERR "Illegal from char: $from at $time\n";
+ }
+
+ if ($to eq '*') {
+ } elsif ($to eq 'G') {
+ ++$active;
+ } elsif ($to eq 'A') {
+ ++$runnable;
+ } elsif ($to eq 'R') {
+ ++$blocked;
+ } elsif ($to eq 'B') {
+ ++$sparks;
+ } elsif ($to eq 'C') {
+ ++$migrating;
+ } elsif ($to eq 'Y') {
+ ++$fetching;
+ } else {
+ print STDERR "Illegal to char: $to at $time\n";
+ }
+
+ }
+
+ $curr = &count();
+ if ( $curr > $max ) {
+ $max = $curr;
+ }
+
+ if ( 0 ) {
+ print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
+ "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
+ " max = $max\n" ;
+ }
+
+ #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n" if $opt_D;
+
+ if ( $time > $tmax ) {
+ $tmax = $time;
+ }
delete $queue{$tid} if $to eq '*';
-}
+}
+
+print "Time: ", $tmax, " Max_selected_tasks: ", $max,
+ " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
+
+close(FOOL);
+
+exit 0;
+
+# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+# Copied from qp3ps and slightly modified (we don't keep a list for each queue
+# but just compute the max value we get out of all calls to count during the
+# execution of the script).
+# -----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+
+sub queue_on {
+ local ($queue) = @_;
+
+ return index($show,$queue)+1;
+}
+
+# -----------------------------------------------------------------------------
+
+sub count {
+ local ($res);
+
+ $res = (($queue_on_a) ? $active : 0) +
+ (($queue_on_r) ? $runnable : 0) +
+ (($queue_on_b) ? $blocked : 0) +
+ (($queue_on_f) ? $fetching : 0) +
+ (($queue_on_m) ? $migrating : 0) +
+ (($queue_on_s) ? $sparks : 0);
+
+ return $res;
+}
+
+# -----------------------------------------------------------------------------
+# DaH 'oH lo'lu'Qo'
+# -----------------------------------------------------------------------------
+
+sub set_values {
+ local ($samples,
+ $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
+
+ $G[$samples] = queue_on_a ? $active : 0;
+ $A[$samples] = queue_on_r ? $runnable : 0;
+ $R[$samples] = queue_on_b ? $blocked : 0;
+ $Y[$samples] = queue_on_f ? $fetching : 0;
+ $B[$samples] = queue_on_s ? $sparks : 0;
+ $C[$samples] = queue_on_m ? $migrating : 0;
+}
+
+# -----------------------------------------------------------------------------
+
+sub process_options {
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ $show = "armfb";
+
+ if ( $opt_i ) {
+ $show = "a" if info_level == 1;
+ $show = "ar" if info_level == 2;
+ $show = "arb" if info_level == 3;
+ $show = "arfb" if info_level == 4;
+ $show = "armfb" if info_level == 5;
+ $show = "armfbs" if info_level == 6;
+ }
+
+ if ( $opt_I ) {
+ $show = $opt_I;
+ }
+
+ if ( $opt_v ){
+ $verbose = 1;
+ }
+
+ $queue_on_a = &queue_on("a");
+ $queue_on_r = &queue_on("r");
+ $queue_on_b = &queue_on("b");
+ $queue_on_f = &queue_on("f");
+ $queue_on_s = &queue_on("s");
+ $queue_on_m = &queue_on("m");
+}
+
+sub print_verbose_message {
+
+ print STDERR "Info-str: $show\n";
+ print STDERR "The following queues are turned on: " .
+ ( $queue_on_a ? "active, " : "") .
+ ( $queue_on_r ? "runnable, " : "") .
+ ( $queue_on_b ? "blocked, " : "") .
+ ( $queue_on_f ? "fetching, " : "") .
+ ( $queue_on_m ? "migrating, " : "") .
+ ( $queue_on_s ? "sparks" : "") .
+ "\n";
+}
diff --git a/ghc/utils/parallel/gran-extr.pl b/ghc/utils/parallel/gran-extr.pl
new file mode 100644
index 0000000000..509da499d6
--- /dev/null
+++ b/ghc/utils/parallel/gran-extr.pl
@@ -0,0 +1,2114 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Last modified: Time-stamp: <Sat Oct 28 1995 23:49:48 Stardate: [-31]6509.75 hwloidl>
+# (C) Hans Wolfgang Loidl
+#
+# Usage: gran-extr [options] [<sim-file>]
+#
+# Takes a file <sim-file> generated by running the GrAnSim simulator and
+# produces data files that should be used as input for gnuplot.
+# This script produces figures for:
+# runtime of tasks
+# percentage of communication
+# heap allocation
+# number of created sparks
+# cumulative no. of tasks over runtime
+# Furthermore, it computes the correlation between runtime and heap allocation.
+#
+# Options:
+# -g <file> ... filename of granularity file to be produced; should end with
+# .dat; -global and -local will be automatically inserted for
+# other versions.
+# -c <file> ... filename of communication file to be produced; should end with
+# .dat; -global and -local will be automatically inserted for
+# other versions.
+# -s <file> ... filename of sparked-threads file to be produced; should end w/
+# .dat; -global and -local will be automatically inserted for
+# other versions.
+# -a <file> ... filename of heap alloc. file to be produced; should end with
+# .dat;
+# -f <file> ... filename of communication time file to be produced;
+# should end with .dat;
+# -p <file> ... filename of GNUPLOT file that is prouced and executed.
+# -G <LIST> ... provide a list of boundaries for the Intervals used in the
+# granularity figure; must be a Perl list e.g. (10, 20, 50)
+# this is interpreted as being open to left and right.
+# -C <LIST> ... provide a list of boundaries for the Intervals used in the
+# communication figure; must be a Perl list e.g. (10, 20, 50)
+# this is interpreted as being closed to left and right.
+# -S <LIST> ... provide a list of boundaries for the Intervals used in the
+# sparked-threads figure; must be a Perl list e.g. (10, 20, 50)
+# this is interpreted as being closed to left and right.
+# -A <LIST> ... provide a list of boundaries for the Intervals used in the
+# heap alloc figure; must be a Perl list e.g. (10, 20, 50)
+# this is interpreted as being closed to left and right.
+# -F <LIST> ... provide a list of boundaries for the Intervals used in the
+# comm. time figure; must be a Perl list e.g. (10, 20, 50)
+# this is interpreted as being open to left and right.
+# -l <int> ... left margin in the produced figures.
+# -r <int> ... right margin in the produced figures.
+# -x <int> ... enlargement of figure along x-axis.
+# -y <int> ... enlargement of figure along y-axis.
+# -e <int> ... thickness of impulses in figure.
+# -i <rat> ... set the gray level of the impulses to <rat>; <rat> must be
+# between 0 and 1 with 0 meaning black.
+# -k <n> ... number of klusters (oops, clusters, I mean ;)
+# -P ... print percentage of threads rather than absolute number of
+# threads on the y axis
+# -t <file> ... use template <file> for interval settings and file names
+# Syntax of a line in the template file:
+# <flag>: <arg>
+# -T ... use smart xtics rather than GNUPLOT default x-axis naming.
+# -L ... use logarithmic scale for all figures.
+# -W ... print warnings
+# -m ... generate monchrome output
+# -h ... help; print this text.
+# -v ... verbose mode.
+#
+##############################################################################
+
+# ----------------------------------------------------------------------------
+# Command line processing and initialization
+# ----------------------------------------------------------------------------
+
+require "getopts.pl";
+
+&Getopts('hvWTPDmt:L:g:f:c:s:a:p:G:F:C:S:A:l:r:x:y:e:i:k:');
+
+do process_options();
+
+$OPEN_INT = 1;
+$CLOSED_INT = 0;
+
+if ( $opt_v ) {
+ do print_verbose_message ();
+}
+
+# ----------------------------------------------------------------------------
+# The real thing
+# ----------------------------------------------------------------------------
+
+open(INPUT,"<$input") || die "Couldn't open input file $input";
+
+do skip_header();
+
+$tot_total_rt = 0;
+$tot_rt = 0;
+$tot_bt = 0;
+$tot_ft = 0;
+$tot_it = 0;
+$gum_style_gr = 0;
+
+$line_no = 0;
+while (<INPUT>) {
+ next if /^--/; # Comment lines start with --
+ next if /^\s*$/; # Skip empty lines
+ $line_no++;
+ @fields = split(/[:,]/,$_);
+ $has_end = 0;
+
+ foreach $elem (@fields) {
+ foo : {
+ $pe = $1, $end = $2 , last foo if $elem =~ /^\s*PE\s+(\d+)\s+\[(\d+)\].*$/;
+ $tn = $1, $has_end = 1 , last foo if $elem =~ /^\s*END\s+(\w+).*$/;
+ # $tn = $1 , last foo if $elem =~ /^\s*TN\s+(\w+).*$/;
+ $sn = $1 , last foo if $elem =~ /^\s*SN\s+(\d+).*$/;
+ $start = $1 , last foo if $elem =~ /^\s*ST\s+(\d+).*$/;
+ $is_global = $1 , last foo if $elem =~ /^\s*EXP\s+(T|F).*$/;
+ $bbs = $1 , last foo if $elem =~ /^\s*BB\s+(\d+).*$/;
+ $ha = $1 , last foo if $elem =~ /^\s*HA\s+(\d+).*$/;
+ $rt = $1 , last foo if $elem =~ /^\s*RT\s+(\d+).*$/;
+ $bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
+ $ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
+ $lsp = $1 , last foo if $elem =~ /^\s*LS\s+(\d+).*$/;
+ $gsp = $1 , last foo if $elem =~ /^\s*GS\s+(\d+).*$/;
+ $my = $1 , last foo if $elem =~ /^\s*MY\s+(T|F).*$/;
+ }
+ }
+
+ next unless $has_end == 1;
+
+ $total_rt = $end - $start;
+ $ready_time = $total_rt - $rt - $bt - $ft;
+
+ # ------------------------------------------------------------------------
+ # Accumulate runtime, block time, fetch time and ready time over all threads
+ # ------------------------------------------------------------------------
+
+ $tot_total_rt += $total_rt;
+ $tot_rt += $rt;
+ $tot_bt += $bt;
+ $tot_ft += $ft;
+ $tot_it += $ready_time;
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about `load' on the PEs
+ # ------------------------------------------------------------------------
+
+ print "WARNING: ready time of thread is <0: $ready_time\n" if $pedantic && ($ready_time <0);
+ $pe_load[$pe] += $ready_time;
+
+ if ( $opt_D ) {
+ print "Adding $ready_time to the load time of PE no. $pe yielding $pe_load[$pe]\n";
+ }
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about the size of a spark site
+ # ------------------------------------------------------------------------
+
+ $site_size[$sn] += $rt;
+
+ if ( $opt_D ) {
+ print "Adding $rt to the size of site $sn yielding $site_size[$sn]\n";
+ }
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about pure exec time
+ # ------------------------------------------------------------------------
+
+ push(@all_rts,$rt);
+ $sum_rt += $rt;
+ $max_rt = $rt if $rt > $max_rt;
+
+ $index = do get_index_open_int($rt,@exec_times);
+ $exec_class[$index]++;
+
+ if ( $is_global eq 'T' ) {
+ $exec_global_class[$index]++;
+ } else {
+ $exec_local_class[$index]++;
+ }
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about communication time (absolute time rather than %)
+ # ------------------------------------------------------------------------
+
+ # Note: Communicatin time is fetch time
+
+ push(@all_fts,$ft);
+ $sum_ft += $ft;
+ $max_ft = $ft if $ft > $max_ft;
+
+ $index = do get_index_open_int($ft,@fetch_times);
+ $fetch_class[$index]++;
+
+ if ( $is_global eq 'T' ) {
+ $fetch_global_class[$index]++;
+ } else {
+ $fetch_local_class[$index]++;
+ }
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about communication percentage
+ # ------------------------------------------------------------------------
+
+ $comm_perc = ( $total_rt == 0 ? 100 : (100 * $ft)/$total_rt );
+
+ push(@all_comm_percs,$comm_perc);
+ $sum_comm_perc += $comm_perc;
+ $max_comm_perc = $comm_perc if $comm_perc > $max_comm_perc;
+
+ $index = do get_index_closed_int( $comm_perc, @comm_percs );
+ if ( $index != -1 ) {
+ $comm_class[$index]++;
+ } else {
+ print "WARNING: value " . $comm_perc . " not in range (t_rt=$total_rt; ft=$ft)\n" if $pedantic;
+ $outside++;
+ }
+
+ if ( $is_global eq 'T' ) {
+ if ( $index != -1 ) {
+ $comm_global_class[$index]++;
+ } else {
+ $outside_global++;
+ }
+ } else {
+ if ( $index != -1 ) {
+ $comm_local_class[$index]++;
+ } else {
+ $outside_local++;
+ }
+ }
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about locally sparked threads
+ # ------------------------------------------------------------------------
+
+ push(@all_local_sparks,$lsp);
+ $sum_local_sp += $lsp;
+ $max_local_sp = $lsp if $lsp > $max_local_sp;
+
+ $index = do get_index_open_int($lsp,@sparks);
+ $spark_local_class[$index]++;
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about globally sparked threads
+ # ------------------------------------------------------------------------
+
+ push(@all_global_sparks,$gsp);
+ $sum_global_sp += $gsp;
+ $max_global_sp = $gsp if $gsp > $max_global_sp;
+
+ $index = do get_index_open_int($gsp,@sparks);
+ $spark_global_class[$index]++;
+
+ # ------------------------------------------------------------------------
+ # Add the above two entries to get the total number of sparks
+ # ------------------------------------------------------------------------
+
+ $sp = $lsp + $gsp;
+
+ push(@all_sparks,$sp);
+ $sum_sp += $sp;
+ $max_sp = $sp if $sp > $max_sp;
+
+ $index = do get_index_open_int($sp,@sparks);
+ $spark_class[$index]++;
+
+ # ------------------------------------------------------------------------
+ # Gather statistics about heap allocations
+ # ------------------------------------------------------------------------
+
+ push(@all_has,$ha);
+ $sum_ha += $ha;
+ $max_ha = $ha if $ha > $max_ha;
+
+ $index = do get_index_open_int($ha,@has);
+ $ha_class[$index]++;
+
+ # do print_line($start,$end,$is_global,$bbs,$ha,$rt,$bt,$bc,$ft,$fc,$my);
+}
+
+print STDERR "You don't want to engage me for a file with just $line_no lines, do you?(N)\n" , exit (-1) if $line_no <= 1;
+
+# ----------------------------------------------------------------------------
+
+do write_pie_chart();
+
+# ----------------------------------------------------------------------------
+# Statistics
+# ----------------------------------------------------------------------------
+
+if ( $opt_D ) {
+ print "Lengths:\n" .
+ " all_rts: $#all_rts;\n" .
+ " all_comm_percs: $#all_comm_percs;\n" .
+ " all_sparks: $#all_sparks; \n" .
+ " all_local_sparks: $#all_local_sparks; \n" .
+ " all_global_sparks: $#all_global_sparks; \n" .
+ " all_has: $#all_has\n" .
+ " all_fts: $#all_fts;\n";
+
+
+ print "No of elems in all_rts: $#all_rts with sum $sum_rt\n";
+ print "No of elems in all_comm_percs: $#all_rts with sum $sum_comm_perc\n";
+ print "No of elems in all_has: $#all_has with sum $sum_ha\n";
+ print "No of elems in all_fts: $#all_fts with sum $sum_ft\n";
+
+}
+
+do do_statistics($line_no);
+
+# Just for debugging
+# ..................
+
+if ( $opt_D ) {
+ open(FILE,">LOG") || die "Couldn't open file LOG\n";
+ printf FILE "All total runtimes (\@all_rts:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_rts);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_rt, $std_dev_rt\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All communication times (\@all_fts:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_fts);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_ft, $std_dev_ft\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All communication percentages (\@all_comm_percs:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_comm_percs);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_comm_perc,$std_dev_comm_perc\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All sparks (\@all_sparks:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_sparks);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_spark,$std_dev_spark\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All local sparks (\@all_local_sparks:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_local_sparks);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_local_spark,$std_dev_local_spark\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All global sparks (\@all_global_sparks:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_global_sparks);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_global_spark,$std_dev_global_spark\n";
+ printf FILE 70 x "-" . "\n";
+ printf FILE "All local sparks (\@all_has:)\n";
+ printf FILE "[";
+ printf FILE join(", ",@all_has);
+ printf FILE "]\n";
+ printf FILE " Mean, std. dev: $mean_ha,$std_dev_ha\n";
+ printf FILE 70 x "-" . "\n";
+
+
+ printf FILE ("CORR of runtime and heap alloc: %f\n",$c_exec_ha);
+ printf FILE ("CORR of runtime and no. of sparks: %f\n",$c_exec_sp);
+ printf FILE ("CORR of heap alloc and no. sparks: %f\n",$c_ha_sp);
+ printf FILE ("CORR of runtime and local sparks: %f\n",$c_exec_lsp);
+ printf FILE ("CORR of runtime and global sparks: %f\n",$c_exec_gsp);
+ printf FILE ("CORR of heap alloc and local sparks: %f\n",$c_ha_lsp);
+ printf FILE ("CORR of heap alloc and global sparks: %f\n",$c_ha_gsp);
+ printf FILE ("CORR of runtime and communication time: %f\n",$c_exec_ft);
+ printf FILE ("CORR of heap alloc and communication time: %f\n",$c_ha_ft);
+ printf FILE ("CORR of local sparks and communication time: %f\n",$c_lsp_ft);
+ printf FILE ("CORR of global_sparks and communication time: %f\n",$c_gsp_ft);
+ close FILE;
+}
+
+if ( $opt_P ) {
+ do percentify($line_no,*exec_class);
+ do percentify($line_no,*exec_global_class);
+ do percentify($line_no,*exec_local_class);
+ do percentify($line_no,*comm_class);
+ do percentify($line_no,*comm_global_class);
+ do percentify($line_no,*comm_local_class);
+ do percentify($line_no,*spark_local_class);
+ do percentify($line_no,*spark_global_class);
+ do percentify($line_no,*ha_class);
+ do percentify($line_no,*ft_class);
+}
+
+# Produce cumulative RT graph and other (more or less) nice graphs
+# ................................................................
+
+do sort_and_cum();
+
+# ----------------------------------------------------------------------------
+
+open(IV,">INTERVALS") || die "Couldn't open file INTERVALS\n";
+do write_interval(IV, 'G', &guess_interval(@all_rts));
+do write_interval(IV, 'C', 0, int($mean_comm_perc),
+ int($mean_comm_perc+$std_dev_comm_perc), 50);
+do write_interval(IV, 'S', &guess_interval(@all_sparks));
+do write_interval(IV, 'A', &guess_interval(@all_has));
+close(IV);
+
+# ----------------------------------------------------------------------------
+# Print results to STDOUT (mainly for testing)
+# ----------------------------------------------------------------------------
+
+if ( $opt_v ) {
+ do print_general_info();
+}
+
+# ----------------------------------------------------------------------------
+# Write results to data files to be processed by GNUPLOT
+# ----------------------------------------------------------------------------
+
+do write_data($gran_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
+ @exec_times, @exec_class);
+
+do write_data($gran_global_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
+ @exec_times, @exec_global_class);
+
+do write_data($gran_local_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
+ @exec_times, @exec_local_class);
+
+do write_data($comm_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
+ @comm_percs, @comm_class);
+
+do write_data($comm_global_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
+ @comm_percs, @comm_global_class);
+
+do write_data($comm_local_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
+ @comm_percs, @comm_local_class);
+
+do write_data($spark_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
+ @sparks, @spark_class);
+
+do write_data($spark_local_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
+ @sparks, @spark_local_class);
+
+do write_data($spark_global_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
+ @sparks, @spark_global_class);
+
+do write_data($ha_file_name, $OPEN_INT, $logscale{'a'}, $#has+1,
+ @has, @ha_class);
+
+do write_data($ft_file_name, $OPEN_INT, $logscale{'g'}, $#fetch_times+1,
+ @fetch_times, @fetch_class);
+
+
+# ----------------------------------------------------------------------------
+# Run GNUPLOT over the data files and create figures
+# ----------------------------------------------------------------------------
+
+do gnu_plotify($gp_file_name);
+
+print "Script finished successfully!\n";
+
+exit 0;
+
+# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+# ----------------------------------------------------------------------------
+# Basic Operations on the intervals
+# ----------------------------------------------------------------------------
+
+sub get_index_open_int {
+ local ($value,@list) = @_;
+ local ($index,$right);
+
+ # print "get_index: searching for index of" . $value;
+ # print " in " . join(':',@list);
+
+ $index = 0;
+ $right = $list[$index];
+ while ( ($value >= $right) && ($index < $#list) ) {
+ $index++;
+ $right = $list[$index];
+ }
+
+ return ( ($index == $#list) && ($value > $right) ) ? $index+1 : $index;
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_index_closed_int {
+ local ($value,@list) = @_;
+ local ($index,$right);
+
+ if ( ($value < $list[0]) || ($value > $list[$#list]) ) {
+ return ( -1 );
+ }
+
+ $index = 0;
+ $left = $list[$index];
+ while ( ($left <= $value) && ($index < $#list) ) {
+ $index++;
+ $left = $list[$index];
+ }
+ return ( $index-1 );
+}
+
+# ----------------------------------------------------------------------------
+# Write operations
+# ----------------------------------------------------------------------------
+
+sub write_data {
+ local ($file_name, $open_int, $logaxes, $n, @rest) = @_;
+ local (@times) = splice(@rest,0,$n);
+ local (@class) = @rest;
+
+ open(GRAN,">$file_name") || die "Couldn't open file $file_name for output";
+
+ if ( $open_int == $OPEN_INT ) {
+
+ for ($i=0,
+ $left = ( index($logaxes,"x") != -1 ? int($times[0]/2) : 0 ),
+ $right = 0;
+ $i < $n;
+ $i++, $left = $right) {
+ $right = $times[$i];
+ print GRAN int(($left+$right)/2) . " " .
+ ($class[$i] eq "" ? "0" : $class[$i]) . "\n";
+ }
+ print GRAN $times[$n-1]+(($times[$n-1]-$times[$n-2])/2) . " " .
+ ($class[$n] eq "" ? "0" : $class[$n]) . "\n";
+
+ } else {
+
+ print GRAN ( (index($logaxes,"x") != -1) && ($times[0] == 0 ? int($times[1]/2) : ($times[$1] + $times[0])/2 ) . " " . $class[0] . "\n");
+ for ($i=1; $i < $n-2; $i++) {
+ $left = $times[$i];
+ $right = $times[$i+1];
+ print(GRAN ($left+$right)/2 . " " .
+ ($class[$i] eq "" ? "0" : $class[$i]) . "\n");
+ }
+ print GRAN ($times[$n-1]+$times[$n-2])/2 . " " . $class[$n-2] if $n >= 2;
+ }
+
+ close(GRAN);
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_array {
+ local ($file_name,$n,@list) = @_;
+
+ open(FILE,">$file_name") || die "$file_name: $!";
+ for ($i=0; $i<=$#list; $i++) {
+ print FILE $i . " " . ( $list[$i] eq "" ? "0" : $list[$i] ) . "\n";
+ }
+
+ if ( $opt_D ) {
+ print "write_array: (" . join(", ",1 .. $#list) . ")\n for file $file_name returns: \n (0, $#list, &list_max(@list)\n";
+ }
+
+ return ( (0, $#list, &list_max(@list),
+ "(" . join(", ",1 .. $#list) . ")\n") );
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_cumulative_data {
+ local ($file_name1,$file_name2,@list) = @_;
+ local (@ns, @elems, @xtics, $i, $j, $n, $elem, $max_clust, $xtics_str,
+ $xstart, $xend, $file_name0);
+ local ($CLUST_SZ) = $no_of_clusters;
+
+ @ns = ();
+ @elems = ();
+ $file_name0 = $file_name1;
+ $file_name0 =~ s/\.dat$//;
+ $file_name0 .= "0.dat";
+ open(CUMM,">$file_name1") || die "Couldn't open file $file_name1 (error $!)\n";
+ open(CUMM0,">$file_name0") || die "Couldn't open file $file_name0 (error $!)\n";
+
+ print CUMM "1 0\n" unless $list[0] <= 1;
+ print CUMM0 "1 0\n" unless $list[0] <= 1;;
+
+ for ($i=0; $i <= $#list; $i++) {
+ $elem = $list[$i];
+ print CUMM ($elem) . " " . int( (100 * ($i)) / ($#list+1) ) . "\n" unless $elem == 0;
+ print CUMM0 ($elem) . " " . $i . "\n" unless $elem == 0;;
+ for ($n=1; $i < $#list && $list[$i+1] == $elem; $i++, $n++) { }
+
+ print CUMM "$elem " . int( (100 * ($i+1)) / ($#list+1) ) . "\n";
+ print CUMM0 "$elem " . ($i+1) . "\n";
+
+
+ if ( $opt_D ) {
+ print "\n--> Insert: n: $n (elem $elem) in the above lists yields: \n ";
+ }
+
+ # inlined version of do insert_elem($elem, $n, $#exs, @exs, @ns)
+ for ($j=0; $j<=$#ns && $ns[$j]>$n; $j++) { }
+ if ( $j > $#ns ) {
+ push(@ns,$n);
+ push(@elems,$elem);
+ } else {
+ splice(@ns,$j,0,$n); # insert $n at pos $j and move the
+ splice(@elems,$j,0,$elem); # rest of the array to the right
+ }
+
+ if ( $opt_D ) {
+ print "[" . join(", ",@ns) . "]" . "\n and \n" .
+ "[" . join(", ",@elems) . "]\n";
+ }
+
+ }
+
+ close(CUMM);
+ close(CUMM0);
+
+ open(CLUSTERS_ALL,">" . (&dirname($file_name2)) . "CL-" .
+ &basename($file_name2))
+ || die "Couldn't open file CL-$file_name2 (error $!)\n";
+ for ($i=0; $i <= $#ns; $i++) {
+ print CLUSTERS_ALL "$elems[$i] $ns[$i]\n";
+ }
+ close(CLUSTERS_ALL);
+
+ # Interesting are only the first parts of the list (clusters!)
+ splice(@elems, $CLUST_SZ);
+ splice(@ns, $CLUST_SZ);
+
+ open(CLUSTERS,">$file_name2") || die "Couldn't open file $file_name2 (error $!)\n";
+
+ $xstart = &list_min(@elems);
+ $xend = &list_max(@elems);
+ $step = ($xend - $xstart) / ( $CLUST_SZ == 1 ? 1 : ($CLUST_SZ-1));
+
+ @xtics = ();
+ for ($i=0, $x=$xstart; $i <= $#ns; $i++, $x+=$step) {
+ print CLUSTERS "$x $ns[$i]\n";
+ push(@xtics,"\"$elems[$i]\" $x");
+ }
+ close(CLUSTERS);
+
+ $max_clust = $ns[0];
+ $xtics_str = "(" . join(", ",@xtics) . ")\n";
+
+ return ( ($xstart, $xend, $max_clust, $xtics_str) );
+}
+
+# ----------------------------------------------------------------------------
+
+sub get_xtics {
+ local ($open_int, @list) = @_;
+
+ local ($str);
+
+ if ( $open_int == $OPEN_INT ) {
+ $last = pop(@list);
+ $str = "( \">0\" 0";
+ foreach $x (@list) {
+ $str .= ", \">$x\" $x";
+ }
+ $str .= ", \"Large\" $last)\n";
+ } else {
+ $left = shift(@list);
+ $right = shift(@list) if $#list >= 0;
+ $last = pop(@list) if $#list >= 0;
+ $str = "( \"$left-$right\" " . $left;
+ $left = $right;
+ foreach $right (@list) {
+ $str .= ", \"$left-$right\" " . ($left+$right)/2;
+ $left = $right;
+ }
+ $str .= ", \"$left-$last\" " . $last .")\n" unless $last eq "";
+ }
+ return $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_line {
+ local ($start,$end,$is_global,$bbs,$ha,$rt,$bt,$bc,$ft,$fc,$my) = @_;
+
+ printf("START: %u, END: %u ==> tot_exec: %u\n",
+ $start,$end,$end-$start);
+ printf(" BASIC_BLOCKS: %u, HEAP_ALLOCATIONS: %u \n",$bbs,$ha);
+ printf(" TOT_EXEC: %u = RUN_TIME %u + BLOCK_TIME %u + FETCH_TIME %u\n",
+ $end-$start,$rt,$bt,$ft);
+ printf(" BLOCK_TIME %u / BLOCK_COUNT %u; FETCH_TIME %u / FETCH_COUNT %u\n",
+ $bt,$bc,$ft,$fc);
+ printf(" %s %s\n",
+ $is_global eq 'T' ? "GLOBAL" : "LOCAL",
+ $my eq 'T' ? "MANDATORY" : "NOT MANDATORY");
+}
+
+# ----------------------------------------------------------------------------
+
+sub gnu_plotify {
+ local ($gp_file_name) = @_;
+
+ local (@open_xrange,@closed_xrang,@spark_xrange,@ha_xrange, @ft_range,
+ $exec_xtics,$comm_perc_xtics,$spark_xtics,$has_xtics,
+ $cumu0_rts_file, $cumu0_has_file, $cumu0_fts_file);
+
+ $cumu0_rts_file = $cumulat_rts_file_name;
+ $cumu0_rts_file =~ s/\.dat$//;
+ $cumu0_rts_file .= "0.dat";
+
+ $cumu0_has_file = $cumulat_has_file_name;
+ $cumu0_has_file =~ s/\.dat$//;
+ $cumu0_has_file .= "0.dat";
+
+ $cumu0_fts_file = $cumulat_fts_file_name;
+ $cumu0_fts_file =~ s/\.dat$//;
+ $cumu0_fts_file .= "0.dat";
+
+ $cumu0_cps_file = $cumulat_cps_file_name;
+ $cumu0_cps_file =~ s/\.dat$//;
+ $cumu0_cps_file .= "0.dat";
+
+ @open_xrange = &range($OPEN_INT,$logscale{'g'},@exec_times);
+ @closed_xrange = &range($CLOSED_INT,$logscale{'c'},@comm_percs);
+ @spark_xrange = &range($OPEN_INT,$logscale{'s'},@sparks);
+ @ha_xrange = &range($OPEN_INT,$logscale{'a'},@has);
+ @ft_xrange = &range($OPEN_INT,$logscale{'f'},@fts);
+
+ $exec_xtics = $opt_T ? &get_xtics($OPEN_INT,@exec_times) : "" ;
+ $comm_perc_xtics = $opt_T ? &get_xtics($CLOSED_INT,@comm_percs) : "";
+ $spark_xtics = $opt_T ? &get_xtics($OPEN_INT,@sparks) : "";
+ $has_xtics = $opt_T ? &get_xtics($OPEN_INT,@has) : "";
+ $fts_xtics = $opt_T ? &get_xtics($OPEN_INT,@fts) : "";
+
+ open(GP_FILE,">$gp_file_name") ||
+ die "Couldn't open gnuplot file $gp_file_name for output\n";
+
+ if ( $opt_m ) {
+ print GP_FILE "set term postscript \"Roman\" 20\n";
+ } else {
+ print GP_FILE "set term postscript color \"Roman\" 20\n";
+ }
+
+ do write_gp_record(GP_FILE,
+ $gran_file_name, &dat2ps_name($gran_file_name),
+ "Granularity (pure exec. time)", $ylabel, $logscale{'g'},
+ @open_xrange,$max_rt_class,$exec_xtics);
+ do write_gp_record(GP_FILE,
+ $gran_global_file_name, &dat2ps_name($gran_global_file_name),
+ "Granularity (pure exec. time) of exported threads",
+ $ylabel, $logscale{'g'},
+ @open_xrange,$max_rt_global_class,$exec_xtics);
+ do write_gp_record(GP_FILE,
+ $gran_local_file_name, &dat2ps_name($gran_local_file_name),
+ "Granularity (pure exec. time) of not exported threads",
+ $ylabel,$logscale{'g'},
+ @open_xrange,$max_rt_local_class,$exec_xtics);
+
+ do write_gp_record(GP_FILE,
+ $comm_file_name, &dat2ps_name($comm_file_name),
+ "% of communication",$ylabel,$logscale{'c'},
+ @closed_xrange,$max_comm_perc_class,$comm_perc_xtics);
+ do write_gp_record(GP_FILE,
+ $comm_global_file_name, &dat2ps_name($comm_global_file_name),
+ "% of communication of exported threads",$ylabel,$logscale{'c'},
+ @closed_xrange,$max_comm_perc_global_class,$comm_perc_xtics);
+ do write_gp_record(GP_FILE,
+ $comm_local_file_name, &dat2ps_name($comm_local_file_name),
+ "% of communication of not exported threads",$ylabel,$logscale{'c'},
+ @closed_xrange,$max_comm_perc_local_class,$comm_perc_xtics);
+ do write_gp_record(GP_FILE,
+ $ft_file_name, &dat2ps_name($ft_file_name),
+ "Communication time", $ylabel, $logscale{'g'},
+ @open_xrange,$max_ft_class,$fts_xtics);
+
+
+ do write_gp_record(GP_FILE,
+ $spark_file_name, &dat2ps_name($spark_file_name),
+ "No. of sparks created", $ylabel, $logscale{'s'},
+ @spark_xrange,$max_spark_class,$spark_xtics);
+
+ do write_gp_record(GP_FILE,
+ $spark_local_file_name, &dat2ps_name($spark_local_file_name),
+ "No. of sparks created (parLocal)", $ylabel, $logscale{'s'},
+ @spark_xrange,$max_spark_local_class,$spark_xtics);
+
+ do write_gp_record(GP_FILE,
+ $spark_global_file_name, &dat2ps_name($spark_global_file_name),
+ "No. of sparks created (parGlobal)", $ylabel, $logscale{'s'},
+ @spark_xrange,$max_spark_global_class,$spark_xtics);
+
+ do write_gp_record(GP_FILE,
+ $ha_file_name, &dat2ps_name($ha_file_name),
+ "Heap Allocations (words)", $ylabel, $logscale{'a'},
+ @ha_xrange,$max_ha_class,$has_xtics);
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat_rts_file_name, &dat2ps_name($cumulat_rts_file_name),
+ "Cumulative pure exec. times","% of threads",
+ $logscale{'Cg'},
+ $xend_cum_rts, $yend_cum_rts,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat_has_file_name, &dat2ps_name($cumulat_has_file_name),
+ "Cumulative heap allocations","% of threads",
+ $logscale{'Ca'},
+ $xend_cum_has, $yend_cum_has,"");
+ # $xtics_cluster_has as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumu0_rts_file, &dat2ps_name($cumu0_rts_file),
+ "Cumulative pure exec. times","Number of threads",
+ $logscale{'Cg'},
+ $xend_cum_rts, $yend_cum0_rts,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumu0_has_file, &dat2ps_name($cumu0_has_file),
+ "Cumulative heap allocations","Number of threads",
+ $logscale{'Ca'},
+ $xend_cum_has, $yend_cum0_has,"");
+ # $xtics_cluster_has as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat_fts_file_name, &dat2ps_name($cumulat_fts_file_name),
+ "Cumulative communication times","% of threads",
+ $logscale{'Cg'},
+ $xend_cum_fts, $yend_cum_fts,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumu0_fts_file, &dat2ps_name($cumu0_fts_file),
+ "Cumulative communication times","Number of threads",
+ $logscale{'Cg'},
+ $xend_cum_fts, $yend_cum0_fts,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumulat_cps_file_name, &dat2ps_name($cumulat_cps_file_name),
+ "Cumulative communication percentages","% of threads",
+ "", # No logscale here !
+ $xend_cum_cps, $yend_cum_cps,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_lines_record(GP_FILE,
+ $cumu0_cps_file, &dat2ps_name($cumu0_cps_file),
+ "Cumulative communication percentages","Number of threads",
+ "", # No logscale here !
+ $xend_cum_cps, $yend_cum0_cps,"");
+ # $xtics_cluster_rts as last arg?
+
+ do write_gp_record(GP_FILE,
+ $clust_rts_file_name, &dat2ps_name($clust_rts_file_name),
+ "Pure exec. time", "No. of threads", $logscale{'CG'},
+ $xstart_cluster_rts,$xend_cluster_rts,$max_cluster_rts,$xtics_cluster_rts);
+
+ do write_gp_record(GP_FILE,
+ $clust_has_file_name, &dat2ps_name($clust_has_file_name),
+ "Pure exec. time", "No. of threads", $logscale{'CA'},
+ $xstart_cluster_has,$xend_cluster_has,$max_cluster_has,$xtics_cluster_has);
+
+ do write_gp_record(GP_FILE,
+ $clust_fts_file_name, &dat2ps_name($clust_fts_file_name),
+ "Communication time", "No. of threads", $logscale{'CG'},
+ $xstart_cluster_fts,$xend_cluster_fts,$max_cluster_fts,$xtics_cluster_rts);
+
+
+ do write_gp_simple_record(GP_FILE,
+ $pe_file_name, &dat2ps_name($pe_file_name),
+ "Processing Elements (PEs)", "Ready Time (not running)",
+ $logscale{'Yp'},$xstart_pe,$xend_pe,$max_pe,$xtics_pe);
+
+ do write_gp_simple_record(GP_FILE,
+ $sn_file_name, &dat2ps_name($sn_file_name),
+ "Spark sites", "Pure exec. time",
+ $logscale{'Ys'},$xstart_sn,$xend_sn,$max_sn,$xtics_sn);
+
+ close GP_FILE;
+
+ print "Gnu plotting figures ...\n";
+ system "gnuplot $gp_file_name";
+
+ print "Extending thickness of impulses ...\n";
+ do gp_ext($gran_file_name,
+ $gran_global_file_name,
+ $gran_local_file_name,
+ $comm_file_name,
+ $comm_global_file_name,
+ $comm_local_file_name,
+ $spark_file_name,
+ $spark_local_file_name,
+ $spark_global_file_name,
+ $ha_file_name,
+ $ft_file_name,
+ $clust_fts_file_name,
+ $clust_rts_file_name,
+ $clust_has_file_name,
+ $pe_file_name,
+ $sn_file_name
+ );
+
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub gp_ext {
+ local (@file_names) = @_;
+ local ($file_name);
+ local ($ps_file_name);
+ local ($prg);
+
+ #$prg = system "which gp-ext-imp";
+ #print " Using script $prg for impuls extension\n";
+ $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp"
+ : $ENV{HOME} . "/bin/gp-ext-imp" ;
+ if ( $opt_v ) {
+ print " (using script $prg)\n";
+ }
+
+ foreach $file_name (@file_names) {
+ $ps_file_name = &dat2ps_name($file_name);
+ system "$prg -w $ext_size -g $gray " .
+ $ps_file_name . " " .
+ $ps_file_name . "2" ;
+ system "mv " . $ps_file_name . "2 " . $ps_file_name;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xstart,$xend,$ymax,$xtics) = @_;
+
+ if ( $xstart >= $xend ) {
+ print ("WARNING: empty xrange [$xstart:$xend] changed to [$xstart:" . $xstart+1 . "]\n") if ( $pedantic || $opt_v );
+ $xend = $xstart + 1;
+ }
+
+ if ( $ymax <=0 ) {
+ $ymax = 2;
+ print "WARNING: empty yrange changed to [0:$ymax]\n" if ( $pedantic || $opt_v );
+ }
+
+ $str = "set size " . $xsize . "," . $ysize . "\n" .
+ "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ ($xstart eq "" ? ""
+ : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
+ ($ymax eq "" ? ""
+ : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) .
+ ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
+ ($xtics ne "" ? "set xtics $xtics" : "") .
+ "set tics out\n" .
+ "set border\n" .
+ "set title \"$nPEs PEs\"\n" .
+ "set nokey \n" .
+ "set nozeroaxis\n" .
+ "set format xy \"%g\"\n" .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with impulses\n\n";
+ print $file $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_lines_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xend,$yend,$xtics) = @_;
+
+ local ($str);
+
+ $str = "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ "set xrange [" . ( index($logaxes,"x") != -1 ? 1 : 0 ) . ":$xend]\n" .
+ "set yrange [" . ( index($logaxes,"y") != -1 ? 1 : 0 ) . ":$yend]\n" .
+ "set border\n" .
+ "set nokey\n" .
+ ( $xtics ne "" ? "set xtics $xtics" : "" ) .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set nozeroaxis\n" .
+ "set format xy \"%g\"\n" .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with lines\n\n";
+ print $file $str;
+}
+
+
+# ----------------------------------------------------------------------------
+
+sub write_gp_simple_record {
+ local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
+ $xstart,$xend,$ymax,$xtics) = @_;
+
+ $str = "set size " . $xsize . "," . $ysize . "\n" .
+ "set xlabel \"" . $xlabel . "\"\n" .
+ "set ylabel \"" . $ylabel . "\"\n" .
+ ($xstart eq "" ? ""
+ : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
+ ($ymax eq "" ? ""
+ : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) .
+ ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
+ ($xtics ne "" ? "set xtics $xtics" : "") .
+ "set border\n" .
+ "set nokey\n" .
+ "set tics out\n" .
+ "set nozeroaxis\n" .
+ "set format xy \"%g\"\n" .
+ (index($logaxes,"x") != -1 ?
+ "set logscale x\n" :
+ "set nologscale x\n") .
+ (index($logaxes,"y") != -1 ?
+ "set logscale y\n" :
+ "set nologscale y\n") .
+ "set output \"" . $out_file . "\"\n" .
+ "plot \"" . $in_file . "\" with impulses\n\n";
+ print $file $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub dat2ps_name {
+ local ($dat_name) = @_;
+
+ $dat_name =~ s/\.dat$/\.ps/;
+ return ($dat_name);
+}
+
+# ----------------------------------------------------------------------------
+
+sub range {
+ local ($open_int, $logaxes, @ints) = @_;
+
+ local ($range, $left_margin, $right_margin);
+
+ $range = $ints[$#ints]-$ints[0];
+ $left_margin = 0; # $range/10;
+ $right_margin = 0; # $range/10;
+
+ if ( $opt_D ) {
+ print "\n==> Range: logaxes are $logaxes i.e. " .
+ (index($logaxes,"x") != -1 ? "matches x axis\n"
+ : "DOESN'T match x axis\n");
+ }
+ if ( index($logaxes,"x") != -1 ) {
+ if ( $open_int == $OPEN_INT ) {
+ return ( ($ints[0]/2-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ } else {
+ return ( ( &list_max(1,$ints[0]-$left_margin),
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ }
+ } else {
+ if ( $open_int == $OPEN_INT ) {
+ return ( ($ints[0]/2-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ } else {
+ return ( ($ints[0]-$left_margin,
+ $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
+ }
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub percentify {
+ local ($sum,*classes) = @_;
+
+ for ($i=0; $i<=$#classes; $i++) {
+ $classes[$i] = (100 * $classes[$i]) / $sum;
+ }
+}
+
+# ----------------------------------------------------------------------------
+# ToDo: get these statistics functions from "stat.pl"
+# ----------------------------------------------------------------------------
+
+sub mean_std_dev {
+ local ($sum,@list) = @_;
+
+ local ($n, $s, $s_);
+
+ #print "\nmean_std_dev: sum is $sum ; list has length $#list";
+
+ $n = $#list+1;
+ $mean_value = $sum/$n;
+
+ $s_ = 0;
+ foreach $x (@list) {
+ $s_ += $x;
+ $s += ($mean_value - $x) ** 2;
+ }
+ if ( $sum != $s_ ) {
+ print "ERROR in mean_std_dev: provided sum is wrong " .
+ "(provided: $sum; computed: $s_)\n";
+ print " list_sum: " . &list_sum(@list) . "\n";
+ exit (2);
+ }
+
+ return ( ($mean_value, sqrt($s / ($n - 1)) ) );
+}
+
+# ----------------------------------------------------------------------------
+
+sub _mean_std_dev {
+ return ( &mean_std_dev(&list_sum(@_), @_) );
+}
+
+# ----------------------------------------------------------------------------
+# Compute covariance of 2 vectors, having their sums precomputed.
+# Input: $n ... number of all elements in @list_1 as well as in @list_2
+# (i.e. $n = $#list_1+1 = $#list_2+1).
+# $mean_1 ... mean value of all elements in @list_1
+# @list_1 ... list of integers; first vector
+# $mean_2 ... mean value of all elements in @list_2
+# @list_2 ... list of integers; first vector
+# Output: covariance of @list_1 and @list_2
+# ----------------------------------------------------------------------------
+
+sub cov {
+ local ($n, $mean_1, @rest) = @_;
+ local (@list_1) = splice(@rest,0,$n);
+ local ($mean_2, @list_2) = @rest;
+
+ local ($i,$s,$s_1,$s_2);
+
+ for ($i=0; $i<$n; $i++) {
+ $s_1 += $list_1[$i];
+ $s_2 += $list_2[$i];
+ $s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
+ }
+ if ( $mean_1 != ($s_1/$n) ) {
+ print "ERROR in cov: provided mean value is wrong " .
+ "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n";
+ exit (2);
+ }
+ if ( $mean_2 != ($s_2/$n) ) {
+ print "ERROR in cov: provided mean value is wrong " .
+ "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n";
+ exit (2);
+ }
+ return ( $s / ($n - 1) ) ;
+}
+
+# ----------------------------------------------------------------------------
+# Compute correlation of 2 vectors, having their sums precomputed.
+# Input: $n ... number of all elements in @list_1 as well as in @list_2
+# (i.e. $n = $#list_1+1 = $#list_2+1).
+# $sum_1 ... sum of all elements in @list_1
+# @list_1 ... list of integers; first vector
+# $sum_2 ... sum of all elements in @list_2
+# @list_2 ... list of integers; first vector
+# Output: correlation of @list_1 and @list_2
+# ----------------------------------------------------------------------------
+
+sub corr {
+ local ($n, $sum_1, @rest) = @_;
+ local (@list_1) = splice(@rest,0,$n);
+ local ($sum_2, @list_2) = @rest;
+
+ local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
+
+ if ( $opt_D ) {
+ print "\ncorr: n=$n sum_1=$sum_1 sum_2=$sum_2\n";
+ print " list_sum of list_1=" . &list_sum(@list_1) .
+ " list_sum of list_2=" . &list_sum(@list_2) . "\n";
+ print " len of list_1=$#list_1 len of list_2=$#list_2\n";
+ }
+
+ ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1);
+ ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2);
+
+ if ( $opt_D ) {
+ print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
+ }
+
+ return ( ($std_dev_1 * $std_dev_2) == 0 ?
+ 0 :
+ &cov($n, $mean_1, @list_1, $mean_2, @list_2) /
+ ( $std_dev_1 * $std_dev_2 ) );
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_sum {
+ local (@list) = @_;
+
+ local ($sum);
+
+ foreach $x (@list) {
+ $sum += $x;
+ }
+
+ return ($sum);
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_max {
+ local (@list) = @_;
+
+ local ($max) = shift;
+
+ foreach $x (@list) {
+ $max = $x if $x > $max;
+ }
+
+ return ($max);
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_min {
+ local (@list) = @_;
+
+ local ($min) = shift;
+
+ foreach $x (@list) {
+ $min = $x if $x < $min;
+ }
+
+ return ($min);
+}
+
+# ----------------------------------------------------------------------------
+
+sub guess_interval {
+ local (@list) = @_ ;
+
+ local ($min,$max,$sum,$mean,$std_dev,@intervals);
+
+ $min = &list_min(@list);
+ $max = &list_max(@list);
+ $sum = &list_sum(@list);
+ ($mean, $std_dev) = &mean_std_dev($sum,@list);
+
+ @intervals = (int($mean-$std_dev),int($mean-$std_dev/2),int($mean),
+ int($mean+$std_dev/2),int($mean+$std_dev));
+
+ while ($#intervals>=0 && $intervals[0]<0) {
+ shift(@intervals);
+ }
+
+ return (@intervals);
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_interval {
+ local ($file,$flag,@intervals) = @_;
+
+ printf $file "$flag: (" . join(", ",@intervals) . ")\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub read_template {
+
+ if ( $opt_v ) {
+ print "Reading settings from template file $templ_file_name ...\n";
+ }
+
+ open(TEMPLATE,$templ_file_name) || die "Couldn't open file $templ_file_name";
+ while (<TEMPLATE>) {
+ next if /^\s*$/ || /^--/;
+ if (/^\s*G[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @exec_times = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @fetch_times = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @has = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @comm_percs = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
+ ($gran_file_name,$gran_global_file_name, $gran_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
+ ($ft_file_name,$ft_global_file_name, $ft_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
+ ($comm_file_name, $comm_global_file_name, $comm_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
+ ($spark_file_name, $spark_global_file_name, $spark_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
+ ($ha_file_name, $ha_global_file_name, $ha_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
+ $gp_file_name = $1;
+ $ps_file_name = &dat2ps_name($gp_file_name);
+
+ } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
+ $corr_file_name = $1;
+ } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
+ $cumulat_rts_file_name = $1;
+ } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
+ $cumulat_has_file_name = $1;
+ } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
+ $cumulat_fts_file_name = $1;
+ } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
+ $cumulat_cps_file_name = $1;
+ } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
+ $clust_rts_file_name = $1;
+ } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
+ $clust_has_file_name = $1;
+ } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
+ $clust_fts_file_name = $1;
+ } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
+ $clust_cps_file_name = $1;
+ } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
+ $pe_file_name = $1;
+ } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
+ $sn_file_name = $1;
+
+ } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
+ $rts_file_name = $1;
+ } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
+ $has_file_name = $1;
+ } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
+ $fts_file_name = $1;
+ } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
+ $lsps_file_name = $1;
+ } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
+ $gsps_file_name = $1;
+ } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
+ $cps_file_name = $1;
+ } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
+ $ccps_file_name = $1;
+
+ } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
+ $input = $1;
+ } elsif (/^\s*L[:,;\s]+(.*)$/) {
+ $str = $1;
+ %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next if $str eq ".";
+ $str =~ s/[\(\)\[\]]//g;
+ %logscale = split(/[,;. ]+/, $str);
+ } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
+ $gray = $1;
+ } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
+ $no_of_clusters = $1;
+ } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
+ $ext_size = $1;
+ } elsif (/^\s*v.*$/) {
+ $verbose = 1;
+ } elsif (/^\s*T.*$/) {
+ $opt_T = 1;
+ } elsif (/^\s*m.*$/) {
+ $opt_m = 1;
+ }
+ }
+ close(TEMPLATE);
+}
+
+# ----------------------------------------------------------------------------
+
+sub mk_global_local_names {
+ local ($file_name) = @_;
+
+ $file_name .= ".dat" unless $file_name =~ /\.dat$/;
+ $global_file_name = $file_name;
+ $global_file_name =~ s/\.dat/\-global\.dat/ ;
+ $local_file_name = $file_name;
+ $local_file_name =~ s/\.dat/\-local\.dat/ ;
+
+ return ( ($file_name, $global_file_name, $local_file_name) );
+}
+
+# ----------------------------------------------------------------------------
+
+# ----------------------------------------------------------------------------
+
+sub pre_process {
+ local ($lines) = @_;
+
+ local (@all_rts, @all_comm_percs, @all_sparks, @all_local_sparks,
+ @all_global_sparks, @all_has, @fields,
+ $line_no, $elem, $total_rt, $comm_perc,
+ $pe, $start, $end, $is_global, $bbs, $ha, $rt, $bt, $ft,
+ $lsp, $gsp, $my);
+
+ if ( $opt_v ) {
+ print "Preprocessing file $input ... \n";
+ }
+
+ open(INPUT,"<$input") || die "Couldn't open input file $input";
+
+ do skip_header();
+
+ $line_no = 0;
+ while (<INPUT>) {
+ $line_no++;
+ last if $line_no > $lines;
+
+ @fields = split(/,/,$_);
+
+ foreach $elem (@fields) {
+ foo : {
+ $pe = $1 , last foo if $elem =~ /^\s*PE\s+(\d+).*$/;
+ $start = $1 , last foo if $elem =~ /^\s*ST\s+(\d+).*$/;
+ $end = $1 , last foo if $elem =~ /^\s*END\s+(\d+).*$/;
+ $is_global = $1 , last foo if $elem =~ /^\s*GBL\s+(T|F).*$/;
+ $bbs = $1 , last foo if $elem =~ /^\s*BB\s+(\d+).*$/;
+ $ha = $1 , last foo if $elem =~ /^\s*HA\s+(\d+).*$/;
+ $rt = $1 , last foo if $elem =~ /^\s*RT\s+(\d+).*$/;
+ $bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
+ $ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
+ $lsp = $1 , last foo if $elem =~ /^\s*LS\s+(\d+).*$/;
+ $gsp = $1 , last foo if $elem =~ /^\s*GS\s+(\d+).*$/;
+ $my = $1 , last foo if $elem =~ /^\s*MY\s+(T|F).*$/;
+ }
+ }
+
+ $total_rt = $end - $start;
+ $comm_perc = ( $total_rt == 0 ? 100 : (100 * $ft)/$total_rt );
+ $sp = $lsp + $gsp;
+
+ push(@all_rts,$rt);
+
+ push(@all_comm_percs,$comm_perc);
+
+ push(@all_sparks,$sp);
+ push(@all_local_sparks,$lsp);
+ push(@all_global_sparks,$gsp);
+
+ push(@all_has,$ha);
+ }
+
+ close(INPUT);
+
+ @exec_times = &guess_interval(@all_rts);
+ @sparks = &guess_interval(@all_sparks);
+ @has = &guess_interval(@all_has);
+
+ ($m,$std_dev) = &_mean_std_dev(@all_comm_percs);
+ @comm_percs = (0, int($m), int($std_dev), 100) unless int($m) == 0;
+ @comm_percs = (0, 1, 2, 5, 10, 50, 100) if int($m) == 0;
+}
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0)";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+
+ # system "cat $0 | awk 'BEGIN { n = 0; } \
+ # /^$/ { print n; \
+ # exit; } \
+ # { n++; }'"
+ exit ;
+ }
+
+ if ( $opt_W ) {
+ $pedantic = 1;
+ } else {
+ $pedantic = 0;
+ }
+
+ $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
+
+ if ( $#ARGV != 0 ) {
+ #print "Usage: gran-extr [options] <sim-file>\n";
+ #print "Use -h option to get details\n";
+ #exit 1;
+
+ }
+
+
+ if ( ! $opt_t ) {
+ do pre_process(20);
+ }
+
+ if ( $opt_g ) {
+ ($gran_file_name, $gran_global_file_name, $gran_local_file_name) =
+ do mk_global_local_names($opt_g);
+ } else {
+ $gran_file_name = "gran.dat";
+ $gran_global_file_name = "gran-global.dat";
+ $gran_local_file_name = "gran-local.dat";
+ }
+
+ if ( $opt_c ) {
+ ($comm_file_name, $comm_global_file_name, $comm_local_file_name) =
+ do mk_global_local_names($opt_c);
+ } else {
+ $comm_file_name = "comm.dat";
+ $comm_global_file_name = "comm-global.dat";
+ $comm_local_file_name = "comm-local.dat";
+ }
+
+ if ( $opt_f ) {
+ ($ft_file_name, $ft_global_file_name, $ft_local_file_name) =
+ do mk_global_local_names($opt_c);
+ } else {
+ $ft_file_name = "ft.dat";
+ $ft_global_file_name = "ft-global.dat";
+ $ft_local_file_name = "ft-local.dat";
+ }
+
+ if ( $opt_s ) {
+ ($spark_file_name, $spark_global_file_name, $spark_local_file_name) =
+ do mk_global_local_names($opt_s);
+ } else {
+ $spark_file_name = "spark.dat";
+ $spark_global_file_name = "spark-global.dat";
+ $spark_local_file_name = "spark-local.dat";
+ }
+
+ if ( $opt_a ) {
+ ($ha_file_name, $ha_global_file_name, $ha_local_file_name) =
+ do mk_global_local_names($opt_a);
+ } else {
+ $ha_file_name = "ha.dat";
+ }
+
+ if ( $opt_p ) {
+ $gp_file_name = $opt_p;
+ } else {
+ $gp_file_name = "gran.gp";
+ }
+
+ $ps_file_name = &dat2ps_name($gp_file_name);
+
+ $corr_file_name = "CORR";
+ $cumulat_rts_file_name = "cumulative-rts.dat";
+ $cumulat_has_file_name = "cumulative-has.dat";
+ $cumulat_fts_file_name = "cumulative-fts.dat";
+ $cumulat_cps_file_name = "cumulative-cps.dat";
+ $clust_rts_file_name = "clusters-rts.dat";
+ $clust_has_file_name = "clusters-has.dat";
+ $clust_fts_file_name = "clusters-fts.dat";
+ $clust_cps_file_name = "clusters-cps.dat";
+ $pe_file_name = "pe.dat";
+ $sn_file_name = "sn.dat";
+
+ $pie_file_name = "Pie.ps";
+
+ $cps_file_name = "CPS";
+ $fts_file_name = "FTS";
+ $rts_file_name = "RTS";
+ $has_file_name = "HAS";
+ $lsps_file_name = "LSPS";
+ $gsps_file_name = "GSPS";
+ $ccps_file_name = "CCPS";
+
+ if ( $opt_l ) {
+ $left_margin = $opt_l;
+ } else {
+ $left_margin = 0;
+ }
+ $left_perc_margin = 0;
+
+ if ( $opt_r ) {
+ $right_margin = $opt_r;
+ } else {
+ $right_margin = 0;
+ }
+ $right_perc_margin = 0;
+
+ if ( $opt_x ) {
+ $xsize = $opt_x;
+ } else {
+ $xsize = 1;
+ }
+
+ if ( $opt_y ) {
+ $ysize = $opt_y;
+ } else {
+ $ysize = 1;
+ }
+
+ if ( $opt_e ) {
+ $ext_size = $opt_e;
+ } else {
+ $ext_size = 200;
+ }
+
+ if ( $opt_i ) {
+ $gray = $opt_i;
+ } else {
+ $gray = 0;
+ }
+
+ if ( $opt_k ) {
+ $no_of_clusters = $opt_k;
+ } else {
+ $no_of_clusters = 5;
+ }
+
+ if ( $opt_L ) {
+ $str = $opt_L;
+ $str =~ s/[\(\)\[\]]//g;
+ %logscale = split(/[,;. ]+/, $str);
+ # $logscale = $opt_L;
+ } else {
+ %logscale = (); # ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy");
+ }
+
+# $delta = do compute_delta(@exec_times);
+# $no_of_exec_times = $#exec_times;
+
+ if ( $opt_G ) {
+ $opt_G =~ s/[\(\)\[\]]//g;
+ @exec_times = split(/[,;. ]+/, $opt_G);
+ # @exec_times = split(/[,;. ]+/, ($opt_G =~ s/[\(\)]//g));
+ } else {
+ # @exec_times = (50, 100, 200, 300, 400, 500, 700);
+ }
+
+ if ( $opt_F ) {
+ $opt_F =~ s/[\(\)\[\]]//g;
+ @fetch_times = split(/[,;. ]+/, $opt_F);
+ # @fetch_times = split(/[,;. ]+/, ($opt_F =~ s/[\(\)]//g));
+ } else {
+ # @fetch_times = (50, 100, 200, 300, 400, 500, 700);
+ }
+
+ if ( $opt_C ) {
+ $opt_C =~ s/[\(\)\[\]]//g;
+ @comm_percs = split(/[,;. ]+/, $opt_C);
+ } else {
+ # @comm_percs = (0,10,20,30,50,100);
+ }
+
+ if ( $opt_S ) {
+ $opt_S =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $opt_S);
+ } else {
+ # @sparks = (0,5,10,50);
+ }
+
+# $delta_comm = do compute_delta(@comm_percs);
+
+ if ( $opt_A ) {
+ $opt_A =~ s/[\(\)\[\]]//g;
+ @has = split(/[,;. ]+/, $opt_A);
+ } else {
+ # @has = (10, 100, 200, 300, 500, 1000);
+ }
+
+ if ( $opt_t ) {
+ $templ_file_name = ( $opt_t eq '.' ? "TEMPL" # default file name
+ : $opt_t eq ',' ? "/users/fp/hwloidl/grasp/GrAn/bin/TEMPL" # global master template
+ : $opt_t eq '/' ? "/users/fp/hwloidl/grasp/GrAn/bin/T0" # template, that throws away most of the info
+ : $opt_t );
+ do read_template();
+ # see RTS2gran for use of template-package
+ }
+
+ $ylabel = $opt_P ? "% of threads" : "No. of threads";
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ print "-" x 70 . "\n";
+ print "Setup: \n";
+ print "-" x 70 . "\n";
+ print "\nFilenames: \n";
+ print " Input file: $input\n";
+ print " Gran files: $gran_file_name $gran_global_file_name $gran_local_file_name\n";
+ print " Comm files: $comm_file_name $comm_global_file_name $comm_local_file_name\n";
+ print " Sparked threads file: $spark_file_name $spark_local_file_name $spark_global_file_name\n";
+ print " Heap file: $ha_file_name\n";
+ print " GNUPLOT file name: $gp_file_name Correlation file name: $corr_file_name\n";
+ print " Cumulative RT file name: $cumulat_rts_file_name \n Cumulative HA file name: $cumulat_has_file_name\n";
+ print " Cluster RT file name: $clust_rts_file_name \n Cluster HA file name: $clust_has_file_name\n";
+ print " Cumulative runtimes file name: $cumulat_rts_file_name\n";
+ print " Cumulative heap allocations file name $cumulat_has_file_name\n";
+ print " Cluster run times file name: $clust_rts_file_name\n";
+ print " Cluster heap allocations file name: $clust_has_file_name\n";
+ print " PE load file name: $pe_file_name\n";
+ print " Site size file name: $sn_file_name\n";
+ print "\nBoundaries: \n";
+ print " Gran boundaries: @exec_times\n";
+ print " Comm boundaries: @comm_percs\n";
+ print " Sparked threads boundaries: @sparks\n";
+ print " Heap boundaries: @has\n";
+ print "\nOther pars: \n";
+ print " Left margin: $left_margin Right margin: $right_margin\n";
+ print " GP-extension: $ext_size GP xsize: $xsize GP ysize: $ysize\n";
+ print " Gray scale: $gray Smart x-tics is " . ($opt_T ? "ON" : "OFF") .
+ " Percentage y-axis is " . ($opt_P ? "ON" : "OFF") . "\n";
+ print " Log. scaling assoc list: ";
+ while (($key,$value) = each %logscale) {
+ print "$key: $value, ";
+ }
+ print "\n";
+ print " Active template file: $templ_file\n" if $opt_t;
+ print "-" x 70 . "\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub sort_and_cum {
+
+@sorted_rts = sort {$a <=> $b} @all_rts;
+
+($xstart_cluster_rts,$xend_cluster_rts,$max_cluster_rts,$xtics_cluster_rts) =
+ &write_cumulative_data($cumulat_rts_file_name,$clust_rts_file_name,@sorted_rts);
+
+$xend_cum_rts = pop(@sorted_rts);
+$yend_cum_rts = 100;
+$yend_cum0_rts = $#sorted_rts+1; # unpercentified cum graph
+
+open(RTS,">$rts_file_name") || die "$rts_file_name: $!";
+print RTS "Sorted list of all runtimes:\n";
+print RTS join("\n",@sorted_rts);
+close(RTS);
+
+@sorted_has = sort {$a <=> $b} @all_has;
+
+($xstart_cluster_has,$xend_cluster_has,$max_cluster_has,$xtics_cluster_has) =
+ &write_cumulative_data($cumulat_has_file_name,$clust_has_file_name,@sorted_has);
+
+$xend_cum_has = pop(@sorted_has);
+$yend_cum_has = 100;
+$yend_cum0_has = $#sorted_has+1; # unpercentified cum graph
+
+open(HAS,">$has_file_name") || die "$has_file_name: $!";
+print HAS "Sorted list of all heap allocations:\n";
+print HAS join("\n",@sorted_has);
+close(HAS);
+
+@sorted_lsps = sort {$a <=> $b} @all_local_sparks;
+
+open(LSPS,">$lsps_file_name") || die "$lsps_file_name: $!";
+print LSPS "Sorted list of all local sparks:\n";
+print LSPS join("\n",@sorted_lsps);
+close(LSPS);
+
+@sorted_gsps = sort {$a <=> $b} @all_global_sparks;
+
+open(GSPS,">$gsps_file_name") || die "$gsps_file_name: $!";
+print GSPS "Sorted list of all global sparks:\n";
+print GSPS join("\n",@sorted_gsps);
+close(GSPS);
+
+@sorted_fts = sort {$a <=> $b} @all_fts;
+
+($xstart_cluster_fts,$xend_cluster_fts,$max_cluster_fts,$xtics_cluster_fts) =
+ &write_cumulative_data($cumulat_fts_file_name,$clust_fts_file_name,@sorted_fts);
+
+$xend_cum_fts = pop(@sorted_fts);
+$yend_cum_fts = 100;
+$yend_cum0_fts = $#sorted_fts+1; # unpercentified cum graph
+
+open(FTS,">$fts_file_name") || die "$FTS_file_name: $!";
+print FTS "Sorted list of all communication times:\n";
+print FTS join("\n",@sorted_fts);
+close(FTS);
+
+@sorted_comm_percs = sort {$a <=> $b} @all_comm_percs;
+
+($xstart_cluster_cps,$xend_cluster_cps,$max_cluster_cps,$xtics_cluster_cps) =
+ &write_cumulative_data($cumulat_cps_file_name,$clust_cps_file_name,@sorted_comm_percs);
+
+$xend_cum_cps = 100; # pop(@sorted_comm_percs);
+$yend_cum_cps = 100;
+$yend_cum0_cps = $#sorted_comm_percs+1; # unpercentified cum graph
+
+open(CCPS,">$ccps_file_name") || die "$ccps_file_name: $!";
+print CCPS "Sorted list of all communication percentages:\n";
+print CCPS join("\n",@sorted_comm_percs);
+close(CCPS);
+
+($xstart_pe,$xend_pe,$max_pe,$xtics_pe) =
+ &write_array($pe_file_name,$#pe_load,@pe_load);
+
+($xstart_sn,$xend_sn,$max_sn,$xtics_sn) =
+ &write_array($sn_file_name,$#site_size,@site_size);
+
+if ( $opt_D ) {
+ print "After write_array: xstart, xend, max _sn: $xstart_sn,$xend_sn,$max_sn,$xtics_sn\n";
+}
+}
+
+# ----------------------------------------------------------------------------
+# Compute statistical values (like mean, std_dev and especially corr coeff).
+# Write the important info to a file.
+# ----------------------------------------------------------------------------
+
+sub do_statistics {
+ local ($n) = @_;
+
+ if ( $n <= 1 ) {
+ print "Sorry, no statistics for just $n threads\n";
+ return -1;
+ }
+
+# Compute mean values and std deviations
+# ......................................
+
+ ($mean_rt,$std_dev_rt) = &mean_std_dev($sum_rt,@all_rts);
+ ($mean_comm_perc,$std_dev_comm_perc) = &mean_std_dev($sum_comm_perc,@all_comm_percs);
+ ($mean_spark,$std_dev_spark) = &mean_std_dev($sum_sp,@all_sparks);
+ ($mean_local_spark,$std_dev_local_spark) = &mean_std_dev($sum_local_sp,@all_local_sparks);
+ ($mean_global_spark,$std_dev_global_spark) = &mean_std_dev($sum_global_sp,@all_global_sparks);
+ ($mean_ha,$std_dev_ha) = &mean_std_dev($sum_ha,@all_has);
+ ($mean_ft,$std_dev_ft) = &mean_std_dev($sum_ft,@all_fts);
+
+# Compute correlation coefficients
+# ................................
+
+ $c_exec_ha = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_ha,@all_has);
+ $c_exec_sp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_sp,@all_sparks);
+ $c_exec_lsp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_local_sp,@all_local_sparks);
+ $c_exec_gsp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_global_sp,@all_global_sparks);
+ $c_ha_sp = &corr($#all_has+1,$sum_ha,@all_has,$sum_sp,@all_sparks);
+ $c_ha_lsp = &corr($#all_has+1,$sum_ha,@all_has,$sum_local_sp,@all_local_sparks);
+ $c_ha_gsp = &corr($#all_has+1,$sum_ha,@all_has,$sum_global_sp,@all_global_sparks);
+ $c_exec_ft = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_ft,@all_fts);
+ $c_ha_ft = &corr($#all_has+1,$sum_ha,@all_has,$sum_ft,@all_fts);
+ $c_lsp_ft = &corr($#all_local_sparks+1,$sum_local_sp,@all_local_sparks,$sum_ft,@all_fts);
+ $c_gsp_ft = &corr($#all_global_sparks+1,$sum_global_sp,@all_global_sparks,$sum_ft,@all_fts);
+
+# Write corr coeffs into a file
+# .............................
+
+ open(CORR,">$corr_file_name") || die "Couldn't open file $corr_file_name\n";
+ #printf CORR ("%f\n%f\n%f\n%f\n%f",$c_exec_ha,$c_exec_lsp,$c_exec_gsp,$c_ha_lsp,$c_ha_gsp) ;
+ printf CORR ("CORR of runtime and heap alloc: %f\n",$c_exec_ha);
+ printf CORR ("CORR of runtime and no. of sparks: %f\n",$c_exec_sp);
+ printf CORR ("CORR of heap alloc and no. sparks: %f\n",$c_ha_sp);
+ printf CORR ("CORR of runtime and no. of local sparks: %f\n",$c_exec_lsp);
+ printf CORR ("CORR of runtime and no. of global sparks: %f\n",$c_exec_gsp);
+ printf CORR ("CORR of heap alloc and no. local sparks: %f\n",$c_ha_lsp);
+ printf CORR ("CORR of heap alloc and no. global sparks: %f\n",$c_ha_gsp);
+ printf CORR ("CORR of runtime and communication time: %f\n",$c_exec_ft);
+ printf CORR ("CORR of heap alloc and communication time: %f\n",$c_ha_ft);
+ printf CORR ("CORR of no. of local sparks and communication time: %f\n",$c_lsp_ft);
+ printf CORR ("CORR of no. of global sparks and communication time: %f\n",$c_gsp_ft);
+ close(CORR);
+
+# These are needed later in the GNUPLOT files
+# ...........................................
+
+ $max_rt_class = &list_max(@exec_class);
+ $max_rt_global_class = &list_max(@exec_global_class);
+ $max_rt_local_class = &list_max(@exec_local_class);
+ $max_comm_perc_class = &list_max(@comm_class);
+ $max_comm_perc_global_class = &list_max(@comm_global_class);
+ $max_comm_perc_local_class = &list_max(@comm_local_class);
+ $max_spark_class = &list_max(@spark_class);
+ $max_spark_local_class = &list_max(@spark_local_class);
+ $max_spark_global_class = &list_max(@spark_global_class);
+ $max_ha_class = &list_max(@ha_class);
+ $max_ft_class = &list_max(@fetch_class);
+
+}
+
+# ----------------------------------------------------------------------------
+# This is written to STDOUT at the end of the file processing (before
+# gnuplotting and such) if the verbose option is given.
+# ----------------------------------------------------------------------------
+
+sub print_general_info {
+
+ printf("\nTotal number of lines: %d\n", $line_no);
+
+ print "\nDistribution of execution times: \n";
+ print " Intervals: " . join('|',@exec_times) . "\n";
+ print " Total: " . join('|',@exec_class) . "\n";
+ print " Global: " . join('|',@exec_global_class) . "\n";
+ print " Local: " . join('|',@exec_local_class) . "\n";
+
+ $total=0; foreach $i (@exec_class) { $total += $i ; }
+ $global=0; foreach $i (@exec_global_class) { $global += $i ; }
+ $local=0; foreach $i (@exec_local_class) { $local += $i ; }
+
+ print " Sum of classes (should be " . $line_no . "): " . $total .
+ " (global/local)=(" . $global . "/" . $local . ")\n";
+ print " Mean value: $mean_rt Std dev: $std_dev_rt\n";
+
+ print "\nPercentage of communication: \n";
+ print " Intervals: " . join('|',@comm_percs) . "\n";
+ print " Total: " . join('|',@comm_class) . "\n";
+ print " Global: " . join('|',@comm_global_class) . "\n";
+ print " Local: " . join('|',@comm_local_class) . "\n";
+ print " Values outside closed int: Total: " . $outside .
+ " Global: " . $outside_global . " Local: " . $outside_local . "\n";
+
+ $total=0; foreach $i (@comm_class) { $total += $i ; }
+ $global=0; foreach $i (@comm_global_class) { $global += $i ; }
+ $local=0; foreach $i (@comm_local_class) { $local += $i ; }
+
+ print " Sum of classes (should be " . $line_no . "): " . $total .
+ " (global/local)=(" . $global . "/" . $local . ")\n";
+ print " Mean value: $mean_comm_perc Std dev: $std_dev_comm_perc\n";
+
+ print "\nSparked threads: \n";
+ print " Intervals: " . join('|',@sparks) . "\n";
+ print " Total allocs: " . join('|',@spark_class) . "\n";
+
+ $total=0; foreach $i (@spark_class) { $total += $i ; }
+
+ print " Sum of classes (should be " . $line_no . "): " . $total . "\n";
+ print " Mean value: $mean_spark Std dev: $std_dev_spark\n";
+
+ print "\nHeap Allcoations: \n";
+ print " Intervals: " . join('|',@has) . "\n";
+ print " Total allocs: " . join('|',@ha_class) . "\n";
+
+ $total=0; foreach $i (@ha_class) { $total += $i ; }
+
+ print " Sum of classes (should be " . $line_no . "): " . $total . "\n";
+ print " Mean value: $mean_ha Std dev: $std_dev_ha\n";
+ print "\n";
+ print "CORRELATION between runtimes and heap allocations: $c_exec_ha \n";
+ print "CORRELATION between runtime and no. of sparks: $c_exec_sp \n";
+ print "CORRELATION between heap alloc and no. sparks: $c_ha_sp \n";
+ print "CORRELATION between runtimes and locally sparked threads: $c_exec_lsp \n";
+ print "CORRELATION between runtimes and globally sparked threads: $c_exec_gsp \n";
+ print "CORRELATION between heap allocations and locally sparked threads: $c_ha_lsp \n";
+ print "CORRELATION between heap allocations and globally sparked threads: $c_ha_gsp \n";
+ print "CORRELATION between runtime and communication time: $c_exec_ft\n";
+ print "CORRELATION between heap alloc and communication time: $c_ha_ft\n";
+ print "CORRELATION between no. of local sparks and communication time: $c_lsp_ft\n";
+ print "CORRELATION between no. of global sparks and communication time: $c_gsp_ft\n";
+ print "\n";
+
+}
+
+# ----------------------------------------------------------------------------
+# Old (obsolete) stuff
+# ----------------------------------------------------------------------------
+#
+#for ($index=0;
+# $index <= &list_max($#spark_local_class,$#spark_local_class);
+# $index++) {
+# $spark_class[$index] = $spark_local_class[$index] + $spark_global_class[$index];
+#}
+#
+#for ($index=0, $sum_sp=0;
+# $index <= &list_max($#all_local_sparks,$#all_global_sparks);
+# $index++) {
+# $all_sparks[$index] = $all_local_sparks[$index] + $all_global_sparks[$index];
+# $sum_sp += $all_sparks[$index];
+#}
+#
+# ----------------------------------------------------------------------------
+#
+#sub compute_delta {
+# local (@times) = @_;
+#
+# return ($times[$#times] - $times[$#times-1]);
+#}
+#
+# ----------------------------------------------------------------------------
+
+sub insert_elem {
+ local ($elem,$val,$n,*list1,*list2) = @_;
+ local (@small_part, $i, $len);
+
+ if ( $opt_D ) {
+ print "Inserting val $val (with elem $elem) in the following list: \n" .
+ @list . "\n yields the lists: \n ";
+ }
+
+ for ($i=0; $i<=$#list2 && $list2[$i]>$val; $i++) { }
+ $len = $#list2 - $i + 1;
+ if ( $len == 0 ) {
+ push(@list1,$elem);
+ push(@list2,$val);
+ } else {
+ splice(@list1,$i,0,$elem);
+ splice(@list2,$i,0,$val);
+ }
+
+ if ( $opt_D ) {
+ print @list1 . "\n and \n" . @list2;
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub skip_header {
+ local ($in_header);
+
+ $in_header = 9;
+ while (<INPUT>) {
+ if ( $in_header = 9 ) {
+ if (/^=/) {
+ $gum_style_gr = 1;
+ $in_header = 0;
+ $prg = "????"; #
+ $pars = "-b??????"; #
+ $nPEs = 1; #
+ $lat = 1;
+ return ($prg, $pars, $nPEs, $lat);
+ } else {
+ $gum_style_gr = 0;
+ $in_header = 1;
+ }
+
+ }
+ $prg = $1, $pars = $2 if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
+ $nPEs = $1 if /^PEs\s+(\d+)/;
+ $lat = $1, $fetch = $2 if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
+
+ last if /^\+\+\+\+\+/;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub write_pie_chart {
+ local ($rt_perc, $bt_perc, $ft_perc, $it_perc);
+ local ($title, $title_sz, $label_sz, $x_center, $y_center, $radius);
+
+ $PieChart = "/users/fp/hwloidl/grasp/GrAn/bin/PieChart.ps";
+
+ $title = "Original Glaswegian Communication Pie (tm)";
+ $title_sz = 24;
+ $label_sz = 12;
+ $x_center = 300;
+ $y_center = 400;
+ $radius = 100;
+
+ open(PIE,">$pie_file_name") || die "$pie_file_name: $!";
+
+ print PIE "%!PS-Adobe-2.0\n";
+ print PIE "%%Title: Pie Chart\n";
+ print PIE "%%Creator: gran-extr\n";
+ print PIE "%%CreationDate: Ides of March 44 B.C.\n";
+ print PIE "%%EndComments\n";
+ print PIE "\n";
+ print PIE "% Def of PieChart is taken from:\n";
+ print PIE "% ($PieChart) run\n";
+ print PIE "\n";
+
+ open(PIE_CHART,"<$PieChart") || die "$PieChart: $!";
+ while (<PIE_CHART>){
+ print PIE $_;
+ }
+ close (PIE_CHART);
+ print PIE "\n";
+
+ $rt_perc = $tot_rt / $tot_total_rt;
+ $bt_perc = $tot_bt / $tot_total_rt;
+ $ft_perc = $tot_ft / $tot_total_rt;
+ $it_perc = $tot_it / $tot_total_rt;
+
+ print PIE "($title) $title_sz $label_sz % Title, title size and label size\n" .
+ "[ % PS Array of (descrition, percentage [0, .., 1])\n" .
+ "[(Run Time) $rt_perc]\n" .
+ "[(Block Time) $bt_perc]\n" .
+ "[(Fetch Time) $ft_perc]\n" .
+ "[(Ready Time) $it_perc]\n" .
+ "] $x_center $y_center $radius DrawPieChart\n";
+ print PIE "showpage\n";
+
+ close(PIE);
+}
+
+# ----------------------------------------------------------------------------
+
+sub basename {
+ local ($in_str) = @_;
+ local ($str,$i) ;
+
+ $i = rindex($in_str,"/");
+ if ($i == -1) {
+ $str = $in_str;
+ } else {
+ $str = substr($in_str,$i+1) ;
+ }
+
+ return $str;
+}
+
+# ----------------------------------------------------------------------------
+
+sub dirname {
+ local ($in_str) = @_;
+ local ($str,$i) ;
+
+ $i = rindex($in_str,"/");
+ if ($i == -1) {
+ $str = "";
+ } else {
+ $str = substr($in_str,0,$i+1) ;
+ }
+
+ return $str;
+}
+
+# ----------------------------------------------------------------------------
+
diff --git a/ghc/utils/parallel/grs2gr.pl b/ghc/utils/parallel/grs2gr.pl
index d30c7777ce..ab398a53d9 100644
--- a/ghc/utils/parallel/grs2gr.pl
+++ b/ghc/utils/parallel/grs2gr.pl
@@ -1,3 +1,5 @@
+#!/usr/local/bin/perl
+
#
# Convert several .gr files (from the same GUM run) into a single
# .gr file with all times adjusted relative to the earliest start
@@ -9,13 +11,14 @@ $count = 0;
foreach $i (@ARGV) {
open(GR, $i) || die "Can't read $i\n";
$cmd = <GR>;
+ $dateline = <GR>;
$start = <GR>;
($pe, $timestamp) = ($start =~ /PE\s+(\d+) \[(\d+)\]/);
die "PE $pe too high\n" if $pe > $#ARGV;
$proc[$count++] = $pe;
$prog[$pe] = $cmd;
$time[$pe] = $timestamp;
- close(GR) || die "Can't close $i\n";
+ close(GR);
}
$basetime = 0;
@@ -28,16 +31,18 @@ for($i = 0; $i < $count; $i++) {
}
print $cmd;
+print $dateline;
for($i = 0; $i < $count; $i++) {
$pe = $proc[$i];
$delta = $time[$pe] - $basetime;
open(GR, $ARGV[$i]) || die "Can't read $ARGV[i]\n";
$cmd = <GR>;
+ $dateline = <GR>;
$start = <GR>;
while(<GR>) {
/PE\s+(\d+) \[(\d+)\]/;
printf "PE %2u [%lu]%s", $1, $2 + $delta, $';
}
- close(GR) || die "Can't close $ARGV[$i]\n";
+ close(GR);
}
diff --git a/ghc/utils/parallel/ps-scale-y.pl b/ghc/utils/parallel/ps-scale-y.pl
new file mode 100644
index 0000000000..0e1242081c
--- /dev/null
+++ b/ghc/utils/parallel/ps-scale-y.pl
@@ -0,0 +1,188 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 22:19:02 Stardate: [-31]7859.44 hwloidl>
+#
+# Usage: ps-scale-y [options] <file>
+#
+# It is assumed that the last line of <file> is of the format:
+# %% y_scaling: <f> max: <n>
+# where <f> is a floating point number determining the amount of scaling of
+# the y-axis of the graph that is necessary. <n> is the real maximal number
+# of tasks in the program (needed to rebuild y-axis). This script replaces the
+# definitions of the PostScript functions scale-y and unscale-y in <file> by
+# new definitions that do the right amount of scaling.
+# The y-axis is rebuilt (using the above maximal number of tasks and a copy
+# of the print_y_axis routine from qp2ps).
+# If the above line doesn't exist, <file> is unchanged.
+# This script is typically called from gr2ps.
+#
+##############################################################################
+
+require "getopts.pl";
+
+&Getopts('hv');
+
+do process_options();
+
+$tmpfile = ",t";
+$debug = 0;
+
+# NB: This must be the same as in qp2ps!!
+
+$xmin = 100;
+$xmax = 790;
+
+$scalex = $xmin;
+$labelx = $scalex - 45;
+$markx = $scalex - 30;
+$major = $scalex - 5;
+$majorticks = 10;
+
+$mmax = 1;
+
+$amax = 0;
+$ymin = 50;
+$ymax = 500;
+
+# E
+open (GET_SCALING,"cat $file | tail -1 |") || die "Can't open pipe: $file | tail -1 |\n";
+
+$y_scaling = 1.0;
+
+while (<GET_SCALING>){
+ # print STDERR $_;
+ if (/^\%\%\s+y_scaling:\s+([0-9\.]+)\s+max:\s+(\d+)/) {
+ $y_scaling = $1;
+ $pmax = $2;
+ $y_translate = 1.0 - $y_scaling;
+ }
+}
+close (GET_SCALING);
+
+if ( $y_scaling != 1.0 ) {
+ print STDERR "Scaling $file ($y_scaling; $pmax tasks) ...\n" if $opt_v;
+ # print STDERR "SCALING NECESSARY: y_scaling = $y_scaling; y_translate = $y_translate !\n";
+} else {
+ # No scaling necessary!!
+ exit 0;
+}
+
+
+open (IN,"<$file") || die "Can't open file $file\n";
+open (OUT,">$tmpfile") || die "Can't open file $tmpfile\n";
+
+$skip = 0;
+while (<IN>) {
+ $skip = 0 if $skip && /^% End Y-Axis.$/;
+ next if $skip;
+ if (/\/scale\-y/) {
+ print OUT "/scale-y { gsave\n" .
+ " 0 50 $y_translate mul translate\n" .
+ " 1 $y_scaling scale } def\n";
+ }
+ elsif (/\/unscale\-y/) {
+ print OUT "/unscale-y { grestore } def \n";
+ } else {
+ print OUT $_;
+ }
+ if (/^% Y-Axis:$/) {
+ $skip = 1;
+ do print_y_axis();
+ }
+}
+
+close (IN);
+close (OUT);
+
+rename($tmpfile,$file);
+
+exit 0;
+
+# ###########################################################################
+# Same as in qp2ps (but printing to OUT)!
+# ###########################################################################
+
+sub print_y_axis {
+ local ($i);
+ local ($y, $smax,$majormax, $majorint);
+
+# Y-axis label
+
+ print OUT "% " . ("-" x 75) . "\n";
+ print OUT "% Y-Axis (scaled):\n";
+ print OUT "% " . ("-" x 75) . "\n";
+
+ print OUT ("%scale-y % y-axis outside scaled area if ps-scale-y rebuilds it!\n");
+
+ print OUT ("gsave\n");
+ print OUT ("HE12 setfont\n");
+ print OUT ("(tasks)\n");
+ print OUT ("dup stringwidth pop\n");
+ print OUT ("$ymax\n");
+ print OUT ("exch sub\n");
+ print OUT ("$labelx exch\n");
+ print OUT ("translate\n");
+ print OUT ("90 rotate\n");
+ print OUT ("0 0 moveto\n");
+ print OUT ("show\n");
+ print OUT ("grestore\n");
+
+# Scale
+
+ if ($pmax < $majorticks) {
+ $majorticks = $pmax;
+ }
+
+ print OUT ("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
+ print OUT ("% Max number of tasks: $pmax\n");
+ print OUT ("% Number of ticks: $majorticks\n");
+
+ print OUT "0.5 setlinewidth\n";
+
+ $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
+ print OUT ("$scalex $y moveto\n$major $y lineto\n");
+ print OUT ("$markx $y moveto\n($pmax) show\n");
+
+ $majormax = int($pmax/$majorticks)*$majorticks;
+ $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
+ $majorint = $majormax/$majorticks;
+
+ for($i=1; $i <= $majorticks; ++$i) {
+ $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
+ $majorval = int($majorint * ($majormax/$majorint-$i));
+ print OUT ("$scalex $y moveto\n$major $y lineto\n");
+ print OUT ("$markx $y moveto\n($majorval) show\n");
+ }
+
+ # print OUT ("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
+ print OUT " stroke\n";
+ print OUT "1 setlinewidth\n";
+ print OUT ("%unscale-y\n");
+ print OUT ("% End Y-Axis (scaled).\n");
+ print OUT "% " . ("-" x 75) . "\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $#ARGV != 0 ) {
+ print "Usage: $0 [options] <file>\n";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $file = $ARGV[0];
+}
diff --git a/ghc/utils/parallel/qp2ap.pl b/ghc/utils/parallel/qp2ap.pl
new file mode 100644
index 0000000000..b3c3bcf122
--- /dev/null
+++ b/ghc/utils/parallel/qp2ap.pl
@@ -0,0 +1,495 @@
+#! /usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 22:05:31 Stardate: [-31]7859.39 hwloidl>
+#
+# Usage: qp2ap [options] <max-x> <max-y> <prg> <date>
+#
+# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to
+# a PostScript file at stdout, showing an activity profile with one horizontal
+# line for each task (thickness of the line shows if it's active or suspended).
+#
+# Options:
+# -o <file> ... write .ps file to <file>
+# -m ... create mono PostScript file instead a color one.
+# -O ... optimise i.e. try to minimise the size of the .ps file.
+# -s <n> ... scaling factor of y axis (default: 1)
+# -w <n> ... width of lines denoting running threads (default: 2)
+# -v ... be talkative.
+# -h ... print help message (this header).
+#
+##############################################################################
+
+
+require "getopts.pl";
+
+&Getopts('hvms:w:OlD');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+$y_scaling = 0;
+$gtid = 1; # number of process so far = $gtid-1
+
+$xmin = 100;
+$xmax = 790;
+
+$scalex = $xmin;
+$labelx = $scalex - 45;
+$markx = $scalex - 30;
+$major = $scalex - 5;
+$majorticks = 10;
+
+# $pmax = 40;
+$ymin = 50;
+$ymax = 500;
+
+if ( ($ymax - $ymin)/$pmax < 3 ) {
+ print STDERR "Warning: Too many tasks! Distance will be smaller than 3 pixels.\n";
+}
+
+if ( !$width ) {
+ $width = 2/3 * ($ymax - $ymin)/$pmax;
+}
+
+do write_prolog();
+do print_y_axis();
+
+# ---------------------------------------------------------------------------
+# Main Part
+# ---------------------------------------------------------------------------
+
+while(<STDIN>) {
+ next if /^[^0-9]/; # ignore lines not beginning with a digit (esp. last)
+ chop;
+ ($time, $event, $tid, $addr, $tid2, $addr2) = split;
+
+ if ( $event eq "*G") {
+ $TID{$addr} = $gtid++;
+ $START{$addr} = $time;
+ }
+
+ elsif ($event eq "*A") {
+ $TID{$addr} = $gtid++;
+ $SUSPEND{$addr} = $time;
+ }
+
+ elsif ($event eq "G*" || $event eq "GR" ) {
+ do psout($START{$addr},$time,$TID{$addr},"runlineto");
+# $STOP{$addr} = $time;
+ }
+
+ elsif ($event eq "GA" || $event eq "GC" || $event eq "GY") {
+ do psout($START{$addr},$time,$TID{$addr},"runlineto");
+ $SUSPEND{$addr} = $time;
+ }
+
+ elsif ($event eq "RA") {
+ $SUSPEND{$addr} = $time;
+ }
+
+ elsif ($event eq "YR") {
+ do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
+ }
+
+ elsif ($event eq "CA" || $event eq "YA" ) {
+ do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
+ $SUSPEND{$addr} = $time;
+ }
+
+ elsif ($event eq "AC" || $event eq "AY" ) {
+ do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
+ $SUSPEND{$addr} = $time;
+ }
+
+ elsif ($event eq "RG") {
+ $START{$addr} = $time;
+ }
+
+ elsif ($event eq "AG") {
+ do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
+ $START{$addr} = $time;
+ }
+
+ elsif ($event eq "CG" || $event eq "YG" ) {
+ do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
+ $START{$addr} = $time;
+ } elsif ( $event eq "B*" || $event eq "*B" || $event eq "BB" ) {
+ print STDERR "Ignoring spark event $event at $time\n" if $opt_v;
+ } else {
+ print STDERR "Unexpected event $event at $time\n";
+ }
+
+ print("%% $time: $event $addr $TID{$addr}\n\n") if $opt_D;
+}
+
+# ---------------------------------------------------------------------------
+
+# Logo
+print("HE14 setfont\n");
+if ( $opt_m ) {
+ print("50 550 asciilogo\n");
+} else {
+ print("50 550 logo\n"); #
+}
+
+# Epilogue
+print("showpage\n");
+
+if ( $gtid-1 != $pmax ) {
+ if ( $pedantic ) {
+ die "Error: Calculated max no. of tasks ($gtid-1) does not agree with stated max. no. of tasks ($pmax)\n";
+ } else {
+ print STDERR "Warning: Calculated total no. of tasks ($gtid-1) does not agree with stated total no. of tasks ($pmax)\n" if $opt_v;
+ $y_scaling = $pmax/($gtid-1);
+ }
+}
+
+
+exit 0;
+
+# ---------------------------------------------------------------------------
+
+sub psout {
+ local($x1, $x2, $y, $cmd) = @_;
+ print("% ($x1,$y) -- ($x2,$y) $cmd\n") if $opt_D;
+ $x1 = int(($x1/$tmax) * ($xmax-$xmin) + $xmin);
+ $x2 = int(($x2/$tmax) * ($xmax-$xmin) + $xmin);
+ $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
+ if ( $x1 == $x2 ) {
+ $x2 = $x1 + 1;
+ }
+
+ if ( $opt_l ) {
+ print("newpath\n");
+ print("$x1 $y moveto\n");
+ print("$x2 $y $cmd\n");
+ print("stroke\n");
+ } elsif ( $opt_O ) {
+ print "$x1 $x2 $y " .
+ ( $cmd eq "runlineto" ? "G RL\n" :
+ $cmd eq "suspendlineto" ? "R SL\n" :
+ $cmd eq "fetchlineto" ? "B FL\n" :
+ "\n% ERROR: Unknown command $cmd\n");
+
+ } else {
+ print "$x2 $y $x1 $y " .
+ ( $cmd eq "runlineto" ? "green run\n" :
+ $cmd eq "suspendlineto" ? "red suspend\n" :
+ $cmd eq "fetchlineto" ? "blue fetch\n" :
+ "\n% ERROR: Unknown command $cmd\n");
+ }
+}
+
+# -----------------------------------------------------------------------------
+
+sub get_date {
+ local ($date);
+
+ chop($date = `date`);
+ return ($date);
+}
+
+# -----------------------------------------------------------------------------
+
+sub write_prolog {
+ local ($now);
+
+ $now = do get_date();
+
+ print("%!PS-Adobe-2.0\n");
+ print("%%BoundingBox: 0 0 560 800\n");
+ print("%%Title: Per-thread Activity Profile\n");
+ print("%%Creator: qp2ap\n");
+ print("%%StartTime: $date\n");
+ print("%%CreationDate: $now\n");
+ print("%%Copyright: 1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
+ print("%%EndComments\n");
+
+ print "% " . "-" x 77 . "\n";
+ print "% Tunable Parameters:\n";
+ print "% The width of a line representing a task\n";
+ print "/width $width def\n";
+ print "% Scaling factor for the y-axis (usful to enlarge)\n";
+ print "/y-scale $y_scale def\n";
+ print "% " . "-" x 77 . "\n";
+
+ print "/total-len $tmax def\n";
+ print "/show-len $xmax def\n";
+ print "/x-offset $xmin def\n";
+ print "/y-offset $ymin def\n";
+ print "% normalize is the PS version of the formula: \n" .
+ "% int(($x1/$tmax) * ($xmax-$xmin) + $xmin) \n" .
+ "% in psout.\n";
+ print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
+ print "/x-normalize { exch show-len mul total-len div exch } def\n";
+ print "/y-normalize { y-offset sub y-scale mul y-offset add } def\n";
+ print "/str-len 12 def\n";
+ print "/prt-n { cvi str-len string cvs \n" .
+ " dup stringwidth pop \n" .
+ " currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
+ " neg 0 rmoveto \n" .
+ " show } def \n" .
+ " % print top-of-stack integer centered at the current point\n";
+ # print "/prt-n { cvi str-len string cvs \n" .
+ # " dup stringwidth pop 2 div neg 0 rmoveto \n" .
+ # " show } def \n" .
+ # " % print top-of-stack integer centered at the current point\n";
+
+ if ( $opt_l ) {
+ print ("/runlineto {1.5 setlinewidth lineto} def\n");
+ print ("/suspendlineto {0.5 setlinewidth lineto} def\n");
+ print ("/fetchlineto {0.2 setlinewidth lineto} def\n");
+ } else {
+ if ( $opt_m ) {
+ if ( $opt_O ) {
+ print "/R { 0 } def\n";
+ print "/G { 0.5 } def\n";
+ print "/B { 0.2 } def\n";
+ } else {
+ print "/red { 0 } def\n";
+ print "/green { 0.5 } def\n";
+ print "/blue { 0.2 } def\n";
+ }
+ print "/set-bg { setgray } def\n";
+ } else {
+ if ( $opt_O ) {
+ print "/R { 0.8 0 0 } def\n";
+ print "/G { 0 0.9 0.1 } def\n";
+ print "/B { 0 0.1 0.9 } def\n";
+ print "/set-bg { setrgbcolor } def\n";
+ } else {
+ print "/red { 0.8 0 0 } def\n";
+ print "/green { 0 0.9 0.1 } def\n";
+ print "/blue { 0 0.1 0.9 } def\n";
+ print "/set-bg { setrgbcolor } def\n";
+ }
+ }
+
+ if ( $opt_O ) {
+ print "% RL: runlineto; draws a horizontal line in given color\n";
+ print "% Operands: x-from x-to y color\n";
+ print "/RL { set-bg % set color \n" .
+ " newpath y-normalize % mangle y val\n" .
+ " 2 index 1 index moveto width setlinewidth \n" .
+ " lineto pop stroke} def\n";
+ print "% SL: suspendlineto; draws a horizontal line in given color (thinner)\n";
+ print "% Operands: x-from x-to y color\n";
+ print "/SL { set-bg % set color \n" .
+ " newpath y-normalize % mangle y val\n" .
+ " 2 index 1 index moveto width 2 div setlinewidth \n" .
+ " lineto pop stroke} def\n";
+ print "% FL: fetchlineto; draws a horizontal line in given color (thinner)\n";
+ print "% Operands: x-from x-to y color\n";
+ print "/FL { set-bg % set color \n" .
+ " newpath y-normalize % mangle y val\n" .
+ " 2 index 1 index moveto width " .
+ ( $opt_m ? " 4 " : " 2 ") .
+ " div setlinewidth \n" .
+ " lineto pop stroke} def\n";
+ } else {
+ print "/run { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
+ "setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
+ print "/suspend { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
+ "2 div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
+ print "/fetch { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
+ ( $opt_m ? " 4 " : " 2 ") .
+ "div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
+ #print ("/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n");
+ #print ("/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n");
+ }
+ }
+
+ print "/printText { 0 0 moveto (GrAnSim) show } def\n";
+ print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
+ if ( $opt_m ) {
+ print "/logo { asciilogo } def\n";
+ } else {
+ print "/logo { gsave \n" .
+ " translate \n" .
+ " .95 -.05 0\n" .
+ " { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" .
+ " 1 0 0 setrgbcolor printText\n" .
+ " grestore} def\n";
+ }
+ print "% For debugging PS uncomment this line and add the file behandler.ps\n";
+ print "% $brkpage begin printonly endprint \n";
+
+ print("/HE10 /Helvetica findfont 10 scalefont def\n");
+ print("/HE12 /Helvetica findfont 12 scalefont def\n");
+ print("/HE14 /Helvetica findfont 14 scalefont def\n");
+ print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
+ print "% " . "-" x 77 . "\n";
+ print("newpath\n");
+
+ print("-90 rotate\n");
+ print("-785 30 translate\n");
+ print("0 8.000000 moveto\n");
+ print("0 525.000000 760.000000 525.000000 8.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("760.000000 525.000000 760.000000 0 8.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("760.000000 0 0 0 8.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0 0 0 525.000000 8.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0.500000 setlinewidth\n");
+ print("stroke\n");
+ print("newpath\n");
+ print("4.000000 505.000000 moveto\n");
+ print("4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0.500000 setlinewidth\n");
+ print("stroke\n");
+
+ print("HE14 setfont\n");
+ print("100 505 moveto\n");
+ print("($pname ) show\n");
+
+ print("($date) dup stringwidth pop 750 exch sub 505.000000 moveto show\n");
+
+ # print "/total-len $tmax def\n";
+ print("-40 -40 translate\n");
+
+ print "% " . "-" x 77 . "\n";
+ print "% Print x-axis:\n";
+ print "/y-val $ymin def % { y-offset 40 sub 2 div y-offset add } def\n";
+ print "0.5 setlinewidth\n";
+ print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
+ print "0 total-len 10 div total-len\n" .
+ " { dup normalize dup y-val moveto 0 -2 rlineto stroke % tic\n" .
+ " y-val 10 sub moveto HE10 setfont round prt-n % print label \n" .
+ " } for \n";
+ print "1 setlinewidth\n";
+ print "% " . "-" x 77 . "\n";
+
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_y_axis {
+ local ($i);
+ local ($y, $smax,$majormax, $majorint);
+
+# Y-axis label
+
+ print "% " . ("-" x 75) . "\n";
+ print "% Y-Axis:\n";
+ print "% " . ("-" x 75) . "\n";
+
+ if ( $opt_m ) {
+ print "0 setgray\n";
+ } else {
+ print "0 0 0 setrgbcolor\n";
+ }
+
+ print("gsave\n");
+ print("HE12 setfont\n");
+ print("(tasks)\n");
+ print("dup stringwidth pop\n");
+ print("$ymax\n");
+ print("exch sub\n");
+ print("$labelx exch\n");
+ print("translate\n");
+ print("90 rotate\n");
+ print("0 0 moveto\n");
+ print("show\n");
+ print("grestore\n");
+
+# Scale
+
+ if ($pmax < $majorticks) {
+ $majorticks = $pmax;
+ }
+
+ print "0.5 setlinewidth\n";
+
+ print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
+ print("% Total number of tasks: $pmax\n");
+ print("% Number of ticks: $majorticks\n");
+
+ $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
+ print("$scalex $y moveto\n$major $y lineto\n");
+ print("$markx $y moveto\n($pmax) show\n");
+
+ $majormax = int($pmax/$majorticks)*$majorticks;
+ $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
+ $majorint = $majormax/$majorticks;
+
+ for($i=0; $i <= $majorticks; ++$i) {
+ $y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
+ $majorval = int($majorint * ($majormax/$majorint-$i));
+ print("$scalex $y moveto\n$major $y lineto\n");
+ print("$markx $y moveto\n($majorval) show\n");
+ }
+
+ # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
+ print " stroke\n";
+ print "1 setlinewidth\n";
+ print "% " . ("-" x 75) . "\n";
+}
+
+# ---------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ print "Prg Name: $pname Date: $date\n";
+ print "Input: stdin Output: stdout\n";
+}
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_h ) {
+ open(ME,$0) || die "Can't open myself ($0): $!\n";
+ $n = 0;
+ while (<ME>) {
+ last if $_ =~ /^$/;
+ print $_;
+ $n++;
+ }
+ close(ME);
+ exit ;
+ }
+
+ if ( $opt_s ) {
+ $y_scale = $opt_s;
+ } else {
+ $y_scale = 1;
+ }
+
+ if ( $#ARGV != 3 ) {
+ print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
+ print "Use -h option to get details\n";
+ exit 1;
+ }
+
+ $tmax = $ARGV[0];
+ $pmax = $ARGV[1];
+ # GUM uses the absolute path (with '=' instead of '/') of the executed file
+ # (for PVM reasons); if you want to have the full path in the generated
+ # graph, too, eliminate the substitution below
+ ($pname = $ARGV[2]) =~ s/.*=//;
+ $date = $ARGV[3];
+
+ if ( $opt_w ) {
+ $width = $opt_w;
+ } else {
+ $width = 0;
+ }
+
+}
+# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/qp2ps.pl b/ghc/utils/parallel/qp2ps.pl
index d671cb8937..2fb090346a 100644
--- a/ghc/utils/parallel/qp2ps.pl
+++ b/ghc/utils/parallel/qp2ps.pl
@@ -1,18 +1,31 @@
#! /usr/local/bin/perl
##############################################################################
+# Time-stamp: <Wed Jul 24 1996 22:04:50 Stardate: [-31]7859.39 hwloidl>
#
-# Usage: qp2ps.pl [options] <max-x> <prg> <date>
+# Usage: qp2ps [options] <max-x> <max-y> <prg> <date>
#
# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to
# a PostScript file at stdout, showing essentially the total number of running,
# runnable and blocked tasks.
#
# Options:
-# -o <file> ... write PS file to <file>
+# -o <file> ... write .ps file to <file>
# -m ... create mono PostScript file instead a color one.
# -O ... compress i.e. try to minimize the size of the .ps file
# -s <str> ... print <str> in the top right corner of the generated graph
# -i <int> ... info level from 1 to 7; number of queues to display
+# -I <str> ... queues to be displayed (in the given order) with the encoding
+# 'a' ... active (running)
+# 'r' ... runnable
+# 'b' ... blocked
+# 'f' ... fetching
+# 'm' ... migrating
+# 's' ... sparks
+# (e.g. -I "arb" shows active, runnable, blocked tasks)
+# -l <int> ... length of a slice in the .ps file; (default: 100)
+# small value => less memory consumption of .ps file & script
+# but slower in generating the .ps file
+# -d ... Print date instead of average parallelism
# -v ... be talkative.
# -h ... print help message (this header).
#
@@ -20,7 +33,7 @@
require "getopts.pl";
-&Getopts('hvDOmSs:i:I:');
+&Getopts('hvDCOmdl:s:i:I:H');
do process_options();
@@ -32,6 +45,8 @@ if ( $opt_v ) {
# Init
# ---------------------------------------------------------------------------
+$y_scaling = 1.0;
+
$xmin = 100;
$xmax = 790;
@@ -41,7 +56,8 @@ $markx = $scalex - 30;
$major = $scalex - 5;
$majorticks = 10;
-$pmax = 1;
+$mmax = 1;
+
$amax = 0;
$ymin = 50;
$ymax = 500;
@@ -49,64 +65,78 @@ $ymax = 500;
$active = 0;
$runnable = 0;
$blocked = 0;
-$sparks = 0;
$fetching = 0;
+$migrating = 0;
+$sparks = 0;
-$lines_per_flush = 100; # depends on the PS implementation you use
+#$lines_per_flush = 100; # depends on the PS implementation you use
-%color = ( "a", "green",
- "r", "amber",
- "b", "red",
- "f", "cyan",
- "m", "blue",
- "s", "crimson" );
+%color = ( "a", "green", # active
+ "r", "amber", # runnable
+ "b", "red", # blocked
+ "f", "cyan", # fetching
+ "m", "blue", # migrating
+ "s", "crimson" ); # sparks
# ---------------------------------------------------------------------------
do print_prolog();
$otime = -1;
-$last_x = -1;
-$last_y = -1;
-$in_seq = 0;
$time_of_second_event = 0;
+$samples = 0;
+
+$T[0] = 0;
+$G[0] = 0;
+$A[0] = 0;
+$R[0] = 0;
+$B[0] = 0;
+$Y[0] = 0;
while(<STDIN>) {
+ next if /^[^0-9]/; # ignore lines not beginning with a digit (esp. last)
chop;
($time, $event, $tid, $addr, $tid2, $addr2) = split;
$time_of_second_event = $time if $time_of_second_event == 0;
if($time != $otime) {
$tottime += $G[$samples] * ($time-$T[$samples]);
+ $otime = $time;
+ }
- if($active > $amax) {
- $amax = $active;
- }
+ if($active > $amax) {
+ $amax = $active;
+ }
- if ( $opt_D ) {
- if($G[$samples] < $amax && $A[$samples] > 0) {
- printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " .
- "R $R[$samples], B $B[$samples], " .
- "Y $Y[$samples]\n");
- }
+ if ( $opt_D ) {
+ if($G[$samples] < $amax && $A[$samples] > 0) {
+ printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " .
+ "R $R[$samples], B $B[$samples], " .
+ "Y $Y[$samples]\n");
}
+ }
- # Reality Check
- if($G[$samples] < 0 || $A[$samples] < 0 ||
- $R[$samples] < 0 || $B[$samples] < 0 ||
- $Y[$samples] < 0) {
- printf(stderr "Error: Impossible number of tasks at time " .
- "$T[$samples] (G $G[$samples], A $A[$samples], ".
- "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
- }
- $samples++;
- $otime = $time;
+ # Reality Check
+ if($G[$samples] < 0 || $A[$samples] < 0 ||
+ $R[$samples] < 0 || $B[$samples] < 0 ||
+ $Y[$samples] < 0) {
+ printf(stderr "Error: Impossible number of tasks at time " .
+ "$T[$samples] (G $G[$samples], A $A[$samples], ".
+ "R $R[$samples], B $B[$samples], Y $Y[$samples])\n") if $opt_v || $opt_D;
+ if ( $opt_H ) { # HACK
+ $G[$samples] = 0 if $G[$samples] < 0;
+ $A[$samples] = 0 if $A[$samples] < 0;
+ $R[$samples] = 0 if $R[$samples] < 0;
+ $B[$samples] = 0 if $B[$samples] < 0;
+ $Y[$samples] = 0 if $Y[$samples] < 0;
+ }
}
+ $samples++;
$eventfrom = substr($event,0,1);
$eventto = substr($event,1,1);
- printf(stderr "$time $event $eventfrom $eventto\n") if $opt_D;
+ printf(stderr "$time $event $eventfrom $eventto\n") if 0 && $opt_D;
if ($eventfrom eq '*') {
}
@@ -167,27 +197,84 @@ while(<STDIN>) {
$somefetching = 1;
}
- printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
- "B $sparks, C $migrating\n") if 0;
- $T[$samples] = $time;
- $G[$samples] = &queue_on("a") ? $active : 0;
- $A[$samples] = &queue_on("r") ? $runnable : 0;
- $R[$samples] = &queue_on("b") ? $blocked : 0;
- $Y[$samples] = &queue_on("f") ? $fetching : 0;
- $B[$samples] = &queue_on("s") ? $sparks : 0;
- $C[$samples] = &queue_on("m") ? $migrating : 0;
+ #printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
+ # "B $sparks, C $migrating\n") if 1;
+
+ printf(stderr "Error: Trying to write at index 0!\n") if $samples == 0;
+ $T[$samples] = $time;
+ do set_values($samples,
+ $active,$runnable,$blocked,$fetching,$sparks,$migrating);
+
+ #$G[$samples] = queue_on_a ? $active : 0;
+ #$A[$samples] = queue_on_r ? $runnable : 0;
+ #$R[$samples] = queue_on_b ? $blocked : 0;
+ #$Y[$samples] = queue_on_f ? $fetching : 0;
+ #$B[$samples] = queue_on_s ? $sparks : 0;
+ #$C[$samples] = queue_on_m ? $migrating : 0;
$all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
$B[$samples] + $C[$samples] ;
- if($all > $pmax) {
- $pmax = $all;
+ if($all > $mmax) {
+ $mmax = $all;
+ }
+
+ if ( 0 ) {
+ print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
+ "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
+ " max = $all\n" ;
+ }
+
+ #print STDERR "Sparks @ $time: $sparks \tAll: $all \tMMax: $mmax\n" if $opt_D;
+
+ if ( $samples >= $slice_width ) {
+ do flush_queues();
+ $samples = 0;
}
+
+} # <STDIN>
+
+do flush_queues();
+print "%% End\n" if $opt_C;
+
+# For debugging only
+if ($opt_D) {
+ printf(stderr "Queue values after last event: " .
+ "$T[$samples] (G $G[$samples], A $A[$samples], ".
+ "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
}
if($time != $tmax) {
- die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
+ if ( $pedantic ) {
+ die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
+ } else { #
+ print STDERR "Warning: Calculated time ($time) does not agree with stated max. time ($tmax)\n" if $opt_v;
+ }
+}
+
+# HACK warning:
+# The real max-y value ($mmax) might differ from the one that is the input
+# to this script ($pmax). If so, we post-process the generated ps-file
+# and place an appropriate scaling fct into the header of the ps-file.
+# This is done by yet another perl-script:
+# ps-scale-y <y-scaling-factor> <ps-file>
+
+if($pmax != $mmax) {
+ if ( $pedantic ) {
+ die "Error: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n";
+ } else {
+ print STDERR "Warning: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n" if $opt_v;
+ $y_scaling = $pmax/$mmax; #((float) $pmax)/((float) $mmax);
+ }
+}
+
+print "% " . ("-" x 75) . "\n";
+
+if ( $opt_m ) {
+ print "0 setgray\n";
+} else {
+ print "0 0 0 setrgbcolor\n";
}
# Print optional str
@@ -195,26 +282,32 @@ if($time != $tmax) {
print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
}
+ print("unscale-y\n");
+
# Average Parallelism
if($time > 0) {
- if ( 0 ) { # HACK warning; is this *always* correct -- HWL
+ if ( $opt_S ) { # HACK warning; is this *always* correct -- HWL
$avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
} else {
$avg = $tottime/$time;
}
- $avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
- print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 525 moveto show\n");
+ if ( $opt_d ) { # Print date instead of average parallelism
+ print("HE14 setfont ($date) dup stringwidth pop 790 exch sub 515 moveto show\n");
+ } else {
+ $avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
+ print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 515 moveto show\n");
+ }
$rt_str=sprintf("Runtime = %0.0f\n",$tmax);
- print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 30 moveto show\n");
+ print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 20 moveto show\n");
}
+# do print_y_axis();
+
# -----------------------------------------------------------------------------
# Draw axes lines etc
# -----------------------------------------------------------------------------
-do print_y_axis();
-
-# if ( ! $opt_S ) {
+if ( ! $opt_S ) {
# Draw dashed line for orientation (startup time) -- HWL
@@ -232,7 +325,7 @@ if ( $draw_lines ) {
# and another one at the second event -- HWL
-print STDERR "Time of second event is: $time_of_second_event" if $opt_D;
+print STDERR "Time of second event is: $time_of_second_event" if 0 && $opt_D;
if ( $draw_lines ) {
local($x, $y);
@@ -249,52 +342,71 @@ if ( $draw_lines ) {
"grestore\n";
}
-# }
-
-# -----------------------------------------------------------------------------
-# Draw the different kinds of tasks
-# -----------------------------------------------------------------------------
-
-$rshow = reverse($show);
-print STDERR "\nReversed info-mask is : $rshow" if $opt_D;
-print STDERR "\nMaximal y value is $pmax" if $opt_D;
-for ($j=0; $j<length($rshow); $j++) {
- $x = substr($rshow,$j,1);
- print STDERR "Queue = $x i.e. " . ($color{$x}) . "\n" if $opt_D;
- print("$xmin $ymin moveto\n");
- for($i=1; $i <= $samples; $i++) {
- do psout($T[$i],&count($x,$i));
- if ($i % $lines_per_flush == 0) {
- print($color{$x} . " flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
-
- if ( $opt_m ) {
- print "closepath " . ($color{$x}) . " setgray fill\n";
- } else {
- print "closepath " . ($color{$x}) . " setrgbcolor fill\n";
- }
}
# -----------------------------------------------------------------------------
-
# Logo
print("HE14 setfont\n");
-if ( $opt_m ) {
- print("50 530 asciilogo\n");
+if ($opt_m) {
+ print("50 520 asciilogo\n");
} else {
- print("50 530 logo\n");
+ print("50 520 logo\n");
}
# Epilogue
print("showpage\n");
-exit 0;
+if ( $y_scaling != 1.0 ) {
+ print "%% y_scaling: $y_scaling\t max: $mmax\n";
+}
+
+exit 0 ;
# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# -----------------------------------------------------------------------------
+# Draw the current slice of the overall graph.
+# This routine is called if a slice of data is full (i.e. $T[0..$samples],
+# $G[0..$slice_width] etc with $samples==$slice_width contain data from the
+# input file) or if the end of the input has been reached (i.e. $samples<=
+# $slice_width). Note that the last value of the current slice is stored as
+# the first value for the next slice.
+# -----------------------------------------------------------------------------
+
+sub flush_queues {
+ local ($x_norm, $y_norm);
+ local ($index);
+ local ($last_x, $last_y, $in_seq) = (-1, -1, 0);
+ local ($foo_x, $foo_y);
+
+ if ( $samples == 0 ) { return ; }
+
+ # print "% First sample: T $T[0] (G $G[0], A $A[0], ".
+ # " R $R[0], B $B[0], Y $Y[0])\n" if $opt_C;
+
+ $rshow = reverse($show);
+ print STDERR "\nReversed info-mask is : $rshow" if 0 && $opt_D;
+ print STDERR "\nMaximal y value is $pmax" if 0 && $opt_D;
+ for ($j=0; $j<length($rshow); $j++) {
+ $q = substr($rshow,$j,1);
+ # print "% Queue = $q i.e. " . ($color{$q}) . " counts at first sample: " . &count($q,0) ."\n" if $opt_C;
+ do init_psout($q, $T[0], &count($q,0));
+ for($i=1; $i <= $samples; $i++) {
+ do psout($T[$i],&count($q,$i));
+ }
+ print $color{$q} . " F\n";
+ ($foo_x, $foo_y) = &normalize($T[$samples],&count($q,$samples));
+ print "%% Last " . ($color{$q}) . " is " . &get_queue_val($q,$samples) ." (" . $T[$samples] . ", " . &count($q,$samples) . ") -> ($foo_x,$foo_y)\n" if $opt_C;
+ # print($color{$q} . " flush-it\n");
+ # print("$xmax $ymin L\n");
+ }
+ do wrap($samples);
+
+ #print "% Last sample T $T[$samples] (G $G[$samples], A $A[$samples], ".
+ # " R $R[$samples], B $B[$samples], Y $Y[$samples])\n" if $opt_C;
+}
+
+# -----------------------------------------------------------------------------
# Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the
# x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
# In case of optimization ($opt_O):
@@ -305,15 +417,42 @@ exit 0;
# sequence!).
# -----------------------------------------------------------------------------
-sub psout {
+sub normalize {
local($x, $y ) = @_;
+ local($x_norm, $y_norm );
+
if ( $opt_S ) {
- $x = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
+ $x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
} else {
- $x = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
+ $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
}
- $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
+ $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
+
+ return (($x_norm, $y_norm));
+}
+
+# -----------------------------------------------------------------------------
+
+sub init_psout {
+ local ($q, $x, $y) = @_;
+ local ($x_norm, $y_norm);
+ ($last_x, $last_y, $in_seq) = (-1, -1, 0);
+ ($x_norm, $y_norm) = &normalize($T[0],&count($q,0));
+ $last_x = $x_norm;
+ $last_y = $y_norm;
+ print "%% Begin " . ($color{$q}) . " (" . $T[0] . ", " . &count($q,0) . ") -> ($x_norm,$y_norm)\n" if $opt_C;
+ print $x_norm, " ", $y_norm, " M\n";
+
+}
+
+# ----------------------------------------------------------------------------
+
+sub psout {
+ local($x_in, $y_in ) = @_;
+ local($x, $y );
+
+ ($x, $y) = &normalize($x_in, $y_in);
die "Error in psout: Neg x coordinate\n" if ($x < 0) ;
if ( $opt_O ) {
@@ -346,47 +485,99 @@ sub queue_on {
# -----------------------------------------------------------------------------
-sub count{
+sub count {
local ($queue,$index) = @_;
local ($res);
$where = &queue_on($queue);
- $res = ((&queue_on("a") && (&queue_on("a")<=$where)) ? $G[$index] : 0) +
- ((&queue_on("r") && (&queue_on("r")<=$where)) ? $A[$index] : 0) +
- ((&queue_on("b") && (&queue_on("b")<=$where)) ? $R[$index] : 0) +
- ((&queue_on("f") && (&queue_on("f")<=$where)) ? $Y[$index] : 0) +
- ((&queue_on("m") && (&queue_on("m")<=$where)) ? $B[$index] : 0) +
- ((&queue_on("s") && (&queue_on("s")<=$where)) ? $C[$index] : 0);
+ $res = (($queue_on_a && ($queue_on_a<=$where)) ? $G[$index] : 0) +
+ (($queue_on_r && ($queue_on_r<=$where)) ? $A[$index] : 0) +
+ (($queue_on_b && ($queue_on_b<=$where)) ? $R[$index] : 0) +
+ (($queue_on_f && ($queue_on_f<=$where)) ? $Y[$index] : 0) +
+ (($queue_on_m && ($queue_on_m<=$where)) ? $C[$index] : 0) +
+ (($queue_on_s && ($queue_on_s<=$where)) ? $B[$index] : 0);
return $res;
}
# -----------------------------------------------------------------------------
+sub set_values {
+ local ($samples,
+ $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
+
+ $G[$samples] = $queue_on_a ? $active : 0;
+ $A[$samples] = $queue_on_r ? $runnable : 0;
+ $R[$samples] = $queue_on_b ? $blocked : 0;
+ $Y[$samples] = $queue_on_f ? $fetching : 0;
+ $B[$samples] = $queue_on_s ? $sparks : 0;
+ $C[$samples] = $queue_on_m ? $migrating : 0;
+}
+
+# -----------------------------------------------------------------------------
+
+sub set_queue_val {
+ local ($queue,$index,$val) = @_;
+
+ if ( $queue == "a" ) { $G[$index] = $val; }
+ elsif ( $queue == "r" ) { $A[$index] = $val; }
+ elsif ( $queue == "b" ) { $R[$index] = $val; }
+ elsif ( $queue == "f" ) { $Y[$index] = $val; }
+ elsif ( $queue == "m" ) { $C[$index] = $val; }
+ elsif ( $queue == "s" ) { $B[$index] = $val; }
+}
+
+# -----------------------------------------------------------------------------
+
+sub wrap { # used in flush_queues at the end of a slice
+ local ($index) = @_;
+
+ $T[0] = $T[$index];
+
+ $G[0] = $G[$index];
+ $A[0] = $A[$index];
+ $R[0] = $R[$index];
+ $Y[0] = $Y[$index];
+ $B[0] = $B[$index];
+ $C[0] = $C[$index];
+}
+
+# -----------------------------------------------------------------------------
+
+sub get_queue_val {
+ local ($queue,$index) = @_;
+
+ if ( $queue == "a" ) { return $G[$index]; }
+ elsif ( $queue == "r" ) { return $A[$index]; }
+ elsif ( $queue == "b" ) { return $R[$index]; }
+ elsif ( $queue == "f" ) { return $Y[$index]; }
+ elsif ( $queue == "m" ) { return $C[$index]; }
+ elsif ( $queue == "s" ) { return $B[$index]; }
+}
+
+# -----------------------------------------------------------------------------
+
sub get_date {
local ($date);
- open (DATE,"date |") || die ("$!");
- while (<DATE>) {
- $date = $_;
- }
- close (DATE);
-
+ chop($date = `date`);
return ($date);
}
# -----------------------------------------------------------------------------
sub print_prolog {
- local ($date);
+ local ($now);
- $date = do get_date();
+ $now = do get_date();
print("%!PS-Adobe-2.0\n");
print("%%BoundingBox: 0 0 560 800\n");
print("%%Title: Activity Profile\n");
- print("%%Creator: qp2ps.pl\n");
- print("%%CreationDate: $date\n");
+ print("%%Creator: qp2ps\n");
+ print("%%StartTime: $date\n");
+ print("%%CreationDate: $now\n");
+ print("%%Copyright: 1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
print("%%EndComments\n");
#print ("/greenlineto {1.0 setlinewidth lineto} def\n");
#print ("/amberlineto {0.5 setlinewidth lineto} def\n");
@@ -396,8 +587,8 @@ sub print_prolog {
#print ("/R {newpath moveto redlineto stroke} def\n");
if ( $opt_m ) {
- print "/red { 0.5 } def\n";
- print "/green { 0 } def\n";
+ print "/red { 0 } def\n";
+ print "/green { 0.5 } def\n";
print "/blue { 0.7 } def\n";
print "/crimson { 0.8 } def\n";
print "/amber { 0.9 } def\n";
@@ -434,6 +625,31 @@ sub print_prolog {
print "/cmpy {exch pop 3 2 roll pop eq} def % compare y-coors of 2 points\n";
print "/cmp {2 index eq {exch pop eq} % compare 2 points\n";
print " {pop pop pop false} ifelse } def\n";
+
+ # Hook for scaling just the graph and y-axis
+ print "% " . "-" x 77 . "\n";
+ print "/scale-y { } def\n";
+ print "/unscale-y { } def\n";
+
+ print "% " . "-" x 77 . "\n";
+ print "/str-len 12 def\n";
+ print "/prt-n { cvi str-len string cvs \n" .
+ " dup stringwidth pop \n" .
+ " currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
+ " neg 0 rmoveto \n" .
+ " show } def \n" .
+ " % print top-of-stack integer centered at the current point\n";
+ # NB: These PostScript functions must correspond to the Perl fct `normalize'
+ # Currently normalize defines the following trafo on (x,y) values:
+ # $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
+ # $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
+
+ print "/total-len $tmax def\n";
+ print "/show-len $xmax def\n";
+ print "/x-offset $xmin def\n";
+ print "/y-offset $ymin def\n";
+ print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
+ print "% " . "-" x 77 . "\n";
print "%/L { lineto } def\n";
print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n";
print "/L {2 copy currentpoint cmpx not\n";
@@ -442,15 +658,17 @@ sub print_prolog {
print " {pop pop} \n";
print " {lineto} ifelse\n";
print "} def\n";
- print "/flush-it { % draw a segment of the overall area; Arg: color\n";
- print " currentpoint \n";
- print " 1 index 50 lineto closepath\n";
+ print "/F { % flush a segment of the overall area; Arg: color\n";
+ print " currentpoint pop $ymin lineto closepath\n";
if ( $opt_m ) {
- print " 3 2 roll setgray fill \n";
+ print " setgray fill \n";
} else {
- print " 5 2 roll setrgbcolor fill \n";
+ print " setrgbcolor fill \n";
}
- print " 1 index 50 moveto lineto \n";
+ print "} def\n";
+ print "/M { % Start drawing a slice (vert. line and moveto startpoint)\n";
+ print " % Arg: x y\n";
+ print " newpath 1 index $ymin moveto lineto\n";
print "} def\n";
print "% For debugging PS uncomment this line and add the file behandler.ps\n";
print "% $brkpage begin printonly endprint \n";
@@ -520,31 +738,31 @@ sub print_prolog {
$x_now = $x_begin;
- if ( &queue_on("a") ) {
+ if ( $queue_on_a ) {
do print_box_and_label($x_now,$y_label,"green","running");
}
- if ( &queue_on("r") ) {
+ if ( $queue_on_r ) {
$x_now += $step;
do print_box_and_label($x_now,$y_label,"amber","runnable");
}
- if ( &queue_on("f") ) {
+ if ( $queue_on_f ) {
$x_now += $step;
do print_box_and_label($x_now,$y_label,"cyan","fetching");
}
- if ( &queue_on("b") ) {
+ if ( $queue_on_b ) {
$x_now += $step;
do print_box_and_label($x_now,$y_label,"red","blocked");
}
- if ( &queue_on("m") ) {
+ if ( $queue_on_m ) {
$x_now += $step;
do print_box_and_label($x_now,$y_label,"blue","migrating");
}
- if ( &queue_on("s") ) {
+ if ( $queue_on_s ) {
$x_now += $step;
do print_box_and_label($x_now,$y_label,"crimson","sparked");
}
@@ -554,7 +772,21 @@ sub print_prolog {
#print("680 10 moveto\n");
#print("(RT: $tmax) show\n");
- print("-40 -20 translate\n");
+ print("-40 -10 translate\n");
+
+ do print_x_axis();
+
+ print("$xmin $ymin moveto\n");
+ if ( $opt_m ) {
+ print "0 setgray\n";
+ } else {
+ print "0 0 0 setrgbcolor\n";
+ }
+
+ do print_y_axis();
+
+ print("scale-y\n");
+
}
# -----------------------------------------------------------------------------
@@ -585,11 +817,36 @@ sub print_box_and_label {
# -----------------------------------------------------------------------------
+sub print_x_axis {
+
+ print "% " . "-" x 77 . "\n";
+ print "% X-Axis:\n";
+ print "/y-val $ymin def\n";
+ print "0.5 setlinewidth\n";
+ print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
+ print "0 total-len 10 div total-len\n" .
+ " { dup normalize dup y-val moveto 0 -2 rlineto stroke % tic\n" .
+ " y-val 10 sub moveto HE10 setfont round prt-n % print label \n" .
+ " } for \n";
+ print "1 setlinewidth\n";
+ print "% End X-Axis:\n";
+ print "% " . "-" x 77 . "\n";
+}
+
+# -----------------------------------------------------------------------------
+
sub print_y_axis {
local ($i);
+ local ($y, $smax,$majormax, $majorint);
# Y-axis label
+ print "% " . ("-" x 75) . "\n";
+ print "% Y-Axis:\n";
+ print "% " . ("-" x 75) . "\n";
+
+ print("%scale-y % y-axis outside scaled area if ps-scale-y rebuilds it!\n");
+
print("gsave\n");
print("HE12 setfont\n");
print("(tasks)\n");
@@ -605,23 +862,25 @@ sub print_y_axis {
# Scale
- if ( $opt_m ) {
- print "0 setgray\n";
- } else {
- print "0 0 0 setrgbcolor\n";
+ if ($pmax < $majorticks) {
+ $majorticks = $pmax;
}
print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
+ print("% Max number of tasks: $pmax\n");
+ print("% Number of ticks: $majorticks\n");
- if ($pmax < $majorticks) {
- $majorticks = $pmax;
- }
+ print "0.5 setlinewidth\n";
+
+ $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
+ print("$scalex $y moveto\n$major $y lineto\n");
+ print("$markx $y moveto\n($pmax) show\n");
$majormax = int($pmax/$majorticks)*$majorticks;
$smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
$majorint = $majormax/$majorticks;
- for($i=0; $i <= $majorticks; ++$i) {
+ for($i=1; $i <= $majorticks; ++$i) {
$y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
$majorval = int($majorint * ($majormax/$majorint-$i));
print("$scalex $y moveto\n$major $y lineto\n");
@@ -630,14 +889,32 @@ sub print_y_axis {
# print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
print " stroke\n";
+ print "1 setlinewidth\n";
+ print "%unscale-y\n";
+ print "% End Y-Axis.\n";
+ print "% " . ("-" x 75) . "\n";
}
# -----------------------------------------------------------------------------
sub print_verbose_message {
- print "Prg Name: $pname Date: $date Info-str: $show\n";
- print "Input: stdin Output: stdout\n";
+ print STDERR "Prg Name: $pname \nDate: $date \nInfo-str: $show\n";
+ print STDERR "Input: stdin Output: stdout\n";
+ print STDERR "The following queues are turned on: " .
+ ( $queue_on_a ? "active, " : "") .
+ ( $queue_on_r ? "runnable, " : "") .
+ ( $queue_on_b ? "blocked, " : "") .
+ ( $queue_on_f ? "fetching, " : "") .
+ ( $queue_on_m ? "migrating, " : "") .
+ ( $queue_on_s ? "sparks" : "") .
+ "\n";
+ if ( $opt_C ) {
+ print STDERR "Inserting check code into .ps file (for check-ps3 script)\n";
+ }
+ if ( $opt_D ) {
+ print STDERR "Debugging is turned ON!\n";
+ }
}
# ----------------------------------------------------------------------------
@@ -656,23 +933,22 @@ sub process_options {
exit ;
}
- if ( $#ARGV != 2 ) {
- print "Usage: $0 [options] <max y value> <prg name> <date> \n";
+ if ( $#ARGV != 3 ) {
+ print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
print "Use -h option to get details\n";
exit 1;
}
$tmax = $ARGV[0];
- $pname = $ARGV[1];
- $date = $ARGV[2];
+ $pmax = $ARGV[1];
+ # GUM uses the absolute path (with '=' instead of '/') of the executed file
+ # (for PVM reasons); if you want to have the full path in the generated
+ # graph, too, eliminate the substitution below
+ ($pname = $ARGV[2]) =~ s/.*=//;
+ $date = $ARGV[3];
$show = "armfb";
-
- if ( $opt_S ) {
- $draw_lines = 1;
- } else {
- $draw_lines = 0;
- }
+ $draw_lines = 0;
if ( $opt_i ) {
$show = "a" if info_level == 1;
@@ -691,123 +967,22 @@ sub process_options {
$verbose = 1;
}
-# if ($#ARGV == 0) {
-# printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
-# exit 1;
-# }
-}
-
-# -----------------------------------------------------------------------------
-# Old way of drawing areas
-# -----------------------------------------------------------------------------
-
-exit 0;
-
-# Blocked Tasks
-if ($someblocked && ($info_level >= 3)) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]+$R[$i]);
- if ($i % $lines_per_flush == 0) {
- print("red flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
-
- if ( $opt_m ) {
- print "closepath red setgray fill\n";
- } else {
- print "closepath red setrgbcolor fill\n";
- }
-}
-
-# Fetching Tasks
-if ($somefetching && ($info_level >= 4)) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]+$Y[$i]);
- if ($i % $lines_per_flush == 0) {
- print("cyan flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
-
- if ( $opt_m ) {
- print "closepath cyan setgray fill\n";
- } else {
- print "closepath cyan setrgbcolor fill\n";
- }
-}
-
-# Sparks
-if ($somesparks && ($info_level >= 6)) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]+$A[$i]+$C[$i]+$B[$i]);
- if ($i % $lines_per_flush == 0) {
- print("crimson flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
-
- if ( $opt_m ) {
- print "closepath crimson setgray fill\n";
- } else {
- print "closepath crimson setrgbcolor fill\n";
- }
-}
-
-# Migrating Threads
-if ($somemigratory && ($info_level >= 5)) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]+$A[$i]+$C[$i]);
- if ($i % $lines_per_flush == 0) {
- print("blue flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
- # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
- if ( $opt_m ) {
- print "closepath blue setgray fill\n";
+ if ( $opt_l ) {
+ $slice_width = $opt_l;
} else {
- print "closepath blue setrgbcolor fill\n";
+ $slice_width = 500;
}
-}
-# Runnable Tasks
-if($somerunnable && ($info_level >= 2)) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]+$A[$i]);
- if ($i % $lines_per_flush == 0) {
- print("amber flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
- # print("closepath\ngsave\n0.9 setgray\nfill\ngrestore\nstroke\n");
- if ( $opt_m ) {
- print "closepath amber setgray fill\n";
- } else {
- print "closepath amber setrgbcolor fill\n";
- }
-}
+ $queue_on_a = &queue_on("a");
+ $queue_on_r = &queue_on("r");
+ $queue_on_b = &queue_on("b");
+ $queue_on_f = &queue_on("f");
+ $queue_on_s = &queue_on("s");
+ $queue_on_m = &queue_on("m");
-# Active Tasks
-if ($info_level >= 1) {
- print("$xmin $ymin moveto\n");
- for($i=($opt_S ? 2 : 1); $i <= $samples; $i++) {
- do psout($T[$i],$G[$i]);
- if ($i % $lines_per_flush == 0) {
- print("green flush-it\n");
- }
- }
- # print("$xmax $ymin L\n");
- # print("closepath\ngsave\n0.5 setgray\nfill\ngrestore\nstroke\n");
- if ( $opt_m ) {
- print "closepath green setgray fill\n";
- } else {
- print "closepath green setrgbcolor fill\n";
- }
+# if ($#ARGV == 0) {
+# printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
+# exit 1;
+# }
}
diff --git a/ghc/utils/parallel/sn_filter.pl b/ghc/utils/parallel/sn_filter.pl
new file mode 100644
index 0000000000..4bfc2d1721
--- /dev/null
+++ b/ghc/utils/parallel/sn_filter.pl
@@ -0,0 +1,92 @@
+#!/usr/local/bin/perl
+# ############################################################################
+# Time-stamp: <Wed Jun 19 1996 12:26:21 Stardate: [-31]7682.38 hwloidl>
+#
+# Usage: sn_filter [options] <gr-file> <sn>
+#
+# Extract all events out of <gr-file> that are related to threads whose
+# spark name component is <sn>.
+#
+# Options:
+# -H ... Print header of the <gr-file>, too
+# -h ... print help message (this text)
+# -v ... be talkative
+#
+# ############################################################################
+
+$gran_dir = $ENV{'GRANDIR'};
+if ( $gran_dir eq "" ) {
+ print STDERR "Warning: Env variable GRANDIR is undefined\n";
+}
+
+push(@INC, $gran_dir, $gran_dir . "/bin");
+# print STDERR "INC: " . join(':',@INC) . "\n";
+
+require "get_SN";
+require "getopts.pl";
+
+&Getopts('hvH');
+
+do process_options();
+if ( $opt_v ) { do print_verbose_message(); }
+
+# ----------------------------------------------------------------------------
+
+do get_SN($input);
+
+open (FILE,$input) || die "Can't open $file\n";
+
+$in_header = 1;
+while (<FILE>) {
+ print if $in_header && $opt_H;
+ $in_header = 0 if /^\++$/;
+ next if $in_header;
+ next unless /^PE\s*\d+\s*\[\d+\]:\s*\w*\s*([0-9a-fx]+)/;
+ $id = $1;
+ # print STDERR "$id --> " . $id2sn{hex($id)} . " sn: $sn ==> " . ($sn eq $id2sn{hex($id)}) . "\n";
+ print if $sn == $id2sn{hex($id)};
+}
+
+close (FILE);
+
+exit 0;
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $#ARGV != 1 ) {
+ die "Usage: sn_filter <gr-file> <sn>\n";
+ }
+
+ $input = $ARGV[0];
+ $sn = $ARGV[1];
+
+ print STDERR "File: |$file|; sn: |$sn|\n" if $opt_v;
+
+ if ( $opt_h ) {
+ open (ME,$0) || die "!$: $0";
+ while (<ME>) {
+ last if /^$/;
+ print;
+ }
+ close (ME);
+ exit 1;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ print "Input: $input\tOutput: stdout\tSN: $sn\n";
+ if ( $opt_H ) {
+ print "Prepending .gr header to the output.\n";
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+
+
+
diff --git a/ghc/utils/parallel/stats.pl b/ghc/utils/parallel/stats.pl
new file mode 100644
index 0000000000..6cf826b5cd
--- /dev/null
+++ b/ghc/utils/parallel/stats.pl
@@ -0,0 +1,168 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Sat Oct 28 1995 23:15:13 Stardate: [-31]6509.63 hwloidl>
+#
+# Usage: do ....
+#
+# Statistics package that is used in gran-extr, RTS2gran and friends.
+# Most of the routines assume a list of integers as input.
+# This package contains:
+# - corr
+# - mean_std_dev
+# - cov
+# - list_sum
+# - list_max
+# - list_min
+#
+##############################################################################
+
+# ----------------------------------------------------------------------------
+# Compute correlation of 2 vectors, having their sums precomputed.
+# Usage: do corr(($n, $sum_1, @rest);
+#
+# Input: $n ... number of all elements in @list_1 as well as in @list_2
+# (i.e. $n = $#list_1+1 = $#list_2+1).
+# $sum_1 ... sum of all elements in @list_1
+# @list_1 ... list of integers; first vector
+# $sum_2 ... sum of all elements in @list_2
+# @list_2 ... list of integers; first vector
+# Output: correlation of @list_1 and @list_2
+# ----------------------------------------------------------------------------
+
+sub corr {
+ local ($n, $sum_1, @rest) = @_;
+ local (@list_1) = splice(@rest,0,$n);
+ local ($sum_2, @list_2) = @rest;
+
+ local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
+
+ if ( $opt_D ) {
+ print "\ncorr: n=$n sum_1=$sum_1 sum_2=$sum_2\n";
+ print " list_sum of list_1=" . &list_sum(@list_1) .
+ " list_sum of list_2=" . &list_sum(@list_2) . "\n";
+ print " len of list_1=$#list_1 len of list_2=$#list_2\n";
+ }
+
+ ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1);
+ ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2);
+
+ if ( $opt_D ) {
+ print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
+ }
+
+ return ( ($std_dev_1 * $std_dev_2) == 0 ?
+ 0 :
+ &cov($n, $mean_1, @list_1, $mean_2, @list_2) /
+ ( $std_dev_1 * $std_dev_2 ) );
+}
+
+# ----------------------------------------------------------------------------
+
+sub mean_std_dev {
+ local ($sum,@list) = @_;
+ local ($n, $s, $s_);
+
+ #print "\nmean_std_dev: sum is $sum ; list has length $#list";
+
+ $n = $#list+1;
+ $mean_value = $sum/$n;
+
+ $s_ = 0;
+ foreach $x (@list) {
+ $s_ += $x;
+ $s += ($mean_value - $x) ** 2;
+ }
+ if ( $sum != $s_ ) {
+ print "stat.pl: ERROR in mean_std_dev: provided sum is wrong " .
+ "(provided: $sum; computed: $s_ " .
+ ";list_sum: " . &list_sum(@list) . "\n";
+ exit (2);
+ }
+
+ return ( ($mean_value, sqrt($s / ($n - 1)) ) );
+}
+
+# ----------------------------------------------------------------------------
+
+sub _mean_std_dev {
+ return ( &mean_std_dev(&list_sum(@_), @_) );
+}
+
+# ----------------------------------------------------------------------------
+# Compute covariance of 2 vectors, having their sums precomputed.
+# Input: $n ... number of all elements in @list_1 as well as in @list_2
+# (i.e. $n = $#list_1+1 = $#list_2+1).
+# $mean_1 ... mean value of all elements in @list_1
+# @list_1 ... list of integers; first vector
+# $mean_2 ... mean value of all elements in @list_2
+# @list_2 ... list of integers; first vector
+# Output: covariance of @list_1 and @list_2
+# ----------------------------------------------------------------------------
+
+sub cov {
+ local ($n, $mean_1, @rest) = @_;
+ local (@list_1) = splice(@rest,0,$n);
+ local ($mean_2, @list_2) = @rest;
+
+ local ($i,$s,$s_1,$s_2);
+
+ for ($i=0; $i<$n; $i++) {
+ $s_1 += $list_1[$i];
+ $s_2 += $list_2[$i];
+ $s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
+ }
+ if ( $mean_1 != ($s_1/$n) ) {
+ print "stat.pl: ERROR in cov: provided mean value is wrong " .
+ "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n";
+ exit (2);
+ }
+ if ( $mean_2 != ($s_2/$n) ) {
+ print "stat.pl: ERROR in cov: provided mean value is wrong " .
+ "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n";
+ exit (2);
+ }
+ return ( $s / ($n - 1) ) ;
+}
+
+# ---------------------------------------------------------------------------
+
+sub list_sum {
+ local (@list) = @_;
+ local ($sum) = (0);
+
+ foreach $x (@list) {
+ $sum += $x;
+ }
+
+ return ($sum);
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_max {
+ local (@list) = @_;
+ local ($max) = shift;
+
+ foreach $x (@list) {
+ $max = $x if $x > $max;
+ }
+
+ return ($max);
+}
+
+# ----------------------------------------------------------------------------
+
+sub list_min {
+ local (@list) = @_;
+ local ($min) = shift;
+
+ foreach $x (@list) {
+ $min = $x if $x < $min;
+ }
+
+ return ($min);
+}
+
+# ----------------------------------------------------------------------------
+
+1;
diff --git a/ghc/utils/parallel/template.pl b/ghc/utils/parallel/template.pl
new file mode 100644
index 0000000000..21391d7cd0
--- /dev/null
+++ b/ghc/utils/parallel/template.pl
@@ -0,0 +1,141 @@
+#!/usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Sat Oct 28 1995 23:00:47 Stardate: [-31]6509.58 hwloidl>
+#
+# Usage: do read_template(<template_file_name>,<input_file_name>);
+#
+# Read the template file <template_file_name> as defined in /dev/null.
+# Set global variables as defined in the template file.
+# This is mainly used in gran-extr and RTS2gran.
+#
+##############################################################################
+
+require "aux.pl";
+
+sub read_template {
+ local ($org_templ_file_name,$input) = @_;
+ local ($f,$templ_file_name);
+
+ # Resolve name
+ $gran_dir = $ENV{GRANDIR} ? $ENV{GRANDIR} : $ENV{HOME} ;
+ $templ_file_name = ( $org_templ_file_name eq '.' ? "TEMPL"
+ #^^^ default file name
+ : $org_templ_file_name eq ',' ? $gran_dir . "/bin/TEMPL"
+ #^^^ global master template
+ : $org_templ_file_name eq '/' ? $gran_dir . "/bin/T0"
+ #^^ template, that throws away most of the info
+ : $org_templ_file_name );
+
+ if ( $opt_v ) {
+ print "Reading template file $templ_file_name ...\n";
+ }
+
+ ($f = ($input eq "-" ? "stdin" : $input)) =~ s/.rts//;
+
+ open(TEMPLATE,"cat $templ_file_name | sed -e 's/\$0/$f/' |")
+ || die "Couldn't open file $templ_file_name";
+
+ while (<TEMPLATE>) {
+ next if /^\s*$/ || /^--/;
+ if (/^\s*G[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @exec_times = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @fetch_times = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @has = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @comm_percs = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
+ $list_str = $1;
+ $list_str =~ s/[\(\)\[\]]//g;
+ @sparks = split(/[,;. ]+/, $list_str);
+ } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
+ ($gran_file_name,$gran_global_file_name, $gran_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
+ ($ft_file_name,$ft_global_file_name, $ft_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
+ ($comm_file_name, $comm_global_file_name, $comm_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
+ ($spark_file_name, $spark_global_file_name, $spark_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
+ ($ha_file_name, $ha_global_file_name, $ha_local_file_name) =
+ &mk_global_local_names($1);
+ } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
+ $gp_file_name = $1;
+ # $ps_file_name = &dat2ps_name($gp_file_name);
+ } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
+ $corr_file_name = $1;
+ } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
+ $cumulat_rts_file_name = $1;
+ ($cumulat0_rts_file_name = $1) =~ s/\./0./;
+ } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
+ $cumulat_has_file_name = $1;
+ } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
+ $cumulat_fts_file_name = $1;
+ } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
+ $cumulat_cps_file_name = $1;
+ } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
+ $clust_rts_file_name = $1;
+ } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
+ $clust_has_file_name = $1;
+ } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
+ $clust_fts_file_name = $1;
+ } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
+ $clust_cps_file_name = $1;
+ } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
+ $pe_file_name = $1;
+ } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
+ $sn_file_name = $1;
+
+ } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
+ $rts_file_name = $1;
+ } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
+ $has_file_name = $1;
+ } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
+ $fts_file_name = $1;
+ } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
+ $lsps_file_name = $1;
+ } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
+ $gsps_file_name = $1;
+ } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
+ $cps_file_name = $1;
+ } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
+ $ccps_file_name = $1;
+
+ } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
+ $input = $1;
+ } elsif (/^\s*L[:,;\s]+(.*)$/) {
+ $str = $1;
+ %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next if $str eq ".";
+ $str =~ s/[\(\)\[\]]//g;
+ %logscale = split(/[,;. ]+/, $str);
+ } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
+ $gray = $1;
+ } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
+ $no_of_clusters = $1;
+ } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
+ $ext_size = $1;
+ } elsif (/^\s*v.*$/) {
+ $verbose = 1;
+ } elsif (/^\s*T.*$/) {
+ $opt_T = 1;
+ }
+ }
+ close(TEMPLATE);
+}
+
+# ----------------------------------------------------------------------------
+
+1;
diff --git a/ghc/utils/parallel/tf.pl b/ghc/utils/parallel/tf.pl
new file mode 100644
index 0000000000..40cff09f2c
--- /dev/null
+++ b/ghc/utils/parallel/tf.pl
@@ -0,0 +1,148 @@
+#!/usr/local/bin/perl
+# ############################################################################
+# Time-stamp: <Fri Aug 25 1995 23:17:43 Stardate: [-31]6189.64 hwloidl>
+# (C) Hans Wolfgang Loidl, November 1994
+#
+# Usage: tf [options] <gr-file>
+#
+# Show the `taskflow' in the .gr file (especially useful for keeping track of
+# migrated tasks. It's also possible to focus on a given PE or on a given
+# event.
+#
+# Options:
+# -p <int> ... Print all events on PE <int>
+# -t <int> ... Print all events that occur on task <int>
+# -e <str> ... Print all <str> events
+# -n <hex> ... Print all events about fetching the node at address <hex>.
+# -s <int> ... Print all events with a spark name <int>
+# -L ... Print all events with spark queue length information
+# -H ... Print header of the <gr-file>, too
+# -h ... print help message (this text)
+# -v ... be talkative
+#
+# ############################################################################
+
+# ----------------------------------------------------------------------------
+# Command line processing and initialization
+# ----------------------------------------------------------------------------
+
+require "getopts.pl";
+
+&Getopts('hvHLp:t:e:n:s:S:');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ----------------------------------------------------------------------------
+
+$in_header = 1;
+while (<>) {
+ if ( $opt_H && $in_header ) {
+ print;
+ $in_header = 0 if /^\+\+\+\+\+/;
+ }
+ next unless /^PE/;
+ @c = split(/[\s\[\]:;,]+/);
+ if ( ( $check_proc ? $proc eq $c[1] : 1 ) &&
+ ( $check_event ? $event eq $c[3] : 1 ) &&
+ ( $check_task ? $task eq $c[4] : 1) &&
+ ( $check_node ? $node eq $c[5] : 1) &&
+ ( $check_spark ? (("END" eq $c[3]) && ($spark eq $c[6])) : 1) &&
+ ( $negated_spark ? (("END" eq $c[3]) && ($spark ne $c[6])) : 1) &&
+ ( $spark_queue_len ? ($c[5] =~ /sparks/) : 1 ) ) {
+ print;
+ }
+}
+
+exit 0;
+
+# ----------------------------------------------------------------------------
+
+sub process_options {
+
+ if ( $opt_p ne "" ) {
+ $check_proc = 1;
+ $proc = $opt_p;
+ }
+
+ if ( $opt_t ne "" ) {
+ $check_task = 1;
+ $task = $opt_t;
+ }
+
+ if ( $opt_e ne "" ) {
+ $check_event = 1;
+ $event = $opt_e;
+ }
+
+ if ( $opt_n ne "" ) {
+ $check_node = 1;
+ $node = $opt_n
+ }
+
+ if ( $opt_s ne "" ) {
+ $check_spark = 1;
+ $spark = $opt_s
+ }
+
+ if ( $opt_S ne "" ) {
+ $negated_spark = 1;
+ $spark = $opt_S
+ }
+
+ if ( $opt_L ) {
+ $spark_queue_len = 1;
+ } else {
+ $spark_queue_len = 0;
+ }
+
+ if ( $opt_h ) {
+ open (ME,$0) || die "!$: $0";
+ while (<ME>) {
+ last if /^$/;
+ print;
+ }
+ close (ME);
+ exit 1;
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ if ( $opt_p ne "" ) {
+ print "Processor: $proc\n";
+ }
+
+ if ( $opt_t ne "" ) {
+ print "Task: $task\n";
+ }
+
+ if ( $opt_e ne "" ) {
+ print "Event: $event\n";
+ }
+
+ if ( $opt_n ne "" ) {
+ print "Node: $node\n";
+ }
+
+ if ( $opt_s ne "" ) {
+ print "Spark: $spark\n";
+ }
+
+ if ( $opt_S ne "" ) {
+ print "Negated Spark: $spark\n";
+ }
+
+ if ( $opt_L ne "" ) {
+ print "Printing spark queue len info.\n";
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+
diff --git a/ghc/utils/pvm/README b/ghc/utils/pvm/README
index a45840500a..5ab58ddec8 100644
--- a/ghc/utils/pvm/README
+++ b/ghc/utils/pvm/README
@@ -2,6 +2,3 @@
comes with PVM 3.3.7.
Less sure about "debugger.emacs"...
-
-Will Partain
-95/07/24