?? NEWTITLE := 'NOS/VE Tools : Compare Legible Files' ??
MODULE ram$compare_legible_files;

{ PURPOSE:
{   Compares two legible files.  If the files are identical then the program
{   returns a normal status.  If the files are not the same, it generates a
{   list of the old file with inserted and deleted lines shown.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$compare_errors_detected
*copyc cyd$run_time_error_condition
*copyc oce$ve_linker_exceptions
?? POP ??
*copyc amp$get_file_attributes
*copyc amp$get_next
*copyc amp$get_partial
*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$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 fsp$close_file
*copyc fsp$open_file
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause
*copyc pmp$generate_unique_name
*copyc clv$display_variables
*copyc clp$new_page_procedure
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module.', EJECT ??

  CONST
    product_id = 'RA';

  CONST
    max_line_length = 255,
    max_lines_per_deck = 100000,
    max_line_number = max_lines_per_deck,
    line_length = 200,
    source_id_length = 6 + 1;

  TYPE
    file_line_count = 0 .. max_line_number,
    two_files_line_count = 0 .. max_line_number * 2,
    text_line = string ( * <= max_line_length),

    line_descriptor = record
      link: two_files_line_count,
      where: file_line_count,
      symbol: two_files_line_count,
      trimmed_spaces: 0 .. max_line_length,
      text_p: ^text_line,
    recend;

  CONST
    in_symbol_table = 0;

  VAR
    lines_in_new_file: [STATIC] file_line_count := 0,
    lines_in_old_file: [STATIC] file_line_count := 0,
    line_text_p: ^SEQ ( * ),
    new_lines_p: ^array [0 .. * ] of line_descriptor,
    old_lines_p: ^array [0 .. * ] of line_descriptor;

  VAR
    wild_char: record
      specified: boolean,
      value: char,
    recend;

?? OLDTITLE ??
?? NEWTITLE := 'put_subtitle', EJECT ??

{ PURPOSE:
{   Dummy routine for the display procedures to call when they wish to
{   display a subtitle.

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

  PROCEND put_subtitle;
?? OLDTITLE ??
?? NEWTITLE := 'find_common_unique_source_lines', EJECT ??

{ PURPOSE:
{   Find lines appearing exactly in the old and new files the same number of
{   times and 10 or less times in a file.

  PROCEDURE find_common_unique_source_lines
    (    affected_lines: two_files_line_count;
     VAR old_lines: array [0 .. * ] of line_descriptor;
     VAR new_lines: array [0 .. * ] of line_descriptor);

    VAR
      matching_line_count: -max_line_number .. max_line_number,
      new_index: file_line_count,
      old_index: file_line_count,
      one_percent: file_line_count,
      saved_new_index: file_line_count,
      saved_old_index: file_line_count,
      symbol: two_files_line_count,
      symbol_text_p: ^text_line;


    IF affected_lines = 0 THEN
      RETURN;
    IFEND;

    one_percent := affected_lines DIV 100;
    IF one_percent < 5 THEN
      one_percent := 5;
    IFEND;
    symbol := 2;

    old_index := old_lines [0].link;
    new_index := new_lines [0].link;
    WHILE (old_index <> 0) AND (new_index <> 0) DO
      symbol := symbol + 1;
      IF old_lines [old_index].text_p^ < new_lines [new_index].text_p^ THEN
        old_lines [old_index].where := in_symbol_table;
        old_lines [old_index].symbol := symbol;
        old_index := old_lines [old_index].link;

      ELSEIF new_lines [new_index].text_p^ < old_lines [old_index].text_p^ THEN
        new_lines [new_index].where := in_symbol_table;
        new_lines [new_index].symbol := symbol;
        new_index := new_lines [new_index].link;

      ELSE { One or more lines from both files match
        saved_old_index := old_index;
        saved_new_index := new_index;
        symbol_text_p := old_lines [old_index].text_p;
        matching_line_count := 0;
        REPEAT
          old_lines [old_index].where := in_symbol_table;
          old_lines [old_index].symbol := symbol;
          old_index := old_lines [old_index].link;
          matching_line_count := matching_line_count + 1;
        UNTIL (old_index = 0) OR (old_lines [old_index].text_p^ <>
              symbol_text_p^);

        IF matching_line_count > one_percent THEN
          matching_line_count := 0;
        IFEND;

        REPEAT
          new_lines [new_index].where := in_symbol_table;
          new_lines [new_index].symbol := symbol;
          new_index := new_lines [new_index].link;
          matching_line_count := matching_line_count - 1;
        UNTIL (new_index = 0) OR (new_lines [new_index].text_p^ <>
              symbol_text_p^);

        IF matching_line_count = 0 THEN
          REPEAT
            old_lines [saved_old_index].where := saved_new_index;
            new_lines [saved_new_index].where := saved_old_index;
            saved_old_index := old_lines [saved_old_index].link;
            saved_new_index := new_lines [saved_new_index].link;
          UNTIL saved_old_index = old_index;
        IFEND;

      IFEND;
    WHILEND;

    symbol := symbol + 1;
    WHILE old_index <> 0 DO
      old_lines [old_index].where := in_symbol_table;
      old_lines [old_index].symbol := symbol;
      old_index := old_lines [old_index].link;
    WHILEND;

    WHILE new_index <> 0 DO
      new_lines [new_index].where := in_symbol_table;
      new_lines [new_index].symbol := symbol;
      new_index := new_lines [new_index].link;
    WHILEND;

  PROCEND find_common_unique_source_lines;
?? OLDTITLE ??
?? NEWTITLE := 'isolate_area_of_difference', EJECT ??

{ PURPOSE:
{   This procedure determines what portion of the file is different (if any).
{   This is done looking for the first mismatch scaning both forward and
{   backwards.  The wild char (if specified) is taken into account when doing
{   the match.  The wild char will match any character in that position.

  PROCEDURE isolate_area_of_difference
    (    lines_in_old_file: file_line_count;
         lines_in_new_file: file_line_count;
     VAR old_lines: array [0 .. * ] of line_descriptor;
     VAR new_lines: array [0 .. * ] of line_descriptor;
     VAR matching_lines_in_front: file_line_count;
     VAR matching_lines_at_end: file_line_count;
     VAR files_are_different: boolean);

?? NEWTITLE := '[INLINE] lines_match', EJECT ??

{ PURPOSE:
{   Check two lines for equality taking into account any wild characters.

    FUNCTION [INLINE] lines_match
      (    old_text_p: ^text_line;
           new_text_p: ^text_line): boolean;

      IF old_text_p^ = new_text_p^ THEN
        lines_match := TRUE;
      ELSEIF wild_char.specified AND match_with_wild_char
            (old_text_p, new_text_p) THEN
        lines_match := TRUE;
      ELSE
        lines_match := FALSE;
      IFEND;

    FUNCEND lines_match;
?? OLDTITLE, EJECT ??

    VAR
      line_index: file_line_count,
      smallest_line_count: file_line_count;

    IF lines_in_new_file < lines_in_old_file THEN
      smallest_line_count := lines_in_new_file;
      files_are_different := TRUE;
    ELSE
      smallest_line_count := lines_in_old_file;
      files_are_different := (lines_in_new_file > lines_in_old_file);
    IFEND;
    matching_lines_in_front := smallest_line_count;
    matching_lines_at_end := smallest_line_count;

  /find_first_mismatch/
    FOR line_index := 1 TO smallest_line_count DO
      IF NOT lines_match (old_lines [line_index].
            text_p, new_lines [line_index].text_p) THEN
        matching_lines_in_front := line_index - 1;
        files_are_different := TRUE;
        EXIT /find_first_mismatch/;
      IFEND;
      old_lines [line_index].where := line_index;
      old_lines [line_index].symbol := 0;
      new_lines [line_index].where := line_index;
      new_lines [line_index].symbol := 0;
    FOREND /find_first_mismatch/;

    IF NOT files_are_different THEN
      RETURN;
    IFEND;

    matching_lines_at_end := smallest_line_count - matching_lines_in_front;
    FOR line_index := 0 TO matching_lines_at_end - 1 DO
      IF NOT lines_match (old_lines [lines_in_old_file - line_index].text_p,
            new_lines [lines_in_new_file - line_index].text_p) THEN
        matching_lines_at_end := line_index;
        RETURN;
      IFEND;
      old_lines [lines_in_old_file - line_index].where :=
            lines_in_new_file - line_index;
      old_lines [lines_in_old_file - line_index].symbol := 0;
      new_lines [lines_in_new_file - line_index].where :=
            lines_in_old_file - line_index;
      new_lines [lines_in_new_file - line_index].symbol := 0;
    FOREND;
  PROCEND isolate_area_of_difference;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] is_same_symbol', EJECT ??

{ PURPOSE:
{   Check if two lines refer to the same symbol taking into account the wild
{   character if any.

  FUNCTION [INLINE] is_same_symbol
    (    old_line: line_descriptor;
         new_line: line_descriptor): boolean;

    IF new_line.symbol = old_line.symbol THEN
      is_same_symbol := TRUE;
    ELSEIF wild_char.specified AND match_with_wild_char
          (old_line.text_p, new_line.text_p) THEN
      is_same_symbol := TRUE;
    ELSE
      is_same_symbol := FALSE;
    IFEND;
  FUNCEND is_same_symbol;
?? NEWTITLE := 'match_with_wild_char', EJECT ??

{ PURPOSE:
{   Check two lines for equality taking into account any wild characters.

  FUNCTION match_with_wild_char
    (    old_text_p: ^text_line;
         new_text_p: ^text_line): boolean;

    VAR
      smallest_line: 1 .. line_length,
      char_index: 1 .. line_length;

    match_with_wild_char := FALSE;

    smallest_line := STRLENGTH (new_text_p^);
    IF smallest_line > STRLENGTH (old_text_p^) THEN
      smallest_line := STRLENGTH (old_text_p^);
    IFEND;

    FOR char_index := 1 TO smallest_line DO
      IF (old_text_p^ (char_index) <> new_text_p^ (char_index)) AND
            (old_text_p^ (char_index) <> wild_char.value) THEN
        RETURN;
      IFEND;
    FOREND;

    IF smallest_line < STRLENGTH (new_text_p^) THEN
      IF new_text_p^ (smallest_line + 1, * ) <> ' ' THEN
        RETURN;
      IFEND;
    IFEND;

    FOR char_index := smallest_line + 1 TO STRLENGTH (old_text_p^) DO
      IF (old_text_p^ (char_index) <> ' ') AND
            (old_text_p^ (char_index) <> wild_char.value) THEN
        RETURN;
      IFEND;
    FOREND;
    match_with_wild_char := TRUE;

  FUNCEND match_with_wild_char;
?? OLDTITLE ??
?? NEWTITLE := 'produce_comparison_file', EJECT ??

{ PURPOSE:
{   This procedure displays the differences between the two files to a list
{   file.  The output consists of lines from the old file surrounding the
{   changed lines with the deleted lines marked by a 'D' in column 1 of the
{   listing and the inserted lines marked by a 'I' in column 1 of the listing.
{
{   The number of lines displayed surrounding the changed lines is controlled
{   by the bracket size parameter.  If there is a gap in the lines displayed
{   from the old file, the message 'Starting at line nn of old file' is put
{   on the list file.

  PROCEDURE produce_comparison_file
    (    comparison_file_name: fst$file_reference;
         bracket_size: file_line_count;
         first_line: file_line_count;
         last_old_line: file_line_count;
         last_new_line: file_line_count;
     VAR status: ost$status);

    TYPE
      file_line_index = 0 .. max_line_number + 1;

    VAR
      bracket_index: file_line_index,
      bracket_lines_remaining: file_line_index,
      browse_index: file_line_index,
      first_delete_line: file_line_index,
      first_insert_line: file_line_index,
      new_file_index: file_line_index,
      new_where: file_line_index,
      old_file_index: file_line_index,
      old_where: file_line_index;

    VAR
      display_control: clt$display_control,
      output_open: boolean;

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

{ PURPOSE:
{   This procedure cleans up by closing the display file in the event that
{   the display procedure is aborted.

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

      VAR
        ignore_status: ost$status;

      handler_status.normal := TRUE;
      IF condition.selector = pmc$block_exit_processing THEN
        clp$close_display (display_control, ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;

    PROCEND abort_handler;
?? OLDTITLE ??
?? NEWTITLE := 'put_line', EJECT ??

{ PURPOSE:
{   Writes the specified line to the listing file with a two character id.
{   This id should be '  ' for an unchanged line from the old file, 'D ' for
{   a deleted line from the old file, or 'I ' for an inserted line from the
{   new file.

    PROCEDURE put_line
      (    line: line_descriptor;
           id: string (2));

      VAR
        hold_line: string (max_line_length),
        hold_line_length: 0 .. max_line_length;

      hold_line := id;
      hold_line (line.trimmed_spaces + 2, * ) := line.text_p^;
      hold_line_length := line.trimmed_spaces + STRLENGTH (line.text_p^) + 2 -
            1;
      clp$put_display (display_control, hold_line (1, hold_line_length),
            clc$no_trim, status);
      IF NOT status.normal THEN
        EXIT produce_comparison_file;
      IFEND;
    PROCEND put_line;
?? OLDTITLE ??
?? NEWTITLE := 'Show_Bracket', EJECT ??

{ PURPOSE:
{   This procedure displays the lines needed for the display bracket.  It
{   displays a message specifying that lines were skipped if necessary and
{   then displays the desired lines in front of the changed portion of the
{   old file.

    PROCEDURE show_bracket;

      VAR
        header_line: string (40),
        i: integer;

      IF (bracket_index + bracket_size + bracket_lines_remaining) <
            first_delete_line THEN

        FOR bracket_index := bracket_index TO bracket_index +
              bracket_lines_remaining - 1 DO
          put_line (old_lines_p^ [bracket_index], '  ');
        FOREND;
        bracket_index := first_delete_line - bracket_size;
        STRINGREP (header_line, i, 'Starting at line', bracket_index,
              ' of old file.');
        clp$put_display (display_control, header_line (1, i), clc$no_trim,
              status);
        IF NOT status.normal THEN
          EXIT produce_comparison_file;
        IFEND;
      IFEND;

      FOR bracket_index := bracket_index TO first_delete_line - 1 DO
        put_line (old_lines_p^ [bracket_index], '  ');
      FOREND;
      bracket_lines_remaining := bracket_size;

    PROCEND show_bracket;
?? OLDTITLE, EJECT ??

    VAR
      ring_attributes: amt$ring_attributes;

    status.normal := TRUE;

    clv$command_name := 'Compare_Legible_Files';
    clv$titles_built := FALSE;

    ring_attributes.r1 := #RING (^ring_attributes);
    ring_attributes.r2 := #RING (^ring_attributes);
    ring_attributes.r3 := #RING (^ring_attributes);
    clp$open_display_reference (comparison_file_name, ^clp$new_page_procedure,
          fsc$list, ring_attributes, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

    old_file_index := first_line;
    new_file_index := first_line;
    bracket_index := 1;
    bracket_lines_remaining := 0;

    WHILE (old_file_index <= last_old_line) AND
          (new_file_index <= last_new_line) DO
      old_file_index := old_file_index + 1;
      new_file_index := new_file_index + 1;
      old_where := old_lines_p^ [old_file_index].where;
      new_where := new_lines_p^ [new_file_index].where;

      IF old_where <> new_file_index THEN
        first_insert_line := new_file_index;
        first_delete_line := old_file_index;

        WHILE old_where < new_file_index DO
          old_file_index := old_file_index + 1;
          old_where := old_lines_p^ [old_file_index].where;
        WHILEND;

        WHILE new_where < old_file_index DO
          new_file_index := new_file_index + 1;
          new_where := new_lines_p^ [new_file_index].where;
        WHILEND;

        IF old_where <> new_file_index THEN
          IF (old_where - new_file_index) < (new_where - old_file_index) THEN
            new_file_index := old_where;
          ELSE
            old_file_index := new_where;
          IFEND;
        IFEND;

        WHILE (first_delete_line < old_file_index) AND
              (first_insert_line < new_file_index) AND
              is_same_symbol (old_lines_p^ [first_delete_line],
              new_lines_p^ [first_insert_line]) DO
          first_delete_line := first_delete_line + 1;
          first_insert_line := first_insert_line + 1;
        WHILEND;

        IF (first_delete_line < old_file_index) OR
              (first_insert_line < new_file_index) THEN
          show_bracket;
          FOR first_delete_line := first_delete_line TO old_file_index - 1 DO
            put_line (old_lines_p^ [first_delete_line], 'D ');
          FOREND;

          FOR first_insert_line := first_insert_line TO new_file_index - 1 DO
            put_line (new_lines_p^ [first_insert_line], 'I ');
          FOREND;
          bracket_index := old_file_index;
        IFEND;
      IFEND;

    WHILEND;

    WHILE (bracket_lines_remaining > 0) AND
          (old_file_index < lines_in_old_file) DO
      put_line (old_lines_p^ [old_file_index], '  ');
      bracket_lines_remaining := bracket_lines_remaining - 1;
      old_file_index := old_file_index + 1;
    WHILEND;

    osp$disestablish_cond_handler;

    clp$close_display (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND produce_comparison_file;
?? OLDTITLE ??
?? NEWTITLE := 'propogate_commonality', EJECT ??

{ PURPOSE:
{   Scan backward from lines believed to match checking for additional matching
{   lines.

  PROCEDURE propogate_commonality
    (    first_line: file_line_count;
         last_line: file_line_count;
     VAR old_lines: array [0 .. * ] of line_descriptor;
     VAR new_lines: array [0 .. * ] of line_descriptor);

    VAR
      new_index: file_line_count,
      old_index: file_line_count,
      previous_matched: boolean;

{   Scan backward from each matching line looking for further consecutive
{   matching lines and recording them as such.

    FOR new_index := last_line + 1 DOWNTO first_line DO
      IF new_lines [new_index].where > in_symbol_table THEN
        previous_matched := TRUE;
        old_index := new_lines [new_index].where - 1;
      ELSEIF previous_matched AND (old_lines [old_index].where =
            in_symbol_table) AND is_same_symbol
            (old_lines [old_index], new_lines [new_index]) THEN
        new_lines [new_index].where := old_index;
        old_lines [old_index].where := new_index;
        old_index := old_index - 1;
      ELSE
        previous_matched := FALSE;
      IFEND;
    FOREND;

  PROCEND propogate_commonality;
?? OLDTITLE ??
?? NEWTITLE := 'read_source_files', EJECT ??

{ PURPOSE:
{   This routine reads a file into the line descriptor array.  Leading spaces
{   may be optionally skipped.  Any line identifiers are skipped and only the
{   actual text of the line is kept for comparison purposes.

  PROCEDURE read_source_files
    (    source_file_name: fst$file_reference;
         ignore_leading_spaces: boolean;
     VAR descriptor_seq: ^SEQ ( * );
     VAR lines: ^array [0 .. * ] of line_descriptor;
     VAR line_count: file_line_count;
     VAR status: ost$status);

    CONST
      max_line_size = max_line_length + amc$max_statement_id_length;

    VAR
      access_selections: [STATIC, READ] array [1 .. 1] of
            fst$attachment_option := [[fsc$access_and_share_modes,
            [fsc$specific_access_modes, [fsc$read]],
            [fsc$specific_share_modes, [fsc$read, fsc$execute]]]],
      descriptors_in_segment: integer,
      file_exists: boolean,
      file_previously_opened: boolean,
      contains_data: boolean,
      file_attributes: ^array [1 .. 1] of amt$get_item,
      file_position: amt$file_position,
      first_char_index: 1 .. max_line_length,
      ignored_byte_address: amt$file_byte_address,
      identifier_position: (no_identifier, before, after),
      line: ^SEQ ( * ),
      line_identifier: ^string ( * <= amc$max_statement_id_length),
      line_text: ^text_line,
      line_desc: line_descriptor,
      line_length: amt$transfer_count,
      lines_p: ^array [0 .. * ] of line_descriptor,
      minimum_line_size: amt$max_record_length,
      record_length: amt$max_record_length,
      source_file_id: amt$file_identifier;

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

{ PURPOSE:
{   This procedure cleans up by closing the source file in the event that
{   the procedure aborts with the source file open.

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

      VAR
        ignore_status: ost$status;

      IF condition.selector = pmc$block_exit_processing THEN
        fsp$close_file (source_file_id, ignore_status);
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;

    PROCEND abort_handler;
?? OLDTITLE ??

    VAR
      validation_attributes: array [1 .. 5] of fst$file_cycle_attribute;

    status.normal := TRUE;
    descriptors_in_segment := (#SIZE (descriptor_seq^) DIV
          #SIZE (line_descriptor)) DIV 2;
    NEXT lines_p: [0 .. descriptors_in_segment] IN descriptor_seq;
    IF lines_p = NIL THEN
      osp$set_status_abnormal (product_id, oce$e_storage_allocation_failed,
            'lines_p', status);
      RETURN;
    IFEND;

{ Read source file and product line descriptors

    PUSH file_attributes;
    file_attributes^ [1].key := amc$statement_identifier;
    amp$get_file_attributes (source_file_name, file_attributes^, file_exists,
          file_previously_opened, contains_data, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH line: [[REP max_line_size OF char]];
    RESET line;
    IF file_attributes^ [1].source <> amc$undefined_attribute THEN
      IF file_attributes^ [1].statement_identifier.location = 1 THEN
        identifier_position := before;
        minimum_line_size := file_attributes^ [1].statement_identifier.length;
        NEXT line_identifier: [minimum_line_size] IN line;
        NEXT line_text: [max_line_length] IN line;
      ELSE
        identifier_position := after;
        NEXT line_text: [file_attributes^ [1].statement_identifier.location -
              1] IN line;
        NEXT line_identifier: [file_attributes^ [1].statement_identifier.
              length] IN line;
        minimum_line_size := STRLENGTH (line_text^) +
              STRLENGTH (line_identifier^);
      IFEND;
    ELSE
      identifier_position := no_identifier;
      NEXT line_text: [max_line_length] IN line;
    IFEND;

    validation_attributes [1].selector := fsc$record_type;
    validation_attributes [1].record_type := amc$variable;
    validation_attributes [2].selector := fsc$record_type;
    validation_attributes [2].record_type := amc$ansi_fixed;
    validation_attributes [3].selector := fsc$record_type;
    validation_attributes [3].record_type := amc$ansi_spanned;
    validation_attributes [4].selector := fsc$record_type;
    validation_attributes [4].record_type := amc$ansi_variable;
    validation_attributes [5].selector := fsc$record_type;
    validation_attributes [5].record_type := amc$trailing_char_delimited;

    fsp$open_file (source_file_name, amc$record, ^access_selections,
          {default_creation_attributes=} NIL,
          {mandated_creation_attributes=} NIL, ^validation_attributes,
          {attribute_override=} NIL, source_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_block_exit_hndlr (^abort_handler);

    line_count := 0;
    amp$get_next (source_file_id, line, max_line_size, line_length,
          ignored_byte_address, file_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    WHILE (file_position = amc$eor) DO

{ Isolate text from line to be compared.

      IF identifier_position > no_identifier THEN
        IF identifier_position = before THEN
          IF line_length < minimum_line_size THEN
            line_length := 0;
          ELSE
            line_length := line_length - minimum_line_size;
          IFEND;
        ELSEIF line_length > STRLENGTH (line_text^) THEN
          line_length := STRLENGTH (line_text^);
        IFEND;
      ELSEIF line_length > max_line_length THEN
        line_length := max_line_length;
      IFEND;

      IF line_length <= 0 THEN
        line_length := 1;
        line_text^ (1) := ' ';
      IFEND;

      WHILE (line_length > 1) AND (line_text^ (line_length) = ' ') DO
        line_length := line_length - 1;
      WHILEND;
      first_char_index := 1;
      IF ignore_leading_spaces THEN
        WHILE (first_char_index < line_length) AND
              (line_text^ (first_char_index) = ' ') DO
          first_char_index := first_char_index + 1;
        WHILEND;
      IFEND;

{ Build line descriptor

      line_desc.trimmed_spaces := first_char_index;
      NEXT line_desc.text_p: [line_length - first_char_index + 1] IN
            line_text_p;
      IF line_desc.text_p = NIL THEN
        osp$set_status_abnormal (product_id, oce$e_storage_allocation_failed,
              'space for SOURCE file text', status);
        RETURN;
      IFEND;
      line_desc.text_p^ := line_text^ (first_char_index,
            line_length - first_char_index + 1);
      line_count := line_count + 1;
      IF line_count > descriptors_in_segment THEN
        osp$set_status_abnormal (product_id, oce$e_storage_allocation_failed,
              'space to process SOURCE file', status);
        RETURN;
      IFEND;
      lines_p^ [line_count] := line_desc;

      amp$get_next (source_file_id, line, max_line_size, line_length,
            ignored_byte_address, file_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    WHILEND;

    osp$disestablish_cond_handler;

    fsp$close_file (source_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET descriptor_seq TO lines_p;
    NEXT lines: [0 .. line_count + 1] IN descriptor_seq;

  PROCEND read_source_files;
?? OLDTITLE ??
?? NEWTITLE := 'merge_sort', EJECT ??

{ PURPOSE:
{   This routine sorts the line descriptor array using a merge sort.  A merge
{   sort is used because it is reasonably fast, performs no worse than a
{   guarenteed O(N*Ln(N)), and is stable.  Stability is important since
{   identical lines from the old and new files must remain in the order they
{   were found in the old and new files.
{
{ NOTES:
{   This algorithm uses Ln(N) space to keep indicies to previously sorted
{   lists.  A tradeoff could be made for this space by changing the routine
{   to make Ln(N) passes across the array and building the sublists in the
{   same way the lists are built in the first part of this routine.

  PROCEDURE merge_sort
    (    first_line: file_line_count;
         last_line: file_line_count;
     VAR lines: array [0 .. * ] of line_descriptor);

    VAR
      d: file_line_count,
      index: file_line_count,
      lista: file_line_count,
      listb: file_line_count,
      listr: file_line_count,
      pass_count: file_line_count,
      stack: ^array [1 .. * ] of file_line_count,
      stack_index: file_line_count;

    IF first_line > last_line THEN
      RETURN;
    IFEND;

    index := 1;
    stack_index := 1;
    WHILE index < (last_line - first_line) DO
      index := index * 2;
      stack_index := stack_index + 1;
    WHILEND;
    PUSH stack: [1 .. stack_index];

    stack_index := 0;
    pass_count := 0;
    lines [0].link := first_line;
    index := first_line;

  /scan_list/
    WHILE index <= last_line DO

      listr := 0;
      REPEAT
        lines [listr].link := index;
        listr := index;
        index := index + 1;
        IF index > last_line THEN
          lines [listr].link := 0;
          EXIT /scan_list/;
        IFEND;
      UNTIL lines [index].text_p^ < lines [listr].text_p^;
      lines [listr].link := 0;

      pass_count := pass_count + 1;
      d := pass_count;
      WHILE (d MOD 2) = 0 DO
        lista := stack^ [stack_index];
        stack_index := stack_index - 1;
        listb := lines [0].link;
        listr := 0;
        WHILE (listb > 0) AND (lista > 0) DO
          IF lines [listb].text_p^ < lines [lista].text_p^ THEN
            lines [listr].link := listb;
            listr := listb;
            listb := lines [listb].link;
          ELSE
            lines [listr].link := lista;
            listr := lista;
            lista := lines [lista].link;
          IFEND;
        WHILEND;

        IF listb > 0 THEN
          lines [listr].link := listb;
        ELSE
          lines [listr].link := lista;
        IFEND;
        d := d DIV 2;
      WHILEND;

      stack_index := stack_index + 1;
      stack^ [stack_index] := lines [0].link;

    WHILEND /scan_list/;

    WHILE stack_index > 0 DO
      lista := stack^ [stack_index];
      stack_index := stack_index - 1;
      listb := lines [0].link;
      listr := 0;
      WHILE (listb > 0) AND (lista > 0) DO
        IF lines [listb].text_p^ < lines [lista].text_p^ THEN
          lines [listr].link := listb;
          listr := listb;
          listb := lines [listb].link;
        ELSE
          lines [listr].link := lista;
          listr := lista;
          lista := lines [lista].link;
        IFEND;
      WHILEND;

      IF listb > 0 THEN
        lines [listr].link := listb;
      ELSE
        lines [listr].link := lista;
      IFEND;
    WHILEND;

  PROCEND merge_sort;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] rap$_compare_legible_files', EJECT ??

  PROCEDURE [XDCL] rap$_compare_legible_files
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (OSM$COMLF) compare_legible_files, comlf (
{   old_source, os: file = $required
{   new_source, ns: file = $required
{   list, l: file = output
{   bracket_size, bs: any of
{       key infinite keyend
{       integer 1..max_line_number
{     anyend = 10
{   leading_spaces_significant, lss: boolean = TRUE
{   wild_character, wild_char, wc: string 1..1 = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 14] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] 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,
        default_value: string (6),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (2),
      recend,
      type5: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 17, 10, 51, 26, 184],
    clc$command, 14, 7, 2, 0, 0, 0, 7, 'OSM$COMLF'], [
    ['BRACKET_SIZE                   ',clc$nominal_entry, 4],
    ['BS                             ',clc$abbreviation_entry, 4],
    ['L                              ',clc$abbreviation_entry, 3],
    ['LEADING_SPACES_SIGNIFICANT     ',clc$nominal_entry, 5],
    ['LIST                           ',clc$nominal_entry, 3],
    ['LSS                            ',clc$abbreviation_entry, 5],
    ['NEW_SOURCE                     ',clc$nominal_entry, 2],
    ['NS                             ',clc$abbreviation_entry, 2],
    ['OLD_SOURCE                     ',clc$nominal_entry, 1],
    ['OS                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['WC                             ',clc$abbreviation_entry, 6],
    ['WILD_CHAR                      ',clc$alias_entry, 6],
    ['WILD_CHARACTER                 ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [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 2
    [7, 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
    [5, 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, 6],
{ PARAMETER 4
    [1, 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, 84, clc$optional_default_parameter, 0, 2],
{ PARAMETER 5
    [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$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [14, 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, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 7
    [11, 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$file_type],
    'output'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$integer_type,
    clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['INFINITE                       ', clc$nominal_entry,
  clc$normal_usage_entry, 1]]
      ],
    20, [[1, 0, clc$integer_type], [1, max_line_number, 10]]
    ,
    '10'],
{ PARAMETER 5
    [[1, 0, clc$boolean_type],
    'TRUE'],
{ PARAMETER 6
    [[1, 0, clc$string_type], [1, 1, FALSE]],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

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

    CONST
      p$old_source = 1,
      p$new_source = 2,
      p$list = 3,
      p$bracket_size = 4,
      p$leading_spaces_significant = 5,
      p$wild_character = 6,
      p$status = 7;

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

    VAR
      bracket_size: file_line_count,
      descriptor_segment_pointer: amt$segment_pointer,
      files_are_different: boolean,
      i: integer,
      j: integer,
      ignore_leading_spaces: boolean,
      line_text_segment_pointer: amt$segment_pointer,
      local_status: ost$status,
      matching_lines_at_end: file_line_count,
      matching_lines_in_front: file_line_count;

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

    ignore_leading_spaces := NOT pvt [p$leading_spaces_significant].value^.
          boolean_value.value;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random,
          descriptor_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    RESET descriptor_segment_pointer.sequence_pointer;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random,
          line_text_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    line_text_p := line_text_segment_pointer.sequence_pointer;
    RESET line_text_p;

  /main/
    BEGIN

      read_source_files (pvt [p$old_source].value^.file_value^,
            ignore_leading_spaces, descriptor_segment_pointer.sequence_pointer,
            old_lines_p, lines_in_old_file, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      read_source_files (pvt [p$new_source].value^.file_value^,
            ignore_leading_spaces, descriptor_segment_pointer.sequence_pointer,
            new_lines_p, lines_in_new_file, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      wild_char.specified := pvt [p$wild_character].specified;
      IF wild_char.specified THEN
        wild_char.value := pvt [p$wild_character].value^.string_value^ (1);
      IFEND;

{ Initialize line tables.

      new_lines_p^ [0].where := 0;
      new_lines_p^ [0].symbol := 1;
      new_lines_p^ [lines_in_new_file + 1].where := lines_in_old_file + 1;
      new_lines_p^ [lines_in_new_file + 1].symbol := 2;
      old_lines_p^ [0].where := 0;
      old_lines_p^ [0].symbol := 1;
      old_lines_p^ [lines_in_old_file + 1].where := lines_in_new_file + 1;
      old_lines_p^ [lines_in_old_file + 1].symbol := 2;

      isolate_area_of_difference (lines_in_old_file, lines_in_new_file,
            old_lines_p^, new_lines_p^, matching_lines_in_front,
            matching_lines_at_end, files_are_different);
      IF NOT files_are_different THEN
        EXIT /main/;
      IFEND;

      merge_sort (matching_lines_in_front + 1,
            lines_in_new_file - matching_lines_at_end, new_lines_p^);
      merge_sort (matching_lines_in_front + 1,
            lines_in_old_file - matching_lines_at_end, old_lines_p^);

{ PASS 3 OF ALGORITHM

      find_common_unique_source_lines (lines_in_old_file + lines_in_new_file -
            2 * matching_lines_in_front - 2 * matching_lines_at_end,
            old_lines_p^, new_lines_p^);

{ PASS 4 OF ALGORITHM

      propogate_commonality (matching_lines_in_front + 1,
            lines_in_new_file - matching_lines_at_end, old_lines_p^,
            new_lines_p^);

{ PASS 6 OF ALGORITHM

      IF pvt [p$bracket_size].value^.kind = clc$keyword THEN
        bracket_size := max_line_number;
      ELSE
        bracket_size := pvt [p$bracket_size].value^.integer_value.value;
      IFEND;
      produce_comparison_file (pvt [p$list].value^.file_value^, bracket_size,
            matching_lines_in_front, lines_in_old_file - matching_lines_at_end,
            lines_in_new_file - matching_lines_at_end, status);

      osp$set_status_abnormal (product_id, cle$compare_errors_detected,
            'Files had', status);

    END /main/;

    local_status.normal := TRUE;
    mmp$delete_scratch_segment (descriptor_segment_pointer, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
      local_status.normal := TRUE;
    IFEND;

    mmp$delete_scratch_segment (line_text_segment_pointer, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
      local_status.normal := TRUE;
    IFEND;

  PROCEND rap$_compare_legible_files;
?? OLDTITLE ??
MODEND ram$compare_legible_files;
