[Git][ghc/ghc][wip/T24603] 4 commits: Fix for alex-3.5.2.0 (#25623)

Serge S. Gulin (@gulin.serge) gitlab at gitlab.haskell.org
Tue Jan 28 09:16:53 UTC 2025



Serge S. Gulin pushed to branch wip/T24603 at Glasgow Haskell Compiler / GHC


Commits:
a1d92378 by Brandon Chinn at 2025-01-25T15:11:54-08:00
Fix for alex-3.5.2.0 (#25623)

This INLINE pragma for alexScanUser was added in 9.12, but then I
ported the change to alex in 3.5.2.0
(https://github.com/haskell/alex/pull/262).

I didn't realize that GHC errors on duplicate INLINE pragmas, so
this ended up being a breaking change.

This change should be backported into 9.12

- - - - -
62760367 by ARATA Mizuki at 2025-01-27T16:23:06-05:00
x86 NCG: Make MOVD's output format explicit

The old design led to inference of a wrong format,
losing upper bits of a vector register.

Fixes #25659

Co-authored-by: sheaf <sam.derbyshire at gmail.com>

- - - - -
f19ab490 by Simon Hengel at 2025-01-27T16:23:45-05:00
doc: Correct JSON schema for `-fdiagnostics-as-json` (fixes #25393)

- - - - -
a414412d by Serge S. Gulin at 2025-01-28T12:16:22+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>

- - - - -


24 changed files:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Parser/Lexer.x
- docs/users_guide/diagnostics-as-json-schema-1_0.json
- docs/users_guide/diagnostics-as-json-schema-1_1.json
- 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
- + testsuite/tests/simd/should_run/T25659.hs
- + testsuite/tests/simd/should_run/T25659.stdout
- testsuite/tests/simd/should_run/all.T
- utils/hsc2hs
- utils/llvm-targets/gen-data-layout.sh


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1171,7 +1171,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
         bitcast :: Format -> Format -> CmmExpr -> NatM Register
         bitcast fmt rfmt expr =
           do (src, e_code) <- getSomeReg expr
-             let code = \dst -> e_code `snocOL` (MOVD fmt (OpReg src) (OpReg dst))
+             let code = \dst -> e_code `snocOL` (MOVD fmt rfmt (OpReg src) (OpReg dst))
              return (Any rfmt code)
 
         toI8Reg :: Width -> CmmExpr -> NatM Register
@@ -1262,7 +1262,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
               code dst = exp `snocOL`
                          -- VPBROADCAST from GPR requires AVX-512,
                          -- so we use an additional MOVD.
-                         (MOVD movFormat (OpReg reg) (OpReg dst)) `snocOL`
+                         (MOVD movFormat fmt (OpReg reg) (OpReg dst)) `snocOL`
                          (VPBROADCAST fmt fmt (OpReg dst) dst)
           return $ Any fmt code
 
@@ -1272,7 +1272,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
           (reg, exp) <- getNonClobberedReg expr
           let fmt = VecFormat 16 FmtInt8
           return $ Any fmt (\dst -> exp `snocOL`
-                                    (MOVD II32 (OpReg reg) (OpReg dst)) `snocOL`
+                                    (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL`
                                     (PUNPCKLBW fmt (OpReg dst) dst) `snocOL`
                                     (PUNPCKLWD (VecFormat 8 FmtInt16) (OpReg dst) dst) `snocOL`
                                     (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst)
@@ -1284,7 +1284,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
           (reg, exp) <- getNonClobberedReg expr
           let fmt = VecFormat 8 FmtInt16
           return $ Any fmt (\dst -> exp `snocOL`
-                                    (MOVD II32 (OpReg reg) (OpReg dst)) `snocOL`
+                                    (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL`
                                     (PUNPCKLWD fmt (OpReg dst) dst) `snocOL`
                                     (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst)
                                     )
@@ -1295,7 +1295,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
           (reg, exp) <- getNonClobberedReg expr
           let fmt = VecFormat 4 FmtInt32
           return $ Any fmt (\dst -> exp `snocOL`
-                                    (MOVD II32 (OpReg reg) (OpReg dst)) `snocOL`
+                                    (MOVD II32 fmt (OpReg reg) (OpReg dst)) `snocOL`
                                     (PSHUFD fmt (ImmInt 0x00) (OpReg dst) dst)
                                     )
 
@@ -1305,7 +1305,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
           (reg, exp) <- getNonClobberedReg expr
           let fmt = VecFormat 2 FmtInt64
           return $ Any fmt (\dst -> exp `snocOL`
-                                    (MOVD II64 (OpReg reg) (OpReg dst)) `snocOL`
+                                    (MOVD II64 fmt (OpReg reg) (OpReg dst)) `snocOL`
                                     (PUNPCKLQDQ fmt (OpReg dst) dst)
                                     )
 
@@ -1793,16 +1793,16 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
       let code dst =
             case i of
               0 -> exp `snocOL`
-                   (MOVD FF32 (OpReg r) (OpReg dst))
+                   (MOVD fmt II32 (OpReg r) (OpReg dst))
               1 -> exp `snocOL`
                    (PSHUFD fmt (ImmInt 0b01_01_01_01) (OpReg r) tmp) `snocOL` -- tmp <- (r[1],r[1],r[1],r[1])
-                   (MOVD FF32 (OpReg tmp) (OpReg dst))
+                   (MOVD fmt II32 (OpReg tmp) (OpReg dst))
               2 -> exp `snocOL`
                    (PSHUFD fmt (ImmInt 0b11_10_11_10) (OpReg r) tmp) `snocOL` -- tmp <- (r[2],r[3],r[2],r[3])
-                   (MOVD FF32 (OpReg tmp) (OpReg dst))
+                   (MOVD fmt II32 (OpReg tmp) (OpReg dst))
               _ -> exp `snocOL`
                    (PSHUFD fmt (ImmInt 0b11_11_11_11) (OpReg r) tmp) `snocOL` -- tmp <- (r[3],r[3],r[3],r[3])
-                   (MOVD FF32 (OpReg tmp) (OpReg dst))
+                   (MOVD fmt II32 (OpReg tmp) (OpReg dst))
       return (Any II32 code)
     vector_int32x4_extract_sse2 _ offset
       = pprPanic "Unsupported offset" (pdoc platform offset)
@@ -1818,10 +1818,10 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
       let code dst =
             case lit of
               CmmInt 0 _ -> exp `snocOL`
-                            (MOVD FF64 (OpReg r) (OpReg dst))
+                            (MOVD fmt II64 (OpReg r) (OpReg dst))
               CmmInt 1 _ -> exp `snocOL`
                             (MOVHLPS fmt r tmp) `snocOL`
-                            (MOVD FF64 (OpReg tmp) (OpReg dst))
+                            (MOVD fmt II64 (OpReg tmp) (OpReg dst))
               _          -> panic "Error in offset while unpacking"
       return (Any II64 code)
     vector_int64x2_extract_sse2 _ offset
@@ -2103,22 +2103,22 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
               = case offset of
                   0 -> valExp `appOL`
                        (vecCode dst) `snocOL`
-                       (MOVD II32 (OpReg valReg) (OpReg tmp1)) `snocOL`
+                       (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL`
                        (MOV floatVectorFormat (OpReg tmp1) (OpReg dst)) -- MOVSS; dst <- (tmp1[0],dst[1],dst[2],dst[3])
                   1 -> valExp `appOL`
                        (vecCode tmp1) `snocOL`
-                       (MOVD II32 (OpReg valReg) (OpReg dst)) `snocOL` -- dst <- (val,0,0,0)
+                       (MOVD II32 vectorFormat (OpReg valReg) (OpReg dst)) `snocOL` -- dst <- (val,0,0,0)
                        (PUNPCKLQDQ vectorFormat (OpReg tmp1) dst) `snocOL` -- dst <- (dst[0],dst[1],tmp1[0],tmp1[1])
                        (SHUF floatVectorFormat (ImmInt 0b11_10_00_10) (OpReg tmp1) dst) -- SHUFPS; dst <- (dst[2],dst[0],tmp1[2],tmp1[3])
                   2 -> valExp `appOL`
                        (vecCode dst) `snocOL`
-                       (MOVD II32 (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0)
+                       (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0)
                        (MOVU floatVectorFormat (OpReg dst) (OpReg tmp2)) `snocOL` -- MOVUPS; tmp2 <- dst
                        (SHUF floatVectorFormat (ImmInt 0b01_00_01_11) (OpReg tmp1) tmp2) `snocOL` -- SHUFPS; tmp2 <- (tmp2[3],tmp2[1],tmp1[0],tmp1[1])
                        (SHUF floatVectorFormat (ImmInt 0b00_10_01_00) (OpReg tmp2) dst) -- SHUFPS; dst <- (dst[0],dst[1],tmp2[2],tmp2[0])
                   _ -> valExp `appOL`
                        (vecCode dst) `snocOL`
-                       (MOVD II32 (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0)
+                       (MOVD II32 vectorFormat (OpReg valReg) (OpReg tmp1)) `snocOL` -- tmp1 <- (val,0,0,0)
                        (SHUF floatVectorFormat (ImmInt 0b11_10_01_00) (OpReg dst) tmp1) `snocOL` -- SHUFPS; tmp1 <- (tmp1[0],tmp1[1],dst[2],dst[3])
                        (SHUF floatVectorFormat (ImmInt 0b00_10_01_00) (OpReg tmp1) dst) -- SHUFPS; dst <- (dst[0],dst[1],tmp1[2],tmp1[0])
         return $ Any vectorFormat code
@@ -2139,12 +2139,12 @@ getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
                   CmmInt 0 _ -> valExp `appOL`
                                 vecExp `snocOL`
                                 (MOVHLPS fmt vecReg tmp) `snocOL`
-                                (MOVD II64 (OpReg valReg) (OpReg dst)) `snocOL`
+                                (MOVD II64 fmt (OpReg valReg) (OpReg dst)) `snocOL`
                                 (PUNPCKLQDQ fmt (OpReg tmp) dst)
                   CmmInt 1 _ -> valExp `appOL`
                                 vecExp `snocOL`
-                                (MOV II64 (OpReg vecReg) (OpReg dst)) `snocOL`
-                                (MOVD II64 (OpReg valReg) (OpReg tmp)) `snocOL`
+                                (MOVDQU fmt (OpReg vecReg) (OpReg dst)) `snocOL`
+                                (MOVD II64 fmt (OpReg valReg) (OpReg tmp)) `snocOL`
                                 (PUNPCKLQDQ fmt (OpReg tmp) dst)
                   _ -> pprPanic "MO_V_Insert Int64X2: unsupported offset" (ppr offset)
          in return $ Any fmt code
@@ -4083,7 +4083,7 @@ loadArgsWin config (arg:rest) = do
            -- arguments in both fp and integer registers.
            let (assign_code', regs')
                 | isFloatFormat arg_fmt =
-                    ( assign_code `snocOL` MOVD FF64 (OpReg freg) (OpReg ireg),
+                    ( assign_code `snocOL` MOVD FF64 II64 (OpReg freg) (OpReg ireg),
                       [ RegWithFormat freg FF64
                       , RegWithFormat ireg II64 ])
                 | otherwise = (assign_code, [RegWithFormat ireg II64])


=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -39,7 +39,6 @@ module GHC.CmmToAsm.X86.Instr
    , patchJumpInstr
    , isMetaInstr
    , isJumpishInstr
-   , movdOutFormat
    , MinOrMax(..), MinMaxType(..)
    )
 where
@@ -127,11 +126,16 @@ data Instr
              -- with @MOVABS@; we currently do not use this instruction in GHC.
              -- See https://stackoverflow.com/questions/52434073/whats-the-difference-between-the-x86-64-att-instructions-movq-and-movabsq.
 
-        | MOVD   Format Operand Operand -- ^ MOVD/MOVQ SSE2 instructions
-                                        -- (bitcast between a general purpose
-                                        -- register and a float register).
-                                        -- Format is input format, output format is
-                                        -- calculated in the 'movdOutFormat' function.
+        -- | MOVD/MOVQ SSE2 instructions
+        -- (bitcast between a general purpose register and a float register).
+        | MOVD
+           Format -- ^ input format
+           Format -- ^ output format
+           Operand Operand
+           -- NB: MOVD stores both the input and output formats. This is because
+           -- neither format fully determines the other, as either might be
+           -- a vector format, and we need to know the exact format in order to
+           -- correctly spill/unspill. See #25659.
         | CMOV   Cond Format Operand Reg
         | MOVZxL      Format Operand Operand
               -- ^ The format argument is the size of operand 1 (the number of bits we keep)
@@ -377,10 +381,10 @@ regUsageOfInstr platform instr
       -- (largely to avoid partial register stalls)
       | otherwise
       -> usageRW fmt src dst
-    MOVD   fmt src dst    ->
+    MOVD fmt1 fmt2 src dst    ->
       -- NB: MOVD and MOVQ always zero any remaining upper part of destination,
       -- so the destination is "written" not "modified".
-      usageRW' fmt (movdOutFormat fmt) src dst
+      usageRW' fmt1 fmt2 src dst
     CMOV _ fmt src dst    -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst]
     MOVZxL fmt src dst    -> usageRW fmt src dst
     MOVSxL fmt src dst    -> usageRW fmt src dst
@@ -650,14 +654,6 @@ interesting :: Platform -> Reg -> Bool
 interesting _        (RegVirtual _)              = True
 interesting platform (RegReal (RealRegSingle i)) = freeReg platform i
 
-movdOutFormat :: Format -> Format
-movdOutFormat format = case format of
-  II32 -> FF32
-  II64 -> FF64
-  FF32 -> II32
-  FF64 -> II64
-  _    -> pprPanic "X86: improper format for movd/movq" (ppr format)
-
 
 -- | Applies the supplied function to all registers in instructions.
 -- Typically used to change virtual registers to real registers.
@@ -665,7 +661,7 @@ patchRegsOfInstr :: HasDebugCallStack => Platform -> Instr -> (Reg -> Reg) -> In
 patchRegsOfInstr platform instr env
   = case instr of
     MOV fmt src dst      -> MOV fmt (patchOp src) (patchOp dst)
-    MOVD fmt src dst     -> patch2 (MOVD fmt) src dst
+    MOVD fmt1 fmt2 src dst -> patch2 (MOVD fmt1 fmt2) src dst
     CMOV cc fmt src dst  -> CMOV cc fmt (patchOp src) (env dst)
     MOVZxL fmt src dst   -> patch2 (MOVZxL fmt) src dst
     MOVSxL fmt src dst   -> patch2 (MOVSxL fmt) src dst


=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -657,8 +657,8 @@ pprInstr platform i = case i of
    CMOV cc format src dst
      -> pprCondOpReg (text "cmov") format cc src dst
 
-   MOVD format src dst
-     -> pprMovdOpOp (text "mov") format src dst
+   MOVD format1 format2 src dst
+     -> pprMovdOpOp (text "mov") format1 format2 src dst
 
    MOVZxL II32 src dst
       -> pprFormatOpOp (text "mov") II32 src dst
@@ -1151,21 +1151,21 @@ pprInstr platform i = case i of
            pprOperand platform format op2
        ]
 
-   pprMovdOpOp :: Line doc -> Format -> Operand -> Operand -> doc
-   pprMovdOpOp name format op1 op2
-     = let instr = case format of
+   pprMovdOpOp :: Line doc -> Format -> Format -> Operand -> Operand -> doc
+   pprMovdOpOp name format1 format2 op1 op2
+     = let instr = case (format1, format2) of
              -- bitcasts to/from a general purpose register to a floating point
              -- register require II32 or II64.
-             II32 -> text "d"
-             II64 -> text "q"
-             FF32 -> text "d"
-             FF64 -> text "q"
-             _    -> panic "X86.Ppr.pprMovdOpOp: improper format for movd/movq."
+             (II32, _) -> text "d"
+             (II64, _) -> text "q"
+             (_, II32) -> text "d"
+             (_, II64) -> text "q"
+             _ -> panic "X86.Ppr.pprMovdOpOp: improper format for movd/movq."
        in line $ hcat [
            char '\t' <> name <> instr <> space,
-           pprOperand platform format op1,
+           pprOperand platform format1 op1,
            comma,
-           pprOperand platform (movdOutFormat format) op2
+           pprOperand platform format2 op2
            ]
 
    pprFormatImmRegOp :: Line doc -> Format -> Imm -> Reg -> Operand -> doc


=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -41,6 +41,7 @@
 -- Alex "Haskell code fragment top"
 
 {
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
@@ -3366,11 +3367,15 @@ topNoLayoutContainsCommas [] = False
 topNoLayoutContainsCommas (ALRLayout _ _ : ls) = topNoLayoutContainsCommas ls
 topNoLayoutContainsCommas (ALRNoLayout b _ : _) = b
 
+#ifdef MIN_TOOL_VERSION_alex
+#if !MIN_TOOL_VERSION_alex(3,5,2)
 -- If the generated alexScan/alexScanUser functions are called multiple times
 -- in this file, alexScanUser gets broken out into a separate function and
 -- increases memory usage. Make sure GHC inlines this function and optimizes it.
 -- https://github.com/haskell/alex/pull/262
 {-# INLINE alexScanUser #-}
+#endif
+#endif
 
 lexToken :: P (PsLocated Token)
 lexToken = do


=====================================
docs/users_guide/diagnostics-as-json-schema-1_0.json
=====================================
@@ -13,7 +13,10 @@
       "type": "string"
     },
     "span": {
-      "$ref": "#/$defs/span"
+      "oneOf": [
+        { "$ref": "#/$defs/span" },
+        { "type": "null" }
+      ]
     },
     "severity": {
       "description": "The diagnostic severity",


=====================================
docs/users_guide/diagnostics-as-json-schema-1_1.json
=====================================
@@ -13,7 +13,10 @@
       "type": "string"
     },
     "span": {
-      "$ref": "#/$defs/span"
+      "oneOf": [
+        { "$ref": "#/$defs/span" },
+        { "type": "null" }
+      ]
     },
     "severity": {
       "description": "The diagnostic severity",


=====================================
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))


=====================================
testsuite/tests/simd/should_run/T25659.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, ExtendedLiterals #-}
+import GHC.Int
+import GHC.Prim
+
+test :: (Int64X2# -> Int64X2# -> Int64X2#) -> IO ()
+test f = do
+  let a = packInt64X2# (# 0#Int64, 11#Int64 #)
+      b = packInt64X2# (# 22#Int64, 33#Int64 #)
+      c = f a b
+      (# x0, x1 #) = unpackInt64X2# a
+      (# y0, y1 #) = unpackInt64X2# b
+      (# z0, z1 #) = unpackInt64X2# c
+  putStrLn $ "a = " ++ show (I64# x0, I64# x1)
+  putStrLn $ "b = " ++ show (I64# y0, I64# y1)
+  putStrLn $ "c = " ++ show (I64# z0, I64# z1)
+{-# NOINLINE test #-}
+
+main :: IO ()
+main = test (\_ b -> b)


=====================================
testsuite/tests/simd/should_run/T25659.stdout
=====================================
@@ -0,0 +1,3 @@
+a = (0,11)
+b = (22,33)
+c = (22,33)


=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -26,6 +26,7 @@ test('word32x4_basic_baseline', [], compile_and_run, [''])
 test('word64x2_basic_baseline', [], compile_and_run, [''])
 
 test('T25658', [], compile_and_run, ['']) # #25658 is a bug with SSE2 code generation
+test('T25659', [], compile_and_run, [''])
 
 # Ensure we set the CPU features we have available.
 #


=====================================
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/-/compare/002e26c0ba0415ceac14f9717eb6dc03e7f66d4a...a414412dcbec1835dc12d3bb8a7568243a4f325a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/002e26c0ba0415ceac14f9717eb6dc03e7f66d4a...a414412dcbec1835dc12d3bb8a7568243a4f325a
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/5ca1126a/attachment-0001.html>


More information about the ghc-commits mailing list