[Git][ghc/ghc][wip/T24603] Support for ARM64 Windows (LLVM-enabled) (fixes #24603)
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Tue Jan 28 14:43:53 UTC 2025
Serge S. Gulin pushed to branch wip/T24603 at Glasgow Haskell Compiler / GHC
Commits:
1e528596 by Serge S. Gulin at 2025-01-28T17:42:51+03:00
Support for ARM64 Windows (LLVM-enabled) (fixes #24603)
submodule
Co-authored-by: Cheng Shao <terrorjack at type.dance>
Co-authored-by: Dmitrii Egorov <egorov.d.i at icloud.com>
Co-authored-by: Andrei Borzenkov <root at sandwitch.dev>
- - - - -
17 changed files:
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs
- hadrian/cabal.project
- libraries/Cabal
- libraries/Win32
- libraries/base/src/System/CPUTime/Windows.hsc
- libraries/base/tests/perf/encodingAllocations.hs
- libraries/directory
- libraries/haskeline
- libraries/process
- libraries/unix
- llvm-targets
- m4/ghc_tables_next_to_code.m4
- rts/StgCRun.c
- rts/win32/veh_excn.c
- utils/hsc2hs
- utils/llvm-targets/gen-data-layout.sh
Changes:
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE CPP #-}
module GHC.CmmToAsm.AArch64.Instr
@@ -217,7 +218,11 @@ regUsageOfInstr platform instr = case instr of
-- TODO: The zero register is currently mapped to -1 but should get it's own separate number.
callerSavedRegisters :: [Reg]
callerSavedRegisters
+#if defined(mingw32_HOST_OS)
+ = map regSingle [0..17]
+#else
= map regSingle [0..18]
+#endif
++ map regSingle [32..39]
++ map regSingle [48..63]
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs
=====================================
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
module GHC.CmmToAsm.Reg.Linear.AArch64 where
import GHC.Prelude
@@ -118,7 +120,11 @@ getFreeRegs :: RegClass -> FreeRegs -> [RealReg]
getFreeRegs cls (FreeRegs g f) =
case cls of
RcFloatOrVector -> go 32 f 31
+#if defined(mingw32_HOST_OS)
+ RcInteger -> go 0 g 17
+#else
RcInteger -> go 0 g 18
+#endif
where
go _ _ i | i < 0 = []
go off x i | testBit x i = RealRegSingle (off + i) : (go off x $! i - 1)
=====================================
hadrian/cabal.project
=====================================
@@ -8,7 +8,7 @@ index-state: 2024-10-30T22:56:00Z
-- unordered-containers-0.2.20-r1 requires template-haskell < 2.22
-- ghc-9.10 has template-haskell-2.22.0.0
-allow-newer: unordered-containers:template-haskell
+allow-newer: unordered-containers:template-haskell, splitmix:base, hashable:base, cryptohash-sha256:base
-- N.B. Compile with -O0 since this is not a performance-critical executable
-- and the Cabal takes nearly twice as long to build with -O1. See #16817.
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 269fd808e5d80223a229b6b19edfe6f5b109007a
+Subproject commit 682c54a9e8127c79e714545dbf493bb5de470945
=====================================
libraries/Win32
=====================================
@@ -1 +1 @@
-Subproject commit 027cbcf0de25d681823ea92fb545a2604c3a6a8b
+Subproject commit f340d2c3d846fce73117dd2548ad1bf0c56ceb9d
=====================================
libraries/base/src/System/CPUTime/Windows.hsc
=====================================
@@ -60,7 +60,7 @@ type HANDLE = ()
#if defined(i386_HOST_ARCH)
foreign import stdcall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE)
foreign import stdcall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt
-#elif defined(x86_64_HOST_ARCH)
+#elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH)
foreign import ccall unsafe "GetCurrentProcess" getCurrentProcess :: IO (Ptr HANDLE)
foreign import ccall unsafe "GetProcessTimes" getProcessTimes :: Ptr HANDLE -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> Ptr FILETIME -> IO CInt
#else
=====================================
libraries/base/tests/perf/encodingAllocations.hs
=====================================
@@ -13,13 +13,13 @@ import Distribution.Simple.Utils
main :: IO ()
-main = withTempFile "." "encodingAllocations.tmp" (const $ loop 1000000)
+main = withTempFile "encodingAllocations.tmp" (loop 1000000)
-loop :: Int -> Handle -> IO ()
-loop 0 !_ = pure ()
-loop !n !h = do
+loop :: Int -> FilePath -> Handle -> IO ()
+loop 0 !_ !_ = pure ()
+loop !n !fp !h = do
hPutChar h $! dummy_char n
- loop (n-1) h
+ loop (n-1) fp h
-- unsafe efficient version of `chr`
my_chr :: Int -> Char
=====================================
libraries/directory
=====================================
@@ -1 +1 @@
-Subproject commit 005fa061171a55d35ce8dfe936cf3703525a8616
+Subproject commit eb40bbebcaf86153bbc60772fb2e0466d35c95c4
=====================================
libraries/haskeline
=====================================
@@ -1 +1 @@
-Subproject commit 5f4bf62bf1f4846ad0b8d1fa9d45f902e3934511
+Subproject commit 5f1a790a5db1cb3708d105d4f532c32fcbeb4296
=====================================
libraries/process
=====================================
@@ -1 +1 @@
-Subproject commit 9c3bfc214c72bbd0c8a30a1c41465deed0feaf47
+Subproject commit fbbe60718736999db701c12528c85cbc605ab4fb
=====================================
libraries/unix
=====================================
@@ -1 +1 @@
-Subproject commit 74ae1c0d9dd1518434f7d6cd3e63d7769599e0f9
+Subproject commit 9208d3a5809476e64b9a387a6000821083d1ebfd
=====================================
llvm-targets
=====================================
@@ -1,4 +1,5 @@
[("x86_64-unknown-windows-gnu", ("e-m:w-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
+,("aarch64-unknown-windows-gnu", ("e-m:w-p:64:64-i32:32-i64:64-i128:128-n32:64-S128-Fn32", "generic", "+v8a +fp-armv8 +neon"))
,("arm-unknown-linux-gnueabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm7tdmi", "+strict-align"))
,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))
,("arm-unknown-linux-musleabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align"))
=====================================
m4/ghc_tables_next_to_code.m4
=====================================
@@ -22,8 +22,13 @@ AC_DEFUN([GHC_TABLES_NEXT_TO_CODE],
AC_MSG_RESULT([no])
;;
*)
- TablesNextToCodeDefault=YES
- AC_MSG_RESULT([yes])
+ if test "$TargetOS" = "mingw32" && test "$TargetArch" = "aarch64"; then
+ TablesNextToCodeDefault=NO
+ AC_MSG_RESULT([no])
+ else
+ TablesNextToCodeDefault=YES
+ AC_MSG_RESULT([yes])
+ fi
;;
esac
;;
=====================================
rts/StgCRun.c
=====================================
@@ -863,8 +863,12 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
*/
"br %1\n\t"
+#if defined(mingw32_HOST_OS)
+ ".globl " STG_RETURN "\n"
+#else
".globl " STG_RETURN "\n\t"
-#if !defined(ios_HOST_OS) && !defined(darwin_HOST_OS)
+#endif
+#if !defined(ios_HOST_OS) && !defined(darwin_HOST_OS) && !defined(mingw32_HOST_OS)
".type " STG_RETURN ", %%function\n"
#endif
STG_RETURN ":\n\t"
=====================================
rts/win32/veh_excn.c
=====================================
@@ -287,6 +287,16 @@ void generateStack (EXCEPTION_POINTERS* pExceptionPointers)
stackFrame.AddrStack.Offset = context->Rsp;
stackFrame.AddrStack.Mode = AddrModeFlat;
+#elif defined(aarch64_HOST_ARCH)
+ machineType = IMAGE_FILE_MACHINE_ARM64;
+ stackFrame.AddrPC.Offset = context->Pc;
+ stackFrame.AddrPC.Mode = AddrModeFlat;
+
+ stackFrame.AddrFrame.Offset = context->Fp;
+ stackFrame.AddrFrame.Mode = AddrModeFlat;
+
+ stackFrame.AddrStack.Offset = context->Sp;
+ stackFrame.AddrStack.Mode = AddrModeFlat;
#endif
fprintf (stderr, "\n Attempting to reconstruct a stack trace...\n\n");
if (!SymInitialize (GetCurrentProcess (), NULL, true))
=====================================
utils/hsc2hs
=====================================
@@ -1 +1 @@
-Subproject commit c3b21800a67366c9591dc85a471d1dfdb1efcf29
+Subproject commit 2fab2f4cdffef12afe561ef03f5ebdace7dbae67
=====================================
utils/llvm-targets/gen-data-layout.sh
=====================================
@@ -27,6 +27,7 @@ TARGETS=(
# Windows
"x86_64-unknown-windows-gnu"
+ "aarch64-unknown-windows-gnu"
#########################
# Linux
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e5285963863bac9191ddf7e5f247b2d60699601
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e5285963863bac9191ddf7e5f247b2d60699601
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/20250128/b4b50082/attachment-0001.html>
More information about the ghc-commits
mailing list