[Git][ghc/ghc][wip/win32-m32] 5 commits: rts: Introduce mmapAnonForLinker
Ben Gamari
gitlab at gitlab.haskell.org
Tue Nov 24 02:29:59 UTC 2020
Ben Gamari pushed to branch wip/win32-m32 at Glasgow Haskell Compiler / GHC
Commits:
212a811d by Ben Gamari at 2020-11-23T21:29:50-05:00
rts: Introduce mmapAnonForLinker
Previously most of the uses of mmapForLinker were mapping anonymous
memory, resulting in a great deal of unnecessary repetition. Factor this
out into a new helper.
Also fixes a few places where error checking was missing or suboptimal.
- - - - -
f602af1a by Ben Gamari at 2020-11-23T21:29:50-05:00
rts/linker: Introduce munmapForLinker
Consolidates munmap calls to ensure consistent error handling.
- - - - -
76637b92 by Ben Gamari at 2020-11-23T21:29:50-05:00
rts/Linker: Introduce Windows implementations for mmapForLinker, et al.
- - - - -
4b7ef096 by Ben Gamari at 2020-11-23T21:29:50-05:00
rts/m32: Introduce NEEDS_M32 macro
Instead of relying on RTS_LINKER_USE_MMAP
- - - - -
267c1245 by Ben Gamari at 2020-11-23T21:29:50-05:00
rts/linker: Use m32 to allocate symbol extras in PEi386
- - - - -
10 changed files:
- rts/Linker.c
- rts/LinkerInternals.h
- rts/linker/Elf.c
- rts/linker/LoadArchive.c
- rts/linker/M32Alloc.c
- rts/linker/M32Alloc.h
- rts/linker/MachO.c
- rts/linker/PEi386.c
- rts/linker/SymbolExtras.c
- rts/linker/elf_got.c
Changes:
=====================================
rts/Linker.c
=====================================
@@ -45,6 +45,8 @@
#include <sys/types.h>
#endif
+#include <fcntl.h>
+#include <unistd.h>
#include <inttypes.h>
#include <stdlib.h>
#include <string.h>
@@ -1026,7 +1028,38 @@ resolveSymbolAddr (pathchar* buffer, int size,
#endif /* OBJFORMAT_PEi386 */
}
-#if RTS_LINKER_USE_MMAP
+#if defined(mingw32_HOST_OS)
+
+//
+// Returns NULL on failure.
+//
+void *
+mmapAnonForLinker (size_t bytes)
+{
+ return VirtualAlloc(NULL, bytes, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE);
+}
+
+void
+munmapForLinker (void *addr, size_t bytes, const char *caller)
+{
+ if (VirtualFree(addr, 0, MEM_RELEASE) == 0) {
+ sysErrorBelch("munmapForLinker: %s: Failed to unmap %zd bytes at %p",
+ caller, bytes, addr);
+ }
+}
+
+void
+mmapForLinkerMarkExecutable(void *start, size_t len)
+{
+ DWORD old;
+ if (VirtualProtect(start, len, PAGE_EXECUTE_READ, &old) == 0) {
+ sysErrorBelch("mmapForLinkerMarkExecutable: failed to protect %zd bytes at %p",
+ len, start);
+ ASSERT(false);
+ }
+}
+
+#elif RTS_LINKER_USE_MMAP
//
// Returns NULL on failure.
//
@@ -1085,7 +1118,7 @@ mmap_again:
fixed = MAP_FIXED;
goto mmap_again;
#else
- errorBelch("loadObj: failed to mmap() memory below 2Gb; "
+ errorBelch("mmapForLinker: failed to mmap() memory below 2Gb; "
"asked for %lu bytes at %p. "
"Try specifying an address with +RTS -xm<addr> -RTS",
size, map_addr);
@@ -1145,6 +1178,24 @@ mmap_again:
return result;
}
+/*
+ * Map read/write pages in low memory. Returns NULL on failure.
+ */
+void *
+mmapAnonForLinker (size_t bytes)
+{
+ return mmapForLinker (bytes, PROT_READ|PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+}
+
+void munmapForLinker (void *addr, size_t bytes, const char *caller)
+{
+ int r = munmap(addr, bytes);
+ if (r == -1) {
+ // Should we abort here?
+ sysErrorBelch("munmap: %s", caller);
+ }
+}
+
/* Note [Memory protection in the linker]
* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* For many years the linker would simply map all of its memory
@@ -1230,7 +1281,7 @@ freePreloadObjectFile (ObjectCode *oc)
#else
if (RTS_LINKER_USE_MMAP && oc->imageMapped) {
- munmap(oc->image, oc->fileSize);
+ munmapForLinker(oc->image, oc->fileSize, "freePreloadObjectFile");
}
else {
stgFree(oc->image);
@@ -1278,13 +1329,15 @@ void freeObjectCode (ObjectCode *oc)
switch(oc->sections[i].alloc){
#if RTS_LINKER_USE_MMAP
case SECTION_MMAP:
- munmap(oc->sections[i].mapped_start,
- oc->sections[i].mapped_size);
+ munmapForLinker(
+ oc->sections[i].mapped_start,
+ oc->sections[i].mapped_size,
+ "freeObjectCode");
break;
+#endif
case SECTION_M32:
// Freed by m32_allocator_free
break;
-#endif
case SECTION_MALLOC:
IF_DEBUG(zero_on_gc,
memset(oc->sections[i].start,
@@ -1327,7 +1380,7 @@ void freeObjectCode (ObjectCode *oc)
ocDeinit_ELF(oc);
#endif
-#if RTS_LINKER_USE_MMAP == 1
+#if defined(NEED_M32)
m32_allocator_free(oc->rx_m32);
m32_allocator_free(oc->rw_m32);
#endif
@@ -1405,7 +1458,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize,
oc->mark = object_code_mark_bit;
oc->dependencies = allocHashSet();
-#if RTS_LINKER_USE_MMAP
+#if defined(NEED_M32)
oc->rw_m32 = m32_allocator_new(false);
oc->rx_m32 = m32_allocator_new(true);
#endif
@@ -1742,7 +1795,7 @@ int ocTryLoad (ObjectCode* oc) {
// We have finished loading and relocating; flush the m32 allocators to
// setup page protections.
-#if RTS_LINKER_USE_MMAP
+#if defined(NEED_M32)
m32_allocator_flush(oc->rx_m32);
m32_allocator_flush(oc->rw_m32);
#endif
@@ -2168,7 +2221,7 @@ void freeSegments (ObjectCode *oc)
continue;
} else {
#if RTS_LINKER_USE_MMAP
- CHECKM(0 == munmap(s->start, s->size), "freeSegments: failed to unmap memory");
+ munmapForLinker(s->start, s->size, "freeSegments");
#else
stgFree(s->start);
#endif
=====================================
rts/LinkerInternals.h
=====================================
@@ -145,6 +145,14 @@ typedef struct _Segment {
#define NEED_SYMBOL_EXTRAS 1
#endif
+/*
+ * We use the m32 allocator for symbol extras on Windows and other mmap-using
+ * platforms.
+ */
+#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_ARCH)
+#define NEED_M32 1
+#endif
+
/* Jump Islands are sniplets of machine code required for relative
* address relocations on the PowerPC, x86_64 and ARM.
*/
@@ -276,7 +284,7 @@ typedef struct _ObjectCode {
require extra information.*/
StrHashTable *extraInfos;
-#if RTS_LINKER_USE_MMAP == 1
+#if defined(NEED_M32)
/* The m32 allocators used for allocating small sections and symbol extras
* during loading. We have two: one for (writeable) data and one for
* (read-only/executable) code. */
@@ -334,8 +342,10 @@ void exitLinker( void );
void freeObjectCode (ObjectCode *oc);
SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo);
+void *mmapAnonForLinker (size_t bytes);
void *mmapForLinker (size_t bytes, uint32_t prot, uint32_t flags, int fd, int offset);
void mmapForLinkerMarkExecutable (void *start, size_t len);
+void munmapForLinker (void *addr, size_t bytes, const char *caller);
void addProddableBlock ( ObjectCode* oc, void* start, int size );
void checkProddableBlock (ObjectCode *oc, void *addr, size_t size );
=====================================
rts/linker/Elf.c
=====================================
@@ -25,6 +25,7 @@
#include "linker/elf_util.h"
#include <stdlib.h>
+#include <unistd.h>
#include <string.h>
#if defined(HAVE_SYS_STAT_H)
#include <sys/stat.h>
@@ -709,7 +710,11 @@ ocGetNames_ELF ( ObjectCode* oc )
* address might be out of range for sections that are mmaped.
*/
alloc = SECTION_MMAP;
- start = mmapForLinker(size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+ start = mmapAnonForLinker(size);
+ if (start == NULL) {
+ barf("failed to mmap memory for bss. "
+ "errno = %d", errno);
+ }
mapped_start = start;
mapped_offset = 0;
mapped_size = roundUpToPage(size);
@@ -751,9 +756,9 @@ ocGetNames_ELF ( ObjectCode* oc )
unsigned nstubs = numberOfStubsForSection(oc, i);
unsigned stub_space = STUB_SIZE * nstubs;
- void * mem = mmapForLinker(size+stub_space, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0);
+ void * mem = mmapAnonForLinker(size+stub_space);
- if( mem == MAP_FAILED ) {
+ if( mem == NULL ) {
barf("failed to mmap allocated memory to load section %d. "
"errno = %d", i, errno);
}
@@ -855,11 +860,10 @@ ocGetNames_ELF ( ObjectCode* oc )
}
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);
+ common_mem = mmapAnonForLinker(common_size);
+ if (common_mem == NULL) {
+ barf("ocGetNames_ELF: Failed to allocate memory for SHN_COMMONs");
+ }
}
//TODO: we ignore local symbols anyway right? So we can use the
=====================================
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, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+ image = mmapAnonForLinker(memberSize);
else {
/* See loadObj() */
misalignment = machoGetMisalignment(f);
@@ -549,7 +549,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, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+ gnuFileIndex = mmapAnonForLinker(memberSize + 1);
#else
gnuFileIndex = stgMallocBytes(memberSize + 1, "loadArchive(image)");
#endif
@@ -613,7 +613,7 @@ fail:
stgFree(fileName);
if (gnuFileIndex != NULL) {
#if RTS_LINKER_USE_MMAP
- munmap(gnuFileIndex, gnuFileIndexSize + 1);
+ munmapForLinker(gnuFileIndex, gnuFileIndexSize + 1, "loadArchive_");
#else
stgFree(gnuFileIndex);
#endif
=====================================
rts/linker/M32Alloc.c
=====================================
@@ -42,7 +42,7 @@ still check the call for syntax and correct function parameter types.
*/
-#if RTS_LINKER_USE_MMAP == 1
+#if defined(NEED_M32)
/*
@@ -216,25 +216,6 @@ struct m32_page_t *m32_free_page_pool = NULL;
unsigned int m32_free_page_pool_size = 0;
// TODO
-/**
- * Wrapper for `unmap` that handles error cases.
- * This is the real implementation. There is another dummy implementation below.
- * See the note titled "Compile Time Trickery" at the top of this file.
- */
-static void
-munmapForLinker (void * addr, size_t size)
-{
- IF_DEBUG(linker,
- debugBelch("m32_alloc: Unmapping %zu bytes at %p\n",
- size, addr));
-
- int r = munmap(addr,size);
- if (r == -1) {
- // Should we abort here?
- sysErrorBelch("munmap");
- }
-}
-
/**
* Free a page or, if possible, place it in the free page pool.
*/
@@ -246,7 +227,7 @@ m32_release_page(struct m32_page_t *page)
m32_free_page_pool = page;
m32_free_page_pool_size ++;
} else {
- munmapForLinker((void *) page, getPageSize());
+ munmapForLinker((void *) page, getPageSize(), "m32_release_page");
}
}
@@ -263,7 +244,7 @@ m32_alloc_page(void)
* pages.
*/
const size_t pgsz = getPageSize();
- char *chunk = mmapForLinker(pgsz * M32_MAP_PAGES, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+ char *chunk = mmapAnonForLinker(pgsz * M32_MAP_PAGES);
if (chunk > (char *) 0xffffffff) {
barf("m32_alloc_page: failed to get allocation in lower 32-bits");
}
@@ -309,7 +290,7 @@ m32_allocator_unmap_list(struct m32_page_t *head)
{
while (head != NULL) {
struct m32_page_t *next = m32_filled_page_get_next(head);
- munmapForLinker((void *) head, head->filled_page.size);
+ munmapForLinker((void *) head, head->filled_page.size, "m32_allocator_unmap_list");
head = next;
}
}
@@ -327,7 +308,7 @@ void m32_allocator_free(m32_allocator *alloc)
const size_t pgsz = getPageSize();
for (int i=0; i < M32_MAX_PAGES; i++) {
if (alloc->pages[i]) {
- munmapForLinker(alloc->pages[i], pgsz);
+ munmapForLinker(alloc->pages[i], pgsz, "m32_allocator_free");
}
}
@@ -407,7 +388,14 @@ 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, PROT_READ | PROT_WRITE, MAP_ANONYMOUS,-1,0);
+ struct m32_page_t *page = mmapAnonForLinker(alsize+size);
+ if (page == NULL) {
+ sysErrorBelch("m32_alloc: Failed to map pages for %zd bytes", size);
+ return NULL;
+ } else if (page > (struct m32_page_t *) 0xffffffff) {
+ debugBelch("m32_alloc: warning: Allocation of %zd bytes resulted in pages above 4GB (%p)",
+ size, page);
+ }
page->filled_page.size = alsize + size;
m32_allocator_push_filled_list(&alloc->unprotected_list, (struct m32_page_t *) page);
return (char*) page + alsize;
@@ -460,7 +448,7 @@ m32_alloc(struct m32_allocator_t *alloc, size_t size, size_t alignment)
return (char*)page + ROUND_UP(sizeof(struct m32_page_t),alignment);
}
-#elif RTS_LINKER_USE_MMAP == 0
+#else
// The following implementations of these functions should never be called. If
// they are, there is a bug at the call site.
@@ -491,8 +479,4 @@ m32_alloc(m32_allocator *alloc STG_UNUSED,
barf("%s: RTS_LINKER_USE_MMAP is %d", __func__, RTS_LINKER_USE_MMAP);
}
-#else
-
-#error RTS_LINKER_USE_MMAP should be either `0` or `1`.
-
#endif
=====================================
rts/linker/M32Alloc.h
=====================================
@@ -8,19 +8,17 @@
#pragma once
-#if RTS_LINKER_USE_MMAP == 1
-#include <fcntl.h>
-#include <sys/mman.h>
-
-#if defined(HAVE_UNISTD_H)
-#include <unistd.h>
-#endif
-
+/*
+ * We use the m32 allocator for symbol extras on Windows and other mmap-using
+ * platforms.
+ */
+#if RTS_LINKER_USE_MMAP || defined(mingw32_HOST_OS)
+#define NEED_M32 1
#endif
#include "BeginPrivate.h"
-#if RTS_LINKER_USE_MMAP
+#if defined(NEED_M32)
#define M32_NO_RETURN /* Nothing */
#else
#define M32_NO_RETURN GNUC3_ATTRIBUTE(__noreturn__)
=====================================
rts/linker/MachO.c
=====================================
@@ -508,11 +508,8 @@ makeGot(ObjectCode * oc) {
if(got_slots > 0) {
oc->info->got_size = got_slots * sizeof(void*);
- oc->info->got_start = mmapForLinker(oc->info->got_size,
- PROT_READ | PROT_WRITE,
- MAP_ANON | MAP_PRIVATE,
- -1, 0);
- if( oc->info->got_start == MAP_FAILED ) {
+ oc->info->got_start = mmapAnonForLinker(oc->info->got_size);
+ if( oc->info->got_start == NULL ) {
barf("MAP_FAILED. errno=%d", errno );
return EXIT_FAILURE;
}
@@ -529,7 +526,7 @@ makeGot(ObjectCode * oc) {
void
freeGot(ObjectCode * oc) {
- munmap(oc->info->got_start, oc->info->got_size);
+ munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot");
oc->info->got_start = NULL;
oc->info->got_size = 0;
}
@@ -1114,7 +1111,7 @@ ocBuildSegments_MachO(ObjectCode *oc)
return 1;
}
- mem = mmapForLinker(size_compound, PROT_READ | PROT_WRITE, MAP_ANON, -1, 0);
+ mem = mmapAnonForLinker(size_compound);
if (NULL == mem) return 0;
IF_DEBUG(linker, debugBelch("ocBuildSegments: allocating %d segments\n", n_activeSegments));
=====================================
rts/linker/PEi386.c
=====================================
@@ -1788,42 +1788,28 @@ ocGetNames_PEi386 ( ObjectCode* oc )
bool
ocAllocateExtras_PEi386 ( ObjectCode* oc )
{
- /* If the ObjectCode was unloaded we don't need a trampoline, it's likely
- an import library so we're discarding it earlier. */
- if (!oc->info)
- return false;
+ /* If the ObjectCode was unloaded we don't need a trampoline, it's likely
+ an import library so we're discarding it earlier. */
+ if (!oc->info)
+ return false;
- const int mask = default_alignment - 1;
- size_t origin = oc->info->trampoline;
- oc->symbol_extras
- = (SymbolExtra*)((uintptr_t)(oc->info->image + origin + mask) & ~mask);
- oc->first_symbol_extra = 0;
- COFF_HEADER_INFO *info = oc->info->ch_info;
- oc->n_symbol_extras = info->numberOfSymbols;
+ // These are allocated on-demand from m32 by makeSymbolExtra_PEi386
+ oc->first_symbol_extra = 0;
+ oc->n_symbol_extras = 0;
+ oc->symbol_extras = NULL;
- return true;
+ return true;
}
static size_t
-makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index, size_t s, char* symbol )
+makeSymbolExtra_PEi386( ObjectCode* oc, uint64_t index STG_UNUSED, size_t s, char* symbol STG_UNUSED )
{
- unsigned int curr_thunk;
- SymbolExtra *extra;
- curr_thunk = oc->first_symbol_extra + index;
- if (index >= oc->n_symbol_extras) {
- IF_DEBUG(linker, debugBelch("makeSymbolExtra first:%d, num:%lu, member:%" PATH_FMT ", index:%llu\n", curr_thunk, oc->n_symbol_extras, oc->archiveMemberName, index));
- barf("Can't allocate thunk for `%s' in `%" PATH_FMT "' with member `%" PATH_FMT "'", symbol, oc->fileName, oc->archiveMemberName);
- }
-
- extra = oc->symbol_extras + curr_thunk;
+ SymbolExtra *extra = m32_alloc(oc->rx_m32, sizeof(SymbolExtra), 8);
- if (!extra->addr)
- {
- // jmp *-14(%rip)
- static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
- extra->addr = (uint64_t)s;
- memcpy(extra->jumpIsland, jmp, 6);
- }
+ // jmp *-14(%rip)
+ static uint8_t jmp[] = { 0xFF, 0x25, 0xF2, 0xFF, 0xFF, 0xFF };
+ extra->addr = (uint64_t)s;
+ memcpy(extra->jumpIsland, jmp, 6);
return (size_t)extra->jumpIsland;
}
=====================================
rts/linker/SymbolExtras.c
=====================================
@@ -81,11 +81,11 @@ int ocAllocateExtras(ObjectCode* oc, int count, int first, int bssSize)
// symbol_extras is aligned to a page boundary so it can be mprotect'd.
bssSize = roundUpToPage(bssSize);
size_t allocated_size = n + bssSize + extras_size;
- void *new = mmapForLinker(allocated_size, PROT_READ | PROT_WRITE, MAP_ANONYMOUS, -1, 0);
+ void *new = mmapAnonForLinker(allocated_size);
if (new) {
memcpy(new, oc->image, oc->fileSize);
if (oc->imageMapped) {
- munmap(oc->image, n);
+ munmapForLinker(oc->image, n, "ocAllocateExtras");
}
oc->image = new;
oc->imageMapped = true;
=====================================
rts/linker/elf_got.c
=====================================
@@ -48,11 +48,8 @@ makeGot(ObjectCode * oc) {
}
if(got_slots > 0) {
oc->info->got_size = got_slots * sizeof(void *);
- void * mem = mmapForLinker(oc->info->got_size,
- PROT_READ | PROT_WRITE,
- MAP_ANON | MAP_PRIVATE,
- -1, 0);
- if (mem == MAP_FAILED) {
+ void * mem = mmapAnonForLinker(oc->info->got_size);
+ if (mem == NULL) {
errorBelch("MAP_FAILED. errno=%d", errno);
return EXIT_FAILURE;
}
@@ -147,7 +144,7 @@ verifyGot(ObjectCode * oc) {
void
freeGot(ObjectCode * oc) {
-// munmap(oc->info->got_start, oc->info->got_size);
+// munmapForLinker(oc->info->got_start, oc->info->got_size, "freeGot);
oc->info->got_start = 0x0;
oc->info->got_size = 0;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cd87229f71c639f2f8b1217c22c92b8bcb18d7a...267c1245823d18567e00663c10c0afd92e5b3977
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cd87229f71c639f2f8b1217c22c92b8bcb18d7a...267c1245823d18567e00663c10c0afd92e5b3977
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/20201123/624e6739/attachment-0001.html>
More information about the ghc-commits
mailing list