?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Parameter Description Table and TYPE generator' ??
MODULE clm$generate_pdt_and_type;

{
{ PURPOSE:
{   This module contains the Parameter Description Table generator for an SCL
{   command (procedure) or function, and the generator for a TYPE specification.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$declaration_version
*copyc clc$max_integer
*copyc clc$max_proc_names
*copyc clc$min_integer
*copyc cle$ecc_lexical
*copyc cle$ecc_parsing
*copyc cle$eoi_in_declaration
*copyc cle$unable_to_call_input_proc
*copyc cle$work_area_overflow
*copyc clk$procedure_keypoints
*copyc clt$command_log_option
*copyc clt$command_line
*copyc clt$command_line_size
*copyc clt$command_line_index
*copyc clt$command_or_function
*copyc clt$command_or_function_scope
*copyc clt$input_procedure
*copyc clt$internal_input_procedure
*copyc clt$parameter_description_table
*copyc clt$symbolic_subrange_qualifier
*copyc clt$type_name
*copyc clt$type_specification
*copyc clt$variable_name_reference
*copyc clt$work_area
*IF NOT $true(osv$unix)
*copyc oss$job_paged_literal
*IFEND
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$evaluate_integer_expression
*IF NOT $true(osv$unix)
*copyc clp$evaluate_name
*copyc clp$evaluate_real_expression
*IFEND
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*IF NOT $true(osv$unix)
*copyc clp$longreal_compare_gt
*copyc clp$longreal_compare_le
*copyc clp$longreal_compare_lt
*IFEND
*copyc clp$scan_any_lexical_unit
*copyc clp$scan_non_space_lexical_unit
*copyc clp$scan_unnested_rel_lex_unit
*copyc clp$scan_unnested_sep_lex_unit
*copyc clp$trimmed_string_size
*copyc clv$negative_infinity
*copyc clv$positive_infinity
*copyc clv$type_kind_names
*copyc i#current_sequence_position
*copyc osp$append_status_parameter
*IF NOT $true(osv$unix)
*copyc osp$establish_condition_handler
*copyc osp$disestablish_cond_handler
*IFEND
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc pmp$get_compact_date_time
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
*IFEND
?? EJECT ??

  TYPE
    clt$declaration_identifier = string (9) {'procedure', 'function', 'type'} ;

  TYPE
    clt$declaration_context = record
      kind: (clc$procedure_declaration, clc$function_declaration, clc$type_declaration),
      identifier: clt$declaration_identifier,
      unspecified_type_allowed: boolean,
      list_rest_allowed: boolean,
      list_rest_encountered: boolean,
    recend;

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

  PROCEDURE [XDCL, #GATE] clp$generate_pdt
    (    command_or_function: clt$command_or_function;
         first_line: ^clt$command_line;
         first_line_index: clt$command_line_index;
         get_line: clt$input_procedure;
     VAR work_area {input, output} : ^clt$work_area;
     VAR last_line: ^clt$command_line;
     VAR last_line_index: clt$command_line_index;
     VAR command_or_function_name: pmt$program_name;
     VAR aliases: ^array [1 .. * ] of pmt$program_name;
     VAR availability: clt$named_entry_availability;
     VAR command_or_function_scope: clt$command_or_function_scope;
     VAR command_log_option: clt$command_log_option;
     VAR parameter_description_table: ^clt$parameter_description_table;
     VAR status: ost$status);

    VAR
      declaration_identifier: clt$declaration_identifier,
      get_line_called: boolean,
      lexical_units: ^clt$lexical_units,
      lexical_work_area: ^^clt$work_area,
      local_status: ost$status,
      parse: clt$parse_state;

?? NEWTITLE := 'get_pdt_line', EJECT ??

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

*IF NOT $true(osv$unix)
      VAR
        callers_save_area: ^ost$stack_frame_save_area;

?? NEWTITLE := 'bad_input_proc_pointer_handler', EJECT ??

      PROCEDURE bad_input_proc_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 []) THEN
          IF save_area^.minimum_save_area.a2_previous_save_area = callers_save_area THEN
            osp$set_status_abnormal ('CL', cle$unable_to_call_input_proc, 'clp$generate_pdt', status);
            EXIT get_pdt_line;
          IFEND;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        handler_status.normal := TRUE;

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

      VAR
        line: ^clt$command_line;


      end_of_input := FALSE;

      IF get_line = NIL THEN
        end_of_input := TRUE;
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, declaration_identifier, status);
        RETURN;
      IFEND;

      REPEAT
        REPEAT

*IF NOT $true(osv$unix)
          IF NOT get_line_called THEN
            callers_save_area := #PREVIOUS_SAVE_AREA ();
            osp$establish_condition_handler (^bad_input_proc_pointer_handler, FALSE);
          IFEND;
*IFEND
          get_line^ (line, status);
          IF NOT get_line_called THEN
*IF NOT $true(osv$unix)
            osp$disestablish_cond_handler;
*IFEND
            get_line_called := TRUE;
          IFEND;

          IF NOT status.normal THEN
            RETURN;
          ELSEIF line = NIL THEN
            end_of_input := TRUE;
            osp$set_status_abnormal ('CL', cle$eoi_in_declaration, declaration_identifier, status);
            RETURN;
          IFEND;
        UNTIL STRLENGTH (line^) > 0;

        RESET lexical_work_area^ TO lexical_units;
        clp$identify_lexical_units (line, lexical_work_area^, lexical_units, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$initialize_parse_state (line, lexical_units, parse);
      UNTIL parse.unit.kind <> clc$lex_end_of_line;

    PROCEND get_pdt_line;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    local_status.normal := TRUE;
    get_line_called := FALSE;
    IF command_or_function = clc$command THEN
      declaration_identifier := 'procedure';
    ELSE
      declaration_identifier := 'function';
    IFEND;

  /generate_pdt/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^parse), lexical_work_area, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, lexical_work_area, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /generate_pdt/;
      IFEND;

      clp$identify_lexical_units (first_line, lexical_work_area^, lexical_units, local_status);
      IF NOT local_status.normal THEN
        EXIT /generate_pdt/;
      IFEND;

      clp$initialize_parse_state (first_line, lexical_units, parse);
      REPEAT
        clp$scan_any_lexical_unit (parse);
      UNTIL (parse.unit_index >= first_line_index) OR (parse.unit_index >= parse.index_limit);

      clp$internal_generate_pdt (command_or_function, ^get_pdt_line, NIL, work_area, parse,
            command_or_function_name, aliases, availability, command_or_function_scope, command_log_option,
            parameter_description_table, local_status);

      RESET lexical_work_area^ TO lexical_units;

      last_line := parse.text;
      last_line_index := parse.unit_index;
    END /generate_pdt/;

    IF NOT local_status.normal THEN
      IF local_status.condition = cle$work_area_overflow THEN
        local_status.text.size := 0;
        osp$append_status_parameter (osc$status_parameter_delimiter, 'clp$generate_pdt', local_status);
      IFEND;
      status := local_status;
    IFEND;

  PROCEND clp$generate_pdt;
?? TITLE := 'clp$internal_generate_pdt', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$internal_generate_pdt
    (    command_or_function: clt$command_or_function;
         get_line: clt$internal_input_procedure;
         symbolic_qualifiers_area: ^clt$work_area;
     VAR work_area {input, output} : ^clt$work_area;
     VAR parse {input, output} : clt$parse_state;
     VAR command_or_function_name: pmt$program_name;
     VAR aliases: ^array [1 .. * ] of pmt$program_name;
     VAR availability: clt$named_entry_availability;
     VAR command_or_function_scope: clt$command_or_function_scope;
     VAR command_log_option: clt$command_log_option;
     VAR parameter_description_table: ^clt$parameter_description_table;
     VAR status: ost$status);


    TYPE
      clt$parameter_header = record
        next_parameter: ^clt$parameter_header,
        number_of_names: clt$parameter_name_count,
        names: ^clt$pdt_parameter_names,
      recend;


    VAR
      context: clt$declaration_context,
      first_parameter: ^clt$parameter_header,
      help_module_name: pmt$program_name,
      number_of_advanced_parameters: clt$parameter_count,
      number_of_hidden_parameters: clt$parameter_count,
      number_of_parameter_names: clt$parameter_name_count,
      number_of_parameters: clt$parameter_count,
      number_of_required_parameters: clt$parameter_count,
      number_of_var_parameters: clt$parameter_count,
      status_parameter_number: 0 .. clc$max_parameters,
      symbolic_qualifiers_work_area: ^clt$work_area;

?? NEWTITLE := 'finalize_pdt', EJECT ??

    PROCEDURE finalize_pdt;

?? NEWTITLE := 'sort_parameter_names', EJECT ??

      PROCEDURE [INLINE] sort_parameter_names;

        VAR
          current: -clc$max_parameter_names .. clc$max_parameter_names,
          gap: clt$parameter_name_index,
          start: clt$parameter_name_index,
          swap: clt$pdt_parameter_name;


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

      PROCEND sort_parameter_names;
?? OLDTITLE, EJECT ??

      VAR
        default_name: ^clt$variable_name_reference,
        default_value: ^clt$expression_text,
        i: clt$parameter_name_index,
        intermediate_pdt: ^clt$work_area,
*IF $true(osv$unix)
        kludge_pdt: ^array[*] of cell,
*IFEND
        n: clt$parameter_name_count,
        original_intermediate_pdt: ^clt$work_area,
        p: clt$parameter_number,
        parameter: ^clt$pdt_parameter,
        parameter_header: ^clt$parameter_header,
        parameter_names: ^clt$pdt_parameter_names,
        pdt_default_name: ^clt$variable_name_reference,
        pdt_default_value: ^clt$expression_text,
        pdt_header: ^clt$pdt_header,
        pdt_parameters: ^clt$pdt_parameters,
        pdt_parameter_names: ^clt$pdt_parameter_names,
        pdt_size: integer,
        pdt_type_specification: ^clt$type_specification,
        type_specification: ^clt$type_specification;


      IF number_of_parameters = 0 THEN
*IF NOT $true(osv$unix)
        pdt_size := #SIZE (clt$pdt_header);
*ELSE
        pdt_size := ((3 + #SIZE (clt$pdt_header)) DIV 4) * 4;
*IFEND
      ELSE
        pdt_size := i#current_sequence_position (work_area);
        RESET work_area TO first_parameter;
        pdt_size := pdt_size - i#current_sequence_position (work_area);
*IF $true(osv$unix)
        NEXT kludge_pdt: [1 .. pdt_size] IN work_area;
        original_intermediate_pdt := #SEQ (kludge_pdt^);
*ELSE
        NEXT original_intermediate_pdt: [[REP pdt_size OF cell]] IN work_area;
*IFEND
        RESET work_area TO first_parameter;
*IF $true(osv$unix)
        PUSH kludge_pdt: [1 .. pdt_size];
        intermediate_pdt := #SEQ (kludge_pdt^);
*ELSE
        PUSH intermediate_pdt: [[REP pdt_size OF cell]];
*IFEND
        RESET intermediate_pdt;
        intermediate_pdt^ := original_intermediate_pdt^;
*IF NOT $true(osv$unix)
        pdt_size := #SIZE (clt$pdt_header) + pdt_size - (number_of_parameters * #SIZE (clt$parameter_header));
*ELSE
        pdt_size := ((3 + (#SIZE (clt$pdt_header) + pdt_size -
              (number_of_parameters * #SIZE (clt$parameter_header)))) DIV 4) *
              4 + 100;
*IFEND
      IFEND;

      NEXT parameter_description_table: [[REP pdt_size OF cell]] IN work_area;
      IF parameter_description_table = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT clp$internal_generate_pdt;
      IFEND;
      RESET parameter_description_table;
      NEXT pdt_header IN parameter_description_table;

      pdt_header^.version := clc$declaration_version;
      pmp$get_compact_date_time (pdt_header^.generation_date_time, status);
      IF NOT status.normal THEN
        EXIT clp$internal_generate_pdt;
      IFEND;
      pdt_header^.command_or_function := command_or_function;
      pdt_header^.number_of_parameter_names := number_of_parameter_names;
      pdt_header^.number_of_parameters := number_of_parameters;
      pdt_header^.number_of_required_parameters := number_of_required_parameters;
      pdt_header^.number_of_advanced_parameters := number_of_advanced_parameters;
      pdt_header^.number_of_hidden_parameters := number_of_hidden_parameters;
      pdt_header^.number_of_var_parameters := number_of_var_parameters;
      pdt_header^.status_parameter_number := status_parameter_number;
      pdt_header^.help_module_name := help_module_name;

      IF number_of_parameters = 0 THEN
        RESET parameter_description_table;
        RETURN;
      IFEND;


      NEXT pdt_parameter_names: [1 .. number_of_parameter_names] IN parameter_description_table;
      NEXT pdt_parameters: [1 .. number_of_parameters] IN parameter_description_table;
      n := 0;

    /copy_intermediate_to_final/
      FOR p := 1 TO number_of_parameters DO
        NEXT parameter_header IN intermediate_pdt;

        NEXT parameter IN intermediate_pdt;
        pdt_parameters^ [p] := parameter^;

        NEXT parameter_names: [1 .. parameter_header^.number_of_names] IN intermediate_pdt;
        FOR i := 1 TO parameter_header^.number_of_names DO
          n := n + 1;
          pdt_parameter_names^ [n] := parameter_names^ [i];
        FOREND;

*IF $true(osv$unix)
        NEXT kludge_pdt: [1 .. parameter^.type_specification_size] IN intermediate_pdt;
        type_specification := #SEQ (kludge_pdt^);
*ELSE
        NEXT type_specification: [[REP parameter^.type_specification_size OF cell]] IN intermediate_pdt;
*IFEND
*IF NOT $true(osv$unix)
        NEXT pdt_type_specification: [[REP parameter^.type_specification_size OF cell]] IN
              parameter_description_table;
*ELSE
        NEXT kludge_pdt: [1 .. parameter^.type_specification_size] IN parameter_description_table;
        pdt_type_specification := #SEQ (kludge_pdt^);
*IFEND
        pdt_type_specification^ := type_specification^;

        IF parameter^.default_name_size > 0 THEN
          NEXT default_name: [parameter^.default_name_size] IN intermediate_pdt;
          NEXT pdt_default_name: [parameter^.default_name_size] IN parameter_description_table;
          pdt_default_name^ := default_name^;
        IFEND;

        IF parameter^.default_value_size > 0 THEN
          NEXT default_value: [parameter^.default_value_size] IN intermediate_pdt;
          NEXT pdt_default_value: [parameter^.default_value_size] IN parameter_description_table;
          pdt_default_value^ := default_value^;
        IFEND;
      FOREND /copy_intermediate_to_final/;

      sort_parameter_names;

    /set_parameter_name_indices/
      FOR i := 1 TO number_of_parameter_names DO
        IF pdt_parameter_names^ [i].class = clc$nominal_entry THEN
          pdt_parameters^ [pdt_parameter_names^ [i].position].name_index := i;
        IFEND;
      FOREND /set_parameter_name_indices/;

      RESET parameter_description_table;

    PROCEND finalize_pdt;
?? TITLE := 'get_next_line', EJECT ??

    PROCEDURE [INLINE] get_next_line;

      VAR
        end_of_input: boolean;


      IF get_line = NIL THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        EXIT clp$internal_generate_pdt;
      IFEND;

      get_line^ (parse, end_of_input, status);

      IF NOT status.normal THEN
        EXIT clp$internal_generate_pdt;
      ELSEIF end_of_input THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        EXIT clp$internal_generate_pdt;
      IFEND;
      clp$scan_non_space_lexical_unit (parse);

    PROCEND get_next_line;
?? TITLE := 'process_parameter_definitions', EJECT ??

    PROCEDURE process_parameter_definitions;

      VAR
        current_parameter: ^clt$parameter_header;

?? NEWTITLE := 'process_parameter_definition', EJECT ??

      PROCEDURE process_parameter_definition;

        VAR
          found_end_of_definition: boolean,
          pdt_parameter: ^clt$pdt_parameter,
          type_name: clt$type_name;

?? NEWTITLE := 'process_default_specification', EJECT ??

        PROCEDURE process_default_specification;

          VAR
            default_name: ^clt$variable_name_reference,
            default_name_size: 0 .. osc$max_name_size,
            default_value: ^clt$expression_text,
            default_value_index: clt$string_index,
            name: ost$name;


          pdt_parameter^.requirement := clc$optional_default_parameter;

          IF parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

            IF name = '$REQUIRED' THEN
              pdt_parameter^.requirement := clc$required_parameter;
              number_of_required_parameters := number_of_required_parameters + 1;
              clp$scan_non_space_lexical_unit (parse);
              RETURN;

            ELSEIF name = '$OPTIONAL' THEN
              pdt_parameter^.requirement := clc$optional_parameter;
              clp$scan_non_space_lexical_unit (parse);
              RETURN;

            ELSEIF name = '$CONFIRM' THEN
              pdt_parameter^.requirement := clc$confirm_default_parameter;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind = clc$lex_end_of_line THEN
                get_next_line;
              ELSEIF NOT parse.previous_unit_is_space THEN
                osp$set_status_abnormal ('CL', cle$missing_spaces_after, '$CONFIRM', status);
                EXIT clp$internal_generate_pdt;
              IFEND;
              IF parse.unit.kind = clc$lex_name THEN
                #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
              IFEND;
            IFEND;
          IFEND;

          default_value_index := parse.unit_index;

          IF parse.unit.kind = clc$lex_name THEN
            default_name_size := parse.unit.size;
            clp$scan_non_space_lexical_unit (parse);
            IF parse.unit.kind = clc$lex_comma THEN
              NEXT default_name: [default_name_size] IN work_area;
              IF default_name = NIL THEN
                osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
                EXIT clp$internal_generate_pdt;
              IFEND;
              default_name^ := name;
              pdt_parameter^.default_name_size := default_name_size;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind = clc$lex_end_of_line THEN
                get_next_line;
              IFEND;
              default_value_index := parse.unit_index;
            IFEND;
          IFEND;

          IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds
                [clc$lex_end_of_line, clc$lex_semicolon, clc$lex_right_parenthesis]) THEN

          /scan_default_expression/
            WHILE TRUE DO
              clp$scan_unnested_sep_lex_unit (clc$ignore_ellipsis, parse);
              IF parse.unit.kind IN $clt$lexical_unit_kinds
                    [clc$lex_end_of_line, clc$lex_semicolon, clc$lex_right_parenthesis] THEN
                EXIT /scan_default_expression/;
              IFEND;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind IN $clt$lexical_unit_kinds
                    [clc$lex_end_of_line, clc$lex_semicolon, clc$lex_right_parenthesis] THEN
                EXIT /scan_default_expression/;
              IFEND;
            WHILEND /scan_default_expression/;
          IFEND;

          pdt_parameter^.default_value_size := parse.unit_index - default_value_index;
          NEXT default_value: [pdt_parameter^.default_value_size] IN work_area;
          IF default_value = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$internal_generate_pdt;
          IFEND;
          default_value^ := parse.text^ (default_value_index, pdt_parameter^.default_value_size);

        PROCEND process_default_specification;
?? TITLE := 'process_parameter_attributes', EJECT ??

        PROCEDURE process_parameter_attributes;

?? NEWTITLE := 'process_parameter_attribute', EJECT ??

          PROCEDURE process_parameter_attribute;

            VAR
              name: ost$name;


            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

            IF name = 'ADVANCED' THEN
              IF pdt_parameter^.availability = clc$normal_usage_entry THEN
                pdt_parameter^.availability := clc$advanced_usage_entry;
                number_of_advanced_parameters := number_of_advanced_parameters + 1;
                IF context.kind = clc$procedure_declaration THEN
                  pdt_parameter^.specification_methods := $clt$parameter_spec_methods [clc$specify_by_name];
                IFEND;
                RETURN;
              IFEND;

            ELSEIF name = 'BY_NAME' THEN
              IF context.kind = clc$function_declaration THEN
                osp$set_status_abnormal ('CL', cle$by_name_in_function, current_parameter^.names^ [1].name,
                      status);
                EXIT clp$internal_generate_pdt;
              ELSEIF pdt_parameter^.specification_methods <> $clt$parameter_spec_methods
                    [clc$specify_by_name] THEN
                pdt_parameter^.specification_methods := $clt$parameter_spec_methods [clc$specify_by_name];
                RETURN;
              IFEND;

            ELSEIF name = 'CHECK' THEN
              IF pdt_parameter^.checking_level <> clc$extended_parameter_checking THEN
                pdt_parameter^.checking_level := clc$extended_parameter_checking;
                RETURN;
              IFEND;

            ELSEIF name = 'DEFER' THEN
              IF pdt_parameter^.evaluation_method <> clc$deferred_evaluation THEN
                pdt_parameter^.evaluation_method := clc$deferred_evaluation;
                RETURN;
              IFEND;

            ELSEIF name = 'HIDDEN' THEN
              IF pdt_parameter^.availability <> clc$hidden_entry THEN
                pdt_parameter^.availability := clc$hidden_entry;
                number_of_hidden_parameters := number_of_hidden_parameters + 1;
                IF context.kind = clc$procedure_declaration THEN
                  pdt_parameter^.specification_methods := $clt$parameter_spec_methods [clc$specify_by_name];
                IFEND;
                RETURN;
              IFEND;

            ELSEIF name = 'SECURE' THEN
              IF context.kind = clc$function_declaration THEN
                osp$set_status_abnormal ('CL', cle$secure_param_in_function,
                      current_parameter^.names^ [1].name, status);
                EXIT clp$internal_generate_pdt;
              ELSEIF pdt_parameter^.security <> clc$secure_parameter THEN
                pdt_parameter^.security := clc$secure_parameter;
                command_log_option := clc$manually_log;
                RETURN;
              IFEND;

            ELSEIF name = 'VAR' THEN
              IF context.kind = clc$function_declaration THEN
                osp$set_status_abnormal ('CL', cle$var_param_in_function, current_parameter^.names^ [1].name,
                      status);
                EXIT clp$internal_generate_pdt;
              ELSEIF pdt_parameter^.passing_method <> clc$pass_by_reference THEN
                pdt_parameter^.passing_method := clc$pass_by_reference;
                number_of_var_parameters := number_of_var_parameters + 1;
                RETURN;
              IFEND;

            ELSE
              IF type_name = '' THEN
                type_name := name;
                RETURN;
              IFEND;

              name := 'type name';
            IFEND;

            osp$set_status_abnormal ('CL', cle$duplicate_parameter_attr, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, current_parameter^.names^ [1].name,
                  status);
            EXIT clp$internal_generate_pdt;

          PROCEND process_parameter_attribute;
?? OLDTITLE, EJECT ??

          WHILE TRUE DO
            CASE parse.unit.kind OF

            = clc$lex_right_parenthesis =
              IF parse.previous_non_space_unit.kind <> clc$lex_name THEN
                osp$set_status_abnormal ('CL', cle$expecting_parameter_attr,
                      current_parameter^.names^ [1].name, status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                EXIT clp$internal_generate_pdt;
              IFEND;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind = clc$lex_end_of_line THEN
                get_next_line;
              IFEND;
              RETURN;

            = clc$lex_name =
              process_parameter_attribute;
              clp$scan_non_space_lexical_unit (parse);
              IF parse.unit.kind = clc$lex_comma THEN
                clp$scan_non_space_lexical_unit (parse);
              IFEND;

            = clc$lex_long_name =
              osp$set_status_abnormal ('CL', cle$name_too_long, parse.
                    text^ (parse.unit_index, parse.unit.size), status);
              EXIT clp$internal_generate_pdt;

            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_parameter_attr, current_parameter^.names^ [1].name,
                    status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT clp$internal_generate_pdt;

            CASEND;
          WHILEND;

        PROCEND process_parameter_attributes;
?? TITLE := 'process_parameter_names', EJECT ??

        PROCEDURE process_parameter_names;

          VAR
            check_parameter: ^clt$parameter_header,
            i: clt$parameter_name_index,
            name: ost$name;


          pdt_parameter^.name_index := number_of_parameter_names + 1;

          WHILE TRUE DO
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

            check_parameter := first_parameter;
            WHILE (check_parameter <> NIL) AND (check_parameter^.number_of_names > 0) DO
              FOR i := 1 TO check_parameter^.number_of_names DO
                IF name = check_parameter^.names^ [i].name THEN
                  osp$set_status_abnormal ('CL', cle$duplicate_parameter_name, name, status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, context.identifier, status);
                  EXIT clp$internal_generate_pdt;
                IFEND;
              FOREND;
              check_parameter := check_parameter^.next_parameter;
            WHILEND;

            number_of_parameter_names := number_of_parameter_names + 1;
            current_parameter^.number_of_names := current_parameter^.number_of_names + 1;

            IF current_parameter^.number_of_names = 1 THEN
              NEXT current_parameter^.names: [1 .. 1] IN work_area;
            ELSE
              RESET work_area TO current_parameter^.names;
              NEXT current_parameter^.names: [1 .. current_parameter^.number_of_names] IN work_area;
            IFEND;
            IF current_parameter^.names = NIL THEN
              osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
              EXIT clp$internal_generate_pdt;
            IFEND;

            current_parameter^.names^ [current_parameter^.number_of_names].name := name;
            current_parameter^.names^ [current_parameter^.number_of_names].position := number_of_parameters;
            IF current_parameter^.number_of_names = 1 THEN
              current_parameter^.names^ [current_parameter^.number_of_names].class := clc$nominal_entry;
            ELSEIF context.kind = clc$function_declaration THEN
              osp$set_status_abnormal ('CL', cle$function_parameter_one_name,
                    current_parameter^.names^ [1].name, status);
              EXIT clp$internal_generate_pdt;
            ELSE
              current_parameter^.names^ [current_parameter^.number_of_names].class := clc$alias_entry;
            IFEND;

            clp$scan_non_space_lexical_unit (parse);
            IF parse.unit.kind = clc$lex_comma THEN
              clp$scan_non_space_lexical_unit (parse);
            IFEND;

            CASE parse.unit.kind OF
            = clc$lex_right_parenthesis, clc$lex_semicolon, clc$lex_end_of_line, clc$lex_equal,
                  clc$lex_colon =
              IF parse.previous_non_space_unit.kind <> clc$lex_name THEN
                osp$set_status_abnormal ('CL', cle$expecting_parameter_name,
                      current_parameter^.names^ [1].name, status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                EXIT clp$internal_generate_pdt;
              ELSEIF current_parameter^.number_of_names > 1 THEN
                current_parameter^.names^ [current_parameter^.number_of_names].class :=
                      clc$abbreviation_entry;
              IFEND;
              RETURN;
            = clc$lex_name =
              ;
            = clc$lex_long_name =
              osp$set_status_abnormal ('CL', cle$name_too_long, parse.
                    text^ (parse.unit_index, parse.unit.size), status);
              EXIT clp$internal_generate_pdt;
            ELSE
              osp$set_status_abnormal ('CL', cle$expecting_parameter_name, current_parameter^.names^ [1].name,
                    status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT clp$internal_generate_pdt;
            CASEND;
          WHILEND;

        PROCEND process_parameter_names;
?? OLDTITLE, EJECT ??

        VAR
          previous_parameter: ^clt$parameter_header,
          type_header: ^clt$type_specification_header,
          type_specification: ^clt$type_specification;

        found_end_of_definition := FALSE;
        previous_parameter := current_parameter;
        NEXT current_parameter IN work_area;
        IF current_parameter = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$internal_generate_pdt;
        IFEND;

        IF first_parameter = NIL THEN
          first_parameter := current_parameter;
        ELSE
          previous_parameter^.next_parameter := current_parameter;
        IFEND;

        current_parameter^.next_parameter := NIL;
        current_parameter^.number_of_names := 0;
        current_parameter^.names := NIL;
        number_of_parameters := number_of_parameters + 1;

        NEXT pdt_parameter IN work_area;
        IF pdt_parameter = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT clp$internal_generate_pdt;
        IFEND;

        process_parameter_names;

        pdt_parameter^.availability := clc$normal_usage_entry;
        pdt_parameter^.security := clc$non_secure_parameter;
        IF context.kind = clc$function_declaration THEN
          pdt_parameter^.specification_methods := $clt$parameter_spec_methods [clc$specify_positionally];
        ELSE
          pdt_parameter^.specification_methods := $clt$parameter_spec_methods
                [clc$specify_positionally, clc$specify_by_name];
        IFEND;
        pdt_parameter^.passing_method := clc$pass_by_value;
        pdt_parameter^.evaluation_method := clc$immediate_evaluation;
        pdt_parameter^.checking_level := clc$standard_parameter_checking;
        pdt_parameter^.default_name_size := 0;
        pdt_parameter^.requirement := clc$optional_parameter;
        pdt_parameter^.default_value_size := 0;

        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;

        type_name := '';

        IF parse.unit.kind = clc$lex_colon THEN
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;

          IF parse.unit.kind = clc$lex_left_parenthesis THEN
            clp$scan_non_space_lexical_unit (parse);
            process_parameter_attributes;
          IFEND;

          context.list_rest_allowed := (context.kind = clc$function_declaration) AND
                (pdt_parameter^.passing_method = clc$pass_by_value);
          evaluate_type_expression (type_name, get_line, parse, context, symbolic_qualifiers_work_area,
                work_area, type_specification, status);
          IF NOT status.normal THEN
            EXIT clp$internal_generate_pdt;
          ELSEIF (pdt_parameter^.passing_method = clc$pass_by_reference) AND
                (current_parameter^.names^ [1].name = 'STATUS') THEN
            RESET type_specification;
            NEXT type_header IN type_specification;
            RESET type_specification;
            IF type_header^.kind = clc$status_type THEN
              status_parameter_number := number_of_parameters;
            IFEND;
          IFEND;
          pdt_parameter^.type_specification_size := #SIZE (type_specification^);

        ELSE { no type specification }
          IF context.kind = clc$function_declaration THEN
            osp$set_status_abnormal ('CL', cle$no_type_for_function_param, current_parameter^.names^ [1].name,
                  status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$internal_generate_pdt;
          IFEND;

          NEXT type_header IN work_area;
          IF type_header = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$internal_generate_pdt;
          IFEND;

          type_header^.version := clc$declaration_version;
          type_header^.name_size := 0;
          IF current_parameter^.names^ [1].name = 'STATUS' THEN
            type_header^.kind := clc$status_type;
            pdt_parameter^.specification_methods := $clt$parameter_spec_methods [clc$specify_by_name];
            pdt_parameter^.passing_method := clc$pass_by_reference;
            status_parameter_number := number_of_parameters;
          ELSE
            type_header^.kind := clc$file_type;
          IFEND;
          pdt_parameter^.type_specification_size := #SIZE (type_header^);
          found_end_of_definition := TRUE;
        IFEND;

        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
          found_end_of_definition := TRUE;
        IFEND;

        IF parse.unit.kind = clc$lex_equal THEN
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
          process_default_specification;
          found_end_of_definition := parse.unit.kind IN $clt$lexical_unit_kinds
                [clc$lex_end_of_line, clc$lex_semicolon, clc$lex_right_parenthesis];
        ELSE
          found_end_of_definition := found_end_of_definition OR
                (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon,
                clc$lex_right_parenthesis]);
        IFEND;

        IF pdt_parameter^.passing_method = clc$pass_by_reference THEN
          IF pdt_parameter^.evaluation_method = clc$deferred_evaluation THEN
            osp$set_status_abnormal ('CL', cle$defer_with_var, current_parameter^.names^ [1].name, status);
            EXIT clp$internal_generate_pdt;
          ELSEIF pdt_parameter^.security = clc$secure_parameter THEN
            osp$set_status_abnormal ('CL', cle$secure_with_var, current_parameter^.names^ [1].name, status);
            EXIT clp$internal_generate_pdt;
          IFEND;
        IFEND;

        CASE pdt_parameter^.requirement OF
        = clc$required_parameter, clc$confirm_default_parameter =
          CASE pdt_parameter^.availability OF
          = clc$advanced_usage_entry =
            osp$set_status_abnormal ('CL', cle$advanced_parameter_conflict, current_parameter^.names^ [1].
                  name, status);
            EXIT clp$internal_generate_pdt;
          = clc$hidden_entry =
            osp$set_status_abnormal ('CL', cle$hidden_parameter_conflict, current_parameter^.names^ [1].name,
                  status);
            EXIT clp$internal_generate_pdt;
          ELSE
            ;
          CASEND;
        ELSE
          ;
        CASEND;

        IF NOT found_end_of_definition THEN
          osp$set_status_abnormal ('CL', cle$expecting_end_of_param_spec, current_parameter^.names^ [1].name,
                status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$internal_generate_pdt;
        IFEND;

      PROCEND process_parameter_definition;
?? OLDTITLE, EJECT ??

      IF parse.unit.kind <> clc$lex_left_parenthesis THEN
        RETURN;
      IFEND;

      current_parameter := NIL;

      clp$scan_non_space_lexical_unit (parse);

      WHILE TRUE DO
        CASE parse.unit.kind OF

        = clc$lex_right_parenthesis =
          clp$scan_non_space_lexical_unit (parse);
          RETURN;

        = clc$lex_semicolon =
          clp$scan_non_space_lexical_unit (parse);

        = clc$lex_end_of_line =
          get_next_line;

        = clc$lex_name =
          IF context.list_rest_encountered THEN
            osp$set_status_abnormal ('CL', cle$improper_use_of_list_rest, '', status);
            EXIT clp$internal_generate_pdt;
          IFEND;
          process_parameter_definition;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT clp$internal_generate_pdt;

        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_parameter_spec, context.identifier, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$internal_generate_pdt;

        CASEND;
      WHILEND;

    PROCEND process_parameter_definitions;
?? TITLE := 'process_proc_attributes', EJECT ??

    PROCEDURE process_proc_attributes;

      VAR
        xdcl_attribute_specified: boolean;

?? NEWTITLE := 'process_proc_attribute', EJECT ??

      PROCEDURE process_proc_attribute;

        VAR
          name: ost$name;


        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

      /no_conflict/
        BEGIN

        /no_duplicate/
          BEGIN

            IF name = 'ADVANCED' THEN
              CASE availability OF
              = clc$hidden_entry =
                ;
              = clc$advanced_usage_entry =
                EXIT /no_duplicate/;
              = clc$normal_usage_entry =
                availability := clc$advanced_usage_entry;
              CASEND;

            ELSEIF name = 'GATE' THEN
              CASE command_or_function_scope OF
              = clc$gate_command_or_function =
                EXIT /no_duplicate/;
              = clc$local_command_or_function =
                EXIT /no_conflict/;
              = clc$xdcl_command_or_function =
                command_or_function_scope := clc$gate_command_or_function;
              CASEND;

            ELSEIF name = 'HIDDEN' THEN
              IF availability = clc$hidden_entry THEN
                EXIT /no_duplicate/;
              IFEND;
              availability := clc$hidden_entry;

            ELSEIF name = 'LOCAL' THEN
              CASE command_or_function_scope OF
              = clc$gate_command_or_function =
                EXIT /no_conflict/;
              = clc$local_command_or_function =
                EXIT /no_duplicate/;
              = clc$xdcl_command_or_function =
                IF xdcl_attribute_specified THEN
                  EXIT /no_conflict/;
                IFEND;
                command_or_function_scope := clc$local_command_or_function;
              CASEND;

            ELSEIF name = 'XDCL' THEN
              CASE command_or_function_scope OF
              = clc$gate_command_or_function =
                ;
              = clc$local_command_or_function =
                EXIT /no_conflict/;
              = clc$xdcl_command_or_function =
                IF xdcl_attribute_specified THEN
                  EXIT /no_duplicate/;
                IFEND;
                xdcl_attribute_specified := TRUE;
              CASEND;

            ELSE
              IF help_module_name <> '' THEN
                name := 'help module name';
                EXIT /no_duplicate/;
              IFEND;
              help_module_name := name;

            IFEND;
            RETURN;

          END /no_duplicate/;
          osp$set_status_abnormal ('CL', cle$duplicate_proc_attribute, name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, context.identifier, status);
          EXIT clp$internal_generate_pdt;

        END /no_conflict/;
        osp$set_status_abnormal ('CL', cle$proc_scope_attr_conflict, context.identifier, status);
        EXIT clp$internal_generate_pdt;

      PROCEND process_proc_attribute;
?? OLDTITLE, EJECT ??

      help_module_name := '';
      availability := clc$normal_usage_entry;
      command_or_function_scope := clc$xdcl_command_or_function;

      IF parse.unit.kind <> clc$lex_left_parenthesis THEN
        RETURN;
      IFEND;

      xdcl_attribute_specified := FALSE;

      clp$scan_non_space_lexical_unit (parse);
      WHILE TRUE DO
        CASE parse.unit.kind OF

        = clc$lex_right_parenthesis =
          IF parse.previous_non_space_unit.kind <> clc$lex_name THEN
            osp$set_status_abnormal ('CL', cle$expecting_proc_attribute, context.identifier, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$internal_generate_pdt;
          IFEND;
          clp$scan_non_space_lexical_unit (parse);
          RETURN;

        = clc$lex_name =
          process_proc_attribute;
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_comma THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT clp$internal_generate_pdt;

        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_proc_attribute, context.identifier, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$internal_generate_pdt;

        CASEND;
      WHILEND;

    PROCEND process_proc_attributes;
?? TITLE := 'process_proc_names', EJECT ??

    PROCEDURE process_proc_names;

      VAR
        name: ost$name,
        proc_name_count: 0 .. clc$max_proc_names,
        i: 1 .. clc$max_proc_names - 1;


      aliases := NIL;
      proc_name_count := 0;
      WHILE TRUE DO
        CASE parse.unit.kind OF
        = clc$lex_left_parenthesis, clc$lex_semicolon, clc$lex_end_of_line =
          IF (proc_name_count = 0) OR (parse.previous_non_space_unit.kind <> clc$lex_name) THEN
            osp$set_status_abnormal ('CL', cle$expecting_proc_name, context.identifier, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$internal_generate_pdt;
          IFEND;
          RETURN;
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT clp$internal_generate_pdt;
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_proc_name, context.identifier, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$internal_generate_pdt;
        CASEND;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF (context.kind = clc$function_declaration) AND (name (1) <> '$') THEN
          osp$set_status_abnormal ('CL', cle$function_name_needs_$, name, status);
          EXIT clp$internal_generate_pdt;
        IFEND;

        IF (proc_name_count > 0) AND (name = command_or_function_name) THEN
          osp$set_status_abnormal ('CL', cle$duplicate_proc_name, name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, context.identifier, status);
          EXIT clp$internal_generate_pdt;
        IFEND;
        FOR i := 1 TO proc_name_count - 1 DO
          IF name = aliases^ [i] THEN
            osp$set_status_abnormal ('CL', cle$duplicate_proc_name, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, context.identifier, status);
            EXIT clp$internal_generate_pdt;
          IFEND;
        FOREND;

        proc_name_count := proc_name_count + 1;
        IF proc_name_count = 1 THEN
          command_or_function_name := name;
        ELSE
          IF aliases <> NIL THEN
            RESET work_area TO aliases;
          IFEND;
          NEXT aliases: [1 .. proc_name_count - 1] IN work_area;
          IF aliases = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT clp$internal_generate_pdt;
          IFEND;
          aliases^ [proc_name_count - 1] := name;
        IFEND;

        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_comma THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
      WHILEND;

    PROCEND process_proc_names;
?? OLDTITLE, EJECT ??

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

    status.normal := TRUE;

  /evaluate_declaration/
    BEGIN
      symbolic_qualifiers_work_area := symbolic_qualifiers_area;

      IF command_or_function = clc$command THEN
        context.kind := clc$procedure_declaration;
        context.identifier := 'procedure';
      ELSE
        context.kind := clc$function_declaration;
        context.identifier := 'function';
      IFEND;
      context.unspecified_type_allowed := FALSE;
      context.list_rest_allowed := FALSE;
      context.list_rest_encountered := FALSE;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;

      process_proc_attributes;
      process_proc_names;

      first_parameter := NIL;
      number_of_parameters := 0;
      number_of_required_parameters := 0;
      number_of_advanced_parameters := 0;
      number_of_hidden_parameters := 0;
      number_of_parameter_names := 0;
      number_of_var_parameters := 0;
      status_parameter_number := 0;
      command_log_option := clc$automatically_log;
      process_parameter_definitions;

      CASE parse.unit.kind OF
      = clc$lex_semicolon =
        clp$scan_non_space_lexical_unit (parse);
      = clc$lex_end_of_line =
        ;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_proc_header_term, context.identifier, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT /evaluate_declaration/;
      CASEND;

      finalize_pdt;
    END /evaluate_declaration/;

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

  PROCEND clp$internal_generate_pdt;
?? TITLE := 'clp$generate_type_specification', EJECT ??
*copyc clh$generate_type_specification

  PROCEDURE [XDCL, #GATE] clp$generate_type_specification
    (    type_name: clt$type_name;
         first_line: ^clt$command_line;
         first_line_index: clt$command_line_index;
         get_line: clt$input_procedure;
     VAR work_area {input, output} : ^clt$work_area;
     VAR last_line: ^clt$command_line;
     VAR last_line_index: clt$command_line_index;
     VAR type_specification: ^clt$type_specification;
     VAR status: ost$status);

    CONST
      declaration_identifier = 'type';

    VAR
      get_line_called: boolean,
      lexical_units: ^clt$lexical_units,
      lexical_work_area: ^^clt$work_area,
      local_status: ost$status,
      parse: clt$parse_state;

?? NEWTITLE := 'get_type_spec_line', EJECT ??

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

*IF NOT $true(osv$unix)
      VAR
        callers_save_area: ^ost$stack_frame_save_area;

?? NEWTITLE := 'bad_input_proc_pointer_handler', EJECT ??

      PROCEDURE bad_input_proc_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 []) THEN
          IF save_area^.minimum_save_area.a2_previous_save_area = callers_save_area THEN
            osp$set_status_abnormal ('CL', cle$unable_to_call_input_proc, 'clp$generate_type_specification',
                  status);
            EXIT get_type_spec_line;
          IFEND;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        handler_status.normal := TRUE;

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

      VAR
        line: ^clt$command_line;


      end_of_input := FALSE;

      IF get_line = NIL THEN
        end_of_input := TRUE;
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, declaration_identifier, status);
        RETURN;
      IFEND;

      REPEAT
        REPEAT

*IF NOT $true(osv$unix)
          IF NOT get_line_called THEN
            callers_save_area := #PREVIOUS_SAVE_AREA ();
            osp$establish_condition_handler (^bad_input_proc_pointer_handler, FALSE);
          IFEND;
*IFEND
          get_line^ (line, status);
          IF NOT get_line_called THEN
*IF NOT $true(osv$unix)
            osp$disestablish_cond_handler;
*IFEND
            get_line_called := TRUE;
          IFEND;

          IF NOT status.normal THEN
            RETURN;
          ELSEIF line = NIL THEN
            end_of_input := TRUE;
            osp$set_status_abnormal ('CL', cle$eoi_in_declaration, declaration_identifier, status);
            RETURN;
          IFEND;
        UNTIL STRLENGTH (line^) > 0;

        RESET lexical_work_area^ TO lexical_units;
        clp$identify_lexical_units (line, lexical_work_area^, lexical_units, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$initialize_parse_state (line, lexical_units, parse);
      UNTIL parse.unit.kind <> clc$lex_end_of_line;

    PROCEND get_type_spec_line;
?? OLDTITLE, EJECT ??

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

  /generate_type_specification/
    BEGIN
*IF NOT $true(osv$unix)
      clp$get_work_area (#RING (^parse), lexical_work_area, local_status);
*ELSE
      clp$get_work_area (osc$user_ring, lexical_work_area, local_status);
*IFEND
      IF NOT local_status.normal THEN
        EXIT /generate_type_specification/;
      IFEND;

      clp$identify_lexical_units (first_line, lexical_work_area^, lexical_units, local_status);
      IF NOT local_status.normal THEN
        EXIT /generate_type_specification/;
      IFEND;

      clp$initialize_parse_state (first_line, lexical_units, parse);
      REPEAT
        clp$scan_any_lexical_unit (parse);
      UNTIL (parse.unit_index >= first_line_index) OR (parse.unit_index >= parse.index_limit);

      clp$internal_gen_type_spec (type_name, FALSE, ^get_type_spec_line, NIL, work_area, parse,
            type_specification, local_status);

      RESET lexical_work_area^ TO lexical_units;

      last_line := parse.text;
      last_line_index := parse.unit_index;
    END /generate_type_specification/;

    IF NOT local_status.normal THEN
      IF local_status.condition = cle$work_area_overflow THEN
        local_status.text.size := 0;
        osp$append_status_parameter (osc$status_parameter_delimiter, 'clp$generate_type_specification',
              local_status);
      IFEND;
      status := local_status;
    IFEND;

  PROCEND clp$generate_type_specification;
?? TITLE := 'clp$internal_gen_type_spec', EJECT ??
{
{ NOTE:
{   If the unspecified_type_allowed parameter is given as true, then if a
{   clc$unspecified results from the attempt to "lookup" a type name,
{   NIL is returned for the type_specification parameter.
{

  PROCEDURE [XDCL, #GATE] clp$internal_gen_type_spec
    (    type_name: clt$type_name;
         unspecified_type_allowed: boolean;
         get_line: clt$internal_input_procedure;
         symbolic_qualifiers_area: ^clt$work_area;
     VAR work_area {input, output} : ^clt$work_area;
     VAR parse {input, output} : clt$parse_state;
     VAR type_specification: ^clt$type_specification;
     VAR status: ost$status);

    VAR
      context: clt$declaration_context,
      end_of_input: boolean,
      size: clt$type_specification_size,
      symbolic_qualifiers_work_area: ^clt$work_area,
      type_header: ^clt$type_specification_header;


    status.normal := TRUE;

    symbolic_qualifiers_work_area := symbolic_qualifiers_area;

    context.kind := clc$type_declaration;
    context.identifier := 'type';
    context.unspecified_type_allowed := unspecified_type_allowed;
    context.list_rest_allowed := FALSE;
    context.list_rest_encountered := FALSE;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit.kind = clc$lex_end_of_line THEN
      IF get_line = NIL THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        RETURN;
      IFEND;
      get_line^ (parse, end_of_input, status);
      IF NOT status.normal THEN
        RETURN;
      ELSEIF end_of_input THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        RETURN;
      IFEND;
      clp$scan_non_space_lexical_unit (parse);
    IFEND;

    evaluate_type_expression (type_name, get_line, parse, context, symbolic_qualifiers_work_area, work_area,
          type_specification, status);

  PROCEND clp$internal_gen_type_spec;
?? TITLE := 'evaluate_type_expression', EJECT ??

  PROCEDURE evaluate_type_expression
    (    type_name: clt$type_name;
         get_line: clt$internal_input_procedure;
     VAR parse {input, output} : clt$parse_state;
     VAR context {input, output} : clt$declaration_context;
     VAR symbolic_qualifiers_work_area {input, output} : ^clt$work_area;
     VAR work_area {input, output} : ^clt$work_area;
     VAR type_specification: ^clt$type_specification;
     VAR status: ost$status);


    CONST
*IF NOT $true(osv$unix)
      max_generic_types = 31,
*ELSE
      max_generic_types = 33,
*IFEND
      min_generic_type_size = 3 {ANY, KEY} ,
      max_generic_type_size = 21 {ENTRY_POINT_REFERENCE} ;

    TYPE
      clt$generic_type_descriptor = record
        name: string (max_generic_type_size),
        case kind: clt$type_kind of
        = clc$application_type .. clc$cobol_name_type =
          ,
        = clc$date_time_type =
          date_and_or_time: clt$date_and_or_time,
        = clc$entry_point_reference_type .. clc$union_type =
          ,
        casend,
      recend;

    VAR
*IF NOT $true(osv$unix)
      generic_type_table: [STATIC, READ, oss$job_paged_literal] array [1 .. max_generic_types] of
*ELSE
      generic_type_table: [STATIC, READ] array [1 .. max_generic_types] of
*IFEND
            clt$generic_type_descriptor := [
            {} ['ANY                            ', clc$union_type],
            {} ['APPLICATION                    ', clc$application_type],
            {} ['ARRAY                          ', clc$array_type],
            {} ['BOOLEAN                        ', clc$boolean_type],
            {} ['COBOL_NAME                     ', clc$cobol_name_type],
            {} ['COMMAND_REFERENCE              ', clc$command_reference_type],
            {} ['DATA_NAME                      ', clc$data_name_type],
            {} ['DATE                           ', clc$date_time_type, [clc$date]],
            {} ['DATE_TIME                      ', clc$date_time_type, [clc$date, clc$time]],
            {} ['ENTRY_POINT_REFERENCE          ', clc$entry_point_reference_type],
            {} ['FILE                           ', clc$file_type],
            {} ['INTEGER                        ', clc$integer_type],
            {} ['KEY                            ', clc$keyword_type],
            {} ['LINE_IDENTIFIER                ', clc$scu_line_identifier_type],
            {} ['LIST                           ', clc$list_type],
            {} ['LOCK                           ', clc$lock_type],
            {} ['NAME                           ', clc$name_type],
            {} ['NETWORK_TITLE                  ', clc$network_title_type],
*IF $true(osv$unix)
            {} ['NOS_VE_FILE                    ', clc$nos_ve_file_type],
*IFEND
            {} ['PROGRAM_NAME                   ', clc$program_name_type],
            {} ['RANGE                          ', clc$range_type],
            {} ['REAL                           ', clc$real_type],
            {} ['RECORD                         ', clc$record_type],
            {} ['STATISTIC_CODE                 ', clc$statistic_code_type],
            {} ['STATUS                         ', clc$status_type],
            {} ['STATUS_CODE                    ', clc$status_code_type],
            {} ['STRING                         ', clc$string_type],
            {} ['STRING_PATTERN                 ', clc$string_pattern_type],
            {} ['TIME                           ', clc$date_time_type, [clc$time]],
            {} ['TIME_INCREMENT                 ', clc$time_increment_type],
            {} ['TIME_ZONE                      ', clc$time_zone_type],
*IF NOT $true(osv$unix)
            {} ['TYPE                           ', clc$type_specification_type]];
*ELSE
            {} ['TYPE                           ', clc$type_specification_type],
            {} ['UNIX_FILE                      ', clc$unix_file_type]];
*IFEND


    VAR
      name: ost$name;

?? NEWTITLE := 'check_for_defined_type', EJECT ??

    PROCEDURE check_for_defined_type
      (    name: ost$name;
       VAR defined_type_specification: ^clt$type_specification);

      VAR
*IF NOT $true(osv$unix)
        access_variable_requests: clt$access_variable_requests,
*IFEND
        found: boolean,
        local_parse: clt$parse_state,
        result: ^clt$data_value;


      local_parse := parse;
      clp$scan_any_lexical_unit (local_parse);

*IF NOT $true(osv$unix)
      access_variable_requests := $clt$access_variable_requests[];
      clp$evaluate_name (name, access_variable_requests, local_parse, work_area, result, found, status);
*ELSE
      found := FALSE;
*IFEND
      IF NOT status.normal THEN
        EXIT evaluate_type_expression;
      ELSEIF NOT found THEN
        osp$set_status_abnormal ('CL', cle$expecting_type_expression, name, status);
        EXIT evaluate_type_expression;
      ELSEIF result = NIL THEN
        osp$set_status_abnormal ('CL', cle$variable_never_given_value, name, status);
        EXIT evaluate_type_expression;
      ELSE
        CASE result^.kind OF
        = clc$type_specification =
          parse := local_parse;
          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          defined_type_specification := result^.type_specification_value;
        = clc$unspecified =
          IF context.unspecified_type_allowed THEN

            RESET work_area TO type_header;
            EXIT evaluate_type_expression;

          IFEND;
          defined_type_specification := NIL;
        ELSE
          defined_type_specification := NIL;
        CASEND;
      IFEND;

    PROCEND check_for_defined_type;
?? TITLE := 'check_for_generic_type', EJECT ??

    PROCEDURE [INLINE] check_for_generic_type
      (    name: ost$name;
           name_size: ost$name_size;
       VAR generic_type_descriptor: ^clt$generic_type_descriptor);

      VAR
        current_index: 1 .. max_generic_types,
        high_index: 0 .. max_generic_types,
        temp: integer,
        low_index: 1 .. max_generic_types + 1;


      IF (min_generic_type_size <= name_size) AND (name_size <= max_generic_type_size) THEN
        low_index := 1;
        high_index := max_generic_types;
        REPEAT
          temp := low_index + high_index;
          current_index := temp DIV 2;
          IF name (1, max_generic_type_size) = generic_type_table [current_index].name THEN
            generic_type_descriptor := ^generic_type_table [current_index];
            RETURN;

          ELSEIF name (1, max_generic_type_size) > generic_type_table [current_index].name THEN
            low_index := current_index + 1;
          ELSE
            high_index := current_index - 1;
          IFEND;
        UNTIL low_index > high_index;
      IFEND;

      generic_type_descriptor := NIL;

    PROCEND check_for_generic_type;
?? TITLE := 'evaluate_application_type', EJECT ??

    PROCEDURE evaluate_application_type;

      VAR
        application_qualifier: ^clt$application_type_qualifier,
        name: ost$name;


      NEXT application_qualifier IN work_area;
      IF application_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      application_qualifier^.balance_brackets := FALSE;

      clp$scan_non_space_lexical_unit (parse);

      CASE parse.unit.kind OF

      = clc$lex_end_of_line, clc$lex_equal, clc$lex_semicolon, clc$lex_right_parenthesis =
        RETURN;

      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name <> 'BALANCE_BRACKETS' THEN
          osp$set_status_abnormal ('CL', cle$expecting_applic_type_attr, name, status);
          EXIT evaluate_type_expression;
        IFEND;
        application_qualifier^.balance_brackets := TRUE;
        clp$scan_non_space_lexical_unit (parse);

      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        EXIT evaluate_type_expression;

      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_applic_type_attr, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT evaluate_type_expression;
      CASEND;

    PROCEND evaluate_application_type;
?? TITLE := 'evaluate_array_type', EJECT ??

    PROCEDURE evaluate_array_type;

      VAR
        array_qualifier: ^clt$array_type_qualifier,
        element_type_specification: ^clt$type_specification,
        elements_context: clt$declaration_context,
        high_integer: integer,
        ignore_range_present: boolean,
        low_integer: integer,
        name: ost$name,
        qualifier_present: boolean,
        symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


      NEXT array_qualifier IN work_area;
      IF array_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;
      init_symbolic_subrange_qual (symbolic_subrange_qualifier);

      array_qualifier^.element_type_specification_size := 0;
      array_qualifier^.array_bounds_defined := FALSE;

      clp$scan_non_space_lexical_unit (parse);
      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_equal, clc$lex_semicolon, clc$lex_right_parenthesis =
        IF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$array_bounds_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;
        RETURN;

      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'ARRAY', status);
          EXIT evaluate_type_expression;
        IFEND;
      CASEND;

    /evaluate_array_bounds/
      BEGIN
        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
          IF name = 'OF' THEN
            IF context.kind = clc$type_declaration THEN
              osp$set_status_abnormal ('CL', cle$array_bounds_required, '', status);
              EXIT evaluate_type_expression;
            IFEND;
            EXIT /evaluate_array_bounds/;
          IFEND;
        IFEND;

        evaluate_subrange_qualifier (clc$min_array_bound, clc$max_array_bound, cle$array_bound_out_of_range,
              cle$min_array_bound_gt_max, cle$max_array_bound_omitted, symbolic_subrange_qualifier,
              low_integer, high_integer, ignore_range_present, qualifier_present);
        IF qualifier_present THEN
          array_qualifier^.array_bounds_defined := TRUE;
          array_qualifier^.bounds.lower := low_integer;
          array_qualifier^.bounds.upper := high_integer;
        ELSEIF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$array_bounds_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;

        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IFEND;
      END /evaluate_array_bounds/;

      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_equal, clc$lex_semicolon, clc$lex_right_parenthesis =
        IF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$array_elem_type_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;

      = clc$lex_name =
        IF name <> 'OF' THEN
          osp$set_status_abnormal ('CL', cle$expecting_of_for_array, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        IFEND;

        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;

        elements_context.kind := context.kind;
        elements_context.identifier := context.identifier;
        elements_context.unspecified_type_allowed := FALSE;
        elements_context.list_rest_allowed := FALSE;
        elements_context.list_rest_encountered := FALSE;

        evaluate_type_expression (osc$null_name, get_line, parse, elements_context,
              symbolic_qualifiers_work_area, work_area, element_type_specification, status);
        IF NOT status.normal THEN
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        array_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
*ELSE
        array_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
{       array_qualifier^.element_type_specification_size :=
{             ((3 + #SIZE (element_type_specification^)) DIV 4) * 4;
*IFEND

      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        EXIT evaluate_type_expression;

      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_of_for_array, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT evaluate_type_expression;
      CASEND;

    PROCEND evaluate_array_type;
?? TITLE := 'evaluate_date_time_type', EJECT ??

    PROCEDURE evaluate_date_time_type
      (    date_and_or_time: clt$date_and_or_time);

      VAR
        date_time_qualifier: ^clt$date_time_type_qualifier;


      NEXT date_time_qualifier IN work_area;
      IF date_time_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      date_time_qualifier^.date_and_or_time := date_and_or_time;

      clp$scan_non_space_lexical_unit (parse);
      date_time_qualifier^.tenses := $clt$date_time_tenses [];

      WHILE TRUE DO
        CASE parse.unit.kind OF
        = clc$lex_end_of_line, clc$lex_semicolon, clc$lex_right_parenthesis, clc$lex_equal,
          clc$lex_comma =
          IF date_time_qualifier^.tenses = $clt$date_time_tenses [] THEN
            date_time_qualifier^.tenses := $clt$date_time_tenses [clc$past, clc$present, clc$future];
          IFEND;
          RETURN;
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_type_expression;
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_date_time_tense, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        CASEND;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = 'FUTURE' THEN
          date_time_qualifier^.tenses := date_time_qualifier^.tenses + $clt$date_time_tenses [clc$future];
        ELSEIF name = 'PAST' THEN
          date_time_qualifier^.tenses := date_time_qualifier^.tenses + $clt$date_time_tenses [clc$past];
        ELSEIF name = 'PRESENT' THEN
          date_time_qualifier^.tenses := date_time_qualifier^.tenses + $clt$date_time_tenses [clc$present];
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_date_time_tense, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        IFEND;

        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_comma THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
      WHILEND;

    PROCEND evaluate_date_time_type;
?? TITLE := 'evaluate_integer_type', EJECT ??

    PROCEDURE evaluate_integer_type;

      VAR
        evaluate_radix: boolean,
        ignore_qualifier_present: boolean,
        ignore_range_present: boolean,
        integer_qualifier: ^clt$integer_type_qualifier,
        local_work_area: ^clt$work_area,
        name: ost$name,
        result_integer: clt$integer,
        symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


      NEXT integer_qualifier IN work_area;
      IF integer_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;
      init_symbolic_subrange_qual (symbolic_subrange_qualifier);

      integer_qualifier^.min_integer_value := clc$min_integer;
      integer_qualifier^.max_integer_value := clc$max_integer;
      integer_qualifier^.default_radix := 10;

      evaluate_radix := FALSE;
      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        evaluate_radix := name = 'RADIX';
      IFEND;

      IF NOT evaluate_radix THEN
        evaluate_subrange_qualifier (clc$min_integer, clc$max_integer, cle$integer_out_of_range,
              cle$min_of_subrange_not_le_max, cle$max_of_subrange_omitted, symbolic_subrange_qualifier,
              integer_qualifier^.min_integer_value, integer_qualifier^.max_integer_value,
              ignore_range_present, ignore_qualifier_present);

        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
          evaluate_radix := name = 'RADIX';
        IFEND;
      IFEND;

      IF evaluate_radix THEN
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, 'RADIX', status);
          EXIT evaluate_type_expression;
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'RADIX', status);
          EXIT evaluate_type_expression;
        IFEND;

        local_work_area := work_area;
        clp$evaluate_integer_expression (LOWERVALUE (result_integer.radix), UPPERVALUE (result_integer.radix),
              work_area, parse, result_integer, status);
        IF NOT status.normal THEN
          IF status.condition = cle$integer_out_of_range THEN
            status.condition := cle$radix_out_of_range;
          IFEND;
          EXIT evaluate_type_expression;
        IFEND;
        integer_qualifier^.default_radix := result_integer.value;
      IFEND;

    PROCEND evaluate_integer_type;
?? TITLE := 'evaluate_keyword_type', EJECT ??

    PROCEDURE evaluate_keyword_type;

      VAR
        availability: clt$named_entry_availability,
        first_keyword_specification: ^clt$keyword_specification,
        keywords: ^clt$keyword_specifications,
        name: ost$name,
        number_of_keywords: 0 .. clc$max_keywords,
        ordinal: clt$named_entry_ordinal;

?? NEWTITLE := 'check_for_duplicate_keyword', EJECT ??

      PROCEDURE [INLINE] check_for_duplicate_keyword;

        VAR
          i: 1 .. clc$max_keywords;


        FOR i := 1 TO number_of_keywords DO
          IF keywords^ [i].keyword = name THEN
            osp$set_status_abnormal ('CL', cle$duplicate_keyword, name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, context.identifier, status);
            EXIT evaluate_type_expression;
          IFEND;
        FOREND;

      PROCEND check_for_duplicate_keyword;
?? TITLE := 'evaluate_keyword_group', EJECT ??

      PROCEDURE evaluate_keyword_group;

        VAR
          class: clt$named_entry_class,
          number_of_keywords_in_group: 0 .. clc$max_keywords;


        class := clc$nominal_entry;
        number_of_keywords_in_group := 0;
        clp$scan_non_space_lexical_unit (parse);
        WHILE TRUE DO
          CASE parse.unit.kind OF

          = clc$lex_right_parenthesis =
            IF parse.previous_non_space_unit.kind = clc$lex_comma THEN
              osp$set_status_abnormal ('CL', cle$expecting_key_in_spec, '', status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT evaluate_type_expression;
            IFEND;
            IF number_of_keywords_in_group > 1 THEN
              keywords^ [number_of_keywords].class := clc$abbreviation_entry;
            IFEND;
            RETURN;

          = clc$lex_name =
            ;

          = clc$lex_long_name =
            osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                  status);
            EXIT evaluate_type_expression;

          ELSE
            osp$set_status_abnormal ('CL', cle$expecting_key_in_spec, '', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_type_expression;
          CASEND;

          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

          check_for_duplicate_keyword;

          number_of_keywords := number_of_keywords + 1;
          number_of_usage_keywords := number_of_usage_keywords + 1;

          RESET work_area TO first_keyword_specification;
          NEXT keywords: [1 .. number_of_keywords] IN work_area;
          IF keywords = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            EXIT evaluate_type_expression;
          IFEND;

          keywords^ [number_of_keywords].keyword := name;
          keywords^ [number_of_keywords].class := class;
          keywords^ [number_of_keywords].availability := availability;
          keywords^ [number_of_keywords].ordinal := ordinal;
          number_of_keywords_in_group := number_of_keywords_in_group + 1;
          class := clc$alias_entry;

          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_comma THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
        WHILEND;

      PROCEND evaluate_keyword_group;
?? TITLE := 'sort_keywords', EJECT ??

      PROCEDURE [INLINE] sort_keywords;

        VAR
          current: -clc$max_keywords .. clc$max_keywords,
          gap: 1 .. clc$max_keywords,
          start: 1 .. clc$max_keywords,
          swap: clt$keyword_specification;


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

      PROCEND sort_keywords;
?? OLDTITLE, EJECT ??

      VAR
        keyword_qualifier: ^clt$keyword_type_qualifier,
        number_of_usage_keywords: 0 .. clc$max_keywords;


      number_of_keywords := 0;
      number_of_usage_keywords := 0;
      availability := clc$normal_usage_entry;
      ordinal := 1;

      NEXT keyword_qualifier IN work_area;
      IF keyword_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      NEXT first_keyword_specification IN work_area;
      IF first_keyword_specification = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        get_next_line;
      IFEND;

    /evaluate_keyword/
      WHILE TRUE DO
        CASE parse.unit.kind OF

        = clc$lex_left_parenthesis =
          evaluate_keyword_group;

        = clc$lex_name =
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

          IF name = 'ADVANCED_KEY' THEN
            IF number_of_usage_keywords = 0 THEN
              osp$set_status_abnormal ('CL', cle$no_normal_usage_keywords, '', status);
              EXIT evaluate_type_expression;
            IFEND;
            availability := clc$advanced_usage_entry;
            number_of_usage_keywords := 0;
            clp$scan_non_space_lexical_unit (parse);
            IF parse.unit.kind = clc$lex_end_of_line THEN
              get_next_line;
            IFEND;
            CYCLE /evaluate_keyword/;

          ELSEIF name = 'HIDDEN_KEY' THEN
            IF number_of_usage_keywords = 0 THEN
              IF availability = clc$normal_usage_entry THEN
                osp$set_status_abnormal ('CL', cle$no_normal_usage_keywords, '', status);
              ELSE
                osp$set_status_abnormal ('CL', cle$no_advanced_usage_keywords, '', status);
              IFEND;
              EXIT evaluate_type_expression;
            IFEND;
            availability := clc$hidden_entry;
            number_of_usage_keywords := 0;
            clp$scan_non_space_lexical_unit (parse);
            IF parse.unit.kind = clc$lex_end_of_line THEN
              get_next_line;
            IFEND;
            CYCLE /evaluate_keyword/;

          ELSEIF name = 'KEYEND' THEN
            IF number_of_usage_keywords = 0 THEN
              CASE availability OF
              = clc$normal_usage_entry =
                osp$set_status_abnormal ('CL', cle$no_keywords, '', status);
              = clc$advanced_usage_entry =
                osp$set_status_abnormal ('CL', cle$no_advanced_usage_keywords, '', status);
              ELSE {= clc$hidden_entry =}
                osp$set_status_abnormal ('CL', cle$no_hidden_keywords, '', status);
              CASEND;
              EXIT evaluate_type_expression;
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
            EXIT /evaluate_keyword/;

          ELSE
            check_for_duplicate_keyword;

            number_of_keywords := number_of_keywords + 1;
            number_of_usage_keywords := number_of_usage_keywords + 1;
            RESET work_area TO first_keyword_specification;
            NEXT keywords: [1 .. number_of_keywords] IN work_area;
            IF keywords = NIL THEN
              osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
              EXIT evaluate_type_expression;
            IFEND;
            keywords^ [number_of_keywords].keyword := name;
            keywords^ [number_of_keywords].class := clc$nominal_entry;
            keywords^ [number_of_keywords].availability := availability;
            keywords^ [number_of_keywords].ordinal := ordinal;
          IFEND;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_type_expression;

        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_key_in_spec, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        CASEND;

        ordinal := ordinal + 1;
        clp$scan_non_space_lexical_unit (parse);
        CASE parse.unit.kind OF
        = clc$lex_end_of_line =
          get_next_line;
        = clc$lex_comma =
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
        ELSE
          ;
        CASEND;
      WHILEND /evaluate_keyword/;

      keyword_qualifier^.number_of_keywords := number_of_keywords;
      sort_keywords;

    PROCEND evaluate_keyword_type;
?? TITLE := 'evaluate_list_type', EJECT ??

    PROCEDURE evaluate_list_type;

      VAR
        element_type_specification: ^clt$type_specification,
        elements_context: clt$declaration_context,
        high_integer: integer,
        ignore_range_present: boolean,
        list_qualifier: ^clt$list_type_qualifier_v2,
        low_integer: integer,
        name: ost$name,
        qualifier_present: boolean,
*IF $true(osv$unix)
        type_spec_size: integer,
*IFEND
        symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


      NEXT list_qualifier IN work_area;
      IF list_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;
      init_symbolic_subrange_qual (symbolic_subrange_qualifier);

      list_qualifier^.element_type_specification_size := 0;
      list_qualifier^.min_list_size := $INTEGER (context.kind <> clc$type_declaration);
      list_qualifier^.max_list_size := clc$max_list_size;
      list_qualifier^.reserved := 0;
      list_qualifier^.defer_expansion := FALSE;
      list_qualifier^.list_rest := FALSE;

      clp$scan_non_space_lexical_unit (parse);

      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = 'REST' THEN
          context.list_rest_encountered := TRUE;
          IF NOT context.list_rest_allowed THEN
            osp$set_status_abnormal ('CL', cle$improper_use_of_list_rest, '', status);
            EXIT evaluate_type_expression;
          IFEND;
          list_qualifier^.list_rest := TRUE;
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
      IFEND;

      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = 'DEFER_EXPANSION' THEN
          list_qualifier^.defer_expansion := TRUE;
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_equal, clc$lex_semicolon, clc$lex_right_parenthesis =
        IF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$list_elem_type_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;
        RETURN;
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'LIST', status);
          EXIT evaluate_type_expression;
        IFEND;
      CASEND;

    /evaluate_list_bounds/
      BEGIN
        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
          IF name = 'OF' THEN
            EXIT /evaluate_list_bounds/;
          IFEND;
        IFEND;

        evaluate_subrange_qualifier (0, clc$max_list_size, cle$list_bound_out_of_range,
              cle$min_list_bound_gt_max, cle$max_list_bound_omitted, symbolic_subrange_qualifier, low_integer,
              high_integer, ignore_range_present, qualifier_present);
        IF qualifier_present THEN
          list_qualifier^.min_list_size := low_integer;
        ELSE
          list_qualifier^.min_list_size := 1;
        IFEND;
        list_qualifier^.max_list_size := high_integer;

        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IFEND;
      END /evaluate_list_bounds/;

      CASE parse.unit.kind OF

      = clc$lex_end_of_line, clc$lex_equal, clc$lex_semicolon, clc$lex_right_parenthesis =
        IF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$list_elem_type_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;

      = clc$lex_name =
        IF name <> 'OF' THEN
          osp$set_status_abnormal ('CL', cle$expecting_of_for_list, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        IFEND;

        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;

        elements_context.kind := context.kind;
        elements_context.identifier := context.identifier;
        elements_context.unspecified_type_allowed := FALSE;
        elements_context.list_rest_allowed := FALSE;
        elements_context.list_rest_encountered := FALSE;

*IF $true(osv$unix)
        type_spec_size := i#current_sequence_position (work_area);
*IFEND
        evaluate_type_expression (osc$null_name, get_line, parse, elements_context,
              symbolic_qualifiers_work_area, work_area, element_type_specification, status);
        IF NOT status.normal THEN
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        list_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
*ELSE
        list_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
{       type_spec_size := #SIZE (element_type_specification^);
{       stringrep(line,size,'the size of the element type spec is: ',type_spec_size);
{       print_string(line,size);
{       list_qualifier^.element_type_specification_size :=
{             ((3 + #SIZE (element_type_specification^)) DIV 4) * 4;
{       stringrep(line,size,'the size after fudge is: ',
{             list_qualifier^.element_type_specification_size);
{       print_string(line,size);
{       list_qualifier^.element_type_specification_size :=
{             i#current_sequence_position (work_area) - type_spec_size;
*IFEND

      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        EXIT evaluate_type_expression;

      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_of_for_list, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT evaluate_type_expression;
      CASEND;

    PROCEND evaluate_list_type;
?? TITLE := 'evaluate_name_type', EJECT ??

    PROCEDURE [INLINE] evaluate_name_type;

      VAR
        ignore_qualifier_present: boolean,
        max_size: integer,
        min_size: integer,
        name_qualifier: ^clt$name_type_qualifier,
        range_present: boolean,
        symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


      NEXT name_qualifier IN work_area;
      IF name_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;
      init_symbolic_subrange_qual (symbolic_subrange_qualifier);

      clp$scan_non_space_lexical_unit (parse);
      evaluate_subrange_qualifier (1, osc$max_name_size, cle$name_size_out_of_range, cle$min_name_size_gt_max,
            0, symbolic_subrange_qualifier, min_size, max_size, range_present, ignore_qualifier_present);
      IF range_present THEN
        name_qualifier^.min_name_size := min_size;
      ELSE
        name_qualifier^.min_name_size := 1;
      IFEND;
      name_qualifier^.max_name_size := max_size;

    PROCEND evaluate_name_type;
?? TITLE := 'evaluate_range_type', EJECT ??

    PROCEDURE evaluate_range_type;

      VAR
        element_type_specification: ^clt$type_specification,
        elements_context: clt$declaration_context,
        name: ost$name,
        range_qualifier: ^clt$range_type_qualifier;


      NEXT range_qualifier IN work_area;
      IF range_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      range_qualifier^.element_type_specification_size := 0;

      clp$scan_non_space_lexical_unit (parse);
      CASE parse.unit.kind OF

      = clc$lex_end_of_line, clc$lex_equal, clc$lex_right_parenthesis, clc$lex_semicolon =
        IF context.kind = clc$type_declaration THEN
          osp$set_status_abnormal ('CL', cle$range_elem_type_required, '', status);
          EXIT evaluate_type_expression;
        IFEND;

      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name <> 'OF' THEN
          osp$set_status_abnormal ('CL', cle$expecting_of_for_range, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        IFEND;

        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_before, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'OF', status);
          EXIT evaluate_type_expression;
        IFEND;

        elements_context.kind := context.kind;
        elements_context.identifier := context.identifier;
        elements_context.unspecified_type_allowed := FALSE;
        elements_context.list_rest_allowed := FALSE;
        elements_context.list_rest_encountered := FALSE;

        evaluate_type_expression (osc$null_name, get_line, parse, elements_context,
              symbolic_qualifiers_work_area, work_area, element_type_specification, status);
        IF NOT status.normal THEN
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        range_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
*ELSE
        range_qualifier^.element_type_specification_size := #SIZE (element_type_specification^);
{       range_qualifier^.element_type_specification_size :=
{             ((3 + #SIZE (element_type_specification^)) DIV 4) * 4;
*IFEND

      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        EXIT evaluate_type_expression;

      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_of_for_range, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT evaluate_type_expression;
      CASEND;

    PROCEND evaluate_range_type;
*IF NOT $true(osv$unix)
?? TITLE := 'evaluate_real_type', EJECT ??

    PROCEDURE evaluate_real_type;

      VAR
        real_qualifier: ^clt$real_type_qualifier,
        result_real: clt$real;


      NEXT real_qualifier IN work_area;
      IF real_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      clp$scan_non_space_lexical_unit (parse);

      CASE parse.unit.kind OF
      = clc$lex_equal, clc$lex_comma, clc$lex_semicolon, clc$lex_end_of_line, clc$lex_right_parenthesis =
        real_qualifier^.min_real_value.long_real := clv$negative_infinity^;
        real_qualifier^.max_real_value.long_real := clv$positive_infinity^;
        RETURN;
      ELSE
        IF parse.unit_index >= parse.index_limit THEN
          real_qualifier^.min_real_value.long_real := clv$negative_infinity^;
          real_qualifier^.max_real_value.long_real := clv$positive_infinity^;
          RETURN;
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, 'REAL', status);
          EXIT evaluate_type_expression;
        IFEND;
      CASEND;

      clp$evaluate_real_expression (clv$negative_infinity^, clv$positive_infinity^, work_area, parse,
            result_real, status);
      IF NOT status.normal THEN
        EXIT evaluate_type_expression;
      IFEND;
      real_qualifier^.min_real_value.long_real := result_real.value;

      IF parse.unit.kind <> clc$lex_ellipsis THEN
        osp$set_status_abnormal ('CL', cle$max_of_subrange_omitted, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      clp$scan_non_space_lexical_unit (parse);
      clp$evaluate_real_expression (clv$negative_infinity^, clv$positive_infinity^, work_area, parse,
            result_real, status);
      IF NOT status.normal THEN
        EXIT evaluate_type_expression;
      IFEND;
      real_qualifier^.max_real_value.long_real := result_real.value;

      IF NOT clp$longreal_compare_le (real_qualifier^.min_real_value.long_real,
            real_qualifier^.max_real_value.long_real) THEN
        osp$set_status_abnormal ('CL', cle$min_of_subrange_not_le_max, '', status);
        EXIT evaluate_type_expression;
      IFEND;

    PROCEND evaluate_real_type;
*IFEND
?? TITLE := 'evaluate_record_type', EJECT ??

    PROCEDURE evaluate_record_type;

      VAR
        field_specification: ^clt$field_specification;

?? NEWTITLE := 'evaluate_field_requirement', EJECT ??

      PROCEDURE evaluate_field_requirement;


        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;

        CASE parse.unit.kind OF
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_type_expression;
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_field_requirement, field_specification^.name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        CASEND;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = '$OPTIONAL' THEN
          field_specification^.requirement := clc$optional_field;
        ELSEIF name <> '$REQUIRED' THEN
          osp$set_status_abnormal ('CL', cle$expecting_field_requirement, field_specification^.name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, name, status);
          EXIT evaluate_type_expression;
        IFEND;

        clp$scan_non_space_lexical_unit (parse);

      PROCEND evaluate_field_requirement;
?? OLDTITLE, EJECT ??

      TYPE
        clt$field_names_list_entry = record
          previous: ^clt$field_names_list_entry,
          name: ^clt$field_name,
        recend;

      VAR
        current_field_name: ^clt$field_names_list_entry,
        field_names_list: ^clt$field_names_list_entry,
        field_type_specification: ^clt$type_specification,
        fields_context: clt$declaration_context,
        name: ost$name,
        number_of_fields: 0 .. clc$max_fields,
        previous_unit_is_end_of_line: boolean,
        record_qualifier: ^clt$record_type_qualifier;


      NEXT record_qualifier IN work_area;
      IF record_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      fields_context.kind := clc$type_declaration;
      fields_context.identifier := context.identifier;
      fields_context.unspecified_type_allowed := FALSE;
      fields_context.list_rest_allowed := TRUE;
      fields_context.list_rest_encountered := FALSE;

      field_names_list := NIL;
      number_of_fields := 0;

      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        get_next_line;
      IFEND;

      WHILE TRUE DO
        CASE parse.unit.kind OF
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT evaluate_type_expression;
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_record_field_name, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        CASEND;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = 'RECEND' THEN
          IF number_of_fields = 0 THEN
            osp$set_status_abnormal ('CL', cle$no_record_fields, '', status);
            EXIT evaluate_type_expression;
          IFEND;
          record_qualifier^.number_of_fields := number_of_fields;
          clp$scan_non_space_lexical_unit (parse);
          RETURN;
        IFEND;

        IF fields_context.list_rest_encountered THEN
          osp$set_status_abnormal ('CL', cle$improper_use_of_list_rest, '', status);
          EXIT evaluate_type_expression;
        IFEND;

        current_field_name := field_names_list;
        WHILE current_field_name <> NIL DO
          IF name = current_field_name^.name^ THEN
            osp$set_status_abnormal ('CL', cle$duplicate_field_name, name, status);
            EXIT evaluate_type_expression;
          IFEND;
          current_field_name := current_field_name^.previous;
        WHILEND;

        NEXT field_specification IN work_area;
        IF field_specification = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT evaluate_type_expression;
        IFEND;

        number_of_fields := number_of_fields + 1;
        field_specification^.name := name;
        field_specification^.requirement := clc$required_field;
        field_specification^.type_specification_size := 0;

        PUSH current_field_name;
        current_field_name^.previous := field_names_list;
        current_field_name^.name := ^field_specification^.name;
        field_names_list := current_field_name;

        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;
        IF parse.unit.kind <> clc$lex_colon THEN
          osp$set_status_abnormal ('CL', cle$expecting_after_field_name, field_specification^.name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;

        evaluate_type_expression (osc$null_name, get_line, parse, fields_context,
              symbolic_qualifiers_work_area, work_area, field_type_specification, status);
        IF NOT status.normal THEN
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        field_specification^.type_specification_size := #SIZE (field_type_specification^);
*ELSE
        field_specification^.type_specification_size := #SIZE (field_type_specification^);
{       field_specification^.type_specification_size :=
{             ((3 + #SIZE (field_type_specification^)) DIV 4) * 4;
*IFEND

        previous_unit_is_end_of_line := parse.unit.kind = clc$lex_end_of_line;
        IF previous_unit_is_end_of_line THEN
          get_next_line;
        IFEND;

        IF parse.unit.kind = clc$lex_equal THEN
          previous_unit_is_end_of_line := FALSE;
          evaluate_field_requirement;
        IFEND;

        CASE parse.unit.kind OF
        = clc$lex_comma, clc$lex_semicolon =
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
        = clc$lex_end_of_line =
          get_next_line;
        ELSE
          IF NOT previous_unit_is_end_of_line THEN
            osp$set_status_abnormal ('CL', cle$expecting_after_field_spec, field_specification^.name, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT evaluate_type_expression;
          IFEND;
        CASEND;
      WHILEND;

    PROCEND evaluate_record_type;
?? TITLE := 'evaluate_string_type', EJECT ??

    PROCEDURE [INLINE] evaluate_string_type;

      VAR
        ignore_qualifier_present: boolean,
        ignore_range_present: boolean,
        max_size: integer,
        min_size: integer,
        string_qualifier: ^clt$string_type_qualifier,
        symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


      NEXT string_qualifier IN work_area;
      IF string_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;
      init_symbolic_subrange_qual (symbolic_subrange_qualifier);

      clp$scan_non_space_lexical_unit (parse);

      string_qualifier^.literal := FALSE;
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = 'LITERAL' THEN
          string_qualifier^.literal := TRUE;
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
      IFEND;

      evaluate_subrange_qualifier (0, clc$max_string_size, cle$string_size_out_of_range,
            cle$min_string_size_gt_max, 0, symbolic_subrange_qualifier, min_size, max_size,
            ignore_range_present, ignore_qualifier_present);
      string_qualifier^.min_string_size := min_size;
      string_qualifier^.max_string_size := max_size;

    PROCEND evaluate_string_type;
?? TITLE := 'evaluate_subrange_qualifier', EJECT ??

    PROCEDURE evaluate_subrange_qualifier
      (    nominal_low: integer;
           nominal_high: integer;
           out_of_range: ost$status_condition_code;
           low_greater_than_high: ost$status_condition_code;
           high_omitted: ost$status_condition_code;
           symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;
       VAR actual_low: integer;
       VAR actual_high: integer;
       VAR range_present: boolean;
       VAR qualifier_present: boolean);

?? NEWTITLE := 'save_subrange_expression', EJECT ??

      PROCEDURE save_subrange_expression
        (VAR size: clt$expression_text_size);

        VAR
          start_index: clt$string_index,
          text: ^clt$expression_text;


        start_index := parse.unit_index;
        clp$scan_unnested_rel_lex_unit (parse);
        size := parse.previous_non_space_unit_index + parse.previous_non_space_unit.size - start_index;

        NEXT text: [size] IN symbolic_qualifiers_work_area;
        IF text = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT evaluate_type_expression;
        IFEND;
        text^ := parse.text^ (start_index, size);

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

      PROCEND save_subrange_expression;
?? OLDTITLE, EJECT ??

      VAR
        generic_type_name: clt$type_name,
        result_integer: clt$integer;


      actual_low := nominal_low;
      actual_high := nominal_high;
      range_present := FALSE;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_equal, clc$lex_comma, clc$lex_semicolon, clc$lex_end_of_line, clc$lex_right_parenthesis =
        qualifier_present := FALSE;
        RETURN;
      ELSE
        IF parse.unit_index >= parse.index_limit THEN
          qualifier_present := FALSE;
          RETURN;
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.previous_non_space_unit_index,
                parse.previous_non_space_unit.size), generic_type_name);
          osp$set_status_abnormal ('CL', cle$missing_spaces_after, generic_type_name, status);
          EXIT evaluate_type_expression;
        IFEND;
        qualifier_present := TRUE;
      CASEND;

      IF symbolic_qualifiers_work_area <> NIL THEN
        save_subrange_expression (symbolic_subrange_qualifier^.low_text_size);
      ELSE
        clp$evaluate_integer_expression (nominal_low, nominal_high, work_area, parse, result_integer, status);
        IF NOT status.normal THEN
          IF status.condition = cle$integer_out_of_range THEN
            status.condition := out_of_range;
          IFEND;
          EXIT evaluate_type_expression;
        IFEND;
        actual_low := result_integer.value;
      IFEND;

      IF parse.unit.kind <> clc$lex_ellipsis THEN
        IF high_omitted <> 0 THEN
          osp$set_status_abnormal ('CL', high_omitted, '', status);
          EXIT evaluate_type_expression;
        IFEND;
        actual_high := actual_low;
        RETURN;
      IFEND;

      range_present := TRUE;
      clp$scan_non_space_lexical_unit (parse);

      IF symbolic_qualifiers_work_area <> NIL THEN
        save_subrange_expression (symbolic_subrange_qualifier^.high_text_size);
      ELSE
        clp$evaluate_integer_expression (nominal_low, nominal_high, work_area, parse, result_integer, status);
        IF NOT status.normal THEN
          IF status.condition = cle$integer_out_of_range THEN
            status.condition := out_of_range;
          IFEND;
          EXIT evaluate_type_expression;
        IFEND;
        actual_high := result_integer.value;
      IFEND;

      IF actual_low > actual_high THEN
        osp$set_status_abnormal ('CL', low_greater_than_high, '', status);
        EXIT evaluate_type_expression;
      IFEND;

    PROCEND evaluate_subrange_qualifier;
?? TITLE := 'evaluate_union_type', EJECT ??

    PROCEDURE evaluate_union_type;

      VAR
        member_type_specification: ^clt$type_specification,
        name: ost$name,
        type_specification_size: ^clt$type_specification_size,
        union_default_radix: 2 .. 16,
*IF NOT $true(osv$unix)
        union_qualifier: ^clt$union_type_qualifier;
*ELSE
        union_qualifier: ^clt$union_type_qualifier_v2;
*IFEND

?? NEWTITLE := 'merge_member_type', EJECT ??

      PROCEDURE [INLINE] merge_member_type;

        VAR
          integer_qualifier: ^clt$integer_type_qualifier,
*IF NOT $true(osv$unix)
          member_union_qualifier: ^clt$union_type_qualifier,
*ELSE
          member_union_qualifier: ^clt$union_type_qualifier_v2,
*IFEND
          real_qualifier: ^clt$real_type_qualifier,
          string_qualifier: ^clt$string_type_qualifier,
          type_header: ^clt$type_specification_header,
          type_header_name: ^clt$type_name_reference;


        NEXT type_header IN member_type_specification;
        NEXT type_header_name: [type_header^.name_size] IN member_type_specification;
        CASE type_header^.kind OF

        = clc$boolean_type, clc$file_type, clc$status_type, clc$string_pattern_type =
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                (NOT (clc$name_type IN union_qualifier^.kinds));

        = clc$integer_type =
          NEXT integer_qualifier IN member_type_specification;
*IF NOT $true(osv$unix)
          IF (($clt$type_kinds [clc$integer_type, clc$real_type] * union_qualifier^.kinds) <>
                $clt$type_kinds []) AND (union_default_radix <> integer_qualifier^.default_radix) THEN
*ELSE
          IF (($clt$type_kinds_v2 [clc$integer_type, clc$real_type] * union_qualifier^.kinds) <>
                $clt$type_kinds_v2 []) AND (union_default_radix <> integer_qualifier^.default_radix) THEN
*IFEND
            osp$set_status_abnormal ('CL', cle$inconsistent_radix_in_union, '', status);
            EXIT evaluate_type_expression;
          IFEND;
          union_default_radix := integer_qualifier^.default_radix;

          { The integer type is standard provided its default radix is 10. }
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                (integer_qualifier^.default_radix = 10) AND (NOT (clc$name_type IN union_qualifier^.kinds));

        = clc$name_type =
          { The name type is standard provided that the file type is not already in the union.
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                (NOT (clc$file_type IN union_qualifier^.kinds));

        = clc$real_type =
          NEXT real_qualifier IN member_type_specification;
*IF NOT $true(osv$unix)
          IF (($clt$type_kinds [clc$integer_type, clc$real_type] * union_qualifier^.kinds) <>
                $clt$type_kinds []) AND (union_default_radix <> 10) THEN
*ELSE
          IF (($clt$type_kinds_v2 [clc$integer_type, clc$real_type] * union_qualifier^.kinds) <>
                $clt$type_kinds_v2 []) AND (union_default_radix <> 10) THEN
*IFEND
            osp$set_status_abnormal ('CL', cle$inconsistent_radix_in_union, '', status);
            EXIT evaluate_type_expression;
          IFEND;
          union_default_radix := 10;
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                (NOT (clc$name_type IN union_qualifier^.kinds));

        = clc$string_type =
          NEXT string_qualifier IN member_type_specification;
          { The string type is standard provided the literal qualifier was not present. }
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                (NOT string_qualifier^.literal) AND (NOT (clc$name_type IN union_qualifier^.kinds));

        = clc$union_type =
          NEXT member_union_qualifier IN member_type_specification;
          union_qualifier^.only_standard_types_in_union := union_qualifier^.only_standard_types_in_union AND
                member_union_qualifier^.only_standard_types_in_union;

          union_qualifier^.kinds := union_qualifier^.kinds + member_union_qualifier^.kinds;

        ELSE
          union_qualifier^.only_standard_types_in_union := FALSE;
        CASEND;

*IF NOT $true(osv$unix)
        union_qualifier^.kinds := union_qualifier^.kinds + $clt$type_kinds [type_header^.kind];
*ELSE
        union_qualifier^.kinds := union_qualifier^.kinds + $clt$type_kinds_v2 [type_header^.kind];
*IFEND
        RESET member_type_specification;
        union_qualifier^.number_of_members := union_qualifier^.number_of_members + 1;

      PROCEND merge_member_type;
?? OLDTITLE, EJECT ??

      VAR
        members_context: clt$declaration_context;


      NEXT union_qualifier IN work_area;
      IF union_qualifier = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        EXIT evaluate_type_expression;
      IFEND;

      union_default_radix := 10;
      union_qualifier^.number_of_members := 0;

      clp$scan_non_space_lexical_unit (parse);
      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_equal, clc$lex_right_parenthesis, clc$lex_semicolon =
*IF NOT $true(osv$unix)
        union_qualifier^.kinds := -$clt$type_kinds [];
*ELSE
        union_qualifier^.kinds := -$clt$type_kinds_v2 [];
*IFEND
        union_qualifier^.only_standard_types_in_union := FALSE;
        RETURN;
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name <> 'OF' THEN
          osp$set_status_abnormal ('CL', cle$expecting_of_for_any, name, status);
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        union_qualifier^.kinds := $clt$type_kinds [];
*ELSE
        union_qualifier^.kinds := $clt$type_kinds_v2 [];
*IFEND
        union_qualifier^.only_standard_types_in_union := TRUE;
      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        EXIT evaluate_type_expression;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_of_for_any, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT evaluate_type_expression;
      CASEND;

      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        get_next_line;
      IFEND;

      members_context.kind := context.kind;
      members_context.identifier := context.identifier;
      members_context.unspecified_type_allowed := FALSE;
      members_context.list_rest_allowed := FALSE;
      members_context.list_rest_encountered := FALSE;

      WHILE TRUE DO
        IF parse.unit.kind = clc$lex_name THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
          IF name = 'ANYEND' THEN
            IF union_qualifier^.number_of_members = 0 THEN
              osp$set_status_abnormal ('CL', cle$no_union_members, '', status);
              EXIT evaluate_type_expression;
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
            RETURN;
          IFEND;
        IFEND;

        NEXT type_specification_size IN work_area;
        IF type_specification_size = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT evaluate_type_expression;
        IFEND;

        evaluate_type_expression (osc$null_name, get_line, parse, members_context,
              symbolic_qualifiers_work_area, work_area, member_type_specification, status);
        IF NOT status.normal THEN
          EXIT evaluate_type_expression;
        IFEND;
*IF NOT $true(osv$unix)
        type_specification_size^ := #SIZE (member_type_specification^);
*ELSE
        type_specification_size^ := #SIZE (member_type_specification^);
{       type_specification_size^ := ((3 + #SIZE (member_type_specification^)) DIV 4) * 4;
*IFEND

        merge_member_type;

        CASE parse.unit.kind OF
        = clc$lex_comma, clc$lex_semicolon =
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
        = clc$lex_end_of_line =
          get_next_line;
        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_after_member_spec, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT evaluate_type_expression;
        CASEND;
      WHILEND;

    PROCEND evaluate_union_type;
?? TITLE := 'get_next_line', EJECT ??

    PROCEDURE [INLINE] get_next_line;

      VAR
        end_of_input: boolean;


      IF get_line = NIL THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        EXIT evaluate_type_expression;
      IFEND;

      get_line^ (parse, end_of_input, status);

      IF NOT status.normal THEN
        EXIT evaluate_type_expression;
      ELSEIF end_of_input THEN
        osp$set_status_abnormal ('CL', cle$eoi_in_declaration, context.identifier, status);
        EXIT evaluate_type_expression;
      IFEND;
      clp$scan_non_space_lexical_unit (parse);

    PROCEND get_next_line;
?? TITLE := 'init_symbolic_subrange_qual', EJECT ??

    PROCEDURE [INLINE] init_symbolic_subrange_qual
      (VAR symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier);


      IF symbolic_qualifiers_work_area <> NIL THEN
        NEXT symbolic_subrange_qualifier IN symbolic_qualifiers_work_area;
        IF symbolic_subrange_qualifier = NIL THEN
          osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
          EXIT evaluate_type_expression;
        IFEND;
        symbolic_subrange_qualifier^.low_text_size := 0;
        symbolic_subrange_qualifier^.high_text_size := 0;
      ELSE
        symbolic_subrange_qualifier := NIL;
      IFEND;

    PROCEND init_symbolic_subrange_qual;
?? OLDTITLE, EJECT ??

    VAR
*IF $true(osv$unix)
      i: clt$type_kind,
      kludge_type_specification: ^ array [*] of cell,
*IFEND
      defined_type_specification: ^clt$type_specification,
      generic_type_descriptor: ^clt$generic_type_descriptor,
      temp_type_specification: ^clt$type_specification,
      type_header: ^clt$type_specification_header,
      type_header_name: ^clt$type_name_reference,
      type_specification_size: clt$type_specification_size;


    status.normal := TRUE;
    type_specification := NIL;

    NEXT type_header IN work_area;
    IF type_header = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;
    type_header^.version := clc$declaration_version;
    type_header^.name_size := clp$trimmed_string_size (type_name);
    IF type_header^.name_size > 0 THEN
      NEXT type_header_name: [type_header^.name_size] IN work_area;
      IF type_header = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      type_header_name^ := type_name;
    IFEND;

    IF parse.unit.kind <> clc$lex_name THEN
      osp$set_status_abnormal ('CL', cle$expecting_type_expression, '', status);
      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);
    check_for_generic_type (name, parse.unit.size, generic_type_descriptor);

    IF generic_type_descriptor = NIL THEN
      RESET work_area TO type_header;

      check_for_defined_type (name, defined_type_specification);
      IF defined_type_specification = NIL THEN
        osp$set_status_abnormal ('CL', cle$expecting_type_expression, name, status);
        RETURN;
      IFEND;

*IF NOT $true(osv$unix)
      type_specification_size := #SIZE (defined_type_specification^);
*ELSE
      type_specification_size :=
            ((3 + #SIZE (defined_type_specification^)) DIV 4) * 4;
*IFEND
      PUSH temp_type_specification: [[REP type_specification_size OF cell]];
      temp_type_specification^ := defined_type_specification^;
      RESET work_area TO type_header;
      NEXT type_specification: [[REP type_specification_size OF cell]] IN work_area;
      IF type_specification = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      type_specification^ := temp_type_specification^;
      RETURN;
    IFEND;

    type_header^.kind := generic_type_descriptor^.kind;

    IF type_name = clv$type_kind_names [type_header^.kind] THEN
      RESET work_area TO type_header_name;
      type_header^.name_size := 0;
    IFEND;

    CASE type_header^.kind OF
    = clc$application_type =
      evaluate_application_type;
    = clc$array_type =
      evaluate_array_type;
    = clc$date_time_type =
      evaluate_date_time_type (generic_type_descriptor^.date_and_or_time);
    = clc$integer_type =
      evaluate_integer_type;
    = clc$keyword_type =
      evaluate_keyword_type;
    = clc$list_type =
      evaluate_list_type;
    = clc$name_type =
      evaluate_name_type;
    = clc$range_type =
      evaluate_range_type;
*IF NOT $true(osv$unix)
    = clc$real_type =
      evaluate_real_type;
*IFEND
    = clc$record_type =
      evaluate_record_type;
    = clc$string_type =
      evaluate_string_type;
    = clc$union_type =
      evaluate_union_type;
    ELSE
      clp$scan_non_space_lexical_unit (parse);
    CASEND;

    type_specification_size := i#current_sequence_position (work_area);
    RESET work_area TO type_header;
    type_specification_size := type_specification_size - i#current_sequence_position (work_area);
*IF $true(osv$unix)
    NEXT kludge_type_specification: [1 .. type_specification_size] IN work_area;
    type_specification := #SEQ (kludge_type_specification^);
*ELSE
    NEXT type_specification: [[REP type_specification_size OF cell]] IN work_area;
*IFEND
    RESET type_specification;

  PROCEND evaluate_type_expression;

MODEND clm$generate_pdt_and_type;
