?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Display Parameters of SCL Procedure in Object Library' ??
MODULE clm$display_scl_proc_parameters;

{
{ PURPOSE:
{   This module contains the procedure that displays the parameters for an
{   SCL Procedure that resides on an object library.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_proc_names
*copyc clc$proc_pdt_parameter_limits
*copyc cle$ecc_command_processing
*copyc cle$expecting_proc
*copyc clt$display_control
*copyc clt$scl_procedure
*copyc clt$scl_procedure_header
*copyc ost$status
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$internal_convert_to_string
*copyc clp$internal_generate_old_pdt
*copyc clp$put_display
*copyc clp$scan_non_space_lexical_unit
*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$display_scl_proc_parameters', EJECT ??

  PROCEDURE [XDCL] clp$display_scl_proc_parameters
    (VAR display_control {input, output} : clt$display_control;
         scl_procedure: ^clt$scl_procedure;
     VAR status: ost$status);

    VAR
      local_scl_procedure: ^clt$scl_procedure,
      original_work_area: ^clt$work_area,
      pdt: clt$unbundled_pdt,
      representation: ^clt$data_representation,
      scl_procedure_header: ^clt$scl_procedure_header,
      version: clt$declaration_version,
      work_area: ^^clt$work_area;

?? NEWTITLE := 'format_pdt', EJECT ??

    PROCEDURE [INLINE] format_pdt;

      VAR
        request: clt$convert_to_string_request;


      request.initial_indentation := 2;
      request.continuation_indentation := 8;
      request.max_string := display_control.page_width;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_unbundled_pdt;
      request.multi_line_pdt_format := TRUE;
      request.parameter_starts_line := TRUE;
      request.individual_parameter := FALSE;
      request.individual_parameter_number := LOWERVALUE (clt$parameter_number);
      request.include_header := FALSE;
      request.command_or_function_name := osc$null_name;
      request.aliases := NIL;
      request.availability := clc$normal_usage_entry;
      request.command_or_function_scope := clc$xdcl_command_or_function;
      request.pdt := ^pdt;
      request.pvt := NIL;
      request.symbolic_pdt_qualifiers_area := NIL;
      request.include_implementation_info := TRUE;

      clp$internal_convert_to_string (request, work_area^, representation, status);

    PROCEND format_pdt;
?? TITLE := 'prepare_old_pdt', EJECT ??

    PROCEDURE prepare_old_pdt;

      VAR
        end_of_input: boolean,
        extra_info_area: ^SEQ (REP clc$proc_pdt_info_area_size of cell),
        ignore_application_type_present: boolean,
        lexical_units_work_area: ^clt$work_area,
        line: ost$string,
        name: ost$name,
        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),
        parse: clt$parse_state,
        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;

?? NEWTITLE := 'get_command_line', EJECT ??

      PROCEDURE get_command_line
        (VAR line: ost$string;
         VAR end_of_input: boolean;
         VAR status: ost$status);

        VAR
          line_continued: boolean,
          continuation_line: ost$string;


        get_data_line (line, end_of_input, status);
        IF (NOT status.normal) OR end_of_input THEN
          RETURN;
        IFEND;

        IF (line.size >= 2) AND (line.value (line.size - 1, 2) = '..') THEN
          line.size := line.size - 2;
          WHILE (line.size > 0) AND (line.value (line.size) = '.') DO
            line.size := line.size - 1;
          WHILEND;
          REPEAT
            get_data_line (continuation_line, end_of_input, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            IF end_of_input THEN
              osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '', status);
              RETURN;
            IFEND;
            line_continued := (continuation_line.size >= 2) AND
                  (continuation_line.value (continuation_line.size - 1, 2) = '..');
            IF line_continued THEN
              continuation_line.size := continuation_line.size - 2;
              WHILE (continuation_line.size > 0) AND (continuation_line.value (continuation_line.size) =
                    '.') DO
                continuation_line.size := continuation_line.size - 1;
              WHILEND;
            IFEND;
            IF (line.size + continuation_line.size) > osc$max_string_size THEN
              osp$set_status_abnormal ('CL', cle$continued_line_too_long, '', status);
              RETURN;
            IFEND;
            line.value (line.size + 1, continuation_line.size) :=
                  continuation_line.value (1, continuation_line.size);
            line.size := line.size + continuation_line.size;
          UNTIL NOT line_continued;
        IFEND;

      PROCEND get_command_line;
?? TITLE := 'get_data_line', EJECT ??

      PROCEDURE get_data_line
        (VAR line: ost$string;
         VAR end_of_input: boolean;
         VAR status: ost$status);

        VAR
          procedure_line_size: ^ost$string_size,
          procedure_line: ^string ( * );


        status.normal := TRUE;
        end_of_input := TRUE;
        NEXT procedure_line_size IN local_scl_procedure;
        IF procedure_line_size = NIL THEN
          RETURN;
        IFEND;
        NEXT procedure_line: [procedure_line_size^] IN local_scl_procedure;
        IF procedure_line = NIL THEN
          RETURN;
        IFEND;
        line.size := procedure_line_size^;
        line.value := procedure_line^;
        end_of_input := FALSE;

      PROCEND get_data_line;
?? TITLE := 'get_old_proc_line', EJECT ??

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

        VAR
          lexical_units: ^clt$lexical_units;


        get_command_line (line, end_of_input, status);
        IF (NOT status.normal) OR end_of_input THEN
          RETURN;
        IFEND;

        RESET lexical_units_work_area;
        clp$identify_lexical_units (^line.value (1, line.size), lexical_units_work_area, lexical_units,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        clp$initialize_parse_state (^line.value (1, line.size), lexical_units, parse);

      PROCEND get_old_proc_line;
?? OLDTITLE, EJECT ??

      PUSH lexical_units_work_area: [[REP osc$max_string_size + clc$lexical_units_size_pad OF cell]];

      PUSH proc_name_area;
      PUSH parameter_name_area;
      PUSH parameter_area;
      PUSH symbolic_parameter_area;
      PUSH extra_info_area;

      REPEAT
        get_old_proc_line (parse, end_of_input, status);
        IF (NOT status.normal) OR end_of_input THEN
          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
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name <> 'PROC' THEN
          osp$set_status_abnormal ('CL', cle$expecting_proc, 'PROC', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          RETURN;
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_proc, 'PROC', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN;
      IFEND;

      clp$internal_generate_old_pdt ('PROC', ^get_old_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
        RETURN;
      IFEND;

      clp$translate_pdt (old_pdt, FALSE, FALSE, NIL, NIL, NIL, work_area^, ignore_application_type_present,
            pdt, status);

    PROCEND prepare_old_pdt;
?? TITLE := 'prepare_pdt', EJECT ??

    PROCEDURE [INLINE] prepare_pdt;

      VAR
        parameter_description_table: ^clt$parameter_description_table;


      parameter_description_table := #PTR (scl_procedure_header^.parameter_description_table,
            local_scl_procedure^);
      RESET parameter_description_table;

      clp$unbundle_pdt (parameter_description_table, work_area^, pdt, status);

    PROCEND prepare_pdt;
?? TITLE := 'put_representation', EJECT ??

    PROCEDURE [INLINE] put_representation;

      VAR
        representation_line: ^clt$string_value,
        representation_line_count: ^clt$data_representation_count,
        representation_line_index: clt$data_representation_count,
        representation_line_size: ^clt$string_size;


      RESET representation;
      NEXT representation_line_count IN representation;

      FOR representation_line_index := 1 TO representation_line_count^ DO
        NEXT representation_line_size IN representation;
        NEXT representation_line: [representation_line_size^] IN representation;
        clp$put_display (display_control, representation_line^, clc$no_trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

    PROCEND put_representation;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    local_scl_procedure := scl_procedure;
    RESET local_scl_procedure;

    NEXT scl_procedure_header IN local_scl_procedure;
    IF (scl_procedure_header = NIL) OR (scl_procedure_header^.identifying_first_byte <>
          UPPERVALUE (scl_procedure_header^.identifying_first_byte)) THEN
      version := 0;
      RESET local_scl_procedure;
    ELSE
      version := scl_procedure_header^.version;
    IFEND;

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

  /display_scl_proc_parameters/
    BEGIN
      IF version = 0 THEN
        prepare_old_pdt;
      ELSE
        prepare_pdt;
      IFEND;
      IF NOT status.normal THEN
        EXIT /display_scl_proc_parameters/;
      IFEND;

      format_pdt;
      IF NOT status.normal THEN
        EXIT /display_scl_proc_parameters/;
      IFEND;

      put_representation;
    END /display_scl_proc_parameters/;

    work_area^ := original_work_area;

  PROCEND clp$display_scl_proc_parameters;

MODEND clm$display_scl_proc_parameters;
