September 2025 - ghc-commits

[Git][ghc/ghc][wip/T26415] Fix tabs in string gaps (#26415)
by Brandon Chinn (＠brandonchinn178) 24 Sep '25

24 Sep '25

Brandon Chinn pushed to branch wip/T26415 at Glasgow Haskell Compiler / GHC Commits: e7ded5c5 by Brandon Chinn at 2025-09-24T08:55:34-07:00 Fix tabs in string gaps (#26415) Tabs in string gaps were broken in bb030d0d because previously, string gaps were manually parsed, but now it's lexed by the usual Alex grammar and post-processed after successful lexing. It broke because of a discrepancy between GHC's lexer grammar and the Haskell Report. The Haskell Report includes tabs in whitechar: whitechar → newline | vertab | space | tab | uniWhite $whitechar used to include tabs until 18 years ago, when it was removed in order to exclude tabs from $white_no_nl in order to warn on tabs: 6e202120. In this MR, I'm adding \t back into $whitechar, and explicitly excluding \t from the $white_no_nl+ rule ignoring all whitespace in source code, which more accurately colocates the "ignore all whitespace except tabs, which is handled in the next line" logic. As a side effect of this MR, tabs are now allowed in pragmas; currently, a pragma written as {-# \t LANGUAGE ... #-} is interpreted as the tab character being the pragma name, and GHC warns "Unrecognized pragma". With this change, tabs are ignored as whitespace, which more closely matches the Report anyway. - - - - - 5 changed files: - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/Lexer/String.x - + testsuite/tests/parser/should_run/T26415.hs - + testsuite/tests/parser/should_run/T26415.stdout - testsuite/tests/parser/should_run/all.T Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -145,7 +145,7 @@ import GHC.Parser.String $unispace = \x05 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $nl = [\n\r\f] $space = [\ $unispace] -$whitechar = [$nl \v $space] +$whitechar = [$nl \t \v $space] $white_no_nl = $whitechar # \n -- TODO #8424 $tab = \t @@ -248,7 +248,7 @@ haskell :- -- Alex "Rules" -- everywhere: skip whitespace -$white_no_nl+ ; +($white_no_nl # \t)+ ; $tab { warnTab } -- Everywhere: deal with nested comments. We explicitly rule out ===================================== compiler/GHC/Parser/Lexer/String.x ===================================== @@ -25,7 +25,7 @@ import GHC.Utils.Panic (panic) $unispace = \x05 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $nl = [\n\r\f] $space = [\ $unispace] -$whitechar = [$nl \v $space] +$whitechar = [$nl \t \v $space] $tab = \t $ascdigit = 0-9 ===================================== testsuite/tests/parser/should_run/T26415.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE MultilineStrings #-} + +main :: IO () +main = do + -- Test tabs in string gaps + print "\ \" + print """\ \""" ===================================== testsuite/tests/parser/should_run/T26415.stdout ===================================== @@ -0,0 +1,2 @@ +"" +"" ===================================== testsuite/tests/parser/should_run/all.T ===================================== @@ -27,6 +27,7 @@ test('RecordDotSyntax4', [extra_files(['RecordDotSyntaxA.hs'])], multimod_compil test('RecordDotSyntax5', normal, compile_and_run, ['']) test('ListTuplePunsConstraints', extra_files(['ListTuplePunsConstraints.hs']), ghci_script, ['ListTuplePunsConstraints.script']) test('T25937', normal, compile_and_run, ['']) +test('T26415', normal, compile_and_run, ['']) # Multiline strings test('MultilineStrings', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7ded5c5032d3702d07c314aa8a0b6c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7ded5c5032d3702d07c314aa8a0b6c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] cleanup: Delete historical artifact of COMPILING_WINDOWS_DLL
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 495886d9 by Rodrigo Mesquita at 2025-09-24T09:50:35-04:00 cleanup: Delete historical artifact of COMPILING_WINDOWS_DLL Namely, drop the obsolete - DLL_IMPORT_RTS - DLL_IMPORT_DATA_VAR - DLL_IMPORT_DATA_VARNAME - DLL_IMPORT_DATA_REF These macros were not doing anything and placed inconsistently Looking at the git logs reveal these macros were used to support dynamic libraries on Win32, a feature that was dropped in b8cfa8f741729ef123569fb321c4b2ab4a1a941c This allows us to get rid of the rts/DLL.h file too. - - - - - 13 changed files: - rts/CloneStack.h - rts/Prelude.h - rts/RtsSymbols.c - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/Stg.h - rts/include/rts/Flags.h - rts/include/rts/NonMoving.h - rts/include/rts/StableName.h - rts/include/rts/StablePtr.h - − rts/include/stg/DLL.h - rts/include/stg/MiscClosures.h - rts/rts.cabal Changes: ===================================== rts/CloneStack.h ===================================== @@ -8,8 +8,8 @@ #pragma once -extern StgClosure DLL_IMPORT_DATA_VARNAME(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure); -#define StackSnapshot_constructor_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure) +extern StgClosure ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure; +#define StackSnapshot_constructor_closure (&(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure)) StgStack* cloneStack(Capability* capability, const StgStack* stack); ===================================== rts/Prelude.h ===================================== @@ -15,8 +15,8 @@ #define PRELUDE_INFO(i) extern W_(i)[] #define PRELUDE_CLOSURE(i) extern W_(i)[] #else -#define PRELUDE_INFO(i) extern const StgInfoTable DLL_IMPORT_DATA_VARNAME(i) -#define PRELUDE_CLOSURE(i) extern StgClosure DLL_IMPORT_DATA_VARNAME(i) +#define PRELUDE_INFO(i) extern const StgInfoTable (i) +#define PRELUDE_CLOSURE(i) extern StgClosure (i) #endif /* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */ @@ -87,58 +87,58 @@ PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W32zh_con_info); PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W64zh_con_info); PRELUDE_INFO(ghczminternal_GHCziInternalziStable_StablePtr_con_info); -#define Unit_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTuple_Z0T_closure) -#define True_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_True_closure) -#define False_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_False_closure) -#define unpackCString_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPack_unpackCString_closure) -#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure) +#define Unit_closure (&(ghczminternal_GHCziInternalziTuple_Z0T_closure)) +#define True_closure (&(ghczminternal_GHCziInternalziTypes_True_closure)) +#define False_closure (&(ghczminternal_GHCziInternalziTypes_False_closure)) +#define unpackCString_closure (&(ghczminternal_GHCziInternalziPack_unpackCString_closure)) +#define runFinalizerBatch_closure (&(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure)) #define mainIO_closure (&ZCMain_main_closure) -#define runSparks_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSync_runSparks_closure) -#define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure) -#define interruptIOManager_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure) -#define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure) -#define runHandlersPtr_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure) +#define runSparks_closure (&(ghczminternal_GHCziInternalziConcziSync_runSparks_closure)) +#define ensureIOManagerIsRunning_closure (&(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure)) +#define interruptIOManager_closure (&(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure)) +#define ioManagerCapabilitiesChanged_closure (&(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure)) +#define runHandlersPtr_closure (&(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure)) #if defined(mingw32_HOST_OS) -#define processRemoteCompletion_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure) +#define processRemoteCompletion_closure (&(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure)) #endif -#define runAllocationLimitHandler_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure) - -#define flushStdHandles_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure) -#define runMainIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure) - -#define stackOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure) -#define heapOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure) -#define allocationLimitExceeded_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure) -#define blockedIndefinitelyOnMVar_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure) -#define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure) -#define cannotCompactFunction_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure) -#define cannotCompactPinned_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure) -#define cannotCompactMutable_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure) -#define nonTermination_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure) -#define nestedAtomically_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure) -#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure) -#define underflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure) -#define overflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure) -#define divZeroException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure) - -#define blockedOnBadFD_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure) - -#define Czh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Czh_con_info) -#define Izh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Izh_con_info) -#define Fzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Fzh_con_info) -#define Dzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Dzh_con_info) -#define Wzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Wzh_con_info) -#define W8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W8zh_con_info) -#define W16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W16zh_con_info) -#define W32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W32zh_con_info) -#define W64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W64zh_con_info) -#define I8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I8zh_con_info) -#define I16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I16zh_con_info) -#define I32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I32zh_con_info) -#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info) -#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info) -#define Ptr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_Ptr_con_info) -#define FunPtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_FunPtr_con_info) -#define StablePtr_static_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_static_info) -#define StablePtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_con_info) +#define runAllocationLimitHandler_closure (&(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure)) + +#define flushStdHandles_closure (&(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure)) +#define runMainIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure)) + +#define stackOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure)) +#define heapOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure)) +#define allocationLimitExceeded_closure (&(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure)) +#define blockedIndefinitelyOnMVar_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure)) +#define blockedIndefinitelyOnSTM_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure)) +#define cannotCompactFunction_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure)) +#define cannotCompactPinned_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure)) +#define cannotCompactMutable_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure)) +#define nonTermination_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure)) +#define nestedAtomically_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure)) +#define absentSumFieldError_closure (&(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure)) +#define underflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure)) +#define overflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure)) +#define divZeroException_closure (&(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure)) + +#define blockedOnBadFD_closure (&(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure)) + +#define Czh_con_info (&(ghczminternal_GHCziInternalziTypes_Czh_con_info)) +#define Izh_con_info (&(ghczminternal_GHCziInternalziTypes_Izh_con_info)) +#define Fzh_con_info (&(ghczminternal_GHCziInternalziTypes_Fzh_con_info)) +#define Dzh_con_info (&(ghczminternal_GHCziInternalziTypes_Dzh_con_info)) +#define Wzh_con_info (&(ghczminternal_GHCziInternalziTypes_Wzh_con_info)) +#define W8zh_con_info (&(ghczminternal_GHCziInternalziWord_W8zh_con_info)) +#define W16zh_con_info (&(ghczminternal_GHCziInternalziWord_W16zh_con_info)) +#define W32zh_con_info (&(ghczminternal_GHCziInternalziWord_W32zh_con_info)) +#define W64zh_con_info (&(ghczminternal_GHCziInternalziWord_W64zh_con_info)) +#define I8zh_con_info (&(ghczminternal_GHCziInternalziInt_I8zh_con_info)) +#define I16zh_con_info (&(ghczminternal_GHCziInternalziInt_I16zh_con_info)) +#define I32zh_con_info (&(ghczminternal_GHCziInternalziInt_I32zh_con_info)) +#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info)) +#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info)) +#define Ptr_con_info (&(ghczminternal_GHCziInternalziPtr_Ptr_con_info)) +#define FunPtr_con_info (&(ghczminternal_GHCziInternalziPtr_FunPtr_con_info)) +#define StablePtr_static_info (&(ghczminternal_GHCziInternalziStable_StablePtr_static_info)) +#define StablePtr_con_info (&(ghczminternal_GHCziInternalziStable_StablePtr_con_info)) ===================================== rts/RtsSymbols.c ===================================== @@ -1054,9 +1054,9 @@ RTS_ARM_OUTLINE_ATOMIC_SYMBOLS #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA }, #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ - (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_CODE }, + (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE }, #define SymE_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ - (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_DATA }, + (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA }, #define SymI_NeedsProto(vvv) SymI_HasProto(vvv) #define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv) ===================================== rts/include/Rts.h ===================================== @@ -265,9 +265,9 @@ void _warnFail(const char *filename, unsigned int linenum); #include "rts/LibdwPool.h" /* Misc stuff without a home */ -DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ -DLL_IMPORT_RTS extern int prog_argc; -DLL_IMPORT_RTS extern char *prog_name; +extern char **prog_argv; /* so we can get at these from Haskell */ +extern int prog_argc; +extern char *prog_name; void reportStackOverflow(StgTSO* tso); void reportHeapOverflow(void); ===================================== rts/include/RtsAPI.h ===================================== @@ -587,8 +587,8 @@ void rts_done (void); extern StgClosure ghczminternal_GHCziInternalziTopHandler_runIO_closure; extern StgClosure ghczminternal_GHCziInternalziTopHandler_runNonIO_closure; -#define runIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runIO_closure) -#define runNonIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure) +#define runIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runIO_closure)) +#define runNonIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure)) /* ------------------------------------------------------------------------ */ ===================================== rts/include/Stg.h ===================================== @@ -332,7 +332,6 @@ external prototype return neither of these types to workaround #11395. Other Stg stuff... -------------------------------------------------------------------------- */ -#include "stg/DLL.h" #include "stg/MachRegsForHost.h" #include "stg/Regs.h" #include "stg/Ticky.h" ===================================== rts/include/rts/Flags.h ===================================== @@ -358,7 +358,7 @@ typedef struct _RTS_FLAGS { } RTS_FLAGS; #if defined(COMPILING_RTS_MAIN) -extern DLLIMPORT RTS_FLAGS RtsFlags; +extern RTS_FLAGS RtsFlags; #elif IN_STG_CODE /* Note [RtsFlags is a pointer in STG code] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== rts/include/rts/NonMoving.h ===================================== @@ -19,10 +19,10 @@ struct StgThunk_; struct Capability_; /* This is called by the code generator */ -extern DLL_IMPORT_RTS +extern void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p); -extern DLL_IMPORT_RTS +extern void updateRemembSetPushThunk_(StgRegTable *reg, struct StgThunk_ *p); // Forward declaration for unregisterised backend. @@ -31,7 +31,7 @@ EF_(stg_copyArray_barrier); // Note that RTS code should not condition on this directly by rather // use the IF_NONMOVING_WRITE_BARRIER_ENABLED macro to ensure that // the barrier is eliminated in the non-threaded RTS. -extern StgWord DLL_IMPORT_DATA_VAR(nonmoving_write_barrier_enabled); +extern StgWord nonmoving_write_barrier_enabled; // A similar macro is defined in rts/include/Cmm.h for C-- code. #if defined(THREADED_RTS) ===================================== rts/include/rts/StableName.h ===================================== @@ -29,4 +29,4 @@ typedef struct { // free } snEntry; -extern DLL_IMPORT_RTS snEntry *stable_name_table; +extern snEntry *stable_name_table; ===================================== rts/include/rts/StablePtr.h ===================================== @@ -26,7 +26,7 @@ typedef struct { // otherwise. } spEntry; -extern DLL_IMPORT_RTS spEntry *stable_ptr_table; +extern spEntry *stable_ptr_table; ATTR_ALWAYS_INLINE EXTERN_INLINE StgPtr deRefStablePtr(StgStablePtr sp) ===================================== rts/include/stg/DLL.h deleted ===================================== @@ -1,35 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1998-2009 - * - * Support for Windows DLLs. - * - * Do not #include this file directly: #include "Rts.h" instead. - * - * To understand the structure of the RTS headers, see the wiki: - * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes - * - * ---------------------------------------------------------------------------*/ - -#pragma once - -# define DLL_IMPORT_DATA_REF(x) (&(x)) -# define DLL_IMPORT_DATA_VARNAME(x) x -# define DLLIMPORT - -/* The view of the rts/include/ header files differ ever so - slightly depending on whether the RTS is being compiled - or not - so we're forced to distinguish between two. - [oh, you want details :) : Data symbols defined by the RTS - have to be accessed through an extra level of indirection - when compiling generated .hc code compared to when the RTS - sources are being processed. This is only the case when - using Win32 DLLs. ] -*/ -#if defined(COMPILING_RTS) -#define DLL_IMPORT_RTS -#define DLL_IMPORT_DATA_VAR(x) x -#else -#define DLL_IMPORT_RTS DLLIMPORT -#define DLL_IMPORT_DATA_VAR(x) x -#endif ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -25,14 +25,14 @@ # define RTS_THUNK_INFO(i) extern const W_(i)[] # define RTS_INFO(i) extern const W_(i)[] # define RTS_CLOSURE(i) extern W_(i)[] -# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +# define RTS_FUN_DECL(f) extern StgFunPtr f(void) #else -# define RTS_RET_INFO(i) extern DLL_IMPORT_RTS const StgRetInfoTable i -# define RTS_FUN_INFO(i) extern DLL_IMPORT_RTS const StgFunInfoTable i -# define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i -# define RTS_INFO(i) extern DLL_IMPORT_RTS const StgInfoTable i -# define RTS_CLOSURE(i) extern DLL_IMPORT_RTS StgClosure i -# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +# define RTS_RET_INFO(i) extern const StgRetInfoTable i +# define RTS_FUN_INFO(i) extern const StgFunInfoTable i +# define RTS_THUNK_INFO(i) extern const StgThunkInfoTable i +# define RTS_INFO(i) extern const StgInfoTable i +# define RTS_CLOSURE(i) extern StgClosure i +# define RTS_FUN_DECL(f) extern StgFunPtr f(void) #endif #if defined(TABLES_NEXT_TO_CODE) @@ -274,11 +274,11 @@ RTS_CLOSURE(stg_NO_TREC_closure); RTS_ENTRY(stg_NO_FINALIZER); #if IN_STG_CODE -extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure; -extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure; +extern StgWordArray stg_CHARLIKE_closure; +extern StgWordArray stg_INTLIKE_closure; #else -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[]; -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[]; +extern StgIntCharlikeClosure stg_CHARLIKE_closure[]; +extern StgIntCharlikeClosure stg_INTLIKE_closure[]; #endif /* StgStartup */ ===================================== rts/rts.cabal ===================================== @@ -334,7 +334,6 @@ library rts/storage/InfoTables.h rts/storage/MBlock.h rts/storage/TSO.h - stg/DLL.h stg/MachRegs.h stg/MachRegs/arm32.h stg/MachRegs/arm64.h View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/495886d9d92def9e39234cfa18ba830… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/495886d9d92def9e39234cfa18ba830… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] User's guide: clarify optimisation of INLINABLE unfoldings
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a7f15858 by sheaf at 2025-09-24T09:49:53-04:00 User's guide: clarify optimisation of INLINABLE unfoldings This updates the user's guide section on INLINABLE pragmas to explain how the unfoldings of inlineable functions are optimised. The user's guide incorrectly stated that the RHS was not optimised at all, but this is not true. Instead, GHC is careful about phase control to optmise the RHS while retaining the guarantee that GHC behaves as if the original RHS had been written. - - - - - 1 changed file: - docs/users_guide/exts/pragmas.rst Changes: ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -486,17 +486,18 @@ behaviour: optimisation level etc. - Like ``INLINE``, the ``INLINABLE`` pragma retains a copy of the - original RHS for inlining purposes, and persists it in the interface + RHS for inlining purposes, and persists it in the interface file, regardless of the size of the RHS. + The RHS will be carefully optimised so that, when the function + inlines, GHC behaves as if the original RHS had been inlined. - One way to use ``INLINABLE`` is in conjunction with the special function ``inline`` (:ref:`special-ids`). The call ``inline f`` tries very hard to inline ``f``. To make sure that ``f`` can be inlined, it is a good idea to mark the definition of ``f`` as ``INLINABLE``, so that GHC guarantees to expose an unfolding regardless of how big it - is. Moreover, by annotating ``f`` as ``INLINABLE``, you ensure that - ``f``\'s original RHS is inlined, rather than whatever random - optimised version of ``f`` GHC's optimiser has produced. + is. You can also provide an explicit :ref:`phase-control` on the + ``INLINABLE`` pragma to ensure that RULES have a chance of firing first. - The ``INLINABLE`` pragma also works with ``SPECIALISE``: if you mark function ``f`` as ``INLINABLE``, then you can subsequently View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7f1585808606490bbdd2c7dc966ca9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7f1585808606490bbdd2c7dc966ca9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: RV64: Fix: Add missing truncation to MO_S_Shr (#26248)
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c4d32493 by Sven Tennie at 2025-09-23T20:40:57-04:00 RV64: Fix: Add missing truncation to MO_S_Shr (#26248) Sub-double word (<W64) registers need to be truncated after the operation. - - - - - 41dce477 by Sven Tennie at 2025-09-23T20:40:57-04:00 RV64: Cleanup shift emitting cases/code Remove overlapping cases to make the shift logic easier to understand. - - - - - 0a601c30 by Alex Washburn at 2025-09-23T20:41:41-04:00 Correcting LLVM linking of Intel BMI intrinsics pdep{8,16} and pext{8,16}. This patch fixes #26065. The LLVM interface does not expose bindings to: - llvm.x86.bmi.pdep.8 - llvm.x86.bmi.pdep.16 - llvm.x86.bmi.pext.8 - llvm.x86.bmi.pext.16 So calls are instead made to llvm.x86.bmi.{pdep,pext}.32 in these cases, with pre/post-operation truncation to constrain the logical value range. - - - - - 89e8ff3d by Peng Fan at 2025-09-23T20:42:37-04:00 NCG/LA64: Implement MO_BSwap and MO_BRev with bit-manipulation Instructions - - - - - 50f6be09 by Sylvain Henry at 2025-09-23T20:43:29-04:00 Allow Core plugins to access unoptimized Core (#23337) Make the first simple optimization pass after desugaring a real CoreToDo pass. This allows CorePlugins to decide whether they want to be executed before or after this pass. - - - - - 30ef0aac by Simon Hengel at 2025-09-23T20:44:12-04:00 docs: Fix typo in scoped_type_variables.rst - - - - - f8919262 by Cheng Shao at 2025-09-23T20:44:54-04:00 ghci: fix bootstrapping with 9.12.3-rc1 and above This patch fixes bootstrapping GHC with 9.12.3-rc1 and above. ghci defines `Binary` instance for `HalfWord` in `ghc-heap`, which is a proper `newtype` in 9.14 and starting from 9.12.3. Given we don't build `ghc-heap` in stage0, we need to fix this predicate so that it corresponds to the boot ghc versions that contain the right version of `ghc-heap`. - - - - - ee2c6fa3 by sheaf at 2025-09-24T05:59:35-04:00 User's guide: clarify optimisation of INLINABLE unfoldings This updates the user's guide section on INLINABLE pragmas to explain how the unfoldings of inlineable functions are optimised. The user's guide incorrectly stated that the RHS was not optimised at all, but this is not true. Instead, GHC is careful about phase control to optmise the RHS while retaining the guarantee that GHC behaves as if the original RHS had been written. - - - - - 73cefd08 by Rodrigo Mesquita at 2025-09-24T05:59:36-04:00 cleanup: Delete historical artifact of COMPILING_WINDOWS_DLL Namely, drop the obsolete - DLL_IMPORT_RTS - DLL_IMPORT_DATA_VAR - DLL_IMPORT_DATA_VARNAME - DLL_IMPORT_DATA_REF These macros were not doing anything and placed inconsistently Looking at the git logs reveal these macros were used to support dynamic libraries on Win32, a feature that was dropped in b8cfa8f741729ef123569fb321c4b2ab4a1a941c This allows us to get rid of the rts/DLL.h file too. - - - - - 30 changed files: - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Instr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs - compiler/GHC/HsToCore.hs - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/scoped_type_variables.rst - libraries/ghci/GHCi/Message.hs - rts/CloneStack.h - rts/Prelude.h - rts/RtsSymbols.c - rts/include/Rts.h - rts/include/RtsAPI.h - rts/include/Stg.h - rts/include/rts/Flags.h - rts/include/rts/NonMoving.h - rts/include/rts/StableName.h - rts/include/rts/StablePtr.h - − rts/include/stg/DLL.h - rts/include/stg/MiscClosures.h - rts/rts.cabal - + testsuite/tests/llvm/should_run/T26065.hs - + testsuite/tests/llvm/should_run/T26065.stdout - testsuite/tests/llvm/should_run/all.T - testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs - testsuite/tests/plugins/late-plugin/LatePlugin.hs - testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs Changes: ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -1805,6 +1805,49 @@ genCCall target dest_regs arg_regs = do where shift = (widthToInt w) + PrimTarget (MO_BSwap w) + | w `elem` [W16, W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + case w of + W64 -> return ( code_x `appOL` toOL + [ + REVBD (OpReg w dst_reg) (OpReg w reg_x) + ]) + W32 -> return ( code_x `appOL` toOL + [ + REVB2W (OpReg w dst_reg) (OpReg w reg_x) + ]) + _ -> return ( code_x `appOL` toOL + [ + REVB2H (OpReg w dst_reg) (OpReg w reg_x) + ]) + | otherwise -> unsupported (MO_BSwap w) + + PrimTarget (MO_BRev w) + | w `elem` [W8, W16, W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + case w of + W8 -> return ( code_x `appOL` toOL + [ + BITREV4B (OpReg W32 reg_x) (OpReg W32 reg_x), + AND (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 255)) + ]) + W16 -> return ( code_x `appOL` toOL + [ + BITREV (OpReg W64 reg_x) (OpReg W64 reg_x), + SRL (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 48)) + ]) + _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x)) + | otherwise -> unsupported (MO_BRev w) + -- mop :: CallishMachOp (see GHC.Cmm.MachOp) PrimTarget mop -> do -- We'll need config to construct forien targets @@ -1939,8 +1982,6 @@ genCCall target dest_regs arg_regs = do MO_PopCnt w -> mkCCall (popCntLabel w) MO_Pdep w -> mkCCall (pdepLabel w) MO_Pext w -> mkCCall (pextLabel w) - MO_BSwap w -> mkCCall (bSwapLabel w) - MO_BRev w -> mkCCall (bRevLabel w) -- or a possibly side-effecting machine operation mo@(MO_AtomicRead w ord) ===================================== compiler/GHC/CmmToAsm/LA64/Instr.hs ===================================== @@ -126,8 +126,7 @@ regUsageOfInstr platform instr = case instr of REVHD dst src1 -> usage (regOp src1, regOp dst) BITREV4B dst src1 -> usage (regOp src1, regOp dst) BITREV8B dst src1 -> usage (regOp src1, regOp dst) - BITREVW dst src1 -> usage (regOp src1, regOp dst) - BITREVD dst src1 -> usage (regOp src1, regOp dst) + BITREV dst src1 -> usage (regOp src1, regOp dst) BSTRINS _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) BSTRPICK _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) MASKEQZ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -309,8 +308,7 @@ patchRegsOfInstr instr env = case instr of REVHD o1 o2 -> REVHD (patchOp o1) (patchOp o2) BITREV4B o1 o2 -> BITREV4B (patchOp o1) (patchOp o2) BITREV8B o1 o2 -> BITREV8B (patchOp o1) (patchOp o2) - BITREVW o1 o2 -> BITREVW (patchOp o1) (patchOp o2) - BITREVD o1 o2 -> BITREVD (patchOp o1) (patchOp o2) + BITREV o1 o2 -> BITREV (patchOp o1) (patchOp o2) BSTRINS f o1 o2 o3 o4 -> BSTRINS f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) BSTRPICK f o1 o2 o3 o4 -> BSTRPICK f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) MASKEQZ o1 o2 o3 -> MASKEQZ (patchOp o1) (patchOp o2) (patchOp o3) @@ -700,8 +698,7 @@ data Instr | REVHD Operand Operand | BITREV4B Operand Operand | BITREV8B Operand Operand - | BITREVW Operand Operand - | BITREVD Operand Operand + | BITREV Operand Operand | BSTRINS Format Operand Operand Operand Operand | BSTRPICK Format Operand Operand Operand Operand | MASKEQZ Operand Operand Operand @@ -824,8 +821,7 @@ instrCon i = REVHD{} -> "REVHD" BITREV4B{} -> "BITREV4B" BITREV8B{} -> "BITREV8B" - BITREVW{} -> "BITREVW" - BITREVD{} -> "BITREVD" + BITREV{} -> "BITREV" BSTRINS{} -> "BSTRINS" BSTRPICK{} -> "BSTRPICK" MASKEQZ{} -> "MASKEQZ" ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -802,8 +802,9 @@ pprInstr platform instr = case instr of -- BITREV.{W/D} BITREV4B o1 o2 -> op2 (text "\tbitrev.4b") o1 o2 BITREV8B o1 o2 -> op2 (text "\tbitrev.8b") o1 o2 - BITREVW o1 o2 -> op2 (text "\tbitrev.w") o1 o2 - BITREVD o1 o2 -> op2 (text "\tbitrev.d") o1 o2 + BITREV o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tbitrev.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tbitrev.d") o1 o2 -- BSTRINS.{W/D} BSTRINS II64 o1 o2 o3 o4 -> op4 (text "\tbstrins.d") o1 o2 o3 o4 BSTRINS II32 o1 o2 o3 o4 -> op4 (text "\tbstrins.w") o1 o2 o3 o4 ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -874,46 +874,18 @@ getRegister' config plat expr = ) -- 2. Shifts. x << n, x >> n. - CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] - | w == W32, - 0 <= n, - n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - `appOL` truncateReg w w dst - ) - CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] - | w == W64, - 0 <= n, - n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - `appOL` truncateReg w w dst - ) - CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do - (reg_x, format_x, code_x) <- getSomeReg x - (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do + (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) ( \dst -> code_x - `appOL` code_x' - `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_S_Shr w) [x, y] -> do + CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x return $ Any @@ -921,72 +893,20 @@ getRegister' config plat expr = ( \dst -> code_x `appOL` code_x' - `appOL` code_y - `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y)) + `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W8, - 0 <= n, - n < 8 -> do - (reg_x, format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W16, - 0 <= n, - n < 16 -> do - (reg_x, format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do + CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y return $ Any (intFormat w) ( \dst -> code_x - `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W32, - 0 <= n, - n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W64, - 0 <= n, - n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - -- 3. Logic &&, || CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -240,12 +240,25 @@ genCall (PrimTarget op@(MO_BRev w)) [dst] args = genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_BSwap w)) [dst] args = genCallSimpleCast w op dst args -genCall (PrimTarget op@(MO_Pdep w)) [dst] args = - genCallSimpleCast w op dst args -genCall (PrimTarget op@(MO_Pext w)) [dst] args = - genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_PopCnt w)) [dst] args = genCallSimpleCast w op dst args +{- Note [LLVM PDep/PExt intrinsics] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since x86 PDep/PExt instructions only exist for 32/64 bit widths +we use the 32bit variant to compute the 8/16bit primops. +To do so we extend/truncate the argument/result around the +call. +-} +genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do + cfg <- getConfig + if llvmCgBmiVersion cfg >= Just BMI2 + then genCallMinimumTruncationCast W32 w op dst args + else genCallSimpleCast w op dst args +genCall (PrimTarget op@(MO_Pext w)) [dst] args = do + cfg <- getConfig + if llvmCgBmiVersion cfg >= Just BMI2 + then genCallMinimumTruncationCast W32 w op dst args + else genCallSimpleCast w op dst args genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do addrVar <- exprToVarW addr @@ -641,8 +654,15 @@ genCallExtract _ _ _ _ = -- from i32 to i8 explicitly as LLVM is strict about types. genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual] -> LlvmM StmtData -genCallSimpleCast specW op dst args = do - let width = widthToLlvmInt specW +genCallSimpleCast w = genCallMinimumTruncationCast w w + +-- Given the minimum machine bit-width to use and the logical bit-width of the +-- value range, perform a type-cast truncation and extension before and after the +-- specified operation, respectively. +genCallMinimumTruncationCast :: Width -> Width -> CallishMachOp -> CmmFormal + -> [CmmActual] -> LlvmM StmtData +genCallMinimumTruncationCast minW specW op dst args = do + let width = widthToLlvmInt $ max minW specW argsW = const width <$> args dstType = cmmToLlvmType $ localRegType dst signage = cmmPrimOpRetValSignage op @@ -945,9 +965,10 @@ cmmPrimOpFunctions mop = do W256 -> fsLit "llvm.cttz.i256" W512 -> fsLit "llvm.cttz.i512" MO_Pdep w + -- See Note [LLVM PDep/PExt intrinsics] | isBmi2Enabled -> case w of - W8 -> fsLit "llvm.x86.bmi.pdep.8" - W16 -> fsLit "llvm.x86.bmi.pdep.16" + W8 -> fsLit "llvm.x86.bmi.pdep.32" + W16 -> fsLit "llvm.x86.bmi.pdep.32" W32 -> fsLit "llvm.x86.bmi.pdep.32" W64 -> fsLit "llvm.x86.bmi.pdep.64" W128 -> fsLit "llvm.x86.bmi.pdep.128" @@ -963,8 +984,9 @@ cmmPrimOpFunctions mop = do W512 -> fsLit "hs_pdep512" MO_Pext w | isBmi2Enabled -> case w of - W8 -> fsLit "llvm.x86.bmi.pext.8" - W16 -> fsLit "llvm.x86.bmi.pext.16" + -- See Note [LLVM PDep/PExt intrinsics] + W8 -> fsLit "llvm.x86.bmi.pext.32" + W16 -> fsLit "llvm.x86.bmi.pext.32" W32 -> fsLit "llvm.x86.bmi.pext.32" W64 -> fsLit "llvm.x86.bmi.pext.64" W128 -> fsLit "llvm.x86.bmi.pext.128" ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env +import GHC.Driver.Config (initSimpleOpts) import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) @@ -21,9 +22,10 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) import GHC.Core +import GHC.Core.SimpleOpt (simpleOptPgm) import GHC.Core.Opt.CSE ( cseProgram ) import GHC.Core.Rules ( RuleBase, ruleCheckProgram, getRules ) -import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Ppr ( pprCoreBindings, pprRules ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) @@ -202,10 +204,14 @@ getCoreToDo dflags hpt_rule_base extra_vars core_todo = [ - -- We want to do the static argument transform before full laziness as it - -- may expose extra opportunities to float things outwards. However, to fix - -- up the output of the transformation we need at do at least one simplify - -- after this before anything else + -- We always perform a run of the simple optimizer after desugaring to + -- remove really bad code + CoreDesugarOpt, + + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), -- initial simplify: mk specialiser happy: minimum effort please @@ -467,6 +473,7 @@ doCorePass pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) let updateBinds f = return $ guts { mg_binds = f (mg_binds guts) } let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' } + let updateBindsAndRulesM f = f (mg_binds guts) (mg_rules guts) >>= \(b',r') -> return $ guts { mg_binds = b', mg_rules = r' } -- Important to force this now as name_ppr_ctx lives through an entire phase in -- the optimiser and if it's not forced then the entire previous `ModGuts` will -- be retained until the end of the phase. (See #24328 for more analysis) @@ -479,6 +486,9 @@ doCorePass pass guts = do case pass of + CoreDesugarOpt -> {-# SCC "DesugarOpt" #-} + updateBindsAndRulesM (desugarOpt dflags logger (mg_module guts)) + CoreDoSimplify opts -> {-# SCC "Simplify" #-} liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) name_ppr_ctx opts guts @@ -537,7 +547,6 @@ doCorePass pass guts = do CoreDoPluginPass _ p -> {-# SCC "Plugin" #-} p guts CoreDesugar -> pprPanic "doCorePass" (ppr pass) - CoreDesugarOpt -> pprPanic "doCorePass" (ppr pass) CoreTidy -> pprPanic "doCorePass" (ppr pass) CorePrep -> pprPanic "doCorePass" (ppr pass) @@ -580,3 +589,22 @@ dmdAnal logger before_ww dflags fam_envs rules binds = do dumpIdInfoOfProgram (hasPprDebug dflags) (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds + + +-- | Simple optimization after desugaring. +-- +-- This performs some quick basic optimizations even with -O0. +-- See Note [The simple optimiser] for details. +-- +-- We could call it directly in the desugarer but we implement it as the first +-- Core-to-Core pass to accomodate Core plugins that want to see Core even +-- before the first (simple) optimization took place. See #23337 +desugarOpt :: DynFlags -> Logger -> Module -> CoreProgram -> [CoreRule] -> CoreM (CoreProgram,[CoreRule]) +desugarOpt dflags logger mod binds rules = liftIO $ do + let simpl_opts = initSimpleOpts dflags + let !(ds_binds, ds_rules_for_imps, occ_anald_binds) = simpleOptPgm simpl_opts mod binds rules + + putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" + FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps ) + + pure (ds_binds, ds_rules_for_imps) ===================================== compiler/GHC/Core/Opt/Pipeline/Types.hs ===================================== @@ -58,8 +58,7 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoPasses [CoreToDo] -- lists of these things | CoreDesugar -- Right after desugaring, no simple optimisation yet! - | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces - -- Core output, and hence useful to pass to endPass + | CoreDesugarOpt -- Simple optimisation after desugaring | CoreTidy | CorePrep ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -48,7 +48,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons ) import GHC.Core import GHC.Core.FVs ( exprsSomeFreeVarsList, exprFreeVars ) -import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr ) +import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Utils import GHC.Core.Unfold.Make import GHC.Core.Coercion @@ -200,27 +200,18 @@ deSugar hsc_env do { -- Add export flags to bindings keep_alive <- readIORef keep_var - ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules + ; let (rules_for_locals, ds_rules_for_imps) = partition isLocalRule all_rules final_prs = addExportFlagsAndRules bcknd export_set keep_alive rules_for_locals (fromOL all_prs) - final_pgm = combineEvBinds ds_ev_binds final_prs + ds_binds = combineEvBinds ds_ev_binds final_prs -- Notice that we put the whole lot in a big Rec, even the foreign binds -- When compiling PrelFloat, which defines data Float = F# Float# -- we want F# to be in scope in the foreign marshalling code! -- You might think it doesn't matter, but the simplifier brings all top-level -- things into the in-scope set before simplifying; so we get no unfolding for F#! - ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar final_pgm rules_for_imps - ; let simpl_opts = initSimpleOpts dflags - ; let (ds_binds, ds_rules_for_imps, occ_anald_binds) - = simpleOptPgm simpl_opts mod final_pgm rules_for_imps - -- The simpleOptPgm gets rid of type - -- bindings plus any stupid dead code - ; putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" - FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps ) - - ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps + ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar ds_binds ds_rules_for_imps ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) home_unit = hsc_home_unit hsc_env ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -486,17 +486,18 @@ behaviour: optimisation level etc. - Like ``INLINE``, the ``INLINABLE`` pragma retains a copy of the - original RHS for inlining purposes, and persists it in the interface + RHS for inlining purposes, and persists it in the interface file, regardless of the size of the RHS. + The RHS will be carefully optimised so that, when the function + inlines, GHC behaves as if the original RHS had been inlined. - One way to use ``INLINABLE`` is in conjunction with the special function ``inline`` (:ref:`special-ids`). The call ``inline f`` tries very hard to inline ``f``. To make sure that ``f`` can be inlined, it is a good idea to mark the definition of ``f`` as ``INLINABLE``, so that GHC guarantees to expose an unfolding regardless of how big it - is. Moreover, by annotating ``f`` as ``INLINABLE``, you ensure that - ``f``\'s original RHS is inlined, rather than whatever random - optimised version of ``f`` GHC's optimiser has produced. + is. You can also provide an explicit :ref:`phase-control` on the + ``INLINABLE`` pragma to ensure that RULES have a chance of firing first. - The ``INLINABLE`` pragma also works with ``SPECIALISE``: if you mark function ``f`` as ``INLINABLE``, then you can subsequently ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,7 +6,7 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Lexically scope explicitly-introduced type variables. + :shortdesc: Lexically scoped explicitly-introduced type variables. :implies: :extension:`ExplicitForAll` ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -525,7 +525,7 @@ instance Binary (FunPtr a) where put = put . castFunPtrToPtr get = castPtrToFunPtr <$> get -#if MIN_VERSION_ghc_internal(9,1500,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,12,2,20250919) instance Binary Heap.HalfWord where put x = put (fromIntegral x :: Word32) get = fromIntegral <$> (get :: Get Word32) ===================================== rts/CloneStack.h ===================================== @@ -8,8 +8,8 @@ #pragma once -extern StgClosure DLL_IMPORT_DATA_VARNAME(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure); -#define StackSnapshot_constructor_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure) +extern StgClosure ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure; +#define StackSnapshot_constructor_closure (&(ghczminternal_GHCziInternalziStackziCloneStack_StackSnapshot_closure)) StgStack* cloneStack(Capability* capability, const StgStack* stack); ===================================== rts/Prelude.h ===================================== @@ -15,8 +15,8 @@ #define PRELUDE_INFO(i) extern W_(i)[] #define PRELUDE_CLOSURE(i) extern W_(i)[] #else -#define PRELUDE_INFO(i) extern const StgInfoTable DLL_IMPORT_DATA_VARNAME(i) -#define PRELUDE_CLOSURE(i) extern StgClosure DLL_IMPORT_DATA_VARNAME(i) +#define PRELUDE_INFO(i) extern const StgInfoTable (i) +#define PRELUDE_CLOSURE(i) extern StgClosure (i) #endif /* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */ @@ -87,58 +87,58 @@ PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W32zh_con_info); PRELUDE_INFO(ghczminternal_GHCziInternalziWord_W64zh_con_info); PRELUDE_INFO(ghczminternal_GHCziInternalziStable_StablePtr_con_info); -#define Unit_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTuple_Z0T_closure) -#define True_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_True_closure) -#define False_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_False_closure) -#define unpackCString_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPack_unpackCString_closure) -#define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure) +#define Unit_closure (&(ghczminternal_GHCziInternalziTuple_Z0T_closure)) +#define True_closure (&(ghczminternal_GHCziInternalziTypes_True_closure)) +#define False_closure (&(ghczminternal_GHCziInternalziTypes_False_closure)) +#define unpackCString_closure (&(ghczminternal_GHCziInternalziPack_unpackCString_closure)) +#define runFinalizerBatch_closure (&(ghczminternal_GHCziInternalziWeakziFinalizze_runFinalizzerBatch_closure)) #define mainIO_closure (&ZCMain_main_closure) -#define runSparks_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSync_runSparks_closure) -#define ensureIOManagerIsRunning_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure) -#define interruptIOManager_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure) -#define ioManagerCapabilitiesChanged_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure) -#define runHandlersPtr_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure) +#define runSparks_closure (&(ghczminternal_GHCziInternalziConcziSync_runSparks_closure)) +#define ensureIOManagerIsRunning_closure (&(ghczminternal_GHCziInternalziConcziIO_ensureIOManagerIsRunning_closure)) +#define interruptIOManager_closure (&(ghczminternal_GHCziInternalziConcziIO_interruptIOManager_closure)) +#define ioManagerCapabilitiesChanged_closure (&(ghczminternal_GHCziInternalziConcziIO_ioManagerCapabilitiesChanged_closure)) +#define runHandlersPtr_closure (&(ghczminternal_GHCziInternalziConcziSignal_runHandlersPtr_closure)) #if defined(mingw32_HOST_OS) -#define processRemoteCompletion_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure) +#define processRemoteCompletion_closure (&(ghczminternal_GHCziInternalziEventziWindows_processRemoteCompletion_closure)) #endif -#define runAllocationLimitHandler_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure) - -#define flushStdHandles_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure) -#define runMainIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure) - -#define stackOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure) -#define heapOverflow_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure) -#define allocationLimitExceeded_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure) -#define blockedIndefinitelyOnMVar_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure) -#define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure) -#define cannotCompactFunction_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure) -#define cannotCompactPinned_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure) -#define cannotCompactMutable_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure) -#define nonTermination_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure) -#define nestedAtomically_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure) -#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure) -#define underflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure) -#define overflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure) -#define divZeroException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure) - -#define blockedOnBadFD_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure) - -#define Czh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Czh_con_info) -#define Izh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Izh_con_info) -#define Fzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Fzh_con_info) -#define Dzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Dzh_con_info) -#define Wzh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTypes_Wzh_con_info) -#define W8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W8zh_con_info) -#define W16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W16zh_con_info) -#define W32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W32zh_con_info) -#define W64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziWord_W64zh_con_info) -#define I8zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I8zh_con_info) -#define I16zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I16zh_con_info) -#define I32zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I32zh_con_info) -#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info) -#define I64zh_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziInt_I64zh_con_info) -#define Ptr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_Ptr_con_info) -#define FunPtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziPtr_FunPtr_con_info) -#define StablePtr_static_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_static_info) -#define StablePtr_con_info DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziStable_StablePtr_con_info) +#define runAllocationLimitHandler_closure (&(ghczminternal_GHCziInternalziAllocationLimitHandler_runAllocationLimitHandler_closure)) + +#define flushStdHandles_closure (&(ghczminternal_GHCziInternalziTopHandler_flushStdHandles_closure)) +#define runMainIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runMainIO_closure)) + +#define stackOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_stackOverflow_closure)) +#define heapOverflow_closure (&(ghczminternal_GHCziInternalziIOziException_heapOverflow_closure)) +#define allocationLimitExceeded_closure (&(ghczminternal_GHCziInternalziIOziException_allocationLimitExceeded_closure)) +#define blockedIndefinitelyOnMVar_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnMVar_closure)) +#define blockedIndefinitelyOnSTM_closure (&(ghczminternal_GHCziInternalziIOziException_blockedIndefinitelyOnSTM_closure)) +#define cannotCompactFunction_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactFunction_closure)) +#define cannotCompactPinned_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactPinned_closure)) +#define cannotCompactMutable_closure (&(ghczminternal_GHCziInternalziIOziException_cannotCompactMutable_closure)) +#define nonTermination_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nonTermination_closure)) +#define nestedAtomically_closure (&(ghczminternal_GHCziInternalziControlziExceptionziBase_nestedAtomically_closure)) +#define absentSumFieldError_closure (&(ghczminternal_GHCziInternalziPrimziPanic_absentSumFieldError_closure)) +#define underflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_underflowException_closure)) +#define overflowException_closure (&(ghczminternal_GHCziInternalziExceptionziType_overflowException_closure)) +#define divZeroException_closure (&(ghczminternal_GHCziInternalziExceptionziType_divZZeroException_closure)) + +#define blockedOnBadFD_closure (&(ghczminternal_GHCziInternalziEventziThread_blockedOnBadFD_closure)) + +#define Czh_con_info (&(ghczminternal_GHCziInternalziTypes_Czh_con_info)) +#define Izh_con_info (&(ghczminternal_GHCziInternalziTypes_Izh_con_info)) +#define Fzh_con_info (&(ghczminternal_GHCziInternalziTypes_Fzh_con_info)) +#define Dzh_con_info (&(ghczminternal_GHCziInternalziTypes_Dzh_con_info)) +#define Wzh_con_info (&(ghczminternal_GHCziInternalziTypes_Wzh_con_info)) +#define W8zh_con_info (&(ghczminternal_GHCziInternalziWord_W8zh_con_info)) +#define W16zh_con_info (&(ghczminternal_GHCziInternalziWord_W16zh_con_info)) +#define W32zh_con_info (&(ghczminternal_GHCziInternalziWord_W32zh_con_info)) +#define W64zh_con_info (&(ghczminternal_GHCziInternalziWord_W64zh_con_info)) +#define I8zh_con_info (&(ghczminternal_GHCziInternalziInt_I8zh_con_info)) +#define I16zh_con_info (&(ghczminternal_GHCziInternalziInt_I16zh_con_info)) +#define I32zh_con_info (&(ghczminternal_GHCziInternalziInt_I32zh_con_info)) +#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info)) +#define I64zh_con_info (&(ghczminternal_GHCziInternalziInt_I64zh_con_info)) +#define Ptr_con_info (&(ghczminternal_GHCziInternalziPtr_Ptr_con_info)) +#define FunPtr_con_info (&(ghczminternal_GHCziInternalziPtr_FunPtr_con_info)) +#define StablePtr_static_info (&(ghczminternal_GHCziInternalziStable_StablePtr_static_info)) +#define StablePtr_con_info (&(ghczminternal_GHCziInternalziStable_StablePtr_con_info)) ===================================== rts/RtsSymbols.c ===================================== @@ -1054,9 +1054,9 @@ RTS_ARM_OUTLINE_ATOMIC_SYMBOLS #define SymI_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA }, #define SymE_HasProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ - (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_CODE }, + (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_CODE }, #define SymE_HasDataProto(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \ - (void*)DLL_IMPORT_DATA_REF(vvv), STRENGTH_NORMAL, SYM_TYPE_DATA }, + (void*)(&(vvv)), STRENGTH_NORMAL, SYM_TYPE_DATA }, #define SymI_NeedsProto(vvv) SymI_HasProto(vvv) #define SymI_NeedsDataProto(vvv) SymI_HasDataProto(vvv) ===================================== rts/include/Rts.h ===================================== @@ -265,9 +265,9 @@ void _warnFail(const char *filename, unsigned int linenum); #include "rts/LibdwPool.h" /* Misc stuff without a home */ -DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */ -DLL_IMPORT_RTS extern int prog_argc; -DLL_IMPORT_RTS extern char *prog_name; +extern char **prog_argv; /* so we can get at these from Haskell */ +extern int prog_argc; +extern char *prog_name; void reportStackOverflow(StgTSO* tso); void reportHeapOverflow(void); ===================================== rts/include/RtsAPI.h ===================================== @@ -587,8 +587,8 @@ void rts_done (void); extern StgClosure ghczminternal_GHCziInternalziTopHandler_runIO_closure; extern StgClosure ghczminternal_GHCziInternalziTopHandler_runNonIO_closure; -#define runIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runIO_closure) -#define runNonIO_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure) +#define runIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runIO_closure)) +#define runNonIO_closure (&(ghczminternal_GHCziInternalziTopHandler_runNonIO_closure)) /* ------------------------------------------------------------------------ */ ===================================== rts/include/Stg.h ===================================== @@ -332,7 +332,6 @@ external prototype return neither of these types to workaround #11395. Other Stg stuff... -------------------------------------------------------------------------- */ -#include "stg/DLL.h" #include "stg/MachRegsForHost.h" #include "stg/Regs.h" #include "stg/Ticky.h" ===================================== rts/include/rts/Flags.h ===================================== @@ -358,7 +358,7 @@ typedef struct _RTS_FLAGS { } RTS_FLAGS; #if defined(COMPILING_RTS_MAIN) -extern DLLIMPORT RTS_FLAGS RtsFlags; +extern RTS_FLAGS RtsFlags; #elif IN_STG_CODE /* Note [RtsFlags is a pointer in STG code] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== rts/include/rts/NonMoving.h ===================================== @@ -19,10 +19,10 @@ struct StgThunk_; struct Capability_; /* This is called by the code generator */ -extern DLL_IMPORT_RTS +extern void updateRemembSetPushClosure_(StgRegTable *reg, struct StgClosure_ *p); -extern DLL_IMPORT_RTS +extern void updateRemembSetPushThunk_(StgRegTable *reg, struct StgThunk_ *p); // Forward declaration for unregisterised backend. @@ -31,7 +31,7 @@ EF_(stg_copyArray_barrier); // Note that RTS code should not condition on this directly by rather // use the IF_NONMOVING_WRITE_BARRIER_ENABLED macro to ensure that // the barrier is eliminated in the non-threaded RTS. -extern StgWord DLL_IMPORT_DATA_VAR(nonmoving_write_barrier_enabled); +extern StgWord nonmoving_write_barrier_enabled; // A similar macro is defined in rts/include/Cmm.h for C-- code. #if defined(THREADED_RTS) ===================================== rts/include/rts/StableName.h ===================================== @@ -29,4 +29,4 @@ typedef struct { // free } snEntry; -extern DLL_IMPORT_RTS snEntry *stable_name_table; +extern snEntry *stable_name_table; ===================================== rts/include/rts/StablePtr.h ===================================== @@ -26,7 +26,7 @@ typedef struct { // otherwise. } spEntry; -extern DLL_IMPORT_RTS spEntry *stable_ptr_table; +extern spEntry *stable_ptr_table; ATTR_ALWAYS_INLINE EXTERN_INLINE StgPtr deRefStablePtr(StgStablePtr sp) ===================================== rts/include/stg/DLL.h deleted ===================================== @@ -1,35 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (c) The GHC Team, 1998-2009 - * - * Support for Windows DLLs. - * - * Do not #include this file directly: #include "Rts.h" instead. - * - * To understand the structure of the RTS headers, see the wiki: - * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes - * - * ---------------------------------------------------------------------------*/ - -#pragma once - -# define DLL_IMPORT_DATA_REF(x) (&(x)) -# define DLL_IMPORT_DATA_VARNAME(x) x -# define DLLIMPORT - -/* The view of the rts/include/ header files differ ever so - slightly depending on whether the RTS is being compiled - or not - so we're forced to distinguish between two. - [oh, you want details :) : Data symbols defined by the RTS - have to be accessed through an extra level of indirection - when compiling generated .hc code compared to when the RTS - sources are being processed. This is only the case when - using Win32 DLLs. ] -*/ -#if defined(COMPILING_RTS) -#define DLL_IMPORT_RTS -#define DLL_IMPORT_DATA_VAR(x) x -#else -#define DLL_IMPORT_RTS DLLIMPORT -#define DLL_IMPORT_DATA_VAR(x) x -#endif ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -25,14 +25,14 @@ # define RTS_THUNK_INFO(i) extern const W_(i)[] # define RTS_INFO(i) extern const W_(i)[] # define RTS_CLOSURE(i) extern W_(i)[] -# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +# define RTS_FUN_DECL(f) extern StgFunPtr f(void) #else -# define RTS_RET_INFO(i) extern DLL_IMPORT_RTS const StgRetInfoTable i -# define RTS_FUN_INFO(i) extern DLL_IMPORT_RTS const StgFunInfoTable i -# define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i -# define RTS_INFO(i) extern DLL_IMPORT_RTS const StgInfoTable i -# define RTS_CLOSURE(i) extern DLL_IMPORT_RTS StgClosure i -# define RTS_FUN_DECL(f) extern DLL_IMPORT_RTS StgFunPtr f(void) +# define RTS_RET_INFO(i) extern const StgRetInfoTable i +# define RTS_FUN_INFO(i) extern const StgFunInfoTable i +# define RTS_THUNK_INFO(i) extern const StgThunkInfoTable i +# define RTS_INFO(i) extern const StgInfoTable i +# define RTS_CLOSURE(i) extern StgClosure i +# define RTS_FUN_DECL(f) extern StgFunPtr f(void) #endif #if defined(TABLES_NEXT_TO_CODE) @@ -274,11 +274,11 @@ RTS_CLOSURE(stg_NO_TREC_closure); RTS_ENTRY(stg_NO_FINALIZER); #if IN_STG_CODE -extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure; -extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure; +extern StgWordArray stg_CHARLIKE_closure; +extern StgWordArray stg_INTLIKE_closure; #else -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[]; -extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[]; +extern StgIntCharlikeClosure stg_CHARLIKE_closure[]; +extern StgIntCharlikeClosure stg_INTLIKE_closure[]; #endif /* StgStartup */ ===================================== rts/rts.cabal ===================================== @@ -334,7 +334,6 @@ library rts/storage/InfoTables.h rts/storage/MBlock.h rts/storage/TSO.h - stg/DLL.h stg/MachRegs.h stg/MachRegs/arm32.h stg/MachRegs/arm64.h ===================================== testsuite/tests/llvm/should_run/T26065.hs ===================================== @@ -0,0 +1,68 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +import Data.Char (toUpper) +import GHC.Exts +import GHC.Word +import Numeric (showHex) + +pdep8 :: Word8 -> Word8 -> Word8 +pdep8 (W8# a) (W8# b) = W8# (wordToWord8# (pdep8# (word8ToWord# a) (word8ToWord# b))) +{-# NOINLINE pdep8 #-} + +pdep16 :: Word16 -> Word16 -> Word16 +pdep16 (W16# a) (W16# b) = W16# (wordToWord16# (pdep16# (word16ToWord# a) (word16ToWord# b))) +{-# NOINLINE pdep16 #-} + +pdep32 :: Word32 -> Word32 -> Word32 +pdep32 (W32# a) (W32# b) = W32# (wordToWord32# (pdep32# (word32ToWord# a) (word32ToWord# b))) +{-# NOINLINE pdep32 #-} + +pdep64 :: Word64 -> Word64 -> Word64 +pdep64 (W64# a) (W64# b) = W64# (pdep64# a b) +{-# NOINLINE pdep64 #-} + +pext8 :: Word8 -> Word8 -> Word8 +pext8 (W8# a) (W8# b) = W8# (wordToWord8# (pext8# (word8ToWord# a) (word8ToWord# b))) +{-# NOINLINE pext8 #-} + +pext16 :: Word16 -> Word16 -> Word16 +pext16 (W16# a) (W16# b) = W16# (wordToWord16# (pext16# (word16ToWord# a) (word16ToWord# b))) +{-# NOINLINE pext16 #-} + +pext32 :: Word32 -> Word32 -> Word32 +pext32 (W32# a) (W32# b) = W32# (wordToWord32# (pext32# (word32ToWord# a) (word32ToWord# b))) +{-# NOINLINE pext32 #-} + +pext64 :: Word64 -> Word64 -> Word64 +pext64 (W64# a) (W64# b) = W64# (pext64# a b) +{-# NOINLINE pext64 #-} + +valueSource :: Integral i => i +valueSource = fromInteger 0xA7F7A7F7A7F7A7F7 + +valueMask :: Integral i => i +valueMask = fromInteger 0x5555555555555555 + +printIntrinsicCall :: forall i. Integral i => String -> (i -> i -> i) -> IO () +printIntrinsicCall label f = + let op1 = valueSource + op2 = valueMask + pad s = + let hex :: Integral a => a -> String + hex = flip showHex "" + str = toUpper <$> hex s + len = length $ hex (maxBound :: Word64) + n = length str + in "0x" <> replicate (len - n) '0' <> str + in putStrLn $ unwords [ label, pad op1, pad op2, "=", pad (f op1 op2) ] + +main :: IO () +main = do + printIntrinsicCall "pdep8 " pdep8 + printIntrinsicCall "pdep16" pdep16 + printIntrinsicCall "pdep32" pdep32 + printIntrinsicCall "pdep64" pdep64 + printIntrinsicCall "pext8 " pext8 + printIntrinsicCall "pext16" pext16 + printIntrinsicCall "pext32" pext32 + printIntrinsicCall "pext64" pext64 ===================================== testsuite/tests/llvm/should_run/T26065.stdout ===================================== @@ -0,0 +1,8 @@ +pdep8 0x00000000000000F7 0x0000000000000055 = 0x0000000000000015 +pdep16 0x000000000000A7F7 0x0000000000005555 = 0x0000000000005515 +pdep32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000044155515 +pdep64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x4415551544155515 +pext8 0x00000000000000F7 0x0000000000000055 = 0x000000000000000F +pext16 0x000000000000A7F7 0x0000000000005555 = 0x000000000000003F +pext32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000000003F3F +pext64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x000000003F3F3F3F ===================================== testsuite/tests/llvm/should_run/all.T ===================================== @@ -18,3 +18,8 @@ test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c']) # T25730C.c contains Intel instrinsics, so only run this test on x86 test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, ['']) +# T26065.c tests LLVM linking of Intel instrinsics, so only run this test on x86 +test('T26065', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"])), + unless((arch('x86_64') or arch('i386')) and have_cpu_feature('bmi2'),skip)], + compile_and_run, ['-mbmi2']) + ===================================== testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs ===================================== @@ -19,13 +19,14 @@ pass :: ModGuts -> CoreM ModGuts pass g = do dflags <- getDynFlags mapM_ (printAnn dflags g) (mg_binds g) >> return g - where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind - printAnn dflags guts bndr@(NonRec b _) = do + where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM () + printAnn dflags guts (NonRec b _) = lookupAnn dflags guts b + printAnn dflags guts (Rec ps) = mapM_ (lookupAnn dflags guts . fst) ps + + lookupAnn dflags guts b = do anns <- annotationsOn guts b :: CoreM [SomeAnn] unless (null anns) $ putMsgS $ "Annotated binding found: " ++ showSDoc dflags (ppr b) - return bndr - printAnn _ _ bndr = return bndr annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a] annotationsOn guts bndr = do ===================================== testsuite/tests/plugins/late-plugin/LatePlugin.hs ===================================== @@ -43,8 +43,13 @@ editCoreBinding early modName pgm = do pure $ go pgm where go :: [CoreBind] -> [CoreBind] - go (b@(NonRec v e) : bs) - | occNameString (getOccName v) == "testBinding" && exprType e `eqType` intTy = - NonRec v (mkUncheckedIntExpr $ bool 222222 111111 early) : bs - go (b:bs) = b : go bs + go (Rec ps : bs) = Rec (map (uncurry (go_bind (,))) ps) : go bs + go (NonRec v e : bs) = go_bind NonRec v e : go bs go [] = [] + + go_bind c v e + | occNameString (getOccName v) == "testBinding" + , exprType e `eqType` intTy + = c v (mkUncheckedIntExpr $ bool 222222 111111 early) + | otherwise + = c v e ===================================== testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs ===================================== @@ -51,5 +51,6 @@ fixGuts rep guts = pure $ guts { mg_binds = fmap fix_bind (mg_binds guts) } Tick t e -> Tick t (fix_expr e) Type t -> Type t Coercion c -> Coercion c + Let b body -> Let (fix_bind b) (fix_expr body) fix_alt (Alt c bs e) = Alt c bs (fix_expr e) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7668b4a87faa0d905f96a94f3f835a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7668b4a87faa0d905f96a94f3f835a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] ghci: fix bootstrapping with 9.12.3-rc1 and above
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f8919262 by Cheng Shao at 2025-09-23T20:44:54-04:00 ghci: fix bootstrapping with 9.12.3-rc1 and above This patch fixes bootstrapping GHC with 9.12.3-rc1 and above. ghci defines `Binary` instance for `HalfWord` in `ghc-heap`, which is a proper `newtype` in 9.14 and starting from 9.12.3. Given we don't build `ghc-heap` in stage0, we need to fix this predicate so that it corresponds to the boot ghc versions that contain the right version of `ghc-heap`. - - - - - 1 changed file: - libraries/ghci/GHCi/Message.hs Changes: ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -525,7 +525,7 @@ instance Binary (FunPtr a) where put = put . castFunPtrToPtr get = castPtrToFunPtr <$> get -#if MIN_VERSION_ghc_internal(9,1500,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,12,2,20250919) instance Binary Heap.HalfWord where put x = put (fromIntegral x :: Word32) get = fromIntegral <$> (get :: Get Word32) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8919262dc3034851fbefab86fe45dd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8919262dc3034851fbefab86fe45dd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] docs: Fix typo in scoped_type_variables.rst
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 30ef0aac by Simon Hengel at 2025-09-23T20:44:12-04:00 docs: Fix typo in scoped_type_variables.rst - - - - - 1 changed file: - docs/users_guide/exts/scoped_type_variables.rst Changes: ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,7 +6,7 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Lexically scope explicitly-introduced type variables. + :shortdesc: Lexically scoped explicitly-introduced type variables. :implies: :extension:`ExplicitForAll` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30ef0aac1f03acbef5856d16081e24f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30ef0aac1f03acbef5856d16081e24f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Allow Core plugins to access unoptimized Core (#23337)
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 50f6be09 by Sylvain Henry at 2025-09-23T20:43:29-04:00 Allow Core plugins to access unoptimized Core (#23337) Make the first simple optimization pass after desugaring a real CoreToDo pass. This allows CorePlugins to decide whether they want to be executed before or after this pass. - - - - - 6 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Pipeline/Types.hs - compiler/GHC/HsToCore.hs - testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs - testsuite/tests/plugins/late-plugin/LatePlugin.hs - testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -13,6 +13,7 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Plugins ( withPlugins, installCoreToDos ) import GHC.Driver.Env +import GHC.Driver.Config (initSimpleOpts) import GHC.Driver.Config.Core.Lint ( endPass ) import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts ) import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode ) @@ -21,9 +22,10 @@ import GHC.Driver.Config.Core.Rules ( initRuleOpts ) import GHC.Platform.Ways ( hasWay, Way(WayProf) ) import GHC.Core +import GHC.Core.SimpleOpt (simpleOptPgm) import GHC.Core.Opt.CSE ( cseProgram ) import GHC.Core.Rules ( RuleBase, ruleCheckProgram, getRules ) -import GHC.Core.Ppr ( pprCoreBindings ) +import GHC.Core.Ppr ( pprCoreBindings, pprRules ) import GHC.Core.Utils ( dumpIdInfoOfProgram ) import GHC.Core.Lint ( lintAnnots ) import GHC.Core.Lint.Interactive ( interactiveInScope ) @@ -202,10 +204,14 @@ getCoreToDo dflags hpt_rule_base extra_vars core_todo = [ - -- We want to do the static argument transform before full laziness as it - -- may expose extra opportunities to float things outwards. However, to fix - -- up the output of the transformation we need at do at least one simplify - -- after this before anything else + -- We always perform a run of the simple optimizer after desugaring to + -- remove really bad code + CoreDesugarOpt, + + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), -- initial simplify: mk specialiser happy: minimum effort please @@ -467,6 +473,7 @@ doCorePass pass guts = do let fam_envs = (p_fam_env, mg_fam_inst_env guts) let updateBinds f = return $ guts { mg_binds = f (mg_binds guts) } let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' } + let updateBindsAndRulesM f = f (mg_binds guts) (mg_rules guts) >>= \(b',r') -> return $ guts { mg_binds = b', mg_rules = r' } -- Important to force this now as name_ppr_ctx lives through an entire phase in -- the optimiser and if it's not forced then the entire previous `ModGuts` will -- be retained until the end of the phase. (See #24328 for more analysis) @@ -479,6 +486,9 @@ doCorePass pass guts = do case pass of + CoreDesugarOpt -> {-# SCC "DesugarOpt" #-} + updateBindsAndRulesM (desugarOpt dflags logger (mg_module guts)) + CoreDoSimplify opts -> {-# SCC "Simplify" #-} liftIOWithCount $ simplifyPgm logger (hsc_unit_env hsc_env) name_ppr_ctx opts guts @@ -537,7 +547,6 @@ doCorePass pass guts = do CoreDoPluginPass _ p -> {-# SCC "Plugin" #-} p guts CoreDesugar -> pprPanic "doCorePass" (ppr pass) - CoreDesugarOpt -> pprPanic "doCorePass" (ppr pass) CoreTidy -> pprPanic "doCorePass" (ppr pass) CorePrep -> pprPanic "doCorePass" (ppr pass) @@ -580,3 +589,22 @@ dmdAnal logger before_ww dflags fam_envs rules binds = do dumpIdInfoOfProgram (hasPprDebug dflags) (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds + + +-- | Simple optimization after desugaring. +-- +-- This performs some quick basic optimizations even with -O0. +-- See Note [The simple optimiser] for details. +-- +-- We could call it directly in the desugarer but we implement it as the first +-- Core-to-Core pass to accomodate Core plugins that want to see Core even +-- before the first (simple) optimization took place. See #23337 +desugarOpt :: DynFlags -> Logger -> Module -> CoreProgram -> [CoreRule] -> CoreM (CoreProgram,[CoreRule]) +desugarOpt dflags logger mod binds rules = liftIO $ do + let simpl_opts = initSimpleOpts dflags + let !(ds_binds, ds_rules_for_imps, occ_anald_binds) = simpleOptPgm simpl_opts mod binds rules + + putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" + FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps ) + + pure (ds_binds, ds_rules_for_imps) ===================================== compiler/GHC/Core/Opt/Pipeline/Types.hs ===================================== @@ -58,8 +58,7 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoPasses [CoreToDo] -- lists of these things | CoreDesugar -- Right after desugaring, no simple optimisation yet! - | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces - -- Core output, and hence useful to pass to endPass + | CoreDesugarOpt -- Simple optimisation after desugaring | CoreTidy | CorePrep ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -48,7 +48,7 @@ import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon ( tyConDataCons ) import GHC.Core import GHC.Core.FVs ( exprsSomeFreeVarsList, exprFreeVars ) -import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr ) +import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Utils import GHC.Core.Unfold.Make import GHC.Core.Coercion @@ -200,27 +200,18 @@ deSugar hsc_env do { -- Add export flags to bindings keep_alive <- readIORef keep_var - ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules + ; let (rules_for_locals, ds_rules_for_imps) = partition isLocalRule all_rules final_prs = addExportFlagsAndRules bcknd export_set keep_alive rules_for_locals (fromOL all_prs) - final_pgm = combineEvBinds ds_ev_binds final_prs + ds_binds = combineEvBinds ds_ev_binds final_prs -- Notice that we put the whole lot in a big Rec, even the foreign binds -- When compiling PrelFloat, which defines data Float = F# Float# -- we want F# to be in scope in the foreign marshalling code! -- You might think it doesn't matter, but the simplifier brings all top-level -- things into the in-scope set before simplifying; so we get no unfolding for F#! - ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar final_pgm rules_for_imps - ; let simpl_opts = initSimpleOpts dflags - ; let (ds_binds, ds_rules_for_imps, occ_anald_binds) - = simpleOptPgm simpl_opts mod final_pgm rules_for_imps - -- The simpleOptPgm gets rid of type - -- bindings plus any stupid dead code - ; putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis" - FormatCore (pprCoreBindings occ_anald_binds $$ pprRules ds_rules_for_imps ) - - ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps + ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugar ds_binds ds_rules_for_imps ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) home_unit = hsc_home_unit hsc_env ===================================== testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs ===================================== @@ -19,13 +19,14 @@ pass :: ModGuts -> CoreM ModGuts pass g = do dflags <- getDynFlags mapM_ (printAnn dflags g) (mg_binds g) >> return g - where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM CoreBind - printAnn dflags guts bndr@(NonRec b _) = do + where printAnn :: DynFlags -> ModGuts -> CoreBind -> CoreM () + printAnn dflags guts (NonRec b _) = lookupAnn dflags guts b + printAnn dflags guts (Rec ps) = mapM_ (lookupAnn dflags guts . fst) ps + + lookupAnn dflags guts b = do anns <- annotationsOn guts b :: CoreM [SomeAnn] unless (null anns) $ putMsgS $ "Annotated binding found: " ++ showSDoc dflags (ppr b) - return bndr - printAnn _ _ bndr = return bndr annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a] annotationsOn guts bndr = do ===================================== testsuite/tests/plugins/late-plugin/LatePlugin.hs ===================================== @@ -43,8 +43,13 @@ editCoreBinding early modName pgm = do pure $ go pgm where go :: [CoreBind] -> [CoreBind] - go (b@(NonRec v e) : bs) - | occNameString (getOccName v) == "testBinding" && exprType e `eqType` intTy = - NonRec v (mkUncheckedIntExpr $ bool 222222 111111 early) : bs - go (b:bs) = b : go bs + go (Rec ps : bs) = Rec (map (uncurry (go_bind (,))) ps) : go bs + go (NonRec v e : bs) = go_bind NonRec v e : go bs go [] = [] + + go_bind c v e + | occNameString (getOccName v) == "testBinding" + , exprType e `eqType` intTy + = c v (mkUncheckedIntExpr $ bool 222222 111111 early) + | otherwise + = c v e ===================================== testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs ===================================== @@ -51,5 +51,6 @@ fixGuts rep guts = pure $ guts { mg_binds = fmap fix_bind (mg_binds guts) } Tick t e -> Tick t (fix_expr e) Type t -> Type t Coercion c -> Coercion c + Let b body -> Let (fix_bind b) (fix_expr body) fix_alt (Alt c bs e) = Alt c bs (fix_expr e) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f6be09df4822b4729bc8ceb2de8ff… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f6be09df4822b4729bc8ceb2de8ff… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] NCG/LA64: Implement MO_BSwap and MO_BRev with bit-manipulation Instructions
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 89e8ff3d by Peng Fan at 2025-09-23T20:42:37-04:00 NCG/LA64: Implement MO_BSwap and MO_BRev with bit-manipulation Instructions - - - - - 3 changed files: - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/LA64/Instr.hs - compiler/GHC/CmmToAsm/LA64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/LA64/CodeGen.hs ===================================== @@ -1805,6 +1805,49 @@ genCCall target dest_regs arg_regs = do where shift = (widthToInt w) + PrimTarget (MO_BSwap w) + | w `elem` [W16, W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + case w of + W64 -> return ( code_x `appOL` toOL + [ + REVBD (OpReg w dst_reg) (OpReg w reg_x) + ]) + W32 -> return ( code_x `appOL` toOL + [ + REVB2W (OpReg w dst_reg) (OpReg w reg_x) + ]) + _ -> return ( code_x `appOL` toOL + [ + REVB2H (OpReg w dst_reg) (OpReg w reg_x) + ]) + | otherwise -> unsupported (MO_BSwap w) + + PrimTarget (MO_BRev w) + | w `elem` [W8, W16, W32, W64], + [arg_reg] <- arg_regs, + [dest_reg] <- dest_regs -> do + platform <- getPlatform + (reg_x, _, code_x) <- getSomeReg arg_reg + let dst_reg = getRegisterReg platform (CmmLocal dest_reg) + case w of + W8 -> return ( code_x `appOL` toOL + [ + BITREV4B (OpReg W32 reg_x) (OpReg W32 reg_x), + AND (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 255)) + ]) + W16 -> return ( code_x `appOL` toOL + [ + BITREV (OpReg W64 reg_x) (OpReg W64 reg_x), + SRL (OpReg W64 dst_reg) (OpReg W64 reg_x) (OpImm (ImmInt 48)) + ]) + _ -> return ( code_x `snocOL` BITREV (OpReg w dst_reg) (OpReg w reg_x)) + | otherwise -> unsupported (MO_BRev w) + -- mop :: CallishMachOp (see GHC.Cmm.MachOp) PrimTarget mop -> do -- We'll need config to construct forien targets @@ -1939,8 +1982,6 @@ genCCall target dest_regs arg_regs = do MO_PopCnt w -> mkCCall (popCntLabel w) MO_Pdep w -> mkCCall (pdepLabel w) MO_Pext w -> mkCCall (pextLabel w) - MO_BSwap w -> mkCCall (bSwapLabel w) - MO_BRev w -> mkCCall (bRevLabel w) -- or a possibly side-effecting machine operation mo@(MO_AtomicRead w ord) ===================================== compiler/GHC/CmmToAsm/LA64/Instr.hs ===================================== @@ -126,8 +126,7 @@ regUsageOfInstr platform instr = case instr of REVHD dst src1 -> usage (regOp src1, regOp dst) BITREV4B dst src1 -> usage (regOp src1, regOp dst) BITREV8B dst src1 -> usage (regOp src1, regOp dst) - BITREVW dst src1 -> usage (regOp src1, regOp dst) - BITREVD dst src1 -> usage (regOp src1, regOp dst) + BITREV dst src1 -> usage (regOp src1, regOp dst) BSTRINS _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) BSTRPICK _ dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) MASKEQZ dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -309,8 +308,7 @@ patchRegsOfInstr instr env = case instr of REVHD o1 o2 -> REVHD (patchOp o1) (patchOp o2) BITREV4B o1 o2 -> BITREV4B (patchOp o1) (patchOp o2) BITREV8B o1 o2 -> BITREV8B (patchOp o1) (patchOp o2) - BITREVW o1 o2 -> BITREVW (patchOp o1) (patchOp o2) - BITREVD o1 o2 -> BITREVD (patchOp o1) (patchOp o2) + BITREV o1 o2 -> BITREV (patchOp o1) (patchOp o2) BSTRINS f o1 o2 o3 o4 -> BSTRINS f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) BSTRPICK f o1 o2 o3 o4 -> BSTRPICK f (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) MASKEQZ o1 o2 o3 -> MASKEQZ (patchOp o1) (patchOp o2) (patchOp o3) @@ -700,8 +698,7 @@ data Instr | REVHD Operand Operand | BITREV4B Operand Operand | BITREV8B Operand Operand - | BITREVW Operand Operand - | BITREVD Operand Operand + | BITREV Operand Operand | BSTRINS Format Operand Operand Operand Operand | BSTRPICK Format Operand Operand Operand Operand | MASKEQZ Operand Operand Operand @@ -824,8 +821,7 @@ instrCon i = REVHD{} -> "REVHD" BITREV4B{} -> "BITREV4B" BITREV8B{} -> "BITREV8B" - BITREVW{} -> "BITREVW" - BITREVD{} -> "BITREVD" + BITREV{} -> "BITREV" BSTRINS{} -> "BSTRINS" BSTRPICK{} -> "BSTRPICK" MASKEQZ{} -> "MASKEQZ" ===================================== compiler/GHC/CmmToAsm/LA64/Ppr.hs ===================================== @@ -802,8 +802,9 @@ pprInstr platform instr = case instr of -- BITREV.{W/D} BITREV4B o1 o2 -> op2 (text "\tbitrev.4b") o1 o2 BITREV8B o1 o2 -> op2 (text "\tbitrev.8b") o1 o2 - BITREVW o1 o2 -> op2 (text "\tbitrev.w") o1 o2 - BITREVD o1 o2 -> op2 (text "\tbitrev.d") o1 o2 + BITREV o1 o2 + | OpReg W32 _ <- o2 -> op2 (text "\tbitrev.w") o1 o2 + | OpReg W64 _ <- o2 -> op2 (text "\tbitrev.d") o1 o2 -- BSTRINS.{W/D} BSTRINS II64 o1 o2 o3 o4 -> op4 (text "\tbstrins.d") o1 o2 o3 o4 BSTRINS II32 o1 o2 o3 o4 -> op4 (text "\tbstrins.w") o1 o2 o3 o4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89e8ff3d12689d73481cdb68d7408fd… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89e8ff3d12689d73481cdb68d7408fd… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Correcting LLVM linking of Intel BMI intrinsics pdep{8,16} and pext{8,16}.
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0a601c30 by Alex Washburn at 2025-09-23T20:41:41-04:00 Correcting LLVM linking of Intel BMI intrinsics pdep{8,16} and pext{8,16}. This patch fixes #26065. The LLVM interface does not expose bindings to: - llvm.x86.bmi.pdep.8 - llvm.x86.bmi.pdep.16 - llvm.x86.bmi.pext.8 - llvm.x86.bmi.pext.16 So calls are instead made to llvm.x86.bmi.{pdep,pext}.32 in these cases, with pre/post-operation truncation to constrain the logical value range. - - - - - 4 changed files: - compiler/GHC/CmmToLlvm/CodeGen.hs - + testsuite/tests/llvm/should_run/T26065.hs - + testsuite/tests/llvm/should_run/T26065.stdout - testsuite/tests/llvm/should_run/all.T Changes: ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -240,12 +240,25 @@ genCall (PrimTarget op@(MO_BRev w)) [dst] args = genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_BSwap w)) [dst] args = genCallSimpleCast w op dst args -genCall (PrimTarget op@(MO_Pdep w)) [dst] args = - genCallSimpleCast w op dst args -genCall (PrimTarget op@(MO_Pext w)) [dst] args = - genCallSimpleCast w op dst args genCall (PrimTarget op@(MO_PopCnt w)) [dst] args = genCallSimpleCast w op dst args +{- Note [LLVM PDep/PExt intrinsics] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Since x86 PDep/PExt instructions only exist for 32/64 bit widths +we use the 32bit variant to compute the 8/16bit primops. +To do so we extend/truncate the argument/result around the +call. +-} +genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do + cfg <- getConfig + if llvmCgBmiVersion cfg >= Just BMI2 + then genCallMinimumTruncationCast W32 w op dst args + else genCallSimpleCast w op dst args +genCall (PrimTarget op@(MO_Pext w)) [dst] args = do + cfg <- getConfig + if llvmCgBmiVersion cfg >= Just BMI2 + then genCallMinimumTruncationCast W32 w op dst args + else genCallSimpleCast w op dst args genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do addrVar <- exprToVarW addr @@ -641,8 +654,15 @@ genCallExtract _ _ _ _ = -- from i32 to i8 explicitly as LLVM is strict about types. genCallSimpleCast :: Width -> CallishMachOp -> CmmFormal -> [CmmActual] -> LlvmM StmtData -genCallSimpleCast specW op dst args = do - let width = widthToLlvmInt specW +genCallSimpleCast w = genCallMinimumTruncationCast w w + +-- Given the minimum machine bit-width to use and the logical bit-width of the +-- value range, perform a type-cast truncation and extension before and after the +-- specified operation, respectively. +genCallMinimumTruncationCast :: Width -> Width -> CallishMachOp -> CmmFormal + -> [CmmActual] -> LlvmM StmtData +genCallMinimumTruncationCast minW specW op dst args = do + let width = widthToLlvmInt $ max minW specW argsW = const width <$> args dstType = cmmToLlvmType $ localRegType dst signage = cmmPrimOpRetValSignage op @@ -945,9 +965,10 @@ cmmPrimOpFunctions mop = do W256 -> fsLit "llvm.cttz.i256" W512 -> fsLit "llvm.cttz.i512" MO_Pdep w + -- See Note [LLVM PDep/PExt intrinsics] | isBmi2Enabled -> case w of - W8 -> fsLit "llvm.x86.bmi.pdep.8" - W16 -> fsLit "llvm.x86.bmi.pdep.16" + W8 -> fsLit "llvm.x86.bmi.pdep.32" + W16 -> fsLit "llvm.x86.bmi.pdep.32" W32 -> fsLit "llvm.x86.bmi.pdep.32" W64 -> fsLit "llvm.x86.bmi.pdep.64" W128 -> fsLit "llvm.x86.bmi.pdep.128" @@ -963,8 +984,9 @@ cmmPrimOpFunctions mop = do W512 -> fsLit "hs_pdep512" MO_Pext w | isBmi2Enabled -> case w of - W8 -> fsLit "llvm.x86.bmi.pext.8" - W16 -> fsLit "llvm.x86.bmi.pext.16" + -- See Note [LLVM PDep/PExt intrinsics] + W8 -> fsLit "llvm.x86.bmi.pext.32" + W16 -> fsLit "llvm.x86.bmi.pext.32" W32 -> fsLit "llvm.x86.bmi.pext.32" W64 -> fsLit "llvm.x86.bmi.pext.64" W128 -> fsLit "llvm.x86.bmi.pext.128" ===================================== testsuite/tests/llvm/should_run/T26065.hs ===================================== @@ -0,0 +1,68 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +import Data.Char (toUpper) +import GHC.Exts +import GHC.Word +import Numeric (showHex) + +pdep8 :: Word8 -> Word8 -> Word8 +pdep8 (W8# a) (W8# b) = W8# (wordToWord8# (pdep8# (word8ToWord# a) (word8ToWord# b))) +{-# NOINLINE pdep8 #-} + +pdep16 :: Word16 -> Word16 -> Word16 +pdep16 (W16# a) (W16# b) = W16# (wordToWord16# (pdep16# (word16ToWord# a) (word16ToWord# b))) +{-# NOINLINE pdep16 #-} + +pdep32 :: Word32 -> Word32 -> Word32 +pdep32 (W32# a) (W32# b) = W32# (wordToWord32# (pdep32# (word32ToWord# a) (word32ToWord# b))) +{-# NOINLINE pdep32 #-} + +pdep64 :: Word64 -> Word64 -> Word64 +pdep64 (W64# a) (W64# b) = W64# (pdep64# a b) +{-# NOINLINE pdep64 #-} + +pext8 :: Word8 -> Word8 -> Word8 +pext8 (W8# a) (W8# b) = W8# (wordToWord8# (pext8# (word8ToWord# a) (word8ToWord# b))) +{-# NOINLINE pext8 #-} + +pext16 :: Word16 -> Word16 -> Word16 +pext16 (W16# a) (W16# b) = W16# (wordToWord16# (pext16# (word16ToWord# a) (word16ToWord# b))) +{-# NOINLINE pext16 #-} + +pext32 :: Word32 -> Word32 -> Word32 +pext32 (W32# a) (W32# b) = W32# (wordToWord32# (pext32# (word32ToWord# a) (word32ToWord# b))) +{-# NOINLINE pext32 #-} + +pext64 :: Word64 -> Word64 -> Word64 +pext64 (W64# a) (W64# b) = W64# (pext64# a b) +{-# NOINLINE pext64 #-} + +valueSource :: Integral i => i +valueSource = fromInteger 0xA7F7A7F7A7F7A7F7 + +valueMask :: Integral i => i +valueMask = fromInteger 0x5555555555555555 + +printIntrinsicCall :: forall i. Integral i => String -> (i -> i -> i) -> IO () +printIntrinsicCall label f = + let op1 = valueSource + op2 = valueMask + pad s = + let hex :: Integral a => a -> String + hex = flip showHex "" + str = toUpper <$> hex s + len = length $ hex (maxBound :: Word64) + n = length str + in "0x" <> replicate (len - n) '0' <> str + in putStrLn $ unwords [ label, pad op1, pad op2, "=", pad (f op1 op2) ] + +main :: IO () +main = do + printIntrinsicCall "pdep8 " pdep8 + printIntrinsicCall "pdep16" pdep16 + printIntrinsicCall "pdep32" pdep32 + printIntrinsicCall "pdep64" pdep64 + printIntrinsicCall "pext8 " pext8 + printIntrinsicCall "pext16" pext16 + printIntrinsicCall "pext32" pext32 + printIntrinsicCall "pext64" pext64 ===================================== testsuite/tests/llvm/should_run/T26065.stdout ===================================== @@ -0,0 +1,8 @@ +pdep8 0x00000000000000F7 0x0000000000000055 = 0x0000000000000015 +pdep16 0x000000000000A7F7 0x0000000000005555 = 0x0000000000005515 +pdep32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000044155515 +pdep64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x4415551544155515 +pext8 0x00000000000000F7 0x0000000000000055 = 0x000000000000000F +pext16 0x000000000000A7F7 0x0000000000005555 = 0x000000000000003F +pext32 0x00000000A7F7A7F7 0x0000000055555555 = 0x0000000000003F3F +pext64 0xA7F7A7F7A7F7A7F7 0x5555555555555555 = 0x000000003F3F3F3F ===================================== testsuite/tests/llvm/should_run/all.T ===================================== @@ -18,3 +18,8 @@ test('T22033', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_a test('T25730', [req_c, unless(arch('x86_64'), skip), normalise_errmsg_fun(ignore_llvm_and_vortex)], compile_and_run, ['T25730C.c']) # T25730C.c contains Intel instrinsics, so only run this test on x86 test('T20645', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"]))], compile_and_run, ['']) +# T26065.c tests LLVM linking of Intel instrinsics, so only run this test on x86 +test('T26065', [normal, normalise_errmsg_fun(ignore_llvm_and_vortex), when(have_llvm(), extra_ways(["optllvm"])), + unless((arch('x86_64') or arch('i386')) and have_cpu_feature('bmi2'),skip)], + compile_and_run, ['-mbmi2']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a601c30d5e885d9b15b202f1fce55c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a601c30d5e885d9b15b202f1fce55c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: RV64: Fix: Add missing truncation to MO_S_Shr (#26248)
by Marge Bot (＠marge-bot) 24 Sep '25

24 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c4d32493 by Sven Tennie at 2025-09-23T20:40:57-04:00 RV64: Fix: Add missing truncation to MO_S_Shr (#26248) Sub-double word (<W64) registers need to be truncated after the operation. - - - - - 41dce477 by Sven Tennie at 2025-09-23T20:40:57-04:00 RV64: Cleanup shift emitting cases/code Remove overlapping cases to make the shift logic easier to understand. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -874,46 +874,18 @@ getRegister' config plat expr = ) -- 2. Shifts. x << n, x >> n. - CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] - | w == W32, - 0 <= n, - n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - `appOL` truncateReg w w dst - ) - CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] - | w == W64, - 0 <= n, - n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - `appOL` truncateReg w w dst - ) - CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do - (reg_x, format_x, code_x) <- getSomeReg x - (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + CmmMachOp (MO_Shl w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do + (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) ( \dst -> code_x - `appOL` code_x' - `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + `snocOL` annExpr expr (SLL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_S_Shr w) [x, y] -> do + CmmMachOp (MO_S_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x return $ Any @@ -921,72 +893,20 @@ getRegister' config plat expr = ( \dst -> code_x `appOL` code_x' - `appOL` code_y - `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y)) + `snocOL` annExpr expr (SRA (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W8, - 0 <= n, - n < 8 -> do - (reg_x, format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W16, - 0 <= n, - n < 16 -> do - (reg_x, format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do + CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> do (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y return $ Any (intFormat w) ( \dst -> code_x - `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) + `appOL` truncateReg w w dst ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W32, - 0 <= n, - n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - CmmMachOp (MO_U_Shr w) [x, CmmLit (CmmInt n _)] - | w == W64, - 0 <= n, - n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return - $ Any - (intFormat w) - ( \dst -> - code_x - `snocOL` annExpr expr (SRL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) - ) - -- 3. Logic &&, || CmmMachOp (MO_And w) [CmmReg reg, CmmLit (CmmInt n _)] | fitsIn12bitImm n -> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67de53a6ced23caad640d2c7421089… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67de53a6ced23caad640d2c7421089… You're receiving this email because of your account on gitlab.haskell.org.

1 0