1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 
  7 /*
  8 Fall//79, Robert E. Mullen, Initial coding.
  9 06/29/81, Jeffrey D. Ives, added SUB TOTALs.
 10 03/29/82, Jeffrey D. Ives, added -bf and -of and made trace table 0 relative.
 11 07/22/83, Jeffrey D. Ives, for new tab with bigger vcpu and real time fields.  Added VCPU/CALL.
 12 May 1984, Jeffrey D. Ives, get rid of tab altogether and go to new interface.
 13 */
 14 
 15 /* format: style2,^inddcls,^indnoniterdo,^inditerdo,dclind5,idind35 */
 16 trace_meters:
 17 tmt:
 18      procedure options (variable);
 19 
 20 /* DISABLE TRACE_CATCH_ */
 21 
 22           transaction_id = clock ();
 23           on cleanup call TRACE_METERS_CLEANUP ();
 24           if ^trace_$transaction_begin (transaction_id)     /* Temporarily disables trace_catch_.                       */
 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 /* read the arguments */
 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 /* Open the output file if necessary. */
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 /* Do some consistency checks. */
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 /* Calculate the percentage coefficients. */
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 /* Print the requested information. */
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 /* Print column headers if necessary */
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 /* Print the stats for this entrypoint. */
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 /* SUBROUTINES */
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)       /* Re-enable trace_catch_. */
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 /* START OF DECLARATIONS */
387 /* format: ^insnl,^delnl */
388 
389 
390 /* Parameters */
391 
392 
393 /* Automatic */
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 /* Static */
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 /* Conditions */
448 
449 dcl  cleanup                            condition;
450 
451 
452 /* Based */
453 
454 dcl  arg                                char (arg_length) based (arg_ptr);
455 
456 
457 /* External Variables */
458 
459 dcl  error_table_$badopt                fixed bin (35) ext;
460 dcl  iox_$user_output                   ptr ext;
461 
462 
463 /* External Entries */
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 /* format: insnl,delnl */
482 /* END OF DECLARATIONS */
483 %page;
484 /* START OF INCLUDE FILES */
485 
486 
487 %page;
488 %include iox_modes;
489 %page;
490 %include trace_interface;
491 
492      end trace_meters;