1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  4    *                                                         *
  5    *********************************************************** */
  6 /*
  7 
  8    This is the command interface to the watch part of the trace facility.
  9 
 10    Written: May 1984 by Jeffrey D. Ives.
 11 */
 12 /* format: style2,ifthendo,^indnoniterdo,thendo,^inditerdo,indproc,ind2,dclind5,idind32 */
 13 %page;
 14 watch:
 15   procedure options (variable);
 16 
 17 /* DISABLE TRACE_CATCH_ */
 18 
 19     transaction_id = clock ();
 20     on cleanup status = trace_$transaction_end (transaction_id);
 21                                                             /* Disregard nonstandard use of status. */
 22     if ^trace_$transaction_begin (transaction_id) /* Temporarily disables trace_catch_.                       */
 23     then do;
 24       call com_err_ (code, ME, "There seems to be an incomplete invocation of trace,
 25 watch, or trace_meters still on the stack.  Try the release command.");
 26       return;
 27     end;
 28 
 29 /* SET UP A SUB_ERROR_ CONDITION HANDLER */
 30 
 31     call condition_ ("sub_error_", SUB_ERROR_HANDLER);
 32 
 33 /* SET DEFAULT ACTIONS */
 34 
 35     add_remove_action = "";
 36     status = "0"b;
 37 
 38 /* READ THE ARGUMENTS */
 39 
 40     call cu_$arg_count (arg_count, code);
 41     if code ^= 0
 42     then do;
 43       call com_err_ (code, ME);
 44       go to TRANSACTION_END;
 45     end;
 46 
 47     arg_idx = 1;
 48 ARGUMENT_LOOP:
 49     do while (arg_idx <= arg_count);
 50       call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, code);
 51       if code ^= 0
 52       then do;
 53         call com_err_ (code, ME);
 54         go to TRANSACTION_END;
 55       end;
 56 
 57       if length (arg) = 0
 58       then do;
 59         call com_err_ (code, ME, "A null argument was found where a location was expected.");
 60         go to TRANSACTION_END;
 61       end;
 62 
 63       if substr (arg, 1, 1) ^= "-"
 64       then
 65 ENTRYPOINTS_ARGUMENT:
 66         do;
 67         call CHECK_NEXT_ARG (arg, 256, "watch", "locations", " control_args");
 68         call trace_$specify_locations ((arg));
 69         arg_idx = arg_idx + 1;
 70       end ENTRYPOINTS_ARGUMENT;
 71 
 72       else
 73 CONTROL_ARGUMENT:
 74         do;
 75         if arg_idx + 1 > arg_count
 76         then next_arg_ptr = null ();
 77         else do;
 78           call cu_$arg_ptr (arg_idx + 1, next_arg_ptr, next_arg_len, code);
 79           if code ^= 0
 80           then do;
 81             call com_err_ (code, ME);
 82             go to TRANSACTION_END;
 83           end;
 84 
 85           if length (next_arg) > 0
 86           then if substr (next_arg, 1, 1) = "-"
 87                then next_arg_ptr = null ();
 88         end;
 89 
 90         if arg = "-add" /* -add */
 91         then do;
 92           add_remove_action = "add";
 93           arg_idx = arg_idx + 1;
 94         end;
 95 
 96         else if arg = "-changed" /* -changed */
 97         then do;
 98           call trace_$specify_changed_locations ();
 99           arg_idx = arg_idx + 1;
100         end;
101 
102         else if arg = "-remove" | arg = "-rm" /* -remove, -rm */
103         then do;
104           add_remove_action = "remove";
105           arg_idx = arg_idx + 1;
106         end;
107 
108         else if arg = "-status" | arg = "-st" /* -status, -st */
109         then do;
110           status = "1"b;
111           arg_idx = arg_idx + 1;
112         end;
113 
114         else do;
115           call com_err_ (error_table_$badopt, ME, """^a""", arg);
116           go to TRANSACTION_END;
117         end;
118       end CONTROL_ARGUMENT;
119     end ARGUMENT_LOOP;
120 %page;
121 /* COMMIT ACTION and print a nice message something like this:
122 
123    Trace: 2 locations specified, 2 locations added.
124 */
125 
126     call SAY_BEGIN ();
127 
128     n_specified = trace_$num_specified_locations ();
129 
130     if n_specified > 0
131     then
132 LOCATION_ACTION:
133       do;
134       call SAY_N_LOCATIONS (n_specified, "specified");
135 
136       if add_remove_action = "" & ^status
137       then add_remove_action = "add";
138 
139       if add_remove_action = "add"
140       then
141         begin;
142           dcl  n_added                         fixed bin;
143           dcl  n_updated                       fixed bin;
144           call trace_$add_specified_locs (n_added, n_updated);
145           call SAY_N_LOCATIONS (n_added, "added");
146           if n_updated > 0
147           then call SAY_N_LOCATIONS (n_updated, "updated");
148         end;
149 
150       if add_remove_action = "remove"
151       then
152         begin;
153           dcl  n_removed                       fixed bin;
154           call trace_$remove_specified_locs (n_removed);
155           call SAY_N_LOCATIONS (n_removed, "removed");
156         end;
157     end LOCATION_ACTION;
158 
159     n_locations = trace_$num_locations ();
160     if n_locations = 0
161     then call SAY ("watch table empty");
162     else call SAY_N_LOCATIONS (n_locations, "in watch table");
163 
164     if ^trace_$enabled ()
165     then call SAY ("trace is disabled");
166     else if trace_$in_trace ()
167     then call SAY ("trace is temporarily disabled");
168     else if trace_$num_entrypoints () = 0
169     then call SAY ("trace table empty");
170 
171     call SAY_END ();
172 
173     if status & n_locations ^= 0
174     then
175 STATUS:
176       begin;
177         dcl  loc_idx                         fixed bin;
178         dcl  loc_ptr                         ptr;
179         dcl  n_not_in_wt                     fixed bin;
180         dcl  old_seg_no                      bit (18) aligned;
181         dcl  specified_loc_idx               fixed bin;
182         old_seg_no = ""b;
183         n_not_in_wt = 0;
184         if n_specified = 0
185         then call ioa_ ("If you want status, you must specify some locations.");
186         do specified_loc_idx = 0 to n_specified - 1;
187           loc_idx = trace_$specified_location_index (specified_loc_idx);
188           if loc_idx < 0
189           then n_not_in_wt = n_not_in_wt + 1;
190           else do;
191             loc_ptr = trace_$location_ptr (loc_idx);
192             if baseno (loc_ptr) ^= old_seg_no
193             then do;
194               call ioa_ ("^a", trace_$location_seg_path (loc_idx));
195               old_seg_no = baseno (loc_ptr);
196             end;
197             watch_values = trace_$location_values (loc_idx);
198             if watch_values.old = watch_values.new
199             then call ioa_ ("^20x^w    ^12x at ^p", watch_values.old, loc_ptr);
200             else call ioa_ ("^20x^w -> ^w at ^p", watch_values.old, watch_values.new, loc_ptr);
201           end;
202         end;
203         if n_not_in_wt > 0
204         then do;
205           if n_not_in_wt = 1
206           then call ioa_ ("^d of the specified locations was not in the watch table.", n_not_in_wt);
207           else call ioa_ ("^d of the specified locations were not in the watch table.", n_not_in_wt);
208         end;
209       end STATUS;
210 
211     if arg_count = 0
212     then call ioa_ ("Acts: -add/-remove -status.");
213 
214 TRANSACTION_END:
215     if ^trace_$transaction_end (transaction_id)             /* Re-enable trace_catch_. */
216     then call com_err_ (ZERO, ME, "This invocation of the watch command ended abnormally.");
217 
218     return;
219 
220 
221 
222 SAY:
223   proc (action_i);
224     if trace_$loud ()
225     then do;
226       call INIT ();
227       call ioa_$nnl ("^a", action_i);
228     end;
229     return;
230 
231 SAY_N_LOCATIONS:
232   entry (num_i, action_i);
233     if trace_$loud ()
234     then do;
235       call INIT ();
236       if num_i = 1
237       then call ioa_$nnl ("^d loc ^a", num_i, action_i);
238       else call ioa_$nnl ("^d locs ^a", num_i, action_i);
239     end;
240     return;
241 
242 SAY_BEGIN:
243   entry ();
244     n_things_said = 0;
245     return;
246 
247 SAY_END:
248   entry ();
249     if n_things_said > 0
250     then call ioa_ (".");
251     return;
252 
253 INIT:
254     proc ();
255       if n_things_said = 0
256       then call ioa_$nnl ("^a: ", ME);
257       else call ioa_$nnl (", ");
258       n_things_said = n_things_said + 1;
259     end INIT;
260 
261     dcl  action_i                        char (*) parm;
262     dcl  num_i                           fixed bin parm;
263   end SAY;
264 %page;
265 CHECK_NEXT_ARG:
266   proc (next_arg_i, max_arg_len_i, control_arg_i, syntax_i, comment_i);
267     dcl  (next_arg_i, control_arg_i, syntax_i, comment_i)
268                                          char (*) parm;
269     dcl  max_arg_len_i                   fixed bin (21);
270 
271     if addr (next_arg_i) = null ()
272     then do;
273       call com_err_ (error_table_$noarg, ME, "The syntax is: ^a ^a^a.", control_arg_i, syntax_i, comment_i);
274       go to TRANSACTION_END;
275     end;
276 
277     if length (next_arg_i) > max_arg_len_i
278     then do;
279       call com_err_ (error_table_$bigarg, ME, "The maximum length for ^a is ^d characters.
280 The syntax is: ^a ^a^a.", syntax_i, max_arg_len_i, control_arg_i, syntax_i, comment_i);
281       go to TRANSACTION_END;
282     end;
283   end CHECK_NEXT_ARG;
284 %page;
285 /* SUBROUTINES */
286 
287 SUB_ERROR_HANDLER:
288   proc (mcptr_i, a_name_i, wcptr_i, info_ptr_i, continue_o);
289     sub_error_info_ptr = info_ptr_i;
290     condition_info_header_ptr = null ();
291     if sub_error_info.name ^= trace_$me ()
292     then go to CONTINUE;
293     if sub_error_info.header.support_signal | sub_error_info.header.quiet_restart
294     then go to HANDLED;
295     if sub_error_info.header.default_restart
296     then go to REPORT;
297     if sub_error_info.header.cant_restart
298     then go to REPORT_AND_ABORT;
299     else go to CONTINUE;
300 
301 REPORT_AND_ABORT:
302     call com_err_ (sub_error_info.header.status_code, ME, "^a", sub_error_info.header.info_string);
303     go to TRANSACTION_END;
304 
305 REPORT:
306     call com_err_ (sub_error_info.header.status_code, ME, "^a", sub_error_info.header.info_string);
307 
308 HANDLED:
309     continue_o = "0"b;
310     return;
311 
312 CONTINUE:
313     continue_o = "1"b;
314     return;
315 
316     dcl  mcptr_i                         ptr parm;
317     dcl  a_name_i                        char (*) parm;
318     dcl  info_ptr_i                      ptr parm;
319     dcl  wcptr_i                         ptr parm;
320     dcl  continue_o                      bit aligned;
321 
322 %include condition_info_header;
323 
324 %include sub_error_info;
325 
326   end SUB_ERROR_HANDLER;
327 %page;
328 /* START OF DECLARATIONS */
329 /* format: ^insnl,^delnl */
330 
331 
332 /* Automatic */
333 
334     dcl  add_remove_action               char (8) init ("");
335     dcl  arg_count                       fixed bin init (0);
336     dcl  arg_idx                         fixed bin init (0);
337     dcl  arg_len                         fixed bin (21) init (0);
338     dcl  arg_ptr                         ptr init (null ());
339     dcl  code                            fixed bin (35) init (0);
340     dcl  n_locations                     fixed bin;
341     dcl  n_specified                     fixed bin init (0);
342     dcl  n_things_said                   fixed bin init (0);
343     dcl  next_arg_idx                    fixed bin init (0);
344     dcl  next_arg_len                    fixed bin (21) init (0);
345     dcl  next_arg_ptr                    ptr init (null ());
346     dcl  status                          bit aligned init ("0"b);
347     dcl  transaction_id                  fixed bin (71) init (0);
348 
349 
350 /* Static */
351 
352     dcl  ME                              char (32) static options (constant) init ("watch");
353     dcl  ZERO                            fixed bin (35) static options (constant) init (0);
354 
355 
356 /* Conditions */
357 
358     dcl  cleanup                         condition;
359 
360 
361 /* Based */
362 
363     dcl  arg                             char (arg_len) based (arg_ptr);
364     dcl  next_arg                        char (next_arg_len) based (next_arg_ptr);
365 
366 
367 /* External Variables */
368 
369     dcl  error_table_$badopt             fixed bin (35) ext;
370     dcl  error_table_$bigarg             fixed bin (35) ext;
371     dcl  error_table_$noarg              fixed bin (35) ext;
372 
373 
374 /* External Entries */
375 
376     dcl  com_err_                        entry options (variable);
377     dcl  condition_                      entry (char (*), entry);
378     dcl  cu_$arg_count                   entry (fixed bin, fixed bin (35));
379     dcl  cu_$arg_ptr                     entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
380     dcl  ioa_                            entry () options (variable);
381     dcl  ioa_$nnl                        entry () options (variable);
382 
383 
384 /* format: insnl,delnl */
385 /* END OF DECLARATIONS */
386 %page;
387 /* START OF INCLUDE FILES */
388 
389 
390 %include trace_interface;
391 
392 
393   end watch;