?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Command Level Utility Commands' ??
MODULE clm$utility_commands;

{
{ PURPOSE:
{   This module contains the processors for the commands that provide the
{   "command level" utility capability.
{
{ DESIGN:
{   Process all the information needed to create a command level utility.
{   Execute the command level utility.  Change attributes of a command
{   level utility.  Return information about a utility.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_control_statement
*copyc cle$ecc_utilities
*copyc clt$block
*copyc clt$command_table_entry
*copyc clt$control_statement_info
*copyc clt$parse_state
*copyc clt$utility_attribute
*copyc clt$when_condition
*copyc ost$status
?? POP ??
*copyc clp$begin_utility
*copyc clp$change_utility_environment
*copyc clp$count_list_elements
*copyc clp$create_utility_environment
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$find_current_block
*copyc clp$get_interpreter_mode
*copyc clp$get_utility_attributes
*copyc clp$include_file
*copyc clp$make_boolean_value
*copyc clp$make_name_value
*copyc clp$make_string_value
*copyc clp$prepare_delayed_block
*copyc clp$process_delayed_block
*copyc clp$trimmed_string_size
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$disestablish_cond_handler
*copyc osp$enforce_exception_policies
*copyc osp$file_access_condition
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osv$initial_exception_context
?? EJECT ??

  CONST
    max_utility_attributes = 11;

  TYPE
    table_entry = record
      command: boolean,
      entry_info: clt$command_table_entry,
    recend;

  CONST
    utility_prompt = 'UTILITY',
    utility_prompt_length = 7;

?? TITLE := 'clp$_utility', EJECT ??

  PROCEDURE [XDCL] clp$_utility
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$utility) utility (
{   name, n: name = $required
{   enable_subcommand_logging, esl: (BY_NAME) boolean = yes
{   interactive_include_processor, iip: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = none
{   library, libraries, l: (BY_NAME) list of file = $optional
{   line_preprocessor, lp: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = none
{   online_manual, om: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = none
{   prompt, p: (BY_NAME) string 0..27 = $optional
{   search_mode, sm: (BY_NAME) key
{       (global, g)
{       (restricted, r)
{       (exclusive, e)
{     keyend = global
{   tables, table, t: (BY_NAME) file = $command
{   termination_command_name, tcn: (BY_NAME) name = quit
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 23] of clt$pdt_parameter_name,
      parameters: array [1 .. 11] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (3),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
        default_value: string (6),
      recend,
      type9: record
        header: clt$type_specification_header,
        default_value: string (8),
      recend,
      type10: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
        default_value: string (4),
      recend,
      type11: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 4, 20, 14, 42, 58, 149],
    clc$command, 23, 11, 1, 0, 0, 0, 11, 'OSM$UTILITY'], [
    ['ENABLE_SUBCOMMAND_LOGGING      ',clc$nominal_entry, 2],
    ['ESL                            ',clc$abbreviation_entry, 2],
    ['IIP                            ',clc$abbreviation_entry, 3],
    ['INTERACTIVE_INCLUDE_PROCESSOR  ',clc$nominal_entry, 3],
    ['L                              ',clc$abbreviation_entry, 4],
    ['LIBRARIES                      ',clc$alias_entry, 4],
    ['LIBRARY                        ',clc$nominal_entry, 4],
    ['LINE_PREPROCESSOR              ',clc$nominal_entry, 5],
    ['LP                             ',clc$abbreviation_entry, 5],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['OM                             ',clc$abbreviation_entry, 6],
    ['ONLINE_MANUAL                  ',clc$nominal_entry, 6],
    ['P                              ',clc$abbreviation_entry, 7],
    ['PROMPT                         ',clc$nominal_entry, 7],
    ['SEARCH_MODE                    ',clc$nominal_entry, 8],
    ['SM                             ',clc$abbreviation_entry, 8],
    ['STATUS                         ',clc$nominal_entry, 11],
    ['T                              ',clc$abbreviation_entry, 9],
    ['TABLE                          ',clc$alias_entry, 9],
    ['TABLES                         ',clc$nominal_entry, 9],
    ['TCN                            ',clc$abbreviation_entry, 10],
    ['TERMINATION_COMMAND_NAME       ',clc$nominal_entry, 10]],
    [
{ PARAMETER 1
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 19, clc$optional_parameter,
  0, 0],
{ PARAMETER 5
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 7
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 8
    [16, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$optional_default_parameter, 0, 6],
{ PARAMETER 9
    [21, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 8],
{ PARAMETER 10
    [23, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 11
    [18, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$boolean_type],
    'yes'],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'none'],
{ PARAMETER 4
    [[1, 0, clc$list_type], [3, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'none'],
{ PARAMETER 7
    [[1, 0, clc$string_type], [0, 27, FALSE]],
{ PARAMETER 8
    [[1, 0, clc$keyword_type], [6], [
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['EXCLUSIVE                      ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['G                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['GLOBAL                         ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['RESTRICTED                     ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'global'],
{ PARAMETER 9
    [[1, 0, clc$file_type],
    '$command'],
{ PARAMETER 10
    [[1, 0, clc$name_type], [1, osc$max_name_size],
    'quit'],
{ PARAMETER 11
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$name = 1,
      p$enable_subcommand_logging = 2,
      p$interactive_include_processor = 3,
      p$library = 4,
      p$line_preprocessor = 5,
      p$online_manual = 6,
      p$prompt = 7,
      p$search_mode = 8,
      p$tables = 9,
      p$termination_command_name = 10,
      p$status = 11;

    VAR
      pvt: array [1 .. 11] of clt$parameter_value;


    VAR
      block: ^clt$block,
      can_be_echoed: boolean,
      command_sequence_pointer: ^SEQ ( * ),
      command_table: ^clt$command_table,
      delete_segment_status: ost$status,
      function_sequence_pointer: ^SEQ ( * ),
      function_table: ^clt$function_processor_table,
      include_processor: clt$utility_interactive_in_desc,
      index: integer,
      interpreter_mode: clt$interpreter_modes,
      library_list_ptr: ^array [1 .. * ] of fst$path,
      node: ^clt$data_value,
      online_manual: ost$name,
      pre_process: clt$utility_line_preproc_desc,
      prompt: string (clc$max_prompt_size),
      prompt_size: clt$prompt_size,
      search_mode: clt$command_search_modes,
      segment_pointer: amt$segment_pointer,
      statement_area: ^clt$collect_statement_area,
      substitution_mark: clt$substitution_mark,
      utility_command_attributes: array [1 .. 10] of clt$utility_attribute;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      IF command_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := command_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, handler_status);
      IFEND;

      IF function_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := function_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, handler_status);
      IFEND;

      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      context: ^ost$ecp_exception_context;

    status.normal := TRUE;
    context := NIL;
    substitution_mark.specified := FALSE;
    command_sequence_pointer := NIL;
    #SPOIL (command_sequence_pointer);
    function_sequence_pointer := NIL;
    #SPOIL (function_sequence_pointer);

    clp$get_interpreter_mode (interpreter_mode);

    IF interpreter_mode <> clc$skip_mode THEN

      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF pvt [p$interactive_include_processor].value^.kind = clc$keyword {AND keyword = NONE} THEN
        include_processor.call_method := clc$unspecified_call;
      ELSE
        osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'interactive include processor', status);
        RETURN;

{ The following code will be used when the interactive include processor is implemented.
{
{       include_processor.call_method := clc$proc_call;
{       include_processor.command_name := pvt [p$interactive_include_processor].value^.name_value;

      IFEND;

      IF pvt [p$library].specified THEN
        PUSH library_list_ptr: [1 .. clp$count_list_elements (pvt [p$library].value)];
        node := pvt [p$library].value;
        FOR index := 1 TO UPPERBOUND (library_list_ptr^) DO
          library_list_ptr^ [index] := node^.element_value^.file_value^;
          node := node^.link;
        FOREND;

      ELSE
        clp$find_current_block (block);
        block := block^.previous_block;

      /search/
        WHILE block <> NIL DO
          CASE block^.kind OF
          = clc$command_block =
            CASE block^.command_kind OF
            = clc$command_is_include_file, clc$command_is_include_line =
              ;
            ELSE
              EXIT /search/;
            CASEND;
          = clc$command_proc_block, clc$function_proc_block =
            EXIT /search/;
          ELSE
            ;
          CASEND;
          block := block^.previous_block;
        WHILEND /search/;

        IF block = NIL THEN
          osp$set_status_abnormal ('CL', cle$command_source_not_lib, '', status);
          EXIT clp$_utility;
        ELSEIF block^.source.kind = clc$library_commands THEN
          PUSH library_list_ptr: [1 .. 1];
          library_list_ptr^ [1] := block^.source.local_file_name;
        ELSEIF (block^.source.kind = clc$sub_commands) AND (block^.source.utility_info^.libraries <> NIL) THEN
          PUSH library_list_ptr: [1 .. UPPERBOUND (block^.source.utility_info^.libraries^)];
          FOR index := 1 TO UPPERBOUND (library_list_ptr^) DO
            library_list_ptr^ [index] := block^.source.utility_info^.libraries^ [index];
          FOREND;
        ELSE
          osp$set_status_abnormal ('CL', cle$command_source_not_lib, '', status);
          EXIT clp$_utility;
        IFEND;
      IFEND;

      IF pvt [p$line_preprocessor].value^.kind = clc$keyword {AND keyword = NONE} THEN
        pre_process.call_method := clc$unspecified_call;
      ELSE
        osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'line preprocessor', status);
        RETURN;

{ The following code will be used when the line processor is implemented.
{
{       pre_process.call_method := clc$proc_call;
{       pre_process.command_name := pvt [p$line_preprocessor].value^.name_value;

      IFEND;

      IF pvt [p$online_manual].value^.kind = clc$keyword {AND keyword = NONE} THEN
        online_manual := osc$null_name;
      ELSE
        online_manual := pvt [p$online_manual].value^.name_value;
      IFEND;

      IF pvt [p$prompt].specified THEN
        prompt := pvt [p$prompt].value^.string_value^;
      ELSE
        prompt := pvt [p$name].value^.name_value;
      IFEND;
      prompt_size := clp$trimmed_string_size (prompt);
      IF prompt_size > clc$max_prompt_size THEN
        prompt_size := clc$max_prompt_size;
      IFEND;

      IF pvt [p$search_mode].value^.keyword_value = 'GLOBAL' THEN
        search_mode := clc$global_command_search;
      ELSEIF pvt [p$search_mode].value^.keyword_value = 'RESTRICTED' THEN
        search_mode := clc$restricted_command_search;
      ELSE {EXCLUSIVE}
        search_mode := clc$exclusive_command_search;
      IFEND;

      osp$establish_block_exit_hndlr (^abort_handler);

      build_tables (pvt [p$tables].value^.file_value^, command_sequence_pointer, function_sequence_pointer,
            command_table, function_table, status);

    IFEND; {End of skip if in skip_mode.

  /set_up_user_utility/
    BEGIN
      IF NOT status.normal THEN
        EXIT /set_up_user_utility/;
      IFEND;

      clp$prepare_delayed_block (interpreter_mode, 'UTILITY', 'UTILITYEND', utility_prompt, '',
            substitution_mark, statement_area, can_be_echoed, status);

      IF interpreter_mode <> clc$interpret_mode THEN
        RETURN;
      IFEND;

      IF NOT status.normal THEN
        EXIT /set_up_user_utility/;
      IFEND;

      utility_command_attributes [1].key := clc$utility_command_search_mode;
      utility_command_attributes [1].command_search_mode := search_mode;
      utility_command_attributes [2].key := clc$utility_command_table;
      utility_command_attributes [2].command_table := command_table;
      utility_command_attributes [3].key := clc$utility_function_proc_table;
      utility_command_attributes [3].function_processor_table := function_table;
      utility_command_attributes [4].key := clc$utility_interactive_include;
      utility_command_attributes [4].interactive_include_processor := include_processor;
      utility_command_attributes [5].key := clc$utility_libraries;
      utility_command_attributes [5].libraries := library_list_ptr;
      utility_command_attributes [6].key := clc$utility_line_preprocessor;
      utility_command_attributes [6].line_preprocessor := pre_process;
      utility_command_attributes [7].key := clc$utility_online_manual;
      utility_command_attributes [7].online_manual_name := online_manual;
      utility_command_attributes [8].key := clc$utility_prompt;
      utility_command_attributes [8].prompt.value := prompt;
      utility_command_attributes [8].prompt.size := prompt_size;
      utility_command_attributes [9].key := clc$utility_subcmnd_log_enabled;
      utility_command_attributes [9].subcommand_logging_enabled :=
            pvt [p$enable_subcommand_logging].value^.boolean_value.value;
      utility_command_attributes [10].key := clc$utility_termination_command;
      utility_command_attributes [10].termination_command :=
            pvt [p$termination_command_name].value^.name_value;

      REPEAT
        clp$create_utility_environment (pvt [p$name].value^.name_value, TRUE, FALSE,
              utility_command_attributes, status);
        IF NOT status.normal THEN
          IF context = NIL THEN
            PUSH context;
            context^ := osv$initial_exception_context;
          IFEND;
          context^.condition_status := status;
          osp$enforce_exception_policies (context^);
          status := context^.condition_status;
        IFEND;
      UNTIL status.normal OR (NOT osp$file_access_condition (status)) OR (NOT context^.wait);
    END /set_up_user_utility/;

    IF command_sequence_pointer <> NIL THEN
      segment_pointer.sequence_pointer := command_sequence_pointer;
      mmp$delete_scratch_segment (segment_pointer, delete_segment_status);
      IF (NOT delete_segment_status.normal) AND status.normal THEN
        status := delete_segment_status;
      IFEND;
      command_sequence_pointer := NIL;
      #SPOIL (command_sequence_pointer);
    IFEND;

    IF function_sequence_pointer <> NIL THEN
      segment_pointer.sequence_pointer := function_sequence_pointer;
      mmp$delete_scratch_segment (segment_pointer, delete_segment_status);
      IF (NOT delete_segment_status.normal) AND status.normal THEN
        status := delete_segment_status;
      IFEND;
      function_sequence_pointer := NIL;
      #SPOIL (function_sequence_pointer);
    IFEND;

    osp$disestablish_cond_handler;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$process_delayed_block (pvt [p$name].value^.name_value, statement_area, can_be_echoed, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_utility (pvt [p$name].value^.name_value, status);

  PROCEND clp$_utility;
?? TITLE := 'build_tables', EJECT ??

  PROCEDURE build_tables
    (    table_file_name: fst$file_reference;
     VAR command_sequence_pointer {input, output} : ^SEQ ( * );
     VAR function_sequence_pointer {input, output} : ^SEQ ( * );
     VAR command_table {input, output} : ^clt$command_table;
     VAR function_table {input, output} : ^clt$function_processor_table;
     VAR status: ost$status);

{ table utility_command_list
{ command command command_command
{ command function function_command
{ command tablend tablend_command
{ tablend

{ The utility_command_list data is initialized later in
{ the init_utility_cmnd_list routine. Because there are
{ numerous nested procedures used to establish the
{ utility environment, the command_list cannot be
{ statically initialized. If any new commands need to
{ be added to the utility_command_list, use GENCT to
{ create the array and information needed, then use
{ the values to dynamically create the command_list.
{ See the init_utility_cmnd_list procedure.

    VAR
      command_entries: ^clt$command_table,
      command_entry_count: integer,
      command_ordinal_count: integer,
      function_entries: ^clt$function_processor_table,
      function_entry_count: integer,
      function_ordinal_count: integer,
      segment_pointer: amt$segment_pointer,
      utility_attributes: array [1 .. 4] of clt$utility_attribute,
      utility_command_list: ^clt$command_table,
      utility_command_list_entries: array [1 .. 3] of clt$command_table_entry,
      utility_name: ost$name;

?? NEWTITLE := 'command_command', EJECT ??

    PROCEDURE command_command
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE (osm$utility_command) command (
{   name, names, n: list of name = $required
{   processor, p: name = $optional
{   availability, a: (BY_NAME) key
{       (normal_usage, advertised, a, nu)
{       (advanced_usage, au)
{       (hidden, h)
{     keyend = normal_usage
{   automatically_log, al: (BY_NAME) boolean = yes
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
        default_value: string (12),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (3),
      recend,
    recend := [
    [1,
    [89, 4, 19, 17, 18, 53, 213],
    clc$command, 9, 4, 1, 0, 0, 0, 0, 'OSM$UTILITY_COMMAND'], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['AL                             ',clc$abbreviation_entry, 4],
    ['AUTOMATICALLY_LOG              ',clc$nominal_entry, 4],
    ['AVAILABILITY                   ',clc$nominal_entry, 3],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['NAMES                          ',clc$alias_entry, 1],
    ['P                              ',clc$abbreviation_entry, 2],
    ['PROCESSOR                      ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
  clc$optional_default_parameter, 0, 12],
{ PARAMETER 4
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 3]],
{ PARAMETER 1
    [[1, 0, clc$list_type], [5, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 2
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [8], [
    ['A                              ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['ADVANCED_USAGE                 ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['ADVERTISED                     ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['AU                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['H                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['NORMAL_USAGE                   ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NU                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'normal_usage'],
{ PARAMETER 4
    [[1, 0, clc$boolean_type],
    'yes']];

?? FMT (FORMAT := ON) ??
?? POP ??

      CONST
        p$name = 1,
        p$processor = 2,
        p$availability = 3,
        p$automatically_log = 4;

      VAR
        pvt: array [1 .. 4] of clt$parameter_value;


      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF command_sequence_pointer = NIL THEN
        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        command_sequence_pointer := segment_pointer.sequence_pointer;
        RESET command_sequence_pointer;
        NEXT command_entries: [1 .. #SIZE (command_sequence_pointer^) DIV
              #SIZE (clt$command_table_entry)] IN command_sequence_pointer;
      IFEND;

      save_entries (clc$command, pvt [p$name].value, pvt [p$processor].value, pvt [p$availability].
            value^.keyword_value, pvt [p$automatically_log].value^.boolean_value.value, status);

    PROCEND command_command;
?? TITLE := 'function_command', EJECT ??

    PROCEDURE function_command
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE (osm$utility_function) function (
{   name, names, n: any of
{       data_name
{       list of data_name
{     anyend = $required
{   processor, p: data_name = $optional
{   availability, a: (BY_NAME) key
{       (normal_usage, a, advertised, nu)
{       (advanced_usage, au)
{       (hidden, h)
{     keyend = normal_usage
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
        default_value: string (12),
      recend,
    recend := [
    [1,
    [90, 3, 24, 14, 15, 14, 619],
    clc$command, 7, 3, 1, 0, 0, 0, 0, 'OSM$UTILITY_FUNCTION'], [
    ['A                              ',clc$abbreviation_entry, 3],
    ['AVAILABILITY                   ',clc$nominal_entry, 3],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['NAMES                          ',clc$alias_entry, 1],
    ['P                              ',clc$abbreviation_entry, 2],
    ['PROCESSOR                      ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 42, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
  clc$optional_default_parameter, 0, 12]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$data_name_type, clc$list_type],
    FALSE, 2],
    3, [[1, 0, clc$data_name_type]],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$data_name_type]]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$data_name_type]],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [8], [
    ['A                              ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['ADVANCED_USAGE                 ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['ADVERTISED                     ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['AU                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['H                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['HIDDEN                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['NORMAL_USAGE                   ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NU                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ,
    'normal_usage']];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$name = 1,
      p$processor = 2,
      p$availability = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;


      VAR
        names: ^clt$data_value;


      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF function_sequence_pointer = NIL THEN
        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        function_sequence_pointer := segment_pointer.sequence_pointer;
        RESET function_sequence_pointer;
        NEXT function_entries: [1 .. #SIZE (function_sequence_pointer^) DIV
              #SIZE (clt$function_proc_table_entry)] IN function_sequence_pointer;
      IFEND;

      IF pvt [p$name].value^.kind = clc$list THEN
        names := pvt [p$name].value;
      ELSE
        PUSH names;
        names^.kind := clc$list;
        names^.element_value := pvt [p$name].value;
        names^.link := NIL;
        names^.generated_via_list_rest := FALSE;
      IFEND;

      save_entries (clc$function, names, pvt [p$processor].value, pvt [p$availability].
            value^.keyword_value, FALSE {ignored} , status);

    PROCEND function_command;
?? TITLE := 'tablend_command', EJECT ??

    PROCEDURE tablend_command
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE (osm$utility_tablend) tablend

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 4, 19, 17, 27, 20, 914],
    clc$command, 0, 0, 0, 0, 0, 0, 0, 'OSM$UTILITY_TABLEND']];

?? FMT (FORMAT := ON) ??
?? POP ??

      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, NIL, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$end_include (utility_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND tablend_command;
?? TITLE := 'init_utility_cmnd_table', EJECT ??

    PROCEDURE [INLINE] init_utility_cmnd_table;


      utility_command_list := ^utility_command_list_entries;

      utility_command_list_entries [1].name := 'COMMAND                        ';
      utility_command_list_entries [1].class := clc$nominal_entry;
      utility_command_list_entries [1].availability := clc$advertised_entry;
      utility_command_list_entries [1].ordinal := 1;
      utility_command_list_entries [1].log_option := clc$automatically_log;
      utility_command_list_entries [1].call_method := clc$linked_call;
      utility_command_list_entries [1].command := ^command_command;

      utility_command_list_entries [2].name := 'FUNCTION                       ';
      utility_command_list_entries [2].class := clc$nominal_entry;
      utility_command_list_entries [2].availability := clc$advertised_entry;
      utility_command_list_entries [2].ordinal := 2;
      utility_command_list_entries [2].log_option := clc$automatically_log;
      utility_command_list_entries [2].call_method := clc$linked_call;
      utility_command_list_entries [2].command := ^function_command;

      utility_command_list_entries [3].name := 'TABLEND                        ';
      utility_command_list_entries [3].class := clc$nominal_entry;
      utility_command_list_entries [3].availability := clc$advertised_entry;
      utility_command_list_entries [3].ordinal := 3;
      utility_command_list_entries [3].log_option := clc$automatically_log;
      utility_command_list_entries [3].call_method := clc$linked_call;
      utility_command_list_entries [3].command := ^tablend_command;

    PROCEND init_utility_cmnd_table;
?? TITLE := 'save_entries', EJECT ??

    PROCEDURE save_entries
      (    command_or_function: clt$command_or_function;
           names: ^clt$data_value;
           processor_value: ^clt$data_value;
           availability_keyword: clt$keyword;
           automatically_log: boolean;
       VAR status: ost$status);

      VAR
        availability: clt$named_entry_availability,
        index: integer,
        method: clt$call_method,
        log_option: clt$command_log_option,
        node: ^clt$data_value,
        processor: ost$name;


      IF availability_keyword = 'NORMAL_USAGE' THEN
        availability := clc$normal_usage_entry;
      ELSEIF availability_keyword = 'ADVANCED_USAGE' THEN
        availability := clc$advanced_usage_entry;
      ELSE {HIDDEN}
        availability := clc$hidden_entry;
      IFEND;

      IF command_or_function = clc$command THEN
        IF automatically_log THEN
          log_option := clc$automatically_log;
        ELSE
          log_option := clc$manually_log;
        IFEND;
        IF command_entry_count < 1 THEN
          RESET command_sequence_pointer;
        IFEND;
        command_ordinal_count := command_ordinal_count + 1;
      ELSE {clc$function}
        IF function_entry_count < 1 THEN
          RESET function_sequence_pointer;
        IFEND;
        function_ordinal_count := function_ordinal_count + 1;
      IFEND;

      node := names;
      WHILE node <> NIL DO

        IF command_or_function = clc$command THEN
          FOR index := 1 TO command_entry_count DO
            IF node^.element_value^.name_value = command_entries^ [index].name THEN
              osp$set_status_abnormal ('CL', cle$duplicate_cmnd_or_fcn_name,
                    node^.element_value^.name_value, status);
              RETURN;
            IFEND;
          FOREND;
          command_entry_count := command_entry_count + 1;
          IF node = names THEN
            IF processor_value <> NIL THEN
              processor := processor_value^.name_value;
            ELSE
              processor := names^.element_value^.name_value;
            IFEND;
            command_entries^ [command_entry_count].class := clc$nominal_entry;
          ELSEIF node^.link = NIL THEN
            command_entries^ [command_entry_count].class := clc$abbreviation_entry;
          ELSE
            command_entries^ [command_entry_count].class := clc$alias_entry;
          IFEND;
          command_entries^ [command_entry_count].name := node^.element_value^.name_value;
          command_entries^ [command_entry_count].availability := availability;

{ We are assuming here that Proc_calls and Program_calls are
{ dealt with essentially the same.

          command_entries^ [command_entry_count].call_method := clc$proc_call;
          command_entries^ [command_entry_count].procedure_name := processor;
          command_entries^ [command_entry_count].ordinal := command_ordinal_count;
          command_entries^ [command_entry_count].log_option := log_option;

        ELSE {clc$function}
          FOR index := 1 TO function_entry_count DO
            IF node^.element_value^.data_name_value = function_entries^ [index].name THEN
              osp$set_status_abnormal ('CL', cle$duplicate_cmnd_or_fcn_name,
                    node^.element_value^.data_name_value, status);
              RETURN;
            IFEND;
          FOREND;
          function_entry_count := function_entry_count + 1;
          IF node = names THEN
            IF processor_value <> NIL THEN
              processor := processor_value^.data_name_value;
            ELSE
              processor := names^.element_value^.data_name_value;
            IFEND;
            function_entries^ [function_entry_count].class := clc$nominal_entry;
          ELSEIF node^.link = NIL THEN
            function_entries^ [function_entry_count].class := clc$abbreviation_entry;
          ELSE
            function_entries^ [function_entry_count].class := clc$alias_entry;
          IFEND;
          function_entries^ [function_entry_count].name := node^.element_value^.data_name_value;
          function_entries^ [function_entry_count].availability := availability;

{ We are assuming here that Proc_calls and Program_calls are
{ dealt with essentially the same.

          function_entries^ [function_entry_count].call_method := clc$proc_call;
          function_entries^ [function_entry_count].procedure_name := processor;
          function_entries^ [function_entry_count].ordinal := function_ordinal_count;
        IFEND;

        node := node^.link;
      WHILEND;

    PROCEND save_entries;
?? TITLE := 'sort_command_entries', EJECT ??

    PROCEDURE [INLINE] sort_command_entries;

      VAR
        current: integer,
        gap: integer,
        start: integer,
        swap: clt$command_table_entry;


      gap := command_entry_count;
      WHILE gap > 1 DO
        gap := 2 * (gap DIV 4) + 1;
        FOR start := 1 TO command_entry_count - gap DO
          current := start;
          WHILE (current > 0) AND (command_entries^ [current].name > command_entries^ [current + gap].name) DO
            swap := command_entries^ [current];
            command_entries^ [current] := command_entries^ [current + gap];
            command_entries^ [current + gap] := swap;
            current := current - gap;
          WHILEND;
        FOREND;
      WHILEND;

    PROCEND sort_command_entries;
?? TITLE := 'sort_function_entries', EJECT ??

    PROCEDURE [INLINE] sort_function_entries;

      VAR
        current: integer,
        gap: integer,
        start: integer,
        swap: clt$function_proc_table_entry;


      gap := function_entry_count;
      WHILE gap > 1 DO
        gap := 2 * (gap DIV 4) + 1;
        FOR start := 1 TO function_entry_count - gap DO
          current := start;
          WHILE (current > 0) AND (function_entries^ [current].name > function_entries^ [current + gap].name)
                DO
            swap := function_entries^ [current];
            function_entries^ [current] := function_entries^ [current + gap];
            function_entries^ [current + gap] := swap;
            current := current - gap;
          WHILEND;
        FOREND;
      WHILEND;

    PROCEND sort_function_entries;
?? OLDTITLE, EJECT ??

    command_entry_count := 0;
    command_ordinal_count := 0;
    function_entry_count := 0;
    function_ordinal_count := 0;
    utility_name := 'utility_utilityend';

    init_utility_cmnd_table;

    utility_attributes [1].key := clc$utility_command_search_mode;
    utility_attributes [1].command_search_mode := clc$global_command_search;
    utility_attributes [2].key := clc$utility_command_table;
    utility_attributes [2].command_table := utility_command_list;
    utility_attributes [3].key := clc$utility_prompt;
    utility_attributes [3].prompt.value := utility_prompt;
    utility_attributes [3].prompt.size := utility_prompt_length;
    utility_attributes [4].key := clc$utility_termination_command;
    utility_attributes [4].termination_command := 'tablend';

    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (table_file_name, utility_prompt, utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET command_sequence_pointer;
    RESET function_sequence_pointer;

    IF command_entry_count > 0 THEN
      NEXT command_entries: [1 .. command_entry_count] IN command_sequence_pointer;
      sort_command_entries;
    ELSE
      command_entries := NIL;
    IFEND;

    IF function_entry_count > 0 THEN
      NEXT function_entries: [1 .. function_entry_count] IN function_sequence_pointer;
      sort_function_entries;
    ELSE
      function_entries := NIL;
    IFEND;

    command_table := command_entries;
    function_table := function_entries;

  PROCEND build_tables;
?? TITLE := 'clp$utilityend_statement', EJECT ??

  PROCEDURE [XDCL] clp$utilityend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      current_block: ^clt$block;


    status.normal := TRUE;
    clp$find_current_block (current_block);

    IF (current_block^.kind <> clc$input_block) OR (current_block^.previous_block^.kind <>
          clc$utility_block) OR (NOT current_block^.previous_block^.command_environment.command_level) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'UTILITYEND', status);
    IFEND;

  PROCEND clp$utilityend_statement;
?? TITLE := 'clp$$utility', EJECT ??

  PROCEDURE [XDCL] clp$$utility
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$utility) $utility (
{   attribute: key
{       (name, n)
{       (online_manual, om)
{       (prompt, p)
{       (subcommand_logging_enabled, scle, sle)
{     keyend = $required
{   )

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 9] of clt$keyword_specification,
      recend,
    recend := [
    [1,
    [89, 4, 20, 14, 36, 49, 240],
    clc$function, 1, 1, 1, 0, 0, 0, 0, 'OSM$$UTILITY'], [
    ['ATTRIBUTE                      ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 340,
  clc$required_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [9], [
    ['N                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['NAME                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['OM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['ONLINE_MANUAL                  ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['P                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['PROMPT                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['SCLE                           ', clc$alias_entry, clc$normal_usage_entry, 4],
    ['SLE                            ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['SUBCOMMAND_LOGGING_ENABLED     ', clc$nominal_entry, clc$normal_usage_entry, 4]]
    ]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$attribute = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;


    VAR
      attributes: array [1 .. 1] of clt$utility_attribute,
      utility_active: boolean,
      utility_name: ost$name;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    utility_name := osc$null_name;
    utility_active := TRUE;

    IF (pvt [p$attribute].value^.keyword_value = 'NAME') THEN
      attributes [1].key := clc$utility_name;
    ELSEIF (pvt [p$attribute].value^.keyword_value = 'ONLINE_MANUAL') THEN
      attributes [1].key := clc$utility_online_manual;
    ELSEIF (pvt [p$attribute].value^.keyword_value = 'PROMPT') THEN
      attributes [1].key := clc$utility_prompt;
    ELSEIF (pvt [p$attribute].value^.keyword_value = 'SUBCOMMAND_LOGGING_ENABLED') THEN
      attributes [1].key := clc$utility_subcmnd_log_enabled;
    IFEND;

    clp$get_utility_attributes (utility_name, attributes, status);
    IF NOT status.normal THEN
      IF status.condition <> cle$unknown_utility THEN
        RETURN;
      ELSE
        utility_active := FALSE;
        status.normal := TRUE;
      IFEND;
    IFEND;

    CASE attributes [1].key OF

    = clc$utility_name =
      IF utility_active THEN
        clp$make_name_value (attributes [1].name, work_area, result);
      ELSE
        clp$make_name_value ('NONE', work_area, result);
      IFEND;

    = clc$utility_online_manual =
      IF (attributes [1].online_manual_name <> osc$null_name) AND utility_active THEN
        clp$make_name_value (attributes [1].online_manual_name, work_area, result);
      ELSE
        clp$make_name_value ('NONE', work_area, result);
      IFEND;

    = clc$utility_prompt =
      IF utility_active THEN
        clp$make_string_value (attributes [1].prompt.value (1, attributes [1].prompt.size),
              work_area, result);
      ELSE
        clp$make_string_value ('', work_area, result);
      IFEND;

    = clc$utility_subcmnd_log_enabled =
      IF utility_active THEN
        clp$make_boolean_value (attributes [1].subcommand_logging_enabled, clc$true_false_boolean, work_area,
              result);
      ELSE
        clp$make_boolean_value (TRUE, clc$true_false_boolean, work_area, result);
      IFEND;

    CASEND;

  PROCEND clp$$utility;
?? TITLE := 'clp$_change_utility_attributes', EJECT ??

  PROCEDURE [XDCL] clp$_change_utility_attributes
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$chaua) change_utility_attributes, change_utility_attribute, chaua (
{   utility, u: name = $required
{   enable_subcommand_logging, esl: (BY_NAME) boolean = $optional
{   interactive_include_processor, iip: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = $optional
{   line_preprocessor, lp: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = $optional
{   online_manual, om: (BY_NAME) any of
{       key
{         none
{       keyend
{       name
{     anyend = $optional
{   prompt, p: (BY_NAME) string 0..27 = $optional
{   tables, table, t: (BY_NAME) file = $optional
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 8] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 25, 14, 16, 6, 424],
    clc$command, 16, 8, 1, 0, 0, 0, 8, 'OSM$CHAUA'], [
    ['ENABLE_SUBCOMMAND_LOGGING      ',clc$nominal_entry, 2],
    ['ESL                            ',clc$abbreviation_entry, 2],
    ['IIP                            ',clc$abbreviation_entry, 3],
    ['INTERACTIVE_INCLUDE_PROCESSOR  ',clc$nominal_entry, 3],
    ['LINE_PREPROCESSOR              ',clc$nominal_entry, 4],
    ['LP                             ',clc$abbreviation_entry, 4],
    ['OM                             ',clc$abbreviation_entry, 5],
    ['ONLINE_MANUAL                  ',clc$nominal_entry, 5],
    ['P                              ',clc$abbreviation_entry, 6],
    ['PROMPT                         ',clc$nominal_entry, 6],
    ['STATUS                         ',clc$nominal_entry, 8],
    ['T                              ',clc$abbreviation_entry, 7],
    ['TABLE                          ',clc$alias_entry, 7],
    ['TABLES                         ',clc$nominal_entry, 7],
    ['U                              ',clc$abbreviation_entry, 1],
    ['UTILITY                        ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [16, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 3
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69, clc$optional_parameter,
  0, 0],
{ PARAMETER 5
    [8, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69, clc$optional_parameter,
  0, 0],
{ PARAMETER 6
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$optional_parameter, 0
  , 0],
{ PARAMETER 7
    [14, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 8
    [11, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$boolean_type]],
{ PARAMETER 3
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 5
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 6
    [[1, 0, clc$string_type], [0, 27, FALSE]],
{ PARAMETER 7
    [[1, 0, clc$file_type]],
{ PARAMETER 8
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$utility = 1,
      p$enable_subcommand_logging = 2,
      p$interactive_include_processor = 3,
      p$line_preprocessor = 4,
      p$online_manual = 5,
      p$prompt = 6,
      p$tables = 7,
      p$status = 8;

    VAR
      pvt: array [1 .. 8] of clt$parameter_value;


    VAR
      attribute_ptr: ^SEQ (REP max_utility_attributes of clt$utility_attribute),
      change_utility_name: ost$name,
      command_sequence_pointer: ^SEQ ( * ),
      command_table: ^clt$command_table,
      delete_segment_status: ost$status,
      function_sequence_pointer: ^SEQ ( * ),
      function_table: ^clt$function_processor_table,
      parameter_count: 0 .. 6,
      segment_pointer: amt$segment_pointer,
      table_file_name: ^fst$file_reference,
      utility_command_attribute: ^array [1 .. * ] of clt$utility_attribute;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      IF command_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := command_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, handler_status);
      IFEND;

      IF function_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := function_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, handler_status);
      IFEND;

      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    command_sequence_pointer := NIL;
    #SPOIL (command_sequence_pointer);
    function_sequence_pointer := NIL;
    #SPOIL (function_sequence_pointer);
    parameter_count := 0;

    change_utility_name := pvt [p$utility].value^.name_value;

    PUSH attribute_ptr;
    RESET attribute_ptr;
    NEXT utility_command_attribute: [1 .. 6] IN attribute_ptr;

    IF pvt [p$enable_subcommand_logging].specified THEN
      parameter_count := parameter_count + 1;
      utility_command_attribute^ [parameter_count].key := clc$utility_subcmnd_log_enabled;
      utility_command_attribute^ [parameter_count].subcommand_logging_enabled :=
            pvt [p$enable_subcommand_logging].value^.boolean_value.value;
    IFEND;

    IF pvt [p$interactive_include_processor].specified THEN
      parameter_count := parameter_count + 1;
      utility_command_attribute^ [parameter_count].key := clc$utility_interactive_include;
      IF pvt [p$interactive_include_processor].value^.kind = clc$keyword THEN
        utility_command_attribute^ [parameter_count].interactive_include_processor.call_method :=
              clc$unspecified_call;
      ELSE
        osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'interactive_include_processor', status);
        RETURN;
        utility_command_attribute^ [parameter_count].interactive_include_processor.call_method :=
              clc$proc_call;
        utility_command_attribute^ [parameter_count].interactive_include_processor.command_name :=
              pvt [p$interactive_include_processor].value^.name_value;
      IFEND;
    IFEND;

    IF pvt [p$line_preprocessor].specified THEN
      parameter_count := parameter_count + 1;
      utility_command_attribute^ [parameter_count].key := clc$utility_line_preprocessor;
      IF pvt [p$line_preprocessor].value^.kind = clc$keyword THEN
        utility_command_attribute^ [parameter_count].line_preprocessor.call_method := clc$unspecified_call;
      ELSE
        osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'line_preprocessor', status);
        RETURN;
        utility_command_attribute^ [parameter_count].line_preprocessor.call_method := clc$proc_call;
        utility_command_attribute^ [parameter_count].line_preprocessor.command_name :=
              pvt [p$line_preprocessor].value^.name_value;
      IFEND;
    IFEND;

    IF pvt [p$online_manual].specified THEN
      parameter_count := parameter_count + 1;
      utility_command_attribute^ [parameter_count].key := clc$utility_online_manual;
      IF pvt [p$online_manual].value^.kind = clc$keyword THEN
        utility_command_attribute^ [parameter_count].online_manual_name := osc$null_name;
      ELSE
        utility_command_attribute^ [parameter_count].online_manual_name :=
              pvt [p$online_manual].value^.name_value;
      IFEND;
    IFEND;

    IF pvt [p$prompt].specified THEN
      parameter_count := parameter_count + 1;
      utility_command_attribute^ [parameter_count].key := clc$utility_prompt;
      utility_command_attribute^ [parameter_count].prompt.value := pvt [p$prompt].value^.string_value^;
      utility_command_attribute^ [parameter_count].prompt.size :=
            STRLENGTH (pvt [p$prompt].value^.string_value^);
    IFEND;

  /change_user_utility/
    BEGIN
      IF pvt [p$tables].specified THEN
        osp$establish_block_exit_hndlr (^abort_handler);

        build_tables (pvt [p$tables].value^.file_value^, command_sequence_pointer, function_sequence_pointer,
              command_table, function_table, status);
        IF NOT status.normal THEN
          EXIT /change_user_utility/;
        IFEND;

        IF command_sequence_pointer <> NIL THEN
          parameter_count := parameter_count + 1;
          utility_command_attribute^ [parameter_count].key := clc$utility_command_table;
          utility_command_attribute^ [parameter_count].command_table := command_table;
        IFEND;
        IF function_sequence_pointer <> NIL THEN
          parameter_count := parameter_count + 1;
          utility_command_attribute^ [parameter_count].key := clc$utility_function_proc_table;
          utility_command_attribute^ [parameter_count].function_processor_table := function_table;
        IFEND;
      IFEND;

      IF parameter_count = 0 THEN
        EXIT /change_user_utility/;
      IFEND;

      RESET attribute_ptr;
      NEXT utility_command_attribute: [1 .. parameter_count] IN attribute_ptr;

      clp$change_utility_environment (change_utility_name, TRUE, utility_command_attribute^, status);
      IF NOT status.normal THEN
        EXIT /change_user_utility/;
      IFEND;
    END /change_user_utility/;

    IF pvt [p$tables].specified THEN
      IF command_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := command_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, delete_segment_status);
        IF (NOT delete_segment_status.normal) AND status.normal THEN
          status := delete_segment_status;
        IFEND;
        command_sequence_pointer := NIL;
        #SPOIL (command_sequence_pointer);
      IFEND;

      IF function_sequence_pointer <> NIL THEN
        segment_pointer.sequence_pointer := function_sequence_pointer;
        mmp$delete_scratch_segment (segment_pointer, delete_segment_status);
        IF (NOT delete_segment_status.normal) AND status.normal THEN
          status := delete_segment_status;
        IFEND;
        function_sequence_pointer := NIL;
        #SPOIL (function_sequence_pointer);
      IFEND;

      osp$disestablish_cond_handler;
    IFEND;

  PROCEND clp$_change_utility_attributes;

MODEND clm$utility_commands;
