Fix x86 Windows build and testsuite
authorTamar Christina <tamar@zhox.com>
Mon, 5 Dec 2016 21:27:23 +0000 (21:27 +0000)
committerTamar Christina <tamar@zhox.com>
Tue, 6 Dec 2016 07:01:23 +0000 (07:01 +0000)
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

rts/linker/PEi386.c
rts/posix/OSMem.c
rts/sm/OSMem.h
rts/win32/OSMem.c
rts/win32/OSThreads.c
testsuite/timeout/WinCBindings.hsc

index 5eaa35a..b7db10b 100644 (file)
@@ -68,10 +68,12 @@ static UChar *cstring_from_COFF_symbol_name(
     UChar* name,
     UChar* strtab);
 
     UChar* name,
     UChar* strtab);
 
+#if defined(x86_64_HOST_ARCH)
 static size_t makeSymbolExtra_PEi386(
     ObjectCode* oc,
     size_t s,
     char* symbol);
 static size_t makeSymbolExtra_PEi386(
     ObjectCode* oc,
     size_t s,
     char* symbol);
+#endif
 
 static void addDLLHandle(
     pathchar* dll_name,
 
 static void addDLLHandle(
     pathchar* dll_name,
index beffeda..dcf734f 100644 (file)
@@ -593,7 +593,7 @@ uint32_t osNumaNodes(void)
 #endif
 }
 
 #endif
 }
 
-StgWord osNumaMask(void)
+uint64_t osNumaMask(void)
 {
 #if HAVE_LIBNUMA
     struct bitmask *mask;
 {
 #if HAVE_LIBNUMA
     struct bitmask *mask;
index f6f9559..4d158df 100644 (file)
@@ -21,7 +21,7 @@ StgWord64 getPhysicalMemorySize (void);
 void setExecutable (void *p, W_ len, bool exec);
 bool osNumaAvailable(void);
 uint32_t osNumaNodes(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
 void osBindMBlocksToNode(void *addr, StgWord size, uint32_t node);
 
 INLINE_HEADER size_t
index b6b97a7..2a54235 100644 (file)
@@ -518,9 +518,9 @@ uint32_t osNumaNodes(void)
     return numNumaNodes;
 }
 
     return numNumaNodes;
 }
 
-StgWord osNumaMask(void)
+uint64_t osNumaMask(void)
 {
 {
-    StgWord numaMask;
+    uint64_t numaMask;
     if (!GetNumaNodeProcessorMask(0, &numaMask))
     {
         return 1;
     if (!GetNumaNodeProcessorMask(0, &numaMask))
     {
         return 1;
@@ -561,7 +561,7 @@ void osBindMBlocksToNode(
                 }
                 else {
                     sysErrorBelch(
                 }
                 else {
                     sysErrorBelch(
-                        "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %llu bytes "
+                        "osBindMBlocksToNode: VirtualAllocExNuma MEM_RESERVE %" FMT_Word " bytes "
                         "at address %p bytes failed",
                                         size, addr);
                 }
                         "at address %p bytes failed",
                                         size, addr);
                 }
index 652ba13..d2f867c 100644 (file)
@@ -328,6 +328,7 @@ getNumberOfProcessorsGroups (void)
     return n_groups;
 }
 
     return n_groups;
 }
 
+#if x86_64_HOST_ARCH
 static uint8_t*
 getProcessorsDistribution (void)
 {
 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));
 
         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");
         /* 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]));
             }
         }
                 IF_DEBUG(scheduler, debugBelch("[*] Number of active processors in group %u detected: %u\n", i, cpuGroupDistCache[i]));
             }
         }
-#endif
     }
 
     return cpuGroupDistCache;
 }
     }
 
     return cpuGroupDistCache;
 }
+#endif
 
 static uint32_t*
 getProcessorsCumulativeSum(void)
 
 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 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
 
 #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;
         for (int i = 0; i < n_groups; i++)
         {
             cpuGroupCumulativeCache[i] = cum_num_proc;
@@ -593,11 +593,11 @@ void releaseThreadNode (void)
 {
     if (osNumaAvailable())
     {
 {
     if (osNumaAvailable())
     {
-        StgWord processMask;
-        StgWord systemMask;
+        PDWORD_PTR processMask = NULL;
+        PDWORD_PTR systemMask = NULL;
         if (!GetProcessAffinityMask(GetCurrentProcess(),
         if (!GetProcessAffinityMask(GetCurrentProcess(),
-                                   &processMask,
-                                   &systemMask))
+                                    processMask,
+                                    systemMask))
         {
             sysErrorBelch(
                 "releaseThreadNode: Error resetting affinity of thread: %lu",
         {
             sysErrorBelch(
                 "releaseThreadNode: Error resetting affinity of thread: %lu",
@@ -605,7 +605,7 @@ void releaseThreadNode (void)
             stg_exit(EXIT_FAILURE);
         }
 
             stg_exit(EXIT_FAILURE);
         }
 
-        if (!SetThreadAffinityMask(GetCurrentThread(), processMask))
+        if (!SetThreadAffinityMask(GetCurrentThread(), *processMask))
         {
             sysErrorBelch(
                 "releaseThreadNode: Error reseting NUMA affinity mask of thread: %lu.",
         {
             sysErrorBelch(
                 "releaseThreadNode: Error reseting NUMA affinity mask of thread: %lu.",
index 87e4341..d9c08ee 100644 (file)
@@ -314,7 +314,7 @@ foreign import WINDOWS_CCONV unsafe "windows.h CreateProcessW"
                    -> BOOL -> DWORD -> LPVOID -> LPCTSTR -> LPSTARTUPINFO
                    -> LPPROCESS_INFORMATION -> IO BOOL
 
                    -> 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
 
 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)
 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
     _ <- 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