* Performance improvement in Xferhint module.

  Update this cache more accurately during transport.

17 files changed, 185 insertions, 185 deletions

diff --git a/src/.depend b/src/.depend
index bc92a8a..81c39bd 100644
--- a/src/.depend
+++ b/src/.depend
@@ -15,19 +15,19 @@ fileutil.cmi:
 fingerprint.cmi: uutil.cmi path.cmi fspath.cmi 
 fs.cmi: system/system_intf.cmo fspath.cmi 
 fspath.cmi: system.cmi path.cmi name.cmi 
-globals.cmi: ubase/prefs.cmi path.cmi lwt/lwt.cmi common.cmi 
+globals.cmi: ubase/prefs.cmi pred.cmi path.cmi lwt/lwt.cmi common.cmi 
 lock.cmi: system.cmi 
 name.cmi: 
 os.cmi: system.cmi props.cmi path.cmi name.cmi fspath.cmi fileinfo.cmi 
 osx.cmi: uutil.cmi ubase/prefs.cmi path.cmi fspath.cmi fingerprint.cmi 
-path.cmi: name.cmi 
+path.cmi: pred.cmi name.cmi 
 pred.cmi: 
 props.cmi: uutil.cmi ubase/prefs.cmi path.cmi osx.cmi fspath.cmi 
 recon.cmi: path.cmi common.cmi 
 remote.cmi: ubase/prefs.cmi lwt/lwt.cmi fspath.cmi common.cmi clroot.cmi \
     bytearray.cmi 
 sortri.cmi: common.cmi 
-stasher.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi 
+stasher.cmi: update.cmi ubase/prefs.cmi path.cmi os.cmi fspath.cmi 
 strings.cmi: 
 system.cmi: system/system_intf.cmo 
 terminal.cmi: 
@@ -44,7 +44,8 @@ unicode.cmi:
 update.cmi: uutil.cmi tree.cmi props.cmi path.cmi osx.cmi os.cmi name.cmi \
     lwt/lwt.cmi fspath.cmi fileinfo.cmi common.cmi 
 uutil.cmi: 
-xferhint.cmi: ubase/prefs.cmi path.cmi os.cmi fspath.cmi 
+xferhint.cmi: props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi fspath.cmi \
+    fileinfo.cmi 
 abort.cmo: uutil.cmi ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi abort.cmi 
 abort.cmx: uutil.cmx ubase/util.cmx ubase/trace.cmx ubase/prefs.cmx abort.cmi 
 bytearray.cmo: bytearray.cmi 
@@ -59,16 +60,16 @@ common.cmo: uutil.cmi ubase/util.cmi ubase/safelist.cmi props.cmi path.cmi \
     osx.cmi os.cmi name.cmi fspath.cmi fileinfo.cmi common.cmi 
 common.cmx: uutil.cmx ubase/util.cmx ubase/safelist.cmx props.cmx path.cmx \
     osx.cmx os.cmx name.cmx fspath.cmx fileinfo.cmx common.cmi 
-copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi transfer.cmi ubase/trace.cmi \
-    ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi path.cmi osx.cmi \
-    os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi \
-    fileinfo.cmi external.cmi common.cmi clroot.cmi bytearray.cmi abort.cmi \
-    copy.cmi 
-copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx transfer.cmx ubase/trace.cmx \
-    ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx path.cmx osx.cmx \
-    os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx \
-    fileinfo.cmx external.cmx common.cmx clroot.cmx bytearray.cmx abort.cmx \
-    copy.cmi 
+copy.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi transfer.cmi \
+    ubase/trace.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi \
+    path.cmi osx.cmi os.cmi lwt/lwt_util.cmi lwt/lwt.cmi globals.cmi \
+    fspath.cmi fs.cmi fileinfo.cmi external.cmi common.cmi clroot.cmi \
+    bytearray.cmi abort.cmi copy.cmi 
+copy.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx transfer.cmx \
+    ubase/trace.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx \
+    path.cmx osx.cmx os.cmx lwt/lwt_util.cmx lwt/lwt.cmx globals.cmx \
+    fspath.cmx fs.cmx fileinfo.cmx external.cmx common.cmx clroot.cmx \
+    bytearray.cmx abort.cmx copy.cmi 
 external.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi lwt/lwt_util.cmi \
     lwt/lwt_unix.cmi lwt/lwt.cmi external.cmi 
 external.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx lwt/lwt_util.cmx \
@@ -77,18 +78,18 @@ fileinfo.cmo: ubase/util.cmi system.cmi props.cmi ubase/prefs.cmi path.cmi \
     osx.cmi fspath.cmi fs.cmi fileinfo.cmi 
 fileinfo.cmx: ubase/util.cmx system.cmx props.cmx ubase/prefs.cmx path.cmx \
     osx.cmx fspath.cmx fs.cmx fileinfo.cmi 
-files.cmo: uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi system.cmi \
-    stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi props.cmi \
-    ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi lwt/lwt_util.cmi \
-    lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi fs.cmi \
-    fingerprint.cmi fileinfo.cmi external.cmi copy.cmi common.cmi abort.cmi \
-    files.cmi 
-files.cmx: uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx system.cmx \
-    stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx props.cmx \
-    ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx lwt/lwt_util.cmx \
-    lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx fs.cmx \
-    fingerprint.cmx fileinfo.cmx external.cmx copy.cmx common.cmx abort.cmx \
-    files.cmi 
+files.cmo: xferhint.cmi uutil.cmi ubase/util.cmi update.cmi ubase/trace.cmi \
+    system.cmi stasher.cmi ubase/safelist.cmi ubase/rx.cmi remote.cmi \
+    props.cmi ubase/prefs.cmi path.cmi osx.cmi os.cmi name.cmi \
+    lwt/lwt_util.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \
+    fs.cmi fingerprint.cmi fileinfo.cmi external.cmi copy.cmi common.cmi \
+    abort.cmi files.cmi 
+files.cmx: xferhint.cmx uutil.cmx ubase/util.cmx update.cmx ubase/trace.cmx \
+    system.cmx stasher.cmx ubase/safelist.cmx ubase/rx.cmx remote.cmx \
+    props.cmx ubase/prefs.cmx path.cmx osx.cmx os.cmx name.cmx \
+    lwt/lwt_util.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \
+    fs.cmx fingerprint.cmx fileinfo.cmx external.cmx copy.cmx common.cmx \
+    abort.cmx files.cmi 
 fileutil.cmo: fileutil.cmi 
 fileutil.cmx: fileutil.cmi 
 fingerprint.cmo: uutil.cmi ubase/util.cmi fspath.cmi fs.cmi fingerprint.cmi 
@@ -165,14 +166,14 @@ sortri.cmo: ubase/util.cmi ubase/safelist.cmi ubase/prefs.cmi pred.cmi \
     path.cmi common.cmi sortri.cmi 
 sortri.cmx: ubase/util.cmx ubase/safelist.cmx ubase/prefs.cmx pred.cmx \
     path.cmx common.cmx sortri.cmi 
-stasher.cmo: ubase/util.cmi system.cmi ubase/safelist.cmi remote.cmi \
-    props.cmi ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi \
-    lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi fingerprint.cmi \
-    fileutil.cmi fileinfo.cmi copy.cmi common.cmi stasher.cmi 
-stasher.cmx: ubase/util.cmx system.cmx ubase/safelist.cmx remote.cmx \
-    props.cmx ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx \
-    lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx fingerprint.cmx \
-    fileutil.cmx fileinfo.cmx copy.cmx common.cmx stasher.cmi 
+stasher.cmo: xferhint.cmi ubase/util.cmi update.cmi system.cmi \
+    ubase/safelist.cmi remote.cmi props.cmi ubase/prefs.cmi pred.cmi path.cmi \
+    osx.cmi os.cmi lwt/lwt_unix.cmi lwt/lwt.cmi globals.cmi fspath.cmi \
+    fingerprint.cmi fileutil.cmi fileinfo.cmi copy.cmi common.cmi stasher.cmi 
+stasher.cmx: xferhint.cmx ubase/util.cmx update.cmx system.cmx \
+    ubase/safelist.cmx remote.cmx props.cmx ubase/prefs.cmx pred.cmx path.cmx \
+    osx.cmx os.cmx lwt/lwt_unix.cmx lwt/lwt.cmx globals.cmx fspath.cmx \
+    fingerprint.cmx fileutil.cmx fileinfo.cmx copy.cmx common.cmx stasher.cmi 
 strings.cmo: strings.cmi 
 strings.cmx: strings.cmi 
 system.cmo: system.cmi 
@@ -268,17 +269,15 @@ unicode.cmx: unicode_tables.cmx unicode.cmi
 unicode_tables.cmo: 
 unicode_tables.cmx: 
 update.cmo: xferhint.cmi uutil.cmi ubase/util.cmi tree.cmi ubase/trace.cmi \
-    system.cmi stasher.cmi ubase/safelist.cmi remote.cmi props.cmi \
-    ubase/proplist.cmi ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi \
-    name.cmi ubase/myMap.cmi lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi \
-    globals.cmi fspath.cmi fs.cmi fingerprint.cmi fileinfo.cmi copy.cmi \
-    common.cmi case.cmi update.cmi 
+    system.cmi ubase/safelist.cmi remote.cmi props.cmi ubase/proplist.cmi \
+    ubase/prefs.cmi pred.cmi path.cmi osx.cmi os.cmi name.cmi ubase/myMap.cmi \
+    lwt/lwt_unix.cmi lwt/lwt.cmi lock.cmi globals.cmi fspath.cmi fs.cmi \
+    fingerprint.cmi fileinfo.cmi common.cmi case.cmi update.cmi 
 update.cmx: xferhint.cmx uutil.cmx ubase/util.cmx tree.cmx ubase/trace.cmx \
-    system.cmx stasher.cmx ubase/safelist.cmx remote.cmx props.cmx \
-    ubase/proplist.cmx ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx \
-    name.cmx ubase/myMap.cmx lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx \
-    globals.cmx fspath.cmx fs.cmx fingerprint.cmx fileinfo.cmx copy.cmx \
-    common.cmx case.cmx update.cmi 
+    system.cmx ubase/safelist.cmx remote.cmx props.cmx ubase/proplist.cmx \
+    ubase/prefs.cmx pred.cmx path.cmx osx.cmx os.cmx name.cmx ubase/myMap.cmx \
+    lwt/lwt_unix.cmx lwt/lwt.cmx lock.cmx globals.cmx fspath.cmx fs.cmx \
+    fingerprint.cmx fileinfo.cmx common.cmx case.cmx update.cmi 
 uutil.cmo: ubase/util.cmi ubase/trace.cmi ubase/projectInfo.cmo uutil.cmi 
 uutil.cmx: ubase/util.cmx ubase/trace.cmx ubase/projectInfo.cmx uutil.cmi 
 xferhint.cmo: ubase/util.cmi ubase/trace.cmi ubase/prefs.cmi path.cmi os.cmi \
diff --git a/src/Makefile.OCaml b/src/Makefile.OCaml
index 03113c3..52f316f 100644
--- a/src/Makefile.OCaml
+++ b/src/Makefile.OCaml
@@ -207,8 +207,8 @@ OCAMLOBJS += \
           abort.cmo osx.cmo external.cmo \
           props.cmo fileinfo.cmo os.cmo lock.cmo clroot.cmo common.cmo \
           tree.cmo checksum.cmo terminal.cmo \
-          transfer.cmo xferhint.cmo remote.cmo globals.cmo copy.cmo \
-          stasher.cmo update.cmo \
+          transfer.cmo xferhint.cmo remote.cmo globals.cmo \
+          update.cmo copy.cmo stasher.cmo \
 	  files.cmo sortri.cmo recon.cmo transport.cmo \
           strings.cmo uicommon.cmo uitext.cmo test.cmo
 
diff --git a/src/RECENTNEWS b/src/RECENTNEWS
index 7088608..12abdcf 100644
--- a/src/RECENTNEWS
+++ b/src/RECENTNEWS
@@ -1,5 +1,11 @@
 CHANGES FROM VERSION 2.36.-27
 
+* Performance improvement in Xferhint module.
+  Update this cache more accurately during transport.
+
+-------------------------------
+CHANGES FROM VERSION 2.36.-27
+
 * Correction to previous fix: do not perform the optimization for
   directories with ignored children *in the archive*. (The previous
   fix was also rejecting directories with ignored children on disk,
diff --git a/src/copy.ml b/src/copy.ml
index 30de9e7..ed41e2b 100644
--- a/src/copy.ml
+++ b/src/copy.ml
@@ -42,11 +42,6 @@ let lwt_protect f g =
 
 (****)
 
-(* From update.ml *)
-(* (there is a dependency loop between copy.ml and update.ml...) *)
-let excelFile = ref (fun _ -> false)
-let markPossiblyUpdated = ref (fun _ _ -> ())
-
 (* Check whether the source file has been modified during synchronization *)
 let checkContentsChangeLocal
       fspathFrom pathFrom archDesc archDig archStamp archRess paranoid =
@@ -60,7 +55,7 @@ let checkContentsChangeLocal
   let dataClearlyUnchanged =
     not clearlyModified
     && Props.same_time info.Fileinfo.desc archDesc
-    && not (!excelFile pathFrom)
+    && not (Update.excelFile pathFrom)
     && match archStamp with
          Some (Fileinfo.InodeStamp inode) -> info.Fileinfo.inode = inode
        | Some (Fileinfo.CtimeStamp ctime) -> true
@@ -75,7 +70,7 @@ let checkContentsChangeLocal
     if paranoid then begin
       let newDig = Os.fingerprint fspathFrom pathFrom info in
       if archDig <> newDig then begin
-        !markPossiblyUpdated fspathFrom pathFrom;
+        Update.markPossiblyUpdated fspathFrom pathFrom;
         raise (Util.Transient (Printf.sprintf
           "The source file %s\n\
            has been modified but the fast update detection mechanism\n\
@@ -248,14 +243,22 @@ let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
     match Xferhint.lookup fp with
       None ->
         None
-    | Some (candidateFspath, candidatePath) ->
+    | Some (candidateFspath, candidatePath, hintHandle) ->
         debug (fun () ->
           Util.msg
             "tryCopyMovedFile: found match at %s,%s. Try local copying\n"
             (Fspath.toDebugString candidateFspath)
             (Path.toString candidatePath));
         try
-          if Os.exists candidateFspath candidatePath then begin
+          (* If candidateFspath is the replica root, the argument
+             [true] is correct.  Otherwise, we don't expect to point
+             to a symlink, and therefore we still get the correct
+             result. *)
+          let info = Fileinfo.get true candidateFspath candidatePath in
+          if
+            info.Fileinfo.typ <> `ABSENT &&
+            Props.length info.Fileinfo.desc = Props.length desc
+          then begin
             localFile
               candidateFspath candidatePath fspathTo pathTo realPathTo
               update desc (Osx.ressLength ress) (Some id);
@@ -263,7 +266,6 @@ let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
               fileIsTransferred fspathTo pathTo desc fp ress in
             if isTransferred then begin
               debug (fun () -> Util.msg "tryCopyMoveFile: success.\n");
-              Xferhint.insertEntry (fspathTo, pathTo) fp;
               let msg =
                 Printf.sprintf
                  "Shortcut: copied %s/%s from local file %s/%s\n"
@@ -277,15 +279,14 @@ let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
               debug (fun () ->
                 Util.msg "tryCopyMoveFile: candidate file %s modified!\n"
                   (Path.toString candidatePath));
-              Xferhint.deleteEntry (candidateFspath, candidatePath);
-              Os.delete fspathTo pathTo;
+              Xferhint.deleteEntry hintHandle;
               None
             end
           end else begin
             debug (fun () ->
               Util.msg "tryCopyMoveFile: candidate file %s disappeared!\n"
                 (Path.toString candidatePath));
-            Xferhint.deleteEntry (candidateFspath, candidatePath);
+            Xferhint.deleteEntry hintHandle;
             None
           end
         with
@@ -294,8 +295,7 @@ let tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id =
               Util.msg
                 "tryCopyMovedFile: local copy from %s didn't work [%s]"
                 (Path.toString candidatePath) s);
-            Xferhint.deleteEntry (candidateFspath, candidatePath);
-            Os.delete fspathTo pathTo;
+            Xferhint.deleteEntry hintHandle;
             None)
 
 (****)
@@ -627,7 +627,10 @@ let finishExternalTransferLocal connFrom
           (Path.toString pathTo)));
   transferRessourceForkAndSetFileinfo
     connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
-    update desc fp ress id
+    update desc fp ress id >>= fun res ->
+  Xferhint.insertEntry fspathTo pathTo fp;
+  Lwt.return res
+
 
 let finishExternalTransferOnRoot =
   Remote.registerRootCmdWithConnection
@@ -689,6 +692,7 @@ let transferFileLocal connFrom
     let len = Uutil.Filesize.add (Props.length desc) (Osx.ressLength ress) in
     Uutil.showProgress id len "alr";
     setFileinfo fspathTo pathTo realPathTo update desc;
+    Xferhint.insertEntry fspathTo pathTo fp;
     Lwt.return (`DONE (Success info, Some msg))
   end else
    match
@@ -696,6 +700,7 @@ let transferFileLocal connFrom
    with
      Some (info, msg) ->
        (* Transfer was performed by copying *)
+       Xferhint.insertEntry fspathTo pathTo fp;
        Lwt.return (`DONE (Success info, Some msg))
    | None ->
        if shouldUseExternalCopyprog update desc then
@@ -704,6 +709,7 @@ let transferFileLocal connFrom
          reallyTransferFile
            connFrom fspathFrom pathFrom fspathTo pathTo realPathTo
            update desc fp ress id >>= fun status ->
+         Xferhint.insertEntry fspathTo pathTo fp;
          Lwt.return (`DONE (status, None))
        end
 
diff --git a/src/copy.mli b/src/copy.mli
index 006bbd2..9147794 100644
--- a/src/copy.mli
+++ b/src/copy.mli
@@ -27,8 +27,3 @@ val localFile :
  -> Uutil.Filesize.t     (* fork length *)
  -> Uutil.File.t option  (* file's index in UI (for progress bars), as appropriate *)
  -> unit
-
-(* From update.ml *)
-(* (there is a dependency loop between copy.ml and update.ml...) *)
-val excelFile : (Path.local -> bool) ref
-val markPossiblyUpdated : (Fspath.t -> Path.local -> unit) ref
diff --git a/src/files.ml b/src/files.ml
index 795e423..ee27b4e 100644
--- a/src/files.ml
+++ b/src/files.ml
@@ -79,8 +79,8 @@ let deleteLocal (fspathTo, (pathTo, ui)) =
   let localPathTo = Update.translatePathLocal fspathTo pathTo in
   (* Make sure the target is unchanged first *)
   (* (There is an unavoidable race condition here.) *)
-  Update.checkNoUpdates fspathTo localPathTo ui;
-  Stasher.backup fspathTo localPathTo `AndRemove;
+  let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
+  Stasher.backup fspathTo localPathTo `AndRemove prevArch;
   (* Archive update must be done last *)
   Update.replaceArchiveLocal fspathTo localPathTo Update.NoArchive;
   Lwt.return ()
@@ -177,7 +177,7 @@ let makeSymlink =
 
 (* ------------------------------------------------------------ *)
 
-let performRename fspathTo localPathTo workingDir pathFrom pathTo =
+let performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch =
   debug (fun () -> Util.msg "Renaming %s to %s in %s; root is %s\n"
       (Path.toString pathFrom)
       (Path.toString pathTo)
@@ -221,7 +221,7 @@ let performRename fspathTo localPathTo workingDir pathFrom pathTo =
 
         debug (fun() ->
           Util.msg "moving %s to %s\n" (Fspath.toDebugString target) temp');
-        Stasher.backup fspathTo localPathTo `ByCopying;
+        Stasher.backup fspathTo localPathTo `ByCopying prevArch;
         writeCommitLog source target temp';
         Util.finalize (fun() ->
           (* If the first rename fails, the log can be removed: the
@@ -245,7 +245,7 @@ let performRename fspathTo localPathTo workingDir pathFrom pathTo =
         Os.delete temp Path.empty
       end else begin
         debug (fun() -> Util.msg "rename: moveFirst=false\n");
-        Stasher.backup fspathTo localPathTo `ByCopying;
+        Stasher.backup fspathTo localPathTo `ByCopying prevArch;
         Os.rename "renameLocal(3)" source Path.empty target Path.empty;
         debug (fun() ->
 	  if filetypeFrom = `FILE then
@@ -271,11 +271,13 @@ let renameLocal
       (fspathTo, (localPathTo, workingDir, pathFrom, pathTo, ui, archOpt)) =
   (* Make sure the target is unchanged, then do the rename.
      (Note that there is an unavoidable race condition here...) *)
-  Update.checkNoUpdates fspathTo localPathTo ui;
-  performRename fspathTo localPathTo workingDir pathFrom pathTo;
-  (* Archive update must be done last *)
+  let prevArch = Update.checkNoUpdates fspathTo localPathTo ui in
+  performRename fspathTo localPathTo workingDir pathFrom pathTo prevArch;
   begin match archOpt with
     Some archTo -> Stasher.stashCurrentVersion fspathTo localPathTo None;
+                   Update.iterFiles fspathTo localPathTo archTo
+                     Xferhint.insertEntry;
+                   (* Archive update must be done last *)
                    Update.replaceArchiveLocal fspathTo localPathTo archTo
   | None        -> ()
   end;
@@ -283,7 +285,7 @@ let renameLocal
 
 let renameOnHost = Remote.registerRootCmd "rename" renameLocal
 
-let rename root pathInArchive localPath workingDir pathOld pathNew ui archOpt =
+let rename root localPath workingDir pathOld pathNew ui archOpt =
   debug (fun() ->
     Util.msg "rename(root=%s, pathOld=%s, pathNew=%s)\n"
       (root2string root)
@@ -518,7 +520,7 @@ let copy
   else begin
     (* Rename the files to their final location and then update the
        archive on the destination replica *)
-    rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo
+    rename rootTo localPathTo workingDir tempPathTo realPathTo uiTo
       (Some archTo) >>= fun () ->
     (* Update the archive on the source replica
        FIX: we could reuse localArch if rootFrom is the same as rootLocal *)
@@ -701,7 +703,7 @@ let copyBack fspathFrom pathFrom rootTo pathTo propsTo uiTo id =
   Copy.file
     (Local, fspathFrom) pathFrom rootTo workingDirForCopy tempPathTo realPathTo
     `Copy newprops fp None stamp id >>= fun info ->
-  rename rootTo pathTo localPathTo workingDirForCopy tempPathTo realPathTo
+  rename rootTo localPathTo workingDirForCopy tempPathTo realPathTo
     uiTo None)
     
 let keeptempfilesaftermerge =   
diff --git a/src/fingerprint.ml b/src/fingerprint.ml
index ab2c962..cb9d2ca 100644
--- a/src/fingerprint.ml
+++ b/src/fingerprint.ml
@@ -79,3 +79,14 @@ let toString md5 =
 let string = Digest.string
 
 let dummy = ""
+
+let hash d =
+  if d == dummy then
+    1234577
+  else begin
+    Char.code (String.unsafe_get d 0) +
+    (Char.code (String.unsafe_get d 1) lsl 8) +
+    (Char.code (String.unsafe_get d 2) lsl 16)
+  end
+
+let equal (d : string) d' = d = d'
diff --git a/src/fingerprint.mli b/src/fingerprint.mli
index a9ff3e0..e7c25c7 100644
--- a/src/fingerprint.mli
+++ b/src/fingerprint.mli
@@ -14,3 +14,6 @@ val toString : t -> string
 (* This dummy fingerprint is guaranteed small and distinct from all
    other fingerprints *)
 val dummy : t
+
+val hash : t -> int
+val equal : t -> t -> bool
diff --git a/src/mkProjectInfo.ml b/src/mkProjectInfo.ml
index 302ccd9..6cd5ebd 100644
--- a/src/mkProjectInfo.ml
+++ b/src/mkProjectInfo.ml
@@ -95,3 +95,4 @@ Printf.printf "NAME=%s\n" projectName;;
 
 
 
+
diff --git a/src/os.ml b/src/os.ml
index 49ecc3d..1a460b2 100644
--- a/src/os.ml
+++ b/src/os.ml
@@ -36,13 +36,6 @@ let includeInTempNames s =
     if s = "" then tempFileSuffixFixed
     else "." ^ s ^ tempFileSuffixFixed
 
-let xferDelete = ref (fun (fp,p) -> ())
-let xferRename = ref (fun (fp,p) (ftp,tp) -> ())
-
-let initializeXferFunctions del ren =
-  xferDelete := del;
-  xferRename := ren
-      
 (*****************************************************************************)
 (*                      QUERYING THE FILESYSTEM                              *)
 (*****************************************************************************)
@@ -158,7 +151,6 @@ and delete fspath path =
           Safelist.iter
             (fun child -> delete fspath (Path.child path child))
             (allChildrenOf fspath path);
-	  (!xferDelete) (fspath, path);
           Fs.rmdir absolutePath
       | `FILE ->
           if Util.osType <> `Unix then begin
@@ -166,7 +158,6 @@ and delete fspath path =
               Fs.chmod absolutePath 0o600;
             with Unix.Unix_error _ -> ()
           end;
-	  (!xferDelete) (fspath, path);
           Fs.unlink absolutePath;
           if Prefs.read Osx.rsrc then begin
             let pathDouble = Fspath.appleDouble absolutePath in
@@ -189,7 +180,6 @@ let rename fname sourcefspath sourcepath targetfspath targetpath =
   Util.convertUnixErrorsToTransient ("renaming " ^ source' ^ " to " ^ target')
     (fun () ->
       debug (fun() -> Util.msg "rename %s to %s\n" source' target');
-      (!xferRename) (sourcefspath, sourcepath) (targetfspath, targetpath);
       Fs.rename source target;
       if Prefs.read Osx.rsrc then begin
         let sourceDouble = Fspath.appleDouble source in
@@ -278,6 +268,12 @@ let reasonForFingerprintMismatch (digdata,digress) (digdata',digress') =
 
 let fullfingerprint_dummy = (Fingerprint.dummy,Fingerprint.dummy)
 
+let fullfingerprintHash (fp, rfp) =
+  Fingerprint.hash fp + 31 * Fingerprint.hash rfp
+
+let fullfingerprintEqual (fp, rfp) (fp', rfp') =
+  Fingerprint.equal fp fp' && Fingerprint.equal rfp rfp'
+
 (*****************************************************************************)
 (*                           UNISON DIRECTORY                                *)
 (*****************************************************************************)
diff --git a/src/os.mli b/src/os.mli
index dc918cf..f710360 100644
--- a/src/os.mli
+++ b/src/os.mli
@@ -31,6 +31,8 @@ type fullfingerprint
 val fullfingerprint_to_string : fullfingerprint -> string
 val reasonForFingerprintMismatch : fullfingerprint -> fullfingerprint -> string
 val fullfingerprint_dummy : fullfingerprint
+val fullfingerprintHash : fullfingerprint -> int
+val fullfingerprintEqual : fullfingerprint -> fullfingerprint -> bool
 
 (* Use this function if the file may change during fingerprinting *)
 val safeFingerprint :
@@ -47,10 +49,3 @@ val fingerprint :
 (* Versions of system calls that will restart when interrupted by
    signal handling *)
 val accept : Unix.file_descr -> (Unix.file_descr * Unix.sockaddr)
-
-(* Called during program initialization to resolve a circular dependency
-   between this module and Xferhints *)
-val initializeXferFunctions : 
-    (Fspath.t * Path.local -> unit) -> 
-    ((Fspath.t * Path.local) -> (Fspath.t * Path.local) -> unit) ->
-    unit
diff --git a/src/stasher.ml b/src/stasher.ml
index 669d926..9cc4678 100644
--- a/src/stasher.ml
+++ b/src/stasher.ml
@@ -360,7 +360,7 @@ let backupPath fspath path =
 
 (*------------------------------------------------------------------------------------*)
 	  
-let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) =
+let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) arch =
   debug (fun () -> Util.msg
       "backup: %s / %s\n"
       (Fspath.toDebugString fspath)
@@ -409,14 +409,17 @@ let backup fspath path (finalDisposition : [`AndRemove | `ByCopying]) =
             debug (fun () -> Util.msg "  Finished copying; deleting %s / %s\n"
               (Fspath.toDebugString fspath) (Path.toString path));
             disposeIfNeeded() in
-          if finalDisposition = `AndRemove then
+          begin if finalDisposition = `AndRemove then
             try
+              (*FIX: this does the wrong thing with followed symbolic links!*)
               Os.rename "backup" workingDir realPath backRoot backPath
             with Util.Transient _ ->
               debug (fun () -> Util.msg "Rename failed -- copying instead\n");
               byCopying()
           else
             byCopying()
+          end;
+          Update.iterFiles backRoot backPath arch Xferhint.insertEntry
       end else begin
 	debug (fun () -> Util.msg "Path %s / %s does not need to be backed up\n"
 	    (Fspath.toDebugString fspath)
@@ -462,7 +465,10 @@ let rec stashCurrentVersion fspath path sourcePathOpt =
                 (Osx.ressLength stat.Fileinfo.osX.Osx.ressInfo)
                 None
           end)
-      
+
+let _ =
+Update.setStasherFun (fun fspath path -> stashCurrentVersion fspath path None)
+
 (*------------------------------------------------------------------------------------*)    
     
 (* This function tries to find a backup of a recent version of the file at location
diff --git a/src/stasher.mli b/src/stasher.mli
index d431d57..2f8d692 100644
--- a/src/stasher.mli
+++ b/src/stasher.mli
@@ -5,9 +5,12 @@
 (* This module maintains backups for general purpose and *)
 (* as archives for mergeable files. *)
 
-(* Make a backup copy of a file, if needed; if the third parameter is `AndRemove,
-   then the file is either backed up by renaming or deleted if no backup is needed. *)
-val backup: Fspath.t -> Path.local -> [`AndRemove | `ByCopying] -> unit
+(* Make a backup copy of a file, if needed; if the third parameter is
+   `AndRemove, then the file is either backed up by renaming or
+   deleted if no backup is needed. *)
+val backup:
+  Fspath.t -> Path.local ->
+  [`AndRemove | `ByCopying] -> Update.archive -> unit
 
 (* Stashes of current versions (so that we have archives when needed for merging) *)
 val stashCurrentVersion:
diff --git a/src/update.ml b/src/update.ml
index 76b2447..901edb8 100644
--- a/src/update.ml
+++ b/src/update.ml
@@ -1223,7 +1223,7 @@ let checkContentsChange
     Osx.ressUnchanged archRess info.Fileinfo.osX.Osx.ressInfo
       None dataClearlyUnchanged in
   if dataClearlyUnchanged && ressClearlyUnchanged then begin
-    Xferhint.insertEntry (currfspath, path) archDig;
+    Xferhint.insertEntry currfspath path archDig;
     None, checkPropChange info archive archDesc
   end else begin
     debugverbose (fun() -> Util.msg "  Double-check possibly updated file\n");
@@ -1231,7 +1231,7 @@ let checkContentsChange
     let (info, newDigest) =
       Os.safeFingerprint currfspath path info
         (if dataClearlyUnchanged then Some archDig else None) in
-    Xferhint.insertEntry (currfspath, path) newDigest;
+    Xferhint.insertEntry currfspath path newDigest;
     debug (fun() -> Util.msg "  archive digest = %s   current digest = %s\n"
              (Os.fullfingerprint_to_string archDig)
              (Os.fullfingerprint_to_string newDigest));
@@ -1239,7 +1239,6 @@ let checkContentsChange
       let newprops = Props.setTime archDesc (Props.time info.Fileinfo.desc) in
       let newarch =
         ArchiveFile
-
           (newprops, archDig, Fileinfo.stamp info, Fileinfo.ressStamp info) in
       debugverbose (fun() ->
         Util.msg "  Contents match: update archive with new time...%f\n" 
@@ -1330,8 +1329,8 @@ let rec buildUpdateChildren
         NameMap.iter
           (fun nm archive ->
              match archive with
-               ArchiveFile (archDesc, archDig, archStamp, archRess) ->
-                 Xferhint.insertEntry (fspath, Path.child path nm) archDig
+               ArchiveFile (_, archDig, _, _) ->
+                 Xferhint.insertEntry fspath (Path.child path nm) archDig
              | _ ->
                  ())
           archChi;
@@ -1374,8 +1373,8 @@ let rec buildUpdateChildren
         `Ok | `Abs ->
           if skip && archive <> NoArchive && status <> `Abs then begin
             begin match archive with
-              ArchiveFile (archDesc, archDig, archStamp, archRess) ->
-                Xferhint.insertEntry (fspath, path') archDig 
+              ArchiveFile (_, archDig, _, _) ->
+                Xferhint.insertEntry fspath path' archDig
             | _ ->
                 ()
             end;
@@ -1469,7 +1468,7 @@ and buildUpdateRec archive currfspath path fastCheckInfos =
         begin
           showStatusAddLength info;
           let (info, dig) = Os.safeFingerprint currfspath path info None in
-          Xferhint.insertEntry (currfspath, path) dig;
+          Xferhint.insertEntry currfspath path dig;
           Updates (File (info.Fileinfo.desc,
                          ContentsUpdated (dig, Fileinfo.stamp info,
                                           Fileinfo.ressStamp info)),
@@ -1909,6 +1908,10 @@ let updateArchive fspath path ui =
   let (_, subArch) = getPathInArchive archive Path.empty path in
   updateArchiveRec ui (stripArchive path subArch)
 
+(* (For breaking the dependency loop between update.ml and stasher.ml...) *)
+let stashCurrentVersion = ref (fun _ _ -> ())
+let setStasherFun f = stashCurrentVersion := f
+
 (* This function is called for files changed only in identical ways.
    It only updates the archives and perhaps makes backups. *)
 let markEqualLocal fspath paths =
@@ -1922,7 +1925,7 @@ let markEqualLocal fspath paths =
        let arch =
          updatePathInArchive !archive fspath Path.empty path
            (fun archive localPath ->
-              Stasher.stashCurrentVersion fspath localPath None;
+              !stashCurrentVersion fspath localPath;
               updateArchiveRec (Updates (uc, New)) archive)
        in
        archive := arch);
@@ -2136,7 +2139,8 @@ let checkNoUpdates fspath pathInArchive ui =
   in
   let (_, uiNew) = buildUpdateRec archive fspath localPath fastCheckInfos in
   markPossiblyUpdatedRec fspath pathInArchive uiNew;
-  explainUpdate pathInArchive uiNew
+  explainUpdate pathInArchive uiNew;
+  archive
 
 (*****************************************************************************)
 (*                                UPDATE SIZE                                *)
@@ -2213,9 +2217,16 @@ let updateSize path ui =
   let (_, subArch) = getPathInArchive archive Path.empty path in
   updateSizeRec subArch ui
 
-(*****)
+(*****************************************************************************)
+(*                                MISC                                       *)
+(*****************************************************************************)
 
-(* There is a dependency loop between copy.ml and update.ml... *)
-let _ =
-Copy.excelFile := excelFile;
-Copy.markPossiblyUpdated := markPossiblyUpdated
+let rec iterFiles fspath path arch f =
+  match arch with
+    ArchiveDir (_, children) ->
+      NameMap.iter
+        (fun nm arch -> iterFiles fspath (Path.child path nm) arch f) children
+  | ArchiveFile (desc, fp, stamp, ress) ->
+      f fspath path fp
+  | _ ->
+      ()
diff --git a/src/update.mli b/src/update.mli
index b298e18..b8293e6 100644
--- a/src/update.mli
+++ b/src/update.mli
@@ -36,7 +36,9 @@ val updateProps :
   Fspath.t -> 'a Path.path -> Props.t option -> Common.updateItem -> unit
 
 (* Check that no updates has taken place in a given place of the filesystem *)
-val checkNoUpdates : Fspath.t -> Path.local -> Common.updateItem -> unit
+(* Returns an archive mirroring the filesystem contents *)
+val checkNoUpdates :
+  Fspath.t -> Path.local -> Common.updateItem -> archive
 
 (* Turn off fastcheck for the given file on the next sync. *)
 val markPossiblyUpdated : Fspath.t -> Path.local -> unit
@@ -61,8 +63,19 @@ val translatePathLocal : Fspath.t -> Path.t -> Path.local
 (* Are we checking fast, or carefully? *)
 val useFastChecking : unit -> bool
 
+(* Is that a file for which fast checking is disabled? *)
+val excelFile : Path.local -> bool
+
 (* Print the archive to the current formatter (see Format) *)
 val showArchive: archive -> unit
 
 (* Compute the size of an update *)
 val updateSize : Path.t -> Common.updateItem -> int * Uutil.Filesize.t
+
+(* Iterate on all files in an archive *)
+val iterFiles :
+  Fspath.t -> Path.local -> archive ->
+  (Fspath.t -> Path.local -> Os.fullfingerprint -> unit) -> unit
+
+(* (For breaking the dependency loop between update.ml and stasher.ml...) *)
+val setStasherFun : (Fspath.t -> Path.local -> unit) -> unit
diff --git a/src/xferhint.ml b/src/xferhint.ml
index 3b7db64..4915c59 100644
--- a/src/xferhint.ml
+++ b/src/xferhint.ml
@@ -27,89 +27,39 @@ let xferbycopying =
    ^ "allows file moves to be propagated very quickly.  The default value is"
    ^ "\\texttt{true}.  ")
 
-module PathMap =
-  Hashtbl.Make
-    (struct
-       type t = Fspath.t * Path.local
-       let hash (fspath, path) =
-         (Fspath.hash fspath + 13217 * Path.hash path)
-           land
-         0x3FFFFFFF
-       let equal = (=)
-     end)
 module FPMap =
   Hashtbl.Make
     (struct
        type t = Os.fullfingerprint
-       let hash = Hashtbl.hash
-       let equal = (=)
+       let hash = Os.fullfingerprintHash
+       let equal = Os.fullfingerprintEqual
      end)
 
-(* map(path, fingerprint) *)
-let path2fingerprintMap =  PathMap.create 101
+type handle = Os.fullfingerprint
+
 (* map(fingerprint, path) *)
-let fingerprint2pathMap = FPMap.create 101
+let fingerprint2pathMap = FPMap.create 10000
 
-(*  Now we don't clear it out anymore
-let initLocal () =
-  debug (fun () -> Util.msg "initLocal\n");
-  path2fingerprintMap := PathMap.empty;
-  fingerprint2pathMap := FPMap.empty
-*)
+let deleteEntry fp =
+  debug (fun () ->
+    Util.msg "deleteEntry: fp=%s\n" (Os.fullfingerprint_to_string fp));
+  FPMap.remove fingerprint2pathMap fp
 
 let lookup fp =
   assert (Prefs.read xferbycopying);
   debug (fun () ->
     Util.msg "lookup: fp = %s\n" (Os.fullfingerprint_to_string fp));
   try
-    Some (FPMap.find fingerprint2pathMap fp)
+    let (fspath, path) = FPMap.find fingerprint2pathMap fp in
+    Some (fspath, path, fp)
   with Not_found ->
     None
 
-let insertEntry p fp =
+let insertEntry fspath path fp =
   if Prefs.read xferbycopying then begin
     debug (fun () ->
-      let (fspath, path) = p in
       Util.msg "insertEntry: fspath=%s, path=%s, fp=%s\n"
         (Fspath.toDebugString fspath)
         (Path.toString path) (Os.fullfingerprint_to_string fp));
-    (* Neither of these should be able to raise Not_found *)
-    PathMap.replace path2fingerprintMap p fp;
-    FPMap.replace fingerprint2pathMap fp p
-  end
-
-let deleteEntry p =
-  if Prefs.read xferbycopying then begin
-    debug (fun () ->
-      let (fspath, path) = p in
-      Util.msg "deleteEntry: fspath=%s, path=%s\n"
-        (Fspath.toDebugString fspath) (Path.toString path));
-    try
-      let fp = PathMap.find path2fingerprintMap p in
-      PathMap.remove path2fingerprintMap p;
-      let p' = FPMap.find fingerprint2pathMap fp in
-      (* Maybe we should do this unconditionally *)
-      if p' = p then FPMap.remove fingerprint2pathMap fp
-    with Not_found ->
-      ()
+    FPMap.replace fingerprint2pathMap fp (fspath, path)
   end
-      
-let renameEntry pOrig pNew =
-  if Prefs.read xferbycopying then begin
-    debug (fun () ->
-      let (fspathOrig, pathOrig) = pOrig in
-      let (fspathNew, pathNew) = pNew in
-      Util.msg "renameEntry: fsOrig=%s, pOrig=%s, fsNew=%s, pNew=%s\n"
-        (Fspath.toDebugString fspathOrig) (Path.toString pathOrig)
-        (Fspath.toDebugString fspathNew) (Path.toString pathNew));
-    try
-      let fp = PathMap.find path2fingerprintMap pOrig in
-      PathMap.remove path2fingerprintMap pOrig;
-      PathMap.replace path2fingerprintMap pNew fp;
-      FPMap.replace fingerprint2pathMap fp pNew
-    with Not_found ->
-      ()
-  end
-
-let _ =
-  Os.initializeXferFunctions deleteEntry renameEntry
diff --git a/src/xferhint.mli b/src/xferhint.mli
index c459347..ee5cb33 100644
--- a/src/xferhint.mli
+++ b/src/xferhint.mli
@@ -9,10 +9,13 @@
 
 val xferbycopying: bool Prefs.t
 
+type handle
+
 (* Suggest a file that's likely to have a given fingerprint *)
-val lookup: Os.fullfingerprint -> (Fspath.t * Path.local) option
+val lookup: Os.fullfingerprint -> (Fspath.t * Path.local * handle) option
+
+(* Add a file *)
+val insertEntry: Fspath.t -> Path.local -> Os.fullfingerprint -> unit
 
-(* Add, delete, and rename entries *)
-val insertEntry: Fspath.t * Path.local -> Os.fullfingerprint -> unit
-val deleteEntry: Fspath.t * Path.local -> unit
-val renameEntry: Fspath.t * Path.local -> Fspath.t * Path.local -> unit
+(* Delete an entry *)
+val deleteEntry: handle -> unit