v2.0/bin/PROHST.PAS

   1 PROGRAM prohst(input,output);
   2 {$debug- $line- $symtab+}
   3
   4 {**********************************************************************}
   5 {*                                                                    *}
   6 {*                           prohst                                   *}
   7 {*                                                                    *}
   8 {* This program produces a histogram from the profile file produced   *}
   9 {* by the MS-DOS profile utility. It optionally reads the map file    *}
  10 {* generated when the program being profiled was linked, and writes   *}
  11 {* either the module address or, if available, the line number as     *}
  12 {* a prefix to the line of the graph which describes a particular     *}
  13 {* bucket.                                                            *}
  14 {*                                                                    *}
  15 {* After using filbm (derived from the Pascal and Fortran front end   *}
  16 {* command scanner) to parse its parameters, prohst opens the map     *}
  17 {* file if specified, searches for the heading line, and then reads   *}
  18 {* the lines giving the names and positions of the modules. It builds *}
  19 {* a linked list of module names and start addresses.                 *}
  20 {*                                                                    *}
  21 {* It then reads the bucket file header and and bucket array elements *}
  22 {* into a variable created on the heap. It simultaneously calculates  *}
  23 {* a normalization factor. It writes the profile listing header and   *}
  24 {* starts to write the profile lines. For each bucket, the address    *}
  25 {* is calculated. The first entry in the address/name linked list     *}
  26 {* is the lowest addressed module. This is initially the 'current'    *}
  27 {* module. The bucket address is compared with the current module     *}
  28 {* address. When it becomes the greater, the module name is written   *}
  29 {* to the listing and the next entry in the address/name list becomes *}
  30 {* the current module. If line numbers are available, the bucket      *}
  31 {* address is also compared to the current line/address. This is      *}
  32 {* read and calculated directly from the file. Since there may be     *}
  33 {* more than one line per bucket, several entries may be read until   *}
  34 {* the addresses compare within the span of addresses encompassed by  *}
  35 {* a bucket (its 'width'). Note that the idiosyncracies of Pascal i/o *}
  36 {* make it necessary to continually check for the end of the map file *}
  37 {* and the complexity of this code is mainly due to an attempt to     *}
  38 {* make it reasonably resilient to changes in the format of the map   *}
  39 {* file.                                                              *}
  40 {*                                                                    *}
  41 {**********************************************************************}
  42
  43
  44 CONST
  45   max_file = 32;
  46
  47
  48 TYPE
  49   filenam = LSTRING (max_file);
  50   sets = SET OF 0..31;
  51   address_pointer = ^address_record;
  52   address_record = RECORD
  53                      next: address_pointer;
  54                      name: STRING (15);
  55                      address: WORD;
  56                    END;
  57
  58
  59
  60
  61
  62 VAR
  63
  64   i: INTEGER;
  65   bucket: FILE OF WORD;
  66   hist: TEXT;
  67   map: TEXT;
  68
  69   first_address,
  70   this_address: address_pointer;
  71   current_base: WORD;
  72   bucket_name,
  73   hist_name,
  74   map_name: filenam;
  75
  76   switches: sets;
  77
  78   line: LSTRING (100);
  79
  80   map_avail: BOOLEAN;
  81   line_nos_avail: BOOLEAN;
  82
  83   norm: REAL;
  84   per_cent: INTEGER;
  85   real_bucket,
  86   norm_bucket: REAL;
  87   cum_per_cent,
  88   real_per_cent: REAL;
  89
  90   bucket_num,
  91   clock_grain,
  92   bucket_size,
  93   prog_low_pa,
  94   prog_high_pa,
  95   dos_pa,
  96   hit_io,
  97   hit_dos,
  98   hit_high: WORD;
  99
 100   seg,
 101   offset,
 102   parcel: WORD;
 103
 104   address: WORD;
 105   new_line_no,
 106   line_no: WORD;
 107
 108   dummy : LSTRING (8);
 109   name: LSTRING (20);
 110   line_no_part: LSTRING (17);
 111   start: LSTRING (6);
 112
 113   buckets: ^SUPER ARRAY [1 .. *] OF REAL;
 114
 115   this_bucket: WORD;
 116
 117 LABEL 1;
 118
 119
 120 PROCEDURE filbm (VAR prffil, hstfil, mapfil: filenam;
 121                       VAR switches: sets); EXTERN;
 122
 123 FUNCTION realword (w: WORD): REAL;
 124 BEGIN
 125   IF ORD (w) < 0 THEN BEGIN
 126     realword := FLOAT (maxint) + FLOAT (ORD (w - maxint));
 127     END
 128   ELSE BEGIN
 129     realword := FLOAT (ORD(w));
 130   END {IF};
 131 END {realword};
 132
 133
 134
 135 PROCEDURE skip_spaces;
 136 BEGIN
 137   WHILE NOT eof(map) AND THEN map^ = ' ' DO BEGIN
 138     get (map);
 139   END {WHILE};
 140 END {skip_spaces};
 141
 142
 143 FUNCTION hex_char (ch: CHAR): WORD;
 144 BEGIN
 145   IF ch >= '0' AND THEN ch <= '9' THEN BEGIN
 146     hex_char := WRD (ch) - WRD ('0');
 147     END
 148   ELSE IF ch >= 'A' AND THEN ch <= 'F' THEN BEGIN
 149     hex_char := WRD (ch) - WRD ('A') + 10;
 150     END
 151   ELSE BEGIN
 152     WRITELN ('Invalid hex character');
 153     hex_char := 0;
 154   END {IF};
 155 END {hex_char};
 156
 157
 158 FUNCTION read_hex (i :WORD): WORD;
 159 VAR
 160   hex_val: WORD;
 161 BEGIN
 162   skip_spaces;
 163   hex_val := 0;
 164   WHILE NOT eof (map) AND THEN i <> 0 DO BEGIN
 165     hex_val := hex_val * 16 + hex_char (map^);
 166     GET (map);
 167     i := i - 1;
 168   END {WHILE};
 169     read_hex := hex_val;
 170 END {read_hex};
 171
 172 FUNCTION read_h: WORD;
 173 BEGIN
 174   read_h := read_hex (4);
 175   get (map);
 176   get (map);
 177 END;
 178
 179 FUNCTION read_word: WORD;
 180 VAR
 181   int_value: WORD;
 182 BEGIN
 183   int_value := 0;
 184   IF NOT EOF (map) THEN BEGIN
 185     READ (map, int_value);
 186   END {IF};
 187   read_word := int_value;
 188 END {read_word};
 189
 190
 191 FUNCTION map_digit: BOOLEAN;
 192 BEGIN
 193   map_digit := (map^ >= '0') OR (map^ <= '9');
 194 END {map_digit};
 195
 196 BEGIN {prohst}
 197   writeln (output, '    Profile Histogram Utility - Version 1.0');
 198   writeln (output);
 199   writeln (output, '         Copyright - Microsoft, 1983');
 200
 201   start := '      ';
 202
 203   filbm (bucket_name, hist_name, map_name, switches);
 204
 205   IF 31 IN switches THEN BEGIN
 206     ABORT ('Map file must not be terminal', 0, 0);
 207   END {IF};
 208
 209   IF NOT (28 IN switches) THEN BEGIN
 210     ABORT ('No histogram file specified', 0, 0);
 211   END {IF};
 212
 213   ASSIGN (bucket, bucket_name);
 214   reset (bucket);
 215   ASSIGN (hist, hist_name);
 216   rewrite (hist);
 217
 218   map_avail := 29 IN switches;
 219   line_nos_avail := FALSE;
 220
 221   IF map_avail THEN BEGIN
 222     ASSIGN (map, map_name);
 223     RESET (map);
 224
 225     WHILE NOT EOF (map) AND THEN start <> ' Start' DO BEGIN
 226       READLN (map, start);
 227     END {WHILE};
 228
 229     NEW (first_address);
 230     this_address := NIL;
 231
 232     WHILE NOT EOF(map) DO BEGIN
 233       READLN (map, line);
 234       IF line.len < 6 OR ELSE line [2] < '0' OR ELSE
 235           line [2] > '9' THEN BEGIN
 236         BREAK;
 237       END {IF};
 238
 239       IF this_address <> NIL THEN BEGIN
 240         NEW (this_address^.next);
 241         this_address := this_address^.next;
 242         END
 243       ELSE BEGIN
 244         this_address := first_address;
 245       END {IF};
 246       this_address^.next := NIL;
 247
 248       this_address^.address := (hex_char (line [2]) * 4096) +
 249                                (hex_char (line [3]) * 256) +
 250                                (hex_char (line [4]) * 16) +
 251                                hex_char (line [5]);
 252
 253       FOR i := 1 TO 15 DO BEGIN
 254         this_address^.name [i] := line [22 + i];
 255       END {FOR};
 256
 257     END {WHILE};
 258
 259     WHILE NOT EOF (map) DO BEGIN
 260       READLN (map, line_no_part);
 261       IF line_no_part = 'Line numbers for ' THEN BEGIN
 262         line_nos_avail := TRUE;
 263         BREAK;
 264       END {IF};
 265     END {WHILE};
 266
 267   END {IF};
 268
 269   read (bucket, clock_grain, bucket_num, bucket_size,
 270     prog_low_pa, prog_high_pa, dos_pa, hit_io, hit_dos, hit_high);
 271
 272   NEW (buckets,ORD (bucket_num));
 273
 274   norm := 0.0;
 275   norm_bucket := 0.0;
 276
 277   FOR i := 1 TO ORD (bucket_num) DO BEGIN
 278     read (bucket, this_bucket);
 279     real_bucket := realword (this_bucket);
 280
 281     IF real_bucket > norm_bucket THEN BEGIN
 282       norm_bucket := real_bucket;
 283     END {IF};
 284
 285     norm := norm + real_bucket;
 286     buckets^[i] := real_bucket;
 287   END {FOR};
 288   norm_bucket := 45.0/norm_bucket;
 289   norm := 100.0/norm;
 290
 291   WRITELN (hist, 'Microsoft Profiler Output Listing');
 292
 293   WRITELN (hist);
 294   WRITELN (hist, ORD (bucket_num):6, bucket_size:4,'-byte buckets.');
 295
 296   WRITELN (hist);
 297   WRITELN (hist, 'Profile taken between ', prog_low_pa*16::16,
 298     ' and ', prog_high_pa*16::16, '.');
 299
 300   WRITELN (hist);
 301   WRITELN (hist, 'DOS program address:', dos_pa::16);
 302
 303   WRITELN (hist);
 304   WRITELN (hist, 'Number of hits in DOS: ', hit_dos:5,
 305             ' or ', realword (hit_dos) * norm:4:1, '%.');
 306   WRITELN (hist, 'Number of hits in I/O: ', hit_io:5,
 307             ' or ', realword (hit_io) * norm:4:1, '%.');
 308   WRITELN (hist, 'Number of hits high  : ', hit_high:5,
 309             ' or ', realword (hit_high) * norm:4:1, '%.');
 310   WRITELN (hist);
 311   WRITELN (hist, ' Hits  Addr.  Line/ Cumul.  % 0.0               ',
 312                               '                         ',
 313                               1.0/norm:1:1);
 314
 315   WRITELN (hist, '              Offset           +----------------',
 316                               '----------------------------');
 317   WRITELN (hist, name);
 318   i := 0;
 319   parcel := 0;
 320   current_base := 0;
 321   line_no := 0;
 322   new_line_no := 0;
 323   cum_per_cent := 0.0;
 324
 325   WHILE i < ORD (bucket_num) DO BEGIN
 326     i := i + 1;
 327     IF buckets^[i] < 0.9 THEN BEGIN
 328       WRITELN (hist);
 329       REPEAT
 330         i := i + 1;
 331       UNTIL (i = ORD (bucket_num)) OR ELSE buckets^[i] > 0.0;
 332     END {IF};
 333
 334     address := bucket_size * (WRD (i) - 1);
 335
 336     WHILE map_avail AND THEN
 337         address >= first_address^.address DO BEGIN
 338       WRITELN (hist, '      ', first_address^.name);
 339       current_base := first_address^.address;
 340       first_address := first_address^.next;
 341     END {WHILE};
 342
 343     WHILE line_nos_avail AND THEN NOT eof (map) AND THEN
 344                                        address >= parcel DO BEGIN
 345       skip_spaces;
 346       WHILE  (map^ < '0') OR (map^ > '9') DO BEGIN
 347
 348         IF EOF (map) THEN BEGIN
 349           goto 1;
 350         END {IF};
 351         READLN (map);
 352         skip_spaces;
 353       END {WHILE};
 354
 355
 356       line_no := new_line_no;
 357       new_line_no := read_word;
 358       seg := read_hex (4);
 359       IF EOF (map) THEN BEGIN
 360         GOTO 1;
 361       END {IF};
 362       IF map^ <> ':' THEN BEGIN
 363         WRITELN ('Invalid map file');
 364       END {IF};
 365       get (map);
 366       IF EOF (map) THEN BEGIN
 367         GOTO 1;
 368       END {IF};
 369       offset := read_hex (3) + WRD (hex_char (map^) > 0);
 370       get (map);
 371       IF map^ <> 'H' THEN BEGIN
 372         WRITELN ('Invalid map file');
 373       END {IF};
 374       IF EOF (map) THEN BEGIN
 375         GOTO 1;
 376       END {IF};
 377       get (map);
 378       parcel := seg + offset;
 379     END {WHILE};
 380 1:  real_per_cent := buckets^[i] * norm;
 381     cum_per_cent := cum_per_cent + real_per_cent;
 382     per_cent := ROUND ( buckets^[i] * norm_bucket);
 383
 384     WRITE (hist, buckets^ [i]:6:0, ' ',
 385                address*16:6:16);
 386     IF line_no <> 0 THEN BEGIN
 387       WRITE (hist, line_no:6);
 388       line_no := 0;
 389       END
 390     ELSE IF map_avail AND THEN first_address <> NIL THEN BEGIN
 391       WRITE (hist, ' #', address - first_address^.address:4:16);
 392       END
 393     ELSE BEGIN
 394       WRITE (hist, '      ');
 395     END {IF};
 396
 397     WRITELN (hist, ' ', cum_per_cent:5:1, ' ', real_per_cent:4:1, ' |',
 398                '*': per_cent);
 399   END {WHILE};
 400   WRITELN (hist, '                               +-----------------',
 401                               '------------------');
 402 END.
 403