?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Process Procedure Parameters' ??
MODULE clm$process_proc_parameters;

{
{ PURPOSE:
{   This module contains the routines that interpret a command or function
{   procedure's parameter declarations (header) and use the resulting
{   parameter description table (PDT) to evaluate the actual parameter of a
{   to the procedure.
{
{ NOTE:
{   The PDTs for "old style" command PROCedures are translated prior to
{   evaluating actual parameters.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_proc_names
*copyc clc$proc_pdt_parameter_limits
*copyc cle$expecting_proc
*copyc cle$parameters_displayed
*copyc cle$work_area_overflow
*copyc clt$command_line
*copyc clt$command_or_function
*copyc clt$parse_state
*copyc clt$scl_procedure
*copyc clt$scl_procedure_header
*copyc clt$work_area
*copyc ost$status
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$convert_type_desc_to_spec
*copyc clp$display_cmnd_or_func_info
*copyc clp$echo_command
*copyc clp$get_command_line
*copyc clp$internal_evaluate_params
*copyc clp$internal_generate_old_pdt
*copyc clp$internal_generate_pdt
*copyc clp$log_command_line
*copyc clp$prepare_for_log_and_or_echo
*copyc clp$scan_non_space_lexical_unit
*copyc clp$save_evaluated_parameters
*copyc clp$set_input_line_parse
*copyc clp$setup_parameter_evaluation
*copyc clp$translate_pdt
*copyc clp$unbundle_pdt
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
?? TITLE := 'clp$process_proc_parameters', EJECT ??

  PROCEDURE [XDCL] clp$process_proc_parameters
    (    command_or_function: clt$command_or_function;
         proc_data: ^clt$scl_procedure;
         header: ^clt$scl_procedure_header;
         can_be_echoed: boolean;
     VAR parameter_list_parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      command_or_function_name: pmt$program_name,
      end_of_input: boolean,
      ignore_aliases: ^array [1 .. * ] of pmt$program_name,
      ignore_availability: clt$named_entry_availability,
      ignore_command_log_option: clt$command_log_option,
      ignore_command_or_func_scope: clt$command_or_function_scope,
      name: ost$name,
      old_style_proc: boolean,
      parse: clt$parse_state,
      parameter_descrioption_table: ^clt$parameter_description_table,
      pdt: clt$unbundled_pdt;

?? NEWTITLE := 'evaluate_proc_parameters', EJECT ??

    PROCEDURE [INLINE] evaluate_proc_parameters
      (    proc_name: clt$command_name;
           check_parameters_procedure: clt$check_parameters_procedure);

      VAR
        command_reference_text: ^clt$command_line,
        edited_command: ^clt$command_line,
        evaluation_context: clt$parameter_eval_context,
        help_context: clt$parameter_help_context,
        ignore_status: ^ost$status,
        ignore_work_area_ptr: ^^clt$work_area,
        pvt: ^clt$parameter_value_table;


      status.normal := TRUE;

    /evaluate/
      BEGIN
        clp$setup_parameter_evaluation (^pdt, proc_name, TRUE, parameter_list_parse,
              ignore_work_area_ptr, evaluation_context, help_context, status);
        IF NOT status.normal THEN
          EXIT /evaluate/;
        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, status);
          IF status.normal THEN
            osp$set_status_abnormal ('CL', cle$parameters_displayed, '', status);
          IFEND;
          EXIT /evaluate/;
        IFEND;

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

        clp$internal_evaluate_params (evaluation_context, pdt, check_parameters_procedure,
              parameter_list_parse, work_area, pvt, status);

        IF NOT (evaluation_context.command_logging_completed AND evaluation_context.command_echoing_completed)
              THEN
          IF (evaluation_context.interpreter_mode = clc$interpret_mode) AND
                (evaluation_context.prompting_requested) THEN
            command_reference_text := ^parameter_list_parse.text^
                  (evaluation_context.command_or_function_source^.reference_index-1,
                  evaluation_context.command_or_function_source^.reference_size+1);
          ELSE
            command_reference_text := ^parameter_list_parse.text^
                  (evaluation_context.command_or_function_source^.reference_index,
                  evaluation_context.command_or_function_source^.reference_size);
          IFEND;
          clp$prepare_for_log_and_or_echo (command_reference_text, ^pdt, pvt, work_area, 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, FALSE, work_area, status);
      END /evaluate/;

    PROCEND evaluate_proc_parameters;
?? TITLE := 'get_proc_declaration_line', EJECT ??

    PROCEDURE [INLINE] get_proc_declaration_line
      (VAR procedure_declaration {input, output} : ^clt$input_data;
       VAR line: ^clt$command_line;
       VAR status: ost$status);

      VAR
        component_lines_data: ^array [1 .. * ] of cell,
        lexical_units: ^clt$lexical_units,
        line_header: ^clt$input_data_line_header;


      status.normal := TRUE;

      NEXT line_header IN procedure_declaration;
      IF line_header = NIL THEN
        line := NIL;
        RETURN;
      IFEND;

      NEXT line: [line_header^.line_size] IN procedure_declaration;

      IF line_header^.number_of_lexical_units > 0 THEN
        NEXT lexical_units: [1 .. line_header^.number_of_lexical_units] IN procedure_declaration;
      IFEND;

      IF line_header^.size_of_component_lines_data > 0 THEN
        NEXT component_lines_data: [1 .. line_header^.size_of_component_lines_data] IN procedure_declaration;
      IFEND;

    PROCEND get_proc_declaration_line;
?? TITLE := 'get_proc_line', EJECT ??

    PROCEDURE get_proc_line
      (VAR parse: clt$parse_state;
       VAR end_of_input: boolean;
       VAR status: ost$status);


      status.normal := TRUE;

      clp$get_command_line (parse, end_of_input, status);
      IF (NOT status.normal) OR end_of_input THEN
        RETURN;
      IFEND;

      IF status.normal AND can_be_echoed THEN
        clp$echo_command (clc$interpret_mode, parse.text^, status);
      IFEND;

    PROCEND get_proc_line;
?? TITLE := 'handle_compiled_proc', EJECT ??

    PROCEDURE [INLINE] handle_compiled_proc;

      VAR
        check_parameters_procedure: clt$check_parameters_procedure,
        line: ^clt$command_line,
        procedure_declaration: ^clt$input_data;


      IF can_be_echoed THEN
        procedure_declaration := #PTR (header^.procedure_declaration, proc_data^);
        RESET procedure_declaration;

      /echo_procedure_declaration/
        WHILE TRUE DO
          get_proc_declaration_line (procedure_declaration, line, status);
          IF NOT status.normal THEN
            EXIT clp$process_proc_parameters;
          ELSEIF line = NIL THEN
            EXIT /echo_procedure_declaration/;
          IFEND;
          clp$echo_command (clc$interpret_mode, line^, status);
          IF NOT status.normal THEN
            EXIT clp$process_proc_parameters;
          IFEND;
        WHILEND /echo_procedure_declaration/;
      IFEND;

      parameter_descrioption_table := #PTR (header^.parameter_description_table, proc_data^);
      clp$unbundle_pdt (parameter_descrioption_table, work_area, pdt, status);
      IF NOT status.normal THEN
        EXIT clp$process_proc_parameters;
      IFEND;

      check_parameters_procedure := NIL;

      evaluate_proc_parameters (header^.command_or_function_name, check_parameters_procedure);

    PROCEND handle_compiled_proc;
?? TITLE := 'handle_old_pdt', EJECT ??

    PROCEDURE [INLINE] handle_old_pdt;

      VAR
        extra_info_area: ^SEQ (REP clc$proc_pdt_info_area_size of cell),
        i: clt$parameter_number,
        ignore_application_type_present: boolean,
        old_pdt: clt$parameter_descriptor_table,
        parameter_area: ^SEQ (REP clc$max_proc_pdt_parameters of clt$parameter_descriptor),
        parameter_name_area: ^SEQ (REP clc$max_proc_pdt_param_names of clt$parameter_name_descriptor),
        proc_name_area: ^SEQ (REP clc$max_proc_names of ost$name),
        proc_names: ^clt$proc_names,
        symbolic_parameter_area: ^SEQ (REP clc$max_proc_pdt_parameters of clt$symbolic_parameter),
        symbolic_parameters: ^clt$symbolic_parameters,
        type_specification: ^clt$type_specification;


      NEXT proc_name_area IN work_area;
      NEXT parameter_name_area IN work_area;
      NEXT parameter_area IN work_area;
      NEXT symbolic_parameter_area IN work_area;
      NEXT extra_info_area IN work_area;
      IF (proc_name_area = NIL) OR (parameter_name_area = NIL) OR (parameter_area = NIL) OR
            (symbolic_parameter_area = NIL) OR (extra_info_area = NIL) THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT clp$process_proc_parameters;
      IFEND;

      clp$internal_generate_old_pdt ('PROC', ^get_proc_line, work_area, parse, proc_name_area^,
            parameter_name_area^, parameter_area^, symbolic_parameter_area^, extra_info_area^, proc_names,
            old_pdt, symbolic_parameters, status);
      IF NOT status.normal THEN
        EXIT clp$process_proc_parameters;
      IFEND;

      clp$set_input_line_parse (parse);

      clp$translate_pdt (old_pdt, FALSE, FALSE, NIL, NIL, NIL, work_area, ignore_application_type_present,
            pdt, status);
      IF NOT status.normal THEN
        EXIT clp$process_proc_parameters;
      IFEND;

      FOR i := 1 TO pdt.header^.number_of_parameters DO
        clp$convert_type_desc_to_spec (^pdt.type_descriptions^ [i], work_area, type_specification, status);
        IF NOT status.normal THEN
          EXIT clp$process_proc_parameters;
        IFEND;
        pdt.parameters^ [i].type_specification_size := #SIZE (type_specification^);
        pdt.type_descriptions^ [i].specification := type_specification;
      FOREND;

      evaluate_proc_parameters (proc_names^ [1], NIL);

    PROCEND handle_old_pdt;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    IF header <> NIL THEN
      handle_compiled_proc;
      RETURN;
    IFEND;


    REPEAT
      get_proc_line (parse, end_of_input, status);
      IF NOT status.normal THEN
        RETURN;
      ELSEIF end_of_input THEN
        IF command_or_function = clc$command THEN
          osp$set_status_abnormal ('CL', cle$expecting_proc, 'PROCEDURE', status);
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_proc, 'FUNCTION', status);
        IFEND;
        osp$append_status_parameter (osc$status_parameter_delimiter, 'end of input', status);
        RETURN;
      IFEND;
      clp$scan_non_space_lexical_unit (parse);
    UNTIL parse.unit.kind <> clc$lex_end_of_line;

    IF parse.unit.kind <> clc$lex_name THEN
      IF command_or_function = clc$command THEN
        osp$set_status_abnormal ('CL', cle$expecting_proc, 'PROCEDURE', status);
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_proc, 'FUNCTION', status);
      IFEND;
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;
    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
    IF command_or_function = clc$command THEN
      IF name = 'PROC' THEN
        old_style_proc := TRUE;
      ELSEIF name = 'PROCEDURE' THEN
        old_style_proc := FALSE;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_proc, 'PROCEDURE', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
        RETURN;
      IFEND;
    ELSEIF name = 'FUNCTION' THEN
      old_style_proc := FALSE;
    ELSE
      osp$set_status_abnormal ('CL', cle$expecting_proc, 'FUNCTION', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
      RETURN;
    IFEND;


    IF old_style_proc THEN
      handle_old_pdt;
      RETURN;
    IFEND;


    clp$scan_non_space_lexical_unit (parse);

    clp$internal_generate_pdt (command_or_function, ^get_proc_line, NIL, work_area, parse,
          command_or_function_name, ignore_aliases, ignore_availability, ignore_command_or_func_scope,
          ignore_command_log_option, parameter_descrioption_table, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$set_input_line_parse (parse);

    clp$unbundle_pdt (parameter_descrioption_table, work_area, pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    evaluate_proc_parameters (command_or_function_name, NIL);

  PROCEND clp$process_proc_parameters;

MODEND clm$process_proc_parameters;
