?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter: Compare Command Processor' ??
MODULE clm$compare_command;

{
{  PURPOSE:
{    This module contains the processor for the compare command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$improper_random_access
*copyc amt$page_format
*copyc amt$page_length
*copyc amt$page_width
*copyc cle$ecc_compare_command
*copyc cle$ecc_lexical
*copyc cle$ecc_miscellaneous
*copyc clt$file_reference
*copyc clt$path_display_chunks
*copyc clt$path_name
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$get_path_name
*copyc clp$get_set_count
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$trimmed_string_size
*copyc clv$nil_display_control
*copyc fsp$close_file
*copyc osp$append_status_file
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal

*copyc cli$compare_display_file_input

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

  PROCEDURE [XDCL] clp$_compare_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$comf) compare_file, compare_files, comf (
{   file, f: file = $required
{   with, w: file = $required
{   error_limit, el: integer 0..amc$file_byte_limit = 0
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 9] of clt$pdt_parameter_name,
      parameters: array [1 .. 5] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 25, 14, 10, 56, 414],
    clc$command, 9, 5, 2, 0, 0, 0, 5, 'OSM$COMF'], [
    ['EL                             ',clc$abbreviation_entry, 3],
    ['ERROR_LIMIT                    ',clc$nominal_entry, 3],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 4],
    ['OUTPUT                         ',clc$nominal_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 5],
    ['W                              ',clc$abbreviation_entry, 2],
    ['WITH                           ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 4
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 5
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, amc$file_byte_limit, 10],
    '0'],
{ PARAMETER 4
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$file = 1,
      p$with = 2,
      p$error_limit = 3,
      p$output = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;

*copy clv$display_variables
?? NEWTITLE := 'abort_handler', EJECT ??

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


      IF file_control.file_id <> amv$nil_file_identifier THEN
        clp$close_for_get (file_control, handler_status);
      IFEND;
      IF with_control.file_id <> amv$nil_file_identifier THEN
        clp$close_for_get (with_control, handler_status);
      IFEND;
      clp$close_display (display_control, handler_status);

      handler_status.normal := TRUE;

    PROCEND abort_handler;
*copy clp$new_page_procedure
?? TITLE := 'put_subtitle ', EJECT ??

    PROCEDURE put_subtitle
      (VAR display_control: clt$display_control;
       VAR status: ost$status);


      clp$put_path_reference_subtitle (pvt [p$file].value^.file_value^, 'FILE ', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clv$subtitles_built := FALSE;
      clp$put_path_reference_subtitle (pvt [p$with].value^.file_value^, 'WITH ', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clv$subtitles_built := FALSE;
      IF error_count > 0 THEN
        clp$new_display_line (display_control, 1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        put_column_headers (display_control, status);
      IFEND;

    PROCEND put_subtitle;
?? TITLE := 'put_column_headers', EJECT ??

    PROCEDURE put_column_headers
      (VAR display_control: clt$display_control;
       VAR status: ost$status);


      clp$put_partial_display (display_control, ' BYTE ADDRESS', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$horizontal_tab_display (display_control, 15, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_partial_display (display_control, '   FILE  WORD   ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$horizontal_tab_display (display_control, 32, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$put_partial_display (display_control, '   WITH  WORD   ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$horizontal_tab_display (display_control, 49, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_partial_display (display_control, 'LOGICAL DIFFERENCE', clc$no_trim, amc$terminate, status);

    PROCEND put_column_headers;
*copy clp$put_path_reference_subtitle
?? OLDTITLE, EJECT ??

    CONST
      address_size = 13,
      address_start = 1,
      bytes_per_word = 8,
      difference_start = 49,
      file_start = 15,
      hex_digits_per_byte = 2,
      max_output_line_size = 64,
      with_start = 32;

    TYPE
      word_set = set of 0 .. 63;

    TYPE
      comparer = record
        case 1 .. 3 of
        = 1 =
          word: word_set,
        = 2 =
          digits: packed array [0 .. 15] of 0 .. 15,
        = 3 =
          bytes: packed array [1 .. bytes_per_word] of cell,
        casend,
      recend;

    VAR
      hex_digits: [STATIC, READ, oss$job_paged_literal] array [0 .. 15] of char := ['0', '1', '2', '3', '4',
            '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'];

    VAR
      buffer_required: boolean,
      current_byte_address: amt$file_byte_address,
      default_ring_attributes: amt$ring_attributes,
      difference: comparer,
      display_control: clt$display_control,
      error_count: 0 .. amc$file_byte_limit,
      error_limit: 0 .. amc$file_byte_limit,
      file_control: clt$get_control_record,
      file_position: amt$file_position,
      file_transfer_count: amt$transfer_count,
      file_transfer_word: ^comparer,
      i: 0 .. clc$max_value_sets,
      ignore_byte_address: amt$file_byte_address,
      ignore_status: ost$status,
      output_count: 0 .. clc$max_value_sets,
      output_line: string (max_output_line_size),
      with_control: clt$get_control_record,
      with_position: amt$file_position,
      with_transfer_count: amt$transfer_count,
      with_transfer_word: ^comparer,
      word_from_file: comparer,
      word_from_with: comparer;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    error_limit := pvt [p$error_limit].value^.integer_value.value;
    error_count := 0;

    file_control.file_id := amv$nil_file_identifier;
    #SPOIL (file_control);
    with_control.file_id := amv$nil_file_identifier;
    #SPOIL (with_control);
    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^abort_handler);

  /compare_files/
    BEGIN
      clp$open_for_get (pvt [p$file].value^.file_value^, 'COMPARE_FILE', FALSE, file_position, file_control,
            buffer_required, status);
      IF NOT status.normal THEN
        EXIT /compare_files/;
      IFEND;
      IF buffer_required THEN
        PUSH file_control.sequence_pointer: [[REP clc$input_buffer_size OF cell]];
        #SPOIL (file_control);
      IFEND;

      clp$open_for_get (pvt [p$with].value^.file_value^, 'COMPARE_FILE', FALSE, with_position, with_control,
            buffer_required, status);
      IF NOT status.normal THEN
        clp$close_for_get (file_control, ignore_status);
        EXIT /compare_files/;
      IFEND;
      IF buffer_required THEN
        PUSH with_control.sequence_pointer: [[REP clc$input_buffer_size OF cell]];
        #SPOIL (with_control);
      IFEND;

      default_ring_attributes.r1 := #RING (^default_ring_attributes);
      default_ring_attributes.r2 := #RING (^default_ring_attributes);
      default_ring_attributes.r3 := #RING (^default_ring_attributes);

      clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
            default_ring_attributes, display_control, status);
      IF NOT status.normal THEN
        clp$close_for_get (file_control, ignore_status);
        clp$close_for_get (with_control, ignore_status);
        EXIT /compare_files/;
      IFEND;
      clv$titles_built := FALSE;
      clv$subtitles_built := FALSE;
      clv$command_name := 'compare_file';
      current_byte_address := 0;
      file_transfer_count := 0;
      with_transfer_count := 0;

    /compare_loop/
      WHILE TRUE DO
        clp$get_next_bytes (bytes_per_word, file_transfer_count, file_position, file_control,
              file_transfer_word, status);
        IF NOT status.normal THEN
          EXIT /compare_loop/;
        IFEND;
        clp$get_next_bytes (bytes_per_word, with_transfer_count, with_position, with_control,
              with_transfer_word, status);
        IF NOT status.normal THEN
          EXIT /compare_loop/;
        IFEND;
        IF file_transfer_count < with_transfer_count THEN
          output_count := file_transfer_count;
        ELSE
          output_count := with_transfer_count;
        IFEND;

{ Exit loop here if either of the files has no more data for comparison.

        IF output_count = 0 THEN
          EXIT /compare_loop/;
        IFEND;

        IF output_count < bytes_per_word THEN
          word_from_file.word := $word_set [];
          word_from_with.word := $word_set [];
          FOR i := 1 TO output_count DO
            word_from_file.bytes [i] := file_transfer_word^.bytes [i];
            word_from_with.bytes [i] := with_transfer_word^.bytes [i];
          FOREND;
        ELSE
          word_from_file.word := file_transfer_word^.word;
          word_from_with.word := with_transfer_word^.word;
        IFEND;

        difference.word := word_from_file.word XOR word_from_with.word;
        IF difference.word <> $word_set [] THEN

          IF (error_count = 0) AND (display_control.page_format = amc$continuous_form) THEN
            put_column_headers (display_control, status);
            IF NOT status.normal THEN
              EXIT /compare_loop/;
            IFEND;
          IFEND;

          error_count := error_count + 1;

          output_line := '';
          clp$convert_integer_to_rjstring (current_byte_address, 10, FALSE, ' ',
                output_line (address_start, address_size), status);
          IF NOT status.normal THEN
            EXIT /compare_loop/;
          IFEND;

          FOR i := 0 TO (output_count * hex_digits_per_byte) - 1 DO
            output_line (file_start + i) := hex_digits [word_from_file.digits [i]];
            output_line (with_start + i) := hex_digits [word_from_with.digits [i]];
            output_line (difference_start + i) := hex_digits [difference.digits [i]];
          FOREND;
          clp$put_display (display_control, output_line, clc$trim, status);
          IF NOT status.normal THEN
            EXIT /compare_loop/;
          IFEND;

          IF error_count > error_limit THEN
            EXIT /compare_loop/;
          IFEND;
        IFEND;
        IF file_transfer_count <> with_transfer_count THEN
          EXIT /compare_loop/;
        IFEND;
        current_byte_address := current_byte_address + bytes_per_word;
      WHILEND;

      IF error_count > 0 THEN
        clp$put_display (display_control, '', clc$trim, ignore_status);
        IF error_count > error_limit THEN
          output_line := ' -- Specified compare error limit exceeded.';
          clp$put_display (display_control, output_line, clc$trim, ignore_status);
        IFEND;
        output_line := '    xxxxxxxx compare errors.';
        clp$convert_integer_to_rjstring (error_count, 10, FALSE, ' ', output_line (5, 8), ignore_status);
        clp$put_display (display_control, output_line, clc$trim, ignore_status);
        osp$set_status_abnormal ('CL', cle$compare_errors_detected, '', status);
        osp$append_status_integer (osc$status_parameter_delimiter, error_count, 10, FALSE, status);
      ELSEIF (file_position = with_position) AND (file_transfer_count = with_transfer_count) THEN
        output_line := '     No compare errors.';
        clp$put_display (display_control, output_line, clc$trim, ignore_status);
      IFEND;

      IF (file_position > with_position) OR (file_transfer_count < with_transfer_count) THEN
        output_line := ' -- FILE file shorter than WITH file.';
        clp$put_display (display_control, output_line, clc$trim, ignore_status);
        IF error_count = 0 THEN
          osp$set_status_abnormal ('CL', cle$compared_files_unequal_size, '', status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$file].value^.file_value^, status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$with].value^.file_value^, status);
        IFEND;
      ELSEIF (with_position > file_position) OR (with_transfer_count < file_transfer_count) THEN
        output_line := ' -- WITH file shorter than FILE file.';
        clp$put_display (display_control, output_line, clc$trim, ignore_status);
        IF error_count = 0 THEN
          osp$set_status_abnormal ('CL', cle$compared_files_unequal_size, '', status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$with].value^.file_value^, status);
          osp$append_status_file (osc$status_parameter_delimiter, pvt [p$file].value^.file_value^, status);
        IFEND;
      IFEND;

      IF status.normal THEN
        clp$close_for_get (file_control, status);
      ELSE
        clp$close_for_get (file_control, ignore_status);
      IFEND;
      IF status.normal THEN
        clp$close_for_get (with_control, status);
      ELSE
        clp$close_for_get (with_control, ignore_status);
      IFEND;
      IF status.normal THEN
        clp$close_display (display_control, status);
      ELSE
        clp$close_display (display_control, ignore_status);
      IFEND;
    END /compare_files/;

    osp$disestablish_cond_handler

  PROCEND clp$_compare_file;

MODEND clm$compare_command;
