summaryrefslogtreecommitdiff
path: root/v2.0/bin/PROHST.PAS
diff options
context:
space:
mode:
authorGravatar Rich Turner1983-08-12 17:53:34 -0700
committerGravatar Rich Turner2018-09-21 17:53:34 -0700
commit80ab2fddfdf30f09f0a0a637654cbb3cd5c7baa6 (patch)
treeee4357f7f3dd0f2ded59b9c6e7384432d85e7ec9 /v2.0/bin/PROHST.PAS
parentMS-DOS v1.25 Release (diff)
downloadms-dos-80ab2fddfdf30f09f0a0a637654cbb3cd5c7baa6.tar.gz
ms-dos-80ab2fddfdf30f09f0a0a637654cbb3cd5c7baa6.tar.xz
ms-dos-80ab2fddfdf30f09f0a0a637654cbb3cd5c7baa6.zip
MS-DOS v2.0 Release
Diffstat (limited to 'v2.0/bin/PROHST.PAS')
-rw-r--r--v2.0/bin/PROHST.PAS403
1 files changed, 403 insertions, 0 deletions
diff --git a/v2.0/bin/PROHST.PAS b/v2.0/bin/PROHST.PAS
new file mode 100644
index 0000000..4ee13fc
--- /dev/null
+++ b/v2.0/bin/PROHST.PAS
@@ -0,0 +1,403 @@
1PROGRAM 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
44CONST
45 max_file = 32;
46
47
48TYPE
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
62VAR
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
117LABEL 1;
118
119
120PROCEDURE filbm (VAR prffil, hstfil, mapfil: filenam;
121 VAR switches: sets); EXTERN;
122
123FUNCTION realword (w: WORD): REAL;
124BEGIN
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};
131END {realword};
132
133
134
135PROCEDURE skip_spaces;
136BEGIN
137 WHILE NOT eof(map) AND THEN map^ = ' ' DO BEGIN
138 get (map);
139 END {WHILE};
140END {skip_spaces};
141
142
143FUNCTION hex_char (ch: CHAR): WORD;
144BEGIN
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};
155END {hex_char};
156
157
158FUNCTION read_hex (i :WORD): WORD;
159VAR
160 hex_val: WORD;
161BEGIN
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;
170END {read_hex};
171
172FUNCTION read_h: WORD;
173BEGIN
174 read_h := read_hex (4);
175 get (map);
176 get (map);
177END;
178
179FUNCTION read_word: WORD;
180VAR
181 int_value: WORD;
182BEGIN
183 int_value := 0;
184 IF NOT EOF (map) THEN BEGIN
185 READ (map, int_value);
186 END {IF};
187 read_word := int_value;
188END {read_word};
189
190
191FUNCTION map_digit: BOOLEAN;
192BEGIN
193 map_digit := (map^ >= '0') OR (map^ <= '9');
194END {map_digit};
195
196BEGIN {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};
3801: 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 '------------------');
402END.
403
HIC SVNT DRACONES