1
2
3
4
5
6
7
8 bce_severity: proc (P_ss_info_ptr);
9
10
11
12
13
14 dcl P_ss_info_ptr ptr parameter;
15 dcl active_fnc_err_ entry options (variable);
16 dcl active_function bit (1) aligned;
17 dcl af_return char (af_return_len) based (af_return_ptr) var;
18 dcl af_return_len fixed bin (21);
19 dcl af_return_ptr ptr;
20 dcl arg char (arg_len) based (arg_ptr);
21 dcl arg_count fixed bin;
22 dcl arg_len fixed bin (21);
23 dcl arg_ptr ptr;
24 dcl bce_dump$severity entry () returns (fixed bin);
25 dcl code fixed bin (35);
26 dcl com_err_ entry options (variable);
27 dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
28 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
29 dcl error variable entry options (variable);
30 dcl error_table_$badopt fixed bin (35) ext;
31 dcl error_table_$not_act_fnc fixed bin (35) ext;
32 dcl ioa_ entry options (variable);
33 dcl me char (8) init ("severity") static options (constant);
34 dcl value fixed bin;
35
36 ss_info_ptr = P_ss_info_ptr;
37 arg_list_ptr = ss_info.arg_list_ptr;
38 call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr);
39 active_function = (code = 0);
40 if active_function then error = active_fnc_err_;
41 else error = com_err_;
42 if arg_count ^= 1 then do;
43 call error (0, me, "Usage is: severity command_name");
44 return;
45 end;
46
47 call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, arg_list_ptr);
48 if arg = "dump" then value = bce_dump$severity ();
49 else do;
50 call error (error_table_$badopt, me, "^a", arg);
51 return;
52 end;
53
54 if active_function then af_return = ltrim (character (value));
55 else call ioa_ ("^d", value);
56 return;
57 %page; %include bce_subsystem_info_;
58 end;