1 /****^  ***********************************************************
 2         *                                                         *
 3         * Copyright, (C) Honeywell Bull Inc., 1987                *
 4         *                                                         *
 5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
 6         *                                                         *
 7         *********************************************************** */
 8 bce_severity: proc (P_ss_info_ptr);
 9 
10 /* Version of severity for bce.  Keith Loepere, January 1984. */
11 
12 /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */
13 
14 dcl  P_ss_info_ptr                    ptr parameter;
15 dcl  active_fnc_err_                  entry options (variable);
16 dcl  active_function                  bit (1) aligned;      /* as opposed to command usage */
17 dcl  af_return                        char (af_return_len) based (af_return_ptr) var; /* return for active function */
18 dcl  af_return_len                    fixed bin (21);
19 dcl  af_return_ptr                    ptr;
20 dcl  arg                              char (arg_len) based (arg_ptr); /* command line arg */
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);/* program name */
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;