1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 trace_meters:
17 tmt:
18 procedure options (variable);
19
20
21
22 transaction_id = clock ();
23 on cleanup call TRACE_METERS_CLEANUP ();
24 if ^trace_$transaction_begin (transaction_id)
25 then do;
26 call com_err_ (code, ME, "There seems to be an incomplete invocation of trace,
27 watch, or trace_meters still on the stack. Try the release command.");
28 return;
29 end;
30 %page;
31
32
33 call cu_$arg_count (arg_count, code);
34 if code ^= 0
35 then do;
36 call com_err_ (code, ME);
37 go to RETURN;
38 end;
39
40 ARG_READING_LOOP:
41 do arg_idx = 1 to arg_count;
42 call cu_$arg_ptr (arg_idx, arg_ptr, arg_length, code);
43 if code ^= 0
44 then do;
45 call com_err_ (code, ME);
46 go to RETURN;
47 end;
48
49 if arg = "-brief" | arg = "-bf"
50 then long_format = "0"b;
51 else if arg = "-long" | arg = "-lg"
52 then long_format = "1"b;
53 else if arg = "-reset" | arg = "-rs"
54 then do;
55 reset = "1"b;
56 report = "0"b;
57 end;
58 else if arg = "-report_reset" | arg = "-rr"
59 then do;
60 reset = "1"b;
61 report = "1"b;
62 end;
63 else if arg = "-output_file" | arg = "-of"
64 then do;
65 control_arg = arg;
66
67 arg_idx = arg_idx + 1;
68 call cu_$arg_ptr (arg_idx, arg_ptr, arg_length, code);
69 if code ^= 0
70 then do;
71 BAD_FILE_PATH_ARG:
72 call com_err_ (code, ME, " A pathname must follow ^a.", control_arg);
73 go to RETURN;
74 end;
75
76 if arg = ""
77 then go to BAD_FILE_PATH_ARG;
78
79 if substr (arg, 1, 1) = "-"
80 then go to BAD_FILE_PATH_ARG;
81
82 call expand_pathname_$add_suffix (arg, "tmt", output_file.dir_path, output_file.entry_name, code);
83 if code ^= 0
84 then do;
85 call com_err_ (code, ME, " The argument in error is ""^a"".", arg);
86 go to RETURN;
87 end;
88 end;
89 else if arg = "-percent" | arg = "-pct" | arg = "-%"
90 then do;
91 minimum.kind = "local";
92 go to GET_PERCENTAGE;
93 end;
94 else if arg = "-global_percent" | arg = "-gpct" | arg = "-g%"
95 then do;
96 minimum.kind = "global";
97 GET_PERCENTAGE:
98 control_arg = arg;
99
100 arg_idx = arg_idx + 1;
101 call cu_$arg_ptr (arg_idx, arg_ptr, arg_length, code);
102 if code ^= 0
103 then do;
104 BAD_PERCENTAGE_ARG:
105 call com_err_ (code, ME, " A number between 0 and 100 must follow ^a.", control_arg);
106 go to RETURN;
107 end;
108
109 if arg = ""
110 then go to BAD_PERCENTAGE_ARG;
111
112 if substr (arg, 1, 1) = "-"
113 then go to BAD_PERCENTAGE_ARG;
114
115 numeric_arg = cv_dec_check_ (arg, code);
116 if code ^= 0
117 then do;
118 call com_err_ (ZERO, ME, " Decimal conversion error at ""^a"" in ""^a"".", substr (arg, code, 1),
119 arg);
120 code = 0;
121 go to BAD_PERCENTAGE_ARG;
122 end;
123
124 if numeric_arg < 0 | numeric_arg > 100
125 then go to BAD_PERCENTAGE_ARG;
126
127 minimum.percent = numeric_arg;
128 end;
129 else do;
130 call com_err_ (error_table_$badopt, ME, """^a""", arg);
131 go to RETURN;
132 end;
133 end ARG_READING_LOOP;
134 %page;
135
136
137 if output_file.entry_name = ""
138 then output_file.iocb_ptr = iox_$user_output;
139 else
140 OPEN_OUTPUT_FILE:
141 do;
142 call iox_$attach_name (unique_chars_ (""b), output_file.iocb_ptr,
143 "vfile_ " || rtrim (output_file.dir_path) || ">" || rtrim (output_file.entry_name),
144 codeptr (trace_meters), code);
145 if code ^= 0
146 then do;
147 call com_err_ (code, ME, " Coult not attach the file ""^a>^a"".", output_file.dir_path,
148 output_file.entry_name);
149 go to RETURN;
150 end;
151
152 call iox_$open (output_file.iocb_ptr, Stream_output, "0"b, code);
153 if code ^= 0
154 then do;
155 call com_err_ (code, ME, " Could not open the file ""^a>^a"".", output_file.dir_path,
156 output_file.entry_name);
157 go to RETURN;
158 end;
159 end OPEN_OUTPUT_FILE;
160
161
162
163
164 metered = trace_$metered () - trace_$removed ();
165
166 if metered.real_time < 0 | metered.vcpu_time > metered.real_time | metered.page_faults < 0
167 then call com_err_ (ZERO, ME,
168 " The meters are inconsistent. Metered real time is ^d, vcpu time is ^d, and page faults are ^d.",
169 metered.real_time, metered.vcpu_time, metered.page_faults);
170
171
172
173
174 if metered.vcpu_time = 0
175 then percentage_coefficient.vcpu_time = 0;
176 else percentage_coefficient.vcpu_time = 1e2 / float (metered.vcpu_time, 27);
177
178 if metered.page_faults = 0
179 then percentage_coefficient.page_faults = 0;
180 else percentage_coefficient.page_faults = 1e2 / float (metered.page_faults, 27);
181 %page;
182
183
184 totals = 0;
185 tt_count = trace_$num_entrypoints ();
186
187 TOTAL_LOOP:
188 do tt_idx = 0 by 0 to tt_count - 1;
189
190 segment_being_subtotaled.seg_num = baseno (trace_$entrypoint_ptr (tt_idx));
191 segment_being_subtotaled.dir_path = "?";
192 segment_being_subtotaled.entry_name = "?";
193
194 subtotals = 0;
195
196 SUB_TOTAL_LOOP:
197 do tt_idx = tt_idx to tt_count - 1
198 while (baseno (trace_$entrypoint_ptr (tt_idx)) = segment_being_subtotaled.seg_num);
199
200 counts = trace_$entrypoint_counts (tt_idx);
201 local_meters = trace_$entrypoint_local_meters (tt_idx);
202 global_meters = trace_$entrypoint_global_meters (tt_idx);
203
204 if ^report
205 then go to END_SUB_TOTAL_LOOP;
206
207 if counts.calls = 0
208 then go to END_SUB_TOTAL_LOOP;
209
210 if minimum.kind = "local"
211 then if float (local_meters.vcpu_time, 27) * percentage_coefficient.vcpu_time < minimum.percent
212 & float (local_meters.page_faults, 27) * percentage_coefficient.page_faults
213 < minimum.percent
214 then go to END_SUB_TOTAL_LOOP;
215
216 if minimum.kind = "global"
217 then if float (global_meters.vcpu_time, 27) * percentage_coefficient.vcpu_time < minimum.percent
218 & float (global_meters.page_faults, 27) * percentage_coefficient.page_faults
219 < minimum.percent
220 then go to END_SUB_TOTAL_LOOP;
221
222
223
224 if subtotals.line_count = 0
225 then do;
226 if long_format
227 then do;
228 call PRINT_METERS_HEADER ("G");
229 call PRINT_METERS_HEADER ("L");
230 call expand_pathname_ ((trace_$entrypoint_seg_path (tt_idx)),
231 segment_being_subtotaled.dir_path, segment_being_subtotaled.entry_name, code);
232 if code ^= 0
233 then segment_being_subtotaled.dir_path, segment_being_subtotaled.entry_name = "?";
234 call ioa_$ioa_switch (output_file.iocb_ptr, " ^a>^a", segment_being_subtotaled.dir_path,
235 segment_being_subtotaled.entry_name);
236 end;
237
238 if ^long_format & totals.line_count = 0
239 then do;
240 call PRINT_METERS_HEADER ("L");
241 call ioa_$ioa_switch (output_file.iocb_ptr, " ENTRY POINT NAME");
242 end;
243 end;
244
245
246
247
248 if long_format
249 then call PRINT_METERS (global_meters);
250
251 call PRINT_METERS (local_meters);
252
253 call PRINT_STATS (local_meters.vcpu_time, counts.calls);
254
255 call ioa_$ioa_switch (output_file.iocb_ptr, " ^a", trace_$entrypoint_name (tt_idx));
256
257 subtotals.line_count = subtotals.line_count + 1;
258 subtotals.calls = subtotals.calls + counts.calls;
259 subtotals.meters = subtotals.meters + local_meters;
260
261 END_SUB_TOTAL_LOOP:
262 end SUB_TOTAL_LOOP;
263
264 if report & long_format & subtotals.line_count >= 1
265 then do;
266 if subtotals.line_count >= 2
267 then call PRINT_TOTAL_LINE (subtotals, "SUBTOTAL", segment_being_subtotaled.entry_name);
268
269 call ioa_$ioa_switch (output_file.iocb_ptr, "");
270 end;
271
272 totals = totals + subtotals;
273 end TOTAL_LOOP;
274
275
276 if report
277 then do;
278 if long_format
279 then call PRINT_METERS_HEADER (" ");
280 else call ioa_$ioa_switch (output_file.iocb_ptr, "");
281
282 call PRINT_METERS_HEADER ("L");
283
284 call ioa_$ioa_switch (output_file.iocb_ptr, "");
285
286 call date_time_ (clock (), date_time_string);
287
288 call PRINT_TOTAL_LINE (totals, "TOTAL", date_time_string);
289 end;
290
291
292 if reset
293 then call trace_$reset_meters ();
294
295
296 RETURN:
297 call TRACE_METERS_CLEANUP;
298
299 return;
300 %page;
301
302
303
304 TRACE_METERS_CLEANUP:
305 proc;
306 if output_file.iocb_ptr ^= null () & output_file.iocb_ptr ^= iox_$user_output
307 then do;
308 call iox_$close (output_file.iocb_ptr, (0));
309 call iox_$detach_iocb (output_file.iocb_ptr, (0));
310 output_file.iocb_ptr = null ();
311 end;
312
313 if ^trace_$transaction_end (transaction_id)
314 then call com_err_ (ZERO, ME, "The trace_meters command ended abnormally.");
315 end TRACE_METERS_CLEANUP;
316
317
318
319
320
321
322
323
324 PRINT_TOTAL_LINE:
325 proc (totals_i, comment_1_i, comment_2_i);
326 if long_format
327 then call PRINT_METERS_HEADER (" ");
328
329 call PRINT_METERS (totals_i.meters);
330
331 call PRINT_STATS (totals_i.meters.vcpu_time, totals_i.calls);
332
333 call ioa_$ioa_switch (output_file.iocb_ptr, " ^a ^a", comment_1_i, comment_2_i);
334
335 dcl 1 totals_i aligned parm like totals;
336 dcl comment_1_i char (*) parm;
337 dcl comment_2_i char (*) parm;
338 end PRINT_TOTAL_LINE;
339
340
341
342
343
344
345 PRINT_METERS_HEADER:
346 proc (leading_letter_i);
347 if leading_letter_i = " "
348 then call ioa_$ioa_switch_nnl (output_file.iocb_ptr, "^24x");
349 else call ioa_$ioa_switch_nnl (output_file.iocb_ptr, " ^aREAL ^aVCPU ^aPF^[ LVCPU/CALL LVCPU% CALLS^]",
350 leading_letter_i, leading_letter_i, leading_letter_i, leading_letter_i = "L");
351
352 dcl leading_letter_i char parm;
353 end PRINT_METERS_HEADER;
354
355
356
357
358
359
360
361 PRINT_METERS:
362 proc (meters_i);
363 if meters_i.real_time = 0 & meters_i.vcpu_time = 0 & meters_i.page_faults = 0
364 then call PRINT_METERS_HEADER (" ");
365 else call ioa_$ioa_switch_nnl (output_file.iocb_ptr, "^9.3f ^8.3f ^5d", float (meters_i.real_time, 27) * 1e-6,
366 float (meters_i.vcpu_time, 27) * 1e-6, meters_i.page_faults);
367
368 dcl 1 meters_i aligned parm like local_meters;
369 end PRINT_METERS;
370
371
372
373
374 PRINT_STATS:
375 proc (vcpu_time_i, calls_i);
376 if vcpu_time_i = 0 | calls_i = 0
377 then call ioa_$ioa_switch_nnl (output_file.iocb_ptr, " ^10x ^5x ^7d", calls_i);
378 else call ioa_$ioa_switch_nnl (output_file.iocb_ptr, " ^10.6f ^5.1f ^7d",
379 (float (vcpu_time_i, 27) / float (calls_i, 27)) * 1e-6,
380 float (vcpu_time_i, 27) * percentage_coefficient.vcpu_time, calls_i);
381
382 dcl vcpu_time_i fixed bin (53) parm;
383 dcl calls_i fixed bin (53) parm;
384 end PRINT_STATS;
385 %page;
386
387
388
389
390
391
392
393
394
395 dcl arg_count fixed bin;
396 dcl arg_idx fixed bin;
397 dcl arg_length fixed bin (21);
398 dcl arg_ptr ptr init (null ());
399 dcl code fixed bin (35) init (0);
400 dcl control_arg char (32);
401 dcl date_time_string char (24);
402 dcl in_trace_saved bit (36) aligned;
403 dcl long_format bit aligned init ("1"b);
404 dcl numeric_arg fixed bin (35);
405 dcl report bit aligned init ("1"b);
406 dcl reset bit aligned init ("0"b);
407 dcl transaction_id fixed bin (71);
408 dcl tt_count fixed bin;
409 dcl tt_idx fixed bin;
410
411 dcl 1 local_meters like meters aligned;
412 dcl 1 global_meters like meters aligned;
413 dcl 1 metered like meters aligned;
414
415 dcl 1 minimum aligned,
416 2 kind char (8) init (""),
417 2 percent float bin (27) init (0);
418
419 dcl 1 output_file aligned,
420 2 iocb_ptr ptr init (null ()),
421 2 dir_path char (168) unal init (""),
422 2 entry_name char (32) unal init ("");
423
424 dcl 1 percentage_coefficient aligned,
425 2 vcpu_time float bin (27),
426 2 page_faults float bin (27);
427
428 dcl 1 totals aligned,
429 2 line_count fixed bin,
430 2 calls fixed bin (53),
431 2 meters like meters;
432
433 dcl 1 subtotals aligned like totals;
434
435 dcl 1 segment_being_subtotaled aligned,
436 2 seg_num bit (18),
437 2 dir_path char (168) unal,
438 2 entry_name char (32) unal;
439
440
441
442
443 dcl ME char (32) static options (constant) init ("trace_meters");
444 dcl ZERO fixed bin (35) static options (constant) init (0);
445
446
447
448
449 dcl cleanup condition;
450
451
452
453
454 dcl arg char (arg_length) based (arg_ptr);
455
456
457
458
459 dcl error_table_$badopt fixed bin (35) ext;
460 dcl iox_$user_output ptr ext;
461
462
463
464
465 dcl com_err_ entry () options (variable);
466 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
467 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
468 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
469 dcl date_time_ entry (fixed bin (71), char (*));
470 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
471 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
472 dcl ioa_$ioa_switch entry () options (variable);
473 dcl ioa_$ioa_switch_nnl entry () options (variable);
474 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
475 dcl iox_$close entry (ptr, fixed bin (35));
476 dcl iox_$detach_iocb entry (ptr, fixed bin (35));
477 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
478 dcl unique_chars_ entry (bit (*)) returns (char (15));
479
480
481
482
483 %page;
484
485
486
487 %page;
488 %include iox_modes;
489 %page;
490 %include trace_interface;
491
492 end trace_meters;