?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Data Value Conversion Procedures' ??
MODULE clm$data_value_conversion;

{
{ PURPOSE:
{   This module contains the procedures that convert data values between their
{   external and internal forms.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$bad_data_value
*IF NOT $true(osv$unix)
*copyc cle$bad_internal_value
*IFEND
*copyc cle$work_area_overflow
*IF $true(osv$unix)
*copyc clt$data_kinds
*IFEND
*copyc clt$data_value
*IF NOT $true(osv$unix)
*copyc clt$expression_eval_method
*copyc clt$internal_data_value
*copyc clt$internal_data_value_size
*copyc clt$i_data_value
*copyc clt$type_description
*IFEND
*copyc clt$work_area
*IF NOT $true(osv$unix)
*copyc cyd$run_time_error_condition
*ELSE
*copyc cyt$mips_signal_handler
*IFEND
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*IF NOT $true(osv$unix)
*copyc clp$longreal_compare_gt
*copyc clp$longreal_compare_lt
*ELSE
*copyc clp$make_a_file_value
*IFEND
*IF NOT $true(osv$unix)
*copyc clp$make_application_value
*copyc clp$make_array_value
*copyc clp$make_clt$boolean_value
*copyc clp$make_clt$integer_value
*copyc clp$make_clt$real_value
*copyc clp$make_cobol_name_value
*copyc clp$make_command_ref_value
*copyc clp$make_data_name_value
*copyc clp$make_date_time_value
*copyc clp$make_deferred_value
*copyc clp$make_entry_point_ref_value
*copyc clp$make_file_value
*copyc clp$make_keyword_value
*copyc clp$make_list_value
*copyc clp$make_lock_value
*copyc clp$make_name_value
*copyc clp$make_network_title_value
*copyc clp$make_program_name_value
*copyc clp$make_range_value
*copyc clp$make_record_value
*copyc clp$make_scu_line_id_value
*copyc clp$make_statistic_code_value
*copyc clp$make_status_value
*copyc clp$make_status_code_value
*copyc clp$make_string_value
*copyc clp$make_string_pattern_value
*copyc clp$make_time_increment_value
*copyc clp$make_time_zone_value
*copyc clp$make_type_spec_value
*copyc clp$make_unspecified_value
*copyc clp$trimmed_string_size
*copyc clv$max_variable_allocation
*copyc clv$real_zero
*copyc i#current_sequence_position
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*IFEND
*copyc osp$set_status_abnormal
*IF NOT $true(osv$unix)
*copyc pmp$continue_to_cause
?? TITLE := 'size estimating constatnts', EJECT ??

  CONST
    application_size_increment = 16,
    deferred_size_increment = 16,
    file_size_increment = 32,
    max_increment_size = 0fff(16),
    max_unused_space = 0ffff(16),
    network_title_size_increment = 16,
    nominal_application_size = 32,
    nominal_deferred_value_size = 32,
    nominal_file_size = 96,
    nominal_list_size = 25,
    nominal_network_title_size = 31,
    nominal_string_size = 128,
    string_size_increment = 64;

*IFEND
*IF NOT $true(osv$unix)
?? TITLE := 'clp$change_internal_value', EJECT ??

  PROCEDURE [XDCL] clp$change_internal_value
    (    change_in_place: boolean;
         old_value: ^clt$internal_data_value;
         graft_address: ^ REL (clt$internal_data_value) ^clt$i_data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR new_value {input, output} : ^clt$internal_data_value;
     VAR status: ost$status);

    VAR
      actual_graft_address: ^ REL (clt$internal_data_value) ^clt$i_data_value,
      copy_new_into_old: boolean,
      ignore_graft_address: ^ REL (clt$internal_data_value) ^clt$i_data_value,
      minimum_new_value_size: clt$internal_data_value_size,
      new_space: ^SEQ ( * ),
      new_value_size: clt$internal_data_value_size,
      old_allocated_space: ^SEQ ( * ),
      old_space: ^SEQ ( * ),
      original_work_area: ^clt$work_area,
      replacement_value: ^clt$internal_data_value,
      skip_space: ^array [1 .. * ] of cell;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      CASE condition.selector OF

      = pmc$block_exit_processing =
        work_area := original_work_area;
        #SPOIL (work_area);
        RETURN;

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          bad_internal_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          bad_internal_value;
        IFEND;

      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi =
          bad_internal_value;
        = mmc$sac_read_write_beyond_msl, mmc$sac_no_append_permission =
*IF $true(osv$unix)
          bad_internal_value;
*ELSE
          IF #SEGMENT (condition.segment_access_condition.segment) = #SEGMENT (work_area) THEN
            work_area_overflow;
          ELSE
            bad_internal_value;
          IFEND;
*IFEND
        ELSE
          ;
        CASEND;

      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? TITLE := 'bad_internal_value', EJECT ??

    PROCEDURE [INLINE] bad_internal_value;


      osp$set_status_abnormal ('CL', cle$bad_internal_value, '', status);
      EXIT clp$change_internal_value;

    PROCEND bad_internal_value;
?? TITLE := 'copy_internal_value', EJECT ??

    PROCEDURE copy_internal_value
      (    source_value: ^clt$internal_data_value;
           source_component: ^ REL (clt$internal_data_value) ^clt$i_data_value;
           new_value: ^clt$internal_data_value;
           new_component: ^ REL (clt$internal_data_value) ^clt$i_data_value;
       VAR migrate_graft_address {input, output} : ^ REL (clt$internal_data_value) ^clt$i_data_value;
       VAR new_space {input, output} : ^SEQ ( * ));

      VAR
        new_i_value: ^clt$i_data_value,
        source_i_value: ^clt$i_data_value;

?? NEWTITLE := 'copy_application_value', EJECT ??

      PROCEDURE [INLINE] copy_application_value;

        VAR
          new_application_value: ^clt$application_value_text,
          source_application_value: ^clt$application_value_text;


        source_application_value := #PTR (source_i_value^.application_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$application;
          NEXT new_application_value: [STRLENGTH (source_application_value^)] IN new_space;
        ELSEIF new_i_value^.kind <> clc$application THEN
          new_i_value^.kind := clc$application;
          NEXT new_application_value: [STRLENGTH (source_application_value^)] IN new_space;
        ELSE
          new_application_value := #PTR (new_i_value^.application_value, new_value^);
          IF STRLENGTH (new_application_value^) < STRLENGTH (source_application_value^) THEN
            NEXT new_application_value: [STRLENGTH (source_application_value^)] IN new_space;
          ELSEIF STRLENGTH (new_application_value^) > STRLENGTH (source_application_value^) THEN
            new_application_value := ^new_application_value^ (1, STRLENGTH (source_application_value^));
          IFEND;
        IFEND;

        IF new_application_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_application_value^ := source_application_value^;
        new_i_value^.application_value := #REL (new_application_value, new_value^);

      PROCEND copy_application_value;
?? TITLE := 'copy_array_value', EJECT ??

      PROCEDURE [INLINE] copy_array_value;

        VAR
          i: clt$array_bound,
          new_array_value: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
          overwrite_array: boolean,
          source_array_value: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value;


        source_array_value := #PTR (source_i_value^.array_value, source_value^);

        overwrite_array := TRUE;
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$array;
          NEXT new_array_value: [LOWERBOUND (source_array_value^) .. UPPERBOUND (source_array_value^)] IN
                new_space;
          overwrite_array := FALSE;
        ELSEIF new_i_value^.kind <> clc$array THEN
          new_i_value^.kind := clc$array;
          NEXT new_array_value: [LOWERBOUND (source_array_value^) .. UPPERBOUND (source_array_value^)] IN
                new_space;
          overwrite_array := FALSE;
        ELSE
          new_array_value := #PTR (new_i_value^.array_value, new_value^);
          IF (LOWERBOUND (new_array_value^) <> LOWERBOUND (source_array_value^)) OR
                (UPPERBOUND (new_array_value^) <> UPPERBOUND (source_array_value^)) THEN
            NEXT new_array_value: [LOWERBOUND (source_array_value^) .. UPPERBOUND (source_array_value^)] IN
                  new_space;
            overwrite_array := FALSE;
          IFEND;
        IFEND;

        IF new_array_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_i_value^.array_value := #REL (new_array_value, new_value^);

        FOR i := LOWERBOUND (new_array_value^) TO UPPERBOUND (new_array_value^) DO
          IF source_array_value^ [i] = NIL THEN
            new_array_value^ [i] := NIL;
            IF migrate_graft_address = ^source_array_value^ [i] THEN
              migrate_graft_address := ^new_array_value^ [i];
            IFEND;
          ELSE
            IF NOT overwrite_array THEN
              new_array_value^ [i] := NIL;
            IFEND;
            copy_internal_value (source_value, ^source_array_value^ [i], new_value, ^new_array_value^ [i],
                  migrate_graft_address, new_space);
          IFEND;
        FOREND;

      PROCEND copy_array_value;
?? TITLE := 'copy_cobol_name_value', EJECT ??

      PROCEDURE [INLINE] copy_cobol_name_value;

        VAR
          new_cobol_name_value: ^clt$cobol_name,
          source_cobol_name_value: ^clt$cobol_name;


        source_cobol_name_value := #PTR (source_i_value^.cobol_name_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$cobol_name;
          NEXT new_cobol_name_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$cobol_name THEN
          new_i_value^.kind := clc$cobol_name;
          NEXT new_cobol_name_value IN new_space;
        ELSE
          new_cobol_name_value := #PTR (new_i_value^.cobol_name_value, new_value^);
        IFEND;

        IF new_cobol_name_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_cobol_name_value^ := source_cobol_name_value^;
        new_i_value^.cobol_name_value := #REL (new_cobol_name_value, new_value^);

      PROCEND copy_cobol_name_value;
?? TITLE := 'copy_command_reference_value', EJECT ??

      PROCEDURE [INLINE] copy_command_reference_value;

        VAR
          new_command_reference_value: ^clt$command_reference,
          source_command_reference_value: ^clt$command_reference;


        source_command_reference_value := #PTR (source_i_value^.command_reference_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$command_reference;
          NEXT new_command_reference_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$command_reference THEN
          new_i_value^.kind := clc$command_reference;
          NEXT new_command_reference_value IN new_space;
        ELSE
          new_command_reference_value := #PTR (new_i_value^.command_reference_value, new_value^);
        IFEND;

        IF new_command_reference_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_command_reference_value^ := source_command_reference_value^;
        new_i_value^.command_reference_value := #REL (new_command_reference_value, new_value^);

      PROCEND copy_command_reference_value;
?? TITLE := 'copy_data_name_value', EJECT ??

      PROCEDURE [INLINE] copy_data_name_value;

        VAR
          new_data_name_value: ^ost$name,
          source_data_name_value: ^ost$name;


        source_data_name_value := #PTR (source_i_value^.data_name_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$data_name;
          NEXT new_data_name_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$data_name THEN
          new_i_value^.kind := clc$data_name;
          NEXT new_data_name_value IN new_space;
        ELSE
          new_data_name_value := #PTR (new_i_value^.data_name_value, new_value^);
        IFEND;

        IF new_data_name_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_data_name_value^ := source_data_name_value^;
        new_i_value^.data_name_value := #REL (new_data_name_value, new_value^);

      PROCEND copy_data_name_value;
?? TITLE := 'copy_deferred_value', EJECT ??

      PROCEDURE [INLINE] copy_deferred_value;

        VAR
          new_deferred_value: ^clt$expression_text,
          source_deferred_value: ^clt$expression_text;


        source_deferred_value := #PTR (source_i_value^.deferred_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$deferred;
          NEXT new_deferred_value: [STRLENGTH (source_deferred_value^)] IN new_space;
        ELSEIF new_i_value^.kind <> clc$deferred THEN
          new_i_value^.kind := clc$deferred;
          NEXT new_deferred_value: [STRLENGTH (source_deferred_value^)] IN new_space;
        ELSE
          new_deferred_value := #PTR (new_i_value^.deferred_value, new_value^);
          IF STRLENGTH (new_deferred_value^) < STRLENGTH (source_deferred_value^) THEN
            NEXT new_deferred_value: [STRLENGTH (source_deferred_value^)] IN new_space;
          ELSEIF STRLENGTH (new_deferred_value^) > STRLENGTH (source_deferred_value^) THEN
            new_deferred_value := ^new_deferred_value^ (1, STRLENGTH (source_deferred_value^));
          IFEND;
        IFEND;

        IF new_deferred_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_deferred_value^ := source_deferred_value^;
        new_i_value^.deferred_value := #REL (new_deferred_value, new_value^);

{ Since the only values that can be deferred are those of entire
{ variables and parameters (i.e. NOT components of structured values),
{ the deferred_type field is not stored internally since it can be
{ obtained from the descriptor of the variable or parameter when needed.

      PROCEND copy_deferred_value;
?? TITLE := 'copy_entry_point_ref_value', EJECT ??

      PROCEDURE [INLINE] copy_entry_point_ref_value;

        VAR
          new_entry_point_ref_value: ^pmt$entry_point_reference,
          source_entry_point_ref_value: ^pmt$entry_point_reference;


        source_entry_point_ref_value := #PTR (source_i_value^.entry_point_reference_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$entry_point_reference;
          NEXT new_entry_point_ref_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$entry_point_reference THEN
          new_i_value^.kind := clc$entry_point_reference;
          NEXT new_entry_point_ref_value IN new_space;
        ELSE
          new_entry_point_ref_value := #PTR (new_i_value^.entry_point_reference_value, new_value^);
        IFEND;

        IF new_entry_point_ref_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_entry_point_ref_value^ := source_entry_point_ref_value^;
        new_i_value^.entry_point_reference_value := #REL (new_entry_point_ref_value, new_value^);

      PROCEND copy_entry_point_ref_value;
?? TITLE := 'copy_file_value', EJECT ??

      PROCEDURE [INLINE] copy_file_value;

        VAR
          new_file_value: ^fst$file_reference,
          source_file_value: ^fst$file_reference;


        source_file_value := #PTR (source_i_value^.file_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
*IF NOT $true(osv$unix)
          new_i_value^.kind := clc$file;
*ELSE
          new_i_value^.kind := source_i_value^.kind;
*IFEND
          NEXT new_file_value: [STRLENGTH (source_file_value^)] IN new_space;
*IF NOT $true(osv$unix)
        ELSEIF new_i_value^.kind <> clc$file THEN
          new_i_value^.kind := clc$file;
*ELSE
        ELSEIF NOT (new_i_value^.kind IN $clt$data_kinds [clc$nos_ve_file, clc$unix_file]) THEN
          new_i_value^.kind := source_i_value^.kind;
*IFEND
          NEXT new_file_value: [STRLENGTH (source_file_value^)] IN new_space;
        ELSE
*IF $true(osv$unix)
          new_i_value^.kind := source_i_value^.kind;
*IFEND
          new_file_value := #PTR (new_i_value^.file_value, new_value^);
          IF STRLENGTH (new_file_value^) < STRLENGTH (source_file_value^) THEN
            NEXT new_file_value: [STRLENGTH (source_file_value^)] IN new_space;
          ELSEIF STRLENGTH (new_file_value^) > STRLENGTH (source_file_value^) THEN
            new_file_value := ^new_file_value^ (1, STRLENGTH (source_file_value^));
          IFEND;
        IFEND;

        IF new_file_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_file_value^ := source_file_value^;
        new_i_value^.file_value := #REL (new_file_value, new_value^);

      PROCEND copy_file_value;
?? TITLE := 'copy_keyword_value', EJECT ??

      PROCEDURE [INLINE] copy_keyword_value;

        VAR
          new_keyword_value: ^clt$keyword,
          source_keyword_value: ^clt$keyword;


        source_keyword_value := #PTR (source_i_value^.keyword_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$keyword;
          NEXT new_keyword_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$keyword THEN
          new_i_value^.kind := clc$keyword;
          NEXT new_keyword_value IN new_space;
        ELSE
          new_keyword_value := #PTR (new_i_value^.keyword_value, new_value^);
        IFEND;

        IF new_keyword_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_keyword_value^ := source_keyword_value^;
        new_i_value^.keyword_value := #REL (new_keyword_value, new_value^);

      PROCEND copy_keyword_value;
?? TITLE := 'copy_list_value', EJECT ??

      PROCEDURE [INLINE] copy_list_value;

        VAR
          current_new_node: ^clt$i_data_value,
          current_source_node: ^clt$i_data_value,
          previous_new_node_link: ^ REL (clt$internal_data_value) ^clt$i_data_value;


        current_source_node := source_i_value;
        previous_new_node_link := NIL;
        current_new_node := new_i_value;

        REPEAT
          IF current_new_node = NIL THEN
            NEXT current_new_node IN new_space;
            IF current_new_node = NIL THEN
              work_area_overflow;
            IFEND;
            current_new_node^.kind := clc$list;
            current_new_node^.element_value := NIL;
            current_new_node^.link := NIL;
            current_new_node^.generated_via_list_rest := FALSE;
          ELSEIF current_new_node^.kind <> clc$list THEN
            current_new_node^.kind := clc$list;
            current_new_node^.element_value := NIL;
            current_new_node^.link := NIL;
            current_new_node^.generated_via_list_rest := FALSE;
          IFEND;

          IF previous_new_node_link = NIL THEN
            new_i_value := current_new_node;
            new_i_value^.generated_via_list_rest := source_i_value^.generated_via_list_rest;
          ELSE
            previous_new_node_link^ := #REL (current_new_node, new_value^);
          IFEND;

          IF current_source_node^.element_value = NIL THEN
            current_new_node^.element_value := NIL;
            IF migrate_graft_address = ^current_source_node^.element_value THEN
              migrate_graft_address := ^current_new_node^.element_value;
            IFEND;
          ELSE
            copy_internal_value (source_value, ^current_source_node^.element_value, new_value,
                  ^current_new_node^.element_value, migrate_graft_address, new_space);
          IFEND;

          previous_new_node_link := ^current_new_node^.link;
          current_new_node := #PTR (current_new_node^.link, new_value^);
          current_source_node := #PTR (current_source_node^.link, source_value^);
        UNTIL current_source_node = NIL;

        previous_new_node_link^ := NIL;

      PROCEND copy_list_value;
?? TITLE := 'copy_lock_value', EJECT ??

      PROCEDURE [INLINE] copy_lock_value;

        VAR
          new_lock_value: ^clt$lock,
          source_lock_value: ^clt$lock;


        source_lock_value := #PTR (source_i_value^.lock_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$lock;
          NEXT new_lock_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$lock THEN
          new_i_value^.kind := clc$lock;
          NEXT new_lock_value IN new_space;
        ELSE
          new_lock_value := #PTR (new_i_value^.lock_value, new_value^);
        IFEND;

        IF new_lock_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_lock_value^ := source_lock_value^;
        new_i_value^.lock_value := #REL (new_lock_value, new_value^);

      PROCEND copy_lock_value;
?? TITLE := 'copy_name_value', EJECT ??

      PROCEDURE [INLINE] copy_name_value;

        VAR
          new_name_value: ^ost$name,
          source_name_value: ^ost$name;


        source_name_value := #PTR (source_i_value^.name_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$name;
          NEXT new_name_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$name THEN
          new_i_value^.kind := clc$name;
          NEXT new_name_value IN new_space;
        ELSE
          new_name_value := #PTR (new_i_value^.name_value, new_value^);
        IFEND;

        IF new_name_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_name_value^ := source_name_value^;
        new_i_value^.name_value := #REL (new_name_value, new_value^);

      PROCEND copy_name_value;
?? TITLE := 'copy_network_title_value', EJECT ??

      PROCEDURE [INLINE] copy_network_title_value;

        VAR
          new_network_title_value: ^nat$title,
          source_network_title_value: ^nat$title;


        source_network_title_value := #PTR (source_i_value^.network_title_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$network_title;
          NEXT new_network_title_value: [STRLENGTH (source_network_title_value^)] IN new_space;
        ELSEIF new_i_value^.kind <> clc$network_title THEN
          new_i_value^.kind := clc$network_title;
          NEXT new_network_title_value: [STRLENGTH (source_network_title_value^)] IN new_space;
        ELSE
          new_network_title_value := #PTR (new_i_value^.network_title_value, new_value^);
          IF STRLENGTH (new_network_title_value^) < STRLENGTH (source_network_title_value^) THEN
            NEXT new_network_title_value: [STRLENGTH (source_network_title_value^)] IN new_space;
          ELSEIF STRLENGTH (new_network_title_value^) > STRLENGTH (source_network_title_value^) THEN
            new_network_title_value := ^new_network_title_value^ (1, STRLENGTH (source_network_title_value^));
          IFEND;
        IFEND;

        IF new_network_title_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_network_title_value^ := source_network_title_value^;
        new_i_value^.network_title_value := #REL (new_network_title_value, new_value^);

      PROCEND copy_network_title_value;
?? TITLE := 'copy_program_name_value', EJECT ??

      PROCEDURE [INLINE] copy_program_name_value;

        VAR
          new_program_name_value: ^pmt$program_name,
          source_program_name_value: ^pmt$program_name;


        source_program_name_value := #PTR (source_i_value^.program_name_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$program_name;
          NEXT new_program_name_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$program_name THEN
          new_i_value^.kind := clc$program_name;
          NEXT new_program_name_value IN new_space;
        ELSE
          new_program_name_value := #PTR (new_i_value^.program_name_value, new_value^);
        IFEND;

        IF new_program_name_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_program_name_value^ := source_program_name_value^;
        new_i_value^.program_name_value := #REL (new_program_name_value, new_value^);

      PROCEND copy_program_name_value;
?? TITLE := 'copy_range_value', EJECT ??

      PROCEDURE [INLINE] copy_range_value;


        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$range;
          new_i_value^.low_value := NIL;
          new_i_value^.high_value := NIL;
        ELSEIF new_i_value^.kind <> clc$range THEN
          new_i_value^.kind := clc$range;
          new_i_value^.low_value := NIL;
          new_i_value^.high_value := NIL;
        IFEND;

        IF source_i_value^.low_value = NIL THEN
          new_i_value^.low_value := NIL;
          IF migrate_graft_address = ^source_i_value^.low_value THEN
            migrate_graft_address := ^new_i_value^.low_value;
          IFEND;
        ELSE
          copy_internal_value (source_value, ^source_i_value^.low_value, new_value, ^new_i_value^.low_value,
                migrate_graft_address, new_space);
        IFEND;

        IF source_i_value^.high_value = source_i_value^.low_value THEN
          new_i_value^.high_value := new_i_value^.low_value;
          IF migrate_graft_address = ^source_i_value^.high_value THEN
            migrate_graft_address := ^new_i_value^.high_value;
          IFEND;
        ELSE
          copy_internal_value (source_value, ^source_i_value^.high_value, new_value, ^new_i_value^.high_value,
                migrate_graft_address, new_space);
        IFEND;

      PROCEND copy_range_value;
?? TITLE := 'copy_record_value', EJECT ??

      PROCEDURE [INLINE] copy_record_value;

        VAR
          i: clt$field_number,
          new_field_values: ^array [1 .. * ] of clt$internal_field_value,
          overwrite_fields: boolean,
          source_field_values: ^array [1 .. * ] of clt$internal_field_value;


        source_field_values := #PTR (source_i_value^.field_values, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$record;
          NEXT new_field_values: [1 .. UPPERBOUND (source_field_values^)] IN new_space;
          overwrite_fields := FALSE;
        ELSEIF new_i_value^.kind <> clc$record THEN
          new_i_value^.kind := clc$record;
          NEXT new_field_values: [1 .. UPPERBOUND (source_field_values^)] IN new_space;
          overwrite_fields := FALSE;
        ELSE
          new_field_values := #PTR (new_i_value^.field_values, new_value^);
          overwrite_fields := UPPERBOUND (new_field_values^) = UPPERBOUND (source_field_values^);
          IF NOT overwrite_fields THEN
            NEXT new_field_values: [1 .. UPPERBOUND (source_field_values^)] IN new_space;
          IFEND;
        IFEND;

        IF new_field_values = NIL THEN
          work_area_overflow;
        IFEND;

        new_i_value^.field_values := #REL (new_field_values, new_value^);

        FOR i := 1 TO UPPERBOUND (new_field_values^) DO
          new_field_values^ [i].name := source_field_values^ [i].name;
          IF source_field_values^ [i].value = NIL THEN
            new_field_values^ [i].value := NIL;
            IF migrate_graft_address = ^source_field_values^ [i].value THEN
              migrate_graft_address := ^new_field_values^ [i].value;
            IFEND;
          ELSE
            IF NOT overwrite_fields THEN
              new_field_values^ [i].value := NIL;
            IFEND;
            copy_internal_value (source_value, ^source_field_values^ [i].value, new_value,
                  ^new_field_values^ [i].value, migrate_graft_address, new_space);
          IFEND;
        FOREND;

      PROCEND copy_record_value;
?? TITLE := 'copy_status_value', EJECT ??

      PROCEDURE [INLINE] copy_status_value;

        VAR
          new_status_value: ^ost$status,
          source_status_value: ^ost$status;


        source_status_value := #PTR (source_i_value^.status_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$status;
          NEXT new_status_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$status THEN
          new_i_value^.kind := clc$status;
          NEXT new_status_value IN new_space;
        ELSE
          new_status_value := #PTR (new_i_value^.status_value, new_value^);
        IFEND;

        IF new_status_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_status_value^ := source_status_value^;
        new_i_value^.status_value := #REL (new_status_value, new_value^);

      PROCEND copy_status_value;
?? TITLE := 'copy_string_value', EJECT ??

      PROCEDURE [INLINE] copy_string_value;

        VAR
          new_string_value: ^clt$string_value,
          source_string_value: ^clt$string_value;


        source_string_value := #PTR (source_i_value^.string_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$string;
          NEXT new_string_value: [STRLENGTH (source_string_value^)] IN new_space;
        ELSEIF new_i_value^.kind <> clc$string THEN
          new_i_value^.kind := clc$string;
          NEXT new_string_value: [STRLENGTH (source_string_value^)] IN new_space;
        ELSE
          new_string_value := #PTR (new_i_value^.string_value, new_value^);
          IF STRLENGTH (new_string_value^) < STRLENGTH (source_string_value^) THEN
            NEXT new_string_value: [STRLENGTH (source_string_value^)] IN new_space;
          ELSEIF STRLENGTH (new_string_value^) > STRLENGTH (source_string_value^) THEN
            new_string_value := ^new_string_value^ (1, STRLENGTH (source_string_value^));
          IFEND;
        IFEND;

        IF new_string_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_string_value^ := source_string_value^;
        new_i_value^.string_value := #REL (new_string_value, new_value^);

      PROCEND copy_string_value;
?? TITLE := 'copy_string_pattern_value', EJECT ??

      PROCEDURE [INLINE] copy_string_pattern_value;

        VAR
          new_string_pattern_value: ^clt$string_pattern,
          source_string_pattern_value: ^clt$string_pattern;


        source_string_pattern_value := #PTR (source_i_value^.string_pattern_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$string_pattern;
          NEXT new_string_pattern_value: [[REP #SIZE (source_string_pattern_value^) OF cell]] IN new_space;
        ELSEIF new_i_value^.kind <> clc$string_pattern THEN
          new_i_value^.kind := clc$string_pattern;
          NEXT new_string_pattern_value: [[REP #SIZE (source_string_pattern_value^) OF cell]] IN new_space;
        ELSE
          new_string_pattern_value := #PTR (new_i_value^.string_pattern_value, new_value^);
          IF #SIZE (new_string_pattern_value^) <> #SIZE (source_string_pattern_value^) THEN
            NEXT new_string_pattern_value: [[REP #SIZE (source_string_pattern_value^) OF cell]] IN new_space;
          IFEND;
        IFEND;

        IF new_string_pattern_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_string_pattern_value^ := source_string_pattern_value^;
        new_i_value^.string_pattern_value := #REL (new_string_pattern_value, new_value^);

      PROCEND copy_string_pattern_value;
?? TITLE := 'copy_time_increment_value', EJECT ??

      PROCEDURE [INLINE] copy_time_increment_value;

        VAR
          new_time_increment_value: ^pmt$time_increment,
          source_time_increment_value: ^pmt$time_increment;


        source_time_increment_value := #PTR (source_i_value^.time_increment_value, source_value^);

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$time_increment;
          NEXT new_time_increment_value IN new_space;
        ELSEIF new_i_value^.kind <> clc$time_increment THEN
          new_i_value^.kind := clc$time_increment;
          NEXT new_time_increment_value IN new_space;
        ELSE
          new_time_increment_value := #PTR (new_i_value^.time_increment_value, new_value^);
        IFEND;

        IF new_time_increment_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_time_increment_value^ := source_time_increment_value^;
        new_i_value^.time_increment_value := #REL (new_time_increment_value, new_value^);

      PROCEND copy_time_increment_value;
?? TITLE := 'copy_type_spec_value', EJECT ??

      PROCEDURE [INLINE] copy_type_spec_value;

        VAR
          new_type_specification_value: ^clt$type_specification,
          source_type_specification_value: ^clt$type_specification;


        source_type_specification_value := #PTR (source_i_value^.type_specification_value, source_value^);
        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
          new_i_value^.kind := clc$type_specification;
          NEXT new_type_specification_value: [[REP #SIZE (source_type_specification_value^) OF cell]] IN
                new_space;
        ELSEIF new_i_value^.kind <> clc$type_specification THEN
          new_i_value^.kind := clc$type_specification;
          NEXT new_type_specification_value: [[REP #SIZE (source_type_specification_value^) OF cell]] IN
                new_space;
        ELSE
          new_type_specification_value := #PTR (new_i_value^.type_specification_value, new_value^);
          IF #SIZE (new_type_specification_value^) <> #SIZE (source_type_specification_value^) THEN
            NEXT new_type_specification_value: [[REP #SIZE (source_type_specification_value^) OF cell]] IN
                  new_space;
          IFEND;
        IFEND;

        IF new_type_specification_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_type_specification_value^ := source_type_specification_value^;
        new_i_value^.type_specification_value := #REL (new_type_specification_value, new_value^);

      PROCEND copy_type_spec_value;
?? OLDTITLE, EJECT ??

      source_i_value := #PTR (source_component^, source_value^);
      new_i_value := #PTR (new_component^, new_value^);

      CASE source_i_value^.kind OF
      = clc$boolean, clc$date_time, clc$integer, clc$real, clc$scu_line_identifier, clc$statistic_code,
            clc$status_code, clc$time_zone, clc$unspecified =

        IF new_i_value = NIL THEN
          NEXT new_i_value IN new_space;
          IF new_i_value = NIL THEN
            work_area_overflow;
          IFEND;
        IFEND;
        new_i_value^ := source_i_value^;

      = clc$application =
        copy_application_value;
      = clc$array =
        copy_array_value;
      = clc$cobol_name =
        copy_cobol_name_value;
      = clc$command_reference =
        copy_command_reference_value;
      = clc$data_name =
        copy_data_name_value;
      = clc$deferred =
        copy_deferred_value;
      = clc$entry_point_reference =
        copy_entry_point_ref_value;
*IF NOT $true(osv$unix)
      = clc$file =
*ELSE
      = {clc$file} clc$nos_ve_file, clc$unix_file =
*IFEND
        copy_file_value;
      = clc$keyword =
        copy_keyword_value;
      = clc$list =
        copy_list_value;
      = clc$lock =
        copy_lock_value;
      = clc$name =
        copy_name_value;
      = clc$network_title =
        copy_network_title_value;
      = clc$program_name =
        copy_program_name_value;
      = clc$range =
        copy_range_value;
      = clc$record =
        copy_record_value;
      = clc$status =
        copy_status_value;
      = clc$string =
        copy_string_value;
      = clc$string_pattern =
        copy_string_pattern_value;
      = clc$time_increment =
        copy_time_increment_value;
      = clc$type_specification =
        copy_type_spec_value;
      ELSE
        bad_internal_value;
      CASEND;

      IF new_i_value = NIL THEN
        work_area_overflow;
      IFEND;

      new_component^ := #REL (new_i_value, new_value^);

      IF migrate_graft_address = source_component THEN
        migrate_graft_address := new_component;
      IFEND;

    PROCEND copy_internal_value;
?? TITLE := 'work_area_overflow', EJECT ??

    PROCEDURE [INLINE] work_area_overflow;


      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      EXIT clp$change_internal_value;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    original_work_area := work_area;
    #SPOIL (original_work_area);
    osp$establish_condition_handler (^abort_handler, TRUE);

    new_value_size := #OFFSET (work_area) + i#current_sequence_position (work_area) - #OFFSET (new_value) -
          #SIZE (clt$internal_data_value_header);

    IF old_value = NIL THEN
      RESET work_area TO new_value;
      NEXT new_value: [[REP new_value_size OF cell]] IN work_area;

    ELSEIF graft_address = NIL THEN
      IF change_in_place AND (new_value_size <= #SIZE (old_value^.allocated_space)) THEN
        RESET work_area TO new_value;
        NEXT new_value: [[REP new_value_size OF cell]] IN work_area;
        old_allocated_space := ^old_value^.allocated_space;
        RESET old_allocated_space;
        NEXT old_space: [[REP new_value_size OF cell]] IN old_allocated_space;
        old_space^ := new_value^.allocated_space;
        old_value^.header.value := new_value^.header.value;
        old_value^.header.unused_space := #SIZE (old_value^.allocated_space) - new_value_size;
        new_value := old_value;

      ELSE
        minimum_new_value_size := #SIZE (old_value^.allocated_space) +
              old_value^.header.minimum_allocation_increment;
        IF new_value_size < minimum_new_value_size THEN
          new_value^.header.unused_space := minimum_new_value_size - new_value_size;
          NEXT skip_space: [1 .. new_value^.header.unused_space] IN work_area;
          new_value_size := minimum_new_value_size;
        IFEND;
        RESET work_area TO new_value;
        NEXT new_value: [[REP new_value_size OF cell]] IN work_area;
      IFEND;

    ELSE
      replacement_value := new_value;
      minimum_new_value_size := #SIZE (old_value^.allocated_space) +
            old_value^.header.minimum_allocation_increment;
      IF NOT change_in_place THEN
        copy_new_into_old := FALSE;
      ELSEIF graft_address^ = NIL THEN
        copy_new_into_old := new_value_size <= old_value^.header.unused_space;
      ELSE
        copy_new_into_old := (new_value_size - #SIZE (clt$i_data_value)) <= old_value^.header.unused_space;
      IFEND;
      actual_graft_address := graft_address;

      IF copy_new_into_old THEN
        new_value := old_value;
        new_space := ^new_value^.allocated_space;
        RESET new_space;
        IF new_value^.header.unused_space < #SIZE (new_value^.allocated_space) THEN
          NEXT skip_space: [1 .. #SIZE (new_value^.allocated_space) - new_value^.header.unused_space] IN
                new_space;
        IFEND;
      ELSE
        new_value_size := #SIZE (old_value^.allocated_space) + new_value_size;
        IF new_value_size < minimum_new_value_size THEN
          new_value_size := minimum_new_value_size;
        IFEND;
        NEXT new_value: [[REP new_value_size OF cell]] IN work_area;
        IF new_value = NIL THEN
          work_area_overflow;
        IFEND;
        new_value^.header.value := NIL;
        new_value^.header.unused_space := new_value_size;
        new_value^.header.minimum_allocation_increment := old_value^.header.minimum_allocation_increment;
        new_space := ^new_value^.allocated_space;
        RESET new_space;
        copy_internal_value (old_value, ^old_value^.header.value, new_value, ^new_value^.header.value,
              actual_graft_address, new_space);
      IFEND;

      ignore_graft_address := NIL;
      copy_internal_value (replacement_value, ^replacement_value^.header.value, new_value,
            actual_graft_address, ignore_graft_address, new_space);

      new_value^.header.unused_space := #SIZE (new_value^.allocated_space) -
            i#current_sequence_position (new_space);
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$change_internal_value;
?? TITLE := 'clp$convert_ext_value_to_int', EJECT ??

  PROCEDURE [XDCL] clp$convert_ext_value_to_int
    (    initializing_type_description: ^clt$type_description;
         external_value: ^clt$data_value;
         internal_component_address: ^ REL (clt$internal_data_value) ^clt$i_data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR internal_value {input, output} : ^clt$internal_data_value;
     VAR status: ost$status);

    VAR
*IF NOT $true(osv$unix)
      value_kinds: [STATIC, READ, oss$job_paged_literal] array [clt$type_kind] of
            clt$data_kind := [clc$application, clc$array, clc$boolean, clc$cobol_name, clc$command_reference,
            clc$data_name, clc$date_time, clc$entry_point_reference, clc$file, clc$integer, clc$keyword,
            clc$list, clc$lock, clc$name, clc$network_title, clc$program_name, clc$range, clc$real,
            clc$record, clc$scu_line_identifier, clc$statistic_code, clc$status, clc$status_code, clc$string,
            clc$string_pattern, clc$time_increment, clc$time_zone, clc$type_specification, clc$unspecified];
*ELSE
      value_kinds: [STATIC, READ, oss$job_paged_literal] array [clc$application_type .. clc$unix_file_type] of
            clt$data_kind := [clc$application, clc$array, clc$boolean, clc$cobol_name, clc$command_reference,
            clc$data_name, clc$date_time, clc$entry_point_reference, clc$nos_ve_file, clc$integer,
            clc$keyword, clc$list, clc$lock, clc$name, clc$network_title, clc$program_name, clc$range,
            clc$real, clc$record, clc$scu_line_identifier, clc$statistic_code, clc$status, clc$status_code,
            clc$string, clc$string_pattern, clc$time_increment, clc$time_zone, clc$type_specification,
            clc$unspecified, clc$unix_file];
*IFEND

    VAR
      component_address: ^ REL (clt$internal_data_value) ^clt$i_data_value,
      header: ^clt$internal_data_value_header,
      i_value: ^clt$i_data_value,
      increment_size: clt$internal_data_value_size,
      initial_conversion: boolean,
      initial_position: integer,
      kind: clt$data_kind,
      original_work_area: ^clt$work_area,
      space_size: integer,
      unused_space: clt$internal_data_value_size;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      CASE condition.selector OF

      = pmc$block_exit_processing =
        work_area := original_work_area;
        #SPOIL (work_area);
        RETURN;

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          bad_external_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          bad_external_value;
        IFEND;

      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi =
          bad_external_value;
        = mmc$sac_read_write_beyond_msl, mmc$sac_no_append_permission =
*IF $true(osv$unix)
          bad_external_value;
*ELSE
          IF #SEGMENT (condition.segment_access_condition.segment) = #SEGMENT (work_area) THEN
            work_area_overflow;
          ELSE
            bad_external_value;
          IFEND;
*IFEND
        ELSE
          ;
        CASEND;

      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? TITLE := 'bad_external_value', EJECT ??

    PROCEDURE bad_external_value;


      osp$set_status_abnormal ('CL', cle$bad_data_value, '', status);
      EXIT clp$convert_ext_value_to_int;

    PROCEND bad_external_value;
?? TITLE := 'convert_ext_value_to_int', EJECT ??

    PROCEDURE convert_ext_value_to_int
      (    type_description: ^clt$type_description;
           external_value: ^clt$data_value;
       VAR rel_i_value: REL (clt$internal_data_value) ^clt$i_data_value;
       VAR unused_space: clt$internal_data_value_size;
       VAR increment_size: clt$internal_data_value_size);

      VAR
        computed_increment_size: integer,
        computed_unused_space: integer,
        element_increment_size: clt$internal_data_value_size,
        element_type_description: ^clt$type_description,
        element_unused_space: clt$internal_data_value_size,
        ignore_rel_i_value: REL (clt$internal_data_value) ^clt$i_data_value,
        i_value: ^clt$i_data_value;

?? NEWTITLE := 'convert_application_value', EJECT ??

      PROCEDURE [INLINE] convert_application_value;

        VAR
          application_value: ^clt$application_value_text;


        IF external_value = NIL THEN
          unused_space := unused_space + nominal_application_size;
        ELSE

          NEXT application_value: [STRLENGTH (external_value^.application_value^)] IN work_area;
          IF application_value = NIL THEN
            work_area_overflow;
          IFEND;

          application_value^ := external_value^.application_value^;

          i_value^.application_value := #REL (application_value, internal_value^);
        IFEND;

        increment_size := application_size_increment;

      PROCEND convert_application_value;
?? TITLE := 'convert_array_value', EJECT ??

      PROCEDURE [INLINE] convert_array_value;

        VAR
          elements: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
          i: clt$array_bound,
          number_of_elements: integer;


        number_of_elements := 1;
        IF (type_description <> NIL) AND (type_description^.kind = clc$array_type) THEN
          IF type_description^.array_bounds_defined THEN
            number_of_elements := type_description^.bounds.upper - type_description^.bounds.lower + 1;
          IFEND;
          element_type_description := type_description^.array_element_type_description;
        ELSE
          element_type_description := NIL;
        IFEND;

        IF number_of_elements > (osc$max_segment_length DIV #SIZE (clt$data_value)) THEN
          work_area_overflow;
        IFEND;

        IF external_value = NIL THEN
          convert_ext_value_to_int (element_type_description, NIL, ignore_rel_i_value, element_unused_space,
                element_increment_size);
          computed_unused_space := unused_space + (number_of_elements * element_unused_space);
          computed_increment_size := number_of_elements * element_increment_size;

        ELSE
          NEXT elements: [LOWERBOUND (external_value^.array_value^) .. UPPERBOUND (external_value^.
                array_value^)] IN work_area;
          IF elements = NIL THEN
            work_area_overflow;
          IFEND;
          IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation THEN
            work_area_overflow;
          IFEND;
          i_value^.array_value := #REL (elements, internal_value^);

          computed_unused_space := unused_space;
          computed_increment_size := 0;
          FOR i := LOWERBOUND (external_value^.array_value^) TO UPPERBOUND (external_value^.array_value^) DO
            IF external_value^.array_value^ [i] = NIL THEN
              elements^ [i] := NIL;
            ELSE
              convert_ext_value_to_int (element_type_description, external_value^.array_value^ [i],
                    elements^ [i], element_unused_space, element_increment_size);
              computed_unused_space := computed_unused_space + element_unused_space;
              computed_increment_size := computed_increment_size + element_increment_size;
              IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation
                    THEN
                work_area_overflow;
              IFEND;
            IFEND;
          FOREND;
        IFEND;

        IF computed_unused_space <= max_unused_space THEN
          unused_space := computed_unused_space;
        ELSE
          unused_space := max_unused_space;
        IFEND;

        IF computed_increment_size <= max_increment_size THEN
          increment_size := computed_increment_size;
        ELSE
          increment_size := max_increment_size;
        IFEND;

      PROCEND convert_array_value;
?? TITLE := 'convert_boolean_value', EJECT ??

      PROCEDURE [INLINE] convert_boolean_value;


        IF external_value <> NIL THEN
          i_value^.boolean_value := external_value^.boolean_value;
        IFEND;

      PROCEND convert_boolean_value;
?? TITLE := 'convert_cobol_name_value', EJECT ??

      PROCEDURE [INLINE] convert_cobol_name_value;

        VAR
          cobol_name: ^clt$cobol_name;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (clt$cobol_name);
        ELSE

          NEXT cobol_name IN work_area;
          IF cobol_name = NIL THEN
            work_area_overflow;
          IFEND;

          cobol_name^ := external_value^.cobol_name_value;

          i_value^.cobol_name_value := #REL (cobol_name, internal_value^);
        IFEND;

      PROCEND convert_cobol_name_value;
?? TITLE := ' convert_command_reference_value', EJECT ??

      PROCEDURE [INLINE] convert_command_reference_value;

        VAR
          command_reference: ^clt$command_reference;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (clt$command_reference);
        ELSE

          NEXT command_reference IN work_area;
          IF command_reference = NIL THEN
            work_area_overflow;
          IFEND;

          command_reference^ := external_value^.command_reference_value^;

          i_value^.command_reference_value := #REL (command_reference, internal_value^);
        IFEND;

      PROCEND convert_command_reference_value;
?? TITLE := 'convert_data_name_value', EJECT ??

      PROCEDURE [INLINE] convert_data_name_value;

        VAR
          data_name: ^ost$name;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (ost$name);
        ELSE

          NEXT data_name IN work_area;
          IF data_name = NIL THEN
            work_area_overflow;
          IFEND;

          data_name^ := external_value^.data_name_value;

          i_value^.data_name_value := #REL (data_name, internal_value^);
        IFEND;

      PROCEND convert_data_name_value;
?? TITLE := 'convert_date_time_value', EJECT ??

      PROCEDURE [INLINE] convert_date_time_value;


        IF external_value <> NIL THEN
          i_value^.date_time_value := external_value^.date_time_value;
        IFEND;

      PROCEND convert_date_time_value;
?? TITLE := 'convert_deferred_value', EJECT ??

      PROCEDURE [INLINE] convert_deferred_value;

        VAR
          deferred_value: ^clt$expression_text;


        IF external_value = NIL THEN
          unused_space := unused_space + nominal_deferred_value_size;
        ELSE

          NEXT deferred_value: [clp$trimmed_string_size (external_value^.deferred_value^)] IN work_area;
          IF deferred_value = NIL THEN
            work_area_overflow;
          IFEND;

          deferred_value^ := external_value^.deferred_value^;

          i_value^.deferred_value := #REL (deferred_value, internal_value^);
        IFEND;

        increment_size := deferred_size_increment;

{ Since the only values that can be deferred are those of entire
{ variables and parameters (i.e. NOT components of structured values),
{ the deferred_type field is not stored internally since it can be
{ obtained from the descriptor of the variable or parameter when needed.

      PROCEND convert_deferred_value;
?? TITLE := 'convert_entry_point_ref_value', EJECT ??

      PROCEDURE [INLINE] convert_entry_point_ref_value;

        VAR
          entry_point_reference: ^pmt$entry_point_reference;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (pmt$entry_point_reference);
        ELSE

          NEXT entry_point_reference IN work_area;
          IF entry_point_reference = NIL THEN
            work_area_overflow;
          IFEND;

          entry_point_reference^ := external_value^.entry_point_reference_value^;

          i_value^.entry_point_reference_value := #REL (entry_point_reference, internal_value^);
        IFEND;

      PROCEND convert_entry_point_ref_value;
?? TITLE := 'convert_file_value', EJECT ??

      PROCEDURE [INLINE] convert_file_value;

        VAR
          file_value: ^fst$file_reference;


        IF external_value = NIL THEN
          unused_space := unused_space + nominal_file_size;
        ELSE

          NEXT file_value: [clp$trimmed_string_size (external_value^.file_value^)] IN work_area;
          IF file_value = NIL THEN
            work_area_overflow;
          IFEND;

          file_value^ := external_value^.file_value^;

          i_value^.file_value := #REL (file_value, internal_value^);
        IFEND;

        increment_size := file_size_increment;

      PROCEND convert_file_value;
?? TITLE := 'convert_integer_value', EJECT ??

      PROCEDURE [INLINE] convert_integer_value;


        IF external_value <> NIL THEN
          i_value^.integer_value := external_value^.integer_value;
        IFEND;

      PROCEND convert_integer_value;
?? TITLE := 'convert_keyword_value', EJECT ??

      PROCEDURE [INLINE] convert_keyword_value;

        VAR
          keyword: ^clt$keyword;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (clt$keyword);
        ELSE

          NEXT keyword IN work_area;
          IF keyword = NIL THEN
            work_area_overflow;
          IFEND;

          keyword^ := external_value^.keyword_value;

          i_value^.keyword_value := #REL (keyword, internal_value^);
        IFEND;

      PROCEND convert_keyword_value;
?? TITLE := 'convert_list_value', EJECT ??

      PROCEDURE [INLINE] convert_list_value;

        VAR
          current_i_node: ^clt$i_data_value,
          current_node: ^clt$data_value,
          computed_list_size: clt$list_size,
          previous_i_node: ^clt$i_data_value;


        IF (type_description <> NIL) AND (type_description^.kind = clc$list_type) THEN
          IF type_description^.max_list_size < nominal_list_size THEN
            computed_list_size := type_description^.max_list_size;
          ELSEIF type_description^.min_list_size > nominal_list_size THEN
            computed_list_size := type_description^.min_list_size;
          ELSE
            computed_list_size := nominal_list_size;
          IFEND;
          element_type_description := type_description^.list_element_type_description;
        ELSE
          element_type_description := NIL;
          computed_list_size := nominal_list_size;
        IFEND;

        IF external_value = NIL THEN
          convert_ext_value_to_int (element_type_description, NIL, ignore_rel_i_value, element_unused_space,
                element_increment_size);
          computed_unused_space := unused_space + (computed_list_size * element_unused_space);
          computed_increment_size := computed_list_size * element_increment_size;

        ELSE
          computed_unused_space := unused_space;
          computed_increment_size := 0;

          i_value^.element_value := NIL;
          i_value^.link := NIL;
          i_value^.generated_via_list_rest := external_value^.generated_via_list_rest;
          current_i_node := i_value;
          current_node := external_value;

          REPEAT
            IF current_node^.element_value = NIL THEN
              current_i_node^.element_value := NIL;
            ELSE
              convert_ext_value_to_int (element_type_description, current_node^.element_value,
                    current_i_node^.element_value, element_unused_space, element_increment_size);
              computed_unused_space := computed_unused_space + element_unused_space;
              computed_increment_size := computed_increment_size + element_increment_size;
              IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation
                    THEN
                work_area_overflow;
              IFEND;
            IFEND;

            current_node := current_node^.link;
            IF current_node <> NIL THEN
              previous_i_node := current_i_node;
              NEXT current_i_node IN work_area;
              IF current_i_node = NIL THEN
                work_area_overflow;
              IFEND;
              current_i_node^.kind := clc$list;
              current_i_node^.element_value := NIL;
              current_i_node^.link := NIL;
              current_i_node^.generated_via_list_rest := FALSE;
              previous_i_node^.link := #REL (current_i_node, internal_value^);
            IFEND;
          UNTIL current_node = NIL;
        IFEND;

        IF computed_unused_space <= max_unused_space THEN
          unused_space := computed_unused_space;
        ELSE
          unused_space := max_unused_space;
        IFEND;

        IF computed_increment_size <= max_increment_size THEN
          increment_size := computed_increment_size;
        ELSE
          increment_size := max_increment_size;
        IFEND;

      PROCEND convert_list_value;
?? TITLE := 'convert_lock_value', EJECT ??

      PROCEDURE [INLINE] convert_lock_value;

        VAR
          lock_value: ^clt$lock;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (clt$lock);
        ELSE

          NEXT lock_value IN work_area;
          IF lock_value = NIL THEN
            work_area_overflow;
          IFEND;

          lock_value^ := external_value^.lock_value^;

          i_value^.lock_value := #REL (lock_value, internal_value^);
        IFEND;

      PROCEND convert_lock_value;
?? TITLE := 'convert_name_value', EJECT ??

      PROCEDURE [INLINE] convert_name_value;


        VAR
          name: ^ost$name;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (ost$name);
        ELSE

          NEXT name IN work_area;
          IF name = NIL THEN
            work_area_overflow;
          IFEND;

          name^ := external_value^.name_value;

          i_value^.name_value := #REL (name, internal_value^);
        IFEND;

      PROCEND convert_name_value;
?? TITLE := 'convert_network_title_value', EJECT ??

      PROCEDURE [INLINE] convert_network_title_value;

        VAR
          network_title_value: ^nat$title;


        IF external_value = NIL THEN
          unused_space := unused_space + nominal_network_title_size;
        ELSE

          NEXT network_title_value: [clp$trimmed_string_size (external_value^.network_title_value^)] IN
                work_area;
          IF network_title_value = NIL THEN
            work_area_overflow;
          IFEND;

          network_title_value^ := external_value^.network_title_value^;

          i_value^.network_title_value := #REL (network_title_value, internal_value^);
        IFEND;

        increment_size := network_title_size_increment;

      PROCEND convert_network_title_value;
?? TITLE := 'convert_program_name_value', EJECT ??

      PROCEDURE [INLINE] convert_program_name_value;

        VAR
          program_name: ^pmt$program_name;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (pmt$program_name);
        ELSE

          NEXT program_name IN work_area;
          IF program_name = NIL THEN
            work_area_overflow;
          IFEND;

          program_name^ := external_value^.program_name_value;

          i_value^.program_name_value := #REL (program_name, internal_value^);
        IFEND;

      PROCEND convert_program_name_value;
?? TITLE := 'convert_range_value', EJECT ??

      PROCEDURE [INLINE] convert_range_value;


        IF (type_description <> NIL) AND (type_description^.kind = clc$range_type) THEN
          element_type_description := type_description^.range_element_type_description;
        ELSE
          element_type_description := NIL;
        IFEND;

        IF external_value = NIL THEN
          convert_ext_value_to_int (element_type_description, NIL, ignore_rel_i_value, element_unused_space,
                element_increment_size);
          computed_unused_space := unused_space + (2 * element_unused_space);
          computed_increment_size := 2 * element_increment_size;

        ELSE
          computed_unused_space := unused_space;
          computed_increment_size := 0;
          IF external_value^.low_value = NIL THEN
            i_value^.low_value := NIL;
          ELSE
            convert_ext_value_to_int (element_type_description, external_value^.low_value, i_value^.low_value,
                  element_unused_space, element_increment_size);
            computed_unused_space := computed_unused_space + element_unused_space;
            computed_increment_size := computed_increment_size + element_increment_size;
            IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation THEN
              work_area_overflow;
            IFEND;
          IFEND;

          IF external_value^.high_value = external_value^.low_value THEN
            i_value^.high_value := i_value^.low_value;
          ELSE
            convert_ext_value_to_int (element_type_description, external_value^.high_value,
                  i_value^.high_value, element_unused_space, element_increment_size);
            computed_unused_space := computed_unused_space + element_unused_space;
            computed_increment_size := computed_increment_size + element_increment_size;
            IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation THEN
              work_area_overflow;
            IFEND;
          IFEND;
        IFEND;

        IF computed_unused_space <= max_unused_space THEN
          unused_space := computed_unused_space;
        ELSE
          unused_space := max_unused_space;
        IFEND;

        IF computed_increment_size <= max_increment_size THEN
          increment_size := computed_increment_size;
        ELSE
          increment_size := max_increment_size;
        IFEND;

      PROCEND convert_range_value;
?? TITLE := 'convert_real_value', EJECT ??

      PROCEDURE [INLINE] convert_real_value;


        IF external_value <> NIL THEN
          i_value^.real_value := external_value^.real_value;
        IFEND;

      PROCEND convert_real_value;
?? TITLE := 'convert_record_value', EJECT ??

      PROCEDURE [INLINE] convert_record_value;

        VAR
          fields: ^array [1 .. * ] of clt$internal_field_value,
          i: clt$field_number,
          number_of_fields: clt$field_number;


        IF external_value = NIL THEN
          number_of_fields := type_description^.fields_pdt^.header^.number_of_parameters;
        ELSE
          NEXT fields: [1 .. UPPERBOUND (external_value^.field_values^)] IN work_area;
          IF fields = NIL THEN
            work_area_overflow;
          IFEND;
          IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation THEN
            work_area_overflow;
          IFEND;
          i_value^.field_values := #REL (fields, internal_value^);
          number_of_fields := UPPERBOUND (external_value^.field_values^);
        IFEND;

        computed_unused_space := unused_space;
        computed_increment_size := 0;
        FOR i := 1 TO number_of_fields DO
          IF (type_description <> NIL) AND (type_description^.kind = clc$record_type) AND ((external_value =
                NIL) OR ((UPPERBOUND (external_value^.field_values^) = type_description^.fields_pdt^.header^.
                number_of_parameters) AND (external_value^.field_values^ [i].name =
                type_description^.fields_pdt^.names^ [i].name))) THEN
            element_type_description := ^type_description^.fields_pdt^.type_descriptions^ [i];
          ELSE
            element_type_description := NIL;
          IFEND;

          IF external_value = NIL THEN
            convert_ext_value_to_int (element_type_description, NIL, ignore_rel_i_value, element_unused_space,
                  element_increment_size);
          ELSE

            fields^ [i].name := external_value^.field_values^ [i].name;
            IF external_value^.field_values^ [i].value = NIL THEN
              fields^ [i].value := NIL;
            ELSE
              convert_ext_value_to_int (element_type_description, external_value^.field_values^ [i].value,
                    fields^ [i].value, element_unused_space, element_increment_size);
              IF (i#current_sequence_position (work_area) - initial_position) > clv$max_variable_allocation
                    THEN
                work_area_overflow;
              IFEND;
            IFEND;
          IFEND;

          computed_unused_space := unused_space + element_unused_space;
          computed_increment_size := computed_increment_size + element_increment_size;
        FOREND;

        IF computed_unused_space <= max_unused_space THEN
          unused_space := computed_unused_space;
        ELSE
          unused_space := max_unused_space;
        IFEND;

        IF computed_increment_size <= max_increment_size THEN
          increment_size := computed_increment_size;
        ELSE
          increment_size := max_increment_size;
        IFEND;

      PROCEND convert_record_value;
?? TITLE := 'convert_scu_line_id_value', EJECT ??

      PROCEDURE [INLINE] convert_scu_line_id_value;


        IF external_value <> NIL THEN
          i_value^.scu_line_identifier_value := external_value^.scu_line_identifier_value;
        IFEND;

      PROCEND convert_scu_line_id_value;
?? TITLE := 'convert_statistic_code_value', EJECT ??

      PROCEDURE [INLINE] convert_statistic_code_value;


        IF external_value <> NIL THEN
          i_value^.statistic_code_value := external_value^.statistic_code_value;
        IFEND;

      PROCEND convert_statistic_code_value;
?? TITLE := 'convert_status_value', EJECT ??

      PROCEDURE [INLINE] convert_status_value;

        VAR
          status_value: ^ost$status;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (ost$status);
        ELSE

          NEXT status_value IN work_area;
          IF status_value = NIL THEN
            work_area_overflow;
          IFEND;

          status_value^ := external_value^.status_value^;

          i_value^.status_value := #REL (status_value, internal_value^);
        IFEND;

      PROCEND convert_status_value;
?? TITLE := 'convert_status_code_value', EJECT ??

      PROCEDURE [INLINE] convert_status_code_value;

        IF external_value <> NIL THEN
          i_value^.status_code_value := external_value^.status_code_value;
        IFEND;

      PROCEND convert_status_code_value;
?? TITLE := 'convert_string_value', EJECT ??

      PROCEDURE [INLINE] convert_string_value;

        VAR
          computed_string_size: clt$string_size,
          string_value: ^clt$string_value;


        IF (type_description <> NIL) AND (type_description^.kind = clc$string_type) THEN
          IF type_description^.max_string_size < nominal_string_size THEN
            computed_string_size := type_description^.max_string_size;
          ELSEIF type_description^.min_string_size > nominal_string_size THEN
            computed_string_size := type_description^.min_string_size;
          ELSE
            computed_string_size := nominal_string_size;
          IFEND;
        ELSE
          computed_string_size := nominal_string_size;
        IFEND;

        IF external_value = NIL THEN
          unused_space := unused_space + computed_string_size;
        ELSE
          IF computed_string_size > STRLENGTH (external_value^.string_value^) THEN
            unused_space := computed_string_size - STRLENGTH (external_value^.string_value^);
          IFEND;

          NEXT string_value: [STRLENGTH (external_value^.string_value^)] IN work_area;
          IF string_value = NIL THEN
            work_area_overflow;
          IFEND;

          string_value^ := external_value^.string_value^;

          i_value^.string_value := #REL (string_value, internal_value^);
        IFEND;

        IF computed_string_size <= string_size_increment THEN
          increment_size := computed_string_size;
        ELSE
          increment_size := string_size_increment;
        IFEND;

      PROCEND convert_string_value;
?? TITLE := 'convert_string_pattern_value', EJECT ??

      PROCEDURE [INLINE] convert_string_pattern_value;

        VAR
          string_pattern: ^clt$string_pattern;


        IF external_value <> NIL THEN
          NEXT string_pattern: [[REP #SIZE (external_value^.string_pattern_value^) OF cell]] IN work_area;
          IF string_pattern = NIL THEN
            work_area_overflow;
          IFEND;

          string_pattern^ := external_value^.string_pattern_value^;

          i_value^.string_pattern_value := #REL (string_pattern, internal_value^);
        IFEND;

      PROCEND convert_string_pattern_value;
?? TITLE := 'convert_time_increment_value', EJECT ??

      PROCEDURE [INLINE] convert_time_increment_value;

        VAR
          time_increment_value: ^pmt$time_increment;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (pmt$time_increment);
        ELSE

          NEXT time_increment_value IN work_area;
          IF time_increment_value = NIL THEN
            work_area_overflow;
          IFEND;

          time_increment_value^ := external_value^.time_increment_value^;

          i_value^.time_increment_value := #REL (time_increment_value, internal_value^);
        IFEND;

      PROCEND convert_time_increment_value;
?? TITLE := 'convert_time_zone_value', EJECT ??

      PROCEDURE [INLINE] convert_time_zone_value;


        IF external_value <> NIL THEN
          i_value^.time_zone_value := external_value^.time_zone_value;
        IFEND;

      PROCEND convert_time_zone_value;
?? TITLE := 'convert_type_spec_value', EJECT ??

      PROCEDURE [INLINE] convert_type_spec_value;

        VAR
          type_specification: ^clt$type_specification;


        IF external_value = NIL THEN
          unused_space := unused_space + #SIZE (clt$type_specification_header);
        ELSE

          NEXT type_specification: [[REP #SIZE (external_value^.type_specification_value^) OF cell]] IN
                work_area;
          IF type_specification = NIL THEN
            work_area_overflow;
          IFEND;

          type_specification^ := external_value^.type_specification_value^;

          i_value^.type_specification_value := #REL (type_specification, internal_value^);
        IFEND;

      PROCEND convert_type_spec_value;
?? OLDTITLE, EJECT ??

      increment_size := 0;
      unused_space := 0;
      IF external_value = NIL THEN
        i_value := NIL;
        rel_i_value := NIL;
        IF type_description = NIL THEN
          RETURN;
        IFEND;
        unused_space := #SIZE (clt$i_data_value);
        kind := value_kinds [type_description^.kind];
      ELSE
        NEXT i_value IN work_area;
        IF i_value = NIL THEN
          work_area_overflow;
        IFEND;
        rel_i_value := #REL (i_value, internal_value^);
        i_value^.kind := external_value^.kind;
        kind := i_value^.kind;
      IFEND;

      CASE kind OF
      = clc$application =
        convert_application_value;
      = clc$array =
        convert_array_value;
      = clc$boolean =
        convert_boolean_value;
      = clc$cobol_name =
        convert_cobol_name_value;
      = clc$command_reference =
        convert_command_reference_value;
      = clc$data_name =
        convert_data_name_value;
      = clc$date_time =
        convert_date_time_value;
      = clc$deferred =
        convert_deferred_value;
      = clc$entry_point_reference =
        convert_entry_point_ref_value;
*IF NOT $true(osv$unix)
      = clc$file =
*ELSE
      = {clc$file} clc$nos_ve_file, clc$unix_file =
*IFEND
        convert_file_value;
      = clc$integer =
        convert_integer_value;
      = clc$keyword =
        convert_keyword_value;
      = clc$list =
        convert_list_value;
      = clc$lock =
        convert_lock_value;
      = clc$name =
        convert_name_value;
      = clc$network_title =
        convert_network_title_value;
      = clc$program_name =
        convert_program_name_value;
      = clc$range =
        convert_range_value;
      = clc$real =
        convert_real_value;
      = clc$record =
        convert_record_value;
      = clc$scu_line_identifier =
        convert_scu_line_id_value;
      = clc$statistic_code =
        convert_statistic_code_value;
      = clc$status =
        convert_status_value;
      = clc$status_code =
        convert_status_code_value;
      = clc$string =
        convert_string_value;
      = clc$string_pattern =
        convert_string_pattern_value;
      = clc$time_increment =
        convert_time_increment_value;
      = clc$time_zone =
        convert_time_zone_value;
      = clc$type_specification =
        convert_type_spec_value;
      = clc$unspecified =
        ;
      ELSE
        bad_external_value;
      CASEND;

    PROCEND convert_ext_value_to_int;
?? TITLE := 'work_area_overflow', EJECT ??

    PROCEDURE work_area_overflow;


      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      EXIT clp$convert_ext_value_to_int;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    original_work_area := work_area;
    #SPOIL (original_work_area);
    osp$establish_condition_handler (^abort_handler, TRUE);

    initial_conversion := internal_value = NIL;
    IF initial_conversion THEN
      initial_position := i#current_sequence_position (work_area);
      space_size := #SIZE (work_area^) - initial_position - #SIZE (clt$internal_data_value_header);
      IF space_size <= 0 THEN
        work_area_overflow;
      IFEND;
      NEXT internal_value: [[REP space_size OF cell]] IN work_area;
      RESET work_area TO internal_value;
      NEXT header IN work_area;
      header^.value := NIL;
      header^.unused_space := 0;
      header^.minimum_allocation_increment := 0;
    ELSE
      initial_position := #OFFSET (internal_value) - #OFFSET (work_area);
    IFEND;

    IF internal_component_address <> NIL THEN
      component_address := internal_component_address;
    ELSE
      component_address := ^internal_value^.header.value;
    IFEND;

    convert_ext_value_to_int (initializing_type_description, external_value, component_address^, unused_space,
          increment_size);

    IF initial_conversion THEN
      space_size := i#current_sequence_position (work_area) -
            initial_position - #SIZE (clt$internal_data_value_header);
      IF initializing_type_description <> NIL THEN
        space_size := space_size + unused_space;
        header^.unused_space := unused_space;
        header^.minimum_allocation_increment := increment_size;
      IFEND;
      RESET work_area TO header;
      NEXT internal_value: [[REP space_size OF cell]] IN work_area;
      IF internal_value = NIL THEN
        work_area_overflow;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$convert_ext_value_to_int;
?? TITLE := 'clp$convert_int_value_to_ext', EJECT ??

  PROCEDURE [XDCL] clp$convert_int_value_to_ext
    (    internal_value: ^clt$internal_data_value;
         initial_component: REL (clt$internal_data_value) ^clt$i_data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR external_value: ^clt$data_value;
     VAR status: ost$status);

    VAR
      original_work_area: ^clt$work_area;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      CASE condition.selector OF

      = pmc$block_exit_processing =
        work_area := original_work_area;
        #SPOIL (work_area);
        RETURN;

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          bad_internal_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          bad_internal_value;
        IFEND;

      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi =
          bad_internal_value;
        = mmc$sac_read_write_beyond_msl, mmc$sac_no_append_permission =
*IF $true(osv$unix)
          bad_internal_value;
*ELSE
          IF #SEGMENT (condition.segment_access_condition.segment) = #SEGMENT (work_area) THEN
            work_area_overflow;
          ELSE
            bad_internal_value;
          IFEND;
*IFEND
        ELSE
          ;
        CASEND;

      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? TITLE := 'bad_internal_value', EJECT ??

    PROCEDURE bad_internal_value;


      osp$set_status_abnormal ('CL', cle$bad_internal_value, '', status);
      EXIT clp$convert_int_value_to_ext;

    PROCEND bad_internal_value;
?? TITLE := 'convert_int_value_to_ext', EJECT ??

    PROCEDURE convert_int_value_to_ext
      (    i_value: ^clt$i_data_value;
       VAR external_value: ^clt$data_value);

?? NEWTITLE := 'convert_application_value', EJECT ??

      PROCEDURE [INLINE] convert_application_value;

        VAR
          application_value: ^clt$application_value_text;


        application_value := #PTR (i_value^.application_value, internal_value^);

        clp$make_application_value (application_value^, work_area, external_value);

      PROCEND convert_application_value;
?? TITLE := 'convert_array_value', EJECT ??

      PROCEDURE [INLINE] convert_array_value;

        VAR
          element: ^clt$i_data_value,
          elements: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
          i: clt$array_bound;


        elements := #PTR (i_value^.array_value, internal_value^);

        clp$make_array_value (LOWERBOUND (elements^), UPPERBOUND (elements^), work_area, external_value);
        IF external_value = NIL THEN
          work_area_overflow;
        IFEND;

        FOR i := LOWERBOUND (elements^) TO UPPERBOUND (elements^) DO
          IF elements^ [i] = NIL THEN
            external_value^.array_value^ [i] := NIL;
          ELSE
            convert_int_value_to_ext (#PTR (elements^ [i], internal_value^),
                  external_value^.array_value^ [i]);
          IFEND;
        FOREND;

      PROCEND convert_array_value;
?? TITLE := 'convert_boolean_value', EJECT ??

      PROCEDURE [INLINE] convert_boolean_value;


        clp$make_clt$boolean_value (i_value^.boolean_value, work_area, external_value);

      PROCEND convert_boolean_value;
?? TITLE := 'convert_cobol_name_value', EJECT ??

      PROCEDURE [INLINE] convert_cobol_name_value;

        VAR
          cobol_name: ^clt$cobol_name;


        cobol_name := #PTR (i_value^.cobol_name_value, internal_value^);

        clp$make_cobol_name_value (cobol_name^, work_area, external_value);

      PROCEND convert_cobol_name_value;
?? TITLE := 'convert_command_reference_value', EJECT ??

      PROCEDURE [INLINE] convert_command_reference_value;

        VAR
          command_reference: ^clt$command_reference;


        command_reference := #PTR (i_value^.command_reference_value, internal_value^);

        clp$make_command_ref_value (command_reference, work_area, external_value);

      PROCEND convert_command_reference_value;
?? TITLE := 'convert_data_name_value', EJECT ??

      PROCEDURE [INLINE] convert_data_name_value;

        VAR
          data_name: ^ost$name;


        data_name := #PTR (i_value^.data_name_value, internal_value^);

        clp$make_data_name_value (data_name^, work_area, external_value);

      PROCEND convert_data_name_value;
?? TITLE := 'convert_date_time_value', EJECT ??

      PROCEDURE [INLINE] convert_date_time_value;


        clp$make_date_time_value (i_value^.date_time_value, work_area, external_value);

      PROCEND convert_date_time_value;
?? TITLE := 'convert_deferred_value', EJECT ??

      PROCEDURE [INLINE] convert_deferred_value;

        VAR
          expression_text: ^clt$expression_text;


        expression_text := #PTR (i_value^.deferred_value, internal_value^);

{ Since the only values that can be deferred are those of entire
{ variables and parameters (i.e. NOT components of structured values),
{ the deferred_type field is not stored internally since it can be
{ obtained from the descriptor of the variable or parameter when needed.

        clp$make_deferred_value (expression_text^, NIL, work_area, external_value);

      PROCEND convert_deferred_value;
?? TITLE := 'convert_entry_point_ref_value', EJECT ??

      PROCEDURE [INLINE] convert_entry_point_ref_value;

        VAR
          entry_point_reference: ^pmt$entry_point_reference;


        entry_point_reference := #PTR (i_value^.entry_point_reference_value, internal_value^);

        clp$make_entry_point_ref_value (entry_point_reference^.entry_point,
              entry_point_reference^.object_library, work_area, external_value);

      PROCEND convert_entry_point_ref_value;
?? TITLE := 'convert_file_value', EJECT ??

      PROCEDURE [INLINE] convert_file_value;

        VAR
          file_value: ^fst$file_reference;


        file_value := #PTR (i_value^.file_value, internal_value^);

*IF NOT $true(osv$unix)
        clp$make_file_value (file_value^, work_area, external_value);
*ELSE
        clp$make_a_file_value (i_value^.kind, file_value^, work_area, external_value);
*IFEND

      PROCEND convert_file_value;
?? TITLE := 'convert_integer_value', EJECT ??

      PROCEDURE [INLINE] convert_integer_value;


        clp$make_clt$integer_value (i_value^.integer_value, work_area, external_value);

      PROCEND convert_integer_value;
?? TITLE := 'convert_keyword_value', EJECT ??

      PROCEDURE [INLINE] convert_keyword_value;

        VAR
          keyword: ^clt$keyword;


        keyword := #PTR (i_value^.keyword_value, internal_value^);

        clp$make_keyword_value (keyword^, work_area, external_value);

      PROCEND convert_keyword_value;
?? TITLE := 'convert_list_value', EJECT ??

      PROCEDURE [INLINE] convert_list_value;

        VAR
          current_i_node: ^clt$i_data_value,
          current_node: ^clt$data_value,
          previous_node: ^clt$data_value;


        current_i_node := i_value;
        external_value := NIL;

        REPEAT
          clp$make_list_value (work_area, current_node);
          IF current_node = NIL THEN
            work_area_overflow;
          IFEND;

          IF external_value = NIL THEN
            external_value := current_node;
            external_value^.generated_via_list_rest := i_value^.generated_via_list_rest;
          ELSE
            previous_node^.link := current_node;
          IFEND;

          IF current_i_node^.element_value <> NIL THEN
            convert_int_value_to_ext (#PTR (current_i_node^.element_value, internal_value^),
                  current_node^.element_value);
          IFEND;

          previous_node := current_node;
          current_i_node := #PTR (current_i_node^.link, internal_value^);
        UNTIL current_i_node = NIL;

      PROCEND convert_list_value;
?? TITLE := 'convert_lock_value', EJECT ??

      PROCEDURE [INLINE] convert_lock_value;

        VAR
          lock_value: ^clt$lock;


        lock_value := #PTR (i_value^.lock_value, internal_value^);

        clp$make_lock_value (lock_value, work_area, external_value);

      PROCEND convert_lock_value;
?? TITLE := 'convert_name_value', EJECT ??

      PROCEDURE [INLINE] convert_name_value;

        VAR
          name: ^ost$name;


        name := #PTR (i_value^.name_value, internal_value^);

        clp$make_name_value (name^, work_area, external_value);

      PROCEND convert_name_value;
?? TITLE := 'convert_network_title_value', EJECT ??

      PROCEDURE [INLINE] convert_network_title_value;

        VAR
          network_title_value: ^nat$title;


        network_title_value := #PTR (i_value^.network_title_value, internal_value^);

        clp$make_network_title_value (network_title_value^, work_area, external_value);

      PROCEND convert_network_title_value;
?? TITLE := 'convert_program_name_value', EJECT ??

      PROCEDURE [INLINE] convert_program_name_value;

        VAR
          program_name: ^pmt$program_name;


        program_name := #PTR (i_value^.program_name_value, internal_value^);

        clp$make_program_name_value (program_name^, work_area, external_value);

      PROCEND convert_program_name_value;
?? TITLE := 'convert_range_value', EJECT ??

      PROCEDURE [INLINE] convert_range_value;


        clp$make_range_value (work_area, external_value);
        IF external_value = NIL THEN
          work_area_overflow;
        IFEND;

        convert_int_value_to_ext (#PTR (i_value^.low_value, internal_value^), external_value^.low_value);

        IF i_value^.high_value = i_value^.low_value THEN
          external_value^.high_value := external_value^.low_value;
        ELSE
          convert_int_value_to_ext (#PTR (i_value^.high_value, internal_value^), external_value^.high_value);
        IFEND;

      PROCEND convert_range_value;
?? TITLE := 'convert_real_value', EJECT ??

      PROCEDURE [INLINE] convert_real_value;


        clp$make_clt$real_value (i_value^.real_value, work_area, external_value);

      PROCEND convert_real_value;
?? TITLE := 'convert_record_value', EJECT ??

      PROCEDURE [INLINE] convert_record_value;

        VAR
          element: ^clt$i_data_value,
          fields: ^array [1 .. * ] of clt$internal_field_value,
          i: clt$field_number;


        fields := #PTR (i_value^.field_values, internal_value^);

        clp$make_record_value (UPPERBOUND (fields^), work_area, external_value);
        IF external_value = NIL THEN
          work_area_overflow;
        IFEND;

        FOR i := 1 TO UPPERBOUND (fields^) DO
          external_value^.field_values^ [i].name := fields^ [i].name;
          IF fields^ [i].value = NIL THEN
            external_value^.field_values^ [i].value := NIL;
          ELSE
            convert_int_value_to_ext (#PTR (fields^ [i].value, internal_value^),
                  external_value^.field_values^ [i].value);
          IFEND;
        FOREND;

      PROCEND convert_record_value;
?? TITLE := 'convert_scu_line_id_value', EJECT ??

      PROCEDURE [INLINE] convert_scu_line_id_value;


        clp$make_scu_line_id_value (i_value^.scu_line_identifier_value, work_area, external_value);

      PROCEND convert_scu_line_id_value;
?? TITLE := 'convert_statistic_code_value', EJECT ??

      PROCEDURE [INLINE] convert_statistic_code_value;


        clp$make_statistic_code_value (i_value^.statistic_code_value, work_area, external_value);

      PROCEND convert_statistic_code_value;
?? TITLE := 'convert_status_value', EJECT ??

      PROCEDURE [INLINE] convert_status_value;

        VAR
          status_value: ^ost$status;


        status_value := #PTR (i_value^.status_value, internal_value^);

        clp$make_status_value (status_value^, work_area, external_value);

      PROCEND convert_status_value;
?? TITLE := 'convert_status_code_value', EJECT ??

      PROCEDURE [INLINE] convert_status_code_value;


        clp$make_status_code_value (i_value^.status_code_value, work_area, external_value);

      PROCEND convert_status_code_value;
?? TITLE := 'convert_string_value', EJECT ??

      PROCEDURE [INLINE] convert_string_value;

        VAR
          string_value: ^clt$string_value;


        string_value := #PTR (i_value^.string_value, internal_value^);

        clp$make_string_value (string_value^, work_area, external_value);

      PROCEND convert_string_value;
?? TITLE := 'convert_string_pattern_value', EJECT ??

      PROCEDURE [INLINE] convert_string_pattern_value;

        VAR
          string_pattern: ^clt$string_pattern;


        string_pattern := #PTR (i_value^.string_pattern_value, internal_value^);

        clp$make_string_pattern_value (string_pattern^, work_area, external_value);

      PROCEND convert_string_pattern_value;
?? TITLE := 'convert_time_increment_value', EJECT ??

      PROCEDURE [INLINE] convert_time_increment_value;

        VAR
          time_increment: ^pmt$time_increment;


        time_increment := #PTR (i_value^.time_increment_value, internal_value^);

        clp$make_time_increment_value (time_increment, work_area, external_value);

      PROCEND convert_time_increment_value;
?? TITLE := 'convert_time_zone_value', EJECT ??

      PROCEDURE [INLINE] convert_time_zone_value;


        clp$make_time_zone_value (i_value^.time_zone_value, work_area, external_value);

      PROCEND convert_time_zone_value;
?? TITLE := 'convert_type_spec_value', EJECT ??

      PROCEDURE [INLINE] convert_type_spec_value;

        VAR
          internal_type_specification: ^clt$type_specification,
          type_specification: ^clt$type_specification;


        internal_type_specification := #PTR (i_value^.type_specification_value, internal_value^);

        NEXT type_specification: [[REP #SIZE (internal_type_specification^) OF cell]] IN work_area;
        IF type_specification <> NIL THEN
          type_specification^ := internal_type_specification^;
          clp$make_type_spec_value (type_specification, work_area, external_value);
        IFEND;

      PROCEND convert_type_spec_value;
?? TITLE := 'convert_unspecified_value', EJECT ??

      PROCEDURE [INLINE] convert_unspecified_value;


        clp$make_unspecified_value (work_area, external_value);

      PROCEND convert_unspecified_value;
?? OLDTITLE, EJECT ??

      CASE i_value^.kind OF
      = clc$application =
        convert_application_value;
      = clc$array =
        convert_array_value;
      = clc$boolean =
        convert_boolean_value;
      = clc$cobol_name =
        convert_cobol_name_value;
      = clc$command_reference =
        convert_command_reference_value;
      = clc$data_name =
        convert_data_name_value;
      = clc$date_time =
        convert_date_time_value;
      = clc$deferred =
        convert_deferred_value;
      = clc$entry_point_reference =
        convert_entry_point_ref_value;
*IF NOT $true(osv$unix)
      = clc$file =
*ELSE
      = {clc$file} clc$nos_ve_file, clc$unix_file =
*IFEND
        convert_file_value;
      = clc$integer =
        convert_integer_value;
      = clc$keyword =
        convert_keyword_value;
      = clc$list =
        convert_list_value;
      = clc$lock =
        convert_lock_value;
      = clc$name =
        convert_name_value;
      = clc$network_title =
        convert_network_title_value;
      = clc$program_name =
        convert_program_name_value;
      = clc$range =
        convert_range_value;
      = clc$real =
        convert_real_value;
      = clc$record =
        convert_record_value;
      = clc$scu_line_identifier =
        convert_scu_line_id_value;
      = clc$statistic_code =
        convert_statistic_code_value;
      = clc$status =
        convert_status_value;
      = clc$status_code =
        convert_status_code_value;
      = clc$string =
        convert_string_value;
      = clc$string_pattern =
        convert_string_pattern_value;
      = clc$time_increment =
        convert_time_increment_value;
      = clc$time_zone =
        convert_time_zone_value;
      = clc$type_specification =
        convert_type_spec_value;
      = clc$unspecified =
        convert_unspecified_value;
      ELSE
        bad_internal_value;
      CASEND;

      IF external_value = NIL THEN
        work_area_overflow;
      IFEND;

    PROCEND convert_int_value_to_ext;
?? TITLE := 'work_area_overflow', EJECT ??

    PROCEDURE work_area_overflow;


      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      EXIT clp$convert_int_value_to_ext;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

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

    original_work_area := work_area;
    #SPOIL (original_work_area);
    osp$establish_condition_handler (^abort_handler, TRUE);

    IF (internal_value = NIL) OR (initial_component = NIL) THEN
      bad_internal_value;
    IFEND;

    convert_int_value_to_ext (#PTR (initial_component, internal_value^), external_value);

    osp$disestablish_cond_handler;

  PROCEND clp$convert_int_value_to_ext;
*IFEND
?? TITLE := 'clp$copy_data_value', EJECT ??

  PROCEDURE [XDCL] clp$copy_data_value
    (    old_value: ^clt$data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR new_value: ^clt$data_value;
     VAR status: ost$status);

    VAR
*IF $true(osv$unix)
      handler_established: boolean,
*IFEND
      original_work_area: ^clt$work_area;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
*IF $true(osv$unix)
      (    signal_no: integer;
           code: integer;
           p_sigcontext: ^cyt$mips_sigcontext);
*ELSE
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      CASE condition.selector OF

      = pmc$block_exit_processing =
*IFEND
        work_area := original_work_area;
        #SPOIL (work_area);
        RETURN;

*IF NOT $true(osv$unix)
      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          bad_data_value;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          bad_data_value;
        IFEND;

      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi =
          bad_data_value;
        = mmc$sac_read_write_beyond_msl, mmc$sac_no_append_permission =
*IF $true(osv$unix)
          bad_data_value;
*ELSE
          IF #SEGMENT (condition.segment_access_condition.segment) = #SEGMENT (work_area) THEN
            work_area_overflow;
          ELSE
            bad_data_value;
          IFEND;
*IFEND
        ELSE
          ;
        CASEND;

      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
*IFEND

    PROCEND abort_handler;
?? TITLE := 'bad_data_value', EJECT ??

    PROCEDURE [INLINE] bad_data_value;


      osp$set_status_abnormal ('CL', cle$bad_data_value, '', status);
      EXIT clp$copy_data_value;

    PROCEND bad_data_value;
?? TITLE := 'copy_data_value', EJECT ??

    PROCEDURE copy_data_value
      (    old_value: ^clt$data_value;
       VAR new_value: ^clt$data_value);

?? NEWTITLE := 'copy_application_value', EJECT ??

      PROCEDURE [INLINE] copy_application_value;

        VAR
          new_application_value: ^clt$application_value_text,
          old_application_value: ^clt$application_value_text;


        NEXT new_value^.application_value: [STRLENGTH (old_value^.application_value^)] IN work_area;
        IF new_value^.application_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.application_value^ := old_value^.application_value^;

      PROCEND copy_application_value;
?? TITLE := 'copy_array_value', EJECT ??

      PROCEDURE [INLINE] copy_array_value;

        VAR
          i: clt$array_bound;


        NEXT new_value^.array_value: [LOWERBOUND (old_value^.array_value^) .. UPPERBOUND (old_value^.
              array_value^)] IN work_area;
        IF new_value^.array_value = NIL THEN
          work_area_overflow;
        IFEND;

        FOR i := LOWERBOUND (old_value^.array_value^) TO UPPERBOUND (old_value^.array_value^) DO
          IF old_value^.array_value^ [i] = NIL THEN
            new_value^.array_value^ [i] := NIL;
          ELSE
            copy_data_value (old_value^.array_value^ [i], new_value^.array_value^ [i]);
          IFEND;
        FOREND;

      PROCEND copy_array_value;
?? TITLE := 'copy_command_reference_value', EJECT ??

      PROCEDURE [INLINE] copy_command_reference_value;


        NEXT new_value^.command_reference_value IN work_area;
        IF new_value^.command_reference_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.command_reference_value^ := old_value^.command_reference_value^;

      PROCEND copy_command_reference_value;
?? TITLE := 'copy_deferred_value', EJECT ??

      PROCEDURE [INLINE] copy_deferred_value;


        NEXT new_value^.deferred_value: [STRLENGTH (old_value^.deferred_value^)] IN work_area;
        NEXT new_value^.deferred_type: [[REP #SIZE (old_value^.deferred_type^) OF cell]] IN work_area;
        IF (new_value^.deferred_value = NIL) OR (new_value^.deferred_type = NIL) THEN
          work_area_overflow;
        IFEND;

        new_value^.deferred_value^ := old_value^.deferred_value^;
        new_value^.deferred_type^ := old_value^.deferred_type^;

      PROCEND copy_deferred_value;
?? TITLE := 'copy_entry_point_ref_value', EJECT ??

      PROCEDURE [INLINE] copy_entry_point_ref_value;


        NEXT new_value^.entry_point_reference_value IN work_area;
        IF new_value^.entry_point_reference_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.entry_point_reference_value^ := old_value^.entry_point_reference_value^;

      PROCEND copy_entry_point_ref_value;
?? TITLE := 'copy_file_value', EJECT ??

      PROCEDURE [INLINE] copy_file_value;


        NEXT new_value^.file_value: [STRLENGTH (old_value^.file_value^)] IN work_area;
        IF new_value^.file_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.file_value^ := old_value^.file_value^;

      PROCEND copy_file_value;
?? TITLE := 'copy_list_value', EJECT ??

      PROCEDURE [INLINE] copy_list_value;

        VAR
          current_new_node: ^clt$data_value,
          current_old_node: ^clt$data_value,
          previous_new_node_link: ^^clt$data_value;


        current_old_node := old_value;
        current_new_node := new_value;

        REPEAT
          IF current_old_node^.element_value = NIL THEN
            current_new_node^.element_value := NIL;
          ELSE
            copy_data_value (current_old_node^.element_value, current_new_node^.element_value);
          IFEND;

          current_old_node := current_old_node^.link;
          IF current_old_node <> NIL THEN
            previous_new_node_link := ^current_new_node^.link;
            NEXT current_new_node IN work_area;
            IF current_new_node = NIL THEN
              work_area_overflow;
            IFEND;
            previous_new_node_link^ := current_new_node;
            current_new_node^.kind := clc$list;
            current_new_node^.link := NIL;
            current_new_node^.generated_via_list_rest := FALSE;
          IFEND;
        UNTIL current_old_node = NIL;

      PROCEND copy_list_value;
?? TITLE := 'copy_lock_value', EJECT ??

      PROCEDURE [INLINE] copy_lock_value;


        NEXT new_value^.lock_value IN work_area;
        IF new_value^.lock_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.lock_value^ := old_value^.lock_value^;

      PROCEND copy_lock_value;
?? TITLE := 'copy_network_title_value', EJECT ??

      PROCEDURE [INLINE] copy_network_title_value;


        NEXT new_value^.network_title_value: [STRLENGTH (old_value^.network_title_value^)] IN work_area;
        IF new_value^.network_title_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.network_title_value^ := old_value^.network_title_value^;

      PROCEND copy_network_title_value;
?? TITLE := 'copy_range_value', EJECT ??

      PROCEDURE [INLINE] copy_range_value;


        IF old_value^.low_value <> NIL THEN
          copy_data_value (old_value^.low_value, new_value^.low_value);
        IFEND;

        IF old_value^.high_value = old_value^.low_value THEN
          new_value^.high_value := new_value^.low_value;
        ELSE
          copy_data_value (old_value^.high_value, new_value^.high_value);
        IFEND;

      PROCEND copy_range_value;
?? TITLE := 'copy_record_value', EJECT ??

      PROCEDURE [INLINE] copy_record_value;

        VAR
          i: clt$field_number;


        NEXT new_value^.field_values: [1 .. UPPERBOUND (old_value^.field_values^)] IN work_area;
        IF new_value^.field_values = NIL THEN
          work_area_overflow;
        IFEND;

        FOR i := 1 TO UPPERBOUND (old_value^.field_values^) DO
          new_value^.field_values^ [i].name := old_value^.field_values^ [i].name;
          IF old_value^.field_values^ [i].value = NIL THEN
            new_value^.field_values^ [i].value := NIL;
          ELSE
            copy_data_value (old_value^.field_values^ [i].value, new_value^.field_values^ [i].value);
          IFEND;
        FOREND;

      PROCEND copy_record_value;
?? TITLE := 'copy_status_value', EJECT ??

      PROCEDURE [INLINE] copy_status_value;


        NEXT new_value^.status_value IN work_area;
        IF new_value^.status_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.status_value^ := old_value^.status_value^;

      PROCEND copy_status_value;
?? TITLE := 'copy_string_value', EJECT ??

      PROCEDURE [INLINE] copy_string_value;


        NEXT new_value^.string_value: [STRLENGTH (old_value^.string_value^)] IN work_area;
        IF new_value^.string_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.string_value^ := old_value^.string_value^;

      PROCEND copy_string_value;
?? TITLE := 'copy_string_pattern_value', EJECT ??

      PROCEDURE [INLINE] copy_string_pattern_value;


        NEXT new_value^.string_pattern_value: [[REP #SIZE (old_value^.string_pattern_value^) OF cell]] IN
              work_area;
        IF new_value^.string_pattern_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.string_pattern_value^ := old_value^.string_pattern_value^;

      PROCEND copy_string_pattern_value;
?? TITLE := 'copy_time_increment_value', EJECT ??

      PROCEDURE [INLINE] copy_time_increment_value;


        NEXT new_value^.time_increment_value IN work_area;
        IF new_value^.time_increment_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.time_increment_value^ := old_value^.time_increment_value^;

      PROCEND copy_time_increment_value;
?? TITLE := 'copy_type_spec_value', EJECT ??

      PROCEDURE [INLINE] copy_type_spec_value;


        NEXT new_value^.type_specification_value: [[REP #SIZE (old_value^.type_specification_value^) OF
              cell]] IN work_area;
        IF new_value^.type_specification_value = NIL THEN
          work_area_overflow;
        IFEND;

        new_value^.type_specification_value^ := old_value^.type_specification_value^;

      PROCEND copy_type_spec_value;
?? OLDTITLE, EJECT ??

      NEXT new_value IN work_area;
      IF new_value = NIL THEN
        work_area_overflow;
      IFEND;
      new_value^ := old_value^;

      CASE old_value^.kind OF
      = clc$boolean, clc$cobol_name, clc$data_name, clc$date_time, clc$integer, clc$keyword, clc$name,
            clc$program_name, clc$real, clc$scu_line_identifier, clc$statistic_code, clc$status_code,
            clc$time_zone, clc$unspecified =

      = clc$application =
        copy_application_value;
      = clc$array =
        copy_array_value;
      = clc$command_reference =
        copy_command_reference_value;
      = clc$deferred =
        copy_deferred_value;
      = clc$entry_point_reference =
        copy_entry_point_ref_value;
*IF NOT $true(osv$unix)
      = clc$file =
*ELSE
      = {clc$file} clc$nos_ve_file, clc$unix_file =
*IFEND
        copy_file_value;
      = clc$list =
        copy_list_value;
      = clc$lock =
        copy_lock_value;
      = clc$network_title =
        copy_network_title_value;
      = clc$range =
        copy_range_value;
      = clc$record =
        copy_record_value;
      = clc$status =
        copy_status_value;
      = clc$string =
        copy_string_value;
      = clc$string_pattern =
        copy_string_pattern_value;
      = clc$time_increment =
        copy_time_increment_value;
      = clc$type_specification =
        copy_type_spec_value;
      ELSE
        bad_data_value;
      CASEND;

    PROCEND copy_data_value;
?? TITLE := 'work_area_overflow', EJECT ??

    PROCEDURE [INLINE] work_area_overflow;


      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      EXIT clp$copy_data_value;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    original_work_area := work_area;
    #SPOIL (original_work_area);
*IF $true(osv$unix)
    handler_established := #establish_condition_handler (-1, ^abort_handler);
*ELSE
    osp$establish_condition_handler (^abort_handler, TRUE);
*IFEND

    IF old_value = NIL THEN
      bad_data_value;
    IFEND;

    copy_data_value (old_value, new_value);

*IF $true(osv$unix)
    IF handler_established THEN
      handler_established := NOT #disestablish_condition_handler (-1);
    IFEND;
*ELSE
    osp$disestablish_cond_handler;
*IFEND

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

  PROCEDURE [XDCL] clp$create_default_init_value
    (    type_description: ^clt$type_description;
     VAR work_area {input, output} : ^clt$work_area;
     VAR internal_value: ^clt$internal_data_value;
     VAR status: ost$status);

    VAR
      element_type_description: ^clt$type_description,
      header: ^clt$internal_data_value_header,
      i_value: ^clt$i_data_value,
      initial_position: integer,
      original_work_area: ^clt$work_area,
      space_size: integer;

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           ignore_condition_information: ^pmt$condition_information;
           ignore_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      CASE condition.selector OF

      = pmc$block_exit_processing =
        work_area := original_work_area;
        #SPOIL (work_area);
        RETURN;

      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_write_beyond_msl, mmc$sac_no_append_permission =
*IF NOT $true(osv$unix)
          IF #SEGMENT (condition.segment_access_condition.segment) = #SEGMENT (work_area) THEN
            work_area_overflow;
          IFEND;
*IFEND
        ELSE
          ;
        CASEND;

      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? TITLE := 'create_array_value', EJECT ??

    PROCEDURE [INLINE] create_array_value;

      VAR
        array_space: integer,
        elements: ^array [ * ] of REL (clt$internal_data_value) ^clt$i_data_value,
        elements_space: integer,
        i: clt$array_bound,
        increment_size: integer,
        number_of_elements: integer,
        unused_space: integer;


      IF (NOT type_description^.array_bounds_defined) OR (type_description^.array_element_type_description =
            NIL) THEN
        no_initial_value;
      IFEND;

      number_of_elements := type_description^.bounds.upper - type_description^.bounds.lower + 1;
      IF number_of_elements > (osc$max_segment_length DIV #SIZE (clt$data_value)) THEN
        work_area_overflow;
      IFEND;

      NEXT elements: [type_description^.bounds.lower .. type_description^.bounds.upper] IN work_area;
      IF elements = NIL THEN
        work_area_overflow;
      IFEND;

      array_space := i#current_sequence_position (work_area) - initial_position;
      IF array_space > clv$max_variable_allocation THEN
        work_area_overflow;
      IFEND;

      element_type_description := type_description^.array_element_type_description;
      i_value^.kind := clc$array;
      i_value^.array_value := #REL (elements, internal_value^);

      FOR i := LOWERBOUND (elements^) TO UPPERBOUND (elements^) DO
        NEXT i_value IN work_area;
        IF elements = NIL THEN
          work_area_overflow;
        IFEND;
        elements^ [i] := #REL (i_value, internal_value^);

        CASE type_description^.array_element_type_description^.kind OF
        = clc$boolean_type =
          create_boolean_value;
        = clc$integer_type =
          create_integer_value;
        = clc$real_type =
          create_real_value;
        = clc$status_type =
          create_status_value;
        = clc$string_type =

          IF i = LOWERBOUND (elements^) THEN
            determine_string_size;
            unused_space := header^.unused_space * number_of_elements;
            IF unused_space <= max_unused_space THEN
              header^.unused_space := unused_space;
            ELSE
              header^.unused_space := max_unused_space;
            IFEND;
            increment_size := header^.minimum_allocation_increment * number_of_elements;
            IF increment_size <= max_increment_size THEN
              header^.minimum_allocation_increment := increment_size;
            ELSE
              header^.minimum_allocation_increment := max_increment_size;
            IFEND;
          IFEND;

          create_string_value;
        ELSE
          no_initial_value;
        CASEND;
        IF i = 1 THEN
          elements_space := (i#current_sequence_position (work_area) - initial_position - array_space) *
                number_of_elements;
          IF (array_space + elements_space) > clv$max_variable_allocation THEN
            work_area_overflow;
          IFEND;
        IFEND;
      FOREND;

    PROCEND create_array_value;
?? TITLE := 'create_boolean_value', EJECT ??

    PROCEDURE [INLINE] create_boolean_value;


      i_value^.kind := clc$boolean;
      i_value^.boolean_value.value := FALSE;
      i_value^.boolean_value.kind := clc$true_false_boolean;

    PROCEND create_boolean_value;
?? TITLE := 'create_integer_value', EJECT ??

    PROCEDURE [INLINE] create_integer_value;


      IF (0 < element_type_description^.min_integer_value) OR
            (0 > element_type_description^.max_integer_value) THEN
        no_initial_value;
      IFEND;

      i_value^.kind := clc$integer;
      i_value^.integer_value.value := 0;
      i_value^.integer_value.radix := 10;
      i_value^.integer_value.radix_specified := FALSE;

    PROCEND create_integer_value;
?? TITLE := 'create_list_value', EJECT ??

    PROCEDURE [INLINE] create_list_value;

      VAR
        empty_list_value: ^clt$data_value;


      IF type_description^.min_list_size <> 0 THEN
        no_initial_value;
      IFEND;

      RESET work_area TO internal_value;
      internal_value := NIL;
      PUSH empty_list_value;

      empty_list_value^.kind := clc$list;
      empty_list_value^.element_value := NIL;;
      empty_list_value^.link := NIL;
      empty_list_value^.generated_via_list_rest := FALSE;

      clp$convert_ext_value_to_int (type_description, empty_list_value, NIL, work_area, internal_value,
            status);
      IF NOT status.normal THEN
        EXIT clp$create_default_init_value;
      IFEND;

    PROCEND create_list_value;
?? TITLE := 'create_real_value', EJECT ??

    PROCEDURE [INLINE] create_real_value;


      IF clp$longreal_compare_lt (clv$real_zero^, element_type_description^.min_real_value.long_real) OR
            clp$longreal_compare_gt (clv$real_zero^, element_type_description^.max_real_value.long_real) THEN
        no_initial_value;
      IFEND;

      i_value^.kind := clc$real;
      i_value^.real_value.value := clv$real_zero^;
      i_value^.real_value.number_of_digits := 1;

    PROCEND create_real_value;
?? TITLE := 'create_status_value', EJECT ??

    PROCEDURE [INLINE] create_status_value;

      VAR
        status_value: ^ost$status;


      NEXT status_value IN work_area;
      IF status_value = NIL THEN
        work_area_overflow;
      IFEND;

      i_value^.kind := clc$status;
      i_value^.status_value := #REL (status_value, internal_value^);
      status_value^.normal := TRUE;

    PROCEND create_status_value;
?? TITLE := 'create_string_value', EJECT ??

    PROCEDURE [INLINE] create_string_value;

      VAR
        string_value: ^clt$string_value;

      i_value^.kind := clc$string;

      IF element_type_description^.min_string_size > 0 THEN
        NEXT string_value: [element_type_description^.min_string_size] IN work_area;
        string_value^ (1, element_type_description^.min_string_size) := '';
      ELSE
        NEXT string_value: [0] IN work_area;
      IFEND;

      i_value^.string_value := #REL (string_value, internal_value^);

    PROCEND create_string_value;
?? TITLE := 'determine_string_size', EJECT ??

    PROCEDURE [INLINE] determine_string_size;


      IF element_type_description^.min_string_size > 0 THEN
        header^.unused_space := element_type_description^.max_string_size;
      ELSEIF element_type_description^.max_string_size < nominal_string_size THEN
        header^.unused_space := element_type_description^.max_string_size;
      ELSE
        header^.unused_space := nominal_string_size;
      IFEND;

      IF header^.unused_space <= string_size_increment THEN
        header^.minimum_allocation_increment := header^.unused_space;
      ELSE
        header^.minimum_allocation_increment := string_size_increment;
      IFEND;

    PROCEND determine_string_size;
?? TITLE := 'no_initial_value', EJECT ??

    PROCEDURE [INLINE] no_initial_value;


      internal_value := NIL;
      EXIT clp$create_default_init_value;

    PROCEND no_initial_value;
?? TITLE := 'work_area_overflow', EJECT ??

    PROCEDURE work_area_overflow;


      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      EXIT clp$create_default_init_value;

    PROCEND work_area_overflow;
?? OLDTITLE, EJECT ??

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

    original_work_area := work_area;
    #SPOIL (original_work_area);
    osp$establish_condition_handler (^abort_handler, TRUE);

    initial_position := i#current_sequence_position (work_area);
    space_size := #SIZE (work_area^) - initial_position - #SIZE (clt$internal_data_value_header);
    IF space_size <= 0 THEN
      work_area_overflow;
    IFEND;

    NEXT internal_value: [[REP space_size OF cell]] IN work_area;
    RESET work_area TO internal_value;
    NEXT header IN work_area;
    NEXT i_value IN work_area;
    IF i_value = NIL THEN
      work_area_overflow;
    IFEND;
    header^.value := #REL (i_value, internal_value^);
    header^.unused_space := 0;
    header^.minimum_allocation_increment := 0;

    element_type_description := type_description;

    CASE type_description^.kind OF
    = clc$array_type =
      create_array_value;
    = clc$boolean_type =
      create_boolean_value;
    = clc$integer_type =
      create_integer_value;
    = clc$list_type =
      create_list_value;
    = clc$real_type =
      create_real_value;
    = clc$status_type =
      create_status_value;
    = clc$string_type =
      create_string_value;
    ELSE
      no_initial_value;
    CASEND;

    space_size := i#current_sequence_position (work_area) -
          initial_position - #SIZE (clt$internal_data_value_header) + header^.unused_space;
    RESET work_area TO header;
    NEXT internal_value: [[REP space_size OF cell]] IN work_area;
    IF internal_value = NIL THEN
      work_area_overflow;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$create_default_init_value;
*IFEND

MODEND clm$data_value_conversion;

