?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Parameter Access Requests' ??
MODULE clm$access_parameters;

{
{ PURPOSE:
{   This module contains the procedures that retrieve information about the parameters for a command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc clc$max_value_sets
*copyc clc$max_values_per_set
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parameter_list
*copyc cle$not_supported
*copyc cle$unexpected_value_type
*copyc clk$procedure_keypoints
*copyc clt$data_value
*copyc clt$expression_eval_method
*copyc clt$parameter_name
*copyc clt$parameter_name_index
*copyc clt$parameter_number
*copyc clt$value
*copyc ost$name_reference
*copyc ost$status
*copyc clv$type_kind_names
*copyc clv$value_descriptors
*copyc clv$value_type_kinds
*copyc osv$lower_to_upper
?? POP ??
*copyc clp$append_status_value_type
*copyc clp$convert_int_value_to_ext
*copyc clp$convert_value_to_clt$value
*copyc clp$data_representation_text
*copyc clp$find_current_block
*copyc clp$get_single_data_value
*copyc clp$get_single_internal_value
*copyc clp$get_variable
*copyc clp$get_work_area
*copyc clp$internal_convert_to_string
*copyc clp$make_clt$value
*copyc clp$make_string_value
*copyc clp$make_unspecified_value
*copyc clp$read_qualified_data_value
*copyc clp$read_variable
*copyc clp$search_parameter_names
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal

?? TITLE := 'clp$test_parameter', EJECT ??
*copyc clh$test_parameter

  PROCEDURE [XDCL, #GATE] clp$test_parameter
    (    parameter_name: string ( * );
     VAR parameter_specified: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      found: boolean,
      name: clt$parameter_name,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number;


  /test_parameter/
    BEGIN

      status.normal := TRUE;
      find_parameters_block ('clp$test_parameter', block, status);
      IF NOT status.normal THEN
        EXIT /test_parameter/;
      IFEND;
      IF (block^.parameters.names = NIL) OR (block^.parameters.parameter_value_table = NIL) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$test_parameter', status);
        EXIT /test_parameter/;
      IFEND;
      #TRANSLATE (osv$lower_to_upper, parameter_name, name);
      clp$search_parameter_names (name, block^.parameters.names, name_index, found);
      IF NOT found THEN
        osp$set_status_abnormal ('CL', cle$unknown_parameter_name, name, status);
        EXIT /test_parameter/;
      IFEND;
      parameter_number := block^.parameters.names^ [name_index].position;
      parameter_specified := block^.parameters.parameter_value_table^ [parameter_number].specified;

    END /test_parameter/;

  PROCEND clp$test_parameter;
?? TITLE := 'clp$get_set_count', EJECT ??
*copyc clh$get_set_count

  PROCEDURE [XDCL, #GATE] clp$get_set_count
    (    parameter_name: string ( * );
     VAR value_set_count: 0 .. clc$max_value_sets;
     VAR status: ost$status);

    VAR
      value: ^clt$parameter_value;


  /get_set_count/
    BEGIN

      status.normal := TRUE;
      get_parameter_value ('clp$get_set_count', parameter_name, value, status);
      value_set_count := 0;
      IF NOT status.normal THEN
        EXIT /get_set_count/;
      ELSEIF value^.passing_method = clc$pass_by_reference THEN
        IF value^.variable <> NIL THEN
          value_set_count := 1;
        IFEND;
        EXIT /get_set_count/;
      ELSEIF value^.value = NIL THEN
        EXIT /get_set_count/;
      ELSEIF value^.value^.kind <> clc$list THEN
        value_set_count := 1;
        EXIT /get_set_count/;
      IFEND;
      get_value_element_count (value^.value, value_set_count);

    END /get_set_count/;

  PROCEND clp$get_set_count;
?? TITLE := 'clp$get_value_count', EJECT ??
*copyc clh$get_value_count

  PROCEDURE [XDCL, #GATE] clp$get_value_count
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
     VAR value_count: 0 .. clc$max_values_per_set;
     VAR status: ost$status);

    VAR
      data_value: ^clt$data_value,
      value: ^clt$parameter_value;


  /get_val_count/
    BEGIN

      status.normal := TRUE;
      get_parameter_value ('clp$get_value_count', parameter_name, value, status);
      value_count := 0;
      IF NOT status.normal THEN
        EXIT /get_val_count/;
      ELSEIF value^.passing_method = clc$pass_by_reference THEN
        IF (value^.variable <> NIL) AND (value_set_number = 1) THEN
          value_count := 1;
        IFEND;
        EXIT /get_val_count/;
      ELSEIF value^.value = NIL THEN
        EXIT /get_val_count/;
      ELSEIF value^.value^.kind <> clc$list THEN
        IF value_set_number = 1 THEN
          value_count := 1;
        IFEND;
        EXIT /get_val_count/;
      IFEND;
      data_value := value^.value;
      get_value_element (value_set_number, data_value);
      IF data_value = NIL THEN
        EXIT /get_val_count/;
      ELSEIF data_value^.kind <> clc$list THEN
        value_count := 1;
        EXIT /get_val_count/;
      IFEND;
      get_value_element_count (data_value, value_count);

    END /get_val_count/;

  PROCEND clp$get_value_count;
?? TITLE := 'clp$test_range', EJECT ??
*copyc clh$test_range

  PROCEDURE [XDCL, #GATE] clp$test_range
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
         value_number: 1 .. clc$max_values_per_set;
     VAR range_specified: boolean;
     VAR status: ost$status);

    VAR
      data_value: ^clt$data_value,
      value: ^clt$parameter_value;


  /test_rng/
    BEGIN

      status.normal := TRUE;
      get_parameter_value ('clp$test_range', parameter_name, value, status);
      range_specified := FALSE;
      IF (NOT status.normal) OR (value = NIL) THEN
        EXIT /test_rng/;
      ELSEIF value^.passing_method = clc$pass_by_reference THEN
        EXIT /test_rng/;
      ELSEIF value^.value = NIL THEN
        EXIT /test_rng/;
      ELSEIF value^.value^.kind <> clc$list THEN
        IF (value_set_number <> 1) OR (value_number <> 1) THEN
          EXIT /test_rng/;
        IFEND;
        data_value := value^.value;
      ELSE
        data_value := value^.value;
        get_value_element (value_set_number, data_value);
        IF data_value = NIL THEN
          EXIT /test_rng/;
        ELSEIF data_value^.kind = clc$list THEN
          get_value_element (value_number, data_value);
        ELSEIF value_number <> 1 THEN
          EXIT /test_rng/;
        IFEND;
      IFEND;

      range_specified := (data_value^.kind = clc$range) AND (data_value^.low_value <> data_value^.high_value);

    END /test_rng/;

  PROCEND clp$test_range;
?? TITLE := 'clp$get_value', EJECT ??
*copyc clh$get_value

  PROCEDURE [XDCL, #GATE] clp$get_value
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
         value_number: 1 .. clc$max_values_per_set;
         low_or_high: clt$low_or_high;
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      parameter_value: ^clt$parameter_value,
      variable_reference: clt$variable_reference;

  /get_val/
    BEGIN

      status.normal := TRUE;
      get_parameter_value ('clp$get_value', parameter_name, parameter_value, status);
      IF NOT status.normal THEN
        EXIT /get_val/;
      ELSEIF parameter_value^.passing_method = clc$pass_by_reference THEN
        IF parameter_value^.variable = NIL THEN
          clp$make_clt$value (clc$unknown_value, value);
        ELSE
          clp$read_variable (parameter_value^.variable^, variable_reference, status);
          IF status.normal THEN
            clp$make_clt$value (clc$variable_reference, value);
            value.var_ref := variable_reference;
          IFEND;
        IFEND;
      ELSE
        clp$convert_value_to_clt$value (parameter_value^.value, value_set_number, value_number, low_or_high,
              value, status);
      IFEND;

    END /get_val/;

  PROCEND clp$get_value;
?? TITLE := 'clp$get_parameter', EJECT ??
*copyc clh$get_parameter

  PROCEDURE [XDCL, #GATE] clp$get_parameter
    (    parameter_name: string ( * );
     VAR value_list: ost$string;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      original_work_area: ^clt$work_area,
      representation: ^clt$data_representation,
      representation_text: ^clt$string_value,
      request: clt$convert_to_string_request,
      value: ^clt$parameter_value,
      work_area: ^^clt$work_area;


  /get_parameter/
    BEGIN

      status.normal := TRUE;
      find_parameters_block ('clp$get_parameter', block, status);
      IF NOT status.normal THEN
        EXIT /get_parameter/;
      IFEND;
      IF (block^.parameters.names = NIL) OR (block^.parameters.parameter_value_table = NIL) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_parameter', status);
        EXIT /get_parameter/;
      IFEND;
      get_parameter_value ('clp$get_parameter', parameter_name, value, status);
      IF NOT status.normal THEN
        EXIT /get_parameter/;
      ELSEIF value^.passing_method = clc$pass_by_reference THEN
        IF value^.variable = NIL THEN
          value_list.size := 0;
          value_list.value := '';
        ELSE
          IF STRLENGTH (value^.variable^) <= osc$max_string_size THEN
            value_list.size := STRLENGTH (value^.variable^);
          ELSE
            value_list.size := osc$max_string_size;
          IFEND;
          value_list.value := value^.variable^;
        IFEND;
        EXIT /get_parameter/;
      ELSEIF value^.value = NIL THEN
        value_list.size := 0;
        value_list.value := '';
        EXIT /get_parameter/;
      IFEND;

      clp$get_work_area (#RING (^work_area), work_area, status);
      IF NOT status.normal THEN
        EXIT /get_parameter/;
      IFEND;
      original_work_area := work_area^;

      request.initial_indentation := 0;
      request.continuation_indentation := 0;
      request.max_string := clc$max_string_size;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_data_value;
      request.representation_option := clc$data_source_representation;
      request.value := value^.value;

      clp$internal_convert_to_string (request, work_area^, representation, status);
      IF NOT status.normal THEN
        work_area^ := original_work_area;
        EXIT /get_parameter/;
      IFEND;
      representation_text := clp$data_representation_text (representation);

      IF STRLENGTH (representation_text^) <= osc$max_string_size THEN
        value_list.size := STRLENGTH (representation_text^);
      ELSE
        value_list.size := osc$max_string_size;
      IFEND;
      value_list.value := representation_text^;
      work_area^ := original_work_area;

    END /get_parameter/;

  PROCEND clp$get_parameter;
?? TITLE := 'clp$get_parameter_list', EJECT ??
*copyc clh$get_parameter_list

  PROCEDURE [XDCL, #GATE] clp$get_parameter_list
    (VAR parameter_list: ost$string;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      original_work_area: ^clt$work_area,
      representation: ^clt$data_representation,
      representation_text: ^clt$string_value,
      request: clt$convert_to_string_request,
      work_area: ^^clt$work_area;


  /get_parameter_list/
    BEGIN

      status.normal := TRUE;
      find_parameters_block ('clp$get_parameter_list', block, status);
      IF NOT status.normal THEN
        EXIT /get_parameter_list/;
      IFEND;
      IF (block^.parameters.names = NIL) OR (block^.parameters.parameter_value_table = NIL) THEN
        parameter_list.size := 0;
        parameter_list.value := '';
        RETURN;
      IFEND;
      clp$get_work_area (#RING (^work_area), work_area, status);
      IF NOT status.normal THEN
        EXIT /get_parameter_list/;
      IFEND;
      original_work_area := work_area^;
      request.initial_indentation := 0;
      request.continuation_indentation := 0;
      request.max_string := clc$max_string_size;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_parameters;
      request.initial_text := NIL;
      request.include_secure_parameters := TRUE;
      request.evaluated_pdt := block^.parameters.unbundled_pdt;
      request.evaluated_pvt := block^.parameters.parameter_value_table;
      request.parameter_substitutions := NIL;
      clp$internal_convert_to_string (request, work_area^, representation, status);
      IF NOT status.normal THEN
        work_area^ := original_work_area;
        EXIT /get_parameter_list/;
      IFEND;

      representation_text := clp$data_representation_text (representation);
      IF STRLENGTH (representation_text^) <= osc$max_string_size THEN
        parameter_list.size := STRLENGTH (representation_text^);
      ELSE
        parameter_list.size := osc$max_string_size;
      IFEND;
      parameter_list.value := representation_text^;
      work_area^ := original_work_area;

    END /get_parameter_list/;

  PROCEND clp$get_parameter_list;
?? TITLE := 'clp$test_proc_parameter', EJECT ??

  PROCEDURE [XDCL] clp$test_proc_parameter
    (    parameter_name: string ( * );
     VAR parameter_specified: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      found: boolean,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number;


    find_proc_parameters_block ('$SPECIFIED', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$SPECIFIED', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
    ELSE
      parameter_number := block^.parameters.names^ [name_index].position;
      parameter_specified := block^.parameters.accesses^ [parameter_number].specified;
    IFEND;

  PROCEND clp$test_proc_parameter;
?? TITLE := 'clp$get_proc_set_count', EJECT ??

  PROCEDURE [XDCL] clp$get_proc_set_count
    (    parameter_name: string ( * );
     VAR work_area {input, output} : ^clt$work_area;
     VAR value_set_count: 0 .. clc$max_value_sets;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      data_value: ^clt$data_value,
      found: boolean,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number;


    find_proc_parameters_block ('$SET_COUNT', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$SET_COUNT', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    IF block^.parameters.accesses^ [parameter_number].info.access_mode = clc$read_only THEN
      get_proc_parameter_value (parameter_name, parameter_number, block, work_area, data_value,
            internal_value, i_value, status);
      IF status.normal THEN
        IF data_value <> NIL THEN
          get_value_element_count (data_value, value_set_count);
        ELSEIF i_value <> NIL THEN
          get_int_value_element_count (internal_value, i_value, value_set_count);
        ELSE
          value_set_count := 0;
        IFEND;
      IFEND;
    ELSE
      IF block^.parameters.accesses^ [parameter_number].info.descriptor = NIL THEN
        value_set_count := 0;
      ELSE
        value_set_count := 1;
      IFEND;
    IFEND;

  PROCEND clp$get_proc_set_count;
?? TITLE := 'clp$get_proc_value_count', EJECT ??

  PROCEDURE [XDCL] clp$get_proc_value_count
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
     VAR work_area {input, output} : ^clt$work_area;
     VAR value_count: 0 .. clc$max_values_per_set;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      current_node: ^clt$data_value,
      data_value: ^clt$data_value,
      found: boolean,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      kind: clt$data_kind,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number,
      value_set_index: 0 .. clc$max_value_sets;


    status.normal := TRUE;
    find_proc_parameters_block ('$VALUE_COUNT', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$VALUE_COUNT', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    IF block^.parameters.accesses^ [parameter_number].info.access_mode = clc$read_only THEN
      get_proc_parameter_value (parameter_name, parameter_number, block, work_area, data_value,
            internal_value, i_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF data_value <> NIL THEN
        kind := data_value^.kind;
      ELSEIF i_value <> NIL THEN
        kind := i_value^.kind;
      ELSE
        kind := clc$unspecified;
      IFEND;
      IF kind = clc$unspecified THEN
        value_count := 0;
        RETURN;
      ELSEIF kind <> clc$list THEN
        IF value_set_number = 1 THEN
          value_count := 1;
        ELSE
          value_count := 0;
        IFEND;
        RETURN;
      IFEND;
      IF data_value <> NIL THEN
        get_value_element (value_set_number, data_value);
      ELSEIF i_value <> NIL THEN
        get_internal_value_element (value_set_number, internal_value, i_value);
      IFEND;
      IF data_value <> NIL THEN
        kind := data_value^.kind;
      ELSEIF i_value <> NIL THEN
        kind := i_value^.kind;
      ELSE
        kind := clc$unspecified;
      IFEND;
      IF kind = clc$unspecified THEN
        value_count := 0;
      ELSE
        IF data_value <> NIL THEN
          get_value_element_count (data_value, value_count);
        ELSEIF i_value <> NIL THEN
          get_int_value_element_count (internal_value, i_value, value_count);
        ELSE
          value_count := 0;
        IFEND;
      IFEND;
    ELSE
      IF (block^.parameters.accesses^ [parameter_number].info.descriptor = NIL) OR
            (value_set_number <> 1) THEN
        value_count := 0;
      ELSE
        value_count := 1;
      IFEND;
    IFEND;

  PROCEND clp$get_proc_value_count;
?? TITLE := 'clp$test_proc_range', EJECT ??

  PROCEDURE [XDCL] clp$test_proc_range
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
         value_number: 1 .. clc$max_values_per_set;
     VAR work_area {input, output} : ^clt$work_area;
     VAR range_specified: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      data_value: ^clt$data_value,
      found: boolean,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      kind: clt$data_kind,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number;


    range_specified := FALSE;
    find_proc_parameters_block ('$RANGE', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$RANGE', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    IF block^.parameters.accesses^ [parameter_number].info.access_mode = clc$read_write THEN
      RETURN;
    IFEND;
    get_proc_parameter_value (parameter_name, parameter_number, block, work_area, data_value, internal_value,
          i_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF data_value <> NIL THEN
      kind := data_value^.kind;
    ELSEIF i_value <> NIL THEN
      kind := i_value^.kind;
    ELSE
      kind := clc$unspecified;
    IFEND;
    IF kind = clc$unspecified THEN
      RETURN;
    IFEND;
    IF data_value <> NIL THEN
      get_value_element (value_set_number, data_value);
    ELSEIF i_value <> NIL THEN
      get_internal_value_element (value_set_number, internal_value, i_value);
    IFEND;
    IF data_value <> NIL THEN
      kind := data_value^.kind;
    ELSEIF i_value <> NIL THEN
      kind := i_value^.kind;
    ELSE
      kind := clc$unspecified;
    IFEND;
    IF kind = clc$unspecified THEN
      RETURN;
    IFEND;
    IF data_value <> NIL THEN
      get_value_element (value_number, data_value);
    ELSEIF i_value <> NIL THEN
      get_internal_value_element (value_number, internal_value, i_value);
    IFEND;
    IF data_value <> NIL THEN
      kind := data_value^.kind;
    ELSEIF i_value <> NIL THEN
      kind := i_value^.kind;
    ELSE
      kind := clc$unspecified;
    IFEND;
    IF kind <> clc$range THEN
      RETURN;
    IFEND;
    IF data_value <> NIL THEN
      range_specified := data_value^.high_value <> data_value^.low_value;
    ELSEIF i_value <> NIL THEN
      range_specified := i_value^.high_value <> i_value^.low_value;
    IFEND;

  PROCEND clp$test_proc_range;
?? TITLE := 'clp$get_proc_value', EJECT ??

  PROCEDURE [XDCL] clp$get_proc_value
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
         value_number: 1 .. clc$max_values_per_set;
         low_or_high: clt$low_or_high;
     VAR work_area {input, output} : ^clt$work_area;
     VAR access_mode: clt$data_access_mode;
     VAR value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      internal_component: REL (clt$internal_data_value) ^clt$i_data_value,
      found: boolean,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number;


    status.normal := TRUE;
    value := NIL;
    find_proc_parameters_block ('$VALUE', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$VALUE', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    access_mode := block^.parameters.accesses^ [parameter_number].info.access_mode;
    IF access_mode = clc$read_write THEN
      RETURN;
    IFEND;
    get_proc_parameter_value (parameter_name, parameter_number, block, work_area, value, internal_value,
          i_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value <> NIL THEN
      clp$get_single_data_value (value_set_number, value_number, low_or_high, value, status);
    ELSEIF i_value <> NIL THEN
      internal_component := #REL (i_value, internal_value^);
      clp$get_single_internal_value (internal_value, value_set_number, value_number, low_or_high,
            internal_component, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$convert_int_value_to_ext (internal_value, internal_component, work_area, value, status);
    ELSE
      clp$make_unspecified_value (work_area, value);
      IF value = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      IFEND;
    IFEND;

  PROCEND clp$get_proc_value;
?? TITLE := 'clp$get_proc_value_kind', EJECT ??

  PROCEDURE [XDCL] clp$get_proc_value_kind
    (    parameter_name: string ( * );
         value_set_number: 1 .. clc$max_value_sets;
         value_number: 1 .. clc$max_values_per_set;
         low_or_high: clt$low_or_high;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      internal_component: REL (clt$internal_data_value) ^clt$i_data_value,
      found: boolean,
      header: ^clt$type_specification_header,
      i_value: ^clt$i_data_value,
      internal_value: ^clt$internal_data_value,
      kind: clt$data_kind,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number,
      specification: ^clt$type_specification,
      value: ^clt$data_value;


    status.normal := TRUE;
    find_proc_parameters_block ('$VALUE_KIND', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$VALUE_KIND', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    IF block^.parameters.accesses^ [parameter_number].info.access_mode = clc$read_only THEN
      get_proc_parameter_value (parameter_name, parameter_number, block, work_area, value, internal_value,
            i_value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value <> NIL THEN
        kind := value^.kind;
      ELSEIF i_value <> NIL THEN
        kind := i_value^.kind;
      ELSE
        kind := clc$unspecified;
      IFEND;
      IF kind = clc$unspecified THEN
        clp$make_string_value ('UNKNOWN', work_area, result);
        RETURN;
      IFEND;
      IF value <> NIL THEN
        clp$get_single_data_value (value_set_number, value_number, low_or_high, value, status);
      ELSE
        internal_component := #REL (i_value, internal_value^);
        clp$get_single_internal_value (internal_value, value_set_number, value_number, low_or_high,
              internal_component, status);
        i_value := #PTR (internal_component, internal_value^);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value <> NIL THEN
        kind := value^.kind;
      ELSEIF i_value <> NIL THEN
        kind := i_value^.kind;
      ELSE
        kind := clc$unspecified;
      IFEND;
      IF kind = clc$unspecified THEN
        clp$make_string_value ('UNKNOWN', work_area, result);
      ELSEIF kind = clc$keyword THEN
        clp$make_string_value ('NAME', work_area, result);
      ELSE
        clp$make_string_value (clv$type_kind_names [clv$value_type_kinds [kind]], work_area, result);
      IFEND;
    ELSE
      IF (value_set_number <> 1) OR (value_number <> 1) THEN
        clp$make_string_value ('UNKNOWN', work_area, result);
      ELSE
        clp$make_string_value (clv$value_descriptors [clc$variable_reference], work_area, result);
      IFEND;
    IFEND;
    IF result = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$get_proc_value_kind;
?? TITLE := 'clp$get_proc_parameter', EJECT ??

  PROCEDURE [XDCL] clp$get_proc_parameter
    (    parameter_name: string ( * );
     VAR work_area {input, output} : ^clt$work_area;
     VAR value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      found: boolean,
      name_index: clt$parameter_name_index,
      parameter_number: clt$parameter_number,
      representation: ^clt$data_representation,
      request: clt$convert_to_string_request;


    status.normal := TRUE;
    find_proc_parameters_block ('$PARAMETER', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, '$PARAMETER', status);
      RETURN;
    IFEND;
    clp$search_parameter_names (parameter_name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, parameter_name, status);
      RETURN;
    IFEND;
    parameter_number := block^.parameters.names^ [name_index].position;
    IF block^.parameters.accesses^ [parameter_number].info.access_mode = clc$read_only THEN
      IF block^.parameters.accesses^ [parameter_number].info.descriptor^.header.value = NIL THEN
        clp$make_string_value ('', work_area, value);
        RETURN;
      IFEND;
      request.initial_indentation := 0;
      request.continuation_indentation := 0;
      request.max_string := clc$max_string_size;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_data_value;
      request.representation_option := clc$data_source_representation;
      clp$convert_int_value_to_ext (block^.parameters.accesses^ [parameter_number].info.descriptor^.header.
            value, block^.parameters.accesses^ [parameter_number].info.descriptor^.header.value^.header.value,
            work_area, request.value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$internal_convert_to_string (request, work_area, representation, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$make_string_value (clp$data_representation_text (representation) ^, work_area, value);
    ELSE
      IF block^.parameters.accesses^ [parameter_number].passed_variable_reference <> NIL THEN
        clp$make_string_value (block^.parameters.accesses^ [parameter_number].passed_variable_reference^,
              work_area, value);
      ELSE
        clp$make_string_value ('', work_area, value);
      IFEND;
    IFEND;
    IF value = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$get_proc_parameter;
?? TITLE := 'clp$get_proc_parameter_list', EJECT ??

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

    VAR
      block: ^clt$block,
      command_or_function: clt$command_or_function,
      representation: ^clt$data_representation,
      request: clt$convert_to_string_request;


    status.normal := TRUE;
    find_proc_parameters_block ('$PARAMETER_LIST', block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.accesses = NIL) THEN
      clp$make_string_value ('', work_area, value);
      RETURN;
    IFEND;
    request.initial_indentation := 0;
    request.continuation_indentation := 0;
    request.max_string := osc$max_string_size;
    request.include_advanced_items := TRUE;
    request.include_hidden_items := TRUE;
    request.kind := clc$convert_parameters;
    request.initial_text := NIL;
    request.include_secure_parameters := TRUE;
    request.parameter_substitutions := NIL;
    IF block^.kind = clc$command_proc_block THEN
      command_or_function := clc$command;
    ELSE
      command_or_function := clc$function;
    IFEND;
    prepare_proc_param_conversion (command_or_function, block^.parameters.names, block^.parameters.accesses,
          work_area, request.evaluated_pdt, request.evaluated_pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$internal_convert_to_string (request, work_area, representation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$make_string_value (clp$data_representation_text (representation) ^, work_area, value);
    IF value = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
    IFEND;

  PROCEND clp$get_proc_parameter_list;
?? TITLE := 'find_parameters_block', EJECT ??

  PROCEDURE [INLINE] find_parameters_block
    (    request_name: ost$name_reference;
     VAR block: ^clt$block;
     VAR status: ost$status);


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

  /find_block/
    WHILE block <> NIL DO
      CASE block^.kind OF
      = clc$command_proc_block =
        block := NIL;
        EXIT /find_block/;
      = clc$command_block, clc$sub_parameters_block =
        EXIT /find_block/;
      = clc$task_block =
        IF block^.task_kind <> clc$other_task THEN
          block := NIL;
        IFEND;
        EXIT /find_block/;
      ELSE
        block := block^.previous_block;
      CASEND;
    WHILEND /find_block/;

    IF (block = NIL) OR (NOT block^.parameters.evaluated) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, request_name, status);
      block := NIL;
      RETURN;
    IFEND;

  PROCEND find_parameters_block;
?? TITLE := 'find_proc_parameters_block', EJECT ??

  PROCEDURE [INLINE] find_proc_parameters_block
    (    request_name: ost$name_reference;
     VAR block: ^clt$block;
     VAR status: ost$status);


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

  /find_block/
    WHILE block <> NIL DO
      CASE block^.kind OF
      = clc$command_proc_block, clc$function_proc_block =
        IF block^.parameters.evaluated THEN
          RETURN;
        IFEND;
      = clc$input_block =
        IF block^.inherited_input.found THEN
          block := block^.inherited_input.block;
          CYCLE /find_block/;
        IFEND;
      ELSE
        ;
      CASEND;

      IF block^.static_link <> NIL THEN
        block := block^.static_link;
      ELSE
        block := block^.previous_block;
      IFEND;
    WHILEND /find_block/;

    IF block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, request_name, status);
      RETURN;
    IFEND;

  PROCEND find_proc_parameters_block;
?? TITLE := 'get_parameter_value', EJECT ??

  PROCEDURE [INLINE] get_parameter_value
    (    request_name: ost$name_reference;
         parameter_name: string ( * );
     VAR value: ^clt$parameter_value;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      found: boolean,
      name: clt$parameter_name,
      name_index: clt$parameter_name_index;


    value := NIL;
    find_parameters_block (request_name, block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (block^.parameters.names = NIL) OR (block^.parameters.parameter_value_table = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, request_name, status);
      RETURN;
    IFEND;

    #TRANSLATE (osv$lower_to_upper, parameter_name, name);
    clp$search_parameter_names (name, block^.parameters.names, name_index, found);
    IF NOT found THEN
      osp$set_status_abnormal ('CL', cle$unknown_parameter_name, name, status);
      RETURN;
    IFEND;
    value := ^block^.parameters.parameter_value_table^ [block^.parameters.names^ [name_index].position];

  PROCEND get_parameter_value;
?? TITLE := 'get_proc_parameter_value', EJECT ??

  PROCEDURE [INLINE] get_proc_parameter_value
    (    parameter_name: string ( * );
         parameter_number: clt$parameter_number;
         block: ^clt$block;
     VAR work_area {input, output} : ^clt$work_area;
     VAR data_value: ^clt$data_value;
     VAR internal_value: ^clt$internal_data_value;
     VAR i_value: ^clt$i_data_value;
     VAR status: ost$status);

    VAR
      access_variable_requests: clt$access_variable_requests,
      ignore_parse_value_qualifiers: ^clt$value_qualifiers,
      ignore_parse_value_qual_index: integer,
      ignore_type_description: ^clt$type_description;


    data_value := NIL;
    internal_value := NIL;
    i_value := NIL;

    IF (block^.parameters.accesses^ [parameter_number].info.descriptor <> NIL) AND
          (block^.parameters.accesses^ [parameter_number].info.descriptor^.header.value <> NIL) THEN
      IF block^.parameters.accesses^ [parameter_number].info.qualifiers = NIL THEN
        internal_value := block^.parameters.accesses^ [parameter_number].info.descriptor^.header.value;
        i_value := #PTR (block^.parameters.accesses^ [parameter_number].info.descriptor^.header.value^.header.
              value, internal_value^);
      ELSE
        access_variable_requests := $clt$access_variable_requests[ ];
        ignore_type_description := NIL;
        ignore_parse_value_qualifiers := NIL;
        clp$read_qualified_data_value (parameter_name, access_variable_requests,
              block^.parameters.accesses^ [parameter_number].info.qualifiers, block^.parameters.
              accesses^ [parameter_number].info.descriptor^.header.value, data_value, work_area,
              ignore_type_description, ignore_parse_value_qualifiers, ignore_parse_value_qual_index, status);
      IFEND;
    IFEND;

  PROCEND get_proc_parameter_value;
?? TITLE := 'get_value_element', EJECT ??

  PROCEDURE [INLINE] get_value_element
    (    element_number: integer;
     VAR value {input, output} : ^clt$data_value);

    VAR
      count: integer;


    IF value^.kind <> clc$list THEN
      IF element_number > 1 THEN
        value := NIL;
      IFEND;
      RETURN;
    IFEND;

    count := 0;

    REPEAT
      IF value^.element_value <> NIL THEN
        count := count + 1;
        IF count = element_number THEN
          value := value^.element_value;
          RETURN;
        IFEND;
      IFEND;
      value := value^.link;
    UNTIL value = NIL;

  PROCEND get_value_element;
?? TITLE := 'get_internal_value_element', EJECT ??

  PROCEDURE [INLINE] get_internal_value_element
    (    element_number: integer;
         internal_value: ^clt$internal_data_value;
     VAR i_value {input, output} : ^clt$i_data_value);

    VAR
      count: integer;


    IF i_value^.kind <> clc$list THEN
      IF element_number > 1 THEN
        i_value := NIL;
      IFEND;
      RETURN;
    IFEND;

    count := 0;

    REPEAT
      IF i_value^.element_value <> NIL THEN
        count := count + 1;
        IF count = element_number THEN
          i_value := #PTR (i_value^.element_value, internal_value^);
          RETURN;
        IFEND;
      IFEND;
      i_value := #PTR (i_value^.link, internal_value^);
    UNTIL i_value = NIL;

  PROCEND get_internal_value_element;
?? TITLE := 'get_value_element_count', EJECT ??

  PROCEDURE [INLINE] get_value_element_count
    (    value: ^clt$data_value;
     VAR count: clt$list_size);

    VAR
      current_node: ^clt$data_value;


    IF value^.kind <> clc$list THEN
      count := 1;
      RETURN;
    IFEND;

    current_node := value;
    count := 0;

    WHILE current_node <> NIL DO
      IF current_node^.element_value <> NIL THEN
        count := count + 1;
      IFEND;
      current_node := current_node^.link;
    WHILEND;

  PROCEND get_value_element_count;
?? TITLE := 'get_int_value_element_count', EJECT ??

  PROCEDURE [INLINE] get_int_value_element_count
    (    internal_value: ^clt$internal_data_value;
         i_value: ^clt$i_data_value;
     VAR count: clt$list_size);

    VAR
      current_node: ^clt$i_data_value;


    IF i_value^.kind <> clc$list THEN
      count := 1;
      RETURN;
    IFEND;

    current_node := i_value;
    count := 0;

    WHILE current_node <> NIL DO
      IF current_node^.element_value <> NIL THEN
        count := count + 1;
      IFEND;
      current_node := #PTR (current_node^.link, internal_value^);
    WHILEND;

  PROCEND get_int_value_element_count;
?? TITLE := 'prepare_proc_param_conversion', EJECT ??

  PROCEDURE prepare_proc_param_conversion
    (    command_or_function: clt$command_or_function;
         names: ^clt$pdt_parameter_names;
         accesses: ^clt$parameter_accesses;
     VAR work_area {input, output} : ^clt$work_area;
     VAR pdt: ^clt$unbundled_pdt;
     VAR pvt: ^clt$parameter_value_table;
     VAR status: ost$status);

    VAR
      i: clt$parameter_name_index,
      p: clt$parameter_number,
      preset_header: [STATIC, READ, oss$job_paged_literal] clt$pdt_header :=
            [clc$declaration_version, [87, 10, 15, 0, 0, 0, 0], clc$command, 0, 0, 0, 0, 0, 0, 0, ''],
      preset_parameter: [STATIC, READ, oss$job_paged_literal] clt$pdt_parameter :=
            [1, clc$normal_usage_entry, clc$non_secure_parameter,
            [clc$specify_positionally, clc$specify_by_name], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 0, clc$optional_parameter, 0, 0];

{
{   The pdt generated by this procedure contains only the information needed
{   by clp$internal_convert_to_string for the clc$convert_parameters request.
{

    NEXT pdt IN work_area;
    NEXT pdt^.header IN work_area;
    pdt^.header^ := preset_header;
    pdt^.header^.command_or_function := command_or_function;
    pdt^.header^.number_of_parameters := UPPERBOUND (accesses^);
    pdt^.header^.number_of_parameter_names := UPPERBOUND (names^);
    pdt^.header^.status_parameter_number := 0;
    pdt^.names := names;
    NEXT pdt^.parameters: [1 .. pdt^.header^.number_of_parameters] IN work_area;
    pdt^.type_descriptions := NIL;
    pdt^.default_names := NIL;
    pdt^.default_values := NIL;
    pdt^.header^.number_of_var_parameters := 0;

    NEXT pvt: [1 .. pdt^.header^.number_of_parameters] IN work_area;

    FOR p := 1 TO pdt^.header^.number_of_parameters DO
      pdt^.parameters^ [p] := preset_parameter;
      pdt^.parameters^ [p].name_index := accesses^ [p].name_index;
      pdt^.parameters^ [p].security := accesses^ [p].security;
      pvt^ [p].specified := accesses^ [p].specified;
      IF accesses^ [p].info.access_mode = clc$read_write THEN
        pvt^ [p].passing_method := clc$pass_by_reference;
        pvt^ [p].variable := accesses^ [p].passed_variable_reference;
      ELSE
        pvt^ [p].passing_method := clc$pass_by_value;
        IF (accesses^ [p].info.descriptor = NIL) OR (accesses^ [p].info.descriptor^.header.value = NIL) THEN
          pvt^ [p].value := NIL;
        ELSE
          clp$convert_int_value_to_ext (accesses^ [p].info.descriptor^.header.value,
                accesses^ [p].info.descriptor^.header.value^.header.value, work_area, pvt^ [p].value, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND prepare_proc_param_conversion;

MODEND clm$access_parameters;
