1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    *********************************************************** */
 6 dft: default: proc;
 7 
 8 /* This active function is used to insert the arg1 default value into a command line
 9    whenever the optional second argument is not supplied, or is zero length. */
10 
11 /* Usage: [default <arg1> {<optional_arg2>}] */
12 
13 /* Concept by Mike Grady, this version by Bob May, 9/30/76 */
14 /* Modified 10/07/83 Charlie Spitzer. let work as a command. */
15 
16 dcl  code fixed bin (35),                                   /* standard return code */
17      entrypoint_name char (7) init ("default") int static options (constant);
18 
19 dcl  error_table_$wrong_no_of_args fixed bin (35) external;
20 dcl  error_table_$not_act_fnc fixed bin(35) ext static;
21 
22 dcl  active_func bit (1) aligned;
23 dcl  error entry variable entry options (variable);
24 
25 dcl  af_arg_count fixed bin,                                /* to process input args */
26      af_arg_ptr ptr,
27      af_arg_cc fixed bin,
28      af_arg char (af_arg_cc) based (af_arg_ptr);
29 
30 dcl  af_return_arg_ptr ptr,                                 /* to return result */
31      af_return_arg_cc fixed bin,
32      af_return_arg char (af_return_arg_cc) varying based (af_return_arg_ptr);
33 
34 dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)),
35      cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
36      active_fnc_err_ entry options (variable),
37      com_err_ entry() options(variable),
38      ioa_ entry() options(variable);
39 
40           call cu_$af_return_arg (af_arg_count, af_return_arg_ptr, af_return_arg_cc, code);
41           if code = 0 then active_func = "1"b;
42           else if code = error_table_$not_act_fnc
43                then active_func = "0"b;
44           else do;
45                call active_fnc_err_ (code, entrypoint_name, "Attempting to get calling sequence parameters.");
46                return;                                      /* just in case we ever get back here */
47           end;
48 
49           if active_func
50           then error = active_fnc_err_;
51           else error = com_err_;
52 
53           if af_arg_count = 0 | af_arg_count > 2 then do;
54                call error (error_table_$wrong_no_of_args, entrypoint_name,
55                     "^/Usage: ^[[^]default <arg1> {<optional_arg2>}^[]^]", active_func, active_func);
56                return;
57           end;
58 
59 rerun:
60           call cu_$arg_ptr (af_arg_count, af_arg_ptr, af_arg_cc, code);
61           if code ^= 0 then do;
62                call error (code, entrypoint_name, "Getting argument ^d from command line.", af_arg_count);
63                return;
64           end;
65 
66           if af_arg_count = 2 then if af_arg_cc = 0         /* If arg2 is zero length, then return arg1 */
67                then do;                                     /* If we use arg1 and it is zero length... */
68                     af_arg_count = 1;                       /* ... then return it anyway */
69                     go to rerun;
70                end;
71 
72           if active_func
73           then af_return_arg = af_arg;
74           else call ioa_ ("^a", af_arg);
75 
76           return;
77 
78      end /* default */ ;