[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: base: Use TemplateHaskellQuotes in instance Lift ByteArray
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jun 5 03:53:22 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
b23746ad by Teo Camarasu at 2024-06-04T22:50:50-04:00
base: Use TemplateHaskellQuotes in instance Lift ByteArray
Resolves #24852
- - - - -
3fd25743 by Teo Camarasu at 2024-06-04T22:50:50-04:00
base: Mark addrToByteArray as NOINLINE
This function should never be inlined in order to keep code size small.
- - - - -
98ad1ea5 by Cheng Shao at 2024-06-04T22:51:26-04:00
compiler: remove unused CompilerInfo/LinkerInfo types
This patch removes CompilerInfo/LinkerInfo types from the compiler
since they aren't actually used anywhere.
- - - - -
32e89ba6 by Cheng Shao at 2024-06-04T23:52:57-04:00
rts: remove unused PowerPC/IA64 native adjustor code
This commit removes unused PowerPC/IA64 native adjustor code which is
never actually enabled by autoconf/hadrian. Fixes #24920.
- - - - -
848d5160 by Sylvain Henry at 2024-06-04T23:53:09-04:00
RTS: fix warnings with doing*Profiling (#24918)
- - - - -
9 changed files:
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- libraries/base/src/Data/Array/Byte.hs
- − rts/AdjustorAsm.S
- rts/RtsFlags.h
- − rts/adjustor/NativeIA64.c
- − rts/adjustor/NativePowerPC.c
- rts/include/rts/storage/ClosureMacros.h
- rts/rts.cabal
Changes:
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -60,10 +60,6 @@ module GHC.Driver.DynFlags (
versionedAppDir, versionedFilePath,
extraGccViaCFlags, globalPackageDatabasePath,
- -- * Linker/compiler information
- LinkerInfo(..),
- CompilerInfo(..),
-
-- * Include specifications
IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
addImplicitQuoteInclude,
@@ -758,31 +754,6 @@ data ParMakeCount
-- | Use the specific semaphore @<sem>@ to control parallelism (@-jsem <sem>@ flag).
| ParMakeSemaphore FilePath
--- -----------------------------------------------------------------------------
--- Linker/compiler information
-
--- LinkerInfo contains any extra options needed by the system linker.
-data LinkerInfo
- = GnuLD [Option]
- | Mold [Option]
- | GnuGold [Option]
- | LlvmLLD [Option]
- | DarwinLD [Option]
- | SolarisLD [Option]
- | AixLD [Option]
- | UnknownLD
- deriving Eq
-
--- CompilerInfo tells us which C compiler we're using
-data CompilerInfo
- = GCC
- | Clang
- | AppleClang
- | AppleClang51
- | Emscripten
- | UnknownCC
- deriving Eq
-
-- | The 'GhcMode' tells us whether we're doing multi-module
-- compilation (controlled via the "GHC" API) or one-shot
-- (single-module) compilation. This makes a difference primarily to
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -215,8 +215,6 @@ module GHC.Driver.Session (
isFmaEnabled,
-- * Linker/compiler information
- LinkerInfo(..),
- CompilerInfo(..),
useXLinkerRPath,
-- * Include specifications
=====================================
libraries/base/src/Data/Array/Byte.hs
=====================================
@@ -201,10 +201,11 @@ instance Show ByteArray where
| otherwise = showString ", "
instance Lift ByteArray where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (ByteArray b) = return
- (AppE (AppE (VarE addrToByteArrayName) (LitE (IntegerL (fromIntegral len))))
- (LitE (BytesPrimL (Bytes ptr 0 (fromIntegral len)))))
+ liftTyped = unsafeCodeCoerce . lift
+ lift (ByteArray b) =
+ [| addrToByteArray $(lift len)
+ $(pure . LitE . BytesPrimL $ Bytes ptr 0 (fromIntegral len))
+ |]
where
len# = sizeofByteArray# b
len = I# len#
@@ -219,9 +220,7 @@ instance Lift ByteArray where
ptr :: ForeignPtr Word8
ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))
-addrToByteArrayName :: Name
-addrToByteArrayName = 'addrToByteArray
-
+{-# NOINLINE addrToByteArray #-}
addrToByteArray :: Int -> Addr# -> ByteArray
addrToByteArray (I# len) addr = runST $ ST $
\s -> case newByteArray# len s of
=====================================
rts/AdjustorAsm.S deleted
=====================================
@@ -1,125 +0,0 @@
-#include "include/ghcconfig.h"
-
-/* ******************************** PowerPC ******************************** */
-
-#if defined(powerpc_HOST_ARCH) && defined(aix_HOST_OS) || defined(powerpc64_HOST_ARCH) && defined(__ELF__) && (!defined(_CALL_ELF) || _CALL_ELF == 1)
- /* The following code applies, with some differences,
- to all powerpc platforms except for powerpc32-linux,
- whose calling convention is annoyingly complex.
- */
-
-
- /* The code is "almost" the same for
- 32-bit and for 64-bit
- */
-#if defined(powerpc64_HOST_ARCH)
-#define WS 8
-#define LOAD ld
-#define STORE std
-#else
-#define WS 4
-#define LOAD lwz
-#define STORE stw
-#endif /* defined(powerpc64_HOST_ARCH) */
-
- /* Some info about stack frame layout */
-#define LINK_SLOT (2*WS)
-#define LINKAGE_AREA_SIZE (6*WS)
-
- /* The following defines mirror struct AdjustorStub
- from Adjustor.c. Make sure to keep these in sync.
- */
-#define HEADER_WORDS 3
-
-#define HPTR_OFF ((HEADER_WORDS )*WS)
-#define WPTR_OFF ((HEADER_WORDS + 1)*WS)
-#define FRAMESIZE_OFF ((HEADER_WORDS + 2)*WS)
-#define EXTRA_WORDS_OFF ((HEADER_WORDS + 3)*WS)
-
-#if defined(aix_HOST_OS)
-/* IBM's assembler needs a different pseudo-op to declare a .text section */
-.csect .text[PR]
-#else
-.text
-#endif /* defined(aix_HOST_OS) */
-
-#if LEADING_UNDERSCORE
- .globl _adjustorCode
-_adjustorCode:
-#else
- .globl adjustorCode
- /* Note that we don't build a function descriptor
- for AIX-derived ABIs here. This will happen at runtime
- in createAdjustor().
- */
-adjustorCode:
-#endif /* LEADING_UNDERSCORE */
- /* On entry, r2 will point to the AdjustorStub data structure. */
-
- /* save the link */
- mflr 0
- STORE 0, LINK_SLOT(1)
-
- /* set up stack frame */
- LOAD 12, FRAMESIZE_OFF(2)
-#if defined(powerpc64_HOST_ARCH)
- stdux 1, 1, 12
-#else
- stwux 1, 1, 12
-#endif /* defined(powerpc64_HOST_ARCH) */
-
- /* Save some regs so that we can use them.
- Note that we use the "Red Zone" below the stack pointer.
- */
- STORE 31, -WS(1)
- STORE 30, -2*WS(1)
-
- mr 31, 1
- subf 30, 12, 31
-
- LOAD 12, EXTRA_WORDS_OFF(2)
- mtctr 12
- b L2
-L1:
- LOAD 0, LINKAGE_AREA_SIZE + 8*WS(30)
- STORE 0, LINKAGE_AREA_SIZE + 10*WS(31)
- addi 30, 30, WS
- addi 31, 31, WS
-L2:
- bdnz L1
-
- /* Restore r30 and r31 now.
- */
- LOAD 31, -WS(1)
- LOAD 30, -2*WS(1)
-
- STORE 10, LINKAGE_AREA_SIZE + 9*WS(1)
- STORE 9, LINKAGE_AREA_SIZE + 8*WS(1)
- mr 10, 8
- mr 9, 7
- mr 8, 6
- mr 7, 5
- mr 6, 4
- mr 5, 3
-
- LOAD 3, HPTR_OFF(2)
-
- LOAD 12, WPTR_OFF(2)
- LOAD 0, 0(12)
- /* The function we're calling will never be a nested function,
- so we don't load r11.
- */
- mtctr 0
- LOAD 2, WS(12)
- bctrl
-
- LOAD 1, 0(1)
- LOAD 0, LINK_SLOT(1)
- mtlr 0
- blr
-#endif
-
-/* mark stack as nonexecutable */
-#if defined(__linux__) && defined(__ELF__)
-.section .note.GNU-stack,"", at progbits
-#endif
=====================================
rts/RtsFlags.h
=====================================
@@ -23,7 +23,12 @@ char** getUTF8Args(int* argc);
void initRtsFlagsDefaults (void);
void setupRtsFlags (int *argc, char *argv[], RtsConfig rtsConfig);
void freeRtsArgs (void);
-#if defined(PROFILING)
+
+/* These prototypes may also be defined by ClosureMacros.h. We don't want to
+ * define them twice (#24918).
+ */
+#if defined(PROFILING) && !defined(RTS_FLAGS_DOING_PROFILING)
+#define RTS_FLAGS_DOING_PROFILING 1
bool doingLDVProfiling (void);
bool doingRetainerProfiling(void);
bool doingErasProfiling(void);
=====================================
rts/adjustor/NativeIA64.c deleted
=====================================
@@ -1,154 +0,0 @@
-/* -----------------------------------------------------------------------------
- * IA64 architecture adjustor thunk logic.
- * ---------------------------------------------------------------------------*/
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "RtsUtils.h"
-#include "StablePtr.h"
-
-/* Layout of a function descriptor */
-typedef struct _IA64FunDesc {
- StgWord64 ip;
- StgWord64 gp;
-} IA64FunDesc;
-
-static void *
-stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
-{
- StgArrBytes* arr;
- uint32_t data_size_in_words, total_size_in_words;
-
- /* round up to a whole number of words */
- data_size_in_words = ROUNDUP_BYTES_TO_WDS(size_in_bytes);
- total_size_in_words = sizeofW(StgArrBytes) + data_size_in_words;
-
- /* allocate and fill it in */
- arr = (StgArrBytes *)allocate(total_size_in_words);
- SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, size_in_bytes);
-
- /* obtain a stable ptr */
- *stable = getStablePtr((StgPtr)arr);
-
- /* and return a ptr to the goods inside the array */
- return(&(arr->payload));
-}
-
-void initAdjustors(void) { }
-
-void*
-createAdjustor(StgStablePtr hptr,
- StgFunPtr wptr,
- char *typeString
-#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
- STG_UNUSED
-#endif
- )
-{
- void *adjustor = NULL;
- void *code = NULL;
-
-/*
- Up to 8 inputs are passed in registers. We flush the last two inputs to
- the stack, initially into the 16-byte scratch region left by the caller.
- We then shuffle the others along by 4 (taking 2 registers for ourselves
- to save return address and previous function state - we need to come back
- here on the way out to restore the stack, so this is a real function
- rather than just a trampoline).
-
- The function descriptor we create contains the gp of the target function
- so gp is already loaded correctly.
-
- [MLX] alloc r16=ar.pfs,10,2,0
- movl r17=wptr
- [MII] st8.spill [r12]=r38,8 // spill in6 (out4)
- mov r41=r37 // out7 = in5 (out3)
- mov r40=r36;; // out6 = in4 (out2)
- [MII] st8.spill [r12]=r39 // spill in7 (out5)
- mov.sptk b6=r17,50
- mov r38=r34;; // out4 = in2 (out0)
- [MII] mov r39=r35 // out5 = in3 (out1)
- mov r37=r33 // out3 = in1 (loc1)
- mov r36=r32 // out2 = in0 (loc0)
- [MLX] adds r12=-24,r12 // update sp
- movl r34=hptr;; // out0 = hptr
- [MIB] mov r33=r16 // loc1 = ar.pfs
- mov r32=b0 // loc0 = retaddr
- br.call.sptk.many b0=b6;;
-
- [MII] adds r12=-16,r12
- mov b0=r32
- mov.i ar.pfs=r33
- [MFB] nop.m 0x0
- nop.f 0x0
- br.ret.sptk.many b0;;
-*/
-
-/* These macros distribute a long constant into the two words of an MLX bundle */
-#define BITS(val,start,count) (((val) >> (start)) & ((1 << (count))-1))
-#define MOVL_LOWORD(val) (BITS(val,22,18) << 46)
-#define MOVL_HIWORD(val) ( (BITS(val,0,7) << 36) \
- | (BITS(val,7,9) << 50) \
- | (BITS(val,16,5) << 45) \
- | (BITS(val,21,1) << 44) \
- | (BITS(val,40,23)) \
- | (BITS(val,63,1) << 59))
-
- StgStablePtr stable;
- IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
- StgWord64 wcode = wdesc->ip;
- IA64FunDesc *fdesc;
- StgWord64 *code;
-
- /* we allocate on the Haskell heap since malloc'd memory isn't
- * executable - argh */
- /* Allocated memory is word-aligned (8 bytes) but functions on ia64
- * must be aligned to 16 bytes. We allocate an extra 8 bytes of
- * wiggle room so that we can put the code on a 16 byte boundary. */
- adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8+8, &stable);
-
- fdesc = (IA64FunDesc *)adjustor;
- code = (StgWord64 *)(fdesc + 1);
- /* add 8 bytes to code if needed to align to a 16-byte boundary */
- if ((StgWord64)code & 15) code++;
- fdesc->ip = (StgWord64)code;
- fdesc->gp = wdesc->gp;
-
- code[0] = 0x0000058004288004 | MOVL_LOWORD(wcode);
- code[1] = 0x6000000220000000 | MOVL_HIWORD(wcode);
- code[2] = 0x029015d818984001;
- code[3] = 0x8401200500420094;
- code[4] = 0x886011d8189c0001;
- code[5] = 0x84011004c00380c0;
- code[6] = 0x0250210046013800;
- code[7] = 0x8401000480420084;
- code[8] = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
- code[9] = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
- code[10] = 0x0200210020010811;
- code[11] = 0x1080006800006200;
- code[12] = 0x0000210018406000;
- code[13] = 0x00aa021000038005;
- code[14] = 0x000000010000001d;
- code[15] = 0x0084000880000200;
-
- /* save stable pointers in convenient form */
- code[16] = (StgWord64)hptr;
- code[17] = (StgWord64)stable;
-
- return code;
-}
-
-void
-freeHaskellFunctionPtr(void* ptr)
-{
- IA64FunDesc *fdesc = (IA64FunDesc *)ptr;
- StgWord64 *code = (StgWord64 *)(fdesc+1);
-
- if (fdesc->ip != (StgWord64)code) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr((StgStablePtr)code[16]);
- freeStablePtr((StgStablePtr)code[17]);
-}
=====================================
rts/adjustor/NativePowerPC.c deleted
=====================================
@@ -1,401 +0,0 @@
-/* -----------------------------------------------------------------------------
- * PowerPC architecture adjustor thunk logic.
- * ---------------------------------------------------------------------------*/
-
-#include "rts/PosixSource.h"
-#include "Rts.h"
-
-#include "RtsUtils.h"
-#include "StablePtr.h"
-#include "Adjustor.h"
-
-/* Adjustor logic for PowerPC and PowerPC64 */
-
-#if defined(linux_HOST_OS)
-#include <string.h>
-#endif
-
-// from AdjustorAsm.s
-// not declared as a function so that AIX-style
-// fundescs can never get in the way.
-extern void *adjustorCode;
-
-#if defined(linux_HOST_OS)
-__asm__("obscure_ccall_ret_code:\n\t"
- "lwz 1,0(1)\n\t"
- "lwz 0,4(1)\n\t"
- "mtlr 0\n\t"
- "blr");
-extern void obscure_ccall_ret_code(void);
-#endif /* defined(linux_HOST_OS) */
-
-#if defined(powerpc_HOST_ARCH) && defined(aix_HOST_OS) || defined(powerpc64_HOST_ARCH) && defined(__ELF__) && (!defined(_CALL_ELF) || _CALL_ELF == 1)
-
-/* !!! !!! WARNING: !!! !!!
- * This structure is accessed from AdjustorAsm.s
- * Any changes here have to be mirrored in the offsets there.
- */
-
-typedef struct AdjustorStub {
- /* fundesc-based ABIs */
-#define FUNDESCS
- StgFunPtr code;
- struct AdjustorStub
- *toc;
- void *env;
- StgStablePtr hptr;
- StgFunPtr wptr;
- StgInt negative_framesize;
- StgInt extrawords_plus_one;
-} AdjustorStub;
-
-#endif
-
-void initAdjustors(void) { }
-
-void*
-createAdjustor(StgStablePtr hptr,
- StgFunPtr wptr,
- char *typeString
- )
-{
-#if defined(linux_HOST_OS)
-
-#define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
- /* The PowerPC Linux (32-bit) calling convention is annoyingly complex.
- We need to calculate all the details of the stack frame layout,
- taking into account the types of all the arguments, and then
- generate code on the fly. */
-
- int src_gpr = 3, dst_gpr = 5;
- int fpr = 3;
- int src_offset = 0, dst_offset = 0;
- int n = strlen(typeString),i;
- int src_locs[n], dst_locs[n];
- int frameSize;
-
- /* Step 1:
- Calculate where the arguments should go.
- src_locs[] will contain the locations of the arguments in the
- original stack frame passed to the adjustor.
- dst_locs[] will contain the locations of the arguments after the
- adjustor runs, on entry to the wrapper proc pointed to by wptr.
-
- This algorithm is based on the one described on page 3-19 of the
- System V ABI PowerPC Processor Supplement.
- */
- for(i=0;typeString[i];i++)
- {
- char t = typeString[i];
- if((t == 'f' || t == 'd') && fpr <= 8)
- src_locs[i] = dst_locs[i] = -32-(fpr++);
- else
- {
- if((t == 'l' || t == 'L') && src_gpr <= 9)
- {
- if((src_gpr & 1) == 0)
- src_gpr++;
- src_locs[i] = -src_gpr;
- src_gpr += 2;
- }
- else if((t == 'w' || t == 'W') && src_gpr <= 10)
- {
- src_locs[i] = -(src_gpr++);
- }
- else
- {
- if(t == 'l' || t == 'L' || t == 'd')
- {
- if(src_offset % 8)
- src_offset += 4;
- }
- src_locs[i] = src_offset;
- src_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4;
- }
-
- if((t == 'l' || t == 'L') && dst_gpr <= 9)
- {
- if((dst_gpr & 1) == 0)
- dst_gpr++;
- dst_locs[i] = -dst_gpr;
- dst_gpr += 2;
- }
- else if((t == 'w' || t == 'W') && dst_gpr <= 10)
- {
- dst_locs[i] = -(dst_gpr++);
- }
- else
- {
- if(t == 'l' || t == 'L' || t == 'd')
- {
- if(dst_offset % 8)
- dst_offset += 4;
- }
- dst_locs[i] = dst_offset;
- dst_offset += (t == 'l' || t == 'L' || t == 'd') ? 8 : 4;
- }
- }
- }
-
- frameSize = dst_offset + 8;
- frameSize = (frameSize+15) & ~0xF;
-
- /* Step 2:
- Build the adjustor.
- */
- // allocate space for at most 4 insns per parameter
- // plus 14 more instructions.
- ExecPage *page = allocateExecPage();
- if (page == NULL) {
- barf("createAdjustor: failed to allocate executable page\n");
- }
- unsigned *code = adjustor;
-
- *code++ = 0x48000008; // b *+8
- // * Put the hptr in a place where freeHaskellFunctionPtr
- // can get at it.
- *code++ = (unsigned) hptr;
-
- // * save the link register
- *code++ = 0x7c0802a6; // mflr r0;
- *code++ = 0x90010004; // stw r0, 4(r1);
- // * and build a new stack frame
- *code++ = OP_LO(0x9421, -frameSize); // stwu r1, -frameSize(r1)
-
- // * now generate instructions to copy arguments
- // from the old stack frame into the new stack frame.
- for(i=n-1;i>=0;i--)
- {
- if(src_locs[i] < -32)
- ASSERT(dst_locs[i] == src_locs[i]);
- else if(src_locs[i] < 0)
- {
- // source in GPR.
- ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
- if(dst_locs[i] < 0)
- {
- ASSERT(dst_locs[i] > -32);
- // dst is in GPR, too.
-
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // mr dst+1, src+1
- *code++ = 0x7c000378
- | ((-dst_locs[i]+1) << 16)
- | ((-src_locs[i]+1) << 11)
- | ((-src_locs[i]+1) << 21);
- }
- // mr dst, src
- *code++ = 0x7c000378
- | ((-dst_locs[i]) << 16)
- | ((-src_locs[i]) << 11)
- | ((-src_locs[i]) << 21);
- }
- else
- {
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // stw src+1, dst_offset+4(r1)
- *code++ = 0x90010000
- | ((-src_locs[i]+1) << 21)
- | (dst_locs[i] + 4);
- }
-
- // stw src, dst_offset(r1)
- *code++ = 0x90010000
- | ((-src_locs[i]) << 21)
- | (dst_locs[i] + 8);
- }
- }
- else
- {
- ASSERT(dst_locs[i] >= 0);
- ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
-
- if(typeString[i] == 'l' || typeString[i] == 'L')
- {
- // lwz r0, src_offset(r1)
- *code++ = 0x80010000
- | (src_locs[i] + frameSize + 8 + 4);
- // stw r0, dst_offset(r1)
- *code++ = 0x90010000
- | (dst_locs[i] + 8 + 4);
- }
- // lwz r0, src_offset(r1)
- *code++ = 0x80010000
- | (src_locs[i] + frameSize + 8);
- // stw r0, dst_offset(r1)
- *code++ = 0x90010000
- | (dst_locs[i] + 8);
- }
- }
-
- // * hptr will be the new first argument.
- // lis r3, hi(hptr)
- *code++ = OP_HI(0x3c60, hptr);
- // ori r3,r3,lo(hptr)
- *code++ = OP_LO(0x6063, hptr);
-
- // * we need to return to a piece of code
- // which will tear down the stack frame.
- // lis r11,hi(obscure_ccall_ret_code)
- *code++ = OP_HI(0x3d60, obscure_ccall_ret_code);
- // ori r11,r11,lo(obscure_ccall_ret_code)
- *code++ = OP_LO(0x616b, obscure_ccall_ret_code);
- // mtlr r11
- *code++ = 0x7d6803a6;
-
- // * jump to wptr
- // lis r11,hi(wptr)
- *code++ = OP_HI(0x3d60, wptr);
- // ori r11,r11,lo(wptr)
- *code++ = OP_LO(0x616b, wptr);
- // mtctr r11
- *code++ = 0x7d6903a6;
- // bctr
- *code++ = 0x4e800420;
-
- freezeExecPage(page);
-
- // Flush the Instruction cache:
- {
- unsigned *p = adjustor;
- while(p < code)
- {
- __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
- : : "r" (p));
- p++;
- }
- __asm__ volatile ("sync\n\tisync");
- }
-
-#else
-
-#define OP_LO(op,lo) ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi) ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
- /* The following code applies to all PowerPC and PowerPC64 platforms
- whose stack layout is based on the AIX ABI.
-
- Besides (obviously) AIX, this includes
- Mac OS 9 and BeOS/PPC and Mac OS X PPC (may they rest in peace),
- which use the 32-bit AIX ABI
- powerpc64-linux,
- which uses the 64-bit AIX ABI.
-
- The actual stack-frame shuffling is implemented out-of-line
- in the function adjustorCode, in AdjustorAsm.S.
- Here, we set up an AdjustorStub structure, which
- is a function descriptor with a pointer to the AdjustorStub
- struct in the position of the TOC that is loaded
- into register r2.
-
- One nice thing about this is that there is _no_ code generated at
- runtime on the platforms that have function descriptors.
- */
- AdjustorStub *adjustorStub;
- int sz = 0, extra_sz, total_sz;
-
-#if defined(FUNDESCS)
- adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
-#else
- ExecPage *page = allocateExecPage();
- if (page == NULL) {
- barf("createAdjustor: failed to allocate executable page\n");
- }
- adjustorStub = (AdjustorStub *) page;
-#endif /* defined(FUNDESCS) */
- adjustor = adjustorStub;
-
- adjustorStub->code = (void*) &adjustorCode;
-
-#if defined(FUNDESCS)
- // function descriptors are a cool idea.
- // We don't need to generate any code at runtime.
- adjustorStub->toc = adjustorStub;
-#else
-
- // no function descriptors :-(
- // We need to do things "by hand".
-#if defined(powerpc_HOST_ARCH)
- // lis r2, hi(adjustorStub)
- adjustorStub->lis = OP_HI(0x3c40, adjustorStub);
- // ori r2, r2, lo(adjustorStub)
- adjustorStub->ori = OP_LO(0x6042, adjustorStub);
- // lwz r0, code(r2)
- adjustorStub->lwz = OP_LO(0x8002, (char*)(&adjustorStub->code)
- - (char*)adjustorStub);
- // mtctr r0
- adjustorStub->mtctr = 0x7c0903a6;
- // bctr
- adjustorStub->bctr = 0x4e800420;
-
- freezeExecPage(page);
-#else
- barf("adjustor creation not supported on this platform");
-#endif /* defined(powerpc_HOST_ARCH) */
-
- // Flush the Instruction cache:
- {
- int n = sizeof(AdjustorStub)/sizeof(unsigned);
- unsigned *p = (unsigned*)adjustor;
- while(n--)
- {
- __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
- : : "r" (p));
- p++;
- }
- __asm__ volatile ("sync\n\tisync");
- }
-#endif /* defined(FUNDESCS) */
-
- // Calculate the size of the stack frame, in words.
- sz = totalArgumentSize(typeString);
-
- // The first eight words of the parameter area
- // are just "backing store" for the parameters passed in
- // the GPRs. extra_sz is the number of words beyond those first
- // 8 words.
- extra_sz = sz - 8;
- if(extra_sz < 0)
- extra_sz = 0;
-
- // Calculate the total size of the stack frame.
- total_sz = (6 /* linkage area */
- + 8 /* minimum parameter area */
- + 2 /* two extra arguments */
- + extra_sz)*sizeof(StgWord);
-
- // align to 16 bytes.
- // AIX only requires 8 bytes, but who cares?
- total_sz = (total_sz+15) & ~0xF;
-
- // Fill in the information that adjustorCode in AdjustorAsm.S
- // will use to create a new stack frame with the additional args.
- adjustorStub->hptr = hptr;
- adjustorStub->wptr = wptr;
- adjustorStub->negative_framesize = -total_sz;
- adjustorStub->extrawords_plus_one = extra_sz + 1;
-
- return code;
-}
-
-void
-freeHaskellFunctionPtr(void* ptr)
-{
-#if defined(linux_HOST_OS)
- if ( *(StgWord*)ptr != 0x48000008 ) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr(((StgStablePtr*)ptr)[1]);
-#else
- if ( ((AdjustorStub*)ptr)->code != (StgFunPtr) &adjustorCode ) {
- errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
- return;
- }
- freeStablePtr(((AdjustorStub*)ptr)->hptr);
-#endif
-
- freeExecPage(ptr);
-}
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -152,10 +152,16 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
be duplicated here, otherwise there will be some
-Wimplicit-function-declaration compilation errors. Especially when
GHC compiles out-of-tree cbits that rely on SET_HDR in RTS API.
+
+ However when RtsFlags.h is imported, we don't want to redefine them to avoid
+ spurious warnings (#24918).
*/
+#if !defined(RTS_FLAGS_DOING_PROFILING)
+#define RTS_FLAGS_DOING_PROFILING 1
bool doingLDVProfiling(void);
bool doingRetainerProfiling(void);
bool doingErasProfiling(void);
+#endif
/*
The following macro works for both retainer profiling and LDV profiling. For
=====================================
rts/rts.cabal
=====================================
@@ -362,11 +362,6 @@ library
else
asm-sources: adjustor/NativeAmd64Asm.S
c-sources: adjustor/NativeAmd64.c
- if arch(ppc) || arch(ppc64)
- asm-sources: AdjustorAsm.S
- c-sources: adjustor/NativePowerPC.c
- if arch(ia64)
- c-sources: adjustor/NativeIA64.c
-- Use assembler STG entrypoint on architectures where it is used
if arch(ppc) || arch(ppc64) || arch(s390x) || arch(riscv64) || arch(loongarch64)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7541e2046e24ed1abf1066689ec2a0f4ea3ec9b2...848d5160f6b84d36ba15cea83bad82641138bbb2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7541e2046e24ed1abf1066689ec2a0f4ea3ec9b2...848d5160f6b84d36ba15cea83bad82641138bbb2
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240604/ff6f86d5/attachment-0001.html>
More information about the ghc-commits
mailing list