Use a response file for linker command line arguments #10777

On Windows, we're constrained to 32k bytes total for command line
arguments.  When building large projects, this limit can be exceeded.
This patch changes GHC to always use response files for linker
arguments, a feature first used by Microsoft compilers and added to GCC
(over a decade ago).

Alternatives here include:

* Only use this method on Windows systems
* Check the length of the command line arguments and use that to decide
  whether to use this method

I did not pursue either of these, as I believe it would make the patch
more likely to break in less tested situations.

Test Plan:
Confirm that linking still works in general. Ideally: compile a very
large project on Windows with this patch. (I am attempting to do that
myself now, but having trouble getting the Windows build tool chain up
and running.)

Reviewers: goldfire, hvr, rwbarton, austin, thomie, bgamari, Phyx

Reviewed By: thomie, bgamari, Phyx

Subscribers: erikd, awson, #ghc_windows_task_force, thomie

Differential Revision: https://phabricator.haskell.org/D1158

GHC Trac Issues: #8596, #10777

1 files changed, 54 insertions, 2 deletions

diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index af1f546ff4..b624862191 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -412,7 +412,7 @@ runCc dflags args =   do
       args1 = map Option (getOpts dflags opt_c)
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env
+  runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
  where
   -- discard some harmless warnings from gcc that we can't turn off
   cc_filter = unlines . doFilter . lines
@@ -926,7 +926,7 @@ runLink dflags args = do
       args1     = map Option (getOpts dflags opt_l)
       args2     = args0 ++ linkargs ++ args1 ++ args
   mb_env <- getGccEnv args2
-  runSomethingFiltered dflags ld_filter "Linker" p args2 mb_env
+  runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
   where
     ld_filter = case (platformOS (targetPlatform dflags)) of
                   OSSolaris2 -> sunos_ld_filter
@@ -1254,6 +1254,58 @@ runSomething :: DynFlags
 runSomething dflags phase_name pgm args =
   runSomethingFiltered dflags id phase_name pgm args Nothing
 
+-- | Run a command, placing the arguments in an external response file.
+--
+-- This command is used in order to avoid overlong command line arguments on
+-- Windows. The command line arguments are first written to an external,
+-- temporary response file, and then passed to the linker via @filepath.
+-- response files for passing them in. See:
+--
+--     https://gcc.gnu.org/wiki/Response_Files
+--     https://ghc.haskell.org/trac/ghc/ticket/10777
+runSomethingResponseFile
+  :: DynFlags -> (String->String) -> String -> String -> [Option]
+  -> Maybe [(String,String)] -> IO ()
+
+runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
+    runSomethingWith dflags phase_name pgm args $ \real_args -> do
+        fp <- getResponseFile real_args
+        let args = ['@':fp]
+        r <- builderMainLoop dflags filter_fn pgm args mb_env
+        return (r,())
+  where
+    getResponseFile args = do
+      fp <- newTempName dflags "rsp"
+      withFile fp WriteMode $ \h -> do
+          hSetEncoding h utf8
+          hPutStr h $ unlines $ map escape args
+      return fp
+
+    -- Note: Response files have backslash-escaping, double quoting, and are
+    -- whitespace separated (some implementations use newline, others any
+    -- whitespace character). Therefore, escape any backslashes, newlines, and
+    -- double quotes in the argument, and surround the content with double
+    -- quotes.
+    --
+    -- Another possibility that could be considered would be to convert
+    -- backslashes in the argument to forward slashes. This would generally do
+    -- the right thing, since backslashes in general only appear in arguments
+    -- as part of file paths on Windows, and the forward slash is accepted for
+    -- those. However, escaping is more reliable, in case somehow a backslash
+    -- appears in a non-file.
+    escape x = concat
+        [ "\""
+        , concatMap
+            (\c ->
+                case c of
+                    '\\' -> "\\\\"
+                    '\n' -> "\\n"
+                    '\"' -> "\\\""
+                    _    -> [c])
+            x
+        , "\""
+        ]
+
 runSomethingFiltered
   :: DynFlags -> (String->String) -> String -> String -> [Option]
   -> Maybe [(String,String)] -> IO ()