Commit b82f71b9 authored by Tamar Christina's avatar Tamar Christina

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
parent 847d2293
......@@ -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,
......
......@@ -593,7 +593,7 @@ uint32_t osNumaNodes(void)
#endif
}
StgWord osNumaMask(void)
uint64_t osNumaMask(void)
{
#if HAVE_LIBNUMA
struct bitmask *mask;
......
......@@ -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
......
......@@ -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);
}
......
......@@ -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.",
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment