[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Hadrian: use / when making filepaths absolute
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Dec 3 00:41:59 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
57b2c940 by sheaf at 2024-12-02T05:19:05-05:00
Hadrian: use / when making filepaths absolute
In Hadrian, we are careful to use -/- rather than </>, in order to use
/ instead of \ in filepaths. However, this gets ruined by the use of
makeAbsolute from System.Directory, which, on Windows, changes back
forward slashes to backslashes.
- - - - -
4d208df0 by Ben Gamari at 2024-12-02T05:19:06-05:00
rts/linker: Fix out-of-bounds mapping logic
Previously the structure of `mmapInRegion` concealed a subtle bug
concerning handling of `mmap` returning mappings below the beginning of
the desired region. Specifically, we would reset `p = result + bytes`
and then again reset `p = region->start` before looping around for
another iteration. This resulted in an infinite loop on FreeBSD.
Fixes #25492.
- - - - -
cb584e7a by Ben Gamari at 2024-12-02T05:19:06-05:00
rts/linker: Clarify debug output
- - - - -
7 changed files:
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs
- rts/Linker.c
- rts/linker/MMap.c
Changes:
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -7,7 +7,7 @@ module Hadrian.Utilities (
quote, yesNo, parseYesNo, zeroOne,
-- * FilePath manipulation
- unifyPath, (-/-), makeRelativeNoSysLink,
+ unifyPath, (-/-), makeRelativeNoSysLink, makeAbsolute,
-- * Accessing Shake's type-indexed map
insertExtra, lookupExtra, userSetting,
@@ -57,6 +57,7 @@ import qualified System.Directory.Extra as IO
import qualified System.Info.Extra as IO
import qualified System.IO as IO
import System.IO.Error (isPermissionError)
+import qualified System.FilePath.Posix as Posix
-- | Extract a value from a singleton list, or terminate with an error message
-- if the list does not contain exactly one value.
@@ -136,7 +137,17 @@ zeroOne True = "1"
unifyPath :: FilePath -> FilePath
unifyPath = toStandard . normaliseEx
+{- Note [Absolute paths and MSYS]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When dealing with absolute paths in Hadrian, we opt to always use Unix-style
+forward slashes for separating paths.
+This is because, on Windows, the MSYS toolchain can reliably handle paths such
+as /c/foo, while it occasionally falls over on paths of the form C:\foo.
+-}
+
-- | Combine paths with a forward slash regardless of platform.
+--
+-- See Note [Absolute paths and MSYS].
(-/-) :: FilePath -> FilePath -> FilePath
_ -/- b | isAbsolute b && not (isAbsolute $ tail b) = b
"" -/- b = b
@@ -146,6 +157,16 @@ a -/- b
infixr 6 -/-
+-- | Like 'System.Directory.makeAbsolute' from @directory@, but always
+-- using forward slashes.
+--
+-- See Note [Absolute paths and MSYS].
+makeAbsolute :: FilePath -> IO FilePath
+makeAbsolute fp = do
+ cwd <- IO.getCurrentDirectory
+ let fp' = cwd -/- fp
+ return $ Posix.normalise fp'
+
-- | This is like Posix makeRelative, but assumes no sys links in the input
-- paths. This allows the result to start with possibly many "../"s. Input
-- paths must both be relative, or be on the same drive
=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -55,10 +55,10 @@ cabalBuildRules = do
distDir <- Context.distDir (vanillaContext Stage1 rts)
let rtsIncludeDir = distDir -/- "include"
- libdir <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1
- work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal"
+ libdir <- liftIO . makeAbsolute =<< stageLibPath Stage1
+ work_dir <- liftIO $ makeAbsolute $ root -/- "stage-cabal"
let outputDir = work_dir -/- "bin"
- includeDir <- liftIO $ IO.makeAbsolute rtsIncludeDir
+ includeDir <- liftIO $ makeAbsolute rtsIncludeDir
createDirectory outputDir
@@ -95,7 +95,7 @@ cabalBuildRules = do
-- Just symlink these for now
-- TODO: build these with cabal as well
forM_ iserv_targets $ \(_bin_pkg,bin_path') -> do
- bin_path <- liftIO $ IO.makeAbsolute bin_path'
+ bin_path <- liftIO $ makeAbsolute bin_path'
let orig_filename = takeFileName bin_path
output_file = outputDir -/- orig_filename
liftIO $ do
=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -195,7 +195,7 @@ testRules = do
-- get relative path for the given program in the given stage
let relative_path_stage s p = programPath =<< programContext s p
let make_absolute rel_path = do
- abs_path <- liftIO (IO.makeAbsolute rel_path)
+ abs_path <- liftIO (makeAbsolute rel_path)
fixAbsolutePathOnWindows abs_path
rel_ghc_pkg <- relative_path_stage Stage1 ghcPkg
=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -11,7 +11,6 @@ import Settings.Builders.Common
import qualified Settings.Builders.Common as S
import Control.Exception (assert)
import qualified Data.Set as Set
-import System.Directory
import Settings.Program (programContext)
import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink)
import GHC.Toolchain.Program (prgFlags)
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -12,7 +12,6 @@ import Settings.Warnings
import qualified Context as Context
import Rules.Libffi (libffiName)
import qualified Data.Set as Set
-import System.Directory
import Data.Version.Extra
ghcBuilderArgs :: Args
=====================================
rts/Linker.c
=====================================
@@ -1118,7 +1118,7 @@ freePreloadObjectFile (ObjectCode *oc)
*/
void freeObjectCode (ObjectCode *oc)
{
- IF_DEBUG(linker, ocDebugBelch(oc, "start\n"));
+ IF_DEBUG(linker, ocDebugBelch(oc, "freeObjectCode: start\n"));
// Run finalizers
if (oc->type == STATIC_OBJECT &&
=====================================
rts/linker/MMap.c
=====================================
@@ -351,12 +351,7 @@ mmapInRegion (
if (result == NULL) {
// The mapping failed
return NULL;
- } else if (result < region->start) {
- // Uh oh, we assume that mmap() will only give us a
- // an address at or after the requested address.
- // Try again.
- p = (uint8_t *) result + bytes;
- } else if (result < region->end) {
+ } else if (result >= region->start && result < region->end) {
// Success!
region->last = (uint8_t *) result + bytes;
return result;
@@ -364,17 +359,23 @@ mmapInRegion (
// We failed to find a suitable mapping
munmap(result, bytes);
reportMemoryMap();
- errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; "
+ errorBelch("mmapForLinker: failed to mmap() memory between %p and %p; "
"asked for %zu bytes at %p. "
"Try specifying an address with +RTS -xm<addr> -RTS",
- bytes, p);
+ region->start, region->end, bytes, p);
return NULL;
- }
+ } else if (result < region->start) {
+ // Uh oh, we assume that mmap() will only give us a
+ // an address at or after the requested address.
+ // Try bump forward by a bit and try again.
+ p = (uint8_t *) p + bytes;
+ } else if (result >= region->end) {
+ // mmap() gave us too high an address; wrap around and try again
+ wrapped = true;
+ p = region->start;
+ }
- // mmap() gave us too high an address; wrap around and try again
munmap(result, bytes);
- wrapped = true;
- p = region->start;
}
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b4d95acd22d5fe0fc4721febafa7cda02c1dd63...cb584e7a2c0d1fe190532337bed61fa094f6613a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4b4d95acd22d5fe0fc4721febafa7cda02c1dd63...cb584e7a2c0d1fe190532337bed61fa094f6613a
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241202/05f717c3/attachment-0001.html>
More information about the ghc-commits
mailing list