[m-rev.] for review: use the Windows API file copying functions
Julien Fischer
jfischer at opturion.com
Sun Jan 7 20:36:10 AEDT 2024
For review by anyone.
On my Windows machine, this reduces the time required to compile
samples/diff using mmc --make from ~30s (with --install-method external)
to ~6s (with --install-method internal).
------------------------------------------
Use the Windows API file copying functions.
On when Windows, use the file copying functions from the Windows API for
copying files in the compiler. This is a lot faster than use an external
command and a bit faster than using the Mercury implementation of copying.
compiler/copy_util.m:
Add an interface to the file copying functionality in the Windows API.
Add a mechanism for choosing an internal copy implementation; on Windows
prefer to use the Windows API.
Rename the existing Mercury implementation of file copying.
Julien.
diff --git a/compiler/copy_util.m b/compiler/copy_util.m
index aae6e4978..7f04eabb2 100644
--- a/compiler/copy_util.m
+++ b/compiler/copy_util.m
@@ -43,13 +43,13 @@
% 2. The internal method uses code internal to the compiler's executable code.
% We intend to support two different internal methods:
%
-% - We can call do_copy_file/5, a file copy predicate that uses
+% - We can call mercury_copy_file/5, a file copy predicate that uses
% only the facilities of the Mercury standard library.
%
-% - We also intend eventually to support copying using mechanisms
-% provided by the underlying platform, which we expect may be faster
-% than just using pure Mercury code. We would access those mechanisms
-% via foreign_procs.
+% - We also support copying using mechanisms provided by the underlying
+% platform, which we expect may be faster than just using pure Mercury
+% code. We access those mechanisms via foreign_procs. This is currently
+% only done for C grades on Windows.
%
% Regardless of the mechanism, we must ensure that copying preserves
% as much of the file's metadata as possible. Notably, this must include
@@ -171,6 +171,96 @@ copy_file_to_directory(Globals, ProgressStream, SourceFile, DestinationDir,
%-----------------------------------------------------------------------------%
+:- pred do_copy_file(file_name::in, file_name::in, io.res::out,
+ io::di, io::uo) is det.
+
+do_copy_file(SourceFile, DestinationFile, Res, !IO) :-
+ CopyMethod = get_internal_copy_method,
+ (
+ CopyMethod = icm_mercury_impl,
+ mercury_copy_file(SourceFile, DestinationFile, Res, !IO)
+ ;
+ CopyMethod = icm_windows_api,
+ windows_copy_file(SourceFile, DestinationFile, Res, !IO)
+ ).
+
+:- type internal_copy_method
+ ---> icm_mercury_impl % Mercury copy implementation.
+ ; icm_windows_api. % CopyFileW() function from the Windows API.
+
+:- pragma foreign_export_enum("C", internal_copy_method/0,
+ [prefix("MC_"), uppercase]).
+
+:- func get_internal_copy_method = internal_copy_method.
+
+:- pragma foreign_proc("C",
+ get_internal_copy_method = (Method::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+#if defined(MR_WIN32) && !defined(MR_CYGWIN)
+ Method = MC_ICM_WINDOWS_API;
+#else
+ Method = MC_ICM_MERCURY_IMPL;
+#endif
+
+").
+
+get_internal_copy_method = icm_mercury.
+
+%-----------------------------------------------------------------------------%
+%
+% File copying using the Windows API.
+%
+
+:- pred windows_copy_file(file_name::in, file_name::in, io.res::out,
+ io::di, io::uo) is det.
+
+windows_copy_file(Source, Destination, Res, !IO) :-
+ do_windows_copy_file(Source, Destination, IsOk, SysErr, !IO),
+ (
+ IsOk = yes,
+ Res = ok
+ ;
+ IsOk = no,
+ io.make_io_error_from_windows_error(SysErr, "file copy failed: ",
+ IO_Error, !IO),
+ Res = error(IO_Error)
+ ).
+
+:- pragma foreign_decl("C", "
+#if defined(MR_WIN32)
+ #include ""mercury_string.h"" // For MR_utf8_to_wide.
+ #include ""mercury_windows.h"" // For windows.h.
+ #include <Winbase.h> // For CopyFileW().
+#endif
+").
+
+:- pred do_windows_copy_file(file_name::in, file_name::in, bool::out,
+ system_error::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ do_windows_copy_file(Src::in, Dst::in, IsOk::out, SysErr::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+#if defined(MR_WIN32)
+ if (CopyFileW(MR_utf8_to_wide(Src), MR_utf8_to_wide(Dst), FALSE)) {
+ IsOk = MR_YES;
+ SysErr = 0;
+ } else {
+ IsOk = MR_NO;
+ SysErr = GetLastError();
+ }
+#else
+ MR_fatal_error(""do_windows_copy_file/6 not supported on this system"");
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+%
+% Mercury implementation of file copying.
+%
+
% XXX TODO: copying the file byte-by-byte is inefficient.
% If the OS or platform we are on provides a system call for copying files,
% we should use that in preference to the code below.
@@ -178,10 +268,10 @@ copy_file_to_directory(Globals, ProgressStream, SourceFile, DestinationDir,
% change the code below to read the file being copied into a byte_array and
% then write out that array using a single system call.
%
-:- pred do_copy_file(file_name::in, file_name::in, io.res::out,
+:- pred mercury_copy_file(file_name::in, file_name::in, io.res::out,
io::di, io::uo) is det.
-do_copy_file(Source, Destination, Res, !IO) :-
+mercury_copy_file(Source, Destination, Res, !IO) :-
io.open_binary_input(Source, SourceRes, !IO),
get_file_permissions(Source, SourceFilePermissions, !IO),
(
More information about the reviews
mailing list