[commit: ghc] master: Fix x86 Windows build and testsuite (b82f71b)
git at git.haskell.org
git at git.haskell.org
Tue Dec 6 07:01:35 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b82f71b96660400b4b9fa7f3ccef9df7532bb2d7/ghc
>---------------------------------------------------------------
commit b82f71b96660400b4b9fa7f3ccef9df7532bb2d7
Author: Tamar Christina <tamar at zhox.com>
Date: Mon Dec 5 21:27:23 2016 +0000
Fix x86 Windows build and testsuite
Summary:
Fix issues preventing x86 GHC to build on Windows and
fix segfault in the testsuite.
Test Plan: ./validate
Reviewers: austin, erikd, simonmar, bgamari
Reviewed By: bgamari
Subscribers: #ghc_windows_task_force, thomie
Differential Revision: https://phabricator.haskell.org/D2789
>---------------------------------------------------------------
b82f71b96660400b4b9fa7f3ccef9df7532bb2d7
rts/linker/PEi386.c | 2 ++
rts/posix/OSMem.c | 2 +-
rts/sm/OSMem.h | 2 +-
rts/win32/OSMem.c | 6 +++---
rts/win32/OSThreads.c | 18 +++++++++---------
testsuite/timeout/WinCBindings.hsc | 3 ++-
6 files changed, 18 insertions(+), 15 deletions(-)
diff --git a/rts/linker/PEi386.c b/rts/linker/PEi386.c
index 5eaa35a..b7db10b 100644
--- a/rts/linker/PEi386.c
+++ b/rts/linker/PEi386.c
@@ -68,10 +68,12 @@ static UChar *cstring_from_COFF_symbol_name(
UChar* name,
UChar* strtab);
+#if defined(x86_64_HOST_ARCH)
static size_t makeSymbolExtra_PEi386(
ObjectCode* oc,
size_t s,
char* symbol);
+#endif
static void addDLLHandle(
pathchar* dll_name,
diff --git a/rts/posix/OSMem.c b/rts/posix/OSMem.c
index beffeda..dcf734f 100644
--- a/rts/posix/OSMem.c
+++ b/rts/posix/OSMem.c
@@ -593,7 +593,7 @@ uint32_t osNumaNodes(void)
#endif
}
-StgWord osNumaMask(void)
+uint64_t osNumaMask(void)
{
#if HAVE_LIBNUMA
struct bitmask *mask;
diff --git a/rts/sm/OSMem.h b/rts/sm/OSMem.h
index f6f9559..4d158df 100644
--- a/rts/sm/OSMem.h
+++ b/rts/sm/OSMem.h
@@ -21,7 +21,7 @@ StgWord64 getPhysicalMemorySize (void);
void setExecutable (void *p, W_ len, bool exec);
bool osNumaAvailable(void);
uint32_t osNumaNodes(void);
-StgWord osNumaMask(void);
+uint64_t osNumaMask(void);
void osBindMBlocksToNode(void *addr, StgWord size, uint32_t node);
INLINE_HEADER size_t
diff --git a/rts/win32/OSMem.c b/rts/win32/OSMem.c
index b6b97a7..2a54235 100644
--- a/rts/win32/OSMem.c
+++ b/rts/win32/OSMem.c
@@ -518,9 +518,9 @@ uint32_t osNumaNodes(void)
return numNumaNodes;
}
-StgWord osNumaMask(void)
+uint64_t osNumaMask(void)
{
- StgWord numaMask;
+ uint64_t numaMask;
if (!GetNumaNodeProcessorMask(0, &numaMask))
{
return 1;
@@ -561,7 +561,7 @@ void osBindMBlocksToNode(
}
else {
sysErrorBelch(
- "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %llu bytes "
+ "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %" FMT_Word " bytes "
"at address %p bytes failed",
size, addr);
}
diff --git a/rts/win32/OSThreads.c b/rts/win32/OSThreads.c
index 652ba13..d2f867c 100644
--- a/rts/win32/OSThreads.c
+++ b/rts/win32/OSThreads.c
@@ -328,6 +328,7 @@ getNumberOfProcessorsGroups (void)
return n_groups;
}
+#if x86_64_HOST_ARCH
static uint8_t*
getProcessorsDistribution (void)
{
@@ -342,7 +343,6 @@ getProcessorsDistribution (void)
cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t));
memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t));
-#if x86_64_HOST_ARCH
/* We still support Windows Vista. Which means we can't rely
on the API being available. So we'll have to resolve manually. */
HMODULE kernel = GetModuleHandleW(L"kernel32");
@@ -357,11 +357,11 @@ getProcessorsDistribution (void)
IF_DEBUG(scheduler, debugBelch("[*] Number of active processors in group %u detected: %u\n", i, cpuGroupDistCache[i]));
}
}
-#endif
}
return cpuGroupDistCache;
}
+#endif
static uint32_t*
getProcessorsCumulativeSum(void)
@@ -376,10 +376,10 @@ getProcessorsCumulativeSum(void)
uint8_t n_groups = getNumberOfProcessorsGroups();
cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t));
memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t));
- uint8_t* proc_dist = getProcessorsDistribution();
- uint32_t cum_num_proc = 0;
#if x86_64_HOST_ARCH
+ uint8_t* proc_dist = getProcessorsDistribution();
+ uint32_t cum_num_proc = 0;
for (int i = 0; i < n_groups; i++)
{
cpuGroupCumulativeCache[i] = cum_num_proc;
@@ -593,11 +593,11 @@ void releaseThreadNode (void)
{
if (osNumaAvailable())
{
- StgWord processMask;
- StgWord systemMask;
+ PDWORD_PTR processMask = NULL;
+ PDWORD_PTR systemMask = NULL;
if (!GetProcessAffinityMask(GetCurrentProcess(),
- &processMask,
- &systemMask))
+ processMask,
+ systemMask))
{
sysErrorBelch(
"releaseThreadNode: Error resetting affinity of thread: %lu",
@@ -605,7 +605,7 @@ void releaseThreadNode (void)
stg_exit(EXIT_FAILURE);
}
- if (!SetThreadAffinityMask(GetCurrentThread(), processMask))
+ if (!SetThreadAffinityMask(GetCurrentThread(), *processMask))
{
sysErrorBelch(
"releaseThreadNode: Error reseting NUMA affinity mask of thread: %lu.",
diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc
index 87e4341..d9c08ee 100644
--- a/testsuite/timeout/WinCBindings.hsc
+++ b/testsuite/timeout/WinCBindings.hsc
@@ -314,7 +314,7 @@ foreign import WINDOWS_CCONV unsafe "windows.h CreateProcessW"
-> BOOL -> DWORD -> LPVOID -> LPCTSTR -> LPSTARTUPINFO
-> LPPROCESS_INFORMATION -> IO BOOL
-foreign import WINDOWS_CCONV unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
+foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)
foreign import WINDOWS_CCONV unsafe "windows.h SetInformationJobObject"
setInformationJobObject :: HANDLE -> JOBOBJECTINFOCLASS -> LPVOID -> DWORD -> IO BOOL
@@ -328,6 +328,7 @@ foreign import WINDOWS_CCONV unsafe "windows.h GetQueuedCompletionStatus"
setJobParameters :: HANDLE -> IO BOOL
setJobParameters hJob = alloca $ \p_jeli -> do
let jeliSize = sizeOf (undefined :: JOBOBJECT_EXTENDED_LIMIT_INFORMATION)
+
_ <- memset p_jeli 0 $ fromIntegral jeliSize
-- Configure all child processes associated with the job to terminate when the
-- Last process in the job terminates. This prevent half dead processes and that
More information about the ghc-commits
mailing list