[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: [linker] Fix out of range relocations.
Marge Bot
gitlab at gitlab.haskell.org
Thu Jul 23 19:41:42 UTC 2020
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00
[linker] Fix out of range relocations.
mmap may return address all over the place. mmap_next will ensure we get
the next free page after the requested address.
This is especially important for linking on aarch64, where the memory model with PIC
admits relocations in the +-4GB range, and as such we can't work with
arbitrary object locations in memory.
Of note: we map the rts into process space, so any mapped objects must
not be ouside of the 4GB from the processes address space.
- - - - -
0d52ac36 by Tamar Christina at 2020-07-23T15:41:35-04:00
winio: restore console cp on exit
- - - - -
6f71d32f by Tamar Christina at 2020-07-23T15:41:36-04:00
winio: change memory allocation strategy and fix double free errors.
- - - - -
13 changed files:
- includes/HsFFI.h
- libraries/base/GHC/Event/Windows.hsc
- libraries/base/GHC/Event/Windows/FFI.hsc
- rts/Linker.c
- rts/LinkerInternals.h
- rts/RtsStartup.c
- rts/linker/Elf.c
- rts/linker/LoadArchive.c
- rts/linker/M32Alloc.c
- rts/linker/MachO.c
- rts/linker/SymbolExtras.c
- rts/linker/elf_got.c
- rts/win32/veh_excn.c
Changes:
=====================================
includes/HsFFI.h
=====================================
@@ -102,6 +102,7 @@ extern void hs_exit (void);
extern void hs_exit_nowait(void);
extern void hs_set_argv (int argc, char *argv[]);
extern void hs_thread_done (void);
+extern void hs_restoreConsoleCP (void);
extern void hs_perform_gc (void);
=====================================
libraries/base/GHC/Event/Windows.hsc
=====================================
@@ -86,7 +86,9 @@ import Data.Foldable (mapM_, length, forM_)
import Data.Maybe (isJust, maybe)
import GHC.Event.Windows.Clock (Clock, Seconds, getClock, getTime)
-import GHC.Event.Windows.FFI (LPOVERLAPPED, OVERLAPPED_ENTRY(..))
+import GHC.Event.Windows.FFI (LPOVERLAPPED, OVERLAPPED_ENTRY(..),
+ CompletionData(..), CompletionCallback,
+ withRequest)
import GHC.Event.Windows.ManagedThreadPool
import GHC.Event.Internal.Types
import GHC.Event.Unique
@@ -300,43 +302,6 @@ foreign import ccall safe "completeSynchronousRequest"
------------------------------------------------------------------------
-- Manager structures
--- | Callback type that will be called when an I/O operation completes.
-type IOCallback = CompletionCallback ()
-
--- | Wrap the IOCallback type into a FunPtr.
-foreign import ccall "wrapper"
- wrapIOCallback :: IOCallback -> IO (FunPtr IOCallback)
-
--- | Unwrap a FunPtr IOCallback to a normal Haskell function.
-foreign import ccall "dynamic"
- mkIOCallback :: FunPtr IOCallback -> IOCallback
-
--- | Structure that the I/O manager uses to associate callbacks with
--- additional payload such as their OVERLAPPED structure and Win32 handle
--- etc. *Must* be kept in sync with that in `winio_structs.h` or horrible things
--- happen.
---
--- We keep the handle around for the benefit of ghc-external libraries making
--- use of the manager.
-data CompletionData = CompletionData { cdHandle :: !HANDLE
- , cdCallback :: !IOCallback
- }
-
-instance Storable CompletionData where
- sizeOf _ = #{size CompletionData}
- alignment _ = #{alignment CompletionData}
-
- peek ptr = do
- cdCallback <- mkIOCallback `fmap` #{peek CompletionData, cdCallback} ptr
- cdHandle <- #{peek CompletionData, cdHandle} ptr
- let !cd = CompletionData{..}
- return cd
-
- poke ptr CompletionData{..} = do
- cb <- wrapIOCallback cdCallback
- #{poke CompletionData, cdCallback} ptr cb
- #{poke CompletionData, cdHandle} ptr cdHandle
-
-- | Pointer offset in bytes to the location of hoData in HASKELL_OVERLAPPPED
cdOffset :: Int
cdOffset = #{const __builtin_offsetof (HASKELL_OVERLAPPED, hoData)}
@@ -507,11 +472,6 @@ data CbResult a
-- manager will perform additional checks.
deriving Show
--- | Called when the completion is delivered.
-type CompletionCallback a = ErrCode -- ^ 0 indicates success
- -> DWORD -- ^ Number of bytes transferred
- -> IO a
-
-- | Associate a 'HANDLE' with the current I/O manager's completion port.
-- This must be done before using the handle with 'withOverlapped'.
associateHandle' :: HANDLE -> IO ()
@@ -581,23 +541,18 @@ withOverlappedEx mgr fname h offset startCB completionCB = do
signalThrow ex = failIfFalse_ (dbgMsg "signalThrow") $
writeIOPort signal (IOFailed ex)
mask_ $ do
- let completionCB' e b = completionCB e b >>= \result ->
- case result of
- IOSuccess val -> signalReturn val
- IOFailed err -> signalThrow err
- hs_lpol <- FFI.allocOverlapped offset
- -- Create the completion record and store it.
- -- We only need the record when we enqueue a request, however if we
- -- delay creating it then we will run into a race condition where the
- -- driver may have finished servicing the request before we were ready
- -- and so the request won't have the book keeping information to know
- -- what to do. So because of that we always create the payload, If we
- -- need it ok, if we don't that's no problem. This approach prevents
- -- expensive lookups in hash-tables.
- --
- -- Todo: Use a memory pool for this so we don't have to hit malloc every
- -- time. This would allow us to scale better.
- cdData <- new (CompletionData h completionCB') :: IO (Ptr CompletionData)
+ let completionCB' e b = completionCB e b >>= \result ->
+ case result of
+ IOSuccess val -> signalReturn val
+ IOFailed err -> signalThrow err
+ let callbackData = CompletionData h completionCB'
+ -- Note [Memory Management]
+ -- These callback data and especially the overlapped structs have to keep
+ -- alive throughout the entire lifetime of the requests. Since this
+ -- function will block until done so it can call completionCB at the end
+ -- we can safely use dynamic memory management here and so reduce the
+ -- possibility of memory errors.
+ withRequest offset callbackData $ \hs_lpol cdData -> do
let ptr_lpol = hs_lpol `plusPtr` cdOffset
let lpol = castPtr hs_lpol
debugIO $ "hs_lpol:" ++ show hs_lpol
@@ -713,11 +668,8 @@ withOverlappedEx mgr fname h offset startCB completionCB = do
debugIO $ "## Waiting for cancellation record... "
_ <- FFI.getOverlappedResult h lpol True
oldDataPtr <- exchangePtr ptr_lpol nullReq
- -- Check if we have to free and cleanup pointer
when (oldDataPtr == cdData) $
- do free oldDataPtr
- free hs_lpol
- reqs <- removeRequest
+ do reqs <- removeRequest
debugIO $ "-1.. " ++ show reqs ++ " requests queued after error."
status <- fmap fromIntegral getLastError
completionCB' status 0
@@ -741,7 +693,6 @@ withOverlappedEx mgr fname h offset startCB completionCB = do
case startCBResult of
CbPending -> runner
CbDone rdata -> do
- free cdData
debugIO $ dbgMsg $ ":: done " ++ show lpol ++ " - " ++ show rdata
bytes <- if isJust rdata
then return rdata
@@ -749,23 +700,18 @@ withOverlappedEx mgr fname h offset startCB completionCB = do
else FFI.getOverlappedResult h lpol False
debugIO $ dbgMsg $ ":: done bytes: " ++ show bytes
case bytes of
- Just res -> free hs_lpol >> completionCB 0 res
+ Just res -> completionCB 0 res
Nothing -> do err <- FFI.overlappedIOStatus lpol
numBytes <- FFI.overlappedIONumBytes lpol
-- TODO: Remap between STATUS_ and ERROR_ instead
-- of re-interpret here. But for now, don't care.
let err' = fromIntegral err
- free hs_lpol
debugIO $ dbgMsg $ ":: done callback: " ++ show err' ++ " - " ++ show numBytes
completionCB err' (fromIntegral numBytes)
CbError err -> do
- free cdData
- free hs_lpol
let err' = fromIntegral err
completionCB err' 0
_ -> do
- free cdData
- free hs_lpol
error "unexpected case in `startCBResult'"
where dbgMsg s = s ++ " (" ++ show h ++ ":" ++ show offset ++ ")"
-- Wait for .25ms (threaded) and 1ms (non-threaded)
@@ -1099,15 +1045,17 @@ processCompletion Manager{..} n delay = do
do debugIO $ "exchanged: " ++ show oldDataPtr
payload <- peek oldDataPtr :: IO CompletionData
let !cb = cdCallback payload
- free oldDataPtr
reqs <- removeRequest
debugIO $ "-1.. " ++ show reqs ++ " requests queued."
status <- FFI.overlappedIOStatus (lpOverlapped oe)
-- TODO: Remap between STATUS_ and ERROR_ instead
-- of re-interpret here. But for now, don't care.
let status' = fromIntegral status
+ -- We no longer explicitly free the memory, this is because we
+ -- now require the callback to free the memory since the
+ -- callback allocated it. This allows us to simplify memory
+ -- management and reduce bugs. See Note [Memory Management].
cb status' (dwNumberOfBytesTransferred oe)
- free hs_lpol
-- clear the array so we don't erroneously interpret the output, in
-- certain circumstances like lockFileEx the code could return 1 entry
=====================================
libraries/base/GHC/Event/Windows/FFI.hsc
=====================================
@@ -30,6 +30,11 @@ module GHC.Event.Windows.FFI (
postQueuedCompletionStatus,
getOverlappedResult,
+ -- * Completion Data
+ CompletionData(..),
+ CompletionCallback,
+ withRequest,
+
-- * Overlapped
OVERLAPPED,
LPOVERLAPPED,
@@ -215,6 +220,51 @@ postQueuedCompletionStatus iocp numBytes completionKey lpol =
failIfFalse_ "PostQueuedCompletionStatus" $
c_PostQueuedCompletionStatus iocp numBytes completionKey lpol
+------------------------------------------------------------------------
+-- Completion Data
+
+-- | Called when the completion is delivered.
+type CompletionCallback a = ErrCode -- ^ 0 indicates success
+ -> DWORD -- ^ Number of bytes transferred
+ -> IO a
+
+-- | Callback type that will be called when an I/O operation completes.
+type IOCallback = CompletionCallback ()
+
+-- | Wrap the IOCallback type into a FunPtr.
+foreign import ccall "wrapper"
+ wrapIOCallback :: IOCallback -> IO (FunPtr IOCallback)
+
+-- | Unwrap a FunPtr IOCallback to a normal Haskell function.
+foreign import ccall "dynamic"
+ mkIOCallback :: FunPtr IOCallback -> IOCallback
+
+-- | Structure that the I/O manager uses to associate callbacks with
+-- additional payload such as their OVERLAPPED structure and Win32 handle
+-- etc. *Must* be kept in sync with that in `winio_structs.h` or horrible things
+-- happen.
+--
+-- We keep the handle around for the benefit of ghc-external libraries making
+-- use of the manager.
+data CompletionData = CompletionData { cdHandle :: !HANDLE
+ , cdCallback :: !IOCallback
+ }
+
+instance Storable CompletionData where
+ sizeOf _ = #{size CompletionData}
+ alignment _ = #{alignment CompletionData}
+
+ peek ptr = do
+ cdCallback <- mkIOCallback `fmap` #{peek CompletionData, cdCallback} ptr
+ cdHandle <- #{peek CompletionData, cdHandle} ptr
+ let !cd = CompletionData{..}
+ return cd
+
+ poke ptr CompletionData{..} = do
+ cb <- wrapIOCallback cdCallback
+ #{poke CompletionData, cdCallback} ptr cb
+ #{poke CompletionData, cdHandle} ptr cdHandle
+
------------------------------------------------------------------------
-- Overlapped
@@ -293,6 +343,30 @@ pokeOffsetOverlapped lpol offset = do
#{poke OVERLAPPED, OffsetHigh} lpol offsetHigh
{-# INLINE pokeOffsetOverlapped #-}
+------------------------------------------------------------------------
+-- Request management
+
+withRequest :: Word64 -> CompletionData
+ -> (Ptr HASKELL_OVERLAPPED -> Ptr CompletionData -> IO a)
+ -> IO a
+withRequest offset cbData f =
+ -- Create the completion record and store it.
+ -- We only need the record when we enqueue a request, however if we
+ -- delay creating it then we will run into a race condition where the
+ -- driver may have finished servicing the request before we were ready
+ -- and so the request won't have the book keeping information to know
+ -- what to do. So because of that we always create the payload, If we
+ -- need it ok, if we don't that's no problem. This approach prevents
+ -- expensive lookups in hash-tables.
+ --
+ -- Todo: Use a memory pool for this so we don't have to hit malloc every
+ -- time. This would allow us to scale better.
+ allocaBytes #{size HASKELL_OVERLAPPED} $ \hs_lpol ->
+ with cbData $ \cdData -> do
+ zeroOverlapped hs_lpol
+ pokeOffsetOverlapped (castPtr hs_lpol) offset
+ f hs_lpol cdData
+
------------------------------------------------------------------------
-- Cancel pending I/O
=====================================
rts/Linker.c
=====================================
@@ -188,7 +188,7 @@ int ocTryLoad( ObjectCode* oc );
*
* MAP_32BIT not available on OpenBSD/amd64
*/
-#if defined(MAP_32BIT) && defined(x86_64_HOST_ARCH)
+#if defined(MAP_32BIT) && (defined(x86_64_HOST_ARCH) || (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH)))
#define MAP_LOW_MEM
#define TRY_MAP_32BIT MAP_32BIT
#else
@@ -214,10 +214,22 @@ int ocTryLoad( ObjectCode* oc );
* systems, we have to pick a base address in the low 2Gb of the address space
* and try to allocate memory from there.
*
+ * The same holds for aarch64, where the default, even with PIC, model
+ * is 4GB. The linker is free to emit AARCH64_ADR_PREL_PG_HI21
+ * relocations.
+ *
* We pick a default address based on the OS, but also make this
* configurable via an RTS flag (+RTS -xm)
*/
-#if defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
+
+#if (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
+// Try to use stg_upd_frame_info as the base. We need to be within +-4GB of that
+// address, otherwise we violate the aarch64 memory model. Any object we load
+// can potentially reference any of the ones we bake into the binary (and list)
+// in RtsSymbols. Thus we'll need to be within +-4GB of those,
+// stg_upd_frame_info is a good candidate as it's referenced often.
+#define MMAP_32BIT_BASE_DEFAULT (void*)&stg_upd_frame_info;
+#elif defined(MAP_32BIT) || DEFAULT_LINKER_ALWAYS_PIC
// Try to use MAP_32BIT
#define MMAP_32BIT_BASE_DEFAULT 0
#else
@@ -1040,11 +1052,47 @@ resolveSymbolAddr (pathchar* buffer, int size,
}
#if RTS_LINKER_USE_MMAP
+
+/* -----------------------------------------------------------------------------
+ Occationally we depend on mmap'd region being close to already mmap'd regions.
+
+ Our static in-memory linker may be restricted by the architectures relocation
+ range. E.g. aarch64 has a +-4GB range for PIC code, thus we'd preferrably
+ get memory for the linker close to existing mappings. mmap on it's own is
+ free to return any memory location, independent of what the preferred
+ location argument indicates.
+
+ For example mmap (via qemu) might give you addresses all over the available
+ memory range if the requested location is already occupied.
+
+ mmap_next will do a linear search from the start page upwards to find a
+ suitable location that is as close as possible to the locations (proivded
+ via the first argument).
+ -------------------------------------------------------------------------- */
+
+void*
+mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset) {
+ if(addr == NULL) return mmap(addr, length, prot, flags, fd, offset);
+ // we are going to look for up to pageSize * 1024 * 1024 (4GB) from the
+ // address.
+ size_t pageSize = getPageSize();
+ for(int i = (uintptr_t)addr & (pageSize-1) ? 1 : 0; i < 1024*1024; i++) {
+ void *target = (void*)(((uintptr_t)addr & ~(pageSize-1))+(i*pageSize));
+ void *mem = mmap(target, length, prot, flags, fd, offset);
+ if(mem == NULL) return mem;
+ if(mem == target) return mem;
+ munmap(mem, length);
+ IF_DEBUG(linker && (i % 1024 == 0),
+ debugBelch("mmap_next failed to find suitable space in %p - %p\n", addr, target));
+ }
+ return NULL;
+}
+
//
// Returns NULL on failure.
//
void *
-mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset)
+mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset)
{
void *map_addr = NULL;
void *result;
@@ -1065,15 +1113,14 @@ mmap_again:
map_addr = mmap_32bit_base;
}
- const int prot = PROT_READ | PROT_WRITE;
IF_DEBUG(linker,
debugBelch("mmapForLinker: \tprotection %#0x\n", prot));
IF_DEBUG(linker,
debugBelch("mmapForLinker: \tflags %#0x\n",
MAP_PRIVATE | tryMap32Bit | fixed | flags));
- result = mmap(map_addr, size, prot,
- MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset);
+ result = mmap_next(map_addr, size, prot,
+ MAP_PRIVATE|tryMap32Bit|fixed|flags, fd, offset);
if (result == MAP_FAILED) {
sysErrorBelch("mmap %" FMT_Word " bytes at %p",(W_)size,map_addr);
@@ -1126,6 +1173,28 @@ mmap_again:
goto mmap_again;
}
}
+#elif (defined(aarch64_TARGET_ARCH) || defined(aarch64_HOST_ARCH))
+ // for aarch64 we need to make sure we stay within 4GB of the
+ // mmap_32bit_base, and we also do not want to update it.
+// if (mmap_32bit_base != (void*)&stg_upd_frame_info) {
+ if (result == map_addr) {
+ mmap_32bit_base = (void*)((uintptr_t)map_addr + size);
+ } else {
+ // upper limit 4GB - size of the object file - 1mb wiggle room.
+ if(llabs((uintptr_t)result - (uintptr_t)&stg_upd_frame_info) > (2<<32) - size - (2<<20)) {
+ // not within range :(
+ debugTrace(DEBUG_linker,
+ "MAP_32BIT didn't work; gave us %lu bytes at 0x%p",
+ bytes, result);
+ munmap(result, size);
+ // TODO: some abort/mmap_32bit_base recomputation based on
+ // if mmap_32bit_base is changed, or still at stg_upd_frame_info
+ goto mmap_again;
+ } else {
+ mmap_32bit_base = (void*)((uintptr_t)result + size);
+ }
+ }
+// }
#endif
IF_DEBUG(linker,
@@ -1454,9 +1523,9 @@ preloadObjectFile (pathchar *path)
* See also the misalignment logic for darwin below.
*/
#if defined(ios_HOST_OS)
- image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
+ image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE, MAP_PRIVATE, fd, 0);
#else
- image = mmap(NULL, fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
+ image = mmapForLinker(fileSize, PROT_READ|PROT_WRITE|PROT_EXEC,
MAP_PRIVATE, fd, 0);
#endif
=====================================
rts/LinkerInternals.h
=====================================
@@ -14,6 +14,7 @@
#if RTS_LINKER_USE_MMAP
#include <sys/mman.h>
+void* mmap_next(void *addr, size_t length, int prot, int flags, int fd, off_t offset);
#endif
void printLoadedObjects(void);
@@ -293,7 +294,7 @@ void exitLinker( void );
void freeObjectCode (ObjectCode *oc);
SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
-void *mmapForLinker (size_t bytes, uint32_t flags, int fd, int offset);
+void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
void mmapForLinkerMarkExecutable (void *start, size_t len);
void addProddableBlock ( ObjectCode* oc, void* start, int size );
=====================================
rts/RtsStartup.c
=====================================
@@ -68,6 +68,11 @@
static int hs_init_count = 0;
static bool rts_shutdown = false;
+#if defined(mingw32_HOST_OS)
+/* Indicates CodePage to set program to after exit. */
+static int64_t __codePage = 0;
+#endif
+
static void flushStdHandles(void);
/* -----------------------------------------------------------------------------
@@ -128,13 +133,38 @@ void fpreset(void) {
static void
initConsoleCP (void)
{
+ /* Set the initial codepage to automatic. */
+ __codePage = -1;
+
/* Check if the codepage is still the system default ANSI codepage. */
- if (GetConsoleCP () == GetOEMCP ()) {
- if (! SetConsoleCP (CP_UTF8))
+ if (GetConsoleCP () == GetOEMCP ()
+ && GetConsoleOutputCP () == GetOEMCP ()) {
+ if (!SetConsoleCP (CP_UTF8) || !SetConsoleOutputCP (CP_UTF8))
errorBelch ("Unable to set console CodePage, Unicode output may be "
"garbled.\n");
else
IF_DEBUG (scheduler, debugBelch ("Codepage set to UTF-8.\n"));
+
+ /* Assign the codepage so we can restore it on exit. */
+ __codePage = (int64_t)GetOEMCP ();
+ }
+}
+
+/* Restore the CodePage to what it was before we started. If the CodePage was
+ already set then this call is a no-op. */
+void
+hs_restoreConsoleCP (void)
+{
+ /* If we set the CP at startup, we should set it on exit. */
+ if (__codePage == -1)
+ return;
+
+ UINT cp = (UINT)__codePage;
+ __codePage = -1;
+ if (SetConsoleCP (cp) && SetConsoleOutputCP (cp)) {
+ IF_DEBUG (scheduler, debugBelch ("Codepage restored to OEM.\n"));
+ } else {
+ IF_DEBUG (scheduler, debugBelch ("Unable to restore CodePage to OEM.\n"));
}
}
#endif
@@ -533,6 +563,11 @@ hs_exit_(bool wait_foreign)
shutdownAsyncIO(wait_foreign);
#endif
+ /* Restore the console Codepage. */
+#if defined(mingw32_HOST_OS)
+ if (is_io_mng_native_p())
+ hs_restoreConsoleCP();
+#endif
/* free hash table storage */
exitHashTable();
=====================================
rts/linker/Elf.c
=====================================
@@ -637,7 +637,7 @@ mapObjectFileSection (int fd, Elf_Word offset, Elf_Word size,
pageOffset = roundDownToPage(offset);
pageSize = roundUpToPage(offset-pageOffset+size);
- p = mmapForLinker(pageSize, 0, fd, pageOffset);
+ p = mmapForLinker(pageSize, PROT_READ | PROT_WRITE, 0, fd, pageOffset);
if (p == NULL) return NULL;
*mapped_size = pageSize;
*mapped_offset = pageOffset;
@@ -709,7 +709,7 @@ ocGetNames_ELF ( ObjectCode* oc )
* address might be out of range for sections that are mmaped.
*/
alloc = SECTION_MMAP;
- start = mmapForLinker(size, MAP_ANONYMOUS, -1, 0);
+ start = mmapForLinker(size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
mapped_start = start;
mapped_offset = 0;
mapped_size = roundUpToPage(size);
@@ -751,8 +751,9 @@ ocGetNames_ELF ( ObjectCode* oc )
unsigned nstubs = numberOfStubsForSection(oc, i);
unsigned stub_space = STUB_SIZE * nstubs;
- void * mem = mmapForLinker(size+stub_space, MAP_ANON, -1, 0);
- if( mem == NULL ) {
+ void * mem = mmapForLinker(size+stub_space, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0);
+
+ if( mem == MAP_FAILED ) {
barf("failed to mmap allocated memory to load section %d. "
"errno = %d", i, errno);
}
@@ -841,6 +842,26 @@ ocGetNames_ELF ( ObjectCode* oc )
unsigned curSymbol = 0;
+ unsigned long common_size = 0;
+ unsigned long common_used = 0;
+ for(ElfSymbolTable *symTab = oc->info->symbolTables;
+ symTab != NULL; symTab = symTab->next) {
+ for (size_t j = 0; j < symTab->n_symbols; j++) {
+ ElfSymbol *symbol = &symTab->symbols[j];
+ if (SHN_COMMON == symTab->symbols[j].elf_sym->st_shndx) {
+ common_size += symbol->elf_sym->st_size;
+ }
+ }
+ }
+ void * common_mem = NULL;
+ if(common_size > 0) {
+ common_mem = mmapForLinker(common_size,
+ PROT_READ | PROT_WRITE,
+ MAP_ANON | MAP_PRIVATE,
+ -1, 0);
+ ASSERT(common_mem != NULL);
+ }
+
//TODO: we ignore local symbols anyway right? So we can use the
// shdr[i].sh_info to get the index of the first non-local symbol
// ie we should use j = shdr[i].sh_info
@@ -876,12 +897,15 @@ ocGetNames_ELF ( ObjectCode* oc )
if (shndx == SHN_COMMON) {
isLocal = false;
- symbol->addr = stgCallocBytes(1, symbol->elf_sym->st_size,
- "ocGetNames_ELF(COMMON)");
- /*
- debugBelch("COMMON symbol, size %d name %s\n",
- stab[j].st_size, nm);
- */
+ ASSERT(common_used < common_size);
+ ASSERT(common_mem);
+ symbol->addr = (void*)((uintptr_t)common_mem + common_used);
+ common_used += symbol->elf_sym->st_size;
+ ASSERT(common_used <= common_size);
+
+ debugBelch("COMMON symbol, size %ld name %s allocated at %p\n",
+ symbol->elf_sym->st_size, nm, symbol->addr);
+
/* Pointless to do addProddableBlock() for this area,
since the linker should never poke around in it. */
} else if ((ELF_ST_BIND(symbol->elf_sym->st_info) == STB_GLOBAL
=====================================
rts/linker/LoadArchive.c
=====================================
@@ -489,7 +489,7 @@ static HsInt loadArchive_ (pathchar *path)
#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
if (RTS_LINKER_USE_MMAP)
- image = mmapForLinker(memberSize, MAP_ANONYMOUS, -1, 0);
+ image = mmapForLinker(memberSize, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
else {
/* See loadObj() */
misalignment = machoGetMisalignment(f);
@@ -548,7 +548,7 @@ while reading filename from `%" PATH_FMT "'", path);
}
DEBUG_LOG("Found GNU-variant file index\n");
#if RTS_LINKER_USE_MMAP
- gnuFileIndex = mmapForLinker(memberSize + 1, MAP_ANONYMOUS, -1, 0);
+ gnuFileIndex = mmapForLinker(memberSize + 1, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
#else
gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
#endif
=====================================
rts/linker/M32Alloc.c
=====================================
@@ -256,7 +256,7 @@ m32_alloc_page(void)
m32_free_page_pool_size --;
return page;
} else {
- struct m32_page_t *page = mmapForLinker(getPageSize(),MAP_ANONYMOUS,-1,0);
+ struct m32_page_t *page = mmapForLinker(getPageSize(), PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
if (page > (struct m32_page_t *) 0xffffffff) {
barf("m32_alloc_page: failed to get allocation in lower 32-bits");
}
@@ -280,7 +280,7 @@ m32_allocator_new(bool executable)
// Preallocate the initial M32_MAX_PAGES to ensure that they don't
// fragment the memory.
size_t pgsz = getPageSize();
- char* bigchunk = mmapForLinker(pgsz * M32_MAX_PAGES,MAP_ANONYMOUS,-1,0);
+ char* bigchunk = mmapForLinker(pgsz * M32_MAX_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0);
if (bigchunk == NULL)
barf("m32_allocator_init: Failed to map");
@@ -396,7 +396,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment)
if (m32_is_large_object(size,alignment)) {
// large object
size_t alsize = ROUND_UP(sizeof(struct m32_page_t), alignment);
- struct m32_page_t *page = mmapForLinker(alsize+size,MAP_ANONYMOUS,-1,0);
+ struct m32_page_t *page = mmapForLinker(alsize+size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0);
page->filled_page.size = alsize + size;
m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t *) page);
return (char*) page + alsize;
=====================================
rts/linker/MachO.c
=====================================
@@ -508,7 +508,7 @@ makeGot(ObjectCode * oc) {
if(got_slots > 0) {
oc->info->got_size = got_slots * sizeof(void*);
- oc->info->got_start = mmap(NULL, oc->info->got_size,
+ oc->info->got_start = mmapForLinker(oc->info->got_size,
PROT_READ | PROT_WRITE,
MAP_ANON | MAP_PRIVATE,
-1, 0);
@@ -1114,7 +1114,7 @@ ocBuildSegments_MachO(ObjectCode *oc)
return 1;
}
- mem = mmapForLinker(size_compound, MAP_ANON, -1, 0);
+ mem = mmapForLinker(size_compound, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0);
if (NULL == mem) return 0;
IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments));
=====================================
rts/linker/SymbolExtras.c
=====================================
@@ -79,7 +79,7 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize)
size_t n = roundUpToPage(oc->fileSize);
bssSize = roundUpToAlign(bssSize, 8);
size_t allocated_size = n + bssSize + extras_size;
- void *new = mmapForLinker(allocated_size, MAP_ANONYMOUS, -1, 0);
+ void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
if (new) {
memcpy(new, oc->image, oc->fileSize);
if (oc->imageMapped) {
=====================================
rts/linker/elf_got.c
=====================================
@@ -48,7 +48,7 @@ makeGot(ObjectCode * oc) {
}
if(got_slots > 0) {
oc->info->got_size = got_slots * sizeof(void *);
- void * mem = mmap(NULL, oc->info->got_size,
+ void * mem = mmapForLinker(oc->info->got_size,
PROT_READ | PROT_WRITE,
MAP_ANON | MAP_PRIVATE,
-1, 0);
=====================================
rts/win32/veh_excn.c
=====================================
@@ -153,6 +153,7 @@ long WINAPI __hs_exception_handler(struct _EXCEPTION_POINTERS *exception_data)
if (EXCEPTION_CONTINUE_EXECUTION == action)
{
fflush(stderr);
+ hs_restoreConsoleCP ();
generateStack (exception_data);
generateDump (exception_data);
stg_exit(exit_code);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/862917378d92e19ba36af986d6f30d0af1dcd572...6f71d32f7c63e732dd905e8c7643e20101298568
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/862917378d92e19ba36af986d6f30d0af1dcd572...6f71d32f7c63e732dd905e8c7643e20101298568
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/20200723/45e58947/attachment-0001.html>
More information about the ghc-commits
mailing list