?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Translate Old PDT to New' ??
MODULE clm$translate_pdt;

{
{ PURPOSE:
{
{   This module contains the procedures that translate a
{   clt$parameter_descriptor_table (the old style PDT for commands) and a
{   clt$argument_descriptor_table (the old style PDT (ADT) for functions) to a
{   clt$unbundled_pdt.  It additionally contains a procedure to translate a
{   clt$value_kind_specifier to a clt$type_description.
{
{   It also contains the procedure that "bundles" a translated PDT into a
{   clt$parameter_description_table (the new style PDT for both commands and
{   functions.
{
{ NOTES:
{
{ 1. Because of the nature of the (older) clt$parameter_descriptor_table, the
{    following facts somewhat simplify the translation process:
{
{    a. The "depth" of a list can not exceed 2. That is "LIST OF LIST" can be
{       expected but no "LIST OF LIST OF LIST".
{    b. Neither LISTs nor RANGEs are possible for functions.
{    c. No more than two different types can exist for a parameter.
{    d. There will be no default name for a parameter.
{
{ 2. Restrictions:
{
{    a. A parameter declared as a LIST and/or RANGE OF VAR/ARRAY OF some_kind
{       cannot be translated.  Also, VAR/ARRAY OF some_kind OR KEY xxx cannot
{       be translated.
{
{ 3. Application value specifications are translated.  However, to properly
{    evaluate such parameters requires keeping the "old" PDT in order to be
{    able to call the application value scanner at the appropriate moment.
{    This is intended to be done by the clt$check_parameters_procedure
{    supplied by clp$scan_parameter_list.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*IF $true(osv$unix)
*copyc clc$declaration_version
*IFEND
*copyc cle$bad_pdt
*copyc cle$ecc_parsing
*copyc cle$work_area_overflow
*copyc clt$argument_descriptor_table
*copyc clt$parameter_description_table
*copyc clt$parameter_descriptor_table
*copyc clt$symbolic_parameters
*copyc clt$symbolic_subrange_qualifier
*copyc clt$type_description
*copyc clt$unbundled_pdt
*copyc clt$value_kind_specifier
*copyc clt$work_area
*IF NOT $true(osv$unix)
*copyc oss$job_paged_literal
*IFEND
*copyc ost$status
?? POP ??
*copyc clp$convert_integer_to_string
*copyc clp$convert_type_desc_to_spec
*copyc clp$trimmed_string_size
*copyc clv$negative_infinity
*copyc clv$positive_infinity
*copyc i#current_sequence_position
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
?? TITLE := 'old_union_type_description', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    old_union_type_description: [STATIC, READ, oss$job_paged_literal] clt$type_description :=
          [NIL, NIL, TRUE, FALSE, $clt$type_kinds [clc$boolean_type, clc$file_type, clc$integer_type,
          clc$name_type, clc$real_type, clc$status_type, clc$string_type], clc$union_type, ^old_union_members,
          ^old_union_information],
    old_union_members: [STATIC, READ, oss$job_paged_literal] array [1 .. 7] of clt$type_description := [
*ELSE
    old_union_type_description: [STATIC, READ] clt$type_description :=
          [NIL, NIL, TRUE, FALSE, $clt$type_kinds_v2 [clc$boolean_type, clc$nos_ve_file_type,
          clc$integer_type, clc$name_type, clc$real_type, clc$status_type, clc$string_type], clc$union_type,
          ^old_union_members, ^old_union_information],
    old_union_members: [STATIC, READ] array [1 .. 7] of clt$type_description := [
*IFEND
          {BOOLEAN} [NIL, NIL, TRUE, FALSE, [clc$boolean_type], clc$boolean_type],
          {NAME} [NIL, NIL, TRUE, FALSE, [clc$name_type], clc$name_type, 1, osc$max_name_size],
*IF NOT $true(osv$unix)
          {FILE} [NIL, NIL, TRUE, FALSE, [clc$file_type], clc$file_type],
*ELSE
          {NOS_VE_FILE} [NIL, NIL, TRUE, FALSE, [clc$nos_ve_file_type], clc$nos_ve_file_type],
*IFEND
          {INTEGER} [NIL, NIL, TRUE, FALSE, [clc$integer_type], clc$integer_type, clc$min_integer,
          clc$max_integer, 10],
          {REAL} [NIL, NIL, TRUE, FALSE, [clc$real_type], clc$real_type,
*IF NOT $true(osv$unix)
          [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16), 0]]], [{$INFINITY} 3, [[5000(16), 0],
          [5000(16), 0]]]],
*ELSE
*copy cli$longreal_negative_infinity
          ,
*copy cli$longreal_positive_infinity
          ],
*IFEND
          {STATUS} [NIL, NIL, TRUE, FALSE, [clc$status_type], clc$status_type],
          {STRING} [NIL, NIL, TRUE, FALSE, [clc$string_type], clc$string_type, 0, clc$max_string_size,
          FALSE]],
*IF NOT $true(osv$unix)
    old_union_information: [STATIC, READ, oss$job_paged_literal] clt$union_type_information :=
          [TRUE, clc$min_integer, clc$max_integer, 10, [{-$INFINITY} 3, [[0d000(16), 0], [0d000(16), 0]]],
          [{$INFINITY} 3, [[5000(16), 0], [5000(16), 0]]]];
*ELSE
    old_union_information: [STATIC, READ] clt$union_type_information :=
          [TRUE, clc$min_integer, clc$max_integer, 10,
*copy cli$longreal_negative_infinity
          ,
*copy cli$longreal_positive_infinity
          ];
*IFEND

?? TITLE := 'clp$type_desc_is_for_old_union', EJECT ??

  FUNCTION [XDCL] clp$type_desc_is_for_old_union
    (    type_description: ^clt$type_description): boolean;

    VAR
      i: 1 .. clc$max_union_members;


    clp$type_desc_is_for_old_union := FALSE;

    IF (type_description^.kinds <> old_union_type_description.kinds) OR
          (type_description^.member_descriptions = NIL) OR (UPPERBOUND (type_description^.
          member_descriptions^) <> UPPERBOUND (old_union_type_description.member_descriptions^)) THEN
      RETURN;
    IFEND;

    FOR i := 1 TO UPPERBOUND (type_description^.member_descriptions^) DO
      IF type_description^.member_descriptions^ [i].kind <> old_union_type_description.
            member_descriptions^ [i].kind THEN
        RETURN;
      IFEND;
    FOREND;

    clp$type_desc_is_for_old_union := TRUE;

  FUNCEND clp$type_desc_is_for_old_union;
?? TITLE := 'clp$translate_adt', EJECT ??

  PROCEDURE [XDCL] clp$translate_adt
    (    old_adt: ^clt$argument_descriptor_table;
         group_keywords: boolean;
     VAR work_area {input, output} : ^clt$work_area;
     VAR application_type_present: boolean;
     VAR new_pdt: clt$unbundled_pdt;
     VAR status: ost$status);

    VAR
      symbolic_qualifiers_work_area: ^clt$work_area;

?? NEWTITLE := 'initialize_header', EJECT ??

    PROCEDURE [INLINE] initialize_header;


      new_pdt.default_names := NIL;
      NEXT new_pdt.header IN work_area;

      new_pdt.header^.version := clc$declaration_version;
      new_pdt.header^.generation_date_time.year := 1987 - 1900;
      new_pdt.header^.generation_date_time.month := 9;
      new_pdt.header^.generation_date_time.day := 17;
      new_pdt.header^.generation_date_time.hour := 0;
      new_pdt.header^.generation_date_time.minute := 0;
      new_pdt.header^.generation_date_time.second := 0;
      new_pdt.header^.generation_date_time.millisecond := 0;
      new_pdt.header^.command_or_function := clc$function;
      new_pdt.header^.number_of_required_parameters := 0;
      new_pdt.header^.number_of_advanced_parameters := 0;
      new_pdt.header^.number_of_hidden_parameters := 0;
      new_pdt.header^.number_of_var_parameters := 0;
      new_pdt.header^.status_parameter_number := 0;
      new_pdt.header^.help_module_name := osc$null_name;

      IF old_adt = NIL THEN
        new_pdt.names := NIL;
        new_pdt.parameters := NIL;
        new_pdt.type_descriptions := NIL;
        new_pdt.default_values := NIL;
        new_pdt.header^.number_of_parameter_names := 0;
        new_pdt.header^.number_of_parameters := 0;
        EXIT clp$translate_adt;
      IFEND;

      new_pdt.header^.number_of_parameter_names := UPPERBOUND (old_adt^);
      new_pdt.header^.number_of_parameters := UPPERBOUND (old_adt^);

      NEXT new_pdt.names: [1 .. new_pdt.header^.number_of_parameter_names] IN work_area;
      NEXT new_pdt.parameters: [1 .. new_pdt.header^.number_of_parameters] IN work_area;
      NEXT new_pdt.type_descriptions: [1 .. new_pdt.header^.number_of_parameters] IN work_area;
      NEXT new_pdt.default_values: [1 .. new_pdt.header^.number_of_parameters] IN work_area;

    PROCEND initialize_header;
?? TITLE := 'create_parameter_names', EJECT ??

    PROCEDURE [INLINE] create_parameter_names;

      CONST
        parameter_name_prefix = 'PARAMETER_',
        parameter_name_prefix_size = 10 {STRLENGTH (parameter_name_prefix)} ;

      VAR
        i: clt$parameter_name_index,
        str: ^ost$string;


      str := NIL;
      FOR i := 1 TO new_pdt.header^.number_of_parameter_names DO
        new_pdt.names^ [i].name := parameter_name_prefix;
        IF i <= 9 THEN
          new_pdt.names^ [i].name (parameter_name_prefix_size + 1) := $CHAR ($INTEGER ('0') + i);
        ELSE
          IF str = NIL THEN
            PUSH str;
          IFEND;
          clp$convert_integer_to_string (i, 10, FALSE, str^, status);
          new_pdt.names^ [i].name (parameter_name_prefix_size + 1, * ) := str^.value (1, str^.size);
        IFEND;
        new_pdt.names^ [i].class := clc$nominal_entry;
        new_pdt.names^ [i].position := i;
        new_pdt.parameters^ [i].name_index := i;
      FOREND;

    PROCEND create_parameter_names;
?? TITLE := 'process_parameters', EJECT ??

    PROCEDURE [INLINE] process_parameters;

      VAR
        i: clt$parameter_number;


      FOR i := 1 TO new_pdt.header^.number_of_parameters DO
        new_pdt.parameters^ [i].availability := clc$normal_usage_entry;

        new_pdt.parameters^ [i].security := clc$non_secure_parameter;

        new_pdt.parameters^ [i].specification_methods := $clt$parameter_spec_methods
              [clc$specify_positionally];

        IF old_adt^ [i].value_kind_specifier.kind <> clc$variable_reference THEN
          new_pdt.parameters^ [i].passing_method := clc$pass_by_value;
        ELSE
          new_pdt.parameters^ [i].passing_method := clc$pass_by_reference;
        IFEND;

        new_pdt.parameters^ [i].evaluation_method := clc$immediate_evaluation;

        new_pdt.parameters^ [i].checking_level := clc$standard_parameter_checking;

        new_pdt.parameters^ [i].type_specification_size := 0;

        CASE old_adt^ [i].required_or_optional.selector OF

        = clc$required =
          new_pdt.header^.number_of_required_parameters := new_pdt.header^.number_of_required_parameters + 1;

          new_pdt.parameters^ [i].requirement := clc$required_parameter;
          new_pdt.parameters^ [i].default_value_size := 0;

          new_pdt.default_values^ [i] := NIL;

        = clc$optional_with_default =
          new_pdt.parameters^ [i].requirement := clc$optional_default_parameter;
          new_pdt.parameters^ [i].default_value_size := STRLENGTH (old_adt^ [i].required_or_optional.
                default^);

          new_pdt.default_values^ [i] := old_adt^ [i].required_or_optional.default;

        ELSE { clc$optional }
          new_pdt.parameters^ [i].requirement := clc$optional_parameter;
          new_pdt.parameters^ [i].default_value_size := 0;

          new_pdt.default_values^ [i] := NIL;
        CASEND;

        new_pdt.parameters^ [i].default_name_size := 0;
      FOREND;

    PROCEND process_parameters;
?? TITLE := 'translate_adt_types', EJECT ??

    PROCEDURE [INLINE] translate_adt_types;

      VAR
        i: clt$parameter_number,
        local_application_type_present: boolean,
        type_description: ^clt$type_description,
*IF NOT $true(osv$unix)
        type_kinds: clt$type_kinds;
*ELSE
        type_kinds: clt$type_kinds_v2;
*IFEND


      FOR i := 1 TO new_pdt.header^.number_of_parameters DO
        determine_type_kinds (old_adt^ [i].value_kind_specifier, type_kinds);

        type_description := ^new_pdt.type_descriptions^ [i];

        translate_type (type_kinds, TRUE, old_adt^ [i].value_kind_specifier, group_keywords, NIL,
              symbolic_qualifiers_work_area, work_area, local_application_type_present, type_description,
              status);
        IF NOT status.normal THEN
          EXIT clp$translate_adt;
        ELSEIF local_application_type_present THEN
          application_type_present := TRUE;
          new_pdt.parameters^ [i].checking_level := clc$extended_parameter_checking;
        IFEND;
      FOREND;

    PROCEND translate_adt_types;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    application_type_present := FALSE;
    symbolic_qualifiers_work_area := NIL;

    initialize_header;

    IF old_adt <> NIL THEN

      create_parameter_names;

      process_parameters;

      translate_adt_types;

      IF UPPERBOUND (old_adt^) > 9 THEN
        sort_parameter_names (new_pdt);
      IFEND;

    IFEND;

  PROCEND clp$translate_adt;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$translate_pdt', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$translate_pdt
    (    old_pdt: clt$parameter_descriptor_table;
         encode_file_values: boolean;
         group_keywords: boolean;
         report_status_procedure: ^procedure
           (    parameter_name: clt$parameter_name;
                error_status: ost$status;
            VAR status: ost$status);
         symbolic_parameters: ^clt$symbolic_parameters;
         symbolic_qualifiers_area: ^clt$work_area;
     VAR work_area {input, output} : ^clt$work_area;
     VAR application_type_present: boolean;
     VAR new_pdt: clt$unbundled_pdt;
     VAR status: ost$status);

    VAR
      symbolic_parameter: ^clt$symbolic_parameter,
      symbolic_qualifiers_work_area: ^clt$work_area;

{ The following variables are used only by translate_pdt_types and the various
{ "set type" routines it calls.  They are declared here so that those routines
{ can all be declared as INLINE.  (The "set type" routines should be nested
{ within translate_pdt_types but that would preclude it from being INLINE).

    VAR
      i: clt$parameter_number,
      list_specified: boolean,
      parameter_name: ^clt$parameter_name,
      range_specified: boolean,
      sub_list_specified: boolean,
      symbolic_qualifier_applicable: boolean,
      type_description: ^clt$type_description,
*IF NOT $true(osv$unix)
      type_kinds: clt$type_kinds,
*ELSE
      type_kinds: clt$type_kinds_v2,
*IFEND
      value_kind_specifier: ^clt$value_kind_specifier;

?? NEWTITLE := 'initialize_header', EJECT ??

    PROCEDURE [INLINE] initialize_header;


      new_pdt.default_names := NIL;
      NEXT new_pdt.header IN work_area;

      new_pdt.header^.version := clc$declaration_version;
      new_pdt.header^.generation_date_time.year := 1987 - 1900;
      new_pdt.header^.generation_date_time.month := 5;
      new_pdt.header^.generation_date_time.day := 20;
      new_pdt.header^.generation_date_time.hour := 0;
      new_pdt.header^.generation_date_time.minute := 0;
      new_pdt.header^.generation_date_time.second := 0;
      new_pdt.header^.generation_date_time.millisecond := 0;
      new_pdt.header^.command_or_function := clc$command;
      new_pdt.header^.number_of_required_parameters := 0;
      new_pdt.header^.number_of_advanced_parameters := 0;
      new_pdt.header^.number_of_hidden_parameters := 0;
      new_pdt.header^.number_of_var_parameters := 0;
      new_pdt.header^.status_parameter_number := 0;
      new_pdt.header^.help_module_name := osc$null_name;

      IF old_pdt.parameters = NIL THEN
        IF old_pdt.names <> NIL THEN
          osp$set_status_abnormal ('CL', cle$bad_pdt, '', status);
          EXIT clp$translate_pdt;
        IFEND;

        new_pdt.names := NIL;
        new_pdt.parameters := NIL;
        new_pdt.type_descriptions := NIL;
        new_pdt.default_values := NIL;
        new_pdt.header^.number_of_parameter_names := 0;
        new_pdt.header^.number_of_parameters := 0;
        EXIT clp$translate_pdt;

      ELSEIF old_pdt.names = NIL THEN
        osp$set_status_abnormal ('CL', cle$bad_pdt, '', status);
        EXIT clp$translate_pdt;
      IFEND;

      new_pdt.header^.number_of_parameter_names := UPPERBOUND (old_pdt.names^);
      new_pdt.header^.number_of_parameters := UPPERBOUND (old_pdt.parameters^);

      NEXT new_pdt.names: [1 .. new_pdt.header^.number_of_parameter_names] IN work_area;
      NEXT new_pdt.parameters: [1 .. new_pdt.header^.number_of_parameters] IN work_area;
      NEXT new_pdt.type_descriptions: [1 .. new_pdt.header^.number_of_parameters] IN work_area;
      NEXT new_pdt.default_values: [1 .. new_pdt.header^.number_of_parameters] IN work_area;

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

    PROCEDURE [INLINE] process_parameter_names;

      VAR
        i: clt$parameter_name_index,
        parameter_name_count: 0 .. clc$max_parameter_names,
        parameter_number: 0 .. clc$max_parameters;


      parameter_number := 0;
      parameter_name_count := 0;
      FOR i := 1 TO new_pdt.header^.number_of_parameter_names DO
        #TRANSLATE (osv$lower_to_upper, old_pdt.names^ [i].name, new_pdt.names^ [i].name);
        IF parameter_number <> old_pdt.names^ [i].number THEN
          IF parameter_name_count > 1 THEN
            new_pdt.names^ [i - 1].class := clc$abbreviation_entry;
          IFEND;
          parameter_number := old_pdt.names^ [i].number;
          IF (parameter_number < 1) OR (parameter_number > new_pdt.header^.number_of_parameters) THEN
            osp$set_status_abnormal ('CL', cle$bad_pdt, '', status);
            EXIT clp$translate_pdt;
          IFEND;
          parameter_name_count := 0;
        IFEND;
        IF parameter_name_count = 0 THEN
          new_pdt.names^ [i].class := clc$nominal_entry;
          new_pdt.parameters^ [parameter_number].name_index := i;
        ELSE
          new_pdt.names^ [i].class := clc$alias_entry;
        IFEND;
        parameter_name_count := parameter_name_count + 1;
        new_pdt.names^ [i].position := parameter_number;
      FOREND;
      IF parameter_name_count > 1 THEN
        new_pdt.names^ [i].class := clc$abbreviation_entry;
      IFEND;

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

    PROCEDURE [INLINE] process_parameters;

      VAR
        i: clt$parameter_number,
        name_index: integer;


      FOR i := 1 TO new_pdt.header^.number_of_parameters DO
        name_index := new_pdt.parameters^ [i].name_index;
        IF (name_index > new_pdt.header^.number_of_parameter_names) OR
              (new_pdt.names^ [name_index].position <> i) OR (new_pdt.names^ [name_index].class <>
              clc$nominal_entry) THEN
          osp$set_status_abnormal ('CL', cle$bad_pdt, '', status);
          EXIT clp$translate_pdt;
        IFEND;

        new_pdt.parameters^ [i].availability := clc$normal_usage_entry;

        new_pdt.parameters^ [i].security := clc$non_secure_parameter;

        new_pdt.parameters^ [i].specification_methods := $clt$parameter_spec_methods
              [clc$specify_by_name, clc$specify_positionally];

        IF old_pdt.parameters^ [i].value_kind_specifier.kind <> clc$variable_reference THEN
          new_pdt.parameters^ [i].passing_method := clc$pass_by_value;
        ELSE
          new_pdt.parameters^ [i].passing_method := clc$pass_by_reference;
          new_pdt.header^.number_of_var_parameters := new_pdt.header^.number_of_var_parameters + 1;
          IF (old_pdt.parameters^ [i].value_kind_specifier.variable_kind = clc$status_value) AND
                (new_pdt.names^ [name_index].name = 'STATUS') THEN

            new_pdt.parameters^ [i].specification_methods := $clt$parameter_spec_methods
                  [clc$specify_by_name];

            new_pdt.header^.status_parameter_number := i;
          IFEND;
        IFEND;

        new_pdt.parameters^ [i].evaluation_method := clc$immediate_evaluation;

        new_pdt.parameters^ [i].checking_level := clc$standard_parameter_checking;

        new_pdt.parameters^ [i].type_specification_size := 0;

        CASE old_pdt.parameters^ [i].required_or_optional.selector OF

        = clc$required =
          new_pdt.header^.number_of_required_parameters := new_pdt.header^.number_of_required_parameters + 1;

          new_pdt.parameters^ [i].requirement := clc$required_parameter;
          new_pdt.parameters^ [i].default_value_size := 0;

          new_pdt.default_values^ [i] := NIL;

        = clc$optional_with_default =
          new_pdt.parameters^ [i].requirement := clc$optional_default_parameter;
          new_pdt.parameters^ [i].default_value_size := STRLENGTH (old_pdt.parameters^ [i].
                required_or_optional.default^);

          new_pdt.default_values^ [i] := old_pdt.parameters^ [i].required_or_optional.default;

        ELSE { clc$optional }
          new_pdt.parameters^ [i].requirement := clc$optional_parameter;
          new_pdt.parameters^ [i].default_value_size := 0;

          new_pdt.default_values^ [i] := NIL;
        CASEND;

        new_pdt.parameters^ [i].default_name_size := 0;
      FOREND;

    PROCEND process_parameters;
?? TITLE := 'set_list_type', EJECT ??

    PROCEDURE [INLINE] set_list_type
      (    min_list_size: 1 .. clc$max_list_size;
           max_list_size: 1 .. clc$max_list_size);


      set_type (clc$list_type);
      type_description^.min_list_size := min_list_size;
      type_description^.max_list_size := max_list_size;
      type_description^.defer_expansion := FALSE;
      type_description^.list_rest := FALSE;
      NEXT type_description^.list_element_type_description IN work_area;
      type_description := type_description^.list_element_type_description;

    PROCEND set_list_type;
?? TITLE := 'set_range_type', EJECT ??

    PROCEDURE [INLINE] set_range_type;


      set_type (clc$range_type);
      NEXT type_description^.range_element_type_description IN work_area;
      type_description := type_description^.range_element_type_description;

    PROCEND set_range_type;
?? TITLE := 'set_type', EJECT ??

    PROCEDURE [INLINE] set_type
      (    kind: clt$type_kind);


      type_description^.specification := NIL;
      type_description^.name := NIL;
      type_description^.derived_from_value_kind_spec := encode_file_values;
      type_description^.advanced_keywords_present := FALSE;
      type_description^.kinds := type_kinds;
      type_description^.kind := kind;

    PROCEND set_type;
?? TITLE := 'translate_pdt_types', EJECT ??

    PROCEDURE [INLINE] translate_pdt_types;

      VAR
        local_application_type_present: boolean,
        status_to_report: ^ost$status;


      status_to_report := NIL;

    /process_parameter/
      FOR i := 1 TO new_pdt.header^.number_of_parameters DO
        parameter_name := ^new_pdt.names^ [new_pdt.parameters^ [i].name_index].name;

        IF symbolic_parameters = NIL THEN
          symbolic_parameter := NIL;
        ELSE
          symbolic_parameter := ^symbolic_parameters^ [i];
        IFEND;

        sub_list_specified := (old_pdt.parameters^ [i].max_values_per_set > 1) OR
              ((symbolic_parameter <> NIL) AND (symbolic_parameter^.max_values_per_set <> NIL));
        list_specified := sub_list_specified OR (old_pdt.parameters^ [i].max_value_sets > 1) OR
              ((symbolic_parameter <> NIL) AND (symbolic_parameter^.max_value_sets <> NIL));
        range_specified := old_pdt.parameters^ [i].value_range_allowed = clc$value_range_allowed;

        value_kind_specifier := ^old_pdt.parameters^ [i].value_kind_specifier;

        IF (list_specified OR range_specified OR (value_kind_specifier^.keyword_values <> NIL)) AND
              (value_kind_specifier^.kind = clc$variable_reference) THEN

          osp$set_status_abnormal ('CL', cle$unsupported_parameter_spec, parameter_name^, status);

          IF report_status_procedure <> NIL THEN
            IF status_to_report = NIL THEN
              PUSH status_to_report;
            IFEND;
            status_to_report^ := status;
            status.normal := TRUE;
            report_status_procedure^ (parameter_name^, status_to_report^, status);
            IF status.normal THEN
              new_pdt.names^ [new_pdt.parameters^ [i].name_index].name (osc$max_name_size) := '*';
              CYCLE /process_parameter/;
            IFEND;
          IFEND;

          EXIT clp$translate_pdt;
        IFEND;

        determine_type_kinds (value_kind_specifier^, type_kinds);

        IF range_specified THEN
*IF NOT $true(osv$unix)
          type_kinds := type_kinds + $clt$type_kinds [clc$range_type];
*ELSE
          type_kinds := type_kinds + $clt$type_kinds_v2 [clc$range_type];
*IFEND
        IFEND;

        type_description := ^new_pdt.type_descriptions^ [i];

        IF list_specified THEN
*IF NOT $true(osv$unix)
          type_kinds := type_kinds + $clt$type_kinds [clc$list_type];
*ELSE
          type_kinds := type_kinds + $clt$type_kinds_v2 [clc$list_type];
*IFEND
          set_list_type (old_pdt.parameters^ [i].min_value_sets, old_pdt.parameters^ [i].max_value_sets);
          IF symbolic_parameter <> NIL THEN
            set_symbolic_qualifier (symbolic_parameter^.min_value_sets, symbolic_parameter^.max_value_sets,
                  symbolic_qualifiers_work_area, status);
            IF NOT status.normal THEN
              EXIT clp$translate_pdt;
            IFEND;
          IFEND;

          IF sub_list_specified THEN
            set_list_type (old_pdt.parameters^ [i].min_values_per_set,
                  old_pdt.parameters^ [i].max_values_per_set);
            IF symbolic_parameter <> NIL THEN
              set_symbolic_qualifier (symbolic_parameter^.min_values_per_set,
                    symbolic_parameter^.max_values_per_set, symbolic_qualifiers_work_area, status);
              IF NOT status.normal THEN
                EXIT clp$translate_pdt;
              IFEND;
            IFEND;
          IFEND;
*IF NOT $true(osv$unix)
          type_kinds := type_kinds - $clt$type_kinds [clc$list_type];
*ELSE
          type_kinds := type_kinds - $clt$type_kinds_v2 [clc$list_type];
*IFEND
        IFEND;

        IF range_specified THEN
          set_range_type;
*IF NOT $true(osv$unix)
          type_kinds := type_kinds - $clt$type_kinds [clc$range_type];
*ELSE
          type_kinds := type_kinds - $clt$type_kinds_v2 [clc$range_type];
*IFEND
        IFEND;

        translate_type (type_kinds, encode_file_values, value_kind_specifier^, group_keywords,
              symbolic_parameter, symbolic_qualifiers_work_area, work_area, local_application_type_present,
              type_description, status);
        IF NOT status.normal THEN
          EXIT clp$translate_pdt;
        ELSEIF local_application_type_present THEN
          application_type_present := TRUE;
          new_pdt.parameters^ [i].checking_level := clc$extended_parameter_checking;
        IFEND;
      FOREND /process_parameter/;

    PROCEND translate_pdt_types;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    application_type_present := FALSE;
    symbolic_qualifiers_work_area := symbolic_qualifiers_area;

    initialize_header;

    IF old_pdt.parameters <> NIL THEN

      process_parameter_names;

      process_parameters;

      translate_pdt_types;

      sort_parameter_names (new_pdt);

    IFEND;

  PROCEND clp$translate_pdt;
?? TITLE := 'clp$translate_vks', EJECT ??

  PROCEDURE [XDCL] clp$translate_vks
    (    old_vks: clt$value_kind_specifier;
         group_keywords: boolean;
     VAR work_area {input, output} : ^clt$work_area;
     VAR application_type_present: boolean;
     VAR new_type_description: clt$type_description;
     VAR status: ost$status);

    VAR
      type_description: ^clt$type_description,
*IF NOT $true(osv$unix)
      type_kinds: clt$type_kinds,
*ELSE
      type_kinds: clt$type_kinds_v2,
*IFEND
      symbolic_qualifiers_work_area: ^clt$work_area;


    status.normal := TRUE;
    application_type_present := FALSE;
    symbolic_qualifiers_work_area := NIL;

    determine_type_kinds (old_vks, type_kinds);

    type_description := ^new_type_description;

    translate_type (type_kinds, TRUE, old_vks, group_keywords, NIL, symbolic_qualifiers_work_area, work_area,
          application_type_present, type_description, status);

  PROCEND clp$translate_vks;
*IFEND
?? TITLE := 'determine_type_kinds', EJECT ??

  PROCEDURE [INLINE] determine_type_kinds
    (    value_kind_specifier: clt$value_kind_specifier;
*IF NOT $true(osv$unix)
     VAR type_kinds: clt$type_kinds);
*ELSE
     VAR type_kinds: clt$type_kinds_v2);
*IFEND

    VAR
      type_kind: clt$type_kind;


*IF NOT $true(osv$unix)
    type_kinds := $clt$type_kinds [];
*ELSE
    type_kinds := $clt$type_kinds_v2 [];
*IFEND

    CASE value_kind_specifier.kind OF
    = clc$any_value =
      type_kind := clc$union_type;
*IF NOT $true(osv$unix)
      type_kinds := $clt$type_kinds [clc$boolean_type, clc$file_type, clc$integer_type, clc$name_type,
            clc$real_type, clc$status_type, clc$string_type];
*ELSE
      type_kinds := $clt$type_kinds_v2 [clc$boolean_type, clc$nos_ve_file_type, clc$integer_type,
            clc$name_type, clc$real_type, clc$status_type, clc$string_type];
*IFEND
    = clc$application_value =
      type_kind := clc$application_type;
    = clc$boolean_value =
      type_kind := clc$boolean_type;
    = clc$file_value =
*IF NOT $true(osv$unix)
      type_kind := clc$file_type;
*ELSE
      type_kind := clc$nos_ve_file_type;
*IFEND
    = clc$integer_value =
      type_kind := clc$integer_type;
    = clc$keyword_value =
      type_kind := clc$keyword_type;
    = clc$name_value =
      type_kind := clc$name_type;
    = clc$real_value =
      type_kind := clc$real_type;
    = clc$status_value =
      type_kind := clc$status_type;
    = clc$string_value =
      type_kind := clc$string_type;

    = clc$variable_reference =
      CASE value_kind_specifier.variable_kind OF
      = clc$any_value =
        type_kind := clc$union_type;
*IF NOT $true(osv$unix)
        type_kinds := $clt$type_kinds [clc$boolean_type, clc$file_type, clc$integer_type, clc$name_type,
              clc$real_type, clc$status_type, clc$string_type, clc$union_type];
*ELSE
        type_kinds := $clt$type_kinds_v2 [clc$boolean_type, clc$nos_ve_file_type, clc$integer_type,
              clc$name_type, clc$real_type, clc$status_type, clc$string_type, clc$union_type];
*IFEND
      = clc$boolean_value =
        type_kind := clc$boolean_type;
      = clc$integer_value =
        type_kind := clc$integer_type;
      = clc$real_value =
        type_kind := clc$real_type;
      = clc$status_value =
        type_kind := clc$status_type;
      = clc$string_value =
        type_kind := clc$string_type;
      CASEND;
    CASEND;

*IF NOT $true(osv$unix)
    type_kinds := type_kinds + $clt$type_kinds [type_kind];
*ELSE
    type_kinds := type_kinds + $clt$type_kinds_v2 [type_kind];
*IFEND

    IF value_kind_specifier.keyword_values <> NIL THEN
*IF NOT $true(osv$unix)
      type_kinds := type_kinds + $clt$type_kinds [clc$keyword_type];
*ELSE
      type_kinds := type_kinds + $clt$type_kinds_v2 [clc$keyword_type];
*IFEND
    IFEND;

  PROCEND determine_type_kinds;
?? TITLE := 'set_symbolic_qualifier', EJECT ??

  PROCEDURE set_symbolic_qualifier
    (    low_text: ^string ( * );
         high_text: ^string ( * );
     VAR symbolic_qualifiers_work_area { input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      symbolic_high_text: ^string ( * ),
      symbolic_low_text: ^string ( * ),
      symbolic_subrange_qualifier: ^clt$symbolic_subrange_qualifier;


    status.normal := TRUE;

    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);
      RETURN;
    IFEND;

    IF low_text = NIL THEN
      symbolic_subrange_qualifier^.low_text_size := 0;
    ELSE
      symbolic_subrange_qualifier^.low_text_size := STRLENGTH (low_text^);
      NEXT symbolic_low_text: [STRLENGTH (low_text^)] IN symbolic_qualifiers_work_area;
      IF symbolic_low_text = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      symbolic_low_text^ := low_text^;
    IFEND;

    IF (high_text = NIL) OR (high_text = low_text) THEN
      symbolic_subrange_qualifier^.high_text_size := 0;
    ELSE
      symbolic_subrange_qualifier^.high_text_size := STRLENGTH (high_text^);
      NEXT symbolic_high_text: [STRLENGTH (high_text^)] IN symbolic_qualifiers_work_area;
      IF symbolic_high_text = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      symbolic_high_text^ := high_text^;
    IFEND

  PROCEND set_symbolic_qualifier;
?? TITLE := 'sort_parameter_names', EJECT ??

  PROCEDURE [INLINE] sort_parameter_names
    (VAR new_pdt {input, output} : clt$unbundled_pdt);

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

    VAR
      i: clt$parameter_name_index;


{ Sort parameter names using shell sort technique.

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

{ Adjust name indexes in parameters array following sort.

    FOR i := 1 TO UPPERBOUND (new_pdt.names^) DO
      IF new_pdt.names^ [i].class = clc$nominal_entry THEN
        new_pdt.parameters^ [new_pdt.names^ [i].position].name_index := i;
      IFEND;
    FOREND;

  PROCEND sort_parameter_names;
?? TITLE := 'translate_type', EJECT ??

  PROCEDURE translate_type
*IF NOT $true(osv$unix)
    (    type_kinds: clt$type_kinds;
*ELSE
    (    type_kinds: clt$type_kinds_v2;
*IFEND
         encode_file_values: boolean;
         value_kind_specifier: clt$value_kind_specifier;
         group_keywords: boolean;
         symbolic_parameter: ^clt$symbolic_parameter;
     VAR symbolic_qualifiers_work_area {input, output} : ^clt$work_area;
     VAR work_area {input, output} : ^clt$work_area;
     VAR application_type_present: boolean;
     VAR type_description {input, output} : ^clt$type_description;
     VAR status: ost$status);

    VAR
      symbolic_qualifier_applicable: boolean;

?? NEWTITLE := 'set_application_type', EJECT ??

    PROCEDURE [INLINE] set_application_type;


      set_type (clc$application_type);
      IF value_kind_specifier.value_name <> '' THEN
        NEXT type_description^.name: [clp$trimmed_string_size (value_kind_specifier.value_name)] IN work_area;
        type_description^.name^ := value_kind_specifier.value_name;
      IFEND;
      type_description^.balance_brackets := FALSE;

      application_type_present := TRUE;

    PROCEND set_application_type;
?? TITLE := 'set_integer_type', EJECT ??

    PROCEDURE [INLINE] set_integer_type
      (    min_integer_value: integer;
           max_integer_value: integer);


      symbolic_qualifier_applicable := TRUE;
      set_type (clc$integer_type);
      type_description^.min_integer_value := min_integer_value;
      type_description^.max_integer_value := max_integer_value;
      type_description^.default_radix := 10;

    PROCEND set_integer_type;
?? TITLE := 'set_keyword_type', EJECT ??

    PROCEDURE set_keyword_type;

?? NEWTITLE := 'set_keyword_groups', EJECT ??

      PROCEDURE set_keyword_groups
        (VAR keywords {input, output} : clt$keyword_specifications);

        VAR
*IF NOT $true(osv$unix)
          underline: [STATIC, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
          underline: [STATIC, READ] packed array [char] of boolean := [
*IFEND
                { } REP 95 of FALSE,
                {_} TRUE,
                { } REP 160 of FALSE];

        VAR
          abbrev: ost$name,
          abbrev_name_found: boolean,
          abbrev_size: 0 .. osc$max_name_size,
          current_name: ost$name,
          current_name_size: ost$name_size,
          first_character: char,
          first_index: 1 .. clc$max_keywords,
          group_begin: 1 .. clc$max_keywords,
          group_end: 1 .. clc$max_keywords,
          group_index: 1 .. clc$max_keywords,
          group_ordinal: clt$named_entry_ordinal,
          index: 1 .. clc$max_keywords,
          name: ost$name,
          name_index: integer,
          name_size: ost$name_size,
          number_of_keywords: 1 .. clc$max_keywords,
          scan_index: integer,
          temp_abbrev: ost$name,
          temp_size: 0 .. osc$max_name_size,
          underline_encountered: boolean,
          underline_found: boolean;


        number_of_keywords := UPPERBOUND (keywords);
        group_ordinal := 1;
        index := 1;

      /group/
        WHILE index <= number_of_keywords DO
          group_begin := index;
          first_character := keywords [group_begin].keyword (1);
          group_end := group_begin;

        /group_on_first/
          WHILE group_end <= number_of_keywords DO
            IF keywords [group_end].keyword (1) <> first_character THEN
              group_end := group_end - 1;
              EXIT /group_on_first/;
            IFEND;
            IF group_end = number_of_keywords THEN
              EXIT /group_on_first/;
            IFEND;
            group_end := group_end + 1;
          WHILEND /group_on_first/;

          IF group_end = group_begin THEN

{Only nominal entry (preset by  caller) in group

            keywords [index].ordinal := group_ordinal;
            group_ordinal := group_ordinal + 1;
            index := index + 1;
            CYCLE /group/;
          IFEND;

          group_index := index;

        /process_first_same_char/
          WHILE group_index <= group_end DO
            abbrev (1) := first_character;
            abbrev_size := 1;
            underline_encountered := FALSE;
            abbrev_name_found := FALSE;

          /group_on_abbrev/
            WHILE group_index <= group_end DO
              temp_abbrev (1) := first_character;
              temp_size := 1;
              name_index := 1;
              current_name := keywords [group_index].keyword;
              current_name_size := clp$trimmed_string_size (keywords [group_index].keyword);

            /find_abbrev/
              WHILE name_index <= current_name_size DO
                #SCAN (underline, current_name (name_index, * ), scan_index, underline_found);
                name_index := name_index + scan_index;
                IF underline_found THEN
                  IF name_index < current_name_size THEN
                    underline_encountered := TRUE;
                    temp_abbrev (temp_size + 1) := current_name (name_index);
                    temp_size := temp_size + 1;
                  ELSE
                    temp_size := 1;
                    EXIT /find_abbrev/;
                  IFEND;
                IFEND;
              WHILEND /find_abbrev/;

              IF abbrev_size = 1 THEN
                IF (temp_size > 1) THEN
                  abbrev := temp_abbrev;
                  abbrev_size := temp_size;
                ELSEIF (NOT underline_encountered) AND (NOT abbrev_name_found) THEN
                  abbrev_name_found := TRUE;
                  abbrev := current_name;
                  abbrev_size := current_name_size;
                  group_index := group_index + 1;
                  CYCLE /group_on_abbrev/;
                IFEND;
              IFEND;

              IF current_name (1, current_name_size) = abbrev (1, abbrev_size) THEN
                abbrev_name_found := TRUE;
                group_index := group_index + 1;
                CYCLE /group_on_abbrev/;
              ELSEIF temp_abbrev (1, temp_size) = abbrev (1, abbrev_size) THEN
                group_index := group_index + 1;
                CYCLE /group_on_abbrev/;
              ELSEIF (temp_size = 1) AND ((current_name_size = 1) AND (NOT underline_encountered)) THEN
                abbrev_name_found := TRUE;
                group_index := group_index + 1;
                CYCLE /group_on_abbrev/;
              ELSEIF current_name_size = (abbrev_size + 1) THEN
                IF (current_name (1, abbrev_size) = abbrev) AND (current_name (current_name_size) = 'S') THEN
                  abbrev_name_found := TRUE;
                  group_index := group_index + 1;
                  CYCLE /group_on_abbrev/;
                IFEND;
              ELSEIF abbrev_size = (current_name_size + 1) THEN
                IF (abbrev (1, current_name_size) = current_name) AND (abbrev (abbrev_size) = 'S') THEN
                  abbrev_name_found := TRUE;
                  group_index := group_index + 1;
                  CYCLE /group_on_abbrev/;
                IFEND;
              IFEND;

{no match on abbrev

              IF group_index > index THEN
                group_index := group_index - 1;
              IFEND;
              EXIT /group_on_abbrev/;
            WHILEND /group_on_abbrev/;

            IF group_index > group_end THEN
              group_index := group_end;
            IFEND;
            first_index := index;
            WHILE index <= group_index DO
              keywords [index].ordinal := group_ordinal;
              IF abbrev_name_found THEN
                IF index <> first_index THEN
                  IF (index < group_index) THEN
                    keywords [index].class := clc$alias_entry
                  ELSE
                    keywords [index].class := clc$abbreviation_entry;
                  IFEND;
                IFEND;
              ELSE
                group_ordinal := group_ordinal + 1;
              IFEND;
              index := index + 1;
            WHILEND;
            IF abbrev_name_found THEN
              group_ordinal := group_ordinal + 1;
            IFEND;
            group_index := group_index + 1;
          WHILEND /process_first_same_char/;
          index := group_end + 1;

        WHILEND /group/;

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

      PROCEDURE [INLINE] sort_keywords
        (VAR keywords {input, output} : clt$keyword_specifications);

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


{ Sort keywords using shell sort technique.

        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
        i: 1 .. clc$max_keywords;


      set_type (clc$keyword_type);

      NEXT type_description^.keyword_specifications: [1 .. UPPERBOUND (value_kind_specifier.
            keyword_values^)] IN work_area;

      FOR i := 1 TO UPPERBOUND (value_kind_specifier.keyword_values^) DO
        #TRANSLATE (osv$lower_to_upper, value_kind_specifier.keyword_values^ [i],
              type_description^.keyword_specifications^ [i].keyword);
        type_description^.keyword_specifications^ [i].class := clc$nominal_entry;
        type_description^.keyword_specifications^ [i].availability := clc$normal_usage_entry;
        type_description^.keyword_specifications^ [i].ordinal := i;
      FOREND;

      IF group_keywords THEN
        set_keyword_groups (type_description^.keyword_specifications^);
      IFEND;

      sort_keywords (type_description^.keyword_specifications^);

    PROCEND set_keyword_type;
?? TITLE := 'set_name_type', EJECT ??

    PROCEDURE [INLINE] set_name_type
      (    min_name_size: ost$name_size;
           max_name_size: ost$name_size);


      symbolic_qualifier_applicable := TRUE;
      set_type (clc$name_type);
      type_description^.min_name_size := min_name_size;
      type_description^.max_name_size := max_name_size;

    PROCEND set_name_type;
?? TITLE := 'set_real_type', EJECT ??

    PROCEDURE [INLINE] set_real_type;


      set_type (clc$real_type);
*IF NOT $true(osv$unix)
      #UNCHECKED_CONVERSION (clv$negative_infinity^, type_description^.min_real_value.long_real);
      #UNCHECKED_CONVERSION (clv$positive_infinity^, type_description^.max_real_value.long_real);
*ELSE
      type_description^.min_real_value.long_real := clv$negative_infinity^;
      type_description^.max_real_value.long_real := clv$positive_infinity^;
*IFEND

    PROCEND set_real_type;
?? TITLE := 'set_specifier_type', EJECT ??

    PROCEDURE [INLINE] set_specifier_type;


      CASE value_kind_specifier.kind OF
      = clc$any_value =
        set_unqualified_union_type;
      = clc$application_value =
        set_application_type;
      = clc$variable_reference =
        IF value_kind_specifier.array_allowed = clc$array_allowed THEN
          set_type (clc$array_type);
          type_description^.array_bounds_defined := FALSE;
          NEXT type_description^.array_element_type_description IN work_area;
          type_description := type_description^.array_element_type_description;
        IFEND;

        CASE value_kind_specifier.variable_kind OF
        = clc$string_value =
          set_string_type (0, clc$max_string_size);
        = clc$real_value =
          set_real_type;
        = clc$integer_value =
          set_integer_type (clc$min_integer, clc$max_integer);
        = clc$boolean_value =
          set_type (clc$boolean_type);
        = clc$status_value =
          set_type (clc$status_type);
        = clc$any_value =
          set_unqualified_union_type;
        CASEND;

      = clc$file_value =
*IF NOT $true(osv$unix)
        set_type (clc$file_type);
*ELSE
        set_type (clc$nos_ve_file_type);
*IFEND
      = clc$name_value =
        set_name_type (value_kind_specifier.min_name_size, value_kind_specifier.max_name_size);
      = clc$string_value =
        set_string_type (value_kind_specifier.min_string_size, value_kind_specifier.max_string_size);
      = clc$integer_value =
        set_integer_type (value_kind_specifier.min_integer_value, value_kind_specifier.max_integer_value);
      = clc$real_value =
        set_real_type;
      = clc$boolean_value =
        set_type (clc$boolean_type);
      = clc$status_value =
        set_type (clc$status_type);
      CASEND;

    PROCEND set_specifier_type;
?? TITLE := 'set_string_type', EJECT ??

    PROCEDURE [INLINE] set_string_type
      (    min_string_size: clt$string_size;
           max_string_size: clt$string_size);


      symbolic_qualifier_applicable := TRUE;
      set_type (clc$string_type);
      type_description^.min_string_size := min_string_size;
      IF max_string_size >= osc$max_string_size THEN
        type_description^.max_string_size := clc$max_string_size;
      ELSE
        type_description^.max_string_size := max_string_size;
      IFEND;
      type_description^.literal := FALSE;

    PROCEND set_string_type;
?? TITLE := 'set_type', EJECT ??

    PROCEDURE [INLINE] set_type
      (    kind: clt$type_kind);


      type_description^.specification := NIL;
      type_description^.name := NIL;
      type_description^.derived_from_value_kind_spec := encode_file_values;
      type_description^.advanced_keywords_present := FALSE;
      type_description^.kinds := type_kinds;
      type_description^.kind := kind;

    PROCEND set_type;
?? TITLE := 'set_union_with_keywords_type', EJECT ??

    PROCEDURE [INLINE] set_union_with_keywords_type;

      VAR
        union_type_description: ^clt$type_description;


      set_type (clc$union_type);

      NEXT type_description^.member_descriptions: [1 .. 2] IN work_area;

      union_type_description := type_description;
      type_description := ^union_type_description^.member_descriptions^ [1];

      set_keyword_type;

      type_description := ^union_type_description^.member_descriptions^ [2];

      set_specifier_type;

      NEXT union_type_description^.union_information IN work_area;
      union_type_description^.union_information^.only_standard_types_in_union := FALSE;
      IF type_description^.kind = clc$integer_type THEN
        union_type_description^.union_information^.min_integer_value := type_description^.min_integer_value;
        union_type_description^.union_information^.max_integer_value := type_description^.max_integer_value;
      ELSE
        union_type_description^.union_information^.min_integer_value := clc$min_integer;
        union_type_description^.union_information^.max_integer_value := clc$max_integer;
      IFEND;
      union_type_description^.union_information^.default_radix := 10;
*IF NOT $true(osv$unix)
      #UNCHECKED_CONVERSION (clv$negative_infinity^, union_type_description^.union_information^.
            min_real_value.long_real);
      #UNCHECKED_CONVERSION (clv$positive_infinity^, union_type_description^.union_information^.
            max_real_value.long_real);
*ELSE
      union_type_description^.union_information^.min_real_value.long_real := clv$negative_infinity^;
      union_type_description^.union_information^.max_real_value.long_real := clv$positive_infinity^;
*IFEND

    PROCEND set_union_with_keywords_type;
?? TITLE := 'set_unqualified_union_type', EJECT ??

    PROCEDURE [INLINE] set_unqualified_union_type;

      VAR
        i: 1 .. clc$max_union_members,
        union_members: ^array [ * ] of clt$type_description;


      type_description^ := old_union_type_description;
      type_description^.derived_from_value_kind_spec := encode_file_values;
      NEXT union_members: [1 .. UPPERBOUND (old_union_members)] IN work_area;
      union_members^ := old_union_members;
      FOR i := 1 TO UPPERBOUND (old_union_members) DO
        union_members^ [i].derived_from_value_kind_spec := encode_file_values;
      FOREND;
      type_description^.member_descriptions := union_members;

      IF symbolic_parameter <> NIL THEN

{ Establish symbolic info for types NAME, INTEGER and STRING.

        set_symbolic_qualifier (NIL, NIL, symbolic_qualifiers_work_area, status);
        set_symbolic_qualifier (NIL, NIL, symbolic_qualifiers_work_area, status);
        set_symbolic_qualifier (NIL, NIL, symbolic_qualifiers_work_area, status);
      IFEND;

    PROCEND set_unqualified_union_type;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    application_type_present := FALSE;

    symbolic_qualifier_applicable := FALSE;

    IF value_kind_specifier.keyword_values <> NIL THEN
      IF (value_kind_specifier.kind = clc$unspecified_value) OR
            (value_kind_specifier.kind = clc$keyword_value) THEN
        set_keyword_type;
      ELSE
        set_union_with_keywords_type;
      IFEND;
    ELSE
      set_specifier_type;
    IFEND;

    IF symbolic_qualifier_applicable AND (symbolic_parameter <> NIL) THEN
      set_symbolic_qualifier (symbolic_parameter^.value_kind_qualifier_low,
            symbolic_parameter^.value_kind_qualifier_high, symbolic_qualifiers_work_area, status);
    IFEND;

  PROCEND translate_type;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$bundle_pdt', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$bundle_pdt
    (    unbundled_pdt: clt$unbundled_pdt;
     VAR work_area {input, output} : ^clt$work_area;
     VAR parameter_description_table: ^clt$parameter_description_table;
     VAR status: ost$status);

    VAR
      default_name: ^clt$variable_name_reference,
      default_value: ^clt$expression_text,
      final_position: integer,
      header: ^clt$pdt_header,
      i: clt$parameter_number,
      names: ^clt$pdt_parameter_names,
      parameters: ^clt$pdt_parameters,
      type_specification: ^clt$type_specification;


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

    NEXT header IN work_area;
    IF header = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;
    header^ := unbundled_pdt.header^;

    IF unbundled_pdt.header^.number_of_parameter_names > 0 THEN
      NEXT names: [1 .. header^.number_of_parameter_names] IN work_area;
      NEXT parameters: [1 .. header^.number_of_parameters] IN work_area;
      IF (names = NIL) OR (parameters = NIL) THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;
      names^ := unbundled_pdt.names^;
      parameters^ := unbundled_pdt.parameters^;

      FOR i := 1 TO header^.number_of_parameters DO
        IF unbundled_pdt.type_descriptions^ [i].specification <> NIL THEN
          NEXT type_specification: [[REP #SIZE (unbundled_pdt.type_descriptions^ [i].specification^) OF
                cell]] IN work_area;
          IF type_specification = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;
          type_specification^ := unbundled_pdt.type_descriptions^ [i].specification^;
        ELSE
          clp$convert_type_desc_to_spec (^unbundled_pdt.type_descriptions^ [i], work_area, type_specification,
                status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        parameters^ [i].type_specification_size := #SIZE (type_specification^);

        IF (unbundled_pdt.default_names = NIL) OR (unbundled_pdt.default_names^ [i] = NIL) THEN
          parameters^ [i].default_name_size := 0;
        ELSE
          NEXT default_name: [STRLENGTH (unbundled_pdt.default_names^ [i]^)] IN work_area;
          IF default_name = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;
          default_name^ := unbundled_pdt.default_names^ [i]^;
          parameters^ [i].default_name_size := STRLENGTH (default_name^);
        IFEND;

        IF unbundled_pdt.default_values^ [i] = NIL THEN
          parameters^ [i].default_value_size := 0;
        ELSE
          NEXT default_value: [STRLENGTH (unbundled_pdt.default_values^ [i]^)] IN work_area;
          IF default_value = NIL THEN
            osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
            RETURN;
          IFEND;
          default_value^ := unbundled_pdt.default_values^ [i]^;
          parameters^ [i].default_value_size := STRLENGTH (default_value^);
        IFEND;
      FOREND;
    IFEND;

    final_position := i#current_sequence_position (work_area);
    RESET work_area TO header;
    NEXT parameter_description_table: [[REP final_position - i#current_sequence_position (work_area) OF
          cell]] IN work_area;
    RESET parameter_description_table;

  PROCEND clp$bundle_pdt;
?? TITLE := 'clp$convert_pdt', EJECT ??
*copyc clh$convert_pdt

  PROCEDURE [XDCL, #GATE] clp$convert_pdt
    (    old_pdt: clt$parameter_descriptor_table;
     VAR work_area {input, output} : ^clt$work_area;
     VAR new_pdt: ^clt$parameter_description_table;
     VAR status: ost$status);

    VAR
      ignore_application_type_present: boolean,
      unbundled_pdt: clt$unbundled_pdt;


    clp$translate_pdt (old_pdt, FALSE, FALSE, NIL, NIL, NIL, work_area, ignore_application_type_present,
          unbundled_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$bundle_pdt (unbundled_pdt, work_area, new_pdt, status);

  PROCEND clp$convert_pdt;
*IFEND

MODEND clm$translate_pdt;
