summaryrefslogtreecommitdiff
path: root/utils/parallel
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
commit0065d5ab628975892cea1ec7303f968c3338cbe1 (patch)
tree8e2afe0ab48ee33cf95009809d67c9649573ef92 /utils/parallel
parent28a464a75e14cece5db40f2765a29348273ff2d2 (diff)
downloadhaskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to Cabal, and with the move to darcs we can now flatten the source tree without losing history, so here goes. The main change is that the ghc/ subdir is gone, and most of what it contained is now at the top level. The build system now makes no pretense at being multi-project, it is just the GHC build system. No doubt this will break many things, and there will be a period of instability while we fix the dependencies. A straightforward build should work, but I haven't yet fixed binary/source distributions. Changes to the Building Guide will follow, too.
Diffstat (limited to 'utils/parallel')
-rw-r--r--utils/parallel/AVG.pl108
-rw-r--r--utils/parallel/GrAnSim.el432
-rw-r--r--utils/parallel/Makefile49
-rw-r--r--utils/parallel/RTS2gran.pl684
-rw-r--r--utils/parallel/SN.pl280
-rw-r--r--utils/parallel/SPLIT.pl379
-rw-r--r--utils/parallel/avg-RTS.pl15
-rw-r--r--utils/parallel/get_SN.pl40
-rw-r--r--utils/parallel/ghc-fool-sort.pl23
-rw-r--r--utils/parallel/ghc-unfool-sort.pl16
-rw-r--r--utils/parallel/gp-ext-imp.pl86
-rw-r--r--utils/parallel/gr2RTS.pl138
-rw-r--r--utils/parallel/gr2ap.bash124
-rw-r--r--utils/parallel/gr2gran.bash113
-rw-r--r--utils/parallel/gr2java.pl322
-rw-r--r--utils/parallel/gr2jv.bash123
-rw-r--r--utils/parallel/gr2pe.pl1434
-rw-r--r--utils/parallel/gr2ps.bash169
-rw-r--r--utils/parallel/gr2qp.pl329
-rw-r--r--utils/parallel/gran-extr.pl2114
-rw-r--r--utils/parallel/grs2gr.pl48
-rw-r--r--utils/parallel/par-aux.pl89
-rw-r--r--utils/parallel/ps-scale-y.pl188
-rw-r--r--utils/parallel/qp2ap.pl495
-rw-r--r--utils/parallel/qp2ps.pl988
-rw-r--r--utils/parallel/sn_filter.pl92
-rw-r--r--utils/parallel/stats.pl168
-rw-r--r--utils/parallel/template.pl141
-rw-r--r--utils/parallel/tf.pl148
29 files changed, 9335 insertions, 0 deletions
diff --git a/utils/parallel/AVG.pl b/utils/parallel/AVG.pl
new file mode 100644
index 0000000000..9ec42aee2f
--- /dev/null
+++ b/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/utils/parallel/GrAnSim.el b/utils/parallel/GrAnSim.el
new file mode 100644
index 0000000000..49330a9749
--- /dev/null
+++ b/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/utils/parallel/Makefile b/utils/parallel/Makefile
new file mode 100644
index 0000000000..094c5cbba1
--- /dev/null
+++ b/utils/parallel/Makefile
@@ -0,0 +1,49 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+
+PERL_PROGS = \
+ grs2gr gr2qp qp2ps ghc-fool-sort ghc-unfool-sort gr2pe gr2java \
+ qp2ap gr2RTS RTS2gran gran-extr gp-ext-imp tf avg-RTS SPLIT \
+ AVG SN get_SN sn_filter ps-scale-y
+
+
+BASH_PROGS = gr2ps gr2jv gr2ap gr2gran
+
+#
+# One rule fits all, not particularly selective.
+#
+$(PERL_PROGS) : $(patsubst %,%.pl,$(PERL_PROGS))
+$(BASH_PROGS) : $(patsubst %,%.bash,$(BASH_PROGS))
+
+
+all :: $(PERL_PROGS) $(BASH_PROGS)
+
+$(PERL_PROGS) :
+ $(RM) $@
+ @echo Creating $@...
+ @echo "#!"$(PERL) > $@
+ @cat $@.pl >> $@
+ @chmod a+x $@
+
+$(BASH_PROGS) :
+ $(RM) $@
+ @echo Creating $@...
+ @echo "#!"$(BASH) > $@
+ @cat $@.bash >> $@
+ @chmod a+x $@
+
+#
+# You'll only get this with Parallel Haskell or
+# GranSim..
+#
+ifeq "$(BuildingParallel)" "YES"
+INSTALL_SCRIPTS += $(BASH_PROGS) $(PERL_PROGS)
+else
+ifeq "$(BuildingGranSim)" "YES"
+INSTALL_SCRIPTS += $(BASH_PROGS) $(PERL_PROGS)
+endif
+endif
+
+CLEAN_FILES += $(BASH_PROGS) $(PERL_PROGS)
+
+include $(TOP)/mk/target.mk
diff --git a/utils/parallel/RTS2gran.pl b/utils/parallel/RTS2gran.pl
new file mode 100644
index 0000000000..32012afac8
--- /dev/null
+++ b/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/utils/parallel/SN.pl b/utils/parallel/SN.pl
new file mode 100644
index 0000000000..bc33e2a60c
--- /dev/null
+++ b/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 "par-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/utils/parallel/SPLIT.pl b/utils/parallel/SPLIT.pl
new file mode 100644
index 0000000000..b4fe46f5b0
--- /dev/null
+++ b/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/utils/parallel/avg-RTS.pl b/utils/parallel/avg-RTS.pl
new file mode 100644
index 0000000000..4f25d55f80
--- /dev/null
+++ b/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/utils/parallel/get_SN.pl b/utils/parallel/get_SN.pl
new file mode 100644
index 0000000000..e9426855bf
--- /dev/null
+++ b/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/utils/parallel/ghc-fool-sort.pl b/utils/parallel/ghc-fool-sort.pl
new file mode 100644
index 0000000000..dfa65a1875
--- /dev/null
+++ b/utils/parallel/ghc-fool-sort.pl
@@ -0,0 +1,23 @@
+##############################################################################
+#
+# Usage: fool-sort
+#
+# Takes a pure (i.e. no header lines) quasi-parallel profile (a .qp file) from
+# stdin and inserts a counter as second field to force sort not to change the
+# ordering of lines with the same time stamp. The result is written to stdout.
+#
+##############################################################################
+
+$last_time = 0;
+while (<STDIN>) {
+ ($time, @rest) = split;
+ if ( $time == $last_time ) {
+ $x = ++$count;
+ } else {
+ $x = $count = 0;
+ }
+ print $time, " ", $x, " ", join(' ',@rest), "\n";
+ $last_time = $time;
+}
+
+exit 0;
diff --git a/utils/parallel/ghc-unfool-sort.pl b/utils/parallel/ghc-unfool-sort.pl
new file mode 100644
index 0000000000..90da222a5a
--- /dev/null
+++ b/utils/parallel/ghc-unfool-sort.pl
@@ -0,0 +1,16 @@
+##############################################################################
+#
+# Usage: unfool-sort
+#
+# Reads stdin, elimininates the second field (a dummy counter that has been
+# inserted by fool-sort) of each line and writes the result to stdout.
+# See documentation of fool-sort.
+#
+##############################################################################
+
+while (<STDIN>) {
+ ($time, $dummy, @rest) = split;
+ print join(' ',$time,@rest) . "\n";
+}
+
+exit 0;
diff --git a/utils/parallel/gp-ext-imp.pl b/utils/parallel/gp-ext-imp.pl
new file mode 100644
index 0000000000..fa7c4e06d8
--- /dev/null
+++ b/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/utils/parallel/gr2RTS.pl b/utils/parallel/gr2RTS.pl
new file mode 100644
index 0000000000..c609334c28
--- /dev/null
+++ b/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/utils/parallel/gr2ap.bash b/utils/parallel/gr2ap.bash
new file mode 100644
index 0000000000..7818fe112b
--- /dev/null
+++ b/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/utils/parallel/gr2gran.bash b/utils/parallel/gr2gran.bash
new file mode 100644
index 0000000000..d281d2c5bc
--- /dev/null
+++ b/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
diff --git a/utils/parallel/gr2java.pl b/utils/parallel/gr2java.pl
new file mode 100644
index 0000000000..acd0b5e631
--- /dev/null
+++ b/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/utils/parallel/gr2jv.bash b/utils/parallel/gr2jv.bash
new file mode 100644
index 0000000000..7eeacfe556
--- /dev/null
+++ b/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/utils/parallel/gr2pe.pl b/utils/parallel/gr2pe.pl
new file mode 100644
index 0000000000..6026300758
--- /dev/null
+++ b/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/utils/parallel/gr2ps.bash b/utils/parallel/gr2ps.bash
new file mode 100644
index 0000000000..4d4d3da3e6
--- /dev/null
+++ b/utils/parallel/gr2ps.bash
@@ -0,0 +1,169 @@
+#!/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) 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>
+# -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 ... 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).
+#
+##############################################################################
+
+progname="`basename $0`"
+args="$*"
+
+verb=0
+help=0
+mono=""
+psfile=""
+debug=""
+optimise=""
+info_level=""
+info_mask=""
+string=""
+length=""
+force_date=""
+hack=""
+
+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";;
+ 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 "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 [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 "$psfile" ]
+ then psfile="$f".ps
+fi
+
+if [ $verb -eq 1 ]
+ then echo "Input file: $grfile"
+ echo "Quasi-parallel file: $qpfile"
+ echo "PP file: $ppfile"
+ echo "PostScript file: $psfile"
+ if [ -n "$mono" ]
+ then echo "Producing monochrome PS file"
+ else echo "Producing color PS file"
+ fi
+ if [ -n "$optimise" ]
+ then echo "Optimisation is ON"
+ else echo "Optimisation is OFF"
+ fi
+ 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
+
+
+# unset noclobber
+if [ ! -f "$grfile" ]
+ then
+ echo "$grfile does not exist"
+ exit 1
+ else
+ 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
+ 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 ${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; }'`
+ 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/utils/parallel/gr2qp.pl b/utils/parallel/gr2qp.pl
new file mode 100644
index 0000000000..e87f21b1e4
--- /dev/null
+++ b/utils/parallel/gr2qp.pl
@@ -0,0 +1,329 @@
+#!/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;
+ $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, " ",
+ $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/utils/parallel/gran-extr.pl b/utils/parallel/gran-extr.pl
new file mode 100644
index 0000000000..509da499d6
--- /dev/null
+++ b/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/utils/parallel/grs2gr.pl b/utils/parallel/grs2gr.pl
new file mode 100644
index 0000000000..ab398a53d9
--- /dev/null
+++ b/utils/parallel/grs2gr.pl
@@ -0,0 +1,48 @@
+#!/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
+# time.
+#
+
+$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);
+}
+
+$basetime = 0;
+
+for($i = 0; $i < $count; $i++) {
+ $pe = $proc[$i];
+ die "PE $pe missing?\n" if !defined($time[$pe]);
+ die "Mismatched .gr files\n" if $pe > 0 && $prog[$pe] ne $prog[$pe - 1];
+ $basetime = $time[$pe] if $basetime == 0 || $basetime > $time[$pe];
+}
+
+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);
+}
diff --git a/utils/parallel/par-aux.pl b/utils/parallel/par-aux.pl
new file mode 100644
index 0000000000..8484057aab
--- /dev/null
+++ b/utils/parallel/par-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/utils/parallel/ps-scale-y.pl b/utils/parallel/ps-scale-y.pl
new file mode 100644
index 0000000000..0e1242081c
--- /dev/null
+++ b/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/utils/parallel/qp2ap.pl b/utils/parallel/qp2ap.pl
new file mode 100644
index 0000000000..b3c3bcf122
--- /dev/null
+++ b/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/utils/parallel/qp2ps.pl b/utils/parallel/qp2ps.pl
new file mode 100644
index 0000000000..2fb090346a
--- /dev/null
+++ b/utils/parallel/qp2ps.pl
@@ -0,0 +1,988 @@
+#! /usr/local/bin/perl
+##############################################################################
+# Time-stamp: <Wed Jul 24 1996 22:04:50 Stardate: [-31]7859.39 hwloidl>
+#
+# 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>
+# -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).
+#
+##############################################################################
+
+require "getopts.pl";
+
+&Getopts('hvDCOmdl:s:i:I:H');
+
+do process_options();
+
+if ( $opt_v ) {
+ do print_verbose_message();
+}
+
+# ---------------------------------------------------------------------------
+# Init
+# ---------------------------------------------------------------------------
+
+$y_scaling = 1.0;
+
+$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;
+
+$active = 0;
+$runnable = 0;
+$blocked = 0;
+$fetching = 0;
+$migrating = 0;
+$sparks = 0;
+
+#$lines_per_flush = 100; # depends on the PS implementation you use
+
+%color = ( "a", "green", # active
+ "r", "amber", # runnable
+ "b", "red", # blocked
+ "f", "cyan", # fetching
+ "m", "blue", # migrating
+ "s", "crimson" ); # sparks
+
+# ---------------------------------------------------------------------------
+
+do print_prolog();
+
+$otime = -1;
+$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 ( $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") 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 0 && $opt_D;
+
+ if ($eventfrom eq '*') {
+ }
+
+ elsif ($eventfrom eq 'G') {
+ --$active;
+ }
+
+ elsif ($eventfrom eq 'A') {
+ --$runnable;
+ }
+
+ elsif ($eventfrom eq 'R') {
+ --$blocked;
+ }
+
+ elsif ($eventfrom eq 'B') {
+ --$sparks;
+ }
+
+ elsif ($eventfrom eq 'C') {
+ --$migrating;
+ }
+
+ elsif ($eventfrom eq 'Y') {
+ --$fetching;
+ }
+
+ if ($eventto eq '*') {
+ }
+
+ elsif ($eventto eq 'G') {
+ ++$active;
+ }
+
+ elsif ($eventto eq 'A') {
+ ++$runnable;
+ $somerunnable = 1;
+ }
+
+ elsif ($eventto eq 'R') {
+ ++$blocked;
+ $someblocked = 1;
+ }
+
+ elsif ($eventto eq 'B') {
+ ++$sparks;
+ $somesparks = 1;
+ }
+
+ elsif ($eventto eq 'C') {
+ ++$migrating;
+ $somemigratory = 1;
+ }
+
+ elsif ($eventto eq 'Y') {
+ ++$fetching;
+ $somefetching = 1;
+ }
+
+
+ #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 > $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) {
+ 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
+ if ( $opt_s ) {
+ 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 ( $opt_S ) { # HACK warning; is this *always* correct -- HWL
+ $avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
+ } else {
+ $avg = $tottime/$time;
+ }
+ 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 20 moveto show\n");
+}
+
+# do print_y_axis();
+
+# -----------------------------------------------------------------------------
+# Draw axes lines etc
+# -----------------------------------------------------------------------------
+
+if ( ! $opt_S ) {
+
+# Draw dashed line for orientation (startup time) -- HWL
+
+if ( $draw_lines ) {
+ local($x, $y);
+ $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
+ $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
+ $h = ($ymax-$ymin);
+
+ print "gsave\n" .
+ "[1 3] 1 setdash\n" .
+ "$x $y moveto 0 $h rlineto stroke\n" .
+ "grestore\n";
+}
+
+# and another one at the second event -- HWL
+
+print STDERR "Time of second event is: $time_of_second_event" if 0 && $opt_D;
+
+if ( $draw_lines ) {
+ local($x, $y);
+ $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
+ $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
+ $h = ($ymax-$ymin);
+
+ print "gsave\n";
+ if ( ! $opt_m ) {
+ print "green setrgbcolor\n";
+ }
+ print "[3 5] 1 setdash\n" .
+ "$x $y moveto 0 $h rlineto stroke\n" .
+ "grestore\n";
+}
+
+}
+
+# -----------------------------------------------------------------------------
+
+# Logo
+print("HE14 setfont\n");
+if ($opt_m) {
+ print("50 520 asciilogo\n");
+} else {
+ print("50 520 logo\n");
+}
+
+# Epilogue
+print("showpage\n");
+
+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):
+# If there is a sequence of (x,y) pairs with same x value, then just
+# print the first and the last pair in the seqence. To do that, $last_x
+# always contains the scaled x-val of the last point. $last_y contains
+# the y-val of the last point in the current sequence (it is 0 outside a
+# sequence!).
+# -----------------------------------------------------------------------------
+
+sub normalize {
+ local($x, $y ) = @_;
+ local($x_norm, $y_norm );
+
+ if ( $opt_S ) {
+ $x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
+ } else {
+ $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
+ }
+ $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 ) {
+ if ( $last_x == $x ) { # If seq before $x that then print last pt
+ if ( ! $in_seq ) {
+ $in_seq = 1;
+ $first_y = $last_y;
+ }
+ } else { # If seq with same $x val then ignore pts
+ if ( $in_seq ) { # Seq before that -> print last in seq
+ print("$last_x $last_y L\n") if ($first_y != $last_y);
+ $in_seq = 0;
+ }
+ print("$x $y L\n");
+ }
+ $last_x = $x;
+ $last_y = $y;
+ } else {
+ print("$x $y L\n");
+ }
+}
+
+# -----------------------------------------------------------------------------
+
+sub queue_on {
+ local ($queue) = @_;
+
+ return index($show,$queue)+1;
+}
+
+# -----------------------------------------------------------------------------
+
+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)) ? $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);
+
+ chop($date = `date`);
+ return ($date);
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_prolog {
+ local ($now);
+
+ $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\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");
+ #print ("/redlineto {1.5 setlinewidth lineto} def\n");
+ #print ("/G {newpath moveto greenlineto stroke} def\n");
+ #print ("/A {newpath moveto amberlineto stroke} def\n");
+ #print ("/R {newpath moveto redlineto stroke} def\n");
+
+ if ( $opt_m ) {
+ 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";
+ print "/cyan { 0.3 } 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 "/crimson { 0.7 0.5 0 } def\n";
+ print "/amber { 0.9 0.7 0.2 } def\n";
+ print "/cyan { 0 0.6 0.9 } def\n";
+ }
+
+ print "/printText { 0 0 moveto (GrAnSim) show } def\n";
+
+ if ( $opt_m ) {
+ print "/logo { gsave \n" .
+ " translate \n" .
+ " .95 -.05 0\n" .
+ " { setgray printText 1 -.5 translate } for \n" .
+ " 1 setgray printText\n" .
+ " grestore } 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 "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
+ print "/cmpx {pop exch pop eq} def % compare x-coors of 2 points\n";
+ 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";
+ print " {2 copy pop currentpoint exch pop lineto} if\n";
+ print " 2 copy currentpoint cmpy \n";
+ print " {pop pop} \n";
+ print " {lineto} ifelse\n";
+ print "} def\n";
+ print "/F { % flush a segment of the overall area; Arg: color\n";
+ print " currentpoint pop $ymin lineto closepath\n";
+ if ( $opt_m ) {
+ print " setgray fill \n";
+ } else {
+ print " setrgbcolor fill \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";
+ 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("-90 rotate\n");
+ print("-785 30 translate\n");
+ print("newpath\n");
+ print("0 8 moveto\n");
+ print("0 525 760 525 8 arcto\n");
+ print("4 {pop} repeat\n");
+ print("760 525 760 0 8 arcto\n");
+ print("4 {pop} repeat\n");
+ print("760 0 0 0 8 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0 0 0 525 8 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0.500000 setlinewidth\n");
+ print("stroke\n");
+ print("newpath\n");
+ print("4 505 moveto\n");
+ print("4 521 752 521 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("752 521 752 501 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("752 501 4 501 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("4 501 4 521 4 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 moveto show\n");
+
+ print("4 8 moveto\n");
+ print("4 24 756 24 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("756 24 756 4 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("756 4 4 4 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("4 4 4 24 4 arcto\n");
+ print("4 {pop} repeat\n");
+ print("0.500000 setlinewidth\n");
+ print("stroke\n");
+
+# Labels
+
+# x-range: 100 - 600
+# y-value:
+
+ $x_begin = 100;
+ $x_end = 600;
+ $y_label = 10;
+
+ $no_of_labels = length($show); # $info_level;
+
+ $step = ($x_end-$x_begin)/($no_of_labels);
+
+ $x_now = $x_begin;
+
+ if ( $queue_on_a ) {
+ do print_box_and_label($x_now,$y_label,"green","running");
+ }
+
+ if ( $queue_on_r ) {
+ $x_now += $step;
+ do print_box_and_label($x_now,$y_label,"amber","runnable");
+ }
+
+ if ( $queue_on_f ) {
+ $x_now += $step;
+ do print_box_and_label($x_now,$y_label,"cyan","fetching");
+ }
+
+ if ( $queue_on_b ) {
+ $x_now += $step;
+ do print_box_and_label($x_now,$y_label,"red","blocked");
+ }
+
+ if ( $queue_on_m ) {
+ $x_now += $step;
+ do print_box_and_label($x_now,$y_label,"blue","migrating");
+ }
+
+ if ( $queue_on_s ) {
+ $x_now += $step;
+ do print_box_and_label($x_now,$y_label,"crimson","sparked");
+ }
+
+ # Print runtime of prg; this is jus a crude HACK; better: x-axis! -- HWL
+ #print("HE10 setfont\n");
+ #print("680 10 moveto\n");
+ #print("(RT: $tmax) show\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");
+
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_box_and_label {
+ local ($x,$y,$color,$label) = @_;
+ local ($z) = (15);
+
+ print("$x 10 moveto\n");
+ print("0 10 rlineto\n");
+ print("10 0 rlineto\n");
+ print("0 -10 rlineto\n");
+ print("closepath\n");
+ print("gsave\n");
+ if ( $opt_m ) {
+ print("$color setgray\n");
+ } else {
+ print("$color setrgbcolor\n");
+ }
+ print("fill\n");
+ print("grestore\n");
+ print("stroke\n");
+ print("HE14 setfont\n");
+ print(($x+$z) . " 10 moveto\n");
+ print("($label) show\n");
+
+}
+
+# -----------------------------------------------------------------------------
+
+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");
+ 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("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
+ print("% Max number of tasks: $pmax\n");
+ print("% Number of ticks: $majorticks\n");
+
+ 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=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");
+ 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 "%unscale-y\n";
+ print "% End Y-Axis.\n";
+ print "% " . ("-" x 75) . "\n";
+}
+
+# -----------------------------------------------------------------------------
+
+sub print_verbose_message {
+
+ 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";
+ }
+}
+
+# ----------------------------------------------------------------------------
+
+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 != 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];
+
+ $show = "armfb";
+ $draw_lines = 0;
+
+ 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;
+ }
+
+ if ( $opt_l ) {
+ $slice_width = $opt_l;
+ } else {
+ $slice_width = 500;
+ }
+
+ $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");
+
+# if ($#ARGV == 0) {
+# printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
+# exit 1;
+# }
+}
+
diff --git a/utils/parallel/sn_filter.pl b/utils/parallel/sn_filter.pl
new file mode 100644
index 0000000000..4bfc2d1721
--- /dev/null
+++ b/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/utils/parallel/stats.pl b/utils/parallel/stats.pl
new file mode 100644
index 0000000000..6cf826b5cd
--- /dev/null
+++ b/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/utils/parallel/template.pl b/utils/parallel/template.pl
new file mode 100644
index 0000000000..7fbe4cf797
--- /dev/null
+++ b/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 "par-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/utils/parallel/tf.pl b/utils/parallel/tf.pl
new file mode 100644
index 0000000000..40cff09f2c
--- /dev/null
+++ b/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";
+ }
+
+}
+
+# ----------------------------------------------------------------------------
+