[Git][ghc/ghc][wip/T24603] 5 commits: compiler: Always load GHC.Data.FastString optimised into GHCi
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Tue Feb 4 08:36:00 UTC 2025
Serge S. Gulin pushed to branch wip/T24603 at Glasgow Haskell Compiler / GHC
Commits:
662645f0 by Matthew Pickering at 2025-02-03T11:44:41-05:00
compiler: Always load GHC.Data.FastString optimised into GHCi
The FastString table is shared between the boot compiler and interpreted
compiler. Therefore it's very important the representation of
`FastString` matches in both cases. Otherwise, the interpreter will read
a FastString from the shared variable but place the fields in the wrong
place which leads to segfaults.
Ideally this state would not be shared, but for now we can always
compile both with `-O2` and this leads to a working interpreter.
- - - - -
05e5785a by Peter Trommler at 2025-02-03T11:45:17-05:00
RTS: Fix compile on powerpc64 ELF v1
Cabal does not know about the different ABIs for powerpc64 and compiles
StgCRunAsm.S unconditionally. The old make-based build system excluded
this file from the build and it was OK to signal an error when it was
compiled accidentally.
With this patch we compile StgCRunAsm.S to an empty file, which fixes
the build.
Fixes #25700
- - - - -
cbbb64fb by Matthew Pickering at 2025-02-03T23:40:33-05:00
interpreter: Always print unit and module name in BCO_NAME instruction
Currently the BCO_Name instruction is a bit difficult to use since the
names are not qualified by the module they come from. When you have a
very generic name such as "wildX4", it becomes impossible to work out
which module the identifier comes from.
Fixes #25694
- - - - -
764a43ac by Ben Gamari at 2025-02-03T23:41:10-05:00
upload-ghc-libs: Drop more references to ghc-internal from ghc-boot-th
(cherry picked from commit afec4b75c2d0e9f5c462a86d9f3697acf30355c7)
Co-authored-by: Ben Gamari <bgamari.foss at gmail.com>
- - - - -
1d3de001 by Serge S. Gulin at 2025-02-04T11:33:33+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>
- - - - -
22 changed files:
- .gitlab/rel_eng/upload_ghc_libs.py
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs
- compiler/GHC/Data/FastString.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/StgToByteCode.hs
- 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/StgCRunAsm.S
- rts/win32/veh_excn.c
- utils/hsc2hs
- utils/llvm-targets/gen-data-layout.sh
Changes:
=====================================
.gitlab/rel_eng/upload_ghc_libs.py
=====================================
@@ -94,9 +94,23 @@ def prep_ghc():
build_copy_file(PACKAGES['ghc'], 'GHC/Settings/Config.hs')
def prep_ghc_boot_th():
- # Drop ghc-internal from `hs-source-dirs` as Hackage rejects this
+ # Drop references to `ghc-internal` from `hs-source-dirs` as Hackage rejects
+ # out-of-sdist references and this packages is only uploaded for documentation
+ # purposes.
modify_file(PACKAGES['ghc-boot-th'], 'ghc-boot-th.cabal',
- lambda s: s.replace('../ghc-internal/src', ''))
+ lambda s: s.replace('../ghc-internal/src', '')
+ .replace('GHC.Internal.TH.Lib.Map', '')
+ .replace('GHC.Internal.TH.PprLib', '')
+ .replace('GHC.Internal.TH.Ppr', '')
+ .replace('GHC.Internal.TH.Lib,', '')
+ .replace('GHC.Internal.TH.Lib', '')
+ .replace('GHC.Internal.TH.Lift,', '')
+ .replace('GHC.Internal.TH.Quote,', '')
+ .replace('GHC.Internal.TH.Syntax', '')
+ .replace('GHC.Internal.ForeignSrcLang', '')
+ .replace('GHC.Internal.LanguageExtensions', '')
+ .replace('GHC.Internal.Lexeme', '')
+ )
PACKAGES = {
pkg.name: pkg
=====================================
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/AArch64/Ppr.hs
=====================================
@@ -43,7 +43,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprSectionAlign config (Section Text lbl) $$
-- do not
-- pprProcAlignment config $$
- pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
+ (if lbl /= blockLbl (blockId (head blocks)) -- blocks can have clashed names
+ then pprLabel platform lbl -- blocks guaranteed not null, so label needed
+ else empty) $$
vcat (map (pprBasicBlock platform with_dwarf top_info) blocks) $$
(if ncgDwarfEnabled config
then line (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':') else empty) $$
=====================================
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)
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -2,10 +2,19 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
+#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
+{-# OPTIONS_GHC -fno-unoptimized-core-for-interpreter #-}
+#endif
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
+--
+-- Also important, if you load this module into GHCi then the data representation of
+-- FastString has to match that of the host compiler due to the shared FastString
+-- table. Otherwise you will get segfaults when the table is consulted and the fields
+-- from the FastString are in an incorrect order.
-- |
-- There are two principal string types used internally by GHC:
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -211,7 +211,7 @@ platformNcgSupported platform = if
ArchX86_64 -> True
ArchPPC -> True
ArchPPC_64 {} -> True
- ArchAArch64 -> True
+ ArchAArch64 -> platformOS platform /= OSMinGW32
ArchWasm32 -> True
ArchRISCV64 -> True
_ -> False
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -240,11 +240,12 @@ ppBCEnv p
-- Create a BCO and do a spot of peephole optimisation on the insns
-- at the same time.
mkProtoBCO
- :: (Outputable name)
- => Platform
- -> Bool -- ^ True <=> label with @BCO_NAME@ instruction
- -- see Note [BCO_NAME]
- -> name
+ ::
+ Platform
+ -> Maybe Module
+ -- ^ Just cur_mod <=> label with @BCO_NAME@ instruction
+ -- see Note [BCO_NAME]
+ -> Name
-> BCInstrList
-> Either [CgStgAlt] (CgStgRhs)
-- ^ original expression; for debugging only
@@ -253,7 +254,7 @@ mkProtoBCO
-> [StgWord] -- ^ bitmap
-> Bool -- ^ True <=> is a return point, rather than a function
-> [FFIInfo]
- -> ProtoBCO name
+ -> ProtoBCO Name
mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
= ProtoBCO {
protoBCOName = nm,
@@ -267,9 +268,9 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit
where
#if MIN_VERSION_rts(1,0,3)
maybe_add_bco_name instrs
- | _add_bco_name = BCO_NAME str : instrs
- where
- str = BS.pack $ showSDocOneLine defaultSDocContext (ppr nm)
+ | Just cur_mod <- _add_bco_name =
+ let str = BS.pack $ showSDocOneLine defaultSDocContext (pprFullName cur_mod nm)
+ in BCO_NAME str : instrs
#endif
maybe_add_bco_name instrs = instrs
@@ -1398,7 +1399,7 @@ Note [unboxed tuple bytecodes and tuple_BCO]
tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
tupleBCO platform args_info args =
- mkProtoBCO platform False invented_name body_code (Left [])
+ mkProtoBCO platform Nothing invented_name body_code (Left [])
0{-no arity-} bitmap_size bitmap False{-is alts-}
where
{-
@@ -1419,7 +1420,7 @@ tupleBCO platform args_info args =
primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
primCallBCO platform args_info args =
- mkProtoBCO platform False invented_name body_code (Left [])
+ mkProtoBCO platform Nothing invented_name body_code (Left [])
0{-no arity-} bitmap_size bitmap False{-is alts-}
where
{-
@@ -2359,8 +2360,12 @@ getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
getProfile :: BcM Profile
getProfile = targetProfile <$> getDynFlags
-shouldAddBcoName :: BcM Bool
-shouldAddBcoName = gopt Opt_AddBcoName <$> getDynFlags
+shouldAddBcoName :: BcM (Maybe Module)
+shouldAddBcoName = do
+ add <- gopt Opt_AddBcoName <$> getDynFlags
+ if add
+ then Just <$> getCurrentModule
+ else return Nothing
emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
emitBc bco
=====================================
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/StgCRunAsm.S
=====================================
@@ -69,7 +69,7 @@ StgReturn:
.section .note.GNU-stack,"", at progbits
# else // Not ELF v2
-# error Only ELF v2 supported.
+ // ELF v1 is in StgCrun.c
# endif
#elif defined(powerpc_HOST_ARCH)
=====================================
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/-/compare/9f8176f11878a0fbf637b1f4c9a640d6771c17b1...1d3de001ca88368a1fd0a604bc32f0f351ae8c9b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f8176f11878a0fbf637b1f4c9a640d6771c17b1...1d3de001ca88368a1fd0a604bc32f0f351ae8c9b
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/20250204/c8a4b4ef/attachment-0001.html>
More information about the ghc-commits
mailing list