[m-rev.] for review: specialise file copying in the compiler

[Julien Fischer]

For review by anyone.

--------------------

Specialise file copying in the compiler.

Specialise the Mercury implementation of file copying in the compiler by
avoiding the use of io.binary_input_stream_foldl_io/5. This allows us to avoid
a higher-order call each time a byte is written and it allows us to use the
unboxed version of the predicate that reads bytes. The other reason for this
change is that we are planning to deprecate (and eventually remove)
io.binary_input_stream_foldl_io/5.

compiler/module_cmds.m:
     As above.

library/io.m:
     Refer to the Boolean constant yes/0 and no/0 in C code as MR_YES
     and MR_NO respectively, rather than MR_TRUE and MR_FALSE.

Julien.

diff --git a/compiler/module_cmds.m b/compiler/module_cmds.m
index ccc172e..97bccbb 100644
--- a/compiler/module_cmds.m
+++ b/compiler/module_cmds.m
@@ -345,27 +345,135 @@ copy_file(Globals, ProgressStream, ErrorStream, Source, Destination,
          Res = ok
      ;
          Succeeded = did_not_succeed,
-        io.open_binary_input(Source, SourceRes, !IO),
+        do_copy_file(Source, Destination, Res, !IO)
+    ).
+
+:- pred do_copy_file(file_name::in, file_name::in, io.res::out,
+    io::di, io::uo) is det.
+
+do_copy_file(Source, Destination, Res, !IO) :-
+    io.open_binary_input(Source, SourceRes, !IO),
+    (
+        SourceRes = ok(SourceStream),
+        io.open_binary_output(Destination, DestRes, !IO),
          (
-            SourceRes = ok(SourceStream),
-            io.open_binary_output(Destination, DestRes, !IO),
-            (
-                DestRes = ok(DestStream),
-                WriteByte = io.write_byte(DestStream),
-                io.binary_input_stream_foldl_io(SourceStream, WriteByte, Res,
-                    !IO),
-                io.close_binary_input(SourceStream, !IO),
-                io.close_binary_output(DestStream, !IO)
-            ;
-                DestRes = error(Error),
-                Res = error(Error)
-            )
+            DestRes = ok(DestStream),
+            copy_bytes(SourceStream, DestStream, Res, !IO),
+            io.close_binary_input(SourceStream, !IO),
+            io.close_binary_output(DestStream, !IO)
          ;
-            SourceRes = error(Error),
+            DestRes = error(Error),
              Res = error(Error)
          )
+    ;
+        SourceRes = error(Error),
+        Res = error(Error)
+    ).
+
+:- pred copy_bytes(io.binary_input_stream::in, io.binary_output_stream::in,
+    io.res::out, io::di, io::uo) is det.
+
+copy_bytes(Source, Destination, Res, !IO) :-
+    should_reduce_stack_usage(ShouldReduce),
+    (
+        ShouldReduce = no,
+        copy_bytes_plain(Source, Destination, Res, !IO)
+    ;
+        ShouldReduce = yes,
+        copy_bytes_chunk(Source, Destination, Res, !IO)
+    ).
+
+:- pred copy_bytes_plain(io.binary_input_stream::in,
+    io.binary_output_stream::in, io.res::out, io::di, io::uo) is det.
+
+copy_bytes_plain(Source, Destination, Res, !IO) :-
+    io.read_binary_uint8_unboxed(Source, ByteResult, Byte, !IO),
+    (
+        ByteResult = ok,
+        io.write_binary_uint8(Destination, Byte, !IO),
+        copy_bytes_plain(Source, Destination, Res, !IO)
+    ;
+        ByteResult = eof,
+        Res = ok
+    ;
+        ByteResult = error(Error),
+        Res = error(Error)
+    ).
+
+:- type copy_chunk_inner_res0
+    --->    ccir0_ok
+    ;       ccir0_error(io.error)
+    ;       ccir0_more.
+
+:- pred copy_bytes_chunk(io.binary_input_stream::in,
+    io.binary_output_stream::in, io.res::out, io::di, io::uo) is det.
+
+copy_bytes_chunk(Source, Destination, Res, !IO) :-
+    % ChunkSize gives the maximum number of recursive calls we want to allow in
+    % the copy_bytes_inner predicate. Without such a limit, the depth of
+    % recursion, which depends on the size of the file they read, will cause
+    % exhaustion of the det stack in debug grades, since there is no tail
+    % recursion in such grades.
+    %
+    % With this arrangement, the maximum number of stack frames needed to
+    % process a file of size N is N/1000 + 1000, the former being the number of
+    % frames of copy_bytes_chunk predicate, the latter being the max number of
+    % frames of the copy_bytes_inner predicate.
+    %
+    ChunkSize = 1000,
+    copy_bytes_inner(ChunkSize, Source, Destination, InnerRes, !IO),
+    (
+        InnerRes = ccir0_ok,
+        Res = ok
+    ;
+        InnerRes = ccir0_error(Error),
+        Res = error(Error)
+    ;
+        InnerRes = ccir0_more,
+        copy_bytes_chunk(Source, Destination, Res, !IO)
+    ).
+
+:- pred copy_bytes_inner(int::in, io.binary_input_stream::in,
+    io.binary_output_stream::in, copy_chunk_inner_res0::out,
+    io::di, io::uo) is det.
+
+copy_bytes_inner(Left, Source, Destination, Res, !IO) :-
+    ( if Left > 0 then
+        io.read_binary_uint8_unboxed(Source, ByteResult, Byte, !IO),
+        (
+            ByteResult = ok,
+            io.write_binary_uint8(Destination, Byte, !IO),
+            copy_bytes_inner(Left - 1, Source, Destination, Res, !IO)
+        ;
+            ByteResult = eof,
+            Res = ccir0_ok
+        ;
+            ByteResult = error(Error),
+            Res = ccir0_error(Error)
+        )
+    else
+        Res = ccir0_more
      ).

+:- pred should_reduce_stack_usage(bool::out) is det.
+
+% For non-C backends.
+should_reduce_stack_usage(yes).
+
+:- pragma foreign_proc("C",
+    should_reduce_stack_usage(ShouldReduce::out),
+    [will_not_call_mercury, promise_pure, thread_safe,
+        does_not_affect_liveness],
+"
+#ifdef  MR_EXEC_TRACE
+    ShouldReduce = MR_YES;
+#else
+    ShouldReduce = MR_NO;
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+
  :- pred copy_dir(globals::in,
      io.text_output_stream::in, io.text_output_stream::in,
      dir_name::in, dir_name::in, maybe_succeeded::out, io::di, io::uo) is det.
diff --git a/library/io.m b/library/io.m
index e88cfd3..3b61a6a 100644
--- a/library/io.m
+++ b/library/io.m
@@ -4393,9 +4393,9 @@ should_reduce_stack_usage(yes).
          does_not_affect_liveness],
  "
  #ifdef  MR_EXEC_TRACE
-    ShouldReduce = MR_TRUE;
+    ShouldReduce = MR_YES;
  #else
-    ShouldReduce = MR_FALSE;
+    ShouldReduce = MR_NO;
  #endif
  ").