1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33 transaction: txn: proc;
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81 %page;
82
83
84
85
86 dcl KEY_NAMES (8) char (32) int static options (constant)
87 init ("abandon", "abort", "begin", "commit", "execute", "kill", "rollback", "status");
88 dcl (
89 EXISTING_TXN_NOT_ALLOWED init (1),
90 EXISTING_TXN_ALLOWED init (2),
91 EXISTING_TXN_REQUIRED init (3)
92 ) fixed bin int static options (constant);
93 dcl (
94 ABANDON_ACTION init (1),
95 ABORT_ACTION init (2),
96 NO_ACTION init (3),
97 RETRY_ACTION init (4),
98 SUSPEND_ACTION init (5)
99 ) fixed bin int static options (constant);
100
101 dcl (
102 NO_ERROR_SEVERITY init (0),
103 RETRY_SEVERITY init (1),
104 ABORT_OR_ABANDON_SEVERITY init (2),
105 FAILED_ABORT_OR_ABANDON_SEVERITY init (3),
106 FATAL_SEVERITY init (4)
107 ) fixed bin (35) internal static options (constant);
108
109 dcl (
110 ENTRY_ITEM init (1),
111 TXN_ITEM init (2)
112 ) fixed bin int static options (constant);
113 dcl INITIAL_CHECKPOINT init (0) fixed bin internal static options (constant);
114 dcl PRINT_ALL_INFO bit (36) int static options (constant) init ((36)"1"b);
115 dcl RELATIVE_TIME_OPTION bit (2) int static options (constant) init ("11"b);
116 dcl (
117 TEN_SECONDS init (10),
118 USEC_PER_SECOND init (1000000),
119 LONG_TIME_USEC init (1000000000000)
120 ) fixed bin (71) int static options (constant);
121
122
123
124 dcl 1 handler_node aligned based,
125 2 next_ptr ptr,
126 2 condition_name char (32),
127 2 action fixed bin,
128 2 retry_limit fixed bin;
129
130 dcl 1 tm_info (tdt_max_count) aligned like txn_info based (tm_info_ptr);
131
132 dcl tix (tix_bound) fixed bin based (tix_ptr);
133
134 dcl area area based (area_ptr);
135
136 dcl arg char (arg_len) based (arg_ptr);
137 dcl key char (key_len) based (key_ptr);
138 dcl return_arg char (return_len) varying based (return_ptr);
139
140
141
142 dcl 1 print_switches aligned,
143 2 (bj_path, dtm, errors, owner, pid, rollback_count, state, switches, tid, tix) bit (1) unaligned,
144 2 pad bit (26) unaligned;
145
146 dcl 1 select_switches aligned,
147 2 (abandoned, all, dead, tid, tix) bit (1) unaligned,
148 2 pad bit (31) unaligned;
149
150 dcl 1 cond_info aligned like condition_info;
151
152 dcl (key_buffer, my_name, on_action_name) char (32);
153 dcl (begun_time_str, ctl_args_str, requested_time_str) char (32);
154
155 dcl (af_sw, cl_sw, had_to_wait_sw, handler_invoked_sw, multiple_info_sw, on_action_specified_sw) bit (1);
156 dcl (print_no_txn_warning_sw, printed_something_sw, succeeded_sw, total_sw) bit (1);
157 dcl (txn_exists_sw, txn_existed_sw, wait_sw) bit (1);
158 dcl bj_opening_id bit (36);
159 dcl txn_id bit (36) aligned;
160
161 dcl (alp, area_ptr, arg_ptr, first_handler_ptr, key_ptr, return_ptr, tix_ptr, tm_info_ptr) ptr;
162
163 dcl (arg_count, arg_index, command_line_start, existing_txn_policy) fixed bin;
164 dcl (fixed_txn_id, key_index, tix_index, tdt_index, txn_index) fixed bin;
165 dcl (retry_count, retry_limit, tdt_max_count, tix_bound, tix_count, wait_seconds) fixed bin;
166 dcl (abandoned_count, dead_count, error_count, txn_count, used_count) fixed bin;
167 dcl (arg_len, key_len, return_len) fixed bin (21);
168 dcl code fixed bin (35);
169 dcl (start_usec, wait_usec) fixed bin (71);
170
171 dcl (complain, complain_suppress_name) entry variable options (variable);
172
173
174
175 dcl dm_error_$system_not_initialized fixed bin (35) ext;
176 dcl dm_error_$transaction_suspended fixed bin (35) ext;
177 dcl error_table_$badopt fixed bin (35) ext;
178 dcl error_table_$noarg fixed bin (35) ext;
179 dcl error_table_$not_act_fnc fixed bin (35) ext;
180 dcl error_table_$too_many_args fixed bin (35) ext;
181 dcl transaction_severity_ fixed bin ext;
182
183
184
185 dcl (
186 active_fnc_err_,
187 active_fnc_err_$suppress_name
188 ) entry options (variable);
189 dcl before_journal_manager_$get_bj_path_from_oid entry (bit (36) aligned, char (*), char (*), fixed bin (35));
190 dcl before_journal_manager_$get_bj_path_from_uid entry (bit (36) aligned, char (*), char (*), fixed bin (35));
191 dcl (
192 com_err_,
193 com_err_$suppress_name
194 ) entry options (variable);
195 dcl command_query_ entry options (variable);
196 dcl continue_to_signal_ entry (fixed bin (35));
197 dcl convert_status_code_ entry (fixed bin (35), char (8), char (100));
198 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
199 dcl cu_$arg_list_ptr entry (ptr);
200 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
201 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
202 dcl cu_$cp entry (ptr, fixed bin (21), fixed bin (35));
203 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
204 dcl date_time_ entry (fixed bin (71), char (*));
205 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35));
206 dcl get_process_id_ entry returns (bit (36));
207 dcl get_system_free_area_ entry returns (ptr);
208 dcl hcs_$validate_processid entry (bit (36) aligned, fixed bin (35));
209 dcl (
210 ioa_,
211 ioa_$rsnnl
212 ) entry options (variable);
213 dcl pathname_ entry (char (*), char (*)) returns (char (168));
214 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
215 dcl transaction_manager_$abandon_txn entry (bit (36) aligned, fixed bin (35));
216 dcl transaction_manager_$abort_txn entry (bit (36) aligned, fixed bin (35));
217 dcl transaction_manager_$begin_txn entry (fixed bin, bit (36), bit (36) aligned, fixed bin (35));
218 dcl transaction_manager_$commit_txn entry (bit (36) aligned, fixed bin (35));
219 dcl transaction_manager_$get_current_txn_id entry (bit (36) aligned, fixed bin (35));
220 dcl transaction_manager_$get_state_description entry (fixed bin) returns (char (*));
221 dcl transaction_manager_$get_tdt_size entry (fixed bin);
222 dcl transaction_manager_$get_txn_index entry (bit (36) aligned, fixed bin (35)) returns (fixed bin);
223 dcl transaction_manager_$get_txn_info_index entry (fixed bin, ptr, fixed bin (35));
224 dcl transaction_manager_$handle_conditions entry ();
225 dcl transaction_manager_$kill_txn entry (bit (36) aligned, fixed bin (35));
226 dcl transaction_manager_$resume_txn entry (fixed bin (35));
227 dcl transaction_manager_$rollback_txn entry (bit (36) aligned, fixed bin, fixed bin (35));
228
229
230
231 dcl (addr, addrel, character, clock, fixed, hbound, index, length, ltrim, null, rtrim, substr, unspec, verify) builtin;
232
233
234
235 dcl (any_other, cleanup, dm_not_available_, sub_error_) condition;
236 %page;
237 call cu_$af_return_arg (arg_count, return_ptr, return_len, code);
238 if code = 0 then do;
239 af_sw = "1"b;
240 complain = active_fnc_err_;
241 complain_suppress_name = active_fnc_err_$suppress_name;
242 end;
243 else if code = error_table_$not_act_fnc then do;
244 af_sw = "0"b;
245 complain = com_err_;
246 complain_suppress_name = com_err_$suppress_name;
247 end;
248 else do;
249 call com_err_ (code, "transaction");
250 call ERROR_RETURN ();
251 end;
252
253 if arg_count = 0 then do;
254 my_name = "txn key";
255 call complain_suppress_name (error_table_$noarg, "transaction", "^a", USAGE_STRING ("{other_args}"));
256 call ERROR_RETURN ();
257 end;
258
259 call cu_$arg_ptr (1, arg_ptr, arg_len, code);
260 if code ^= 0 then do;
261 call complain (code, "transaction", "Argument 1.");
262 call ERROR_RETURN ();
263 end;
264
265 if arg = "e" | arg = "st" then do;
266 key_ptr = addr (key_buffer);
267 key_len = length (key_buffer);
268 if arg = "e"
269 then key = "execute";
270 else key = "status";
271 end;
272 else do;
273 key_ptr = arg_ptr;
274 key_len = arg_len;
275 end;
276
277 do key_index = hbound (KEY_NAMES, 1) by -1 to 1 while (KEY_NAMES (key_index) ^= key);
278 end;
279 if key_index = 0 then do;
280 call complain (0, "transaction", "Invalid key argument ^a", arg);
281 call ERROR_RETURN ();
282 end;
283
284 my_name = "txn " || rtrim (KEY_NAMES (key_index));
285
286 on dm_not_available_ begin;
287 call complain (dm_error_$system_not_initialized, my_name);
288 call ERROR_RETURN ();
289 end;
290
291 go to KEY (key_index);
292 RETURN:
293 return;
294 %page;
295
296 KEY (1):
297 if arg_count > 1 then do;
298 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING (""));
299 call ERROR_RETURN ();
300 end;
301
302 on sub_error_ begin;
303 code = SUB_ERROR_CODE ();
304 if code ^= 0 then go to ABANDON_ATTEMPTED;
305 end;
306
307 call transaction_manager_$abandon_txn (CURRENT_ID (), code);
308 ABANDON_ATTEMPTED:
309 if code ^= 0 then do;
310 if af_sw
311 then return_arg = "false";
312 else call complain (code, my_name);
313 end;
314 else do;
315 if af_sw then return_arg = "true";
316 end;
317
318 return;
319 %page;
320
321 KEY (2):
322 if arg_count > 1 then do;
323 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING (""));
324 call ERROR_RETURN ();
325 end;
326
327 on sub_error_ begin;
328 code = SUB_ERROR_CODE ();
329 if code ^= 0 then go to ABORT_ATTEMPTED;
330 end;
331
332 call transaction_manager_$abort_txn (CURRENT_ID (), code);
333 ABORT_ATTEMPTED:
334 if code ^= 0 then do;
335 if af_sw
336 then return_arg = "false";
337 else call complain (code, my_name);
338 end;
339 else do;
340 if af_sw then return_arg = "true";
341 end;
342
343 return;
344 %page;
345
346 KEY (3):
347 wait_sw = "0"b;
348 wait_usec = LONG_TIME_USEC;
349
350 do arg_index = 2 to arg_count;
351
352 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
353
354 if index (arg, "-") ^= 1 then do;
355 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING ("{-control_args}"));
356 call ERROR_RETURN ();
357 end;
358
359 else if arg = "-no_wait" | arg = "-nwt" then wait_sw = "0"b;
360
361 else if arg = "-wait" | arg = "-wt" then do;
362 arg_index = arg_index + 1;
363 if arg_index > arg_count then do;
364 call complain (0, my_name, "No value specified for -wait");
365 call ERROR_RETURN ();
366 end;
367 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
368 wait_seconds = cv_dec_check_ (arg, code);
369 if code ^= 0 then do;
370 call complain (code, my_name, "Invalid -wait number of seconds ^a", arg);
371 call ERROR_RETURN ();
372 end;
373 wait_sw = "1"b;
374 wait_usec = (wait_seconds + TEN_SECONDS) * USEC_PER_SECOND;
375
376 end;
377
378 else if arg = "-wait_indefinitely" | arg = "-wti" then do;
379 wait_sw = "1"b;
380 wait_usec = LONG_TIME_USEC;
381 end;
382
383 else do;
384 call complain (error_table_$badopt, my_name, "^a", arg);
385 call ERROR_RETURN ();
386 end;
387 end;
388
389 on sub_error_ begin;
390 code = SUB_ERROR_CODE ();
391 if code ^= 0 then go to BEGIN_ATTEMPTED;
392 end;
393
394 bj_opening_id = "0"b;
395
396 start_usec = clock ();
397 had_to_wait_sw = "0"b;
398
399 do while (^had_to_wait_sw | clock () - start_usec < wait_usec);
400
401 call transaction_manager_$begin_txn (TM_NORMAL_MODE, bj_opening_id, txn_id, code);
402 BEGIN_ATTEMPTED:
403 if code = 0 then do;
404 if had_to_wait_sw then do;
405 call date_time_ (start_usec, requested_time_str);
406 call date_time_ (clock (), begun_time_str);
407 call ioa_ ("Transaction requested at ^a begun ^a", requested_time_str, begun_time_str);
408 end;
409 if af_sw then return_arg = "true";
410 return;
411 end;
412 else if ^wait_sw | code ^= dm_error_$system_not_initialized then do;
413 if af_sw then return_arg = "false";
414 else call complain (code, my_name);
415 call ERROR_RETURN ();
416 end;
417
418
419
420 call timer_manager_$sleep (TEN_SECONDS, RELATIVE_TIME_OPTION);
421 had_to_wait_sw = "1"b;
422 end;
423
424 if af_sw then return_arg = "false";
425 else call complain (0, my_name, "Data Management not available within ^a seconds.", wait_seconds);
426
427 call ERROR_RETURN ();
428 %page;
429
430 KEY (4):
431 if arg_count > 1 then do;
432 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING (""));
433 call ERROR_RETURN ();
434 end;
435
436 on sub_error_ begin;
437 code = SUB_ERROR_CODE ();
438 if code ^= 0 then go to COMMIT_ATTEMPTED;
439 end;
440
441 call transaction_manager_$commit_txn (CURRENT_ID (), code);
442 COMMIT_ATTEMPTED:
443 if code ^= 0 then do;
444 if af_sw then return_arg = "false";
445 else call complain (code, my_name);
446 end;
447 else if af_sw then return_arg = "true";
448
449 return;
450 %page;
451
452 KEY (5):
453 cl_sw, on_action_specified_sw, wait_sw = "0"b;
454 existing_txn_policy = EXISTING_TXN_NOT_ALLOWED;
455 wait_usec = LONG_TIME_USEC;
456 retry_count = 0;
457 transaction_severity_ = FATAL_SEVERITY;
458
459
460
461 call transaction_manager_$get_current_txn_id (txn_id, code);
462 txn_existed_sw = (code = 0);
463
464 area_ptr = get_system_free_area_ ();
465 first_handler_ptr = null;
466 if ^txn_existed_sw then do;
467 call SAVE_HANDLER ("cleanup", ABORT_ACTION, 0);
468 call SAVE_HANDLER ("any_other", SUSPEND_ACTION, 0);
469 end;
470
471 call cu_$arg_list_ptr (alp);
472
473 command_line_start = 0;
474 do arg_index = 2 to arg_count while (command_line_start = 0);
475
476 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
477
478 if index (arg, "-") ^= 1 then command_line_start = arg_index;
479
480 else if arg = "-abandon_on" then do;
481 call GET_CONDITION_LIST ("-abandon_on", arg_index, ABANDON_ACTION, 0);
482 if ^on_action_specified_sw then do;
483 on_action_specified_sw = "1"b;
484 on_action_name = "-abandon_on";
485 end;
486 end;
487
488 else if arg = "-abort_on" then do;
489 call GET_CONDITION_LIST ("-abort_on", arg_index, ABORT_ACTION, 0);
490 if ^on_action_specified_sw then do;
491 on_action_specified_sw = "1"b;
492 on_action_name = "-abort_on";
493 end;
494 end;
495
496 else if arg = "-command_level" | arg = "-cl" then cl_sw = "1"b;
497
498 else if arg = "-existing_transaction_allowed" | arg = "-eta"
499 then existing_txn_policy = EXISTING_TXN_ALLOWED;
500
501 else if arg = "-existing_transaction_required" | arg = "-etr"
502 then existing_txn_policy = EXISTING_TXN_REQUIRED;
503
504 else if arg = "-no_action_on" then do;
505 call GET_CONDITION_LIST ("-no_action_on", arg_index, NO_ACTION, 0);
506 if ^on_action_specified_sw then do;
507 on_action_specified_sw = "1"b;
508 on_action_name = "-no_action_on";
509 end;
510 end;
511
512 else if arg = "-no_existing_transaction_allowed" | arg = "-neta"
513 then existing_txn_policy = EXISTING_TXN_NOT_ALLOWED;
514
515 else if arg = "-no_wait" | arg = "-nwt" then wait_sw = "0"b;
516
517 else if arg = "-retry_on" then do;
518 arg_index = arg_index + 1;
519 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
520 if arg_index > arg_count then do;
521 call complain (0, my_name, "No number or condition list specified for -retry_on");
522 call ERROR_RETURN ();
523 end;
524 retry_limit = cv_dec_check_ (arg, code);
525 if code ^= 0 then do;
526 call complain (code, my_name, "Invalid count ^a for -retry_on", arg);
527 call ERROR_RETURN ();
528 end;
529 call GET_CONDITION_LIST ("-retry_on", arg_index, RETRY_ACTION, retry_limit);
530 if ^on_action_specified_sw then do;
531 on_action_specified_sw = "1"b;
532 on_action_name = "-retry_on";
533 end;
534 end;
535
536 else if arg = "-suspend_on" then do;
537 call GET_CONDITION_LIST ("-suspend_on", arg_index, SUSPEND_ACTION, 0);
538 if ^on_action_specified_sw then do;
539 on_action_specified_sw = "1"b;
540 on_action_name = "-suspend_on";
541 end;
542 end;
543
544 else if arg = "-wait" | arg = "-wt" then do;
545 arg_index = arg_index + 1;
546 if arg_index > arg_count then do;
547 call complain (0, my_name, "No value specified for -wait");
548 call ERROR_RETURN ();
549 end;
550 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
551 wait_seconds = cv_dec_check_ (arg, code);
552 if code ^= 0 then do;
553 call complain (code, my_name, "^a", arg);
554 call ERROR_RETURN ();
555 end;
556 wait_sw = "1"b;
557 wait_usec = (wait_seconds + TEN_SECONDS) * USEC_PER_SECOND;
558
559 end;
560
561 else if arg = "-wait_indefinitely" | arg = "-wti" then do;
562 wait_sw = "1"b;
563 wait_usec = LONG_TIME_USEC;
564 end;
565
566 else do;
567 call complain (error_table_$badopt, my_name, "^a", arg);
568 call ERROR_RETURN ();
569 end;
570 end;
571
572 if command_line_start > 0 & cl_sw then do;
573 call complain (0, my_name, "Command line is incompatible with -command_level.");
574 call ERROR_RETURN ();
575 end;
576
577 if on_action_specified_sw & existing_txn_policy ^= EXISTING_TXN_NOT_ALLOWED then do;
578 call complain (0, my_name, "-existing_transaction_^[allowed^;required^] is incompatible with ^a",
579 existing_txn_policy = EXISTING_TXN_ALLOWED, on_action_name);
580 call ERROR_RETURN ();
581 end;
582
583 if txn_existed_sw & existing_txn_policy = EXISTING_TXN_NOT_ALLOWED then do;
584 call complain (0, my_name, "Current transaction already in effect, id = ^w", txn_id);
585 call ERROR_RETURN ();
586 end;
587 if ^txn_existed_sw & existing_txn_policy = EXISTING_TXN_REQUIRED then do;
588 call complain (0, my_name, "No current transaction, -existing_transaction_required.");
589 call ERROR_RETURN ();
590 end;
591
592
593
594 on sub_error_ begin;
595 code = SUB_ERROR_CODE ();
596 if code = dm_error_$system_not_initialized
597 then go to EXECUTE_BEGIN_ATTEMPTED;
598 else call continue_to_signal_ (0);
599 end;
600
601 if ^txn_existed_sw then
602 on cleanup begin;
603 call ABORT_OR_ABANDON (txn_id, succeeded_sw);
604 end;
605
606 bj_opening_id = "0"b;
607
608 start_usec = clock ();
609 had_to_wait_sw = "0"b;
610
611 do while (^had_to_wait_sw | clock () - start_usec < wait_usec);
612
613 if txn_existed_sw then code = 0;
614 else call transaction_manager_$begin_txn (TM_NORMAL_MODE, bj_opening_id, txn_id, code);
615 EXECUTE_BEGIN_ATTEMPTED:
616 if code = 0 then do;
617 if had_to_wait_sw then do;
618 call date_time_ (start_usec, requested_time_str);
619 call date_time_ (clock (), begun_time_str);
620 call ioa_ ("Transaction requested at ^a begun ^a", requested_time_str, begun_time_str);
621 end;
622 RETRY:
623 call EXECUTE_COMMAND_LINE ();
624
625 if ^txn_existed_sw then do;
626 call transaction_manager_$commit_txn (txn_id, code);
627 if code ^= 0 then do;
628 call ABORT_OR_ABANDON (txn_id, succeeded_sw);
629 if succeeded_sw then transaction_severity_ = ABORT_OR_ABANDON_SEVERITY;
630 else transaction_severity_ = FAILED_ABORT_OR_ABANDON_SEVERITY;
631 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
632 else call complain (code, my_name, "Unable to commit transaction.");
633 call ERROR_RETURN ();
634 end;
635 end;
636 if retry_count > 0 then do;
637 transaction_severity_ = RETRY_SEVERITY;
638 if ^af_sw then call complain (0, my_name,
639 "^d retries were required to successfully execute the command line.", retry_count);
640 end;
641 else transaction_severity_ = NO_ERROR_SEVERITY;
642 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
643 return;
644 end;
645 else if ^wait_sw | code ^= dm_error_$system_not_initialized then do;
646 transaction_severity_ = FATAL_SEVERITY;
647 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
648 else call complain (code, my_name, "Could not begin transaction.");
649 call ERROR_RETURN ();
650 end;
651
652
653
654 call timer_manager_$sleep (TEN_SECONDS, RELATIVE_TIME_OPTION);
655 had_to_wait_sw = "1"b;
656 end;
657
658 transaction_severity_ = FATAL_SEVERITY;
659 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
660 else call complain (0, my_name, "Data Management not available within ^d seconds.", wait_seconds);
661
662 return;
663 %page;
664
665 KEY (6):
666 if arg_count > 2 then do;
667 KILL_USAGE:
668 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING ("{transaction_id}"));
669 call ERROR_RETURN ();
670 end;
671
672 if arg_count = 2 then do;
673 call cu_$arg_ptr (2, arg_ptr, arg_len, code);
674 if index (arg, "-") = 1 then go to KILL_USAGE;
675 fixed_txn_id = cv_dec_check_ (arg, code);
676 if code ^= 0 then do;
677 call complain (code, my_name, "Invalid transaction id ^a", arg);
678 call ERROR_RETURN ();
679 end;
680 unspec (txn_id) = unspec (fixed_txn_id);
681 end;
682 else txn_id = CURRENT_ID ();
683
684 on sub_error_ begin;
685 code = SUB_ERROR_CODE ();
686 if code ^= 0 then go to KILL_ATTEMPTED;
687 end;
688
689 call transaction_manager_$kill_txn (txn_id, code);
690 KILL_ATTEMPTED:
691 if code ^= 0 then do;
692 if af_sw then return_arg = "false";
693 else call complain (code, my_name);
694 end;
695 else do;
696 if af_sw then return_arg = "true";
697 end;
698
699 return;
700 %page;
701
702 KEY (7):
703 if arg_count > 1 then do;
704 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING (""));
705 call ERROR_RETURN ();
706 end;
707
708 on sub_error_ begin;
709 code = SUB_ERROR_CODE ();
710 if code ^= 0 then go to ROLLBACK_ATTEMPTED;
711 end;
712
713 call transaction_manager_$rollback_txn (CURRENT_ID (), INITIAL_CHECKPOINT, code);
714 ROLLBACK_ATTEMPTED:
715 if code ^= 0 then do;
716 if af_sw then return_arg = "false";
717 else call complain (code, my_name);
718 end;
719 else do;
720 if af_sw then return_arg = "true";
721 end;
722
723 return;
724 %page;
725
726 KEY (8):
727 area_ptr = get_system_free_area_ ();
728 tix_ptr, tm_info_ptr, txn_info_ptr = null;
729
730 on cleanup call CLEAN_UP_STATUS ();
731
732 tix_bound = arg_count - 1;
733 allocate tix in (area) set (tix_ptr);
734 tix_count = 0;
735
736 unspec (print_switches), unspec (select_switches) = "0"b;
737 multiple_info_sw, total_sw = "0"b;
738
739 do arg_index = 2 to arg_count;
740
741 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code);
742
743 if index (arg, "-") ^= 1 then do;
744 if af_sw then ctl_args_str = "-control_arg";
745 else ctl_args_str = "-control_args";
746 call complain_suppress_name (error_table_$too_many_args, my_name, USAGE_STRING (ctl_args_str));
747 go to STATUS_RETURN;
748 end;
749
750
751
752 if arg = "-abandoned" then
753 if af_sw then go to BAD_STATUS_AF_ARG;
754 else select_switches.abandoned = "1"b;
755 else if arg = "-all" | arg = "-a" then
756 if af_sw then go to BAD_STATUS_AF_ARG;
757 else select_switches.all, total_sw = "1"b;
758 else if arg = "-dead" then
759 if af_sw then go to BAD_STATUS_AF_ARG;
760 else select_switches.dead, select_switches.all = "1"b;
761 else if arg = "-total" | arg = "-tt" then
762 if af_sw then go to BAD_STATUS_AF_ARG;
763 else total_sw = "1"b;
764
765 else if arg = "-transaction_id" | arg = "-tid" | arg = "-id" then do;
766 if arg_index = arg_count then print_switches.tid = "1"b;
767 else do;
768 call cu_$arg_ptr (arg_index + 1, arg_ptr, arg_len, code);
769 if index (arg, "-") = 1 then print_switches.tid = "1"b;
770 else do;
771 arg_index = arg_index + 1;
772 fixed_txn_id = cv_dec_check_ (arg, code);
773 if code ^= 0 then do;
774 call complain (code, my_name, "Invalid transaction id ^a", arg);
775 go to STATUS_RETURN;
776 end;
777 unspec (txn_id) = unspec (fixed_txn_id);
778 txn_index = transaction_manager_$get_txn_index (txn_id, code);
779 if code ^= 0 then call complain (code, my_name, "transaction id = ^a", arg);
780 else do;
781 select_switches.tid = "1"b;
782 tix_count = tix_count + 1;
783 tix (tix_count) = txn_index;
784 end;
785 end;
786 end;
787 end;
788
789 else if arg = "-transaction_index" | arg = "-tix" | arg = "-index" then do;
790 if arg_index = arg_count then print_switches.tix = "1"b;
791 else do;
792 call cu_$arg_ptr (arg_index + 1, arg_ptr, arg_len, code);
793 if index (arg, "-") = 1
794 then print_switches.tix = "1"b;
795 else do;
796 arg_index = arg_index + 1;
797 txn_index = cv_dec_check_ (arg, code);
798 if code ^= 0 then do;
799 call complain (code, my_name, "Invalid transaction index ^a", arg);
800 go to STATUS_RETURN;
801 end;
802 select_switches.tix = "1"b;
803 tix_count = tix_count + 1;
804 tix (tix_count) = txn_index;
805 end;
806 end;
807 end;
808
809
810
811 else if arg = "-before_journal_path" | arg = "-bj_path" then call REQUEST_INFO (print_switches.bj_path);
812 else if arg = "-begun" | arg = "-date_time_begun" | arg = "-dtbg" then
813 call REQUEST_INFO (print_switches.dtm);
814 else if arg = "-error_info" | arg = "-error" then call REQUEST_INFO (print_switches.errors);
815 else if arg = "-owner" then call REQUEST_INFO (print_switches.owner);
816 else if arg = "-process_id" | arg = "-pid" then call REQUEST_INFO (print_switches.pid);
817 else if arg = "-rollback_count" | arg = "-rbc" then call REQUEST_INFO (print_switches.rollback_count);
818 else if arg = "-state" then call REQUEST_INFO (print_switches.state);
819 else if arg = "-switches" | arg = "-switch" | arg = "-sw" then call REQUEST_INFO (print_switches.switches);
820
821 else do;
822 BAD_STATUS_AF_ARG:
823 call complain (error_table_$badopt, my_name, "^a", arg);
824 go to STATUS_RETURN;
825 end;
826 end;
827
828 if af_sw & tix_count > 1 then do;
829 call complain (0, my_name, "Can return info for only one transaction.");
830 go to STATUS_RETURN;
831 end;
832
833 on sub_error_ begin;
834 code = SUB_ERROR_CODE ();
835 if code ^= 0 then do;
836 call complain (code, my_name);
837 go to RETURN;
838 end;
839 end;
840
841 if tix_count = 0 & ^select_switches.all & ^total_sw then do;
842 tix_count = tix_count + 1;
843 txn_id = CURRENT_ID ();
844 tix (tix_count) = transaction_manager_$get_txn_index (txn_id, code);
845 if code ^= 0 then do;
846 call complain (code, my_name, "transaction id = ^o", fixed (txn_id));
847 go to STATUS_RETURN;
848 end;
849 end;
850
851 if unspec (print_switches) = "0"b
852 then if af_sw then do;
853 call complain_suppress_name (error_table_$noarg, my_name, "Usage: [txn status -control_arg]");
854 go to STATUS_RETURN;
855 end;
856 else do;
857 unspec (print_switches) = unspec (PRINT_ALL_INFO);
858 multiple_info_sw = "1"b;
859 end;
860
861 if select_switches.all | total_sw then
862 EXAMINE_WHOLE_TDT: do;
863
864 call transaction_manager_$get_tdt_size (tdt_max_count);
865 if tdt_max_count = 0 then do;
866 if af_sw then call complain (0, my_name, "No transactions defined.");
867
868 else call ioa_ ("No transactions defined.");
869 go to STATUS_RETURN;
870 end;
871
872 allocate tm_info in (area) set (tm_info_ptr);
873 allocate txn_info in (area) set (txn_info_ptr);
874 txn_info.version = TXN_INFO_VERSION_5;
875
876 do tdt_index = 1 to tdt_max_count;
877 call transaction_manager_$get_txn_info_index (tdt_index, txn_info_ptr, code);
878 if code ^= 0 then do;
879 call complain (code, my_name, "TDT entry #^d", tdt_index);
880 go to STATUS_RETURN;
881 end;
882
883 tm_info (tdt_index) = txn_info;
884 end;
885
886
887
888 if total_sw then do;
889
890 abandoned_count, dead_count, error_count, txn_count, used_count = 0;
891 do tdt_index = 1 to tdt_max_count;
892 if tm_info.owner_process_id (tdt_index) ^= "0"b then used_count = used_count + 1;
893 if DEAD_PROCESS (tm_info.owner_process_id (tdt_index)) then dead_count = dead_count + 1;
894 if tm_info.abandoned_sw (tdt_index) then abandoned_count = abandoned_count + 1;
895 if tm_info.txn_id (tdt_index) ^= "0"b then txn_count = txn_count + 1;
896 if tm_info.error_sw (tdt_index) then error_count = error_count + 1;
897 end;
898
899 call ioa_ ("TDT size: ^d entries", tdt_max_count);
900 call ioa_ ("In use: ^d", used_count);
901 call ioa_ ("Dead processes: ^d", dead_count);
902 call ioa_ ("Abandoned entries: ^d", abandoned_count);
903 call ioa_ ("Transactions: ^d", txn_count);
904 call ioa_ ("Error transactions: ^d", error_count);
905 call ioa_ ("");
906 end;
907
908
909
910 printed_something_sw = "0"b;
911 if af_sw then return_arg = """""";
912
913 if select_switches.all
914 then do tdt_index = 1 to tdt_max_count;
915
916 if tm_info.owner_process_id (tdt_index) ^= "0"b then do;
917 txn_info = tm_info (tdt_index);
918 call PRINT_ENTRY ();
919 end;
920 end;
921
922 else do tix_index = 1 to tix_count;
923 txn_info = tm_info (tix (tix_index));
924 call PRINT_ENTRY ();
925 end;
926
927 if ^printed_something_sw & ^af_sw &
928 (select_switches.abandoned | select_switches.dead | select_switches.tid | select_switches.tix) then
929 call complain (0, my_name, "No entries with specified attributes.");
930 end EXAMINE_WHOLE_TDT;
931
932 else EXAMINE_SPECIFIED_ENTRIES: do;
933 allocate txn_info in (area) set (txn_info_ptr);
934 txn_info.version = TXN_INFO_VERSION_5;
935
936 do tix_index = 1 to tix_count;
937 call transaction_manager_$get_txn_info_index (tix (tix_index), txn_info_ptr, code);
938 if code = 0 then call PRINT_ENTRY ();
939 else call complain (code, my_name, "TDT entry #^d.", tix (tix_index));
940 end;
941 end EXAMINE_SPECIFIED_ENTRIES;
942 STATUS_RETURN:
943 call CLEAN_UP_STATUS ();
944
945 return;
946 %page;
947 ABORT_OR_ABANDON: proc (P_txn_id, P_succeeded_sw);
948
949 dcl P_txn_id bit (36) aligned;
950 dcl P_succeeded_sw bit (1);
951 dcl code fixed bin (35);
952
953 call transaction_manager_$abort_txn (P_txn_id, code);
954 if code ^= 0 then do;
955 call transaction_manager_$abandon_txn (P_txn_id, code);
956 if code ^= 0 then do;
957 P_succeeded_sw = "0"b;
958 call ERROR_RETURN ();
959 end;
960 end;
961 P_succeeded_sw = "1"b;
962 return;
963
964 end ABORT_OR_ABANDON;
965 %page;
966 AF_SEVERITY_VALUE: proc (P_severity) returns (char (*));
967
968 dcl P_severity fixed bin;
969
970 if P_severity < 2 then return ("true");
971 else return ("false");
972
973 end AF_SEVERITY_VALUE;
974 %page;
975 CLEAN_UP_STATUS: proc;
976
977 if tix_ptr ^= null then free tix in (area);
978 if tm_info_ptr ^= null then free tm_info in (area);
979 if txn_info_ptr ^= null then free txn_info in (area);
980
981 end CLEAN_UP_STATUS;
982 %page;
983 CODE_DESCRIPTION: proc (P_code) returns (char (100));
984
985 dcl P_code fixed bin (35);
986 dcl message char (100);
987 dcl dm_error_$ external bit (36) aligned;
988 dcl better_message char (100);
989 dcl better_code fixed bin (35);
990 dcl pp_as_word bit (36) aligned;
991 dcl segno builtin;
992
993 %include packed_pointer;
994
995 call convert_status_code_ (P_code, "", message);
996 if substr (message, 1, 4) = "Code" then do;
997 pp_as_word = unspec (P_code);
998 packed_pointer_ptr = addr (pp_as_word);
999 packed_pointer.segno = segno (addr (dm_error_$));
1000 unspec (better_code) = pp_as_word;
1001 call convert_status_code_ (better_code, "", better_message);
1002 if substr (better_message, 1, 4) ^= "Code" then message = better_message;
1003 end;
1004 return (message);
1005
1006 end CODE_DESCRIPTION;
1007 %page;
1008 CONDITION_HANDLER: proc (P_txn_id, P_retry_count, P_retry_label);
1009
1010 dcl P_txn_id bit (36) aligned;
1011 dcl P_retry_count fixed bin;
1012 dcl P_retry_label label variable;
1013 dcl p ptr;
1014 dcl condition_name char (32);
1015
1016 if handler_invoked_sw then do;
1017 call continue_to_signal_ (0);
1018 handler_invoked_sw = "0"b;
1019 return;
1020 end;
1021 handler_invoked_sw = "1"b;
1022
1023 if first_handler_ptr = null then return;
1024
1025 call find_condition_info_ (null, addr (cond_info), code);
1026 if code ^= 0 then condition_name = "any_other";
1027 else condition_name = cond_info.condition_name;
1028
1029
1030
1031 do p = first_handler_ptr repeat (p -> handler_node.next_ptr) while (p ^= null);
1032 if p -> handler_node.condition_name = condition_name then do;
1033 call do_action (p, P_txn_id, P_retry_count, P_retry_label);
1034 return;
1035 end;
1036 end;
1037
1038
1039
1040 do p = first_handler_ptr repeat (p -> handler_node.next_ptr) while (p ^= null);
1041 if p -> handler_node.condition_name = "any_other" then do;
1042 call do_action (p, P_txn_id, P_retry_count, P_retry_label);
1043 return;
1044 end;
1045 end;
1046
1047 handler_invoked_sw = "0"b;
1048
1049 return;
1050
1051
1052 do_action: proc (P_ptr, P_txn_id, P_retry_count, P_retry_label);
1053
1054 dcl P_ptr ptr;
1055 dcl P_txn_id bit (36) aligned;
1056 dcl (P_retry_count, action) fixed bin;
1057 dcl code fixed bin (35);
1058 dcl P_retry_label label variable;
1059
1060 action = P_ptr -> handler_node.action;
1061 if action = ABANDON_ACTION then do;
1062 call transaction_manager_$abandon_txn (P_txn_id, code);
1063 if code ^= 0 then transaction_severity_ = FAILED_ABORT_OR_ABANDON_SEVERITY;
1064 else transaction_severity_ = ABORT_OR_ABANDON_SEVERITY;
1065 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
1066 else call complain (0, my_name,
1067 "Abandoning the command line and its transaction because the ^a condition was signaled.",
1068 P_ptr -> handler_node.condition_name);
1069 goto RETURN;
1070 end;
1071 else if action = ABORT_ACTION then do;
1072 call transaction_manager_$abort_txn (P_txn_id, code);
1073 if code ^= 0 then transaction_severity_ = FAILED_ABORT_OR_ABANDON_SEVERITY;
1074 else transaction_severity_ = ABORT_OR_ABANDON_SEVERITY;
1075 if af_sw then return_arg = AF_SEVERITY_VALUE (transaction_severity_);
1076 else call complain (0, my_name,
1077 "Aborting the command line and its transaction because the ^a condition was signaled.",
1078 P_ptr -> handler_node.condition_name);
1079 goto RETURN;
1080 end;
1081 else if action = NO_ACTION then ;
1082 else if action = RETRY_ACTION then do;
1083 P_retry_count = P_retry_count + 1;
1084 if P_retry_count > p -> handler_node.retry_limit then return;
1085 else go to P_retry_label;
1086 end;
1087 else if action = SUSPEND_ACTION then do;
1088 call transaction_manager_$handle_conditions ();
1089 handler_invoked_sw = "0"b;
1090 end;
1091
1092 end do_action;
1093
1094 end CONDITION_HANDLER;
1095 %page;
1096 CURRENT_ID: proc returns (bit (36) aligned);
1097
1098 dcl txn_id bit (36) aligned;
1099 dcl tried_resume_sw bit (1);
1100 dcl code fixed bin (35);
1101
1102 tried_resume_sw = "0"b;
1103 GET_ID:
1104 call transaction_manager_$get_current_txn_id (txn_id, code);
1105 if code ^= 0 then do;
1106 if code = dm_error_$transaction_suspended & ^tried_resume_sw then
1107 if my_name = "txn status" then return (txn_id);
1108 else if my_name = "txn abandon" | my_name = "txn abort" then do;
1109 tried_resume_sw = "1"b;
1110 code = 0;
1111 call transaction_manager_$resume_txn (code);
1112 if code ^= 0 then do;
1113 if af_sw then return_arg = "false";
1114 else call complain (code, my_name, "Could not resume transaction.");
1115 go to RETURN;
1116 end;
1117 else go to GET_ID;
1118 end;
1119 if txn_id = "0"b then do;
1120 if af_sw then return_arg = "false";
1121 else call complain (code, my_name);
1122 go to RETURN;
1123 end;
1124 end;
1125 return (txn_id);
1126
1127 end CURRENT_ID;
1128 %page;
1129 DEAD_PROCESS: proc (P_process_id) returns (bit (1));
1130
1131 dcl P_process_id bit (36) aligned;
1132 dcl code fixed bin (35);
1133
1134 if P_process_id = "0"b then return ("0"b);
1135
1136 call hcs_$validate_processid (P_process_id, code);
1137 return (code ^= 0);
1138
1139 end DEAD_PROCESS;
1140 %page;
1141 ERROR_RETURN: proc;
1142
1143 go to RETURN;
1144
1145 end ERROR_RETURN;
1146 %page;
1147 EXECUTE_COMMAND_LINE: proc;
1148
1149 dcl line_len fixed bin (21);
1150 dcl arg_index fixed bin;
1151
1152 if command_line_start > 0 then do;
1153 line_len = -1;
1154 do arg_index
1155 = command_line_start to arg_count;
1156 call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_len, 0, alp);
1157 line_len = line_len + arg_len + 1;
1158 end;
1159 begin;
1160 dcl line char (line_len);
1161
1162 line = "";
1163 line_len = -1;
1164 do arg_index = command_line_start to arg_count;
1165 call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_len, 0, alp);
1166 substr (line, line_len + 2, arg_len) = arg;
1167 line_len = line_len + arg_len + 1;
1168 end;
1169
1170 handler_invoked_sw = "0"b;
1171 on any_other begin;
1172 call CONDITION_HANDLER (txn_id, retry_count, RETRY);
1173 end;
1174
1175 call cu_$cp (addr (line), line_len, code);
1176 if code ^= 0 then transaction_severity_ = ABORT_OR_ABANDON_SEVERITY;
1177 end;
1178 end;
1179
1180 else do;
1181 begin;
1182 dcl var_line char (3000) varying;
1183 dcl 1 qi aligned like query_info;
1184
1185 unspec (qi) = "0"b;
1186 qi.version = query_info_version_5;
1187 qi.question_iocbp, qi.answer_iocbp, qi.explanation_ptr = null;
1188 qi.suppress_name_sw = "1"b;
1189
1190 call command_query_ (addr (qi), var_line, "transaction execute", "Command line:");
1191
1192 handler_invoked_sw = "0"b;
1193 on any_other begin;
1194 call CONDITION_HANDLER (txn_id, retry_count, RETRY);
1195 end;
1196
1197 call cu_$cp (addrel (addr (var_line), 1), length (var_line), code);
1198 if code ^= 0 then transaction_severity_ = ABORT_OR_ABANDON_SEVERITY;
1199 end;
1200 end;
1201
1202 end EXECUTE_COMMAND_LINE;
1203 %page;
1204 GET_CONDITION_LIST: proc (P_name, P_index, P_action, P_retry_limit);
1205
1206 dcl P_name char (*);
1207 dcl (P_index, P_action, P_retry_limit, comma_pos, list_pos) fixed bin;
1208 dcl condition_name char (32);
1209 dcl COMMA char (1) int static options (constant) init (",");
1210
1211 P_index = P_index + 1;
1212 if P_index > arg_count then do;
1213 call complain (0, my_name, "No condition list specified for ^a", P_name);
1214 go to RETURN;
1215 end;
1216 call cu_$arg_ptr_rel (P_index, arg_ptr, arg_len, code, alp);
1217
1218 list_pos = 1;
1219 do while (list_pos <= arg_len);
1220
1221 comma_pos = verify (substr (arg, list_pos), COMMA);
1222 if comma_pos = 0 then return;
1223
1224 list_pos = list_pos + comma_pos - 1;
1225 comma_pos = index (substr (arg, list_pos), COMMA);
1226 if comma_pos = 0 then do;
1227 condition_name = substr (arg, list_pos);
1228 list_pos = arg_len + 1;
1229 end;
1230 else do;
1231 condition_name = substr (arg, list_pos, comma_pos - 1);
1232 list_pos = list_pos + comma_pos;
1233 end;
1234
1235 call SAVE_HANDLER (condition_name, P_action, P_retry_limit);
1236 end;
1237
1238 return;
1239
1240 end GET_CONDITION_LIST;
1241 %page;
1242 PRINT_ENTRY: proc ();
1243
1244 dcl (buffer, dn) char (168);
1245 dcl state_description_buffer char (68);
1246 dcl (en, time_string) char (32);
1247
1248 if txn_info.owner_process_id = "0"b then do;
1249 if af_sw & print_switches.pid then return_arg = "0";
1250 return;
1251 end;
1252
1253 if select_switches.abandoned & ^txn_info.abandoned_sw then do;
1254 if ^select_switches.dead | ^DEAD_PROCESS (txn_info.owner_process_id) then return;
1255 end;
1256 else if select_switches.dead & ^DEAD_PROCESS (txn_info.owner_process_id) then return;
1257
1258 printed_something_sw = "1"b;
1259
1260 txn_exists_sw = (txn_info.txn_id ^= "0"b);
1261 print_no_txn_warning_sw = "0"b;
1262
1263 if print_switches.tix then call PRINT_ITEM ("Transaction index", character (txn_info.txn_index), ENTRY_ITEM);
1264 if print_switches.tid then
1265 call PRINT_ITEM ("Transaction id", character (fixed (txn_info.txn_id)), TXN_ITEM);
1266 if print_switches.pid then do;
1267 call ioa_$rsnnl ("^w^[ (dead)^]", buffer, length (buffer), txn_info.owner_process_id,
1268 DEAD_PROCESS (txn_info.owner_process_id) & ^af_sw);
1269 call PRINT_ITEM ("Process id", buffer, ENTRY_ITEM);
1270 end;
1271 if print_switches.owner then call PRINT_ITEM ("Owner", (txn_info.owner_name), ENTRY_ITEM);
1272 if print_switches.dtm then do;
1273 if txn_info.date_time_created = 0
1274 then time_string = "(undefined)";
1275 else call date_time_ (txn_info.date_time_created, time_string);
1276 call PRINT_ITEM ("Begun at", time_string, TXN_ITEM);
1277 end;
1278 if print_switches.state then do;
1279 state_description_buffer = transaction_manager_$get_state_description (txn_info.state);
1280 call PRINT_ITEM ("State", state_description_buffer, TXN_ITEM);
1281 end;
1282 if print_switches.errors then
1283 if ^txn_info.error_sw then call PRINT_ITEM ("Error", "none", TXN_ITEM);
1284 else call PRINT_ITEM ("Error", CODE_DESCRIPTION (txn_info.error_code), TXN_ITEM);
1285 if print_switches.rollback_count then
1286 call PRINT_ITEM ("Rollback count", character (txn_info.rollback_count), TXN_ITEM);
1287 if print_switches.bj_path then do;
1288 if txn_info.bj_uid = "0"b then
1289 if af_sw then return_arg = "";
1290 else call ioa_ ("No before journal.");
1291 else do;
1292 if txn_info.owner_process_id = get_process_id_ () then
1293 call before_journal_manager_$get_bj_path_from_oid (txn_info.bj_oid, dn, en, code);
1294 else call before_journal_manager_$get_bj_path_from_uid (txn_info.bj_uid, dn, en, code);
1295 if code ^= 0 then
1296 call complain (code, my_name, "Before journal uid = ^w", txn_info.bj_uid);
1297 else call PRINT_ITEM ("Before journal path", pathname_ (dn, en), TXN_ITEM);
1298 end;
1299 end;
1300 if print_switches.switches then do;
1301 if unspec (txn_info.flags) = "0"b then buffer = "none";
1302 else do;
1303 buffer = "";
1304 if txn_info.abandoned_sw then buffer = "ABANDONED";
1305 if txn_info.kill_sw then call append ("KILL");
1306 if txn_info.suspended_sw then call append ("SUSPENDED");
1307 if txn_info.dead_process_sw then call append ("DEAD_PROCESS");
1308 end;
1309 call PRINT_ITEM ("Switches", buffer, TXN_ITEM);
1310 end;
1311
1312 if print_no_txn_warning_sw then call ioa_ ("No transaction.");
1313
1314 if multiple_info_sw & ^af_sw then call ioa_ ("");
1315
1316 append: proc (P_str);
1317
1318 dcl P_str char (*);
1319
1320 if buffer ^= "" then buffer = rtrim (buffer) || ",";
1321 buffer = rtrim (buffer) || P_str;
1322
1323 end append;
1324
1325 end PRINT_ENTRY;
1326 %page;
1327 PRINT_ITEM: proc (P_name, P_value, P_item_type);
1328
1329 dcl (P_name, P_value) char (*);
1330 dcl P_item_type fixed bin;
1331
1332 if af_sw then do;
1333 if txn_exists_sw | P_item_type = ENTRY_ITEM then return_arg = ltrim (rtrim (P_value));
1334 end;
1335
1336 else if ^txn_exists_sw & P_item_type = TXN_ITEM then print_no_txn_warning_sw = "1"b;
1337
1338 else if multiple_info_sw then call ioa_ ("^a: ^a", P_name, ltrim (rtrim (P_value)));
1339 else call ioa_ ("^a", ltrim (rtrim (P_value)));
1340
1341 end PRINT_ITEM;
1342 %page;
1343 REQUEST_INFO: proc (P_sw);
1344
1345 dcl P_sw bit (1) unaligned;
1346
1347 P_sw = "0"b;
1348 if unspec (print_switches) ^= "0"b then do;
1349 if af_sw then do;
1350 call complain (0, my_name, "Can only return one item of information.");
1351 go to RETURN;
1352 end;
1353 multiple_info_sw = "1"b;
1354 end;
1355
1356 P_sw = "1"b;
1357
1358 return;
1359
1360 end REQUEST_INFO;
1361 %page;
1362 SAVE_HANDLER: proc (P_condition_name, P_action, P_retry_limit);
1363
1364 dcl P_condition_name char (*);
1365 dcl (P_action, P_retry_limit) fixed bin;
1366 dcl (p, last_p) ptr;
1367
1368 if first_handler_ptr = null then do;
1369 allocate handler_node in (area) set (p);
1370 first_handler_ptr = p;
1371 FILL_NEW_NODE:
1372 p -> handler_node.next_ptr = null;
1373 p -> handler_node.condition_name = P_condition_name;
1374 FILL_NODE:
1375 p -> handler_node.action = P_action;
1376 p -> handler_node.retry_limit = P_retry_limit;
1377 return;
1378 end;
1379 do p = first_handler_ptr repeat (p -> handler_node.next_ptr) while (p ^= null);
1380 if p -> handler_node.condition_name = P_condition_name then go to FILL_NODE;
1381 last_p = p;
1382 end;
1383 allocate handler_node in (area) set (p);
1384 last_p -> handler_node.next_ptr = p;
1385 go to FILL_NEW_NODE;
1386
1387 end SAVE_HANDLER;
1388 %page;
1389 SUB_ERROR_CODE: proc returns (fixed bin (35));
1390
1391 call find_condition_info_ (null, addr (cond_info), code);
1392 if code ^= 0 then return (dm_error_$system_not_initialized);
1393
1394 if cond_info.info_ptr -> sub_error_info.default_restart then do;
1395
1396 call continue_to_signal_ (0);
1397 return (0);
1398 end;
1399
1400 else return (cond_info.info_ptr -> sub_error_info.retval);
1401
1402 end SUB_ERROR_CODE;
1403 %page;
1404 USAGE_STRING: proc (P_str) returns (char (128));
1405
1406 dcl P_str char (*);
1407 dcl buffer char (128) varying;
1408
1409 buffer = "Usage: " || rtrim (my_name);
1410 if P_str ^= "" then buffer = buffer || " " || P_str;
1411 if af_sw
1412 then return ("[" || buffer || "]");
1413 else return (buffer);
1414
1415 end USAGE_STRING;
1416 %page;
1417 %include condition_info;
1418 %page;
1419 %include condition_info_header;
1420 %page;
1421 %include dm_tm_modes;
1422 %page;
1423 %include dm_tm_txn_info;
1424 %page;
1425 %include query_info;
1426 %page;
1427 %include sub_error_info;
1428
1429
1430 end transaction;