[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: rts: remove unused PowerPC/IA64 native adjustor code
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jun 5 11:35:53 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
11795244 by Cheng Shao at 2024-06-05T06:33:17-04:00
rts: remove unused PowerPC/IA64 native adjustor code
This commit removes unused PowerPC/IA64 native adjustor code which is
never actually enabled by autoconf/hadrian. Fixes #24920.
- - - - -
5132754b by Sylvain Henry at 2024-06-05T06:33:57-04:00
RTS: fix warnings with doing*Profiling (#24918)
- - - - -
333bbab3 by Cheng Shao at 2024-06-05T07:35:30-04:00
hadrian: don't depend on inplace/mingw when --enable-distro-toolchain on Windows
- - - - -
1e34af01 by Cheng Shao at 2024-06-05T07:35:30-04:00
autoconf: normalize paths of some build-time dependencies on Windows
This commit applies path normalization via cygpath -m to some
build-time dependencies on Windows. Without this logic, the
/clang64/bin prefixed msys2-style paths cause the build to fail with
--enable-distro-toolchain.
- - - - -
2ee13ed2 by Cheng Shao at 2024-06-05T07:35:30-04:00
hadrian: remove OSDarwin mention from speedHack
This commit removes mentioning of OSDarwin from speedHack, since
speedHack is purely for i386 and we no longer support i386 darwin
(#24921).
- - - - -
e83849b0 by Cheng Shao at 2024-06-05T07:35:30-04:00
compiler: remove 32-bit darwin logic
This commit removes all 32-bit darwin logic from the compiler, given
we no longer support 32-bit apple systems (#24921). Also contains a
bit more cleanup of obsolete i386 windows logic.
- - - - -
3f73769f by Cheng Shao at 2024-06-05T07:35:30-04:00
rts: remove 32-bit darwin/ios logic
This commit removes 32-bit darwin/ios related logic from the rts,
given we no longer support them (#24921).
- - - - -
a138e1b8 by Cheng Shao at 2024-06-05T07:35:30-04:00
llvm-targets: remove 32-bit darwin/ios targets
This commit removes 32-bit darwin/ios targets from llvm-targets given
we no longer support them (#24921).
- - - - -
de075099 by Cheng Shao at 2024-06-05T07:35:30-04:00
testsuite: remove 32-bit darwin logic
This commit removes 32-bit darwin logic from the testsuite given it's
no longer supported (#24921). Also contains more cleanup of obsolete
i386 windows logic.
- - - - -
a27ed449 by Cheng Shao at 2024-06-05T07:35:30-04:00
docs: mention 32-bit darwin/ios removal in 9.12 changelog
This commit mentions removal of 32-bit darwin/ios support (#24921) in
the 9.12 changelog.
- - - - -
30 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/CmmToAsm/PIC.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/Driver/Config/Cmm.hs
- compiler/GHC/Linker/Static.hs
- configure.ac
- docs/users_guide/9.12.1-notes.rst
- hadrian/src/Builder.hs
- hadrian/src/Settings/Packages.hs
- llvm-targets
- m4/fp_find_nm.m4
- m4/fp_prog_ar_args.m4
- − rts/AdjustorAsm.S
- rts/RtsFlags.h
- rts/RtsSymbols.c
- rts/StgCRun.c
- − rts/adjustor/NativeIA64.c
- − rts/adjustor/NativePowerPC.c
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal
- testsuite/tests/driver/objc/all.T
- testsuite/tests/ffi/should_run/Makefile
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/rts/T10672/Makefile
- testsuite/tests/rts/T10672/all.T
- testsuite/tests/rts/all.T
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/llvm-targets/gen-data-layout.sh
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1659,11 +1659,7 @@ pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
GotSymbolPtr -> ppLbl <> text "@GOTPCREL"
GotSymbolOffset -> ppLbl
| platformArch platform == ArchAArch64 -> ppLbl
- | otherwise ->
- case dllInfo of
- CodeStub -> char 'L' <> ppLbl <> text "$stub"
- SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
- _ -> panic "pprDynamicLinkerAsmLabel"
+ | otherwise -> panic "pprDynamicLinkerAsmLabel"
OSAIX ->
case dllInfo of
=====================================
compiler/GHC/CmmToAsm/PIC.hs
=====================================
@@ -303,25 +303,15 @@ howToAccessLabel config arch OSDarwin DataReference lbl
| otherwise
= AccessDirectly
-howToAccessLabel config arch OSDarwin JumpReference lbl
+howToAccessLabel config _ OSDarwin JumpReference lbl
-- dyld code stubs don't work for tailcalls because the
-- stack alignment is only right for regular calls.
-- Therefore, we have to go via a symbol pointer:
- | arch == ArchX86 || arch == ArchX86_64 || arch == ArchAArch64
- , ncgLabelDynamic config lbl
+ | ncgLabelDynamic config lbl
= AccessViaSymbolPtr
-howToAccessLabel config arch OSDarwin _kind lbl
- -- Code stubs are the usual method of choice for imported code;
- -- not needed on x86_64 because Apple's new linker, ld64, generates
- -- them automatically, neither on Aarch64 (arm64).
- | arch /= ArchX86_64
- , arch /= ArchAArch64
- , ncgLabelDynamic config lbl
- = AccessViaStub
-
- | otherwise
+howToAccessLabel _ _ OSDarwin _ _
= AccessDirectly
----------------------------------------------------------------------------
@@ -534,16 +524,6 @@ gotLabel
-- However, for PIC on x86, we need a small helper function.
pprGotDeclaration :: NCGConfig -> HDoc
pprGotDeclaration config = case (arch,os) of
- (ArchX86, OSDarwin)
- | ncgPIC config
- -> lines_ [
- text ".section __TEXT,__textcoal_nt,coalesced,no_toc",
- text ".weak_definition ___i686.get_pc_thunk.ax",
- text ".private_extern ___i686.get_pc_thunk.ax",
- text "___i686.get_pc_thunk.ax:",
- text "\tmovl (%esp), %eax",
- text "\tret" ]
-
(_, OSDarwin) -> empty
-- Emit XCOFF TOC section
@@ -597,59 +577,6 @@ pprGotDeclaration config = case (arch,os) of
pprImportedSymbol :: NCGConfig -> CLabel -> HDoc
pprImportedSymbol config importedLbl = case (arch,os) of
- (ArchX86, OSDarwin)
- | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
- -> if not pic
- then
- lines_ [
- text ".symbol_stub",
- text "L" <> ppr_lbl lbl <> text "$stub:",
- text "\t.indirect_symbol" <+> ppr_lbl lbl,
- text "\tjmp *L" <> ppr_lbl lbl
- <> text "$lazy_ptr",
- text "L" <> ppr_lbl lbl
- <> text "$stub_binder:",
- text "\tpushl $L" <> ppr_lbl lbl
- <> text "$lazy_ptr",
- text "\tjmp dyld_stub_binding_helper"
- ]
- else
- lines_ [
- text ".section __TEXT,__picsymbolstub2,"
- <> text "symbol_stubs,pure_instructions,25",
- text "L" <> ppr_lbl lbl <> text "$stub:",
- text "\t.indirect_symbol" <+> ppr_lbl lbl,
- text "\tcall ___i686.get_pc_thunk.ax",
- text "1:",
- text "\tmovl L" <> ppr_lbl lbl
- <> text "$lazy_ptr-1b(%eax),%edx",
- text "\tjmp *%edx",
- text "L" <> ppr_lbl lbl
- <> text "$stub_binder:",
- text "\tlea L" <> ppr_lbl lbl
- <> text "$lazy_ptr-1b(%eax),%eax",
- text "\tpushl %eax",
- text "\tjmp dyld_stub_binding_helper"
- ]
- $$ lines_ [
- text ".section __DATA, __la_sym_ptr"
- <> (if pic then int 2 else int 3)
- <> text ",lazy_symbol_pointers",
- text "L" <> ppr_lbl lbl <> text "$lazy_ptr:",
- text "\t.indirect_symbol" <+> ppr_lbl lbl,
- text "\t.long L" <> ppr_lbl lbl
- <> text "$stub_binder"]
-
- | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
- -> lines_ [
- text ".non_lazy_symbol_pointer",
- char 'L' <> ppr_lbl lbl <> text "$non_lazy_ptr:",
- text "\t.indirect_symbol" <+> ppr_lbl lbl,
- text "\t.long\t0"]
-
- | otherwise
- -> empty
-
(ArchAArch64, OSDarwin)
-> empty
@@ -734,7 +661,6 @@ pprImportedSymbol config importedLbl = case (arch,os) of
ppr_lbl = pprAsmLabel platform
arch = platformArch platform
os = platformOS platform
- pic = ncgPIC config
--------------------------------------------------------------------------------
-- Generate code to calculate the address that should be put in the
@@ -840,11 +766,11 @@ initializePicBase_ppc _ _ _ _
-- (See PprMach.hs)
initializePicBase_x86
- :: Arch -> OS -> Reg
+ :: OS -> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
-initializePicBase_x86 ArchX86 os picReg
+initializePicBase_x86 os picReg
(CmmProc info lab live (ListGraph blocks) : statics)
| osElfTarget os
= return (CmmProc info lab live (ListGraph blocks') : statics)
@@ -862,12 +788,12 @@ initializePicBase_x86 ArchX86 os picReg
fetchGOT (BasicBlock bID insns) =
BasicBlock bID (X86.FETCHGOT picReg : insns)
-initializePicBase_x86 ArchX86 OSDarwin picReg
+initializePicBase_x86 OSDarwin picReg
(CmmProc info lab live (ListGraph (entry:blocks)) : statics)
= return (CmmProc info lab live (ListGraph (block':blocks)) : statics)
where BasicBlock bID insns = entry
block' = BasicBlock bID (X86.FETCHPC picReg : insns)
-initializePicBase_x86 _ _ _ _
+initializePicBase_x86 _ _ _
= panic "initializePicBase_x86: not needed"
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -124,7 +124,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
os = platformOS platform
case picBaseMb of
- Just picBase -> initializePicBase_x86 ArchX86 os picBase tops
+ Just picBase -> initializePicBase_x86 os picBase tops
Nothing -> return tops
cmmTopCodeGen (CmmData sec dat) =
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -883,7 +883,6 @@ needs_probe_call :: Platform -> Int -> Bool
needs_probe_call platform amount
= case platformOS platform of
OSMinGW32 -> case platformArch platform of
- ArchX86 -> amount > (4 * 1024)
ArchX86_64 -> amount > (4 * 1024)
_ -> False
_ -> False
@@ -913,15 +912,6 @@ mkStackAllocInstr platform amount
-- function dropping the stack more than a page.
-- See Note [Windows stack layout]
case platformArch platform of
- ArchX86 | needs_probe_call platform amount ->
- [ MOV II32 (OpImm (ImmInt amount)) (OpReg eax)
- , CALL (Left $ strImmLit (fsLit "___chkstk_ms")) [eax]
- , SUB II32 (OpReg eax) (OpReg esp)
- ]
- | otherwise ->
- [ SUB II32 (OpImm (ImmInt amount)) (OpReg esp)
- , TEST II32 (OpReg esp) (OpReg esp)
- ]
ArchX86_64 | needs_probe_call platform amount ->
[ MOV II64 (OpImm (ImmInt amount)) (OpReg rax)
, CALL (Left $ strImmLit (fsLit "___chkstk_ms")) [rax]
=====================================
compiler/GHC/Driver/Config/Cmm.hs
=====================================
@@ -24,15 +24,10 @@ initCmmConfig dflags = CmmConfig
, cmmDoCmmSwitchPlans = not (backendHasNativeSwitch (backend dflags))
, cmmSplitProcPoints = not (backendSupportsUnsplitProcPoints (backend dflags))
|| not (platformTablesNextToCode platform)
- || usingInconsistentPicReg
, cmmAllowMul2 = (ncg && x86ish) || llvm
, cmmOptConstDivision = not llvm
}
where platform = targetPlatform dflags
- usingInconsistentPicReg =
- case (platformArch platform, platformOS platform, positionIndependent dflags)
- of (ArchX86, OSDarwin, pic) -> pic
- _ -> False
-- Copied from StgToCmm
(ncg, llvm) = case backendPrimitiveImplementation (backend dflags) of
GenericPrimitives -> (False, False)
=====================================
compiler/GHC/Linker/Static.hs
=====================================
@@ -219,25 +219,12 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
toolSettings_ldSupportsCompactUnwind toolSettings' &&
(platformOS platform == OSDarwin) &&
case platformArch platform of
- ArchX86 -> True
ArchX86_64 -> True
- ArchARM {} -> True
ArchAArch64 -> True
_ -> False
then ["-Wl,-no_compact_unwind"]
else [])
- -- '-Wl,-read_only_relocs,suppress'
- -- ld gives loads of warnings like:
- -- ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
- -- when linking any program. We're not sure
- -- whether this is something we ought to fix, but
- -- for now this flags silences them.
- ++ (if platformOS platform == OSDarwin &&
- platformArch platform == ArchX86
- then ["-Wl,-read_only_relocs,suppress"]
- else [])
-
-- We should rather be asking does it support --gc-sections?
++ (if toolSettings_ldIsGnuLd toolSettings' &&
not (gopt Opt_WholeArchiveHsLibs dflags)
=====================================
configure.ac
=====================================
@@ -314,6 +314,8 @@ else
AC_CHECK_TARGET_TOOL([WindresCmd],[windres])
AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump])
+ WindresCmd="$(cygpath -m $WindresCmd)"
+
if test "$Genlib" != ""; then
GenlibCmd="$(cygpath -m $Genlib)"
fi
@@ -464,7 +466,12 @@ case $HostOS_CPP in
;;
esac
-ObjdumpCmd="$OBJDUMP"
+if test "$HostOS" = "mingw32"
+then
+ ObjdumpCmd=$(cygpath -m "$OBJDUMP")
+else
+ ObjdumpCmd="$OBJDUMP"
+fi
AC_SUBST([ObjdumpCmd])
dnl ** Which ranlib to use?
@@ -473,7 +480,12 @@ AC_PROG_RANLIB
if test "$RANLIB" = ":"; then
AC_MSG_ERROR([cannot find ranlib in your PATH])
fi
-RanlibCmd="$RANLIB"
+if test "$HostOS" = "mingw32"
+then
+ RanlibCmd=$(cygpath -m "$RANLIB")
+else
+ RanlibCmd="$RANLIB"
+fi
AC_SUBST([RanlibCmd])
dnl ** which strip to use?
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -69,6 +69,10 @@ Compiler
and treat it as ``ccall``. All C import/export declarations on
Windows should now use ``ccall``.
+- 32-bit macOS/iOS support has also been completely removed (`#24921
+ <https://gitlab.haskell.org/ghc/ghc/-/issues/24921>`_). This does
+ not affect existing support of apple systems on x86_64/aarch64.
+
GHCi
~~~~
=====================================
hadrian/src/Builder.hs
=====================================
@@ -34,6 +34,7 @@ import Base
import Context
import Oracles.Flag
import Oracles.Setting (setting, Setting(..))
+import Oracles.Setting (settingsFileSetting, ToolchainSetting(..))
import Packages
import GHC.IO.Encoding (getFileSystemEncoding)
@@ -239,9 +240,10 @@ instance H.Builder Builder where
Ghc {} -> do
root <- buildRoot
unlitPath <- builderPath Unlit
+ distro_mingw <- settingsFileSetting ToolchainSetting_DistroMinGW
return $ [ unlitPath ]
- ++ [ root -/- mingwStamp | windowsHost ]
+ ++ [ root -/- mingwStamp | windowsHost, distro_mingw == "NO" ]
-- proxy for the entire mingw toolchain that
-- we have in inplace/mingw initially, and then at
-- root -/- mingw.
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -480,7 +480,7 @@ rtsPackageArgs = package rts ? do
speedHack :: Action Bool
speedHack = do
i386 <- anyTargetArch [ArchX86]
- goodOS <- not <$> anyTargetOs [OSDarwin, OSSolaris2]
+ goodOS <- not <$> anyTargetOs [OSSolaris2]
return $ i386 && goodOS
-- See @rts/ghc.mk at .
=====================================
llvm-targets
=====================================
@@ -43,12 +43,9 @@
,("riscv64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+m +a +f +d +c +relax"))
,("loongarch64-unknown-linux-gnu", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d"))
,("loongarch64-unknown-linux", ("e-m:e-p:64:64-i64:64-i128:128-n64-S128", "", "+f +d"))
-,("i386-apple-darwin", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "penryn", ""))
,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "penryn", ""))
,("arm64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+v8.3a +fp-armv8 +neon +crc +crypto +fullfp16 +ras +lse +rdm +rcpc +zcm +zcz +sha2 +aes"))
-,("armv7-apple-ios", ("e-m:o-p:32:32-Fi8-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32", "generic", ""))
,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes"))
-,("i386-apple-ios", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "yonah", ""))
,("x86_64-apple-ios", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", ""))
,("amd64-portbld-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
,("x86_64-unknown-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", ""))
=====================================
m4/fp_find_nm.m4
=====================================
@@ -9,7 +9,12 @@ AC_DEFUN([FP_FIND_NM],
AC_MSG_ERROR([cannot find nm in your PATH])
fi
fi
- NmCmd="$NM"
+ if test "$HostOS" = "mingw32"
+ then
+ NmCmd=$(cygpath -m "$NM")
+ else
+ NmCmd="$NM"
+ fi
AC_SUBST([NmCmd])
if test "$TargetOS_CPP" = "darwin"
@@ -37,4 +42,3 @@ AC_DEFUN([FP_FIND_NM],
esac
fi
])
-
=====================================
m4/fp_prog_ar_args.m4
=====================================
@@ -30,7 +30,13 @@ else
fi
fi])
fp_prog_ar_args=$fp_cv_prog_ar_args
-AC_SUBST([ArCmd], ["$fp_prog_ar"])
+if test "$HostOS" = "mingw32"
+then
+ ArCmd=$(cygpath -m "$fp_prog_ar")
+else
+ ArCmd="$fp_prog_ar"
+fi
+AC_SUBST([ArCmd])
AC_SUBST([ArArgs], ["$fp_prog_ar_args"])
])# FP_PROG_AR_ARGS
=====================================
rts/AdjustorAsm.S deleted
=====================================
@@ -1,125 +0,0 @@
-#include "include/ghcconfig.h"
-
-/* ******************************** PowerPC ******************************** */
-
-#if defined(powerpc_HOST_ARCH) && defined(aix_HOST_OS) || defined(powerpc64_HOST_ARCH) && defined(__ELF__) && (!defined(_CALL_ELF) || _CALL_ELF == 1)
- /* The following code applies, with some differences,
- to all powerpc platforms except for powerpc32-linux,
- whose calling convention is annoyingly complex.
- */
-
-
- /* The code is "almost" the same for
- 32-bit and for 64-bit
- */
-#if defined(powerpc64_HOST_ARCH)
-#define WS 8
-#define LOAD ld
-#define STORE std
-#else
-#define WS 4
-#define LOAD lwz
-#define STORE stw
-#endif /* defined(powerpc64_HOST_ARCH) */
-
- /* Some info about stack frame layout */
-#define LINK_SLOT (2*WS)
-#define LINKAGE_AREA_SIZE (6*WS)
-
- /* The following defines mirror struct AdjustorStub
- from Adjustor.c. Make sure to keep these in sync.
- */
-#define HEADER_WORDS 3
-
-#define HPTR_OFF ((HEADER_WORDS )*WS)
-#define WPTR_OFF ((HEADER_WORDS + 1)*WS)
-#define FRAMESIZE_OFF ((HEADER_WORDS + 2)*WS)
-#define EXTRA_WORDS_OFF ((HEADER_WORDS + 3)*WS)
-
-#if defined(aix_HOST_OS)
-/* IBM's assembler needs a different pseudo-op to declare a .text section */
-.csect .text[PR]
-#else
-.text
-#endif /* defined(aix_HOST_OS) */
-
-#if LEADING_UNDERSCORE
- .globl _adjustorCode
-_adjustorCode:
-#else
- .globl adjustorCode
- /* Note that we don't build a function descriptor
- for AIX-derived ABIs here. This will happen at runtime
- in createAdjustor().
- */
-adjustorCode:
-#endif /* LEADING_UNDERSCORE */
- /* On entry, r2 will point to the AdjustorStub data structure. */
-
- /* save the link */
- mflr 0
- STORE 0, LINK_SLOT(1)
-
- /* set up stack frame */
- LOAD 12, FRAMESIZE_OFF(2)
-#if defined(powerpc64_HOST_ARCH)
- stdux 1, 1, 12
-#else
- stwux 1, 1, 12
-#endif /* defined(powerpc64_HOST_ARCH) */
-
- /* Save some regs so that we can use them.
- Note that we use the "Red Zone" below the stack pointer.
- */
- STORE 31, -WS(1)
- STORE 30, -2*WS(1)
-
- mr 31, 1
- subf 30, 12, 31
-
- LOAD 12, EXTRA_WORDS_OFF(2)
- mtctr 12
- b L2
-L1:
- LOAD 0, LINKAGE_AREA_SIZE + 8*WS(30)
- STORE 0, LINKAGE_AREA_SIZE + 10*WS(31)
- addi 30, 30, WS
- addi 31, 31, WS
-L2:
- bdnz L1
-
- /* Restore r30 and r31 now.
- */
- LOAD 31, -WS(1)
- LOAD 30, -2*WS(1)
-
- STORE 10, LINKAGE_AREA_SIZE + 9*WS(1)
- STORE 9, LINKAGE_AREA_SIZE + 8*WS(1)
- mr 10, 8
- mr 9, 7
- mr 8, 6
- mr 7, 5
- mr 6, 4
- mr 5, 3
-
- LOAD 3, HPTR_OFF(2)
-
- LOAD 12, WPTR_OFF(2)
- LOAD 0, 0(12)
- /* The function we're calling will never be a nested function,
- so we don't load r11.
- */
- mtctr 0
- LOAD 2, WS(12)
- bctrl
-
- LOAD 1, 0(1)
- LOAD 0, LINK_SLOT(1)
- mtlr 0
- blr
-#endif
-
-/* mark stack as nonexecutable */
-#if defined(__linux__) && defined(__ELF__)
-.section .note.GNU-stack,"", at progbits
-#endif
=====================================
rts/RtsFlags.h
=====================================
@@ -23,7 +23,12 @@ char** getUTF8Args(int* argc);
void initRtsFlagsDefaults (void);
void setupRtsFlags (int *argc, char *argv[], RtsConfig rtsConfig);
void freeRtsArgs (void);
-#if defined(PROFILING)
+
+/* These prototypes may also be defined by ClosureMacros.h. We don't want to
+ * define them twice (#24918).
+ */
+#if defined(PROFILING) && !defined(RTS_FLAGS_DOING_PROFILING)
+#define RTS_FLAGS_DOING_PROFILING 1
bool doingLDVProfiling (void);
bool doingRetainerProfiling(void);
bool doingErasProfiling(void);
=====================================
rts/RtsSymbols.c
=====================================
@@ -1073,11 +1073,5 @@ RtsSymbolVal rtsSyms[] = {
RTS_LIBFFI_SYMBOLS
RTS_ARM_OUTLINE_ATOMIC_SYMBOLS
SymI_HasDataProto(nonmoving_write_barrier_enabled)
-#if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
- // dyld stub code contains references to this,
- // but it should never be called because we treat
- // lazy pointers as nonlazy.
- { "dyld_stub_binding_helper", (void*)0xDEADBEEF, STRENGTH_NORMAL },
-#endif
{ 0, 0, STRENGTH_NORMAL, SYM_TYPE_CODE } /* sentinel */
};
=====================================
rts/StgCRun.c
=====================================
@@ -102,13 +102,8 @@ StgFunPtr StgReturn(void)
#if defined(i386_HOST_ARCH)
-#if defined(darwin_HOST_OS) || defined(ios_HOST_OS)
-#define STG_GLOBAL ".globl "
-#define STG_HIDDEN ".private_extern "
-#else
#define STG_GLOBAL ".global "
#define STG_HIDDEN ".hidden "
-#endif
/*
* Note [Stack Alignment on X86]
=====================================
rts/adjustor/NativeIA64.c deleted
=====================================
@@ -1,154 +0,0 @@
-/* -----------------------------------------------------------------------------
- * IA64 architecture adjustor thunk logic.
- * ---------------------------------------------------------------------------*/
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "RtsUtils.h"
-#include "StablePtr.h"
-
-/* Layout of a function descriptor */
-typedef struct _IA64FunDesc {
- StgWord64 ip;
- StgWord64 gp;
-} IA64FunDesc;
-
-static void *
-stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
-{
- StgArrBytes* arr;
- uint32_t data_size_in_words, total_size_in_words;
-
- /* round up to a whole number of words */
- data_size_in_words = ROUNDUP_BYTES_TO_WDS(size_in_bytes);
- total_size_in_words = sizeofW(StgArrBytes) + data_size_in_words;
-
- /* allocate and fill it in */
- arr = (StgArrBytes *)allocate(total_size_in_words);
- SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, size_in_bytes);
-
- /* obtain a stable ptr */
- *stable = getStablePtr((StgPtr)arr);
-
- /* and return a ptr to the goods inside the array */
- return(&(arr->payload));
-}
-
-void initAdjustors(void) { }
-
-void*
-createAdjustor(StgStablePtr hptr,
- StgFunPtr wptr,
- char *typeString
-#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
- STG_UNUSED
-#endif
- )
-{
- void *adjustor = NULL;
- void *code = NULL;
-
-/*
- Up to 8 inputs are passed in registers. We flush the last two inputs to
- the stack, initially into the 16-byte scratch region left by the caller.
- We then shuffle the others along by 4 (taking 2 registers for ourselves
- to save return address and previous function state - we need to come back
- here on the way out to restore the stack, so this is a real function
- rather than just a trampoline).
-
- The function descriptor we create contains the gp of the target function
- so gp is already loaded correctly.
-
- [MLX] alloc r16=ar.pfs,10,2,0
- movl r17=wptr
- [MII] st8.spill [r12]=r38,8 // spill in6 (out4)
- mov r41=r37 // out7 = in5 (out3)
- mov r40=r36;; // out6 = in4 (out2)
- [MII] st8.spill [r12]=r39 // spill in7 (out5)
- mov.sptk b6=r17,50
- mov r38=r34;; // out4 = in2 (out0)
- [MII] mov r39=r35 // out5 = in3 (out1)
- mov r37=r33 // out3 = in1 (loc1)
- mov r36=r32 // out2 = in0 (loc0)
- [MLX] adds r12=-24,r12 // update sp
- movl r34=hptr;; // out0 = hptr
- [MIB] mov r33=r16 // loc1 = ar.pfs
- mov r32=b0 // loc0 = retaddr
- br.call.sptk.many b0=b6;;
-
- [MII] adds r12=-16,r12
- mov b0=r32
- mov.i ar.pfs=r33
- [MFB] nop.m 0x0
- nop.f 0x0
- br.ret.sptk.many b0;;
-*/
-
-/* These macros distribute a long constant into the two words of an MLX bundle */
-#define BITS(val,start,count) (((val) >> (start)) & ((1 << (count))-1))
-#define MOVL_LOWORD(val) (BITS(val,22,18) << 46)
-#define MOVL_HIWORD(val) ( (BITS(val,0,7) << 36) \
- | (BITS(val,7,9) << 50) \
- | (BITS(val,16,5) << 45) \
- | (BITS(val,21,1) << 44) \
- | (BITS(val,40,23)) \
- | (BITS(val,63,1) << 59))
-
- StgStablePtr stable;
- IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
- StgWord64 wcode = wdesc->ip;
- IA64FunDesc *fdesc;
- StgWord64 *code;
-
- /* we allocate on the Haskell heap since malloc'd memory isn't
- * executable - argh */
- /* Allocated memory is word-aligned (8 bytes) but functions on ia64
- * must be aligned to 16 bytes. We allocate an extra 8 bytes of
- * wiggle room so that we can put the code on a 16 byte boundary. */
- adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8+8, &stable);
-
- fdesc = (IA64FunDesc *)adjustor;
- code = (StgWord64 *)(fdesc + 1);
- /* add 8 bytes to code if needed to align to a 16-byte boundary */
- if ((StgWord64)code & 15) code++;
- fdesc->ip = (StgWord64)code;
- fdesc->gp = wdesc->gp;
-
- code[0] = 0x0000058004288004 | MOVL_LOWORD(wcode);
- code[1] = 0x6000000220000000 | MOVL_HIWORD(wcode);
- code[2] = 0x029015d818984001;
- code[3] = 0x8401200500420094;
- code[4] = 0x886011d8189c0001;
- code[5] = 0x84011004c00380c0;
- code[6] = 0x0250210046013800;
- code[7] = 0x8401000480420084;
- code[8] = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
- code[9] = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
- code[10] = 0x0200210020010811;
- code[11] = 0x1080006800006200;
- code[12] = 0x0000210018406000;
- code[13] = 0x00aa021000038005;
- code[14] = 0x000000010000001d;
- code[15] = 0x0084000880000200;
-
- /* save stable pointers in convenient form */
- code[16] = (StgWord64)hptr;
- code[17] = (StgWord64)stable;
-
- return code;
-}
-
-void
-freeHaskellFunctionPtr(void* ptr)
-{
- IA64FunDesc *fdesc = (IA64FunDesc *)ptr;
- StgWord64 *code = (StgWord64 *)(fdesc+1);
-
- if (fdesc->ip != (StgWord64)code) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr((StgStablePtr)code[16]);
- freeStablePtr((StgStablePtr)code[17]);
-}
=====================================
rts/adjustor/NativePowerPC.c deleted
=====================================
@@ -1,401 +0,0 @@
-/* -----------------------------------------------------------------------------
- * PowerPC architecture adjustor thunk logic.
- * ---------------------------------------------------------------------------*/
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "RtsUtils.h"
-#include "StablePtr.h"
-#include "Adjustor.h"
-
-/* Adjustor logic for PowerPC and PowerPC64 */
-
-#if defined(linux_HOST_OS)
-#include <string.h>
-#endif
-
-// from AdjustorAsm.s
-// not declared as a function so that AIX-style
-// fundescs can never get in the way.
-extern void *adjustorCode;
-
-#if defined(linux_HOST_OS)
-__asm__("obscure_ccall_ret_code:\n\t"
- "lwz 1,0(1)\n\t"
- "lwz 0,4(1)\n\t"
- "mtlr 0\n\t"
- "blr");
-extern void obscure_ccall_ret_code(void);
-#endif /* defined(linux_HOST_OS) */
-
-#if defined(powerpc_HOST_ARCH) && defined(aix_HOST_OS) || defined(powerpc64_HOST_ARCH) && defined(__ELF__) && (!defined(_CALL_ELF) || _CALL_ELF == 1)
-
-/* !!! !!! WARNING: !!! !!!
- * This structure is accessed from AdjustorAsm.s
- * Any changes here have to be mirrored in the offsets there.
- */
-
-typedef struct AdjustorStub {
- /* fundesc-based ABIs */
-#define FUNDESCS
- StgFunPtr code;
- struct AdjustorStub
- *toc;
- void *env;
- StgStablePtr hptr;
- StgFunPtr wptr;
- StgInt negative_framesize;
- StgInt extrawords_plus_one;
-} AdjustorStub;
-
-#endif
-
-void initAdjustors(void) { }
-
-void*
-createAdjustor(StgStablePtr hptr,
- StgFunPtr wptr,
- char *typeString
- )
-{
-#if defined(linux_HOST_OS)
-
-#define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
- /* The PowerPC Linux (32-bit) calling convention is annoyingly complex.
- We need to calculate all the details of the stack frame layout,
- taking into account the types of all the arguments, and then
- generate code on the fly. */
-
- int src_gpr = 3, dst_gpr = 5;
- int fpr = 3;
- int src_offset = 0, dst_offset = 0;
- int n = strlen(typeString),i;
- int src_locs[n], dst_locs[n];
- int frameSize;
-
- /* Step 1:
- Calculate where the arguments should go.
- src_locs[] will contain the locations of the arguments in the
- original stack frame passed to the adjustor.
- dst_locs[] will contain the locations of the arguments after the
- adjustor runs, on entry to the wrapper proc pointed to by wptr.
-
- This algorithm is based on the one described on page 3-19 of the
- System V ABI PowerPC Processor Supplement.
- */
- for(i=0;typeString[i];i++)
- {
- char t = typeString[i];
- if((t == 'f' || t == 'd') && fpr <= 8)
- src_locs[i] = dst_locs[i] = -32-(fpr++);
- else
- {
- if((t == 'l' || t == 'L') && src_gpr <= 9)
- {
- if((src_gpr & 1) == 0)
- src_gpr++;
- src_locs[i] = -src_gpr;
- src_gpr += 2;
- }
- else if((t == 'w' || t == 'W') && src_gpr <= 10)
- {
- src_locs[i] = -(src_gpr++);
- }
- else
- {
- if(t == 'l' || t == 'L' || t == 'd')
- {
- if(src_offset % 8)
- src_offset += 4;
- }
- src_locs[i] = src_offset;
- src_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4;
- }
-
- if((t == 'l' || t == 'L') && dst_gpr <= 9)
- {
- if((dst_gpr & 1) == 0)
- dst_gpr++;
- dst_locs[i] = -dst_gpr;
- dst_gpr += 2;
- }
- else if((t == 'w' || t == 'W') && dst_gpr <= 10)
- {
- dst_locs[i] = -(dst_gpr++);
- }
- else
- {
- if(t == 'l' || t == 'L' || t == 'd')
- {
- if(dst_offset % 8)
- dst_offset += 4;
- }
- dst_locs[i] = dst_offset;
- dst_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4;
- }
- }
- }
-
- frameSize = dst_offset + 8;
- frameSize = (frameSize+15) & ~0xF;
-
- /* Step 2:
- Build the adjustor.
- */
- // allocate space for at most 4 insns per parameter
- // plus 14 more instructions.
- ExecPage *page = allocateExecPage();
- if (page == NULL) {
- barf("createAdjustor: failed to allocate executable page\n");
- }
- unsigned *code = adjustor;
-
- *code++ = 0x48000008; // b *+8
- // * Put the hptr in a place where freeHaskellFunctionPtr
- // can get at it.
- *code++ = (unsigned) hptr;
-
- // * save the link register
- *code++ = 0x7c0802a6; // mflr r0;
- *code++ = 0x90010004; // stw r0, 4(r1);
- // * and build a new stack frame
- *code++ = OP_LO(0x9421, -frameSize); // stwu r1, -frameSize(r1)
-
- // * now generate instructions to copy arguments
- // from the old stack frame into the new stack frame.
- for(i=n-1;i>=0;i--)
- {
- if(src_locs[i] < -32)
- ASSERT(dst_locs[i] == src_locs[i]);
- else if(src_locs[i] < 0)
- {
- // source in GPR.
- ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
- if(dst_locs[i] < 0)
- {
- ASSERT(dst_locs[i] > -32);
- // dst is in GPR, too.
-
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // mr dst+1, src+1
- *code++ = 0x7c000378
- | ((-dst_locs[i]+1) << 16)
- | ((-src_locs[i]+1) << 11)
- | ((-src_locs[i]+1) << 21);
- }
- // mr dst, src
- *code++ = 0x7c000378
- | ((-dst_locs[i]) << 16)
- | ((-src_locs[i]) << 11)
- | ((-src_locs[i]) << 21);
- }
- else
- {
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // stw src+1, dst_offset+4(r1)
- *code++ = 0x90010000
- | ((-src_locs[i]+1) << 21)
- | (dst_locs[i] + 4);
- }
-
- // stw src, dst_offset(r1)
- *code++ = 0x90010000
- | ((-src_locs[i]) << 21)
- | (dst_locs[i] + 8);
- }
- }
- else
- {
- ASSERT(dst_locs[i] >= 0);
- ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
-
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // lwz r0, src_offset(r1)
- *code++ = 0x80010000
- | (src_locs[i] + frameSize + 8 + 4);
- // stw r0, dst_offset(r1)
- *code++ = 0x90010000
- | (dst_locs[i] + 8 + 4);
- }
- // lwz r0, src_offset(r1)
- *code++ = 0x80010000
- | (src_locs[i] + frameSize + 8);
- // stw r0, dst_offset(r1)
- *code++ = 0x90010000
- | (dst_locs[i] + 8);
- }
- }
-
- // * hptr will be the new first argument.
- // lis r3, hi(hptr)
- *code++ = OP_HI(0x3c60, hptr);
- // ori r3,r3,lo(hptr)
- *code++ = OP_LO(0x6063, hptr);
-
- // * we need to return to a piece of code
- // which will tear down the stack frame.
- // lis r11,hi(obscure_ccall_ret_code)
- *code++ = OP_HI(0x3d60, obscure_ccall_ret_code);
- // ori r11,r11,lo(obscure_ccall_ret_code)
- *code++ = OP_LO(0x616b, obscure_ccall_ret_code);
- // mtlr r11
- *code++ = 0x7d6803a6;
-
- // * jump to wptr
- // lis r11,hi(wptr)
- *code++ = OP_HI(0x3d60, wptr);
- // ori r11,r11,lo(wptr)
- *code++ = OP_LO(0x616b, wptr);
- // mtctr r11
- *code++ = 0x7d6903a6;
- // bctr
- *code++ = 0x4e800420;
-
- freezeExecPage(page);
-
- // Flush the Instruction cache:
- {
- unsigned *p = adjustor;
- while(p < code)
- {
- __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
- : : "r" (p));
- p++;
- }
- __asm__ volatile ("sync\n\tisync");
- }
-
-#else
-
-#define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
- /* The following code applies to all PowerPC and PowerPC64 platforms
- whose stack layout is based on the AIX ABI.
-
- Besides (obviously) AIX, this includes
- Mac OS 9 and BeOS/PPC and Mac OS X PPC (may they rest in peace),
- which use the 32-bit AIX ABI
- powerpc64-linux,
- which uses the 64-bit AIX ABI.
-
- The actual stack-frame shuffling is implemented out-of-line
- in the function adjustorCode, in AdjustorAsm.S.
- Here, we set up an AdjustorStub structure, which
- is a function descriptor with a pointer to the AdjustorStub
- struct in the position of the TOC that is loaded
- into register r2.
-
- One nice thing about this is that there is _no_ code generated at
- runtime on the platforms that have function descriptors.
- */
- AdjustorStub *adjustorStub;
- int sz = 0, extra_sz, total_sz;
-
-#if defined(FUNDESCS)
- adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
-#else
- ExecPage *page = allocateExecPage();
- if (page == NULL) {
- barf("createAdjustor: failed to allocate executable page\n");
- }
- adjustorStub = (AdjustorStub *) page;
-#endif /* defined(FUNDESCS) */
- adjustor = adjustorStub;
-
- adjustorStub->code = (void*) &adjustorCode;
-
-#if defined(FUNDESCS)
- // function descriptors are a cool idea.
- // We don't need to generate any code at runtime.
- adjustorStub->toc = adjustorStub;
-#else
-
- // no function descriptors :-(
- // We need to do things "by hand".
-#if defined(powerpc_HOST_ARCH)
- // lis r2, hi(adjustorStub)
- adjustorStub->lis = OP_HI(0x3c40, adjustorStub);
- // ori r2, r2, lo(adjustorStub)
- adjustorStub->ori = OP_LO(0x6042, adjustorStub);
- // lwz r0, code(r2)
- adjustorStub->lwz = OP_LO(0x8002, (char*)(&adjustorStub->code)
- - (char*)adjustorStub);
- // mtctr r0
- adjustorStub->mtctr = 0x7c0903a6;
- // bctr
- adjustorStub->bctr = 0x4e800420;
-
- freezeExecPage(page);
-#else
- barf("adjustor creation not supported on this platform");
-#endif /* defined(powerpc_HOST_ARCH) */
-
- // Flush the Instruction cache:
- {
- int n = sizeof(AdjustorStub)/sizeof(unsigned);
- unsigned *p = (unsigned*)adjustor;
- while(n--)
- {
- __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
- : : "r" (p));
- p++;
- }
- __asm__ volatile ("sync\n\tisync");
- }
-#endif /* defined(FUNDESCS) */
-
- // Calculate the size of the stack frame, in words.
- sz = totalArgumentSize(typeString);
-
- // The first eight words of the parameter area
- // are just "backing store" for the parameters passed in
- // the GPRs. extra_sz is the number of words beyond those first
- // 8 words.
- extra_sz = sz - 8;
- if(extra_sz < 0)
- extra_sz = 0;
-
- // Calculate the total size of the stack frame.
- total_sz = (6 /* linkage area */
- + 8 /* minimum parameter area */
- + 2 /* two extra arguments */
- + extra_sz)*sizeof(StgWord);
-
- // align to 16 bytes.
- // AIX only requires 8 bytes, but who cares?
- total_sz = (total_sz+15) & ~0xF;
-
- // Fill in the information that adjustorCode in AdjustorAsm.S
- // will use to create a new stack frame with the additional args.
- adjustorStub->hptr = hptr;
- adjustorStub->wptr = wptr;
- adjustorStub->negative_framesize = -total_sz;
- adjustorStub->extrawords_plus_one = extra_sz + 1;
-
- return code;
-}
-
-void
-freeHaskellFunctionPtr(void* ptr)
-{
-#if defined(linux_HOST_OS)
- if ( *(StgWord*)ptr != 0x48000008 ) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr(((StgStablePtr*)ptr)[1]);
-#else
- if ( ((AdjustorStub*)ptr)->code != (StgFunPtr) &adjustorCode ) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr(((AdjustorStub*)ptr)->hptr);
-#endif
-
- freeExecPage(ptr);
-}
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -152,10 +152,16 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
be duplicated here, otherwise there will be some
-Wimplicit-function-declaration compilation errors. Especially when
GHC compiles out-of-tree cbits that rely on SET_HDR in RTS API.
+
+ However when RtsFlags.h is imported, we don't want to redefine them to avoid
+ spurious warnings (#24918).
*/
+#if !defined(RTS_FLAGS_DOING_PROFILING)
+#define RTS_FLAGS_DOING_PROFILING 1
bool doingLDVProfiling(void);
bool doingRetainerProfiling(void);
bool doingErasProfiling(void);
+#endif
/*
The following macro works for both retainer profiling and LDV profiling. For
=====================================
rts/rts.cabal
=====================================
@@ -362,11 +362,6 @@ library
else
asm-sources: adjustor/NativeAmd64Asm.S
c-sources: adjustor/NativeAmd64.c
- if arch(ppc) || arch(ppc64)
- asm-sources: AdjustorAsm.S
- c-sources: adjustor/NativePowerPC.c
- if arch(ia64)
- c-sources: adjustor/NativeIA64.c
-- Use assembler STG entrypoint on architectures where it is used
if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64)
=====================================
testsuite/tests/driver/objc/all.T
=====================================
@@ -1,19 +1,11 @@
-def if_not_platform(platforms, f):
- if not (config.platform in platforms):
- return f
- else:
- return normal
-
-skip_if_not_osx = if_not_platform(['i386-apple-darwin','x86_64-apple-darwin'], skip)
-
test('objc-hi',
- [ skip_if_not_osx,
+ [ unless(opsys('darwin'), skip),
objc_src,
expect_fail_for(['ghci']) ],
compile_and_run, ['-framework Foundation'])
test('objcxx-hi',
- [ skip_if_not_osx,
+ [ unless(opsys('darwin'), skip),
objcxx_src,
expect_fail_for(['ghci']) ],
compile_and_run, ['-framework Foundation -lc++'])
=====================================
testsuite/tests/ffi/should_run/Makefile
=====================================
@@ -6,12 +6,10 @@ ffi018_ghci_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) -c ffi018_ghci_c.c
T1288_ghci_setup :
- # Don't show gcc warning: 'stdcall' attribute ignored [-Wattributes]
- '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c -optc=-Wno-attributes T1288_ghci_c.c
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c T1288_ghci_c.c
T2276_ghci_setup :
- # Don't show gcc warning: 'stdcall' attribute ignored [-Wattributes]
- '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c -optc=-Wno-attributes T2276_ghci_c.c
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c T2276_ghci_c.c
ffi002_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) -c ffi002.hs
=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -33,7 +33,6 @@ test('ffi004', skip, compile_and_run, [''])
#
test('ffi005', [ omit_ways(prof_ways),
when(arch('i386'), skip),
- when(platform('i386-apple-darwin'), expect_broken(4105)),
exit_code(3),
req_c ],
compile_and_run, ['ffi005_c.c'])
@@ -101,7 +100,6 @@ test('T1288_ghci',
test('T2276', [req_c], compile_and_run, ['T2276_c.c'])
test('T2276_ghci', [ only_ghci,
- when(opsys('darwin'), skip), # stdcall not supported on OS X
pre_cmd('$MAKE -s --no-print-directory T2276_ghci_setup') ],
compile_and_run, ['-fobject-code T2276_ghci_c.o'])
=====================================
testsuite/tests/numeric/should_run/all.T
=====================================
@@ -7,7 +7,7 @@ test('arith001', normal, compile_and_run, [''])
test('arith002', normal, compile_and_run, [''])
test('arith003', normal, compile_and_run, [''])
test('arith004', normal, compile_and_run, [''])
-test('arith005', when(platform('i386-apple-darwin'), expect_broken_for(7043, ['ghci'])), compile_and_run, [''])
+test('arith005', normal, compile_and_run, [''])
test('arith006', normal, compile_and_run, [''])
test('arith007', normal, compile_and_run, [''])
=====================================
testsuite/tests/rts/T10672/Makefile
=====================================
@@ -5,7 +5,3 @@ include $(TOP)/mk/test.mk
T10672_x64:
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -rtsopts=none -fforce-recomp -lgcc_s_seh-1 -package system-cxx-std-lib
Main.hs Printf.hs cxxy.cpp
-
-T10672_x86:
- '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -rtsopts=none -fforce-recomp -lgcc_s_dw2-1 -package system-cxx-std-lib \
- Main.hs Printf.hs cxxy.cpp
=====================================
testsuite/tests/rts/T10672/all.T
=====================================
@@ -3,9 +3,3 @@ test('T10672_x64',
unless(opsys('mingw32'), skip), unless(arch('x86_64'), skip),
when(opsys('mingw32'), expect_broken(16390))],
makefile_test, ['T10672_x64'])
-
-test('T10672_x86',
- [extra_files(['Main.hs', 'Printf.hs', 'cxxy.cpp']),
- unless(opsys('mingw32'), skip), unless(arch('i386'), skip),
- when(opsys('mingw32'), expect_broken(16390))],
- makefile_test, ['T10672_x86'])
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -38,7 +38,6 @@ test('derefnull',
when(opsys('openbsd'), ignore_stderr),
# SIGBUS on OX X (PPC and x86 only; amd64 gives SEGV)
# The output under OS X is too unstable to readily compare
- when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]),
when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]),
when(platform('aarch64-apple-darwin'), [ignore_stderr, exit_code(139)]),
when(opsys('mingw32'), [ignore_stderr, exit_code(11)]),
@@ -80,7 +79,6 @@ test('divbyzero',
when(opsys('mingw32'), [ignore_stderr, exit_code(8)]),
when(opsys('mingw32'), [fragile(18548)]),
# The output under OS X is too unstable to readily compare
- when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(136)]),
when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(136)]),
# ThreadSanitizer changes the output
when(have_thread_sanitizer(), skip),
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
=====================================
@@ -148,8 +148,6 @@ addPlatformDepCcFlags archOs cc0 = do
let cc1 = addWorkaroundFor7799 archOs cc0
-- As per FPTOOLS_SET_C_LD_FLAGS
case archOs of
- ArchOS ArchX86 OSMinGW32 ->
- return $ cc1 & _ccFlags %++ "-march=i686"
ArchOS ArchX86 OSFreeBSD ->
return $ cc1 & _ccFlags %++ "-march=i686"
ArchOS ArchX86_64 OSSolaris2 ->
@@ -183,4 +181,3 @@ addWorkaroundFor7799 :: ArchOS -> Cc -> Cc
addWorkaroundFor7799 archOs cc
| ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686"
| otherwise = cc
-
=====================================
utils/llvm-targets/gen-data-layout.sh
=====================================
@@ -89,13 +89,10 @@ TARGETS=(
#########################
# macOS
- "i386-apple-darwin"
"x86_64-apple-darwin"
"arm64-apple-darwin"
# iOS
- "armv7-apple-ios"
"arm64-apple-ios"
- "i386-apple-ios"
"x86_64-apple-ios"
#########################
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848d5160f6b84d36ba15cea83bad82641138bbb2...a27ed449621487cc121c765da0d721c88651890b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/848d5160f6b84d36ba15cea83bad82641138bbb2...a27ed449621487cc121c765da0d721c88651890b
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/20240605/dddd6dbd/attachment-0001.html>
More information about the ghc-commits
mailing list