1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4         *                                                         *
   5         * Copyright (c) 1972 by Massachusetts Institute of        *
   6         * Technology and Honeywell Information Systems, Inc.      *
   7         *                                                         *
   8         *********************************************************** */
   9 
  10 /****^              DO/EXECUTE_STRING/SUBSTITUTE_ARGUMENTS
  11 
  12       Command/requests to expand specified string by substituting
  13       arguments, and optionally executing the expansion.
  14 
  15       Created:  30 October 1973 by BLW.
  16       Modified: 31 December 1974 by Steve Herbst to remove string parameter.
  17       Modified: 16 December 1975 by Steve Herbst to add &f and &n.
  18       Modified: 3 March 1976 by Steve Herbst to add &qf and &rf.
  19       Modified: 3 August 1976 by Steve Herbst to accept any number of
  20                 mode-changing control arguments.
  21       Modified: 15 October 1976 by Steve Herbst to fix bug with &f.
  22       Modified: 16 February 1982 by G. Palter to add ssu_do_request_ and
  23                 convert to use a standalone subsystem invocation.
  24       Modified: 28 April 1982 by G. Dixon to allow AF first arg to begin with
  25                 minus.
  26       Modified: 8 September 1982 by G. Palter to propagate subsystem/request
  27                 line aborts. */
  28 
  29 
  30 
  31 /****^  HISTORY COMMENTS:
  32   1) change(86-08-11,JSLove), approve(86-08-12,MCR7520),
  33      audit(86-08-14,FCSmith), install(86-10-01,MR12.0-1170):
  34      Changed to permit control arguments and the control string in the same
  35      invocation. Added -control_string (-cs) option to permit control string to
  36      begin with a hyphen.  Added -inhibit_error and -no_inhibit_error as
  37      synonyms of -absentee and -interactive, respectively. Added -abort_line
  38      (-abl) mode for subsystem execution.  Improved expansion error
  39      diagnostics. Changed handling of &r1&r2 to eliminate spurious quote. Added
  40      &control_string construct and handling of "zeroth" argument.
  41   2) change(86-08-11,JSLove), approve(86-08-12,MCR7519),
  42      audit(86-08-14,FCSmith), install(86-10-01,MR12.0-1170):
  43      Added execute_string and substitute_arguments entries. At this time,
  44      substantial changes were required to permit the expansion of the
  45      execute_string AF's -error_value.  Other changes were made for clarity,
  46      coding standards, performance, robustness and minimizing the stack frame
  47      size.   The complete set of changes amount to a substantial rewrite,
  48      including: Removed standalone subsystem invocation.  Changed to allocate
  49      expanded buffer rather than growing stack frame.  Changed to use PL/I "on"
  50      statement to set handlers rather than the condition_ subroutine.
  51   3) change(86-10-09,JSLove), approve(86-10-13,MCR7519),
  52      audit(86-10-13,Parisek), install(86-10-15,MR12.0-1186):
  53      Post-installation Bug Fix: changed error message associated with request
  54      line aborts to not report ssu_et_$request_line_aborted in brief mode.
  55                                                    END HISTORY COMMENTS */
  56 
  57 
  58 
  59 /* format: style3,ifthenstmt,indcomtxt,indproc,idind30 */
  60 
  61 do:
  62      procedure () options (variable);
  63 
  64 declare   P_info_ptr                    ptr parameter,      /* subsystem request -> subsystem's internal data */
  65           P_sci_ptr                     ptr parameter;      /* subsystem request -> SCI of subsystem */
  66 
  67 declare   (addcharno, addr, addwordno, binary, copy, divide, hbound, index, lbound, length, ltrim, maxlength, min, mod,
  68           null, rtrim, substr, verify)  builtin;
  69 
  70 declare   (active_function_error, any_other, area, cleanup)
  71                                         condition;
  72 
  73 declare   abort_line                    bit (1) aligned,
  74           allocated_buffer_max_len      fixed bin (21),
  75           allocated_buffer_ptr          ptr,
  76           arg_count                     fixed bin (17),
  77           arg_list_ptr                  ptr,
  78           arg_offset                    fixed bin (17),
  79           entrypoint                    fixed bin (2),
  80           error_value_len               fixed bin (21),
  81           error_value_ptr               ptr,
  82           execute                       bit (1) aligned,
  83           expansion_buffer              char (256) varying,
  84           expansion_max_len             fixed bin (21),
  85           expansion_ptr                 ptr,
  86           inhibit_error                 bit (1) aligned,
  87           rescan_type                   fixed bin (17),
  88           return_value_max_len          fixed bin (21),
  89           return_value_ptr              ptr,
  90           sci_ptr                       ptr,
  91           status                        fixed bin (35),
  92           trace                         bit (1) aligned,
  93           unique                        char (15) aligned;
  94 
  95 declare   allocated_buffer              char (allocated_buffer_max_len) varying based (allocated_buffer_ptr),
  96           command                       char (length (expansion)) based (addwordno (addr (expansion), 1)),
  97           expansion                     char (expansion_max_len) varying based (expansion_ptr),
  98           return_value                  char (return_value_max_len) varying based (return_value_ptr),
  99           system_area                   area based (get_system_free_area_ ());
 100 
 101 declare   abort_line_mode               (2) bit (1) aligned static initial ((2) ("1"b)),
 102           execute_mode                  (2) bit (1) aligned static initial ((2) ("1"b)),
 103           inhibit_error_mode            (2) bit (1) aligned static initial ((2) ("0"b)),
 104           trace_mode                    (3) bit (1) aligned static initial ((3) ("0"b));
 105 
 106 declare   AMPERSAND                     char (1) static options (constant) initial ("&"),
 107           BLANK                         char (1) static options (constant) initial (" "),
 108           QUOTE                         char (1) static options (constant) initial (""""),
 109           WHITE                         char (5) static options (constant) initial ("^L^K
 110            ");                                              /* FF VT NL HT SPACE                                        */
 111 
 112 declare   (
 113           DO_ENTRY                      initial (1),
 114           EXECUTE_ENTRY                 initial (2),
 115           SUBSTITUTE_ENTRY              initial (3)
 116           )                             fixed bin (2) static options (constant);
 117 
 118 declare   (
 119           ILLEGAL_CHARACTER             initial (1),
 120           ILLEGAL_END_CONTROL_STRING    initial (2),
 121           ILLEGAL_END_ERROR_VALUE       initial (3),
 122           ILLEGAL_INTEGER               initial (4),
 123           ILLEGAL_KEYWORD               initial (5),
 124           ILLEGAL_UNCLOSED              initial (6)
 125           )                             fixed bin (3) static options (constant);
 126 
 127 declare   (
 128           NO_QUOTE_MODIFIER             initial (1),
 129           PROTECT_QUOTES_MODIFIER       initial (2),
 130           REQUOTE_MODIFIER              initial (3)
 131           )                             fixed bin (2) static options (constant);
 132 
 133 declare   MY_NAME                       (3) char (20) static options (constant)
 134                                         initial ("do", "execute_string", "substitute_arguments"),
 135           MY_SHORT_NAME                 (3) char (4) varying static options (constant) initial ("do", "exs", "sbag");
 136 
 137 declare   (
 138           PARSER_EXPLICIT_CONTROL_STRING
 139                                         initial (1),
 140           PARSER_FOUND_CONTROL_STRING   initial (2),
 141           PARSER_WANTS_CONTROL_STRING   initial (3),
 142           PARSER_WANTS_ERROR_VALUE      initial (4)
 143           )                             fixed bin (3) static options (constant);
 144 
 145 declare   REASONS                       (6) char (85) varying static options (constant)
 146                                         initial ("An invalid character terminates substitution construct ^a.",
 147                                         "Substitution construct ^a is incomplete at the end of the control string.",
 148                                         "Substitution construct ^a is incomplete at the end of the error value.",
 149                                         "The parenthesized part of substitution construct ^a must be an unsigned integer.",
 150                                         "^a is not a valid substitution construct.",
 151                                         "There is no "")"" terminating substitution construct ^a.");
 152 
 153 declare   SPECIAL_CONDITIONS            (5) char (24) varying static options (constant)
 154                                         initial ("alrm", "cput", "quit", "program_interrupt", "record_quota_overflow");
 155 
 156 declare   (
 157           COMMAND_USAGE                 char (39) initial ("{-control_args} {control_string {args}}"),
 158           EXS_AF_USAGE                  char (37) initial ("{-control_args} control_string {args}"),
 159           SBAG_AF_USAGE                 char (21) initial ("control_string {args}") char (21)
 160           )                             static options (constant);
 161 
 162 declare   NO_FROM_WARNING               char (95) static options (constant)
 163                                         initial ("""&^[q^;r^]f&n"" must be used instead of argument designator ^a.^[
 164           Type ""start"" to continue.^]");
 165 
 166 declare   TRUNCATION_WARNING            char (127) static options (constant) initial ("
 167           Only the first ^d characters of the expanded ^[error value^;control string^]
 168           can be returned.^[  Type ""start"" to continue.^]");
 169 
 170 declare   (
 171           error_table_$badopt,
 172           error_table_$command_line_overflow,
 173           error_table_$inconsistent,
 174           error_table_$noarg,
 175           error_table_$not_act_fnc,
 176           ssu_et_$null_request_line,
 177           ssu_et_$request_line_aborted,
 178           ssu_et_$subsystem_aborted
 179           )                             fixed bin (35) external;
 180 
 181 declare   iox_$error_output             ptr external;
 182 
 183 declare   active_fnc_err_               entry () options (variable),
 184           active_fnc_err_$suppress_name entry () options (variable),
 185           com_err_                      entry () options (variable),
 186           com_err_$suppress_name        entry () options (variable),
 187           condition_interpreter_        entry (ptr, ptr, fixed bin (17), fixed bin (17), ptr, char (*), ptr, ptr),
 188           continue_to_signal_           entry (fixed bin (35)),
 189           cu_$af_return_arg_rel         entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr),
 190           cu_$arg_list_ptr              entry () returns (ptr),
 191           cu_$arg_ptr_rel               entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr),
 192           cu_$cp                        entry (ptr, fixed bin (21), fixed bin (35)),
 193           cu_$evaluate_active_string    entry (ptr, char (*), fixed bin, char (*) var, fixed bin (35)),
 194           find_condition_info_          entry (ptr, ptr, fixed bin (35)),
 195           get_system_free_area_         entry () returns (ptr),
 196           ioa_                          entry () options (variable),
 197           ioa_$general_rs               entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
 198                                         bit (1) aligned),
 199           ioa_$ioa_switch               entry () options (variable),
 200           requote_string_               entry (char (*)) returns (char (*)),
 201           ssu_$abort_line               entry () options (variable),
 202           ssu_$abort_subsystem          entry () options (variable),
 203           ssu_$arg_ptr                  entry (ptr, fixed bin (17), ptr, fixed bin (21)),
 204           ssu_$evaluate_active_string   entry (ptr, ptr, char (*), fixed bin (17), char (*) var, fixed bin (35)),
 205           ssu_$execute_line             entry (ptr, ptr, fixed bin (21), fixed bin (35)),
 206           ssu_$get_subsystem_and_request_name
 207                                         entry (ptr) returns (char (72) varying),
 208           ssu_$get_request_name         entry (ptr) returns (char (32)),
 209           ssu_$print_message            entry () options (variable),
 210           ssu_$return_arg               entry (ptr, fixed bin (17), bit (1) aligned, ptr, fixed bin (21)),
 211           unique_chars_                 entry (bit (*) aligned) returns (char (15) aligned);
 212 %page;
 213 %include condition_info;
 214 %page;
 215 %include cp_active_string_types;
 216 %page;
 217 /* do: entry () options (variable); */
 218 
 219           entrypoint = DO_ENTRY;                            /* Execute as command, Substitute as AF */
 220 
 221           go to STANDALONE;
 222 
 223 exs:
 224 execute_string:
 225      entry () options (variable);
 226 
 227           entrypoint = EXECUTE_ENTRY;
 228 
 229           go to STANDALONE;
 230 
 231 sbag:
 232 substitute_args:
 233 substitute_arguments:
 234      entry () options (variable);
 235 
 236           entrypoint = SUBSTITUTE_ENTRY;
 237 
 238 STANDALONE:
 239           sci_ptr = null ();
 240 
 241           go to COMMON;
 242 
 243 ssu_do_request_:
 244      entry (P_sci_ptr, P_info_ptr);
 245 
 246           entrypoint = DO_ENTRY;
 247 
 248           go to SUBSYSTEM;
 249 
 250 ssu_execute_string_request_:
 251      entry (P_sci_ptr, P_info_ptr);
 252 
 253           entrypoint = EXECUTE_ENTRY;
 254 
 255           go to SUBSYSTEM;
 256 
 257 ssu_substitute_args_request_:
 258      entry (P_sci_ptr, P_info_ptr);
 259 
 260           entrypoint = SUBSTITUTE_ENTRY;
 261 
 262 SUBSYSTEM:
 263           sci_ptr = P_sci_ptr;
 264 
 265           go to COMMON;
 266 %page;
 267 /* Actual work starts here */
 268 
 269 COMMON:
 270           allocated_buffer_max_len, error_value_len = 0;
 271           allocated_buffer_ptr, arg_list_ptr, error_value_ptr = null ();
 272           expansion_max_len = maxlength (expansion_buffer);
 273           expansion_ptr = addr (expansion_buffer);
 274           trace = trace_mode (entrypoint);
 275           unique = "";
 276 
 277           on cleanup
 278                begin;
 279                     if allocated_buffer_ptr ^= null () then free allocated_buffer in (system_area);
 280                end;
 281 
 282           if sci_ptr = null ()
 283           then call check_arguments (cu_$arg_list_ptr ());
 284           else call ssu_$return_arg (sci_ptr, arg_count, ("0"b), return_value_ptr, return_value_max_len);
 285 
 286           if return_value_ptr = null ()
 287           then go to COMMAND (entrypoint);
 288           else go to FUNCTION (entrypoint);
 289 
 290 COMMAND (1):                                                /* "do" */
 291 COMMAND (2):                                                /* "execute_string" */
 292           call execute_string_command ();
 293 
 294           if ^execute then go to EGRESS;
 295 
 296           if inhibit_error then on any_other call any_other_handler ();
 297 
 298           if sci_ptr = null ()
 299           then call cu_$cp (addr (command), length (command), status);
 300           else call ssu_$execute_line (sci_ptr, addr (command), length (command), status);
 301 
 302           revert any_other;
 303 
 304           if status ^= 0 then call execute_string_command_error ();
 305 
 306           go to EGRESS;
 307 
 308 COMMAND (3):                                                /* "substitute_arguments" */
 309           call substitute_args_command ();
 310 
 311 EGRESS:                                                     /* Common exit and error abort point */
 312           revert active_function_error, any_other;
 313 
 314           if allocated_buffer_ptr ^= null () then free allocated_buffer in (system_area);
 315 
 316           return;
 317 %page;
 318 FUNCTION (1):                                               /* "do" */
 319 FUNCTION (3):                                               /* "substitute_arguments" */
 320           call substitute_args_function ();
 321 
 322           go to EGRESS;
 323 
 324 FUNCTION (2):                                               /* "execute_string" */
 325           call execute_string_function ();
 326 
 327           if error_value_ptr ^= null ()
 328           then do;
 329                     if sci_ptr = null () then on active_function_error call active_function_error_handler ();
 330                     if inhibit_error then on any_other call any_other_handler ();
 331                end;
 332 
 333           if sci_ptr = null ()
 334           then call cu_$evaluate_active_string (null (), command, rescan_type, return_value, status);
 335           else call ssu_$evaluate_active_string (sci_ptr, null (), command, rescan_type, return_value, status);
 336 
 337           revert active_function_error, any_other;
 338 
 339           if status ^= 0 then call execute_string_function_error ();
 340 
 341           go to EGRESS;
 342 
 343 SUBSTITUTE_ERROR_VALUE:
 344           revert active_function_error, any_other;
 345 
 346           call expand_error_value ();
 347 
 348           go to EGRESS;
 349 %page;
 350 /**** Handler for errors during execution of an active function.  Only
 351       errors reported by the active function are caught by this handler, as
 352       opposed to faults which might occur during its execution. */
 353 
 354 active_function_error_handler:
 355      procedure ();
 356 
 357 declare   1 CI                          aligned like condition_info;
 358 
 359           if trace
 360           then do;
 361                     CI.version = condition_info_version_1;
 362                     call find_condition_info_ (null (), addr (CI), (0));
 363                     call condition_interpreter_ (null (), null (), 0, 0, CI.mc_ptr, (CI.condition_name), CI.wc_ptr,
 364                          CI.info_ptr);
 365                end;
 366 
 367           go to SUBSTITUTE_ERROR_VALUE;
 368 
 369      end active_function_error_handler;
 370 %page;
 371 /**** Handler for unexpected conditions during execution of the command,
 372       active function or request line.  Certain conditions are ignored
 373       (i.e., passed on to other handlers). */
 374 
 375 any_other_handler:
 376      procedure ();
 377 
 378 declare   conditionx                    fixed bin (17);
 379 
 380 declare   1 CI                          aligned like condition_info;
 381 
 382           CI.version = condition_info_version_1;
 383           call find_condition_info_ (null (), addr (CI), (0));
 384 
 385           if length (CI.condition_name) > length ("command_")
 386           then if substr (CI.condition_name, 1, length ("command_")) = "command_" then go to CONTINUE;
 387 
 388           do conditionx = lbound (SPECIAL_CONDITIONS, 1) to hbound (SPECIAL_CONDITIONS, 1);
 389 
 390                if CI.condition_name = SPECIAL_CONDITIONS (conditionx) then go to CONTINUE;
 391           end;
 392 
 393           if return_value_ptr = null () | trace
 394           then call condition_interpreter_ (null (), null (), 0, 0, CI.mc_ptr, (CI.condition_name), CI.wc_ptr,
 395                     CI.info_ptr);
 396 
 397           if error_value_ptr ^= null ()
 398           then go to SUBSTITUTE_ERROR_VALUE;
 399           else go to EGRESS;
 400 
 401 CONTINUE:
 402           call continue_to_signal_ ((0));
 403 
 404           return;
 405 
 406      end any_other_handler;
 407 %page;
 408 /**** Get argument count and active function return value for non-SSU case. */
 409 
 410 check_arguments:
 411      procedure (P_arg_list_ptr) options (non_quick);
 412 
 413 declare   P_arg_list_ptr                ptr parameter;
 414 
 415           arg_list_ptr = P_arg_list_ptr;
 416 
 417           call cu_$af_return_arg_rel (arg_count, return_value_ptr, return_value_max_len, status, arg_list_ptr);
 418           if status = 0 then return;
 419           if status = error_table_$not_act_fnc then return;
 420 
 421           call com_err_ (status, MY_NAME (entrypoint), "Can't get argument count.");
 422 
 423           go to EGRESS;
 424 
 425      end check_arguments;
 426 %page;
 427 execute_string_command:
 428      procedure () options (non_quick);
 429 
 430 declare   arg_len                       fixed bin (21),
 431           arg_ptr                       ptr,
 432           argx                          fixed bin (17),
 433           control_string_len            fixed bin (21),
 434           control_string_ptr            ptr,
 435           parser                        fixed bin (3),
 436           saved_parser                  fixed bin (3);
 437 
 438 declare   arg                           char (arg_len) based (arg_ptr),
 439           control_string                char (control_string_len) based (control_string_ptr);
 440 
 441           if arg_count = 0 then call usage (COMMAND_USAGE);
 442 
 443           abort_line = abort_line_mode (entrypoint);
 444           execute = execute_mode (entrypoint);
 445           inhibit_error = inhibit_error_mode (entrypoint);
 446           parser = PARSER_WANTS_CONTROL_STRING;
 447 
 448           do argx = 1 to arg_count while (parser ^= PARSER_FOUND_CONTROL_STRING);
 449 
 450                call get_argument (argx);
 451 
 452                if parser = PARSER_EXPLICIT_CONTROL_STRING then parser = PARSER_FOUND_CONTROL_STRING;
 453                else if substr (arg, 1, min (1, length (arg))) = "-"
 454                then if arg = "-abort_line" | arg = "-abl" then abort_line = "1"b;
 455                     else if arg = "-brief" | arg = "-bf" then trace = "0"b;
 456                     else if arg = "-control_string" | arg = "-cs" then parser = PARSER_EXPLICIT_CONTROL_STRING;
 457                     else if arg = "-go" then execute = "1"b;
 458                     else if arg = "-inhibit_error" | arg = "-ihe" | arg = "-absentee" | arg = "-abs"
 459                     then inhibit_error = "1"b;
 460                     else if arg = "-long" | arg = "-lg" then trace = "1"b;
 461                     else if arg = "-no_abort_line" | arg = "-nabl" then abort_line = "0"b;
 462                     else if arg = "-no_go" | arg = "-nogo" then execute = "0"b;
 463                     else if arg = "-no_inhibit_error" | arg = "-nihe" | arg = "-interactive" | arg = "-ia"
 464                     then inhibit_error = "0"b;
 465                     else go to BADOPT;
 466                else parser = PARSER_FOUND_CONTROL_STRING;
 467           end;
 468 
 469           if parser = PARSER_WANTS_CONTROL_STRING
 470           then do;
 471                     abort_line_mode (entrypoint) = abort_line;
 472                     execute_mode (entrypoint) = execute;
 473                     inhibit_error_mode (entrypoint) = inhibit_error;
 474                     trace_mode (entrypoint) = trace;
 475                     go to EGRESS;
 476                end;
 477 
 478           if parser ^= PARSER_FOUND_CONTROL_STRING then go to NOARG;
 479 
 480           arg_offset = argx - 1;
 481 
 482           call expand ();
 483 
 484           return;
 485 %page;
 486 execute_string_function:
 487      entry ();
 488 
 489           inhibit_error = "0"b;
 490           parser = PARSER_WANTS_CONTROL_STRING;
 491           rescan_type = ATOMIC_ACTIVE_STRING;
 492 
 493           do argx = 1 to arg_count while (parser ^= PARSER_FOUND_CONTROL_STRING);
 494 
 495                call get_argument (argx);
 496 
 497                if parser = PARSER_EXPLICIT_CONTROL_STRING then parser = PARSER_FOUND_CONTROL_STRING;
 498                else if parser = PARSER_WANTS_ERROR_VALUE
 499                then do;
 500                          error_value_len = arg_len;
 501                          error_value_ptr = arg_ptr;
 502                          parser = saved_parser;
 503                     end;
 504                else if substr (arg, 1, min (1, length (arg))) = "-"
 505                then if arg = "-brief" | arg = "-bf" then trace = "0"b;
 506                     else if arg = "-control_string" | arg = "-cs" then parser = PARSER_EXPLICIT_CONTROL_STRING;
 507                     else if arg = "-error_value" | arg = "-erv"
 508                     then do;
 509                               saved_parser = parser;
 510                               parser = PARSER_WANTS_ERROR_VALUE;
 511                          end;
 512                     else if arg = "-inhibit_error" | arg = "-ihe" then inhibit_error = "1"b;
 513                     else if arg = "-long" | arg = "-lg" then trace = "1"b;
 514                     else if arg = "-no_inhibit_error" | arg = "-nihe" then inhibit_error = "0"b;
 515                     else if arg = "-no_rescan" | arg = "-nrsc" then rescan_type = ATOMIC_ACTIVE_STRING;
 516                     else if arg = "-rescan" | arg = "-rsc" then rescan_type = NORMAL_ACTIVE_STRING;
 517                     else if arg = "-rescan_tokens" | arg = "-rsct" then rescan_type = TOKENS_ONLY_ACTIVE_STRING;
 518                     else go to BADOPT;
 519                else parser = PARSER_FOUND_CONTROL_STRING;
 520           end;
 521 
 522           if parser = PARSER_WANTS_CONTROL_STRING then call usage (EXS_AF_USAGE);
 523 
 524           if parser ^= PARSER_FOUND_CONTROL_STRING then go to NOARG;
 525 
 526           if error_value_ptr = null () & inhibit_error
 527           then call error (error_table_$inconsistent, "-inhibit_error without -error_value");
 528 
 529           if error_value_ptr ^= null () then inhibit_error = inhibit_error | inhibit_error_mode (entrypoint);
 530 
 531           arg_offset = argx - 1;
 532 
 533           call expand ();
 534 
 535           return;
 536 %page;
 537 execute_string_command_error:
 538      entry ();
 539 
 540           if sci_ptr = null ()
 541           then do;
 542                     if status = 100 | ^trace then return;
 543                end;
 544           else if status = ssu_et_$null_request_line then return;
 545           else if status = ssu_et_$subsystem_aborted then call ssu_$abort_subsystem (sci_ptr);
 546           else if status = ssu_et_$request_line_aborted & ^trace
 547           then if abort_line
 548                then call ssu_$abort_line (sci_ptr);
 549                else return;
 550 
 551           if abort_line then call error (status, "Executing ^a.", requote_string_ (command));
 552 
 553           call warn (status, "Executing ^a.", requote_string_ (command));
 554 
 555           return;
 556 
 557 execute_string_function_error:
 558      entry ();
 559 
 560           if error_value_ptr = null ()
 561           then do;
 562                     if status = error_table_$command_line_overflow
 563                     then do;
 564                               call warn (status, "Result truncated to ^d characters^[ evaluating ^a^].",
 565                                    return_value_max_len, trace, requote_string_ (command));
 566                               return;
 567                          end;
 568 
 569                     if sci_ptr ^= null ()
 570                     then if status = ssu_et_$subsystem_aborted then call ssu_$abort_subsystem (sci_ptr);
 571                          else if status = ssu_et_$request_line_aborted & ^trace then call ssu_$abort_line (sci_ptr);
 572 
 573                     if trace then call error (status, "Evaluating ^a.", requote_string_ (command));
 574 
 575                     return;
 576                end;
 577 
 578 expand_error_value:
 579      entry ();
 580 
 581           arg_len = error_value_len;
 582           arg_ptr = error_value_ptr;
 583 
 584           expansion_max_len = return_value_max_len;
 585           expansion_ptr = return_value_ptr;
 586 
 587           call expand ();
 588 
 589           return;
 590 %page;
 591 /**** This case is used only by the substitute_arguments command, and
 592       accepts fewer control arguments than the execute_string cases.  The
 593       substitute_arguments command and active function have only the
 594       long/brief mode, since the other modes relate to execution of the
 595       expansion. */
 596 
 597 substitute_args_command:
 598      entry ();
 599 
 600           if arg_count = 0 then call usage (COMMAND_USAGE);
 601 
 602           parser = PARSER_WANTS_CONTROL_STRING;
 603 
 604           do argx = 1 to arg_count while (parser ^= PARSER_FOUND_CONTROL_STRING);
 605 
 606                call get_argument (argx);
 607 
 608                if parser = PARSER_EXPLICIT_CONTROL_STRING then parser = PARSER_FOUND_CONTROL_STRING;
 609                else if substr (arg, 1, min (1, length (arg))) = "-"
 610                then if arg = "-brief" | arg = "-bf" then trace = "0"b;
 611                     else if arg = "-control_string" | arg = "-cs" then parser = PARSER_EXPLICIT_CONTROL_STRING;
 612                     else if arg = "-long" | arg = "-lg" then trace = "1"b;
 613                     else go to BADOPT;
 614                else parser = PARSER_FOUND_CONTROL_STRING;
 615           end;
 616 
 617           if parser = PARSER_WANTS_CONTROL_STRING
 618           then do;
 619                     trace_mode (entrypoint) = trace;
 620                     go to EGRESS;
 621                end;
 622 
 623           if parser ^= PARSER_FOUND_CONTROL_STRING then go to NOARG;
 624 
 625           arg_offset = argx - 1;
 626 
 627           call expand ();
 628 
 629           call ioa_ ("^a", expansion);
 630 
 631           return;
 632 %page;
 633 /**** This case is very simple.  No control arguments are accepted.  The
 634       command processor has already allocated a large but non-expandable
 635       buffer for the expanded string.  We check that we have at least the
 636       one required argument, and if so, we set up the environment for
 637       expansion appropriately, do the expansion, and return. */
 638 
 639 substitute_args_function:
 640      entry ();
 641 
 642           if arg_count = 0 then call usage (SBAG_AF_USAGE);
 643 
 644           arg_offset, argx = 1;
 645 
 646           call get_argument (argx);
 647 
 648           expansion_max_len = return_value_max_len;
 649           expansion_ptr = return_value_ptr;
 650 
 651           call expand ();
 652 
 653           return;
 654 
 655 BADOPT:
 656           call error (error_table_$badopt, "^a", requote_string_ (arg));
 657 
 658 NOARG:
 659           call error (error_table_$noarg, "Following ^a.", requote_string_ (arg));
 660 %page;
 661 error:
 662           procedure () options (variable);
 663 
 664 declare   arg_list_ptr                  ptr,
 665           buffer                        char (256),
 666           buffer_used                   fixed bin (21),
 667           fatal                         bit (1) aligned,
 668           status_ptr                    ptr;
 669 
 670 declare   buffer_overlay                char (buffer_used) based (addr (buffer)),
 671           status                        fixed bin (35) based (status_ptr);
 672 
 673                fatal = "1"b;
 674 
 675                go to COMMON;
 676 
 677 warn:
 678           entry () options (variable);
 679 
 680                fatal = "0"b;
 681 
 682 COMMON:
 683                arg_list_ptr = cu_$arg_list_ptr ();
 684                call cu_$arg_ptr_rel (1, status_ptr, (0), (0), arg_list_ptr);
 685                call ioa_$general_rs (arg_list_ptr, 2, 3, buffer, buffer_used, "0"b, "0"b);
 686 
 687                if sci_ptr = null ()
 688                then do;
 689                          if return_value_ptr = null ()
 690                          then call com_err_ (status, MY_NAME (entrypoint), "^a", buffer_overlay);
 691                          else call active_fnc_err_ (status, MY_NAME (entrypoint), "^a", buffer_overlay);
 692                          if fatal then go to EGRESS;
 693                     end;
 694                else if fatal then call ssu_$abort_line (sci_ptr, status, "^a", buffer_overlay);
 695                else call ssu_$print_message (sci_ptr, status, "^a", buffer_overlay);
 696 
 697                return;
 698 
 699           end error;
 700 %page;
 701 /**** Expand the control string into the expansion.  For simplicity,
 702       expansion is a varying character string so that PL/I concatenation
 703       can be used.  The substitution constructs are mostly recognized a
 704       character at a time by indexing into lists of the characters which
 705       are presently valid and dispatching on the position of the current
 706       character in the list.  This is very efficient. */
 707 
 708 expand:
 709           procedure ();
 710 
 711 declare   buffer_overflow               bit (1) aligned,
 712           command_name                  char (72) varying,
 713           construct_pos                 fixed bin (21),
 714           control_string_pos            fixed bin (21),
 715           nstring                       picture "zzzz9",
 716           from_sw                       bit (1) aligned,
 717           parm_count                    fixed bin (17),
 718           quote_multiplier              fixed bin (21),
 719           quote_scan_pos                fixed bin (21),
 720           requote_last                  bit (1) aligned,
 721           requote_sw                    fixed bin (2),
 722           skip                          fixed bin (21),
 723           string_len                    fixed bin (21),
 724           string_ptr                    ptr;
 725 
 726 declare   construct                     char (control_string_pos - construct_pos)
 727                                         based (addcharno (addr (control_string), construct_pos)),
 728           string                        char (string_len) based (string_ptr);
 729 
 730                buffer_overflow, from_sw = "0"b;
 731                control_string_len = arg_len;
 732                control_string_pos, quote_scan_pos = 0;
 733                control_string_ptr = arg_ptr;
 734                expansion = "";
 735                parm_count = arg_count - arg_offset;
 736                quote_multiplier = 1;
 737                requote_last = "0"b;
 738                requote_sw = NO_QUOTE_MODIFIER;
 739 
 740                do while (control_string_pos < length (control_string));
 741 
 742                     string_len = index (substr (control_string, control_string_pos + 1), AMPERSAND) - 1;
 743                     if string_len < 0 then string_len = length (control_string) - control_string_pos;
 744 
 745                     if string_len > 0
 746                     then do;
 747                               string_ptr = addcharno (control_string_ptr, control_string_pos);
 748                               call add_string ();
 749                               control_string_pos = control_string_pos + string_len;
 750                          end;
 751 
 752                     if control_string_pos >= length (control_string) then go to EXPANDED;
 753 
 754                     construct_pos = control_string_pos;
 755                     control_string_pos = control_string_pos + length (AMPERSAND) + 1;
 756 
 757                     if control_string_pos > length (control_string) then go to END;
 758 
 759                     argx = index ("0123456789!(&&cfnqr", substr (control_string, control_string_pos, 1)) - 1;
 760                     go to DISPATCH (argx);
 761 
 762 DISPATCH (-1):                                              /* illegal -- character not in dispatch string */
 763                     call illegal (ILLEGAL_CHARACTER);
 764 
 765 DISPATCH (0):                                               /* A digit has been found.  The number of the */
 766 DISPATCH (1):                                               /* parameter to be substituted is in argx. */
 767 DISPATCH (2):                                               /* Here we handle the from_sw processing, and */
 768 DISPATCH (3):                                               /* the requote_sw processing is handled in */
 769 DISPATCH (4):                                               /* expand_arg. */
 770 DISPATCH (5):
 771 DISPATCH (6):
 772 DISPATCH (7):
 773 DISPATCH (8):
 774 DISPATCH (9):
 775                     if from_sw
 776                     then do;
 777                               if argx = 0 then argx = 1;    /* &f0 => &f1 */
 778 
 779                               from_sw = "0"b;               /* Reset for next construct */
 780 
 781                               do argx = argx to parm_count;
 782 
 783                                    call expand_arg ();
 784 
 785                                    if argx < parm_count
 786                                    then do;
 787                                              string_len = length (BLANK);
 788                                              string_ptr = addr (BLANK);
 789                                              call add_string ();
 790                                         end;
 791                               end;
 792                          end;
 793                     else if argx <= parm_count then call expand_arg ();
 794 
 795                     requote_sw = NO_QUOTE_MODIFIER;         /* Reset for next expansion */
 796 
 797                     go to SCAN_NEXT;
 798 
 799 DISPATCH (10):                                              /* &! -- Substitute a unique string */
 800                     if unique = "" then unique = unique_chars_ (""b);
 801                     string_len = length (unique);
 802                     string_ptr = addr (unique);
 803                     call add_string ();
 804                     go to SCAN_NEXT;
 805 
 806 DISPATCH (11):                                              /* &( -- Begin a parenthesized parameter index */
 807                     string_len = index (substr (control_string, control_string_pos + 1), ")") - 1;
 808                     if string_len < 0 then call illegal (ILLEGAL_UNCLOSED);
 809                     string_ptr = addcharno (control_string_ptr, control_string_pos);
 810                     control_string_pos = control_string_pos + string_len + length (")");
 811 
 812                     string_len = length (rtrim (string, WHITE));
 813                     if string_len = 0 then call illegal (ILLEGAL_INTEGER);
 814 
 815                     skip = verify (string, WHITE) - 1;
 816                     string_len = string_len - skip;
 817                     string_ptr = addcharno (string_ptr, skip);
 818                     if verify (string, "0123456789") ^= 0 then call illegal (ILLEGAL_INTEGER);
 819                     if length (ltrim (string, "0")) > 5
 820                     then argx = parm_count + 1;
 821                     else argx = binary (string, 17, 0);
 822 
 823                     go to DISPATCH (0);
 824 
 825 DISPATCH (12):                                              /* && -- A literal ampersand */
 826                     string_len = length (AMPERSAND);
 827                     string_ptr = addr (AMPERSAND);
 828                     call add_string ();
 829 
 830                     go to SCAN_NEXT;
 831 
 832 DISPATCH (13):                                              /* &f&, &q&, &qf&, &r&, &rf& -- The last parameter */
 833                     if control_string_pos + length ("n") > length (control_string) then go to END;
 834                     control_string_pos = control_string_pos + length ("n");
 835                     if substr (control_string, control_string_pos, length ("n")) ^= "n"
 836                     then call illegal (ILLEGAL_CHARACTER);
 837 
 838                     if ^from_sw
 839                     then do;
 840                               call warn (0, NO_FROM_WARNING, requote_sw = PROTECT_QUOTES_MODIFIER,
 841                                    requote_string_ (construct), return_value_ptr ^= null () & sci_ptr = null ());
 842                               from_sw = "1"b;
 843                          end;
 844 
 845                     argx = parm_count;
 846 
 847                     go to DISPATCH (0);
 848 
 849 DISPATCH (14):                                              /* &c -- begins &control_string */
 850                     control_string_pos = control_string_pos + length ("ontrol_string");
 851                     if control_string_pos > length (control_string) then call illegal (ILLEGAL_KEYWORD);
 852                     if substr (control_string, construct_pos + 2, length ("control_string")) ^= "control_string"
 853                     then call illegal (ILLEGAL_KEYWORD);
 854 
 855                     argx = 0;
 856                     requote_sw = PROTECT_QUOTES_MODIFIER;
 857 
 858                     go to DISPATCH (0);
 859 
 860 DISPATCH (15):                                              /* &f, &qf and &rf -- Substitute a range of parameters */
 861                     from_sw = "1"b;
 862 
 863                     if control_string_pos >= length (control_string) then go to END;
 864                     control_string_pos = control_string_pos + 1;
 865 
 866                     argx = index ("01234567899((&", substr (control_string, control_string_pos, 1)) - 1;
 867                     go to DISPATCH (argx);
 868 
 869 DISPATCH (16):                                              /* &n -- Substitute the number of optional arguments */
 870                     nstring = parm_count;
 871                     string_len = verify (nstring, BLANK) - 1;
 872                     string_ptr = addcharno (addr (nstring), string_len);
 873                     string_len = length (nstring) - string_len;
 874                     call add_string ();
 875 
 876                     go to SCAN_NEXT;
 877 
 878 DISPATCH (17):                                              /* &q -- Protect quotes in the parameter */
 879                     requote_sw = PROTECT_QUOTES_MODIFIER;
 880                     go to AFTER_QUOTE_MODIFIER;
 881 
 882 DISPATCH (18):                                              /* &r -- Requote the parameter */
 883                     requote_sw = REQUOTE_MODIFIER;
 884 
 885 AFTER_QUOTE_MODIFIER:
 886                     if control_string_pos >= length (control_string) then go to END;
 887                     control_string_pos = control_string_pos + 1;
 888 
 889                     argx = index ("01234567899((&&f", substr (control_string, control_string_pos, 1)) - 1;
 890                     go to DISPATCH (argx);
 891 
 892 SCAN_NEXT:
 893                end;
 894 
 895 
 896 /**** Argument substitution is completed. */
 897 
 898 EXPANDED:
 899                if trace
 900                then do;
 901                          if sci_ptr = null ()
 902                          then command_name = MY_NAME (entrypoint);
 903                          else command_name = ssu_$get_subsystem_and_request_name (sci_ptr);
 904                          call ioa_$ioa_switch (iox_$error_output, "^[[^a^[ -error_value^]]^;^a^s^]: (^d) ^a",
 905                               return_value_ptr ^= null (), command_name,
 906                               return_value_ptr = expansion_ptr & entrypoint = EXECUTE_ENTRY, length (command),
 907                               requote_string_ (command));
 908                     end;
 909 
 910                return;
 911 
 912 
 913 /**** The end of the string beging expanded was found after an ampersand
 914       was encountered but before a valid substitution construct was
 915       completed. */
 916 
 917 END:
 918                if entrypoint = EXECUTE_ENTRY & expansion_ptr = return_value_ptr
 919                then call illegal (ILLEGAL_END_ERROR_VALUE);
 920                else call illegal (ILLEGAL_END_CONTROL_STRING);
 921 %page;
 922 /**** These operations are gathered in a subroutine to reduce code size in
 923       exchange for a very slight performance penalty.  The overlay is used
 924       to add QUOTE characters to the string in order to avoid a stack
 925       extension. */
 926 
 927 add_quotes:
 928                procedure ();
 929 
 930 declare   old_len                       fixed bin (21);
 931 
 932 declare   1 expansion_overlay           aligned based (expansion_ptr),
 933             2 len                       fixed bin (21),
 934             2 str                       char (0 refer (expansion_overlay.len));
 935 
 936                     call check_buffer ();
 937 
 938                     old_len = expansion_overlay.len;
 939                     expansion_overlay.len = expansion_overlay.len + string_len;
 940                     substr (expansion_overlay.str, old_len + 1, string_len) = copy (QUOTE, string_len);
 941 
 942                     if buffer_overflow then go to EXPANDED;
 943 
 944                     return;
 945 
 946 add_string:
 947                entry ();
 948 
 949                     call check_buffer ();
 950 
 951                     expansion = expansion || string;
 952 
 953                     if buffer_overflow then go to EXPANDED;
 954 
 955                     return;
 956 
 957                end add_quotes;
 958 %page;
 959 /**** The expansion has become too large for the expansion buffer.
 960       Allocate a bigger buffer, and free the old one if it was allocated.
 961       The initial buffer is automatic, and must be not be freed. */
 962 
 963 allocate_buffer:
 964                procedure ();
 965 
 966 declare   new_buffer_ptr                ptr,
 967           old_buffer_max_len            fixed bin (21);
 968 
 969                     new_buffer_ptr = null ();
 970                     old_buffer_max_len = allocated_buffer_max_len;
 971 
 972                     on cleanup
 973                          begin;
 974                               if new_buffer_ptr ^= null () & new_buffer_ptr ^= allocated_buffer_ptr
 975                               then free new_buffer_ptr -> allocated_buffer in (system_area);
 976                          end;
 977 
 978                     on area go to AREA_HANDLER;
 979 
 980                     allocated_buffer_max_len =
 981                          maxlength (expansion) + string_len + length (control_string) + 8 * parm_count;
 982 
 983                     allocate allocated_buffer in (system_area) set (new_buffer_ptr);
 984 
 985                     new_buffer_ptr -> allocated_buffer = expansion;
 986                     expansion_max_len = allocated_buffer_max_len;
 987 
 988                     if allocated_buffer_ptr ^= null ()
 989                     then do;
 990                               allocated_buffer_max_len = old_buffer_max_len;
 991                               free allocated_buffer in (system_area);
 992                          end;
 993 
 994                     allocated_buffer_ptr, expansion_ptr = new_buffer_ptr;
 995 
 996                     return;
 997 
 998 AREA_HANDLER:
 999                     call error (0, "Can't allocate a buffer large enough to hold the expanded control string.");
1000 
1001                end allocate_buffer;
1002 %page;
1003 /**** Ensure that there is sufficient space in the expansion buffer to
1004       permit the addition of string_len characters to the buffer.  If there
1005       is not, grow the buffer if possible.  The case where we can't try to
1006       grow the buffer is when the buffer is the active function return
1007       value.  Since the command processor can't accept a bigger value, we
1008       announce that the string was truncated and set string_len to what
1009       will actually fit.  Setting buffer_overflow will cause termination of
1010       the expansion after the characters have been appended.  Note that
1011       ssu_$print_message will only return for active functions after the
1012       user issues "start", but not for the subsystem active request case.
1013       The only cases where expansion is directlyt overlayed on the return
1014       value are the do/sbag active function and the -error_value for
1015       execute_string. */
1016 
1017 check_buffer:
1018                procedure ();
1019 
1020                     if length (string) ^= 0 then requote_last = "0"b;
1021 
1022                     if length (expansion) + length (string) <= maxlength (expansion) then return;
1023 
1024                     if expansion_ptr = return_value_ptr
1025                     then do;
1026                               buffer_overflow = "1"b;
1027                               string_len = maxlength (expansion) - length (expansion);
1028                               call warn (error_table_$command_line_overflow, TRUNCATION_WARNING, expansion_max_len,
1029                                    entrypoint = EXECUTE_ENTRY, return_value_ptr ^= null () & sci_ptr = null ());
1030                               return;
1031                          end;
1032 
1033                     call allocate_buffer ();                /* Make it bigger */
1034 
1035                     return;
1036 
1037                end check_buffer;
1038 %page;
1039 /**** Get the substitution parameter which is argx after the control
1040       string, and append it to the expansion with appropriate quote
1041       processing.  If no quote modifier was specified, then no special
1042       processing is required.  Otherwise, the string up to this point must
1043       be scanned to determine the current quote level.  Then the parameter
1044       is appended with optional requotinq and quotes doubled according to
1045       the quote level. */
1046 
1047 expand_arg:
1048                procedure ();
1049 
1050 declare   arg_pos                       fixed bin (21);
1051 
1052                     call get_argument (argx + arg_offset);
1053 
1054                     if requote_sw = NO_QUOTE_MODIFIER
1055                     then do;
1056                               string_len = arg_len;
1057                               string_ptr = arg_ptr;
1058                               call add_string ();
1059                               return;
1060                          end;
1061 
1062                     do while (quote_scan_pos < length (expansion));
1063 
1064                          string_len = index (substr (expansion, quote_scan_pos + 1), QUOTE) - 1;
1065                          if string_len < 0 then string_len = length (expansion) - quote_scan_pos;
1066 
1067                          quote_scan_pos = quote_scan_pos + string_len;
1068                          if quote_scan_pos < length (expansion)
1069                          then do;
1070                                    string_len = verify (substr (expansion, quote_scan_pos + 1), QUOTE) - 1;
1071                                    if string_len < 0 then string_len = length (expansion) - quote_scan_pos;
1072                                    quote_scan_pos = quote_scan_pos + string_len;
1073 
1074                                    if mod (string_len, quote_multiplier) = 0
1075                                    then do while (mod (string_len, 2 * quote_multiplier) ^= 0);
1076                                              string_len = string_len - quote_multiplier;
1077                                              quote_multiplier = 2 * quote_multiplier;
1078                                         end;
1079                                    else do while (string_len ^= 0);
1080                                              quote_multiplier = divide (quote_multiplier, 2, 21, 0);
1081                                              string_len = mod (string_len, quote_multiplier);
1082                                         end;
1083                               end;
1084                     end;
1085 
1086                     if requote_sw = REQUOTE_MODIFIER
1087                     then do;
1088                               if requote_last
1089                               then expansion = substr (expansion, 1, length (expansion) - quote_multiplier);
1090                               else do;
1091                                         string_len = quote_multiplier;
1092                                         call add_quotes ();
1093                                    end;
1094                               quote_multiplier = 2 * quote_multiplier;
1095                          end;
1096 
1097                     if quote_multiplier = 1
1098                     then do;
1099                               string_len = arg_len;
1100                               string_ptr = arg_ptr;
1101                               call add_string ();
1102                          end;
1103                     else do;
1104                               arg_pos = 0;
1105 
1106                               do while (arg_pos < length (arg));
1107 
1108                                    string_len = index (substr (arg, arg_pos + 1), QUOTE) - 1;
1109                                    if string_len < 0 then string_len = length (arg) - arg_pos;
1110                                    if string_len > 0
1111                                    then do;
1112                                              string_ptr = addcharno (addr (arg), arg_pos);
1113                                              call add_string ();
1114                                              arg_pos = arg_pos + string_len;
1115                                         end;
1116 
1117                                    if arg_pos < length (arg)
1118                                    then do;
1119                                              string_len = verify (substr (arg, arg_pos + 1), QUOTE) - 1;
1120                                              if string_len < 0 then string_len = length (arg) - arg_pos;
1121                                              arg_pos = arg_pos + string_len;
1122 
1123                                              string_len = string_len * quote_multiplier;
1124                                              call add_quotes ();
1125                                         end;
1126                               end;
1127                          end;
1128 
1129                     if requote_sw = REQUOTE_MODIFIER
1130                     then do;
1131                               string_len, quote_multiplier = divide (quote_multiplier, 2, 17, 0);
1132                               call add_quotes ();
1133                               requote_last = "1"b;          /* Remember ending quotes in case of &r1&r2 */
1134                          end;
1135 
1136                     quote_scan_pos = length (expansion);    /* Don't let protected expansion affect quote depth */
1137 
1138                     return;
1139 
1140                end expand_arg;
1141 %page;
1142 /**** This routine is invoked if an illegal construct is found.  To keep
1143       the stack frame from becoming unreasonably large, the various control
1144       strings are stored in an array so that they can be passed by
1145       reference. */
1146 
1147 illegal:
1148                procedure (reason);
1149 
1150 declare   reason                        fixed bin (3) parameter;
1151 
1152                     if control_string_pos > length (control_string) then control_string_pos = length (control_string);
1153 
1154                     expansion_buffer = requote_string_ (construct);
1155 
1156                     call error (0, REASONS (reason), expansion_buffer);
1157 
1158                end illegal;
1159 
1160           end expand;
1161 %page;
1162 /**** Get an argument from the argument list.  Note that SSU reserves the
1163       right to change the argument list format (the entry is replaceable),
1164       so we can't obtain a pointer to the SSU arglist and use the cu_
1165       entrypoints. */
1166 
1167 get_argument:
1168           procedure (P_argx);
1169 
1170 declare   P_argx                        fixed bin (17) parameter;
1171 
1172                if sci_ptr = null ()
1173                then do;
1174                          call cu_$arg_ptr_rel (P_argx, arg_ptr, arg_len, status, arg_list_ptr);
1175                          if status ^= 0 then call error (status, "Can't get argument #^d.", P_argx);
1176                     end;
1177                else call ssu_$arg_ptr (sci_ptr, P_argx, arg_ptr, arg_len);
1178 
1179                return;
1180 
1181           end get_argument;
1182 %page;
1183 /**** An error in usage has been detected, probably a missing control
1184       string.  This internal procedure replaces ssu_$abort_line for this
1185       purpose because the standard for usage messages for commands and
1186       active functions is to call the appropriate $suppress_name
1187       entrypoint.  It also permits the short names to be used in the usage
1188       messages for the command and active function cases.  For the
1189       subsystem cases, the standard action of ssu_$abort_line is used,
1190       because it is desirable to give the subsystem name.  Unfortunately,
1191       at this writing there is no easy way to get the short name of the
1192       request for use in the error message. */
1193 
1194 usage:
1195           procedure (usage_string);
1196 
1197 declare   usage_string                  char (*) parameter;
1198 
1199                expansion_buffer = "Usage:  ";
1200                if return_value_ptr ^= null () then expansion_buffer = expansion_buffer || "[";
1201                if sci_ptr = null ()
1202                then expansion_buffer = expansion_buffer || MY_SHORT_NAME (entrypoint);
1203                else expansion_buffer = expansion_buffer || rtrim (ssu_$get_request_name (sci_ptr));
1204                expansion_buffer = expansion_buffer || BLANK;
1205                expansion_buffer = expansion_buffer || usage_string;
1206                if return_value_ptr ^= null () then expansion_buffer = expansion_buffer || "]";
1207 
1208                if sci_ptr = null ()
1209                then if return_value_ptr = null ()
1210                     then call com_err_$suppress_name (0, MY_NAME (entrypoint), "^a", expansion_buffer);
1211                     else call active_fnc_err_$suppress_name (0, MY_NAME (entrypoint), "^a", expansion_buffer);
1212                else call ssu_$abort_line (sci_ptr, 0, "^a", expansion_buffer);
1213 
1214                go to EGRESS;
1215 
1216           end usage;
1217 
1218      end execute_string_command;
1219 
1220      end do;