?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE ram$isolate_source_changes;
?? PUSH (LISTEXT := ON) ??
*copyc rae$error_messages
*copyc rat$match_decks
*copyc rat$source_lib_correction_hdr
*copyc rat$open_file_list
*copyc amp$open
*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$close
*copyc i#move
*copyc ocp$checksum
*copyc osp$set_status_abnormal
*copyc pmp$get_unique_name
*copyc rap$bin_search
*copyc rap$build_replacement_sl
*copyc rap$compare_sl_decks
*copyc rap$get_deck_list
?? POP ??

*copyc rah$isolate_source_changes

  PROCEDURE [XDCL] rap$isolate_source_changes (old_file: rat$file_values;
        new_file: rat$file_values;
    VAR corrector: ^SEQ ( * );
    VAR size: rat$corrector_size;
    VAR status: ost$status);

    VAR
      access_sel1: amt$file_access_selections,
      access_sel2: amt$file_access_selections,
      ba: amt$file_byte_address,
      correction_header: ^rat$source_lib_correction_hdr,
      d_decks: ^array [1 .. * ] of ost$name,
      decks_dont_differ: boolean,
      decks_ok: ^array [1 .. * ] of ost$name,
      delete_decks: ^array [1 .. * ] of ost$name,
      file_p: amt$file_position,
      file_ref: clt$file_reference,
      found: boolean,
      i: rat$deck_index,
      i_decks: ^array [1 .. * ] of ost$name,
      insert_decks: ^array [1 .. * ] of ost$name,
      j: rat$deck_index,
      k: rat$deck_index,
      l: integer,
      new_array: ^rat$match_decks,
      new_checksum: integer,
      new_fid: amt$file_identifier,
      new_name: ost$name,
      new_seg: amt$segment_pointer,
      old_array: ^rat$match_decks,
      old_checksum: integer,
      old_fid: amt$file_identifier,
      old_file_ref: clt$file_reference,
      old_name: ost$name,
      old_seg: amt$segment_pointer,
      rav$open_file_list: [STATIC, XREF] rat$open_file_list,
      repl_fid: amt$file_identifier,
      repl_sl: amt$segment_pointer,
      replacement: ^SEQ ( * ),
      replace_sl: ost$name,
      size_wsa: integer,
      temp: ost$name,
      temp_array: ^array [1 .. * ] of ost$name,
      transfer_count: amt$transfer_count;


    status.normal := TRUE;

    PUSH access_sel1: [1 .. 1];
    access_sel1^ [1].key := amc$access_mode;
    access_sel1^ [1].access_mode := $pft$usage_selections [pfc$read];

    amp$open (old_file.lfn, amc$segment, access_sel1, old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;
    l := 1;
    WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
      IF rav$open_file_list [l].name = old_file.lfn THEN
        rav$open_file_list [l].identifier := old_fid;
        rav$open_file_list [l].opened := TRUE;
        found := TRUE;
      IFEND;
      l := l + 1;
    WHILEND;

    IF NOT found THEN
      l := 1;
      WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
        IF rav$open_file_list [l].name = osc$null_name THEN
          rav$open_file_list [l].name := old_file.lfn;
          rav$open_file_list [l].identifier := old_fid;
          rav$open_file_list [l].opened := TRUE;
          found := TRUE;
        IFEND;
        l := l + 1;
      WHILEND;
    IFEND;
    IF NOT found THEN
      osp$set_status_abnormal ('RA', rae$open_file_list_full, '', status);
      RETURN;
    IFEND;

    amp$open (new_file.lfn, amc$segment, access_sel1, new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;
    l := 1;
    WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
      IF rav$open_file_list [l].name = new_file.lfn THEN
        rav$open_file_list [l].identifier := new_fid;
        rav$open_file_list [l].opened := TRUE;
        found := TRUE;
      IFEND;
      l := l + 1;
    WHILEND;

    IF NOT found THEN
      l := 1;
      WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
        IF rav$open_file_list [l].name = osc$null_name THEN
          rav$open_file_list [l].name := new_file.lfn;
          rav$open_file_list [l].identifier := new_fid;
          rav$open_file_list [l].opened := TRUE;
          found := TRUE;
        IFEND;
        l := l + 1;
      WHILEND;
    IFEND;
    IF NOT found THEN
      osp$set_status_abnormal ('RA', rae$open_file_list_full, '', status);
      RETURN;
    IFEND;

    amp$get_segment_pointer (old_fid, amc$sequence_pointer, old_seg, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (new_fid, amc$sequence_pointer, new_seg, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    old_checksum := ocp$checksum (old_seg.sequence_pointer);
    new_checksum := ocp$checksum (new_seg.sequence_pointer);

    amp$close (old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;
    l := 1;
    WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
      IF rav$open_file_list [l].name = old_file.lfn THEN
        rav$open_file_list [l].opened := FALSE;
        found := TRUE;
      IFEND;
      l := l + 1;
    WHILEND;

    amp$close (new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    found := FALSE;
    l := 1;
    WHILE (l <= UPPERBOUND (rav$open_file_list)) AND NOT found DO
      IF rav$open_file_list [l].name = new_file.lfn THEN
        rav$open_file_list [l].opened := FALSE;
        found := TRUE;
      IFEND;
      l := l + 1;
    WHILEND;

    IF old_checksum = new_checksum THEN
      size := 0;
      RETURN;
    IFEND;


    pmp$get_unique_name (old_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rap$get_deck_list (old_file.ref.path_name, old_file.ref.path_name_size, old_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    pmp$get_unique_name (new_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rap$get_deck_list (new_file.ref.path_name, new_file.ref.path_name_size, new_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH access_sel1: [1 .. 1];
    access_sel1^ [1].key := amc$access_mode;
    access_sel1^ [1].access_mode := $pft$usage_selections [pfc$read];

    amp$open (old_name, amc$record, access_sel1, old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (new_name, amc$record, access_sel1, new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE temp_array: [1 .. 0fff(16)];
    size_wsa := #SIZE (temp);

    amp$get_next (old_fid, ^temp, size_wsa, transfer_count, ba, file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    temp_array^ [1] := temp (1, transfer_count);

    i := 2;
    WHILE file_p <> amc$eoi DO
      amp$get_next (old_fid, ^temp, size_wsa, transfer_count, ba, file_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      temp_array^ [i] := temp (1, transfer_count);
      i := i + 1;
    WHILEND;
    IF (i - 2) < 1 THEN
      old_array := NIL;
    ELSE
      PUSH old_array: [1 .. (i - 2)];
    IFEND;
    FOR j := 1 TO i - 2 DO
      old_array^ [j].name := temp_array^ [j];
      old_array^ [j].index := 0;
    FOREND;
    amp$get_next (new_fid, ^temp, size_wsa, transfer_count, ba, file_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    temp_array^ [1] := temp (1, transfer_count);

    i := 2;
    WHILE file_p <> amc$eoi DO
      amp$get_next (new_fid, ^temp, size_wsa, transfer_count, ba, file_p, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      temp_array^ [i] := temp (1, transfer_count);
      i := i + 1;
    WHILEND;
    IF (i - 2) < 1 THEN
      new_array := NIL;
    ELSE
      PUSH new_array: [1 .. (i - 2)];
    IFEND;
    FOR j := 1 TO i - 2 DO
      new_array^ [j].name := temp_array^ [j];
      new_array^ [j].index := 0;
    FOREND;
    FREE temp_array;
    amp$close (old_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$close (new_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (old_array <> NIL) AND (new_array <> NIL) THEN
      i := 1;
      j := 1;
      WHILE (i <=  UPPERBOUND (old_array^)) AND (j <= UPPERBOUND (new_array^)) DO
        IF old_array^ [i].name = new_array^ [j].name THEN
          old_array^ [i].index := j;
          new_array^ [j].index := i;
          i := i + 1;
          j := j + 1;
        ELSE
          rap$bin_search (old_array^ [i].name, new_array, j, found);
          IF found THEN
            old_array^ [i].index := j;
            new_array^ [j].index := i;
            j := j + 1;
          IFEND;
          i := i + 1;
        IFEND;
      WHILEND;
    IFEND;

    RESET corrector;
    NEXT correction_header IN corrector;
    j := 1;
    IF old_array = NIL THEN
      delete_decks := NIL
    ELSE
      ALLOCATE delete_decks: [1 .. UPPERBOUND (old_array^)];
      FOR i := 1 TO UPPERBOUND (old_array^) DO
        IF old_array^ [i].index = 0 THEN
          delete_decks^ [j] := old_array^ [i].name;
          j := j + 1;
        IFEND;
      FOREND;
    IFEND;

    correction_header^.decks_to_delete := j - 1;

    d_decks := NIL;
    IF correction_header^.decks_to_delete > 0 THEN
      NEXT d_decks: [1 .. correction_header^.decks_to_delete] IN corrector;
      FOR i := 1 TO correction_header^.decks_to_delete DO
        d_decks^ [i] := delete_decks^ [i];
      FOREND;
    IFEND;
    IF delete_decks <> NIL THEN
      FREE delete_decks;
    IFEND;

    j := 1;
    k := 1;
    IF new_array = NIL THEN
      insert_decks := NIL;
      temp_array := NIL;
    ELSE
      ALLOCATE insert_decks: [1 .. UPPERBOUND (new_array^)];
      ALLOCATE temp_array: [1 .. UPPERBOUND (new_array^)];
      FOR i := 1 TO UPPERBOUND (new_array^) DO
        IF new_array^ [i].index = 0 THEN
          insert_decks^ [j] := new_array^ [i].name;
          j := j + 1;
        ELSE
          rap$compare_sl_decks (new_array^ [i].name, old_file.ref.path_name, old_file.ref.path_name_size,
                new_file.ref.path_name, new_file.ref.path_name_size, decks_dont_differ, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF decks_dont_differ THEN
            temp_array^ [k] := new_array^ [i].name;
            k := k + 1;
          IFEND;
        IFEND;
      FOREND;
    IFEND;

    correction_header^.decks_to_insert := j - 1;

    IF (k - 1) > 0 THEN
      PUSH decks_ok: [1 .. k - 1];
    ELSE
      decks_ok := NIL;
    IFEND;

    FOR i := 1 TO k - 1 DO
      decks_ok^ [i] := temp_array^ [i];
    FOREND;
    IF temp_array <> NIL THEN
      FREE temp_array;
    IFEND;

    i_decks := NIL;
    IF correction_header^.decks_to_insert > 0 THEN
      NEXT i_decks: [1 .. correction_header^.decks_to_insert] IN corrector;
      FOR i := 1 TO correction_header^.decks_to_insert DO
        i_decks^ [i] := insert_decks^ [i];
      FOREND;
    IFEND;
    IF insert_decks <> NIL THEN
      FREE insert_decks;
    IFEND;

    IF (decks_ok <> NIL) AND (new_array <> NIL) AND (old_array <> NIL) THEN
      IF (UPPERBOUND (new_array^) = UPPERBOUND (old_array^)) AND (UPPERBOUND (decks_ok^) = UPPERBOUND
            (new_array^)) THEN
        size := 0;
        RETURN;
      IFEND;
    IFEND;

    IF (new_array = NIL) AND (old_array = NIL) THEN
      size := 0;
      RETURN;
    IFEND;

    pmp$get_unique_name (replace_sl, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    rap$build_replacement_sl (new_file, decks_ok, replace_sl, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    PUSH access_sel2: [1 .. 2];
    access_sel2^ [1].key := amc$access_mode;
    access_sel2^ [1].access_mode := $pft$usage_selections [pfc$read];
    access_sel2^ [2].key := amc$return_option;
    access_sel2^ [2].return_option := amc$return_at_close;

    amp$open (replace_sl, amc$segment, access_sel2, repl_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (repl_fid, amc$sequence_pointer, repl_sl, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    size := #SIZE (repl_sl.sequence_pointer^);
    correction_header^.size_of_replacement := size;
    NEXT replacement: [[REP size OF cell]] IN corrector;
    i#move (repl_sl.sequence_pointer, replacement, size);

    size := size + #SIZE (correction_header^);

    IF i_decks <> NIL THEN
      size := size + #SIZE (i_decks^);
    IFEND;

    IF d_decks <> NIL THEN
      size := size + #SIZE (d_decks^);
    IFEND;

    amp$close (repl_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND rap$isolate_source_changes;
MODEND ram$isolate_source_changes;
