1
2
3
4
5
6
7
8
9
10
11
12
13 %page;
14 watch:
15 procedure options (variable);
16
17
18
19 transaction_id = clock ();
20 on cleanup status = trace_$transaction_end (transaction_id);
21
22 if ^trace_$transaction_begin (transaction_id)
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
30
31 call condition_ ("sub_error_", SUB_ERROR_HANDLER);
32
33
34
35 add_remove_action = "";
36 status = "0"b;
37
38
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"
91 then do;
92 add_remove_action = "add";
93 arg_idx = arg_idx + 1;
94 end;
95
96 else if arg = "-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"
103 then do;
104 add_remove_action = "remove";
105 arg_idx = arg_idx + 1;
106 end;
107
108 else if arg = "-status" | arg = "-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
122
123
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)
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
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
329
330
331
332
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
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
357
358 dcl cleanup condition;
359
360
361
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
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
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
385
386 %page;
387
388
389
390 %include trace_interface;
391
392
393 end watch;