home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / pascal-p / profiler.lbr / PLOTPROF.PZS / PLOTPROF.PAS
Encoding:
Pascal/Delphi Source File  |  1987-01-15  |  8.9 KB  |  253 lines
  1. PROGRAM plotprofile(profdata, outfile, output);
  2. (* ******************************************************** *)
  3. (* Plots a histogram from "profdata", which was saved via   *)
  4. (* "dumprofile" routine of "profiler" subsystem.  Note that *)
  5. (* profile can be of machine language operation.            *)
  6. (*                                                          *)
  7. (* Copyright (c) 1981, 1983 by:                             *)
  8. (*                                                          *)
  9. (*       C.B. Falconer,        (203) 785-2447               *)
  10. (*       Yale School of Medicine,                           *)
  11. (*       Room 6016CB,                                       *)
  12. (*       789 Howard Ave.,                                   *)
  13. (*       New Haven, Conn. 06504.                            *)
  14. (* ******************************************************** *)
  15.  
  16. (* 1.2 84/11/02 fix for terminals that cannot handle 80 char *)
  17. (*     lines without extra linefeeds.   cbf                  *)
  18.  
  19.   CONST
  20.     version      = '1.2';
  21.     firstxcolumn = 8;   (* first used for actual plot *)
  22.     screenwidth  = 80;
  23.     widthless1   = 79;  (* lousy terminals that linefeed at 80 *)
  24.     screenlines  = 24;
  25.  
  26.   TYPE
  27.     lineimage    = PACKED ARRAY[1..screenwidth] OF char;
  28.     screenimage  = ARRAY[1..screenlines] OF lineimage;
  29.     yarray       = ARRAY[firstxcolumn..screenwidth] OF integer;
  30.     fntype       = PACKED ARRAY[1..28] OF char;
  31.     dltype       = PACKED ARRAY[1..15] OF char;
  32.  
  33.   VAR
  34.     xfirst, xstep, xsqueeze,
  35.     events,
  36.     minline,
  37.     maxline,
  38.     maxcount     : integer;  (* data limits *)
  39.     yvalues      : yarray;
  40.     r            : real;
  41.     i            : integer;
  42.     profdata,                  (* the stored data *)
  43.     outfile      : text;     (* the histogram *)
  44.     fn           : fntype;   (* the data file name *)
  45.     dl           : dltype;   (* current time/date *)
  46.  
  47.   (* 1---------------1 *)
  48.  
  49. (*$i'aiwrite.inc' *)
  50.   PROCEDURE skipblanks(VAR f : text);
  51.   (* skips blanks and eolns until first non-blank char *)
  52.  
  53.     BEGIN (* skipblanks *)
  54.     WHILE  (f^ = ' ') AND NOT eof(f) DO get(f);
  55.     END; (* skipblanks *)
  56.  
  57.   (* 1---------------1 *)
  58.  
  59.   FUNCTION getpair(VAR f : text; VAR x,y : integer) : boolean;
  60.   (* returns true if error in input data of form "x: y " *)
  61.  
  62.     BEGIN (* getpair *)
  63.     getpair := true; (* default failure *)
  64.     IF NOT readx(f, x) THEN (* ok so far *)
  65.       IF f^ = ':' THEN BEGIN
  66.         get(f);
  67.         IF NOT readx(f, y) THEN
  68.           IF f^ = ' ' THEN BEGIN
  69.             skipblanks(f); getpair := false; END;
  70.         END;
  71.     END; (* getpair *)
  72.  
  73.   (* 1---------------1 *)
  74.  
  75.   FUNCTION xlimitscan(VAR profdata : text;
  76.                       VAR minx, maxx : integer) : boolean;
  77.   (* returns true if input data satisfactory *)
  78.  
  79.     LABEL 1;
  80.  
  81.     VAR
  82.       thisx,
  83.       thiscount : integer;
  84.  
  85.     BEGIN (* xlimitscan *)
  86.     IF exists(profdata) THEN BEGIN
  87.       skipblanks(profdata); xlimitscan := true;
  88.       maxx := 0; minx := maxint;
  89.       IF getpair(profdata, thisx, thiscount) OR (thisx > 0) THEN
  90.         xlimitscan := false
  91.       ELSE
  92.         WHILE NOT eof(profdata) DO BEGIN
  93.           IF getpair(profdata, thisx, thiscount) THEN BEGIN
  94.             xlimitscan := false; GOTO 1; END;
  95.           IF thisx > maxx THEN maxx := thisx;
  96.           IF thisx < minx THEN minx := thisx; END;
  97.       END
  98.     ELSE xlimitscan := false;
  99. 1:  END; (* xlimitscan *)
  100.  
  101.   (* 1---------------1 *)
  102.  
  103.   PROCEDURE yrangescan(VAR profdata      : text;
  104.                            xfirst, xstep : integer;
  105.                        VAR yvalues       : yarray;
  106.                        VAR ymax, events  : integer
  107.                        VAR xsqueeze      : integer);
  108.   (* primarily fills yvalues array with input data *)
  109.   (* xlimitscan has already validated the input    *)
  110.  
  111.     VAR
  112.       xvalue, i,
  113.       thisy,
  114.       thissum  : integer;
  115.       junk     : boolean;
  116.  
  117.     BEGIN (* yrangescan *)
  118.     FOR i := firstxcolumn TO screenwidth DO yvalues[i] := 0;
  119.     reset(profdata); skipblanks(profdata);
  120.     junk := getpair(profdata, xsqueeze, events); (* eventcount line *)
  121.     ymax := 0; thissum := 0; i := firstxcolumn;
  122.     WHILE NOT eof(profdata) DO BEGIN
  123.       junk := getpair(profdata, xvalue, thisy);
  124.       IF xvalue >= xfirst + xstep THEN BEGIN
  125.         IF thissum > ymax THEN ymax := thissum;
  126.         yvalues[i] := thissum; i := succ(i);
  127.         xfirst := xfirst + xstep;
  128.         WHILE xvalue >= xfirst + xstep DO BEGIN
  129.           i := succ(i); xfirst := xfirst + xstep; END;
  130.         thissum := 0; END;
  131.       thissum := thissum + thisy; END;
  132.     yvalues[i] := thissum;
  133.     IF thissum > ymax THEN ymax := thissum;
  134.     END; (* yrangescan *)
  135.  
  136.   (* 1---------------1 *)
  137.  
  138.   PROCEDURE plot(VAR outfile : text;
  139.                      yvalues : yarray;
  140.                      minline, step,
  141.                      maxcount, events, xsqueeze : integer);
  142.     VAR
  143.       maxpercent,
  144.       i, j, k   : integer;
  145.       screen    : screenimage;
  146.       scale     : real;
  147.  
  148.     (* 2---------------2 *)
  149.  
  150.     PROCEDURE makecoordinates(VAR screen        : screenimage;
  151.                                   minline, step : integer;
  152.                                   maxpercent    : integer);
  153.       VAR
  154.         i, j, v   : integer;
  155.         s         : PACKED ARRAY[1..21] OF CHAR;
  156.         r, num    : real;
  157.  
  158.       (* 3---------------3 *)
  159.  
  160.       PROCEDURE arhexwrite(VAR a    : lineimage;
  161.                            VAR x    : integer;
  162.                                maxx : integer;
  163.                                num  : real);
  164.         VAR
  165.           divd      : real;
  166.           i, dig    : integer;
  167.  
  168.         BEGIN (* arhexwrite *)
  169.         IF x + 3 > maxx THEN BEGIN
  170.           writeln('arhexwrite bounds violation');
  171.           terminate; END
  172.         ELSE BEGIN
  173.           divd := 4096.0;
  174.           FOR i := 0 TO 3 DO BEGIN
  175.             dig := trunc(num/divd); num := num - divd * dig;
  176.             divd := divd/16.0;
  177.             IF dig > 9 THEN dig := dig + 7;
  178.             a[x + i] := chr(dig + ord('0')); END;
  179.           x := x + 3; END;
  180.         END; (* arhexwrite *)
  181.  
  182.       (* 3---------------3 *)
  183.  
  184.       BEGIN (* makecoordinates *)
  185.       r := 1.0;
  186.       FOR i := xsqueeze TO -1 DO r := 2.0 * r;
  187.       FOR i := 1 TO screenwidth DO screen[1,i] := ' ';
  188.       FOR i := 2 TO screenlines DO screen[i] := screen[1];
  189.       FOR i := 0 TO 4 DO BEGIN (* grid and y scale *)
  190.         v := (4 - i) * maxpercent DIV 4; j := 1;
  191.         aiwrite(screen[5*i+1], j, screenwidth, v, firstxcolumn-2);
  192.         FOR j := 1 TO screenwidth DIV 8 DO
  193.           screen[5*i+1, 8*j] := '+'; END;
  194.       FOR i := 0 TO pred(screenwidth DIV 8) DO BEGIN
  195.         j := 8*i+1;
  196.         IF xsqueeze = 0 THEN
  197.           aiwrite(screen[22], j, screenwidth, minline, 7)
  198.         ELSE BEGIN
  199.           num := r * minline; j := j+3;
  200.           arhexwrite(screen[22], j, screenwidth, num); END;
  201.         minline := minline + 8*step; screen[22, j+1] := '^'; END;
  202.       s := '   PERCENT OF TIME   ';
  203.       FOR i := 1 TO 21 DO screen[i, firstxcolumn-5] := s[i];
  204.       END; (* makecoordinates *)
  205.  
  206.     (* 2---------------2 *)
  207.  
  208.     BEGIN (* plot *)
  209.     scale := 100.0/events; maxpercent := 40;
  210.     IF scale * maxcount > 80.0 THEN maxpercent := 100
  211.     ELSE IF scale * maxcount > 40.0 THEN maxpercent := 80;
  212.     IF scale * maxcount < 12.0 THEN maxpercent := 12
  213.     ELSE IF scale * maxcount < 20.0 THEN maxpercent := 20;
  214.     (* maxpercent must be divisible by 4 *)
  215.     scale := 40.0/maxpercent * scale;
  216.     makecoordinates(screen, minline, step, maxpercent);
  217.     FOR i := firstxcolumn TO screenwidth DO BEGIN
  218.       j := 1 + round(scale * yvalues[i]);
  219.       IF odd(j) THEN screen[21 - j DIV 2, i] := '-'
  220.       ELSE screen[21 - j DIV 2, i] := '_'; END;
  221.     FOR i := 1 TO 22 DO
  222. (*$x+,s-*)
  223.       writeln(outfile, screen[i, 2 FOR widthless1]);
  224. (*$x-*)
  225.     END; (* plot *)
  226.  
  227.   (* 1---------------1 *)
  228.  
  229.   BEGIN (* plotprofile *)
  230.   writeln('PLOTPROFILE (profdata, outfile, output) Ver.',
  231.            version);
  232.   IF xlimitscan(profdata, minline, maxline) THEN BEGIN
  233.     filename(profdata, fn); dater(dl);
  234.     rewrite(outfile);
  235.     maxcount := succ(8 * ((screenwidth-firstxcolumn) DIV 8));
  236.     xstep := round((maxline-minline)/maxcount + 0.5); (* round up *)
  237.     xfirst := minline;
  238.     yrangescan(profdata,xfirst,xstep,yvalues,maxcount,events,xsqueeze);
  239.     writeln(outfile, dl, ' Data file = ', fn);
  240.     writeln(outfile);
  241.     write(outfile, 'Profile of ');
  242.     IF xsqueeze = 0 THEN
  243.       write(outfile, 'pcode execution, line increment=', xstep:1)
  244.     ELSE BEGIN
  245.       r := xstep;
  246.       FOR i := xsqueeze TO -1 DO r := 2.0 * r;
  247.       write(outfile, 'machine code execution, ');
  248.       write(outfile, 'adr. increment(decimal)=', trunc(r):1); END;
  249.     writeln(outfile);
  250.     plot(outfile,yvalues,xfirst,xstep,maxcount,events,xsqueeze); END
  251.   ELSE writeln('Fatal error in input data ');
  252.   END. (* plotprofile *)
  253. ª≤