?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Parameter List Scanner' ??
MODULE clm$scan_parameter_list;

{
{ PURPOSE:
{   This module contains the original SCL command/function parameter evaluation
{   procedures.  These interfaces have been supplanted by
{   clp$evaluate_parameters but still exist for compatibility with system
{   levels prior to NOS/VE release 1.3.1.
{
{ DESIGN:
{   The (old style) parameter/argument descriptor table (P/ADT) is translated
{   to the internal (unbundled) form of the (new) parameter description table.
{   A "check parameter procedure" is established to handle any "old style"
{   application values.  The internal version of the (new) parameter evaluator
{   is called and (for commands) the results are saved in such a way as to
{   allow the "old style" parameter retrieval routines to work.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$value
*copyc cle$ecc_function_processing
*copyc cle$ecc_parsing
*copyc cle$parameters_displayed
*copyc cle$unable_to_call_av_scanner
*copyc cle$unexpected_call_to
*copyc clk$scan_argument_list
*copyc clk$scan_parameter_list
*copyc clt$argument_descriptor_table
*copyc clt$argument_value_table
*copyc clt$function
*copyc clt$name
*copyc clt$parameter_descriptor_table
*copyc clt$parameter_list
*copyc ost$status
?? POP ??
*copyc clp$convert_clt$value_to_value
*copyc clp$convert_value_to_clt$value
*copyc clp$display_cmnd_or_func_info
*IF NOT $true(osv$unix)
*copyc clp$echo_command
*IFEND
*copyc clp$get_parameter_list_parse
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$internal_evaluate_params
*IF NOT $true(osv$unix)
*copyc clp$log_command_line
*copyc clp$prepare_for_log_and_or_echo
*IFEND
*copyc clp$setup_parameter_evaluation
*copyc clp$save_evaluated_parameters
*copyc clp$scan_non_space_lexical_unit
*copyc clp$translate_adt
*IF NOT $true(osv$unix)
*copyc clp$translate_pdt
*copyc clp$unspecified_av_scanner
*IFEND
*copyc osp$append_status_parameter
*IF NOT $true(osv$unix)
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc pmp$continue_to_cause
*copyc pmp$load
*IFEND

*IF NOT $true(osv$unix)
?? TITLE := 'clp$scan_parameter_list', EJECT ??
*copyc clh$scan_parameter_list

  PROCEDURE [XDCL, #GATE] clp$scan_parameter_list
    (    parameter_list: clt$parameter_list;
         parameter_descriptor_table: clt$parameter_descriptor_table;
     VAR status: ost$status);

    VAR
      application_type_present: boolean,
      check_parameters_procedure: clt$check_parameters_procedure,
      command_reference_text: ^clt$command_line,
      edited_command: ^clt$parameter_list_text,
      evaluation_context: clt$parameter_eval_context,
      help_context: clt$parameter_help_context,
      ignore_status: ^ost$status,
      local_status: ost$status,
      parse: clt$parse_state,
      pdt: ^clt$unbundled_pdt,
      pvt: ^clt$parameter_value_table,
      work_area_ptr: ^^clt$work_area;

?? NEWTITLE := 'handle_application_values', EJECT ??

    PROCEDURE handle_application_values
      (    pvt: ^clt$parameter_value_table;
           which_parameter: clt$which_parameter;
       VAR status: ost$status);

      VAR
        application_value_scanner: ^clt$application_value_scanner,
        callers_save_area: ^ost$stack_frame_save_area,
        loaded_address: pmt$loaded_address,
        scanner_called: boolean,
        value: clt$value,
        vks: ^clt$value_kind_specifier;

*copy  clh$application_value_scanner
?? NEWTITLE := 'bad_av_scanner_pointer_handler', EJECT ??

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


        IF ((condition.selector = pmc$system_conditions) AND
              ((($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
              pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
              pmc$out_call_in_return]) * condition.system_conditions) <> $pmt$system_conditions [])) AND
              (save_area^.minimum_save_area.a2_previous_save_area = callers_save_area) THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, vks^.value_name, status);
          EXIT handle_application_values;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND bad_av_scanner_pointer_handler;
?? TITLE := 'handle_element', EJECT ??

      PROCEDURE [INLINE] handle_element
        (VAR data_value {input, output} : ^clt$data_value);


        IF NOT scanner_called THEN
*IF NOT $true(osv$unix)
          callers_save_area := #PREVIOUS_SAVE_AREA ();
*ELSE
          callers_save_area := NIL;
*IFEND
          #SPOIL (callers_save_area);
          osp$establish_condition_handler (^bad_av_scanner_pointer_handler, FALSE);
        IFEND;

        value.descriptor := vks^.value_name;
        value.kind := clc$application_value;

        application_value_scanner^ (vks^.value_name, vks^.keyword_values, data_value^.application_value^,
              value, status);

        IF NOT scanner_called THEN
          osp$disestablish_cond_handler;
          scanner_called := TRUE;
        IFEND;

        IF status.normal THEN
          clp$convert_clt$value_to_value (value, work_area_ptr^, data_value, status);
        IFEND;

        IF NOT status.normal THEN
          EXIT handle_application_values;
        IFEND;

      PROCEND handle_element;
?? TITLE := 'handle_list', EJECT ??

      PROCEDURE handle_list
        (    list_value: ^clt$data_value);

        VAR
          current_node: ^clt$data_value;


        current_node := list_value;
        REPEAT
          IF current_node^.element_value <> NIL THEN
            CASE current_node^.element_value^.kind OF
            = clc$application =
              handle_element (current_node^.element_value);
            = clc$list =
              handle_list (current_node^.element_value);
            = clc$range =
              handle_range (current_node^.element_value);
            ELSE
              ;
            CASEND;
          IFEND;
          current_node := current_node^.link;
        UNTIL current_node = NIL;

      PROCEND handle_list;
?? TITLE := 'handle_range', EJECT ??

      PROCEDURE [INLINE] handle_range
        (    range_value: ^clt$data_value);

        VAR
          range_specified: boolean;


        IF range_value^.low_value <> NIL THEN
          range_specified := (range_value^.high_value <> NIL) AND
                (range_value^.high_value <> range_value^.low_value);

          IF range_value^.low_value^.kind = clc$application THEN
            handle_element (range_value^.low_value);
          IFEND;

          IF NOT range_specified THEN
            range_value^.high_value := range_value^.low_value;
          ELSEIF range_value^.high_value^.kind = clc$application THEN
            handle_element (range_value^.high_value);
          IFEND;
        IFEND;

      PROCEND handle_range;
?? OLDTITLE, EJECT ??

      status.normal := TRUE;
      IF (NOT which_parameter.specific) OR (pvt^ [which_parameter.number].passing_method =
            clc$pass_by_reference) THEN
        RETURN;
      IFEND;

      vks := ^parameter_descriptor_table.parameters^ [which_parameter.number].value_kind_specifier;

      IF (pvt^ [which_parameter.number].value = NIL) OR (vks^.kind <> clc$application_value) THEN
        RETURN;
      IFEND;

      CASE vks^.scanner.kind OF
      = clc$linked_av_scanner =
        application_value_scanner := vks^.scanner.proc;
      = clc$unlinked_av_scanner =
        pmp$load (vks^.scanner.name, pmc$procedure_address, loaded_address, status);
        IF NOT status.normal THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, vks^.value_name, status);
          RETURN;
        IFEND;
        #CONVERT_POINTER_TO_PROCEDURE (loaded_address.pointer_to_procedure, application_value_scanner);
      ELSE
        application_value_scanner := ^clp$unspecified_av_scanner;
      CASEND;

      scanner_called := FALSE;

      CASE pvt^ [which_parameter.number].value^.kind OF
      = clc$application =
        handle_element (pvt^ [which_parameter.number].value);
      = clc$list =
        handle_list (pvt^ [which_parameter.number].value);
      = clc$range =
        handle_range (pvt^ [which_parameter.number].value);
      ELSE
        ;
      CASEND;

    PROCEND handle_application_values;
?? OLDTITLE, EJECT ??

    #KEYPOINT (osk$entry, 0, clk$scan_parameter_list);

    status.normal := TRUE;
    local_status.normal := TRUE;

  /scan/
    BEGIN
      clp$setup_parameter_evaluation (NIL, osc$null_name, TRUE, parse, work_area_ptr,
            evaluation_context, help_context, local_status);
      IF NOT local_status.normal THEN
        IF local_status.condition = cle$unexpected_call_to THEN
          local_status.text.size := 0;
          osp$append_status_parameter (osc$status_parameter_delimiter, 'clp$evaluate_parameters',
                local_status);
        IFEND;
        EXIT /scan/;
      IFEND;

      IF parse.text = NIL THEN
        command_reference_text := NIL;
      ELSE
        IF (evaluation_context.interpreter_mode = clc$interpret_mode) AND
              (evaluation_context.prompting_requested) THEN
          command_reference_text := ^parse.text^ (evaluation_context.command_or_function_source^.
                reference_index-1, evaluation_context.command_or_function_source^.reference_size+1);
        ELSE
          command_reference_text := ^parse.text^ (evaluation_context.command_or_function_source^.
                reference_index, evaluation_context.command_or_function_source^.reference_size);
        IFEND;
      IFEND;

      clp$get_parameter_list_parse (^parameter_list, work_area_ptr^, parse, local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
      IFEND;

      NEXT pdt IN work_area_ptr^;
      clp$translate_pdt (parameter_descriptor_table, TRUE, FALSE, NIL, NIL, NIL, work_area_ptr^,
            application_type_present, pdt^, local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
      ELSEIF application_type_present THEN
        check_parameters_procedure := ^handle_application_values;
      ELSE
        check_parameters_procedure := NIL;
      IFEND;

      IF (evaluation_context.interpreter_mode = clc$help_mode) AND (help_context.help_output_file <> NIL) THEN
        clp$display_cmnd_or_func_info (fsc$list, help_context, evaluation_context.command_or_function_source^,
              evaluation_context.command_or_function_name, pdt^, local_status);
        IF local_status.normal THEN
          osp$set_status_abnormal ('CL', cle$parameters_displayed, '', local_status);
        IFEND;
        EXIT /scan/;
      IFEND;

      IF pdt^.header^.number_of_parameters = 0 THEN
        pvt := NIL;
      ELSE
        NEXT pvt: [1 .. pdt^.header^.number_of_parameters] IN work_area_ptr^;
      IFEND;

      clp$internal_evaluate_params (evaluation_context, pdt^, check_parameters_procedure, parse,
            work_area_ptr^, pvt, local_status);

      IF NOT (evaluation_context.command_logging_completed AND evaluation_context.command_echoing_completed)
            THEN
        clp$prepare_for_log_and_or_echo (command_reference_text, pdt, pvt, work_area_ptr^, edited_command);
        PUSH ignore_status;
        IF NOT evaluation_context.command_logging_completed THEN
          clp$log_command_line (edited_command^, ignore_status^);
        IFEND;
        IF NOT evaluation_context.command_echoing_completed THEN
          clp$echo_command (evaluation_context.interpreter_mode, edited_command^, ignore_status^);
        IFEND;
      IFEND;

      clp$save_evaluated_parameters (pdt, pvt, TRUE, work_area_ptr^, local_status);
    END /scan/;

    IF local_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := local_status;
    IFEND;

    #KEYPOINT (osk$exit, 0, clk$scan_parameter_list);

  PROCEND clp$scan_parameter_list;
*IFEND
?? TITLE := 'clp$scan_argument_list', EJECT ??
*copyc clh$scan_argument_list

  PROCEDURE [XDCL, #GATE] clp$scan_argument_list
    (    function_name: clt$name;
         argument_list: string ( * );
         argument_descriptor_table: ^clt$argument_descriptor_table;
         argument_value_table: ^clt$argument_value_table;
     VAR status: ost$status);

    VAR
      application_type_present: boolean,
      check_parameters_procedure: clt$check_parameters_procedure,
      evaluation_context: clt$parameter_eval_context,
      help_context: clt$parameter_help_context,
      lexical_units: ^clt$lexical_units,
      local_status: ost$status,
      p: clt$parameter_number,
      parse: clt$parse_state,
      pdt: ^clt$unbundled_pdt,
      pvt: ^clt$parameter_value_table,
      work_area_ptr: ^^clt$work_area;

*IF NOT $true(osv$unix)
?? NEWTITLE := 'handle_application_values', EJECT ??

    PROCEDURE handle_application_values
      (    pvt: ^clt$parameter_value_table;
           which_parameter: clt$which_parameter;
       VAR status: ost$status);

      VAR
        application_value_scanner: ^clt$application_value_scanner,
        callers_save_area: ^ost$stack_frame_save_area,
        loaded_address: pmt$loaded_address,
        scanner_called: boolean,
        value: clt$value,
        vks: ^clt$value_kind_specifier;

*copy  clh$application_value_scanner
?? NEWTITLE := 'bad_av_scanner_pointer_handler', EJECT ??

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


        IF ((condition.selector = pmc$system_conditions) AND
              ((($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
              pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
              pmc$out_call_in_return]) * condition.system_conditions) <> $pmt$system_conditions [])) AND
              (save_area^.minimum_save_area.a2_previous_save_area = callers_save_area) THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, vks^.value_name, status);
          EXIT handle_application_values;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND bad_av_scanner_pointer_handler;
?? OLDTITLE, EJECT ??

      status.normal := TRUE;
      IF NOT which_parameter.specific THEN
        RETURN;
      IFEND;

      vks := ^argument_descriptor_table^ [which_parameter.number].value_kind_specifier;

      IF (pvt^ [which_parameter.number].value = NIL) OR (pvt^ [which_parameter.number].value^.kind <>
            clc$application) THEN
        RETURN;
      IFEND;

      CASE vks^.scanner.kind OF
      = clc$linked_av_scanner =
        application_value_scanner := vks^.scanner.proc;
      = clc$unlinked_av_scanner =
        pmp$load (vks^.scanner.name, pmc$procedure_address, loaded_address, status);
        IF NOT status.normal THEN
          osp$set_status_abnormal ('CL', cle$unable_to_call_av_scanner, vks^.value_name, status);
          RETURN;
        IFEND;
        #CONVERT_POINTER_TO_PROCEDURE (loaded_address.pointer_to_procedure, application_value_scanner);
      ELSE
        application_value_scanner := ^clp$unspecified_av_scanner;
      CASEND;

*IF NOT $true(osv$unix)
      callers_save_area := #PREVIOUS_SAVE_AREA ();
*ELSE
      callers_save_area := NIL;
*IFEND
      #SPOIL (callers_save_area);
      osp$establish_condition_handler (^bad_av_scanner_pointer_handler, FALSE);

      value.descriptor := vks^.value_name;
      value.kind := clc$application_value;

      application_value_scanner^ (vks^.value_name, vks^.keyword_values,
            pvt^ [which_parameter.number].value^.application_value^, value, status);

      osp$disestablish_cond_handler;

      IF status.normal THEN
        clp$convert_clt$value_to_value (value, work_area_ptr^, pvt^ [which_parameter.number].value, status);
      IFEND;

    PROCEND handle_application_values;
*IFEND
?? OLDTITLE, EJECT ??

    #KEYPOINT (osk$entry, 0, clk$scan_argument_list);

    status.normal := TRUE;
    local_status.normal := TRUE;

  /scan/
    BEGIN
      IF (argument_descriptor_table = NIL) AND (argument_value_table <> NIL) THEN
        osp$set_status_abnormal ('CL', cle$bad_adt, 'ADT is NIL but AVT is not', status);
      ELSEIF (argument_descriptor_table <> NIL) AND (argument_value_table = NIL) THEN
        osp$set_status_abnormal ('CL', cle$bad_adt, 'ADT is not NIL but AVT is', status);
      ELSEIF (argument_descriptor_table <> NIL) AND (UPPERBOUND (argument_descriptor_table^) >
            clc$max_arguments) THEN
        osp$set_status_abnormal ('CL', cle$bad_adt, 'too many arguments', status);
      ELSEIF (argument_descriptor_table <> NIL) AND (UPPERBOUND (argument_descriptor_table^) <>
            UPPERBOUND (argument_value_table^)) THEN
        osp$set_status_abnormal ('CL', cle$bad_adt, 'ADT and AVT are not same size', status);
      IFEND;
      IF NOT status.normal THEN
        osp$append_status_parameter (osc$status_parameter_delimiter, function_name.value, status);
        EXIT /scan/;
      IFEND;

      clp$setup_parameter_evaluation (NIL, osc$null_name, TRUE, parse, work_area_ptr,
            evaluation_context, help_context, local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
      IFEND;

      clp$identify_lexical_units (^argument_list, work_area_ptr^, lexical_units, local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
      IFEND;
      clp$initialize_parse_state (^argument_list, lexical_units, parse);
      clp$scan_non_space_lexical_unit (parse);

      NEXT pdt IN work_area_ptr^;
      clp$translate_adt (argument_descriptor_table, FALSE, work_area_ptr^, application_type_present, pdt^,
            local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
*IF NOT $true(osv$unix)
      ELSEIF application_type_present THEN
        check_parameters_procedure := ^handle_application_values;
*IFEND
      ELSE
        check_parameters_procedure := NIL;
      IFEND;

      IF evaluation_context.interpreter_mode = clc$help_mode THEN
        clp$display_cmnd_or_func_info (fsc$list, help_context, evaluation_context.command_or_function_source^,
              evaluation_context.command_or_function_name, pdt^, local_status);
        IF local_status.normal THEN
          osp$set_status_abnormal ('CL', cle$parameters_displayed, '', local_status);
        IFEND;
        EXIT /scan/;
      IFEND;

      IF pdt^.header^.number_of_parameters = 0 THEN
        pvt := NIL;
      ELSE
        NEXT pvt: [1 .. pdt^.header^.number_of_parameters] IN work_area_ptr^;
      IFEND;

      clp$internal_evaluate_params (evaluation_context, pdt^, check_parameters_procedure, parse,
            work_area_ptr^, pvt, local_status);
      IF NOT local_status.normal THEN
        EXIT /scan/;
      IFEND;

      IF pdt^.header^.number_of_parameters > 0 THEN
        FOR p := 1 TO UPPERBOUND (argument_value_table^) DO
          clp$convert_value_to_clt$value (pvt^ [p].value, 1, 1, clc$low, argument_value_table^ [p],
                local_status);
          IF NOT local_status.normal THEN
            EXIT /scan/;
          IFEND;
        FOREND;
      IFEND;

      clp$save_evaluated_parameters (pdt, pvt, FALSE, work_area_ptr^, local_status);
    END /scan/;

    IF local_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := local_status;
    IFEND;

*IF NOT $true(osv$unix)
    #KEYPOINT (osk$exit, 0, clk$scan_argument_list);
*IFEND

  PROCEND clp$scan_argument_list;

MODEND clm$scan_parameter_list;
