?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Data Value Comparison Functions' ??
MODULE clm$data_value_compare;

{
{ PURPOSE:
{   This module contains a number of functions that compare various types
{   of SCL data values.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$comparison_result
*copyc clt$data_value
*copyc cyc$max_string_size
?? POP ??
*copyc clp$boolean_compare
*IF NOT $true(osv$unix)
*copyc clp$get_path_name
*IFEND
*copyc clp$integer_compare
*IF NOT $true(osv$unix)
*copyc clp$longreal_compare
*IFEND
*copyc clp$string_compare
*copyc osv$lower_to_upper

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

  FUNCTION [XDCL, UNSAFE] clp$array_value_compare
    (    left_value: ^clt$data_value;
         right_value: ^clt$data_value): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result,
      i: clt$array_bound;


    IF (left_value^.array_value = NIL) OR (right_value^.array_value = NIL) OR
          (LOWERBOUND (left_value^.array_value^) <> LOWERBOUND (right_value^.array_value^)) OR
          (UPPERBOUND (left_value^.array_value^) <> UPPERBOUND (right_value^.array_value^)) THEN
      comparison_result := clc$unordered;
    ELSE
      comparison_result := clc$equal;

    /check_array_elements/
      FOR i := LOWERBOUND (left_value^.array_value^) TO UPPERBOUND (left_value^.array_value^) DO
        IF clp$data_value_compare (left_value^.array_value^ [i], right_value^.array_value^ [i]) <>
              clc$equal THEN
          comparison_result := clc$unordered;
          EXIT /check_array_elements/;
        IFEND;
      FOREND /check_array_elements/;
    IFEND;

    clp$array_value_compare := comparison_result;

  FUNCEND clp$array_value_compare;
?? TITLE := 'clp$command_reference_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$command_reference_compare
    (    left_command_reference: clt$command_reference;
         right_command_reference: clt$command_reference): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    IF (left_command_reference.name = right_command_reference.name) THEN

      CASE left_command_reference.form OF
      = clc$name_only_command_ref, clc$skip_1st_entry_command_ref, clc$system_command_ref =
        comparison_result := clc$equal;
      = clc$utility_command_ref =
        IF left_command_reference.utility = right_command_reference.utility THEN
          comparison_result := clc$equal;
        ELSE
          comparison_result := clc$unordered;
        IFEND;
      = clc$module_or_file_command_ref =
        comparison_result := clp$file_compare (^left_command_reference.library_or_catalog,
              ^right_command_reference.library_or_catalog);
        IF comparison_result <> clc$equal THEN
          comparison_result := clc$unordered;
        IFEND;
      = clc$file_cycle_command_ref =
        IF (clp$file_compare (^left_command_reference.catalog, ^right_command_reference.catalog) =
              clc$equal) AND (left_command_reference.cycle_number = right_command_reference.cycle_number) THEN
          comparison_result := clc$equal;
        ELSE
          comparison_result := clc$unordered;
        IFEND;
      ELSE
        comparison_result := clc$unordered;
      CASEND;

      clp$command_reference_compare := comparison_result;
    ELSE
      clp$command_reference_compare := clc$unordered;
    IFEND;

  FUNCEND clp$command_reference_compare;
?? TITLE := 'clp$data_value_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$data_value_compare
    (    left_value: ^clt$data_value;
         right_value: ^clt$data_value): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    IF left_value = NIL THEN
      IF right_value = NIL THEN
        comparison_result := clc$equal;
      ELSE
        comparison_result := clc$unordered;
      IFEND;
    ELSEIF (right_value = NIL) OR (left_value^.kind <> right_value^.kind) THEN
      comparison_result := clc$unordered;
    ELSE
      CASE left_value^.kind OF
      = clc$application =
        comparison_result := clc$unordered;
      = clc$array =
        comparison_result := clp$array_value_compare (left_value, right_value);
      = clc$boolean =
        comparison_result := clp$boolean_compare (left_value^.boolean_value.value,
              right_value^.boolean_value.value);
      = clc$cobol_name =
        comparison_result := clp$string_compare (^left_value^.cobol_name_value,
              ^right_value^.cobol_name_value);
      = clc$command_reference =
        IF (left_value^.command_reference_value = NIL) OR (right_value^.command_reference_value = NIL) THEN
          comparison_result := clc$unordered;
        ELSE
          comparison_result := clp$command_reference_compare
                (left_value^.command_reference_value^, right_value^.command_reference_value^);
        IFEND;
      = clc$data_name =
        comparison_result := clp$string_compare (^left_value^.data_name_value, ^right_value^.data_name_value);
      = clc$date_time =
        comparison_result := clp$date_time_compare (left_value^.date_time_value,
              right_value^.date_time_value);
      = clc$entry_point_reference =
        IF (left_value^.entry_point_reference_value = NIL) OR
              (right_value^.entry_point_reference_value = NIL) THEN
          comparison_result := clc$unordered;
        ELSE
          comparison_result := clp$entry_point_ref_compare (left_value^.entry_point_reference_value^,
                right_value^.entry_point_reference_value^);
        IFEND;
*IF NOT $true(osv$unix)
      = clc$file =
*ELSE
      = clc$nos_ve_file =
*IFEND
        comparison_result := clp$file_compare (left_value^.file_value, right_value^.file_value);
*IF $true(osv$unix)
      = clc$unix_file =
        comparison_result := clp$string_compare (left_value^.file_value, right_value^.file_value);
*IFEND
      = clc$integer =
        comparison_result := clp$integer_compare (left_value^.integer_value.value,
              right_value^.integer_value.value);
      = clc$keyword =
        comparison_result := clp$string_compare (^left_value^.keyword_value, ^right_value^.keyword_value);
      = clc$list =
        comparison_result := clp$list_value_compare (left_value, right_value);
      = clc$lock =
        comparison_result := clc$unordered;
      = clc$name =
        comparison_result := clp$string_compare (^left_value^.name_value, ^right_value^.name_value);
      = clc$network_title =
        comparison_result := clp$string_compare (left_value^.network_title_value,
              right_value^.network_title_value);
      = clc$program_name =
        comparison_result := clp$string_compare (^left_value^.program_name_value,
              ^right_value^.program_name_value);
      = clc$range =
        comparison_result := clp$range_value_compare (left_value, right_value);
*IF NOT $true(osv$unix)
      = clc$real =
        comparison_result := clp$longreal_compare (left_value^.real_value.value,
              right_value^.real_value.value, clc$infinities_equal);
*IFEND
      = clc$record =
        comparison_result := clp$record_value_compare (left_value, right_value);
      = clc$scu_line_identifier =
        IF left_value^.scu_line_identifier_value = right_value^.scu_line_identifier_value THEN
          comparison_result := clc$equal;
        ELSE
          comparison_result := clc$unordered;
        IFEND;
      = clc$statistic_code =
        comparison_result := clp$integer_compare (left_value^.statistic_code_value,
              right_value^.statistic_code_value);
      = clc$status =
        IF (left_value^.status_value = NIL) OR (right_value^.status_value = NIL) THEN
          comparison_result := clc$unordered;
        ELSE
          comparison_result := clp$status_compare (left_value^.status_value^, right_value^.status_value^);
        IFEND;
      = clc$status_code =
        comparison_result := clp$integer_compare (left_value^.status_code_value,
              right_value^.status_code_value);
      = clc$string =
        comparison_result := clp$string_compare (left_value^.string_value, right_value^.string_value);
      = clc$string_pattern =
        comparison_result := clp$sequence_compare (left_value^.string_pattern_value,
              right_value^.string_pattern_value);
      = clc$time_increment =
        IF (left_value^.time_increment_value = NIL) OR (right_value^.time_increment_value = NIL) THEN
          comparison_result := clc$unordered;
        ELSE
          comparison_result := clp$time_increment_compare (left_value^.time_increment_value^,
                right_value^.time_increment_value^);
        IFEND;
      = clc$time_zone =
        IF left_value^.time_zone_value = right_value^.time_zone_value THEN
          comparison_result := clc$equal;
        ELSE
          comparison_result := clc$unordered;
        IFEND;
      = clc$type_specification =
        comparison_result := clp$sequence_compare (left_value^.type_specification_value,
              right_value^.type_specification_value);
      ELSE {clc$unspecified}
        comparison_result := clc$equal;
      CASEND;
    IFEND;

    clp$data_value_compare := comparison_result;

  FUNCEND clp$data_value_compare;
?? TITLE := 'clp$date_time_compare', EJECT ??

  FUNCTION [XDCL] clp$date_time_compare
    (    left_date_time: clt$date_time;
         right_date_time: clt$date_time): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    comparison_result := clc$equal;

    IF left_date_time.date_specified AND right_date_time.date_specified THEN
      IF left_date_time.value.year < right_date_time.value.year THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.year > right_date_time.value.year THEN
        comparison_result := clc$left_is_greater;
      ELSEIF left_date_time.value.month < right_date_time.value.month THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.month > right_date_time.value.month THEN
        comparison_result := clc$left_is_greater;
      ELSEIF left_date_time.value.day < right_date_time.value.day THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.day > right_date_time.value.day THEN
        comparison_result := clc$left_is_greater;
      IFEND;
    IFEND;

    IF (comparison_result = clc$equal) AND left_date_time.time_specified AND
          right_date_time.time_specified THEN
      IF left_date_time.value.hour < right_date_time.value.hour THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.hour > right_date_time.value.hour THEN
        comparison_result := clc$left_is_greater;
      ELSEIF left_date_time.value.minute < right_date_time.value.minute THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.minute > right_date_time.value.minute THEN
        comparison_result := clc$left_is_greater;
      ELSEIF left_date_time.value.second < right_date_time.value.second THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.second > right_date_time.value.second THEN
        comparison_result := clc$left_is_greater;
      ELSEIF left_date_time.value.millisecond < right_date_time.value.millisecond THEN
        comparison_result := clc$right_is_greater;
      ELSEIF left_date_time.value.millisecond > right_date_time.value.millisecond THEN
        comparison_result := clc$left_is_greater;
      IFEND;
    IFEND;

    clp$date_time_compare := comparison_result;

  FUNCEND clp$date_time_compare;
?? TITLE := 'clp$entry_point_ref_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$entry_point_ref_compare
    (    left_entry_point_reference: pmt$entry_point_reference;
         right_entry_point_reference: pmt$entry_point_reference): clt$comparison_result;


    IF (left_entry_point_reference.entry_point = right_entry_point_reference.entry_point) AND
          (clp$file_compare (^left_entry_point_reference.object_library,
          ^right_entry_point_reference.object_library) = clc$equal) THEN
      clp$entry_point_ref_compare := clc$equal;
    ELSE
      clp$entry_point_ref_compare := clc$unordered;
    IFEND;

  FUNCEND clp$entry_point_ref_compare;
?? TITLE := 'clp$file_compare', EJECT ??

  FUNCTION [UNSAFE] clp$file_compare
    (    left_file: ^fst$file_reference;
         right_file: ^fst$file_reference): clt$comparison_result;

    CONST
      first_character_of_full_path = ':';

    VAR
      comparison_result: clt$comparison_result,
      left_path: fst$path,
      right_path: fst$path;


    IF (left_file = NIL) OR (right_file = NIL) OR (STRLENGTH (left_file^) = 0) OR
          (STRLENGTH (right_file^) = 0) THEN
      comparison_result := clc$unordered;
    ELSE

*IF NOT $true(osv$unix)
      IF left_file^ (1) = first_character_of_full_path THEN
*IFEND
        #TRANSLATE (osv$lower_to_upper, left_file^, left_path);
*IF NOT $true(osv$unix)
      ELSE
        clp$get_path_name (left_file^, osc$full_message_level, left_path);
      IFEND;
*IFEND

*IF NOT $true(osv$unix)
      IF right_file^ (1) = first_character_of_full_path THEN
*IFEND
        #TRANSLATE (osv$lower_to_upper, right_file^, right_path);
*IF NOT $true(osv$unix)
      ELSE
        clp$get_path_name (right_file^, osc$full_message_level, right_path);
      IFEND;
*IFEND

      IF left_path = right_path THEN
        comparison_result := clc$equal;
      ELSEIF left_path > right_path THEN
        comparison_result := clc$left_is_greater;
      ELSE
        comparison_result := clc$right_is_greater;
      IFEND;
    IFEND;

    clp$file_compare := comparison_result;

  FUNCEND clp$file_compare;
?? TITLE := 'clp$list_value_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$list_value_compare
    (    left_value: ^clt$data_value;
         right_value: ^clt$data_value): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result,
      left_node: ^clt$data_value,
      right_node: ^clt$data_value;


    IF (left_value^.element_value = NIL) AND (left_value^.link = NIL) AND
          (right_value^.element_value = NIL) AND (right_value^.link = NIL) THEN
      comparison_result := clc$equal;
    ELSE
      left_node := left_value;
      right_node := right_value;

    /check_list_elements/
      WHILE TRUE DO
        IF clp$data_value_compare (left_node^.element_value, right_node^.element_value) <> clc$equal THEN
          comparison_result := clc$unordered;
          EXIT /check_list_elements/;
        ELSEIF left_node^.link = NIL THEN
          IF right_node^.link = NIL THEN
            comparison_result := clc$equal;
          ELSE
            comparison_result := clc$unordered;
          IFEND;
          EXIT /check_list_elements/;
        ELSEIF right_node^.link = NIL THEN
          comparison_result := clc$unordered;
          EXIT /check_list_elements/;
        IFEND;
        left_node := left_node^.link;
        right_node := right_node^.link;
      WHILEND /check_list_elements/;
    IFEND;

    clp$list_value_compare := comparison_result;

  FUNCEND clp$list_value_compare;
?? TITLE := 'clp$range_value_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$range_value_compare
    (    left_value: ^clt$data_value;
         right_value: ^clt$data_value): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    IF clp$data_value_compare (left_value^.low_value, right_value^.low_value) <> clc$equal THEN
      comparison_result := clc$unordered;
    ELSEIF left_value^.high_value = left_value^.low_value THEN
      IF right_value^.high_value = right_value^.low_value THEN
        comparison_result := clc$equal;
      ELSE
        comparison_result := clc$unordered;
      IFEND;
    ELSEIF right_value^.high_value = right_value^.low_value THEN
      comparison_result := clc$unordered;
    ELSE
      comparison_result := clp$data_value_compare (left_value^.high_value, right_value^.high_value);
      IF comparison_result <> clc$equal THEN
        comparison_result := clc$unordered;
      IFEND;
    IFEND;

    clp$range_value_compare := comparison_result;

  FUNCEND clp$range_value_compare;
?? TITLE := 'clp$record_value_compare', EJECT ??

  FUNCTION [XDCL, UNSAFE] clp$record_value_compare
    (    left_value: ^clt$data_value;
         right_value: ^clt$data_value): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result,
      i: clt$field_number;


    IF (left_value^.field_values = NIL) OR (right_value^.field_values = NIL) OR
          (UPPERBOUND (left_value^.field_values^) <> UPPERBOUND (right_value^.field_values^)) THEN
      comparison_result := clc$unordered;
    ELSE
      comparison_result := clc$equal;

    /check_fields/
      FOR i := LOWERBOUND (left_value^.field_values^) TO UPPERBOUND (left_value^.field_values^) DO
        IF (left_value^.field_values^ [i].name <> right_value^.field_values^ [i].name) OR
              (clp$data_value_compare (left_value^.field_values^ [i].value,
              right_value^.field_values^ [i].value) <> clc$equal) THEN
          comparison_result := clc$unordered;
          EXIT /check_fields/;
        IFEND;
      FOREND /check_fields/;
    IFEND;

    clp$record_value_compare := comparison_result;

  FUNCEND clp$record_value_compare;
?? TITLE := 'clp$sequence_compare', EJECT ??

  FUNCTION clp$sequence_compare
    (    left_sequence: ^SEQ ( * );
         right_sequence: ^SEQ ( * )): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result,
      left_seq: ^SEQ ( * ),
      left_string: ^string ( * ),
      right_seq: ^SEQ ( * ),
      right_string: ^string ( * ),
      size: integer;


    IF (left_sequence = NIL) OR (right_sequence = NIL) OR (#SIZE (left_sequence^) <> #SIZE (right_sequence^))
          THEN
      comparison_result := clc$unordered;
    ELSE

    /compare_sequence_contents/
      BEGIN
        size := #SIZE (left_sequence^);
        left_seq := left_sequence;
        RESET left_seq;
        right_seq := right_sequence;
        RESET right_seq;
        WHILE size > cyc$max_string_size DO
          NEXT left_string: [cyc$max_string_size] IN left_seq;
          NEXT right_string: [cyc$max_string_size] IN right_seq;
          IF left_string^ > right_string^ THEN
            comparison_result := clc$left_is_greater;
            EXIT /compare_sequence_contents/;
          ELSEIF left_string^ < right_string^ THEN
            comparison_result := clc$right_is_greater;
            EXIT /compare_sequence_contents/;
          IFEND;
          size := size - cyc$max_string_size;
        WHILEND;
        IF size > 0 THEN
          NEXT left_string: [size] IN left_seq;
          NEXT right_string: [size] IN right_seq;
          IF left_string^ > right_string^ THEN
            comparison_result := clc$left_is_greater;
            EXIT /compare_sequence_contents/;
          ELSEIF left_string^ < right_string^ THEN
            comparison_result := clc$right_is_greater;
            EXIT /compare_sequence_contents/;
          IFEND;
        IFEND;
        comparison_result := clc$equal;
      END /compare_sequence_contents/;
    IFEND;

    clp$sequence_compare := comparison_result;

  FUNCEND clp$sequence_compare;
?? TITLE := 'clp$status_compare', EJECT ??

  FUNCTION [XDCL] clp$status_compare
    (    left_status: ost$status;
         right_status: ost$status): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    IF left_status.normal <> right_status.normal THEN
      comparison_result := clc$unordered;
    ELSE
      CASE left_status.normal OF
      = TRUE =
        comparison_result := clc$equal;
      = FALSE =
        IF (left_status.condition = right_status.condition) AND
              (left_status.text.value (1, left_status.text.size) =
              right_status.text.value (1, right_status.text.size)) THEN
          comparison_result := clc$equal;
        ELSE
          comparison_result := clc$unordered;
        IFEND;
      CASEND;
    IFEND;

    clp$status_compare := comparison_result;

  FUNCEND clp$status_compare;
?? TITLE := 'clp$time_increment_compare', EJECT ??

  FUNCTION [XDCL] clp$time_increment_compare
    (    left_time_increment: pmt$time_increment;
         right_time_increment: pmt$time_increment): clt$comparison_result;

    VAR
      comparison_result: clt$comparison_result;


    IF left_time_increment.year < right_time_increment.year THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.year > right_time_increment.year THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.month < right_time_increment.month THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.month > right_time_increment.month THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.day < right_time_increment.day THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.day > right_time_increment.day THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.hour < right_time_increment.hour THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.hour > right_time_increment.hour THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.minute < right_time_increment.minute THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.minute > right_time_increment.minute THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.second < right_time_increment.second THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.second > right_time_increment.second THEN
      comparison_result := clc$left_is_greater;
    ELSEIF left_time_increment.millisecond < right_time_increment.millisecond THEN
      comparison_result := clc$right_is_greater;
    ELSEIF left_time_increment.millisecond > right_time_increment.millisecond THEN
      comparison_result := clc$left_is_greater;
    ELSE
      comparison_result := clc$equal;
    IFEND;

    clp$time_increment_compare := comparison_result;

  FUNCEND clp$time_increment_compare;

MODEND clm$data_value_compare;
