1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 %page;
16 trace:
17 procedure options (variable);
18
19
20
21 transaction_id = clock ();
22 on cleanup status = trace_$transaction_end (transaction_id);
23
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
31
32
33 call condition_ ("sub_error_", SUB_ERROR_HANDLER);
34
35
36
37 set_defaults = "0"b;
38 add_remove_action = "";
39 on_off_action = "";
40 parameters = "0"b;
41 print_buffer = 0;
42 status = "0"b;
43
44
45
46 call cu_$arg_count (arg_count, code);
47 if code ^= 0
48 then do;
49 call com_err_ (code, ME);
50 go to TRANSACTION_END;
51 end;
52
53 arg_idx = 1;
54 ARGUMENT_LOOP:
55 do while (arg_idx <= arg_count);
56 call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);
57 if code ^= 0
58 then do;
59 call com_err_ (code, ME);
60 go to TRANSACTION_END;
61 end;
62
63 if length (arg) = 0
64 then do;
65 call com_err_ (code, ME, "A null argument was found where an entrypoint was expected.");
66 go to TRANSACTION_END;
67 end;
68
69 if substr (arg, 1, 1) ^= "-"
70 then
71 ENTRYPOINTS_ARGUMENT:
72 do;
73 call CHECK_NEXT_ARG (arg, 256, "trace", "entrypoints", " control_args");
74 call trace_$specify_entrypoints ((arg), null ());
75 arg_idx = arg_idx + 1;
76 end ENTRYPOINTS_ARGUMENT;
77
78 else
79 CONTROL_ARGUMENT:
80 do;
81 if arg_idx + 1 > arg_count
82 then next_arg_ptr = null ();
83 else do;
84 call cu_$arg_ptr (arg_idx + 1, next_arg_ptr, next_arg_len, code);
85 if code ^= 0
86 then do;
87 call com_err_ (code, ME);
88 go to TRANSACTION_END;
89 end;
90
91 if length (next_arg) > 0
92 then if substr (next_arg, 1, 1) = "-"
93 then next_arg_ptr = null ();
94 end;
95
96 if arg = "-add"
97 then do;
98 add_remove_action = "add";
99 arg_idx = arg_idx + 1;
100 end;
101
102 else if arg = "-alm"
103 then do;
104 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
105 call trace_$set_alm (trace_$cv_onoff_to_bit ((next_arg)));
106 arg_idx = arg_idx + 2;
107 end;
108
109 else if arg = "-arguments" | arg = "-ag" | arg = "-argument" | arg = "-args" | arg = "-arg"
110 | arg = "-ags"
111 then do;
112 call CHECK_NEXT_ARG (next_arg, 8, arg, "in|out|on|off", "");
113 call trace_$set_arguments (trace_$cv_inout_to_bits ((next_arg)));
114 arg_idx = arg_idx + 2;
115 end;
116
117 else if arg = "-automatic" | arg = "-auto"
118 then do;
119 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
120 call trace_$set_automatic (trace_$cv_onoff_to_bit ((next_arg)));
121 call trace_$set_signals (trace_$cv_onoff_to_bit ((next_arg)));
122 arg_idx = arg_idx + 2;
123 end;
124
125 else if arg = "-brief" | arg = "-bf"
126 then do;
127 call trace_$set_long ("0"b);
128 arg_idx = arg_idx + 1;
129 end;
130
131 else if arg = "-buffer" | arg = "-buf" | arg = "-buff"
132 then do;
133 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
134 call trace_$set_buffer (trace_$cv_onoff_to_bit ((next_arg)));
135 arg_idx = arg_idx + 2;
136 end;
137
138 else if arg = "-calibrate"
139 then do;
140 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
141 call trace_$set_calibrate (trace_$cv_onoff_to_bit ((next_arg)));
142 arg_idx = arg_idx + 2;
143 end;
144
145 else if arg = "-call"
146 then do;
147 call CHECK_NEXT_ARG (next_arg, 256, arg, "COMMAND-LINE", " (if CL contains spaces, it must be quoted)");
148 call trace_$set_call ((next_arg));
149 arg_idx = arg_idx + 2;
150 end;
151
152 else if arg = "-disable" | arg = "-disa" | arg = "-dis"
153 then do;
154 call trace_$set_enabled ("0"b);
155 arg_idx = arg_idx + 1;
156 end;
157
158 else if arg = "-enable" | arg = "-ena" | arg = "-en"
159 then do;
160 call trace_$set_enabled ("1"b);
161 arg_idx = arg_idx + 1;
162 end;
163
164 else if arg = "-every" | arg = "-ev"
165 then do;
166 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
167 call trace_$set_every (trace_$cv_n_to_number ((next_arg)));
168 arg_idx = arg_idx + 2;
169 end;
170
171 else if arg = "-first" | arg = "-ft"
172 then do;
173 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
174 call trace_$set_first (trace_$cv_n_to_number ((next_arg)));
175 arg_idx = arg_idx + 2;
176 end;
177
178 else if arg = "-high"
179 then do;
180 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
181 call trace_$set_high (trace_$cv_n_to_number ((next_arg)));
182 arg_idx = arg_idx + 2;
183 end;
184
185 else if arg = "-last" | arg = "-lt"
186 then do;
187 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
188 call trace_$set_last (trace_$cv_n_to_number ((next_arg)));
189 arg_idx = arg_idx + 2;
190 end;
191
192 else if arg = "-long" | arg = "-lg"
193 then do;
194 call trace_$set_long ("1"b);
195 arg_idx = arg_idx + 1;
196 end;
197
198 else if arg = "-loud"
199 then do;
200 call trace_$set_loud ("1"b);
201 arg_idx = arg_idx + 1;
202 end;
203
204 else if arg = "-low"
205 then do;
206 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
207 call trace_$set_low (trace_$cv_n_to_number ((next_arg)));
208 arg_idx = arg_idx + 2;
209 end;
210
211 else if arg = "-meter" | arg = "-mt" | arg = "-meters" | arg = "-mts"
212 then do;
213 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
214 call trace_$set_meter (trace_$cv_onoff_to_bit ((next_arg)));
215 arg_idx = arg_idx + 2;
216 end;
217
218 else if arg = "-new_high"
219 then do;
220 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
221 call trace_$set_new_high (trace_$cv_onoff_to_bit ((next_arg)));
222 arg_idx = arg_idx + 2;
223 end;
224
225 else if arg = "-no_alm"
226 then do;
227 call trace_$set_alm ("0"b);
228 arg_idx = arg_idx + 1;
229 end;
230
231 else if arg = "-no_arguments" | arg = "-nag" | arg = "-no_argument" | arg = "-nargs" | arg = "-narg"
232 | arg = "-nags"
233 then do;
234 call trace_$set_arguments ("00"b);
235 arg_idx = arg_idx + 1;
236 end;
237
238 else if arg = "-no_automatic" | arg = "-nauto"
239 then do;
240 call trace_$set_automatic ("0"b);
241 call trace_$set_signals ("0"b);
242 arg_idx = arg_idx + 1;
243 end;
244
245 else if arg = "-no_buffer" | arg = "-nbuf" | arg = "-nbuff"
246 then do;
247 call trace_$set_buffer ("0"b);
248 arg_idx = arg_idx + 1;
249 end;
250
251 else if arg = "-no_calibrate"
252 then do;
253 call trace_$set_calibrate ("0"b);
254 arg_idx = arg_idx + 1;
255 end;
256
257 else if arg = "-no_call"
258 then do;
259 call trace_$set_call ("");
260 arg_idx = arg_idx + 1;
261 end;
262
263 else if arg = "-no_every" | arg = "-nev"
264 then do;
265 call trace_$set_every (0);
266 arg_idx = arg_idx + 1;
267 end;
268
269 else if arg = "-no_first" | arg = "-nft"
270 then do;
271 call trace_$set_first (0);
272 arg_idx = arg_idx + 1;
273 end;
274
275 else if arg = "-no_high"
276 then do;
277 call trace_$set_high (0);
278 arg_idx = arg_idx + 1;
279 end;
280
281 else if arg = "-no_last" | arg = "-nlt"
282 then do;
283 call trace_$set_last (0);
284 arg_idx = arg_idx + 1;
285 end;
286
287 else if arg = "-no_low"
288 then do;
289 call trace_$set_low (0);
290 arg_idx = arg_idx + 1;
291 end;
292
293 else if arg = "-no_meter" | arg = "-nmt" | arg = "-no_meters" | arg = "-nmts"
294 then do;
295 call trace_$set_meter ("0"b);
296 arg_idx = arg_idx + 1;
297 end;
298
299 else if arg = "-no_new_high"
300 then do;
301 call trace_$set_new_high ("0"b);
302 arg_idx = arg_idx + 1;
303 end;
304
305 else if arg = "-no_output_file" | arg = "-nof"
306 then do;
307 call trace_$set_output_switch (trace_$cv_file_path_to_osw ("", null ()));
308 arg_idx = arg_idx + 1;
309 end;
310
311 else if arg = "-no_output_switch" | arg = "-nosw"
312 then do;
313 call trace_$set_output_switch (trace_$cv_stream_name_to_osw (""));
314 arg_idx = arg_idx + 1;
315 end;
316
317 else if arg = "-no_signals" | arg = "-nsig" | arg = "-no_signal" | arg = "-nsigs"
318 then do;
319 call trace_$set_signals ("0"b);
320 arg_idx = arg_idx + 1;
321 end;
322
323 else if arg = "-no_stop" | arg = "-nsp"
324 then do;
325 call trace_$set_stop ("00"b);
326 arg_idx = arg_idx + 1;
327 end;
328
329 else if arg = "-no_stop_every" | arg = "-nspev"
330 then do;
331 call trace_$set_every (0);
332 arg_idx = arg_idx + 1;
333 end;
334
335 else if arg = "-no_stop_low" | arg = "-nsplow"
336 then do;
337 call trace_$set_stop_low (0);
338 arg_idx = arg_idx + 1;
339 end;
340
341 else if arg = "-no_stop_proc" | arg = "-nspp"
342 then do;
343 call trace_$set_stop_proc (trace_$cv_entry_name_to_spp ("", null ()));
344 arg_idx = arg_idx + 1;
345 end;
346
347 else if arg = "-no_trace"
348 then do;
349 call trace_$set_trace ("00"b);
350 arg_idx = arg_idx + 1;
351 end;
352
353 else if arg = "-off"
354 then do;
355 on_off_action = "off";
356 arg_idx = arg_idx + 1;
357 end;
358
359 else if arg = "-on"
360 then do;
361 on_off_action = "on";
362 arg_idx = arg_idx + 1;
363 end;
364
365 else if arg = "-output_file" | arg = "-of"
366 then do;
367 call CHECK_NEXT_ARG (next_arg, 256, arg, "PATH", "");
368 call trace_$set_output_switch (trace_$cv_file_path_to_osw ((next_arg), null ()));
369 arg_idx = arg_idx + 2;
370 end;
371
372 else if arg = "-output_switch" | arg = "-osw"
373 then do;
374 call CHECK_NEXT_ARG (next_arg, 32, arg, "SWITCH", " (SWITCH must be open for stream output)");
375 call trace_$set_output_switch (trace_$cv_stream_name_to_osw ((next_arg)));
376 arg_idx = arg_idx + 2;
377 end;
378
379 else if arg = "-parameters" | arg = "-pm" | arg = "-parameter" | arg = "-pms" | arg = "-parm"
380 | arg = "-parms"
381 then do;
382 parameters = "1"b;
383 arg_idx = arg_idx + 1;
384 end;
385
386 else if arg = "-print_buffer" | arg = "-prbuf" | arg = "-prbuff"
387 then do;
388 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
389 print_buffer = trace_$cv_n_to_number ((next_arg));
390 arg_idx = arg_idx + 2;
391 end;
392
393 else if arg = "-quiet"
394 then do;
395 call trace_$set_loud ("0"b);
396 arg_idx = arg_idx + 1;
397 end;
398
399 else if arg = "-remove" | arg = "-rm"
400 then do;
401 add_remove_action = "remove";
402 arg_idx = arg_idx + 1;
403 end;
404
405 else if arg = "-set_defaults" | arg = "-sdft" | arg = "-set_default" | arg = "-sdf" | arg = "-sdfs"
406 | arg = "-sdfts"
407 then do;
408 set_defaults = "1"b;
409 arg_idx = arg_idx + 1;
410 end;
411
412 else if arg = "-signals" | arg = "-sig" | arg = "-signal" | arg = "-sigs"
413 then do;
414 call CHECK_NEXT_ARG (next_arg, 8, arg, "on|off", "");
415 call trace_$set_signals (trace_$cv_onoff_to_bit ((next_arg)));
416 arg_idx = arg_idx + 2;
417 end;
418
419 else if arg = "-status" | arg = "-st"
420 then do;
421 status = "1"b;
422 arg_idx = arg_idx + 1;
423 end;
424
425 else if arg = "-stop" | arg = "-sp"
426 then do;
427 call CHECK_NEXT_ARG (next_arg, 8, arg, "in|out|on|off", "");
428 call trace_$set_stop (trace_$cv_inout_to_bits ((next_arg)));
429 arg_idx = arg_idx + 2;
430 end;
431
432 else if arg = "-stop_every" | arg = "-spev"
433 then do;
434 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
435 call trace_$set_stop_every (trace_$cv_n_to_number ((next_arg)));
436 arg_idx = arg_idx + 2;
437 end;
438
439 else if arg = "-stop_proc" | arg = "-spp"
440 then do;
441 call CHECK_NEXT_ARG (next_arg, 256, arg, "ENTRYNAME", "");
442 call trace_$set_stop_proc (trace_$cv_entry_name_to_spp ((next_arg), null ()));
443 arg_idx = arg_idx + 2;
444 end;
445
446 else if arg = "-stop_low" | arg = "-splow"
447 then do;
448 call CHECK_NEXT_ARG (next_arg, 16, arg, "N", " (where N is positive or 0)");
449 call trace_$set_stop_low (trace_$cv_n_to_number ((next_arg)));
450 arg_idx = arg_idx + 2;
451 end;
452
453 else if arg = "-trace"
454 then do;
455 call CHECK_NEXT_ARG (next_arg, 8, arg, "in|out|on|off", "");
456 call trace_$set_trace (trace_$cv_inout_to_bits ((next_arg)));
457 arg_idx = arg_idx + 2;
458 end;
459
460
461
462 else if arg = "-return_value" | arg = "-rv"
463 then do;
464 call com_err_ (ZERO, ME, "The ^a argument is now obsolete.
465 Trace automatically determines whether entrypoints return values.", arg);
466 go to TRANSACTION_END;
467 end;
468
469 else if arg = "-start" | arg = "-sr"
470 then do;
471 call OBSOLETE_ARG (arg, "-add");
472 go to TRANSACTION_END;
473 end;
474
475 else if arg = "-before"
476 then do;
477 call OBSOLETE_ARG (arg, "-stop_every N -stop in (-spev N -sp in)");
478 go to TRANSACTION_END;
479 end;
480
481 else if arg = "-after"
482 then do;
483 call OBSOLETE_ARG (arg, "-stop_every N -stop out (-spev N -sp out)");
484 go to TRANSACTION_END;
485 end;
486
487 else if arg = "-depth " | arg = "-dh"
488 then do;
489 call OBSOLETE_ARG (arg, "-high");
490 go to TRANSACTION_END;
491 end;
492
493 else if arg = "-in"
494 then do;
495 call OBSOLETE_ARG (arg, "-arguments in (-ag in)");
496 go to TRANSACTION_END;
497 end;
498
499 else if arg = "-out"
500 then do;
501 call OBSOLETE_ARG (arg, "-arguments out (-ag out)");
502 go to TRANSACTION_END;
503 end;
504
505 else if arg = "-inout"
506 then do;
507 call OBSOLETE_ARG (arg, "-arguments inout (-ag inout)");
508 go to TRANSACTION_END;
509 end;
510
511 else if arg = "-template" | arg = "-tp"
512 then do;
513 call OBSOLETE_ARG (arg, "-parameters (-pm)");
514 go to TRANSACTION_END;
515 end;
516
517 else if arg = "-govern " | arg = "-gv"
518 then do;
519 call OBSOLETE_ARG (arg, "-stop_low N -stop in (-splow N -sp in)");
520 go to TRANSACTION_END;
521 end;
522
523 else if arg = "-execute" | arg = "-ex"
524 then do;
525 call OBSOLETE_ARG (arg, "-call");
526 go to TRANSACTION_END;
527 end;
528
529
530
531 else if arg = "-print " | arg = "-pr"
532 then do;
533 call OBSOLETE_ARG (arg, "-status (-st)");
534 go to TRANSACTION_END;
535 end;
536
537 else if arg = "-reset " | arg = "-rs"
538 then do;
539 call OBSOLETE_ARG (arg, "the trace_meters command (tmt)");
540 go to TRANSACTION_END;
541 end;
542
543 else if arg = "-total" | arg = "-tt"
544 then do;
545 call OBSOLETE_ARG (arg, "the trace_meters command (tmt)");
546 go to TRANSACTION_END;
547 end;
548
549 else if arg = "-subtotal" | arg = "-stt"
550 then do;
551 call OBSOLETE_ARG (arg, "the trace_meters command (tmt)");
552 go to TRANSACTION_END;
553 end;
554
555 else if arg = "-reset_total" | arg = "-rst"
556 then do;
557 call OBSOLETE_ARG (arg, "the trace_meters command (tmt -rs)");
558 go to TRANSACTION_END;
559 end;
560
561 else if arg = "-reset_subtotal" | arg = "-rss"
562 then do;
563 call OBSOLETE_ARG (arg, "the trace_meters command (tmt -rs)");
564 go to TRANSACTION_END;
565 end;
566
567
568
569 else do;
570 call com_err_ (error_table_$badopt, ME, """^a""", arg);
571 go to TRANSACTION_END;
572 end;
573 end CONTROL_ARGUMENT;
574 end ARGUMENT_LOOP;
575 %page;
576
577
578
579
580
581
582
583 call SAY_BEGIN ();
584
585 if FIRST_TIME
586 then do;
587 call SAY (trace_$version ());
588 FIRST_TIME = "0"b;
589 end;
590
591 if trace_$update_global_parms ()
592 then call SAY ("global parms changed");
593
594 if set_defaults
595 then do;
596 if trace_$update_default_parms ()
597 then call SAY ("default parms changed");
598 end;
599
600 n_specified = trace_$num_specified_entrypoints ();
601
602 if n_specified > 0
603 then
604 ENTRYPOINT_ACTION:
605 do;
606 call SAY_N_ENTRYPOINTS (n_specified, "specified");
607
608 if add_remove_action = "" & on_off_action = "" & ^status
609 then add_remove_action = "add";
610
611 if add_remove_action = "add"
612 then
613 begin;
614 dcl n_added fixed bin;
615 dcl n_modified fixed bin;
616 call trace_$add_specified_eps (n_added, n_modified);
617 call SAY_N_ENTRYPOINTS (n_added, "added");
618 if n_modified > 0
619 then call SAY_N_ENTRYPOINTS (n_modified, "modified");
620 end;
621
622 if add_remove_action = "remove"
623 then
624 begin;
625 dcl n_removed fixed bin;
626 call trace_$remove_specified_eps (n_removed);
627 call SAY_N_ENTRYPOINTS (n_removed, "removed");
628 end;
629
630 if on_off_action = "on"
631 then
632 begin;
633 dcl n_turned_on fixed bin;
634 call trace_$turn_on_specified_eps (n_turned_on);
635 call SAY_N_ENTRYPOINTS (n_turned_on, "turned on");
636 end;
637
638 if on_off_action = "off"
639 then
640 begin;
641 dcl n_turned_off fixed bin;
642 call trace_$turn_off_specified_eps (n_turned_off);
643 call SAY_N_ENTRYPOINTS (n_turned_off, "turned off");
644 end;
645 end ENTRYPOINT_ACTION;
646
647 n_entrypoints = trace_$num_entrypoints ();
648 if n_entrypoints = 0
649 then call SAY ("trace table empty");
650 else call SAY_N_ENTRYPOINTS (n_entrypoints, "in trace table");
651
652 if ^trace_$enabled ()
653 then call SAY ("disabled");
654 else if trace_$in_trace ()
655 then call SAY ("temporarily disabled");
656
657 call SAY_END ();
658
659 if parameters | arg_count = 0
660 then do;
661 call ioa_ ("Global parms: ^a", trace_$global_parms_string ());
662 call ioa_ ("Default parms: ^a", trace_$parms_string (-1, "0"b));
663 end;
664
665 if arg_count = 0
666 then call ioa_ ("Acts: -set_defaults -add/-remove -on/-off -parameters -status -print_buffer.");
667
668 if add_remove_action = ""
669 then if trace_$parms_specified ()
670 then call ioa_ ("The trace parameters you specified were ineffectual because
671 you did not specify any entrypoints to be added or -set_defaults.");
672
673 if status & n_entrypoints ^= 0
674 then
675 STATUS:
676 begin;
677 dcl ep_idx fixed bin;
678 dcl ep_ptr ptr;
679 dcl n_not_in_tt fixed bin;
680 dcl old_seg_no bit (18) aligned;
681 dcl specified_ep_idx fixed bin;
682
683 if n_specified = 0
684 then call ioa_ ("If you want status, you must specify some entrypoints.");
685 else call ioa_ ("^/ CALLS RECURSION/HIGHEST NAME ^18x(STATUS) PARMS ^= DEFAULTS");
686 old_seg_no = ""b;
687 n_not_in_tt = 0;
688 do specified_ep_idx = 0 to n_specified - 1;
689 ep_idx = trace_$specified_entrypoint_index (specified_ep_idx);
690 if ep_idx < 0
691 then n_not_in_tt = n_not_in_tt + 1;
692 else do;
693 ep_ptr = trace_$entrypoint_ptr (ep_idx);
694 if baseno (ep_ptr) ^= old_seg_no
695 then do;
696 call ioa_ ("^a", trace_$entrypoint_seg_path (ep_idx));
697 old_seg_no = baseno (ep_ptr);
698 end;
699 counts = trace_$entrypoint_counts (ep_idx);
700 call ioa_ ("^7d ^d/^d ^38a (^a) ^a", counts.calls, counts.level, counts.max_level,
701 trace_$entrypoint_name (ep_idx), trace_$entrypoint_status (ep_idx), trace_$parms_string (ep_idx, "1"b));
702 end;
703 end;
704 if n_not_in_tt > 0
705 then do;
706 if n_not_in_tt = 1
707 then call ioa_ ("^d of the specified entrypoints was not in the trace table.", n_not_in_tt);
708 else call ioa_ ("^d of the specified entrypoints were not in the trace table.", n_not_in_tt);
709 end;
710 end STATUS;
711
712 if print_buffer ^= 0
713 then
714 PRINT_BUFFER:
715 begin;
716 dcl buffer_count fixed bin (34);
717 dcl buffer_first_idx fixed bin (34);
718 dcl buffer_idx fixed bin (34);
719 call ioa_ ("");
720 if ^trace_$buffer ()
721 then call ioa_ ("There is no buffer to print.");
722 else do;
723 call trace_$buffer_counts (buffer_first_idx, buffer_count);
724 if buffer_count = 0
725 then call ioa_ ("The buffer is empty.");
726 else do;
727 buffer_idx = max (buffer_count - print_buffer, buffer_first_idx);
728 call ioa_ ("^8a ^a", " EVENT#", trace_$buffer_event_header (buffer_idx));
729 do buffer_idx = buffer_idx to buffer_count - 1;
730 call ioa_ ("^8d ^a", buffer_idx, trace_$buffer_event_string (buffer_idx));
731 end;
732 end;
733 end;
734 end PRINT_BUFFER;
735
736 TRANSACTION_END:
737 if ^trace_$transaction_end (transaction_id)
738 then call com_err_ (ZERO, ME, "The trace command ended abnormally.");
739
740 return;
741
742
743
744 SAY:
745 proc (action_i);
746 if trace_$loud ()
747 then do;
748 call INIT ();
749 call ioa_$nnl ("^a", action_i);
750 end;
751 return;
752
753 SAY_N_ENTRYPOINTS:
754 entry (num_i, action_i);
755 if trace_$loud ()
756 then do;
757 call INIT ();
758 if num_i = 1
759 then call ioa_$nnl ("^d ep ^a", num_i, action_i);
760 else call ioa_$nnl ("^d eps ^a", num_i, action_i);
761 end;
762 return;
763
764 SAY_BEGIN:
765 entry ();
766 n_things_said = 0;
767 return;
768
769 SAY_END:
770 entry ();
771 if n_things_said > 0
772 then call ioa_ (".");
773 return;
774
775 INIT:
776 proc ();
777 if n_things_said = 0
778 then call ioa_$nnl ("^a: ", ME);
779 else call ioa_$nnl (", ");
780 n_things_said = n_things_said + 1;
781 end INIT;
782
783 dcl action_i char (*) parm;
784 dcl num_i fixed bin parm;
785 end SAY;
786 %page;
787 compensations:
788 compensation:
789 entry ();
790
791 call ioa_ ("^24x REAL VCPU");
792
793 call PC (COMPENSATION_FROM_ENTRY_TO_ENTRY, "From entry to entry");
794 call PC (COMPENSATION_FROM_ENTRY_TO_RETURN, "From entry to return");
795 call PC (COMPENSATION_FROM_RETURN_TO_ENTRY, "From return to entry");
796 call PC (COMPENSATION_FROM_RETURN_TO_RETURN, "From return to return");
797
798 return;
799
800
801 PC:
802 proc (compensation_type_i, compensation_name_i);
803 dcl compensation_type_i fixed bin parm;
804 dcl compensation_name_i char (24) parm;
805 comp = trace_$compensation (compensation_type_i);
806 call ioa_ ("^24a ^4d ^4d", compensation_name_i, comp.real_time, comp.vcpu_time);
807 dcl 1 comp aligned like compensation;
808 end PC;
809
810
811
812
813
814
815 OBSOLETE_ARG:
816 proc (obsolete_arg_i, use_instead_i);
817 dcl (obsolete_arg_i, use_instead_i) char (*) parm;
818 call com_err_ (ZERO, ME, "The ^a argument is now obsolete.
819 Use ^a instead.
820 This version of the trace command has substantially improved syntax.
821 Please see the new documentation for trace and watch.", obsolete_arg_i, use_instead_i);
822 end OBSOLETE_ARG;
823
824
825
826 CHECK_NEXT_ARG:
827 proc (next_arg_i, max_arg_len_i, control_arg_i, syntax_i, comment_i);
828 dcl (next_arg_i, control_arg_i, syntax_i, comment_i)
829 char (*) parm;
830 dcl max_arg_len_i fixed bin (21);
831
832 if addr (next_arg_i) = null ()
833 then do;
834 call com_err_ (error_table_$noarg, ME, "The syntax is: ^a ^a^a.", control_arg_i, syntax_i, comment_i);
835 go to TRANSACTION_END;
836 end;
837
838 if length (next_arg_i) > max_arg_len_i
839 then do;
840 call com_err_ (error_table_$bigarg, ME, "The maximum length for ^a is ^d characters.
841 The syntax is: ^a ^a^a.", syntax_i, max_arg_len_i, control_arg_i, syntax_i, comment_i);
842 go to TRANSACTION_END;
843 end;
844 end CHECK_NEXT_ARG;
845 %page;
846
847
848 SUB_ERROR_HANDLER:
849 proc (mcptr_i, a_name_i, wcptr_i, info_ptr_i, continue_o);
850 sub_error_info_ptr = info_ptr_i;
851 condition_info_header_ptr = null ();
852 if sub_error_info.name ^= trace_$me ()
853 then go to CONTINUE;
854 if sub_error_info.header.support_signal | sub_error_info.header.quiet_restart
855 then go to HANDLED;
856 if sub_error_info.header.default_restart
857 then go to REPORT;
858 if sub_error_info.header.cant_restart
859 then go to REPORT_AND_ABORT;
860 else go to CONTINUE;
861
862 REPORT_AND_ABORT:
863 call com_err_ (sub_error_info.header.status_code, ME, "^a", sub_error_info.header.info_string);
864 go to TRANSACTION_END;
865
866 REPORT:
867 call com_err_ (sub_error_info.header.status_code, ME, "^a", sub_error_info.header.info_string);
868
869 HANDLED:
870 continue_o = "0"b;
871 return;
872
873 CONTINUE:
874 continue_o = "1"b;
875 return;
876
877 dcl mcptr_i ptr parm;
878 dcl a_name_i char (*) parm;
879 dcl info_ptr_i ptr parm;
880 dcl wcptr_i ptr parm;
881 dcl continue_o bit aligned;
882
883 %include condition_info_header;
884
885 %include sub_error_info;
886
887 end SUB_ERROR_HANDLER;
888 %page;
889
890
891
892
893
894
895 dcl add_remove_action char (8) init ("");
896 dcl arg_count fixed bin init (0);
897 dcl arg_idx fixed bin init (0);
898 dcl arg_len fixed bin (21) init (0);
899 dcl arg_ptr ptr init (null ());
900 dcl code fixed bin (35) init (0);
901 dcl n_entrypoints fixed bin;
902 dcl n_specified fixed bin init (0);
903 dcl n_things_said fixed bin init (0);
904 dcl next_arg_idx fixed bin init (0);
905 dcl next_arg_len fixed bin (21) init (0);
906 dcl next_arg_ptr ptr init (null ());
907 dcl on_off_action char (4) init ("");
908 dcl parameters bit aligned init ("0"b);
909 dcl print_buffer fixed bin (34);
910 dcl set_defaults bit aligned init ("0"b);
911 dcl status bit aligned init ("0"b);
912 dcl transaction_id fixed bin (71) init (0);
913
914
915
916
917 dcl FIRST_TIME bit aligned static init ("1"b);
918 dcl ME char (32) static options (constant) init ("trace");
919 dcl ZERO fixed bin (35) static options (constant) init (0);
920
921
922
923
924 dcl cleanup condition;
925 dcl error condition;
926
927
928
929
930 dcl arg char (arg_len) based (arg_ptr);
931 dcl next_arg char (next_arg_len) based (next_arg_ptr);
932
933
934
935
936 dcl error_table_$badopt fixed bin (35) ext;
937 dcl error_table_$bigarg fixed bin (35) ext;
938 dcl error_table_$noarg fixed bin (35) ext;
939
940
941
942
943 dcl com_err_ entry options (variable);
944 dcl condition_ entry (char (*), entry);
945 dcl cu_$arg_count entry (fixed bin, fixed bin (35));
946 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
947 dcl ioa_ entry () options (variable);
948 dcl ioa_$nnl entry () options (variable);
949
950
951
952
953 %page;
954
955
956
957 %include trace_interface;
958
959
960 end trace;