← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to utils/parallel/gr2pe.pl

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/parallel/gr2pe.pl
 
1
#!/usr/local/bin/perl 
 
2
#                                       (C) Hans Wolfgang Loidl, November 1994
 
3
# ############################################################################
 
4
# Time-stamp: <Fri Jun 14 1996 20:21:17 Stardate: [-31]7659.03 hwloidl>
 
5
#
 
6
# Usage: gr2pe [options] <gr-file>
 
7
#
 
8
# Create per processor activity profile (as ps-file) from a given gr-file.
 
9
# 
 
10
# Options:
 
11
#  -o <file> ... output file (ps file) has name <file>
 
12
#  -m        ... produce monochrome output
 
13
#  -M        ... produce a migration graph
 
14
#  -S        ... produce a spark graph in a separate file (based on the no. of
 
15
#                sparks rather than the no. of runnable threads)
 
16
#  -t        ... produce trace of runnable, blocked, fetching threads 
 
17
#  -i <n>    ... ``infinity'' for number of blocked tasks (default: 20)
 
18
#                all values larger than that are shown with the same width
 
19
#  -C        ... do consistency check at each event (mainly for debugging)
 
20
#  -h        ... print help message (this text)
 
21
#  -v        ... be talkative
 
22
#  
 
23
# ############################################################################
 
24
 
 
25
# die "This script is still under development -- HWL\n"; 
 
26
 
 
27
# ----------------------------------------------------------------------------
 
28
# Command line processing and initialization
 
29
# ----------------------------------------------------------------------------
 
30
 
 
31
require "getopts.pl";
 
32
 
 
33
&Getopts('hvDCMNmSGti:o:l:p:');  
 
34
 
 
35
do process_options();
 
36
 
 
37
if ( $opt_v ) {
 
38
    do print_verbose_message();
 
39
}
 
40
 
 
41
# ----------------------------------------------------------------------------
 
42
# Global Variables
 
43
# ----------------------------------------------------------------------------
 
44
 
 
45
$RUNNING = "RUNNING";
 
46
$RUNNABLE = "RUNNABLE";
 
47
$BLOCKED = "BLOCKED";
 
48
$START = "START";
 
49
$END = "END";
 
50
 
 
51
# Modes for hline
 
52
#$LITERATE = 1;
 
53
#$NORMALIZING = 2;
 
54
 
 
55
%GRAY = (
 
56
         $RUNNING, 0.6,
 
57
         $RUNNABLE, 0.3,
 
58
         $BLOCKED, 0,
 
59
         $START, 0,
 
60
         $END, 0.5);
 
61
 
 
62
# Special value showing that no task is running on $pe if in $running[$pe] 
 
63
$NO_ID = -1;
 
64
$NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;
 
65
 
 
66
# The number of PEs we have
 
67
$nPEs = 32;
 
68
 
 
69
# Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
 
70
$width_unit = 1; 
 
71
 
 
72
# Width of line for RUNNING 
 
73
$running_width = 1;
 
74
 
 
75
# Offset of BLOCKED and RUNNABLE lines from the center line
 
76
$offset = 10;
 
77
 
 
78
# Left and right border of the picture; Width of the picture
 
79
$left_border = 0;
 
80
$right_border = 700;
 
81
$total_width = $right_border - $left_border;
 
82
$x_scale = 1;
 
83
 
 
84
# Height of the picture measured from y-val of first to y-val of last PE
 
85
$lower_border = 10;
 
86
$upper_border = 490;
 
87
$total_height = $upper_border - $lower_border;
 
88
$y_scale = 1;
 
89
 
 
90
# Constant from where shrinking of x-values (+scaling as usual) is enabled
 
91
$very_big = 1E8;
 
92
 
 
93
# Factor by which the x values are shrunk (if very big)
 
94
$shrink_x = 10000;
 
95
 
 
96
# Set format of output of numbers
 
97
$# = "%.2g";
 
98
 
 
99
# Width of stripes in migration graph
 
100
$tic_width = 2;
 
101
 
 
102
# If no spark profile should be generate we count the number of spark events
 
103
# in the profile to inform the user about existing spark information
 
104
if ( !$opt_S ) {
 
105
    $spark_events = 0;
 
106
}
 
107
 
 
108
# ----------------------------------------------------------------------------
 
109
# The real thing starts here
 
110
# ----------------------------------------------------------------------------
 
111
 
 
112
open (IN,"<$input") || die "$input: $!\n";
 
113
open (OUT,">$output") || die "$output: $!\n";
 
114
open (OUT_MIG,">$output_mig") || die "$output_mig: $!\n"  if $opt_M;
 
115
open (OUT_SP,">$output_sp") || die "$output_sp: $!\n"  if $opt_S;
 
116
# open (OUT_B,">$output_b") || die "$output_b: $!\n";
 
117
# open (OUT_R,">$output_r") || die "$output_r: $!\n";
 
118
 
 
119
open(OUT_RA, ">$RUNNABLE_file") || die "$RUNNABLE_file: $!\n"  if $opt_t;
 
120
print OUT_RA "# Number of Runnable tasks on all PEs $i\n"      if $opt_t;
 
121
open(OUT_BA, ">$BLOCKED_file") || die "$BLOCKED_file: $!\n"    if $opt_t;
 
122
print OUT_BA "# Number of Blocked tasks on all PEs $i\n"       if $opt_t;
 
123
open(OUT_FA, ">$FETCHING_file") || die "$FETCHING_file: $!\n"  if $opt_t;
 
124
print OUT_FA "# Number of Fetching tasks on all PEs $i\n"      if $opt_t;
 
125
 
 
126
($pname,$pars,$nPEs,$lat) = &skip_header(IN);
 
127
 
 
128
 
 
129
# Fill in the y_val table for all PEs
 
130
$offset = (&generate_y_val_table($nPEs)/2);
 
131
 
 
132
$x_min = 0;
 
133
$x_max = &get_x_max($input);
 
134
$y_max = $total_height;
 
135
#$y_max = $y_val[$nPEs-1] + offset;
 
136
 
 
137
$is_very_big = $x_max > $very_big;
 
138
 
 
139
# Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
 
140
$max_width = $offset;
 
141
 
 
142
# General init
 
143
do init($nPEs);
 
144
 
 
145
do write_prolog(OUT,$x_max,$y_max);
 
146
do write_prolog(OUT_MIG,$x_max,$y_max)  if $opt_M;
 
147
do write_prolog(OUT_SP,$x_max,$y_max)  if $opt_S;
 
148
# do write_prolog(OUT_B,$x_max,$y_max);
 
149
# do write_prolog(OUT_R,$x_max,$y_max);
 
150
 
 
151
while (<IN>) {
 
152
    next  if /^$/;                                # Omit empty lines;
 
153
    next  if /^--/;                               # Omit comment lines;
 
154
 
 
155
    ($event, $time, $id, $pe) = &get_line($_);
 
156
    $x_max_ = $time  if $time > $x_max_;
 
157
 
 
158
    print OUT_RA "TIME: $time  PEs: " . join(", ",@runnable) .
 
159
                 "  SUM: " . &list_sum(@runnable) . "\n"      if $opt_t;
 
160
    print OUT_BA "TIME: $time  PEs: " . join(", ",@blocked) .
 
161
                 "  SUM: " . &list_sum(@blocked) . "\n"       if $opt_t;
 
162
    print OUT_FA "TIME: $time  PEs: " . join(", ",@fetching) .
 
163
                 "  SUM: " . &list_sum(@fetching) . "\n"      if $opt_t;
 
164
 
 
165
    foo : {
 
166
        ($event eq "START") && do {
 
167
            # do draw_tic($pe, $time, $START);
 
168
            do draw_bg($pe, $time);
 
169
            $last_bg[$pe] = $time;
 
170
            $running[$pe] = $id;
 
171
            # $where{$id} = $pe + 1;
 
172
            last foo;
 
173
        };
 
174
        ($event eq "START(Q)") && do {
 
175
            #do draw_segment($pe, $time, $RUNNABLE);
 
176
            do draw_bg($pe, $time);
 
177
            $last_bg[$pe] = $time;
 
178
            #$last_runnable[$pe] = $time;
 
179
            $runnable[$pe]++;
 
180
            # $where{$id} = $pe + 1;
 
181
            last foo;
 
182
        };
 
183
        ($event eq "STEALING") && do {
 
184
            do draw_bg($pe, $time);
 
185
            $last_bg[$pe] = $time;
 
186
            $runnable[$pe]--;
 
187
            $where{$id} = $pe + 1;
 
188
            if ( $opt_M ) {
 
189
                $when{$id} = $time;
 
190
                do draw_tic($pe, $time, $event);
 
191
            }
 
192
            last foo;
 
193
        };
 
194
        ($event eq "STOLEN") && do {
 
195
            # do draw_tic($pe, $time, $START);
 
196
            do draw_bg($pe, $time);
 
197
            $last_bg[$pe] = $time;
 
198
            $running[$pe] = $id;
 
199
            if ( $where{$id} ) { 
 
200
                # Ok
 
201
            } else {
 
202
                $warn++;
 
203
                print "WARNING: No previous location for STOLEN task $id found!" .
 
204
                     " Check the gr file!\n";
 
205
            }
 
206
            if ( $opt_M ) {
 
207
                do draw_tic($pe, $time, $event);
 
208
                do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
 
209
            }
 
210
            last foo;
 
211
        };
 
212
        ($event eq "STOLEN(Q)") && do {
 
213
            #do draw_segment($pe, $time, $RUNNABLE);
 
214
            do draw_bg($pe, $time);
 
215
            $last_bg[$pe] = $time;
 
216
            #$last_runnable[$pe] = $time;
 
217
            $runnable[$pe]++;
 
218
            if ( $where{$id} ) { 
 
219
                # Ok
 
220
            } else {
 
221
                $warn++;
 
222
                print "WARNING: No previous location for STOLEN(Q) task $id found!" .
 
223
                    " Check the gr file!\n";
 
224
            }
 
225
            if ( $opt_M ) {
 
226
                do draw_tic($pe, $time, $event);
 
227
                do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
 
228
            }
 
229
            last foo;
 
230
        };
 
231
        ($event eq "BLOCK") && do {
 
232
            do draw_bg($pe, $time);
 
233
            $last_bg[$pe] = $time;
 
234
            do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
 
235
            $last_blocked[$pe] = $time;
 
236
            #do draw_segment($pe, $time, $RUNNING);
 
237
            $blocked[$pe]++;
 
238
            $running[$pe] = $NO_ID;
 
239
            last foo;
 
240
        };
 
241
        ($event eq "RESUME") && do {
 
242
            # do draw_tic($pe, $time, $START);
 
243
            do draw_bg($pe, $time);
 
244
            $last_bg[$pe] = $time;
 
245
            do draw_segment($pe, $time, $BLOCKED);
 
246
            $last_blocked[$pe] = $time;
 
247
            $blocked[$pe]--;
 
248
            $running[$pe] = $id;
 
249
            last foo;
 
250
        };
 
251
        ($event eq "RESUME(Q)") && do {
 
252
            #do draw_segment($pe, $time, $RUNNABLE);
 
253
            do draw_bg($pe, $time);
 
254
            $last_bg[$pe] = $time;
 
255
            do draw_segment($pe, $time, $BLOCKED);
 
256
            $last_blocked[$pe] = $time;
 
257
            #$last_runnable[$pe] = $time;
 
258
            $blocked[$pe]--;
 
259
            $runnable[$pe]++;
 
260
            last foo;
 
261
        };
 
262
        ($event eq "END") && do {
 
263
            # do draw_tic($pe, $time, $END);
 
264
            do draw_bg($pe, $time);
 
265
            $last_bg[$pe] = $time;
 
266
            $running[$pe] = $NO_ID;
 
267
            # do draw_segment($pe, $time, $RUNNING);
 
268
            # $last_blocked[$pe] = $time;
 
269
            last foo;
 
270
        };
 
271
        ($event eq "SCHEDULE") && do {
 
272
            # do draw_tic($pe, $time);
 
273
            $last_start[$pe] = $time;
 
274
            do draw_bg($pe, $time);
 
275
            $last_bg[$pe] = $time;
 
276
            $runnable[$pe]--;
 
277
            $running[$pe] = $id;
 
278
            last foo;
 
279
        };
 
280
        # NB: Check these; they are not yet tested
 
281
        ($event eq "FETCH") && do {
 
282
            # Similar to BLOCK; but don't draw a block segment
 
283
            do draw_bg($pe, $time);
 
284
            $last_bg[$pe] = $time;
 
285
            #do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
 
286
            #$last_blocked[$pe] = $time;
 
287
            #$blocked[$pe]++;
 
288
            $fetching[$pe]++;
 
289
            $running[$pe] = $NO_ID;
 
290
            last foo;
 
291
        };
 
292
        ($event eq "REPLY") && do {
 
293
            do draw_bg($pe, $time);
 
294
            $last_bg[$pe] = $time;
 
295
            #do draw_segment($pe, $time, $BLOCKED);
 
296
            #$last_blocked[$pe] = $time;
 
297
            #$blocked[$pe]--;
 
298
            $fetching[$pe]--;
 
299
            $blocked[$pe]++;
 
300
            last foo;
 
301
        };
 
302
        # These are only processed if a spark pofile is generated, too
 
303
        (($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
 
304
            if ( !opt_S ) {
 
305
                $spark_events++;
 
306
                last foo;
 
307
            }
 
308
            do draw_sp_bg($pe, $time);
 
309
            $last_sp_bg[$pe] = $time;
 
310
            $sparks[$pe]++;
 
311
            last foo;
 
312
        };
 
313
 
 
314
        (($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
 
315
            if ( !opt_S ) {
 
316
                $spark_events++;
 
317
                last foo;
 
318
            }
 
319
            do draw_sp_bg($pe, $time);
 
320
            $last_sp_bg[$pe] = $time;
 
321
            $sparks[$pe]--;
 
322
            if ( $sparks[$pe]<0 ) {
 
323
                print STDERR "Error: Neg. number of sparks @ $time\n";
 
324
            }
 
325
            last foo;
 
326
        };
 
327
 
 
328
        $warn++;
 
329
        print "WARNING: Unknown event: $event\n";
 
330
    }
 
331
    do check_consistency()  if $opt_M;
 
332
}
 
333
 
 
334
do write_epilog(OUT,$x_max,$y_max);
 
335
do write_epilog(OUT_MIG,$x_max,$y_max)   if $opt_M;
 
336
do write_epilog(OUT_SP,$x_max,$y_max)    if $opt_S;
 
337
# do write_epilog(OUT_B,$x_max,$y_max);
 
338
# do write_epilog(OUT_R,$x_max,$y_max);
 
339
 
 
340
close(IN);
 
341
close(OUT);
 
342
# close(OUT_B);
 
343
# close(OUT_R);
 
344
 
 
345
close(OUT_MIG) if $opt_M;
 
346
close(OUT_SP)  if $opt_S;
 
347
close(OUT_BA)  if $opt_t;
 
348
close(OUT_RA)  if $opt_t;
 
349
close(OUT_FA)  if $opt_t;
 
350
 
 
351
#for ($i=0; $i<$nPEs; $i++) {
 
352
#    close($OUT_BA[$i]);
 
353
#    close($OUT_RA[$i]);
 
354
#}
 
355
 
 
356
if ($x_max != $x_max_ ) {
 
357
    print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
 
358
}
 
359
 
 
360
print "Number of suppressed warnings: $warn\n"  if $warn>0;
 
361
print "FYI: The file $input contains $spark_events lines of spark information\n"  if !opt_S && ($spark_events>0);
 
362
 
 
363
system "gzip -f1 $RUNNABLE_file"  if $opt_t;
 
364
system "gzip -f1 $BLOCKED_file"   if $opt_t;
 
365
system "gzip -f1 $FETCHING_file"  if $opt_t;
 
366
 
 
367
system "fortune -s"  if $opt_v;
 
368
 
 
369
exit 0;
 
370
 
 
371
# ----------------------------------------------------------------------------
 
372
# This translation is mainly taken from gr2qp.awk
 
373
# This subroutine returns the event found on the current line together with
 
374
# the relevant information for that event. The possible EVENTS are:
 
375
#  START, STARTQ, STOLEN, BLOCK, RESUME, RESUMEQ, END, SCHEDULE
 
376
# ----------------------------------------------------------------------------
 
377
 
 
378
sub get_line {
 
379
  local ($line) = @_;
 
380
  local ($f, @fs);
 
381
  local ($event, $time, $id, $pe);
 
382
 
 
383
  @fs = split(/[:\[\]\s]+/,$line);
 
384
  $event = $fs[3];
 
385
  $time = $fs[2];
 
386
  $id = $fs[4];
 
387
  $pe = $fs[1];
 
388
 
 
389
  print OUT "% > " . $_   if $opt_D;
 
390
  print OUT "%   EVENT = $event; TIME = $time; ID = $id; PE = $pe\n" if $opt_D;
 
391
  print OUT "%   --> this task comes from PE " . ($where{$id}-1) . "\n"  if $opt_D && $event eq "STOLEN";
 
392
 
 
393
  return ($event, $time, $id, $pe);
 
394
 
 
395
  # if ($fs[3] eq "START") { 
 
396
  #     partprofile = 0; 
 
397
  #     print (substr($3,2,length($3)-3))," *G 0 0x" $5; 
 
398
  # }
 
399
  # if ($fs[3] eq "START(Q)") { 
 
400
  #     print (substr($3,2,length($3)-3))," *A 0 0x" $5; 
 
401
  # }
 
402
 
 
403
 #  if ($fs[3] eq "STOLEN")    { 
 
404
  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
 
405
  # }
 
406
 
 
407
 #  if ($fs[3] eq "BLOCK")     { 
 
408
  #     print (substr($3,2,length($3)-3))," GR 0 0x" $5; 
 
409
  # }
 
410
  # if ($fs[3] eq "RESUME")    { 
 
411
  #     print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0"; 
 
412
  # }
 
413
  # if ($fs[3] eq "RESUME(Q)") { 
 
414
  #     print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0"; 
 
415
  # }
 
416
  # if ($fs[3] eq "END")       { 
 
417
  #   if (partprofile) {
 
418
  #     p rint (substr($9,1,length($9)-1))," *G 0 0x" (substr($5,1,length($5)-1));
 
419
  #     p rint (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
 
420
  #   } else {
 
421
  #       print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1)); 
 
422
  #   }
 
423
  # }
 
424
  # if ($fs[3] eq "SCHEDULE")  { 
 
425
  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
 
426
  # }
 
427
 
 
428
}
 
429
 
 
430
# ----------------------------------------------------------------------------
 
431
 
 
432
sub check_consistency {
 
433
    local ($i);
 
434
 
 
435
    for ($i=0; $i<$nPEs; $i++) {
 
436
        if ( $runnable[$i] < 0 ) {
 
437
            print "INCONSISTENCY: PE $i: Size of runnable queue: $runnable[$i] at time $time\n";
 
438
            $runnable[$i] = 0 ;
 
439
        }
 
440
        if  ( $blocked[$i] < 0 ) {
 
441
            print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
 
442
            $blocked[$i] = 0 ;
 
443
        }
 
444
    }
 
445
}
 
446
 
 
447
# ----------------------------------------------------------------------------
 
448
 
 
449
sub get_width {
 
450
    local ($n, $type) = @_;
 
451
 
 
452
    $warn++   if $n <0;
 
453
    print "WARNING: Neg. number of tasks in $type queue: $n!!\n"  if $n <0;
 
454
    $n = 0  if $n <0;
 
455
    return ( ($type eq $RUNNING) ? ($running_width * $width_unit) : 
 
456
            &min($max_width, $n * $width_unit) );
 
457
}
 
458
 
 
459
# ----------------------------------------------------------------------------
 
460
# Use an intensity between 0 (empty runnable queue) and 1 (`full' runnable
 
461
# queue) to abstract from monchrome/color values
 
462
# The concrete grayshade/color is computed via PS macros.
 
463
# ----------------------------------------------------------------------------
 
464
 
 
465
sub get_intensity {
 
466
    local ($n) = @_;
 
467
 
 
468
    print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n"  if $n<0;
 
469
 
 
470
    if ($n >= $inf_block) {
 
471
        return 1.0;
 
472
    } else {
 
473
        return ($n+1)/$inf_block;
 
474
    }
 
475
}
 
476
 
 
477
# ----------------------------------------------------------------------------
 
478
 
 
479
sub get_sp_intensity {
 
480
    local ($n) = @_;
 
481
 
 
482
    print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n"  if $n<0;
 
483
 
 
484
    if ($n >= $inf_block) {
 
485
        return 1.0;
 
486
    } else {
 
487
        return ($n+1)/$inf_block;
 
488
    }
 
489
}
 
490
 
 
491
# ----------------------------------------------------------------------------
 
492
 
 
493
sub get_shade {
 
494
    local ($n) = @_;
 
495
 
 
496
 
 
497
    if ($n > $inf_block) {
 
498
        return 0.2;
 
499
    } else {
 
500
        return 0.8 - ($n/$inf_block);
 
501
    }
 
502
}
 
503
 
 
504
# ----------------------------------------------------------------------------
 
505
 
 
506
sub max { 
 
507
    local($x, $y) = @_;
 
508
 
 
509
    return ($x>$y ? $x : $y);
 
510
}
 
511
 
 
512
# ----------------------------------------------------------------------------
 
513
 
 
514
sub min { 
 
515
    local($x, $y) = @_;
 
516
 
 
517
    return ($x<$y ? $x : $y);
 
518
}
 
519
 
 
520
# ----------------------------------------------------------------------------
 
521
 
 
522
sub list_sum {
 
523
    local (@list) = @_;
 
524
 
 
525
    local ($sum);
 
526
 
 
527
    foreach $x (@list) {
 
528
        $sum += $x;
 
529
    }
 
530
 
 
531
    return ($sum);
 
532
}
 
533
 
 
534
# ----------------------------------------------------------------------------
 
535
# Drawing functions.
 
536
# Put on top of funtions that directly generate PostScript.
 
537
# ----------------------------------------------------------------------------
 
538
 
 
539
sub draw_segment {
 
540
    local ($pe, $time, $type) = @_;
 
541
    local ($x, $y, $width, $gray);
 
542
 
 
543
    if ( $type eq $BLOCKED ) {
 
544
        if ( $last_blocked[$pe] == $NO_LAST_BLOCKED ) { return; };
 
545
        $width = &get_width($blocked[$pe], $type);
 
546
        if ( $width  == 0 ) { return; };
 
547
        $y = $stripes_low[$pe] + int($width/2 + 0.5);
 
548
        $x = $last_blocked[$pe]; 
 
549
 
 
550
        if ( $is_very_big ) {   
 
551
            $x = int($x/$shrink_x) + 1;   # rounded up
 
552
        }
 
553
 
 
554
        #  $gray = 0.5;  # Ignoring gray level; doesn't change!
 
555
        do ps_draw_hline(OUT,$x,$y,$time,$width);   
 
556
    } else {
 
557
        die "ERROR: Unknow type of line: $type in draw segment\n";
 
558
    }
 
559
 
 
560
    if ($x < 0 || $y<0) {
 
561
        die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
 
562
    }
 
563
    if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
 
564
        die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
 
565
    }
 
566
}
 
567
 
 
568
# ----------------------------------------------------------------------------
 
569
 
 
570
sub draw_tic {
 
571
    local ($pe, $time, $event) = @_;
 
572
    local ($x, $y, $lit);
 
573
 
 
574
    $ystart = $stripes_low[$pe];
 
575
    $yend = $stripes_high[$pe];
 
576
    $x = $time;
 
577
    if ( $event eq "STEALING" ) {
 
578
        $lit = 0;  # i.e. FROM
 
579
    } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
 
580
        $lit = 1;  # i.e. TO
 
581
    } else {
 
582
        die "ERROR: Wrong event $event in draw_tic\n";
 
583
    }
 
584
 
 
585
    if ( $is_very_big ) {       
 
586
        $x = int($x/$shrink_x) + 1;   # rounded up
 
587
    }
 
588
 
 
589
    if ($x < 0 || $ystart<0 || $yend<0) {
 
590
        die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
 
591
    }
 
592
    do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
 
593
}
 
594
 
 
595
# ----------------------------------------------------------------------------
 
596
 
 
597
sub draw_bg {
 
598
    local ($pe,$time) = @_;
 
599
    local ($x_start, $x_end, $intensity, $secondary_intensity);
 
600
 
 
601
    if ( $last_bg[$pe] == $NO_LAST_BG ) { 
 
602
        print OUT "% Omitting BG: NO LAST BG\n" if $opt_D; 
 
603
        return; 
 
604
    }
 
605
    if ( $running[$pe] == $NO_ID ) { 
 
606
        print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D; 
 
607
        # return;
 
608
    }
 
609
    $x_start = $last_bg[$pe];  
 
610
    $x_end = $time;
 
611
    $intensity = ( $running[$pe] == $NO_ID ? 
 
612
                      0 : 
 
613
                      &get_intensity($runnable[$pe]) );
 
614
    $secondary_intensity = ( $running[$pe] == $NO_ID ? 
 
615
                                0 : 
 
616
                                &get_intensity($fetching[$pe]) );
 
617
    do ps_draw_bg(OUT,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
 
618
                  $intensity,$secondary_intensity);
 
619
 
 
620
    if ( $opt_M ) {
 
621
        do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end, 
 
622
                         $mig_width);
 
623
    }
 
624
    
 
625
}
 
626
 
 
627
# ----------------------------------------------------------------------------
 
628
# Variant of draw_bg; used for spark profile
 
629
# ----------------------------------------------------------------------------
 
630
 
 
631
sub draw_sp_bg {
 
632
    local ($pe,$time) = @_;
 
633
    local ($x_start, $x_end, $intensity, $secondary_intensity);
 
634
 
 
635
    if ( $last_sp_bg[$pe] == $NO_LAST_BG ) { 
 
636
        print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D; 
 
637
        return; 
 
638
    }
 
639
    $x_start = $last_sp_bg[$pe];  
 
640
    $x_end = $time;
 
641
    $intensity = ( $sparks[$pe] <= 0 ? 
 
642
                      0 : 
 
643
                      &get_sp_intensity($sparks[$pe]) );
 
644
    $secondary_intensity = 0; 
 
645
    do ps_draw_bg(OUT_SP,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
 
646
                  $intensity,$secondary_intensity);
 
647
 
 
648
}
 
649
 
 
650
# ----------------------------------------------------------------------------
 
651
 
 
652
sub draw_arrow {
 
653
    local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
 
654
    local ($ystart,$yend);
 
655
    
 
656
    $ystart = $stripes_high[$from_pe];
 
657
    $yend = $stripes_low[$to_pe];
 
658
    do ps_draw_arrow(OUT_MIG,$send_time,$arrive_time,$ystart,$yend);
 
659
}
 
660
 
 
661
# ----------------------------------------------------------------------------
 
662
# Normalize the x value s.t. it fits onto the page without scaling.
 
663
# The global values $left_border and $right_border and $total_width 
 
664
# determine the borders
 
665
# of the graph. 
 
666
# This fct is only called from within ps_... fcts. Before that the $x values
 
667
# are always times.
 
668
# ----------------------------------------------------------------------------
 
669
 
 
670
sub normalize {
 
671
    local ($x) = @_;
 
672
 
 
673
    return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
 
674
}
 
675
 
 
676
# ----------------------------------------------------------------------------
 
677
# PostScript generation functions.
 
678
# Lowest level of writing output file.
 
679
# Now there is only normalizing mode supported. 
 
680
# The following is out of date:
 
681
# $mode can be $LITERATE i.e. assuming scaling has been done
 
682
#           or $NORMALIZING i.e. no scaling has been done so far (do it in
 
683
#                                macros for drawing)
 
684
# ----------------------------------------------------------------------------
 
685
 
 
686
sub ps_draw_hline {
 
687
    local ($OUT,$xstart,$y,$xend,$width) = @_;
 
688
    local ($xlen); 
 
689
 
 
690
    print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D; 
 
691
 
 
692
    if ( ! $opt_N ) {
 
693
        $xstart = &normalize($xstart);
 
694
        $xend = &normalize($xend);
 
695
    }
 
696
 
 
697
    $xlen = $xend - $xstart;
 
698
 
 
699
    printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
 
700
    #           ( $mode == $LITERATE ? " L\n" : " N\n");
 
701
 
 
702
    # Old version:
 
703
    # print $OUT "newpath\n";
 
704
    # print $OUT "$GRAY{$type} setgray\n";
 
705
    # print $OUT $xend . "  " . $y . " " . $xstart . " " . $y . " " . $width . 
 
706
    #    " line\n";
 
707
    # print $OUT "stroke\n";
 
708
}
 
709
 
 
710
# ----------------------------------------------------------------------------
 
711
 
 
712
sub ps_draw_vline {
 
713
    local ($OUT,$x,$ystart,$yend,$width) = @_;
 
714
 
 
715
    print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D; 
 
716
 
 
717
    if ( ! $opt_N ) {
 
718
        $x = &normalize($x);
 
719
    }
 
720
 
 
721
    print $OUT "newpath\n";
 
722
    print $OUT "0 setgray\n";                             # constant gray level
 
723
    printf $OUT ("%d %d %d %d %.1g line\n",
 
724
                 $x,$yend ,$x,$ystart,$width);
 
725
    print $OUT "stroke\n";
 
726
}
 
727
 
 
728
# ----------------------------------------------------------------------------
 
729
 
 
730
sub ps_draw_tic {
 
731
    local ($OUT,$x,$ystart,$yend,$lit) = @_;
 
732
 
 
733
    print $OUT "% TIC at ($x,$ystart-$yend)\n"   if $opt_D;
 
734
 
 
735
    if ( ! $opt_N ) {
 
736
        $x = &normalize($x);
 
737
    }
 
738
 
 
739
    printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);
 
740
 
 
741
    # Old version without PostScript macro /tic:
 
742
    # print $OUT "newpath\n";
 
743
    # print $OUT "ticwidth setlinewidth\n" .
 
744
    #         $x . " " . $y . " ticlen sub moveto\n" .
 
745
    #         $x . " " . $y . " ticlen add lineto\n";
 
746
    #print $OUT "stroke\n";
 
747
}
 
748
 
 
749
# ----------------------------------------------------------------------------
 
750
 
 
751
sub ps_draw_arrow {
 
752
    local ($OUT,$xstart,$xend,$ystart,$yend) = @_;
 
753
 
 
754
    print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n"   if $opt_D;
 
755
 
 
756
    if ( ! $opt_N ) {
 
757
        $xstart = &normalize($xstart);
 
758
        $xend = &normalize($xend);
 
759
    }
 
760
 
 
761
    printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
 
762
}
 
763
 
 
764
# ----------------------------------------------------------------------------
 
765
 
 
766
sub ps_draw_bg {
 
767
    local ($OUT,$xstart, $xend, $ystart, $yend, 
 
768
           $intensity, $secondary_intensity) = @_;
 
769
    local ($xlen, $ylen);
 
770
 
 
771
    print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
 
772
               "  (intensity: $intensity, $secondary_intensity)\n"  if $opt_D;
 
773
 
 
774
    if ( ! $opt_N ) {
 
775
        $xstart = &normalize($xstart);
 
776
        $xend = &normalize($xend);
 
777
    }
 
778
 
 
779
    $xlen = $xend - $xstart;
 
780
    $ylen = $yend - $ystart;
 
781
 
 
782
    printf $OUT ("%d %d %d %d %.2g %.2g R\n",
 
783
                 $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);
 
784
 
 
785
    # Old version without PostScript macro /rect:
 
786
    #print $OUT "newpath\n";
 
787
    #print $OUT " $x_start $y_start moveto\n";
 
788
    #print $OUT " $x_end $y_start lineto\n";
 
789
    #print $OUT " $x_end $y_end lineto\n";
 
790
    #print $OUT " $x_start $y_end lineto\n";
 
791
    #print $OUT "closepath\n";
 
792
    #print $OUT "$gray setgray\n";
 
793
    #print $OUT "fill\n";
 
794
}
 
795
 
 
796
# ----------------------------------------------------------------------------
 
797
# Initialization and such
 
798
# ----------------------------------------------------------------------------
 
799
 
 
800
sub write_prolog {
 
801
    local ($OUT, $x_max, $y_max) = @_;
 
802
    local ($date, $dist, $y, $i);
 
803
 
 
804
    $date = &get_date();
 
805
 
 
806
    if ( $opt_N ) {
 
807
      $x_scale = $total_width/$x_max;
 
808
      $y_scale = $total_height/$y_max;
 
809
    }
 
810
 
 
811
    # $tic_width = 2 * $x_max/$total_width;    constant now
 
812
    # $tic_len = 4 * $y_max/$total_height;
 
813
 
 
814
    print $OUT "%!PS-Adobe-2.0\n";
 
815
    print $OUT "%%BoundingBox:   \t0 0 560 800\n";
 
816
    print $OUT "%%Title: \t$pname  $pars\n";
 
817
    print $OUT "%%Creator: \tgr2pe\n";
 
818
    print $OUT "%%CreationDate: \t$date\n";
 
819
    # print $OUT "%%Orientation: \tSeascape\n";
 
820
    print $OUT "%%EndComments\n";
 
821
 
 
822
    # print $OUT "%%BeginSetup\n";
 
823
    # print $OUT "%%PageOrientation: \tSeascape\n";
 
824
    # print $OUT "%%EndSetup\n";
 
825
 
 
826
    print $OUT "%/runlineto {1.5 setlinewidth lineto} def\n";
 
827
    print $OUT "%/suspendlineto {0.5 setlinewidth lineto} def\n";
 
828
    print $OUT "%/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n";
 
829
    print $OUT "%/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n";
 
830
    print $OUT "\n";
 
831
    print $OUT "/total-len $x_max def\n";
 
832
    print $OUT "/show-len $total_width def\n";
 
833
    print $OUT "/normalize { show-len mul total-len div } def\n";
 
834
    print $OUT "/x-normalize { exch show-len mul total-len div exch } def\n";
 
835
    print $OUT "/str-len 12 def\n";
 
836
    #print $OUT "/prt-n { str-len string cvs show } def" .
 
837
    #          "     % print top-of-stack integer\n";
 
838
    print $OUT "/prt-n { cvi str-len string cvs \n" .
 
839
               "         dup stringwidth pop \n" .
 
840
               "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
 
841
               "         neg 0 rmoveto \n" . 
 
842
               "         show  } def \n" .
 
843
               "        % print top-of-stack integer centered at the current point\n";
 
844
    print $OUT "/ticwidth $tic_width def\n";
 
845
    print $OUT "%/ticlen $tic_len def     % actually half of the tic-length\n";
 
846
    print $OUT "/T    % Draw a tic mark\n" .
 
847
               " {    % Operands: x, y-start, y-end of tic, from/to flag \n" .
 
848
               "   newpath\n" .
 
849
               "   0 eq { " . ( $opt_m ? " 0.2 setgray }" 
 
850
                                       : " 0 0.7 0.2 setrgbcolor }" ) .
 
851
               "        { " . ( $opt_m ? " 0.8 setgray }" 
 
852
                                       : " 0.7 0 0.2 setrgbcolor }" ) . " ifelse\n" .
 
853
               "   ticwidth setlinewidth\n" .
 
854
               "   3 copy pop moveto\n" .
 
855
               "   exch pop lineto\n" .
 
856
               "   stroke\n" .
 
857
               " } def\n";
 
858
    #          "   3 copy pop x-normalize moveto\n" .
 
859
    #          "   exch pop x-normalize lineto\n" .
 
860
    #          "   stroke\n" .
 
861
    #          " } def\n";
 
862
    print $OUT "/blocked-gray 0 def\n";
 
863
    print $OUT "/idle-gray 1 def\n";
 
864
    print $OUT "/blocked-color { 0.2 0.1 0.8 } def\n";
 
865
    print $OUT "/idle-color { 0.8 0.1 0.2 } def\n";
 
866
    print $OUT "/idle-color-fetch { 0.5 0.6 0.4 } def\n";
 
867
    print $OUT "/L              % Draw a line (for blocked tasks)\n" .
 
868
               " {              % Operands: (x,y)-start xlen width\n" .
 
869
               "  newpath \n" .
 
870
               ( $opt_m ? "  blocked-gray setgray\n" : 
 
871
                          "  blocked-color setrgbcolor\n") .
 
872
               "         setlinewidth 3 copy pop moveto 0 rlineto pop pop stroke} def\n";
 
873
    print $OUT "/N              % Draw a normalized line\n" .
 
874
               " {              % Operands: (x,y)-start xlen width\n" .
 
875
               "  newpath \n" .
 
876
               ( $opt_m ? "  blocked-gray setgray\n" : 
 
877
                          "  blocked-color setrgbcolor\n") .
 
878
               "         setlinewidth 3 copy pop x-normalize moveto normalize 0 rlineto pop pop stroke} def\n";
 
879
    print $OUT "% /L line def\n";
 
880
    print $OUT "/printText { 0 0 moveto (GrAnSim) show } def\n";
 
881
    if ( $opt_m ) {
 
882
        print $OUT "/logo { gsave \n" .
 
883
                   "        translate \n" .
 
884
                   "        .95 -.05 0  " .
 
885
                   "          { setgray printText 1 -.5 translate } for \n" .
 
886
                   "        1 setgray printText\n" . 
 
887
                   "        grestore } def\n";
 
888
    } else {
 
889
        print $OUT "/logo { gsave \n" .
 
890
              "        translate \n" .
 
891
              "        .95 -.05 0\n" .
 
892
              "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
 
893
              "        1 0 0 setrgbcolor printText\n" . 
 
894
              "        grestore} def\n";
 
895
    }
 
896
 
 
897
    print $OUT "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
 
898
    print $OUT  "/starside \n" .
 
899
                " {starlen 0 lineto currentpoint translate \n" .
 
900
                "    -144 rotate } def\n";
 
901
 
 
902
   print $OUT  "/star \n" .
 
903
               " { moveto \n" .
 
904
               "   currentpoint translate \n" .
 
905
               "   4 {starside} repeat \n" .
 
906
               "   closepath \n" .
 
907
               "   gsave \n" .
 
908
               "   .7 setgray fill \n" .
 
909
               "   grestore \n" .
 
910
               "   % stroke  \n" .
 
911
               "  } def \n";
 
912
    #print $OUT "/get-shade   % compute shade from intensity\n" .
 
913
    #              " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
 
914
    if ( $opt_m ) { 
 
915
        print $OUT "/from 0.2 def\n";
 
916
        print $OUT "/to 0.8 def\n";
 
917
        print $OUT "/get-shade   % compute shade from intensity\n" .
 
918
                   "  { pop dup 0 eq { pop idle-gray }\n " .
 
919
                   "                 { 1 exch sub to from sub mul from add } ifelse } def\n";
 
920
                   " { pop 1 exch sub to from sub mul from add } def\n";
 
921
    } else {
 
922
        print $OUT "/from 0.5 def\n";
 
923
        print $OUT "/to 0.9 def\n";
 
924
    }
 
925
    print $OUT "/epsilon 0.01 def\n";
 
926
    print $OUT "/from-blue 0.7 def\n";
 
927
    print $OUT "/to-blue   0.95 def\n";
 
928
    print $OUT "/m 1 def\n";
 
929
    print $OUT "/magnify { m mul dup 1 gt { pop 1 } if } def\n";
 
930
    print $OUT "%\n" .
 
931
               "% show no. of runnable threads and the current degree of fetching\n" .
 
932
               "%\n" .
 
933
               "/get-color        % compute color from intensity\n" .
 
934
               " { 4 mul dup      % give more weight to second intensity\n" .
 
935
               "   0 eq { pop 0 exch } \n" .
 
936
               "        { from-blue to-blue sub mul from-blue add dup \n" .
 
937
               "          1 gt { pop 1 } if  exch } ifelse \n" .
 
938
               "   dup 0 eq { pop pop idle-color }\n" .
 
939
               "            { 1 exch sub to from sub mul from add        % green val is top of stack\n" .
 
940
               "              exch 0 3 1 roll  } ifelse } def\n"; 
 
941
 
 
942
    print $OUT "%\n";
 
943
    print $OUT "% show no. of runable threads only\n";
 
944
    print $OUT "%\n";
 
945
    print $OUT "/get-color-runnable                     % compute color from intensity\n";
 
946
    print $OUT "{ pop dup 0 eq { pop idle-color }\n";
 
947
    print $OUT "               { 1 exch sub to from sub mul from add   % green val is top of stack\n";
 
948
    print $OUT "                 0.2 0 3 1 roll  } ifelse } def\n";
 
949
 
 
950
    print $OUT "%\n";
 
951
    print $OUT "% show no. of fetching threads only\n";
 
952
    print $OUT "%\n";
 
953
    print $OUT "/get-color-fetch                        % compute color from intensity\n";
 
954
    print $OUT "{ exch pop dup 0 eq { pop idle-color-fetch }\n";
 
955
    print $OUT "                    { 1 exch sub to from sub mul from add   % blue val is top of stack\n";
 
956
    print $OUT "                      0.2 0.6 3 2 roll  } ifelse } def\n";
 
957
 
 
958
    #print $OUT "/get-color    % compute color from intensity\n" .
 
959
    #           " { dup 0 eq { pop idle-color }\n" .
 
960
    #           "            { 1 exch sub to from sub mul from add 0 exch 0 } ifelse } def\n"; 
 
961
    #          " { dup 0.4 le { 0.4 exch sub 0.2 add 2 mul 0 0 setrgbcolor} " .
 
962
    #          "              { 1 exch sub 0.4 add 0 exch 0 setrgbcolor} ifelse \n" .
 
963
    print $OUT "/R          % Draw a rectangle \n" .
 
964
               " {             % Operands: x y xlen ylen i j \n" .
 
965
               "               %    (x,y) left lower start point of rectangle\n" .
 
966
               "               %    xlen  length of rec in x direction\n" .
 
967
               "               %    ylen  length of rec in y direction\n" .
 
968
               "               %    i     intensity of rectangle [0,1] \n" .
 
969
               "               %    j     intensity blue to indicate fetching\n" .
 
970
               "               %          (ignored in mono mode)\n" .
 
971
               ( $opt_m ? "  get-shade setgray\n" 
 
972
                        : "  get-color-runnable setrgbcolor\n" ) .
 
973
               "  newpath\n" .
 
974
               "  4 copy pop pop moveto\n" .
 
975
               "  1 index  0 rlineto\n" .
 
976
               "  0 index  0 exch rlineto\n" .
 
977
               "  1 index  neg 0 rlineto\n" .
 
978
               "  0 index  neg 0 exch rlineto\n" .
 
979
               "  pop pop pop pop\n" .
 
980
               "  closepath\n" .
 
981
               "  fill             % Note: No stroke => no border\n" .
 
982
               " } def\n";
 
983
    print $OUT "% /R rect def\n";
 
984
    print $OUT "%/A         % Draw an arrow (for migration graph)\n" .
 
985
               "% {         % Operands: x y x' y' \n" .
 
986
               "%           %  (x,y)    start point \n" .
 
987
               "%           %  (x',y')  end point \n" .
 
988
               ( $opt_m ? "%    0 setgray\n" : "%     0 0 0 setrgbcolor\n" ) .
 
989
               "%  1 setlinewidth\n" .
 
990
               "%  newpath 4 2 roll x-normalize moveto x-normalize lineto stroke } def\n";
 
991
 
 
992
    print $OUT "/A         % No arrows \n" .
 
993
               " { pop pop pop pop } def\n";
 
994
    print $OUT "-90 rotate\n";
 
995
    
 
996
    print $OUT "-785 30 translate\n";
 
997
    print $OUT "/HE10 /Helvetica findfont 10 scalefont def\n";
 
998
    print $OUT "/HE12 /Helvetica findfont 12 scalefont def\n";
 
999
    print $OUT "/HE14 /Helvetica findfont 14 scalefont def\n";
 
1000
    print $OUT "/TI16 /Times-Italic findfont 16 scalefont def\n";
 
1001
    print $OUT "/HB16 /Helvetica-Bold findfont 16 scalefont def\n";
 
1002
    print $OUT "% " . "-" x 77 . "\n";
 
1003
 
 
1004
    print $OUT "newpath\n";
 
1005
    print $OUT "0 8.000000 moveto\n";
 
1006
    print $OUT "0 525.000000 760.000000 525.000000 8.000000 arcto\n";
 
1007
    print $OUT "4 {pop} repeat\n";
 
1008
    print $OUT "760.000000 525.000000 760.000000 0 8.000000 arcto\n";
 
1009
    print $OUT "4 {pop} repeat\n";
 
1010
    print $OUT "760.000000 0 0 0 8.000000 arcto\n";
 
1011
    print $OUT "4 {pop} repeat\n";
 
1012
    print $OUT "0 0 0 525.000000 8.000000 arcto\n";
 
1013
    print $OUT "4 {pop} repeat\n";
 
1014
    print $OUT "0.500000 setlinewidth\n";
 
1015
    print $OUT "stroke\n";
 
1016
    print $OUT "newpath\n";
 
1017
    print $OUT "4.000000 505.000000 moveto\n";
 
1018
    print $OUT "4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n";
 
1019
    print $OUT "4 {pop} repeat\n";
 
1020
    print $OUT "752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n";
 
1021
    print $OUT "4 {pop} repeat\n";
 
1022
    print $OUT "752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n";
 
1023
    print $OUT "4 {pop} repeat\n";
 
1024
    print $OUT "4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n";
 
1025
    print $OUT "4 {pop} repeat\n";
 
1026
    print $OUT "0.500000 setlinewidth\n";
 
1027
    print $OUT "stroke\n";
 
1028
    
 
1029
    print $OUT "% ----------------------------------------------------------\n";
 
1030
    print $OUT "% Print pallet\n";
 
1031
    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
 
1032
    print $OUT "%       end values in /get-color\n";
 
1033
    print $OUT "gsave \n";
 
1034
    print $OUT "340 508 translate\n";
 
1035
    print $OUT "0.0 0.05 1.00 \n";
 
1036
    print $OUT " { \n";
 
1037
    print $OUT "  dup dup \n";
 
1038
    print $OUT "    from epsilon sub gt exch \n";
 
1039
    print $OUT "    from epsilon add lt \n";
 
1040
    print $OUT "   and\n";
 
1041
    print $OUT "    { newpath " .
 
1042
               ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
 
1043
               "0 0 moveto 0 -3 rlineto stroke } if\n";
 
1044
    print $OUT "  dup dup \n";
 
1045
    print $OUT "    to epsilon 2 mul sub gt exch \n";
 
1046
    print $OUT "    to epsilon 2 mul add lt \n";
 
1047
    print $OUT "   and\n";
 
1048
    print $OUT "    { newpath " . 
 
1049
               ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
 
1050
               "10 0 moveto 0 -3 rlineto stroke } if\n";
 
1051
    print $OUT ($opt_m ? " setgray\n" : "  0 exch 0 setrgbcolor\n");
 
1052
    print $OUT "  newpath\n";
 
1053
    print $OUT "  0 0 moveto\n";
 
1054
    print $OUT "  10 0 rlineto\n";
 
1055
    print $OUT "  0 10  rlineto\n";
 
1056
    print $OUT "  -10 0 rlineto\n";
 
1057
    print $OUT "  closepath\n";
 
1058
    print $OUT "  fill\n";
 
1059
    print $OUT "  10 0 translate \n";
 
1060
    print $OUT " } for\n";
 
1061
    print $OUT "grestore\n";
 
1062
 
 
1063
    print $OUT "% Print pallet for showing fetch\n";
 
1064
    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
 
1065
    print $OUT "%       end values in /get-color\n";
 
1066
    print $OUT "%gsave \n";
 
1067
    print $OUT "%340 508 translate\n";
 
1068
    print $OUT "%0.0 0.05 1.00 \n";
 
1069
    print $OUT "%{ \n";
 
1070
    print $OUT "%  dup dup \n";
 
1071
    print $OUT "%    from epsilon sub gt exch \n";
 
1072
    print $OUT "%    from epsilon add lt \n";
 
1073
    print $OUT "%   and\n";
 
1074
    print $OUT "%   { newpath 0 0 0 setrgbcolor 0 0 moveto 0 -3 rlineto stroke } if\n";
 
1075
    print $OUT "%  dup dup \n";
 
1076
    print $OUT "%    to epsilon 2 mul sub gt exch \n";
 
1077
    print $OUT "%    to epsilon 2 mul add lt \n";
 
1078
    print $OUT "%   and\n";
 
1079
    print $OUT "%   { newpath 0 0 0 setrgbcolor 10 0 moveto 0 -3 rlineto stroke } if\n";
 
1080
    print $OUT "%  0.2 exch 0.6 exch setrgbcolor   \n";
 
1081
    print $OUT "%  newpath\n";
 
1082
    print $OUT "%  0 0 moveto\n";
 
1083
    print $OUT "%  10 0 rlineto\n";
 
1084
    print $OUT "%  0 10  rlineto\n";
 
1085
    print $OUT "%  -10 0 rlineto\n";
 
1086
    print $OUT "%  closepath\n";
 
1087
    print $OUT "%  fill\n";
 
1088
    print $OUT "%  10 0 translate \n";
 
1089
    print $OUT "% } for\n";
 
1090
    print $OUT "% grestore\n";
 
1091
 
 
1092
    print $OUT "% Print double pallet\n";
 
1093
    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
 
1094
    print $OUT "%       end values in /get-color\n";
 
1095
    print $OUT "% gsave \n";
 
1096
    print $OUT "% 340 500 translate\n";
 
1097
    print $OUT "% 0.0 0.05 1.00 \n";
 
1098
    print $OUT "% { \n";
 
1099
    print $OUT "%   0 exch 0 setrgbcolor   \n";
 
1100
    print $OUT "%   newpath\n";
 
1101
    print $OUT "%   0 0 moveto\n";
 
1102
    print $OUT "%   10 0 rlineto\n";
 
1103
    print $OUT "%   0 10  rlineto\n";
 
1104
    print $OUT "%   -10 0 rlineto\n";
 
1105
    print $OUT "%   closepath\n";
 
1106
    print $OUT "%   fill\n";
 
1107
    print $OUT "%   10 0 translate \n";
 
1108
    print $OUT "% } for\n";
 
1109
    print $OUT "% grestore\n";
 
1110
    print $OUT "% gsave \n";
 
1111
    print $OUT "% 340 510 translate\n";
 
1112
    print $OUT "% 0.0 0.05 1.00 \n";
 
1113
    print $OUT "% { \n";
 
1114
    print $OUT "%   dup dup \n";
 
1115
    print $OUT "%     from epsilon sub gt exch \n";
 
1116
    print $OUT "%     from epsilon add lt \n";
 
1117
    print $OUT "%    and\n";
 
1118
    print $OUT "%    { newpath 0 0 0 setrgbcolor 0 3 moveto 0 -6 rlineto stroke } if\n";
 
1119
    print $OUT "%   dup dup \n";
 
1120
    print $OUT "%     to epsilon 2 mul sub gt exch \n";
 
1121
    print $OUT "%     to epsilon 2 mul add lt \n";
 
1122
    print $OUT "%    and\n";
 
1123
    print $OUT "%    { newpath 0 0 0 setrgbcolor 10 3 moveto 0 -6 rlineto stroke } if\n";
 
1124
    print $OUT "%    0.7 exch 0 setrgbcolor   \n";
 
1125
    print $OUT "%    newpath\n";
 
1126
    print $OUT "%    0 0 moveto\n";
 
1127
    print $OUT "%    10 0 rlineto\n";
 
1128
    print $OUT "%    0 10  rlineto\n";
 
1129
    print $OUT "%    -10 0 rlineto\n";
 
1130
    print $OUT "%    closepath\n";
 
1131
    print $OUT "%    fill\n";
 
1132
    print $OUT "%    10 0 translate \n";
 
1133
    print $OUT "% } for\n";
 
1134
    print $OUT "% grestore\n";
 
1135
    print $OUT "% ----------------------------------------------------------\n";
 
1136
    print $OUT "HE14 setfont\n";
 
1137
    print $OUT "100.000000 508.000000 moveto\n";
 
1138
    print $OUT "($pname  PEs: $nPEs  Lat.: $lat ) show\n";
 
1139
    
 
1140
    print $OUT "($date) dup stringwidth pop 750.000000 exch sub 508.000000 moveto show\n";
 
1141
    print $OUT ( $opt_m ? "5 512 asciilogo\n" : "5 512 logo\n");    
 
1142
    print $OUT "% 100 500 moveto\n";    
 
1143
 
 
1144
    print $OUT "0 20 translate\n";
 
1145
 
 
1146
    print $OUT "HE14 setfont\n";
 
1147
    for ($i=0; $i<$nPEs; $i++) {
 
1148
        $dist = $stripes_high[$i] - $stripes_low[$i];
 
1149
        $y = $stripes_low[$i] + $dist/2;
 
1150
        # print $OUT "/starlen $dist def\n";
 
1151
        # print $OUT "gsave 2 $y star grestore\n";
 
1152
        print $OUT "  2 " . ($stripes_low[$i]+1) . " moveto ($i) show\n";
 
1153
    }
 
1154
 
 
1155
    print $OUT "20 0 translate\n";
 
1156
 
 
1157
    print $OUT "% Print x-axis:\n";
 
1158
    print $OUT "1 setlinewidth\n";
 
1159
    print $OUT "0 -5 moveto total-len normalize 0 rlineto stroke\n";
 
1160
    print $OUT "gsave\n" .
 
1161
               "[2 4] 1 setdash\n" .
 
1162
               "0 0 moveto 0 $total_height rlineto stroke\n" .
 
1163
               "% $x_max 0 moveto 0 $total_height rlineto stroke\n" .
 
1164
               "grestore\n";
 
1165
    print $OUT "0 total-len 10 div total-len\n" .
 
1166
               " { dup normalize dup -5 moveto 0 -2 rlineto stroke  % tic\n" .
 
1167
               "   -17 moveto HE10 setfont round prt-n  % print label \n" .
 
1168
               " } for \n";
 
1169
    
 
1170
 
 
1171
    print $OUT "$x_scale  $y_scale  scale\n";
 
1172
 
 
1173
    print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
 
1174
    
 
1175
    if ( $opt_D ) {
 
1176
        print $OUT "% Debugging info : \n";
 
1177
 
 
1178
        print $OUT "% Offset is: $offset\n";
 
1179
 
 
1180
        print $OUT "% y_val table: \n";
 
1181
        for ($i=0; $i<$nPEs; $i++) {
 
1182
            print $OUT "% y_val of $i: $y_val[$i]\n";
 
1183
        }
 
1184
 
 
1185
        print $OUT "% x-max: $x_max; y-max: $y_max\n";
 
1186
        print $OUT "% Info from header: Prg: $pname; PEs: $nPEs; Lat.: $lat\n";
 
1187
 
 
1188
        print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
 
1189
    }
 
1190
}
 
1191
 
 
1192
# ----------------------------------------------------------------------------
 
1193
 
 
1194
sub write_epilog {
 
1195
    local ($OUT,$x_max, $y_max) = @_;
 
1196
    local($x_scale,$y_scale);
 
1197
 
 
1198
    print $OUT "showpage\n";
 
1199
}
 
1200
 
 
1201
# ----------------------------------------------------------------------------
 
1202
 
 
1203
sub get_x_max {
 
1204
    local ($file) = @_;
 
1205
    local ($last_line, @fs);
 
1206
 
 
1207
    open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
 
1208
    while (<TMP>) {
 
1209
        $last_line = $_;
 
1210
    }
 
1211
    close(TMP);
 
1212
 
 
1213
    @fs = split(/[:\[\]\s]+/,$last_line);
 
1214
 
 
1215
    return $fs[2];
 
1216
}
 
1217
 
 
1218
# ----------------------------------------------------------------------------
 
1219
#
 
1220
#sub get_date {
 
1221
#    local ($now,$today,@lt);
 
1222
#
 
1223
#    @lt = localtime(time);
 
1224
#    $now = join(":",reverse(splice(@lt,0,3)));
 
1225
#    $today = join(".",splice(@lt,0,3));
 
1226
#
 
1227
#    return $now . " on " . $today;
 
1228
#}
 
1229
#
 
1230
# ----------------------------------------------------------------------------
 
1231
 
 
1232
sub get_date {
 
1233
    local ($date);
 
1234
 
 
1235
    open (DATE,"date |") || die ("$!");
 
1236
    while (<DATE>) {
 
1237
        $date = $_;
 
1238
    }
 
1239
    close (DATE);
 
1240
 
 
1241
    return ($date);
 
1242
}
 
1243
 
 
1244
# -----------------------------------------------------------------------------
 
1245
 
 
1246
sub generate_y_val_table {
 
1247
    local ($nPEs) = @_;
 
1248
    local($i, $y, $dist);
 
1249
 
 
1250
    $dist = int($total_height/$nPEs);
 
1251
    for ($i=0, $y=1; $i<$nPEs; $i++, $y+=$dist) {
 
1252
        $y_val[$i] = $y + $lower_border;
 
1253
        $stripes_low[$i] = $y;
 
1254
        $stripes_high[$i] = $y+$dist-2;
 
1255
    }
 
1256
 
 
1257
    # print $OUT "10 5 translate\n";
 
1258
 
 
1259
    return ($dist);
 
1260
}
 
1261
 
 
1262
# ----------------------------------------------------------------------------
 
1263
 
 
1264
sub init { 
 
1265
    local ($nPEs) = @_;
 
1266
    local($i);
 
1267
 
 
1268
    for ($i=0; $i<$nPEs; $i++) {
 
1269
        if ( $opt_S ) {
 
1270
            $sparks[$i] = 0;
 
1271
        }
 
1272
        $blocked[$i] = 0;
 
1273
        $runnable[$i] = 0;
 
1274
        $fetching[$i] = 0;
 
1275
        $running[$i] = $NO_ID;
 
1276
        if ( $opt_S ) {
 
1277
            $last_sp_bg[$i] = $NO_LAST_BG;
 
1278
        }
 
1279
        $last_bg[$i] = $NO_LAST_BG;
 
1280
        $last_start[$i] = $NO_LAST_START;
 
1281
        $last_blocked[$i] = $NO_LAST_BLOCKED;
 
1282
        $last_runnable[$i] = 0; 
 
1283
        #open($OUT_RA[$i], "PE". $i . ".dat") || die "PE".$i."-R.dat: $!\n";
 
1284
        #print $OUT_RA[$i] "# Number of Runnable tasks on PE $i\n";
 
1285
        #open($OUT_BA[$i], "PE". $i . ".dat") || die "PE".$i."-B.dat: $!\n";
 
1286
        #print $OUT_BA[$i] "# Number of Blocked tasks on PE $i\n";
 
1287
    } 
 
1288
    
 
1289
}
 
1290
 
 
1291
 
 
1292
# ----------------------------------------------------------------------------
 
1293
 
 
1294
sub skip_header {
 
1295
    local ($FILE) = @_;
 
1296
    local($prg, $pars, $nPEs, $lat, $fetch, $in_header);
 
1297
 
 
1298
    $in_header = 9;
 
1299
    while (<$FILE>) {
 
1300
        if ( $in_header = 9 ) {
 
1301
            if (/^=/) {
 
1302
                $gum_style_gr = 1;
 
1303
                $in_header = 0;
 
1304
                $prg = "????";          # 
 
1305
                $pars = "-b??????";             # 
 
1306
                $nPEs = $opt_p ? $opt_p : 1; # 
 
1307
                $lat = $opt_l ? $opt_l : 1;
 
1308
                return ($prg, $pars, $nPEs, $lat);
 
1309
            } else {
 
1310
                $gum_style_gr = 0;
 
1311
                $in_header = 1;
 
1312
            }
 
1313
            
 
1314
        }
 
1315
        $prg = $1, $pars = $2   if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
 
1316
        $nPEs = $1              if /^PEs\s+(\d+)/;
 
1317
        $lat = $1, $fetch = $2  if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
 
1318
        die "Can't process GranSim-Light profiles!\n"  if /^GrAnSim-Light$/i;
 
1319
 
 
1320
        last             if /^\+\+\+\+\+/;
 
1321
    }
 
1322
 
 
1323
    return ($prg, $pars, $nPEs, $lat);
 
1324
}
 
1325
 
 
1326
# ----------------------------------------------------------------------------
 
1327
 
 
1328
sub process_options {
 
1329
 
 
1330
    if ( $opt_h ) {                      
 
1331
        open(ME,$0) || die "Can't open myself ($0): $!\n";
 
1332
        $n = 0;
 
1333
        while (<ME>) {
 
1334
            last if $_ =~ /^$/;
 
1335
            print $_;
 
1336
            $n++;
 
1337
        }
 
1338
        close(ME);
 
1339
        exit ;
 
1340
    }
 
1341
    
 
1342
    if ( $#ARGV != 0 ) {
 
1343
        print "Usage: $0 [options] <gr-file>\n";
 
1344
        print "Use -h option to get details\n";
 
1345
        exit 1;
 
1346
    }
 
1347
    
 
1348
    $input = $ARGV[0] ;
 
1349
    $input =~ s/\.gr//;
 
1350
    $input .= ".gr";
 
1351
 
 
1352
    if ( $opt_o ) {
 
1353
        ($output   = $opt_o) =~ s/\.ps// ;
 
1354
        $output_b = $output . "_peb.ps";
 
1355
        $output_r = $output . "_per.ps";
 
1356
        $output_mig = $output . "_mig.ps" if $opt_M;
 
1357
        $output_sp = $output . "_sp.ps"   if $opt_S;
 
1358
        $output   = $output . "_pe.ps";
 
1359
        #($output_b = $opt_o) =~ s/\./-b./ ;
 
1360
        #($output_r = $opt_o) =~ s/\./-r./ ;
 
1361
        #($output_mig = $opt_o) =~ s/\./-mig./  if $opt_M;
 
1362
        #($output_sp = $opt_o) =~ s/\./-sp./  if $opt_S;
 
1363
    } else {
 
1364
        ($output = $input) =~ s/\.gr// ;
 
1365
        $output_b = $output . "_peb.ps";
 
1366
        $output_r = $output . "_per.ps";
 
1367
        $output_mig = $output . "_mig.ps" if $opt_M;
 
1368
        $output_sp = $output . "_sp.ps"   if $opt_S;
 
1369
        $output   = $output . "_pe.ps";
 
1370
    }
 
1371
    
 
1372
    if ( $opt_v ){ 
 
1373
        $verbose = 1;
 
1374
    }    
 
1375
 
 
1376
    if ( $opt_i ) {
 
1377
        $inf_block = $opt_i;
 
1378
    } else {
 
1379
        $inf_block = 20;
 
1380
    }
 
1381
 
 
1382
    $RUNNABLE_file = $input;
 
1383
    $RUNNABLE_file =~ s/\.gr//;
 
1384
    $RUNNABLE_file .= "-R";
 
1385
 
 
1386
    $BLOCKED_file = $input;
 
1387
    $BLOCKED_file =~ s/\.gr//;
 
1388
    $BLOCKED_file .= "-B";
 
1389
 
 
1390
    $FETCHING_file = $input;
 
1391
    $FETCHING_file =~ s/\.gr//;
 
1392
    $FETCHING_file .= "-F";
 
1393
}
 
1394
 
 
1395
# ----------------------------------------------------------------------------
 
1396
 
 
1397
sub print_verbose_message {
 
1398
 
 
1399
    print "Input file: $input\n";  
 
1400
    print "Output files: $output, $output_b, $output_r; ".
 
1401
          ($opt_M ? "Migration: $output_mig" : "") .
 
1402
          ($opt_S ? "Sparks: $output_sp" : "") .
 
1403
          "\n";
 
1404
}
 
1405
 
 
1406
# ----------------------------------------------------------------------------
 
1407
# Junk from draw_segment:
 
1408
#
 
1409
#    if ( $type eq $RUNNING ) { 
 
1410
#       die "ERROR: This version should never draw a RUNNING segment!";
 
1411
#       $y = $y_val[$pe];
 
1412
#       $x = $last_start[$pe]; 
 
1413
#       $width = &get_width(0, $type);
 
1414
#       # $gray = 0;
 
1415
#
 
1416
#       if ( $is_very_big ) {   
 
1417
#           $x = int($x/$shrink_x) + 1;   # rounded up
 
1418
#       }
 
1419
#
 
1420
#       do ps_draw_hline(OUT_B,$x,$y,$time,$width);
 
1421
#       do ps_draw_hline(OUT_R,$x,$y,$time,$width);  
 
1422
#
 
1423
#    } elsif ( $type eq $RUNNABLE ) {
 
1424
#       die "ERROR: This version should never draw a RUNNABLE segment (shades are used instead)!";
 
1425
#       $y = $y_val[$pe] + $offset;
 
1426
#       $x = $last_runnable[$pe];
 
1427
#       $width = &get_width($runnable[$pe], $type);
 
1428
#
 
1429
#       if ( $is_very_big ) {   
 
1430
#           $x = int($x/$shrink_x) + 1;   # rounded up
 
1431
#       }
 
1432
#
 
1433
#       # $gray = 0.5;
 
1434
#       do ps_draw_hline(OUT_R,$x,$y,$time,$width);