diff --git a/compiler/GHC/Platform/AArch64.hs b/compiler/GHC/Platform/AArch64.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Platform/AArch64.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module GHC.Platform.AArch64 where + +import GhcPrelude + +#define MACHREGS_NO_REGS 0 +#define MACHREGS_aarch64 1 +#include "../../../includes/CodeGen.Platform.hs" diff --git a/compiler/GHC/Platform/ARM64.hs b/compiler/GHC/Platform/ARM64.hs deleted file mode 100644 --- a/compiler/GHC/Platform/ARM64.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE CPP #-} - -module GHC.Platform.ARM64 where - -import GhcPrelude - -#define MACHREGS_NO_REGS 0 -#define MACHREGS_aarch64 1 -#include "../../../includes/CodeGen.Platform.hs" - diff --git a/compiler/GHC/Platform/Regs.hs b/compiler/GHC/Platform/Regs.hs --- a/compiler/GHC/Platform/Regs.hs +++ b/compiler/GHC/Platform/Regs.hs @@ -1,4 +1,3 @@ - module GHC.Platform.Regs (callerSaves, activeStgRegs, haveRegBase, globalRegMaybe, freeReg) where @@ -10,7 +9,7 @@ import Reg import qualified GHC.Platform.ARM as ARM -import qualified GHC.Platform.ARM64 as ARM64 +import qualified GHC.Platform.AArch64 as AArch64 import qualified GHC.Platform.PPC as PPC import qualified GHC.Platform.S390X as S390X import qualified GHC.Platform.SPARC as SPARC @@ -26,12 +25,12 @@ | platformUnregisterised platform = NoRegs.callerSaves | otherwise = case platformArch platform of - ArchX86 -> X86.callerSaves - ArchX86_64 -> X86_64.callerSaves - ArchS390X -> S390X.callerSaves - ArchSPARC -> SPARC.callerSaves - ArchARM {} -> ARM.callerSaves - ArchARM64 -> ARM64.callerSaves + ArchX86 -> X86.callerSaves + ArchX86_64 -> X86_64.callerSaves + ArchS390X -> S390X.callerSaves + ArchSPARC -> SPARC.callerSaves + ArchARM {} -> ARM.callerSaves + ArchAArch64 -> AArch64.callerSaves arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.callerSaves @@ -48,12 +47,12 @@ | platformUnregisterised platform = NoRegs.activeStgRegs | otherwise = case platformArch platform of - ArchX86 -> X86.activeStgRegs - ArchX86_64 -> X86_64.activeStgRegs - ArchS390X -> S390X.activeStgRegs - ArchSPARC -> SPARC.activeStgRegs - ArchARM {} -> ARM.activeStgRegs - ArchARM64 -> ARM64.activeStgRegs + ArchX86 -> X86.activeStgRegs + ArchX86_64 -> X86_64.activeStgRegs + ArchS390X -> S390X.activeStgRegs + ArchSPARC -> SPARC.activeStgRegs + ArchARM {} -> ARM.activeStgRegs + ArchAArch64 -> AArch64.activeStgRegs arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.activeStgRegs @@ -65,12 +64,12 @@ | platformUnregisterised platform = NoRegs.haveRegBase | otherwise = case platformArch platform of - ArchX86 -> X86.haveRegBase - ArchX86_64 -> X86_64.haveRegBase - ArchS390X -> S390X.haveRegBase - ArchSPARC -> SPARC.haveRegBase - ArchARM {} -> ARM.haveRegBase - ArchARM64 -> ARM64.haveRegBase + ArchX86 -> X86.haveRegBase + ArchX86_64 -> X86_64.haveRegBase + ArchS390X -> S390X.haveRegBase + ArchSPARC -> SPARC.haveRegBase + ArchARM {} -> ARM.haveRegBase + ArchAArch64 -> AArch64.haveRegBase arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.haveRegBase @@ -82,12 +81,12 @@ | platformUnregisterised platform = NoRegs.globalRegMaybe | otherwise = case platformArch platform of - ArchX86 -> X86.globalRegMaybe - ArchX86_64 -> X86_64.globalRegMaybe - ArchS390X -> S390X.globalRegMaybe - ArchSPARC -> SPARC.globalRegMaybe - ArchARM {} -> ARM.globalRegMaybe - ArchARM64 -> ARM64.globalRegMaybe + ArchX86 -> X86.globalRegMaybe + ArchX86_64 -> X86_64.globalRegMaybe + ArchS390X -> S390X.globalRegMaybe + ArchSPARC -> SPARC.globalRegMaybe + ArchARM {} -> ARM.globalRegMaybe + ArchAArch64 -> AArch64.globalRegMaybe arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.globalRegMaybe @@ -99,15 +98,14 @@ | platformUnregisterised platform = NoRegs.freeReg | otherwise = case platformArch platform of - ArchX86 -> X86.freeReg - ArchX86_64 -> X86_64.freeReg - ArchS390X -> S390X.freeReg - ArchSPARC -> SPARC.freeReg - ArchARM {} -> ARM.freeReg - ArchARM64 -> ARM64.freeReg + ArchX86 -> X86.freeReg + ArchX86_64 -> X86_64.freeReg + ArchS390X -> S390X.freeReg + ArchSPARC -> SPARC.freeReg + ArchARM {} -> ARM.freeReg + ArchAArch64 -> AArch64.freeReg arch | arch `elem` [ArchPPC, ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2] -> PPC.freeReg | otherwise -> NoRegs.freeReg - diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs --- a/compiler/GHC/StgToCmm/Bind.hs +++ b/compiler/GHC/StgToCmm/Bind.hs @@ -52,6 +52,8 @@ import Control.Monad +import TyCon (PrimRep (..)) + ------------------------------------------------------------------------ -- Top-level bindings ------------------------------------------------------------------------ @@ -716,9 +718,9 @@ ; let newCAF_lbl = mkForeignLabel (fsLit "newCAF") Nothing ForeignLabelInExternalPackage IsFunction ; bh <- newTemp (bWord dflags) - ; emitRtsCallGen [(bh,AddrHint)] newCAF_lbl - [ (baseExpr, AddrHint), - (CmmReg (CmmLocal node), AddrHint) ] + ; emitRtsCallGen [(bh, AddrRep, AddrHint)] newCAF_lbl + [ (baseExpr, AddrRep, AddrHint), + (CmmReg (CmmLocal node), AddrRep, AddrHint) ] False -- see Note [atomic CAF entry] in rts/sm/Storage.c diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs --- a/compiler/GHC/StgToCmm/DataCon.hs +++ b/compiler/GHC/StgToCmm/DataCon.hs @@ -84,6 +84,21 @@ nv_args_w_offsets) = mkVirtHeapOffsetsWithPadding dflags StdHeader (addArgReps args) + ; let + -- Decompose padding into units of length 8, 4, 2, or 1 bytes to + -- allow the implementation of mk_payload to use widthFromBytes, + -- which only handles these cases. + fix_padding (x@(Padding n off) : rest) + | n == 0 = fix_padding rest + | n `elem` [1,2,4,8] = x : fix_padding rest + | n > 8 = add_pad 8 + | n > 4 = add_pad 4 + | n > 2 = add_pad 2 + | otherwise = add_pad 1 + where add_pad m = Padding m off : fix_padding (Padding (n-m) (off+m) : rest) + fix_padding (x : rest) = x : fix_padding rest + fix_padding [] = [] + mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len)) mk_payload (FieldOff arg _) = do amode <- getArgAmode arg @@ -99,7 +114,7 @@ info_tbl = mkDataConInfoTable dflags con True ptr_wds nonptr_wds - ; payload <- mapM mk_payload nv_args_w_offsets + ; payload <- mapM mk_payload (fix_padding nv_args_w_offsets) -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs -- NB2: all the amodes should be Lits! -- TODO (osa): Why? diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs --- a/compiler/GHC/StgToCmm/Expr.hs +++ b/compiler/GHC/StgToCmm/Expr.hs @@ -571,7 +571,7 @@ isSimpleOp :: StgOp -> [StgArg] -> FCode Bool -- True iff the op cannot block or allocate -isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe) +isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe _ _)) _) _ = return $! not (playSafe safe) -- dataToTag# evalautes its argument, see Note [dataToTag#] in primops.txt.pp isSimpleOp (StgPrimOp DataToTagOp) _ = return False isSimpleOp (StgPrimOp op) stg_args = do diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs --- a/compiler/GHC/StgToCmm/Foreign.hs +++ b/compiler/GHC/StgToCmm/Foreign.hs @@ -65,7 +65,7 @@ -> Type -- result type -> FCode ReturnKind -cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_ty +cgForeignCall (CCall (CCallSpec target cconv safety ret_rep arg_reps)) typ stg_args res_ty = do { dflags <- getDynFlags ; let -- in the stdcall calling convention, the symbol needs @size appended -- to it, where size is the total number of bytes of arguments. We @@ -97,7 +97,7 @@ DynamicTarget -> case cmm_args of (fn,_):rest -> (unzip rest, fn) [] -> panic "cgForeignCall []" - fc = ForeignConvention cconv arg_hints res_hints CmmMayReturn + fc = ForeignConvention cconv arg_hints res_hints CmmMayReturn ret_rep arg_reps call_target = ForeignTarget cmm_target fc -- we want to emit code for the call, and then emitReturn. @@ -188,17 +188,22 @@ -} -emitCCall :: [(CmmFormal,ForeignHint)] +emitCCall :: [(CmmFormal, PrimRep, ForeignHint)] -> CmmExpr - -> [(CmmActual,ForeignHint)] + -> [(CmmActual, PrimRep, ForeignHint)] -> FCode () emitCCall hinted_results fn hinted_args = void $ emitForeignCall PlayRisky results target args where - (args, arg_hints) = unzip hinted_args - (results, result_hints) = unzip hinted_results + (args, arg_reps, arg_hints) = unzip3 hinted_args + (results, result_reps, result_hints) = unzip3 hinted_results + -- extract result, we can only deal with 0 or 1 result types. + res_rep = case result_reps of + [] -> VoidRep + [r] -> r + _ -> error "can not deal with multiple return values in emitCCall" target = ForeignTarget fn fc - fc = ForeignConvention CCallConv arg_hints result_hints CmmMayReturn + fc = ForeignConvention CCallConv arg_hints result_hints CmmMayReturn res_rep arg_reps emitPrimCall :: [CmmFormal] -> CallishMachOp -> [CmmActual] -> FCode () @@ -653,4 +658,3 @@ -- a type in a foreign function signature with a representationally -- equivalent newtype. tycon = tyConAppTyCon (unwrapType typ) - diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -290,15 +290,16 @@ -> opAllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n) _ -> PrimopCmmEmit_External --- First we handle various awkward cases specially. - + -- First we handle various awkward cases specially. + -- Note: StgInt newSpark (StgRegTable *reg, StgClosure *p) + -- StgInt is Int_64 on 64bit platforms, Int_32 on others ParOp -> \[arg] -> opAllDone $ \[res] -> do -- for now, just implement this in a C function -- later, we might want to inline it. emitCCall - [(res,NoHint)] + [(res, Int64Rep, SignedHint)] (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction))) - [(baseExpr, AddrHint), (arg,AddrHint)] + [(baseExpr, AddrRep, AddrHint), (arg, AddrRep, AddrHint)] SparkOp -> \[arg] -> opAllDone $ \[res] -> do -- returns the value of arg in res. We're going to therefore @@ -307,9 +308,9 @@ tmp <- assignTemp arg tmp2 <- newTemp (bWord dflags) emitCCall - [(tmp2,NoHint)] + [(tmp2, Int64Rep, SignedHint)] (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction))) - [(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] + [(baseExpr, AddrRep, AddrHint), ((CmmReg (CmmLocal tmp)), AddrRep, AddrHint)] emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp)) GetCCSOfOp -> \[arg] -> opAllDone $ \[res] -> do @@ -342,7 +343,7 @@ emitCCall [{-no results-}] (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) - [(baseExpr, AddrHint), (mutv, AddrHint), (CmmReg old_val, AddrHint)] + [(baseExpr, AddrRep, AddrHint), (mutv, AddrRep, AddrHint), (CmmReg old_val, AddrRep, AddrHint)] -- #define sizzeofByteArrayzh(r,a) \ -- r = ((StgArrBytes *)(a))->bytes diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs --- a/compiler/GHC/StgToCmm/Prof.hs +++ b/compiler/GHC/StgToCmm/Prof.hs @@ -44,6 +44,8 @@ import Control.Monad import Data.Char (ord) +import TyCon (PrimRep (..)) + ----------------------------------------------------------------------------- -- -- Cost-centre-stack Profiling @@ -178,8 +180,8 @@ if isCurrentCCS ccs then do dflags <- getDynFlags emitRtsCall rtsUnitId (fsLit "enterFunCCS") - [(baseExpr, AddrHint), - (costCentreFrom dflags closure, AddrHint)] False + [(baseExpr, AddrRep, AddrHint), + (costCentreFrom dflags closure, AddrRep, AddrHint)] False else return () -- top-level function, nothing to do ifProfiling :: FCode () -> FCode () @@ -246,7 +248,7 @@ -- C compiler (that compiles the RTS, in particular) does -- layouts of structs containing long-longs, simply -- pad out the struct with zero words until we hit the - -- size of the overall struct (which we get via DerivedConstants.h) + -- size of the overall struct (which we get via GhclibDerivedConstants.h) emitDataLits (mkCCSLabel ccs) (mk_lits cc) Nothing -> pprPanic "emitCostCentreStackDecl" (ppr ccs) @@ -278,10 +280,10 @@ pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> FCode () pushCostCentre result ccs cc - = emitRtsCallWithResult result AddrHint + = emitRtsCallWithResult result AddrRep AddrHint rtsUnitId - (fsLit "pushCostCentre") [(ccs,AddrHint), - (CmmLit (mkCCostCentre cc), AddrHint)] + (fsLit "pushCostCentre") [(ccs, AddrRep, AddrHint), + (CmmLit (mkCCostCentre cc), AddrRep, AddrHint)] False bumpSccCount :: DynFlags -> CmmExpr -> CmmAGraph diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -179,19 +179,19 @@ -- ------------------------------------------------------------------------- -emitRtsCall :: UnitId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () +emitRtsCall :: UnitId -> FastString -> [(CmmExpr, PrimRep, ForeignHint)] -> Bool -> FCode () emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe -emitRtsCallWithResult :: LocalReg -> ForeignHint -> UnitId -> FastString - -> [(CmmExpr,ForeignHint)] -> Bool -> FCode () -emitRtsCallWithResult res hint pkg fun args safe - = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe +emitRtsCallWithResult :: LocalReg -> PrimRep -> ForeignHint -> UnitId -> FastString + -> [(CmmExpr, PrimRep, ForeignHint)] -> Bool -> FCode () +emitRtsCallWithResult res rep hint pkg fun args safe + = emitRtsCallGen [(res, rep, hint)] (mkCmmCodeLabel pkg fun) args safe -- Make a call to an RTS C procedure emitRtsCallGen - :: [(LocalReg,ForeignHint)] + :: [(LocalReg, PrimRep, ForeignHint)] -> CLabel - -> [(CmmExpr,ForeignHint)] + -> [(CmmExpr, PrimRep, ForeignHint)] -> Bool -- True <=> CmmSafe call -> FCode () emitRtsCallGen res lbl args safe @@ -206,10 +206,14 @@ if safe then emit =<< mkCmmCall fun_expr res' args' updfr_off else do - let conv = ForeignConvention CCallConv arg_hints res_hints CmmMayReturn + let conv = ForeignConvention CCallConv arg_hints res_hints CmmMayReturn res_rep arg_reps emit $ mkUnsafeCall (ForeignTarget fun_expr conv) res' args' - (args', arg_hints) = unzip args - (res', res_hints) = unzip res + (args', arg_reps, arg_hints) = unzip3 args + (res', res_reps, res_hints) = unzip3 res + res_rep = case res_reps of + [] -> VoidRep + [r] -> r + _ -> error "can not deal with multiple return values" fun_expr = mkLblExpr lbl @@ -608,8 +612,8 @@ emitRtsCall rtsUnitId (fsLit "updateRemembSetPushClosure_") - [(CmmReg (CmmGlobal BaseReg), AddrHint), - (ptr, AddrHint)] + [(CmmReg (CmmGlobal BaseReg), AddrRep, AddrHint), + (ptr, AddrRep, AddrHint)] False emitUpdRemSetPushThunk :: CmmExpr -- ^ the thunk @@ -618,6 +622,6 @@ emitRtsCall rtsUnitId (fsLit "updateRemembSetPushThunk_") - [(CmmReg (CmmGlobal BaseReg), AddrHint), - (ptr, AddrHint)] + [(CmmReg (CmmGlobal BaseReg), AddrRep, AddrHint), + (ptr, AddrRep, AddrHint)] False diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -37,6 +37,7 @@ import Data.Array as Array import Data.Bits import Data.List (nub) +import TyCon (PrimRep (..)) {- Note [Stack Layout] @@ -1185,18 +1186,20 @@ foreignLbl :: FastString -> CmmExpr foreignLbl name = CmmLit (CmmLabel (mkForeignLabel name Nothing ForeignLabelInExternalPackage IsFunction)) +-- void * suspendThread (StgRegTable *, bool interruptible); callSuspendThread :: DynFlags -> LocalReg -> Bool -> CmmNode O O callSuspendThread dflags id intrbl = CmmUnsafeForeignCall (ForeignTarget (foreignLbl (fsLit "suspendThread")) - (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint] CmmMayReturn)) + (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint] CmmMayReturn AddrRep [AddrRep, Word32Rep])) [id] [baseExpr, mkIntExpr dflags (fromEnum intrbl)] +-- StgRegTable * resumeThread (void *); callResumeThread :: LocalReg -> LocalReg -> CmmNode O O callResumeThread new_base id = CmmUnsafeForeignCall (ForeignTarget (foreignLbl (fsLit "resumeThread")) - (ForeignConvention CCallConv [AddrHint] [AddrHint] CmmMayReturn)) + (ForeignConvention CCallConv [AddrHint] [AddrHint] CmmMayReturn AddrRep [AddrRep])) [new_base] [CmmReg (CmmLocal id)] -- ----------------------------------------------------------------------------- diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs --- a/compiler/cmm/CmmMachOp.hs +++ b/compiler/cmm/CmmMachOp.hs @@ -17,7 +17,7 @@ , mo_32To8, mo_32To16, mo_WordTo8, mo_WordTo16, mo_WordTo32, mo_WordTo64 -- CallishMachOp - , CallishMachOp(..), callishMachOpHints + , CallishMachOp(..), callishMachOpHints, callishMachOpReps , pprCallishMachOp , machOpMemcpyishAlign @@ -32,6 +32,8 @@ import Outputable import DynFlags +import TyCon (PrimRep (..)) + ----------------------------------------------------------------------------- -- MachOp ----------------------------------------------------------------------------- @@ -649,12 +651,96 @@ callishMachOpHints :: CallishMachOp -> ([ForeignHint], [ForeignHint]) callishMachOpHints op = case op of - MO_Memcpy _ -> ([], [AddrHint,AddrHint,NoHint]) - MO_Memset _ -> ([], [AddrHint,NoHint,NoHint]) - MO_Memmove _ -> ([], [AddrHint,AddrHint,NoHint]) + -- void * memcpy(void *restrict dst, const void *restrict src, size_t n); + MO_Memcpy _ -> ([], [AddrHint, AddrHint, NoHint]) + -- void * memset(void *b, int c, size_t len); + MO_Memset _ -> ([], [AddrHint, SignedHint, NoHint]) + -- void * memmove(void *dst, const void *src, size_t len); + MO_Memmove _ -> ([], [AddrHint, AddrHint, NoHint]) + -- int memcmp(const void *s1, const void *s2, size_t n); MO_Memcmp _ -> ([], [AddrHint, AddrHint, NoHint]) _ -> ([],[]) -- empty lists indicate NoHint + +-- be very careful when setting signatures. +-- C int's need to be Int32Rep. Not IntRep, IntRep is +-- GHC's always Word sized int. Ideally we'd have some +-- CIntRep, but we don't. +callishMachOpReps :: CallishMachOp -> (PrimRep, [PrimRep]) +callishMachOpReps op = case op of + MO_Memcpy _ -> (AddrRep, [AddrRep, AddrRep, WordRep]) + MO_Memset _ -> (AddrRep, [AddrRep, Int32Rep, WordRep]) + MO_Memmove _ -> (AddrRep, [AddrRep, AddrRep, WordRep]) + MO_Memcmp _ -> (Int32Rep, [AddrRep, AddrRep, WordRep]) + + MO_F64_Pwr -> (DoubleRep, [DoubleRep, DoubleRep]) + + MO_F64_Sin -> (DoubleRep, [DoubleRep]) + MO_F64_Cos -> (DoubleRep, [DoubleRep]) + MO_F64_Tan -> (DoubleRep, [DoubleRep]) + + MO_F64_Sinh -> (DoubleRep, [DoubleRep]) + MO_F64_Cosh -> (DoubleRep, [DoubleRep]) + MO_F64_Tanh -> (DoubleRep, [DoubleRep]) + + MO_F64_Asin -> (DoubleRep, [DoubleRep]) + MO_F64_Acos -> (DoubleRep, [DoubleRep]) + MO_F64_Atan -> (DoubleRep, [DoubleRep]) + + MO_F64_Asinh -> (DoubleRep, [DoubleRep]) + MO_F64_Acosh -> (DoubleRep, [DoubleRep]) + MO_F64_Atanh -> (DoubleRep, [DoubleRep]) + + MO_F64_Log -> (DoubleRep, [DoubleRep]) + MO_F64_Log1P -> (DoubleRep, [DoubleRep]) + MO_F64_Exp -> (DoubleRep, [DoubleRep]) + MO_F64_ExpM1 -> (DoubleRep, [DoubleRep]) + + MO_F64_Fabs -> (DoubleRep, [DoubleRep]) + MO_F64_Sqrt -> (DoubleRep, [DoubleRep]) + + MO_F32_Pwr -> (FloatRep, [FloatRep, FloatRep]) + + MO_F32_Sin -> (FloatRep, [FloatRep]) + MO_F32_Cos -> (FloatRep, [FloatRep]) + MO_F32_Tan -> (FloatRep, [FloatRep]) + + MO_F32_Sinh -> (FloatRep, [FloatRep]) + MO_F32_Cosh -> (FloatRep, [FloatRep]) + MO_F32_Tanh -> (FloatRep, [FloatRep]) + + MO_F32_Asin -> (FloatRep, [FloatRep]) + MO_F32_Acos -> (FloatRep, [FloatRep]) + MO_F32_Atan -> (FloatRep, [FloatRep]) + + MO_F32_Asinh -> (FloatRep, [FloatRep]) + MO_F32_Acosh -> (FloatRep, [FloatRep]) + MO_F32_Atanh -> (FloatRep, [FloatRep]) + + MO_F32_Log -> (FloatRep, [FloatRep]) + MO_F32_Log1P -> (FloatRep, [FloatRep]) + MO_F32_Exp -> (FloatRep, [FloatRep]) + MO_F32_ExpM1 -> (FloatRep, [FloatRep]) + + MO_F32_Fabs -> (FloatRep, [FloatRep]) + MO_F32_Sqrt -> (FloatRep, [FloatRep]) + + MO_PopCnt W8 -> (Word8Rep, [Word8Rep]) + MO_PopCnt W16 -> (Word16Rep, [Word16Rep]) + MO_PopCnt W32 -> (Word32Rep, [Word32Rep]) + MO_PopCnt W64 -> (Word64Rep, [Word64Rep]) + + MO_BSwap W8 -> (Word8Rep, [Word8Rep]) + MO_BSwap W16 -> (Word16Rep, [Word16Rep]) + MO_BSwap W32 -> (Word32Rep, [Word32Rep]) + MO_BSwap W64 -> (Word64Rep, [Word64Rep]) + + MO_BRev W8 -> (Word8Rep, [Word8Rep]) + MO_BRev W16 -> (Word16Rep, [Word16Rep]) + MO_BRev W32 -> (Word32Rep, [Word32Rep]) + MO_BRev W64 -> (Word64Rep, [Word64Rep]) + + _ -> (VoidRep, []) -- | The alignment of a 'memcpy'-ish operation. machOpMemcpyishAlign :: CallishMachOp -> Maybe Int diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -9,13 +9,12 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-} - -- CmmNode type for representation using Hoopl graphs. module CmmNode ( CmmNode(..), CmmFormal, CmmActual, CmmTickish, UpdFrameOffset, Convention(..), - ForeignConvention(..), ForeignTarget(..), foreignTargetHints, + ForeignConvention(..), ForeignTarget(..), foreignTargetHints, foreignTargetReps, CmmReturnInfo(..), mapExp, mapExpDeep, wrapRecExp, foldExp, foldExpDeep, wrapRecExpf, mapExpM, mapExpDeepM, wrapRecExpM, mapSuccessors, mapCollectSuccessors, @@ -46,6 +45,7 @@ import Unique (nonDetCmpUnique) import Util +import TyCon (PrimRep) ------------------------ -- CmmNode @@ -281,12 +281,36 @@ -- (TODO: I don't think we need this --SDM) deriving( Eq ) + +-------------------------------------------------- +-- Note [ForeignConvention PrimRep Carry] +-- +-- With the advert of aarch64-darwin, a new AAPCS was brought into mainstream. +-- This AAPCS requires us to pack arguments in excess of registers by their +-- size on the stack as well as extends values as necessary. +-- +-- GHC's internal represetnation of values ends up being either Words or Ints, +-- both of which are assumed to be Word size[1]. Thus in the CodeGen there is no +-- way to recover the origial size of arguments. +-- +-- In GHC 9.2 this has been rectified in !4390 (commit 3e3555cc); however for +-- GHCs before 9.2 to support aarch64-darwin, we need a more lightweight solution. +-- Thus we inject the PrimRep signature during the desugar phase into the +-- ForeignConvention and carry it through to the CodeGen where we can inspect +-- it and produce the correct ABI calls. +-- +-- See https://developer.apple.com/documentation/xcode/writing_arm64_code_for_apple_platforms +-- +-- [1]: Int8 = I8# Int#, Word8 = W8# Word# + data ForeignConvention = ForeignConvention CCallConv -- Which foreign-call convention [ForeignHint] -- Extra info about the args [ForeignHint] -- Extra info about the result CmmReturnInfo + PrimRep -- return prim rep + [PrimRep] -- argument prim reps deriving Eq data CmmReturnInfo @@ -302,7 +326,11 @@ CallishMachOp -- Which one deriving Eq -foreignTargetHints :: ForeignTarget -> ([ForeignHint], [ForeignHint]) +foreignTargetReps :: HasCallStack => ForeignTarget -> (PrimRep, [PrimRep]) +foreignTargetReps (ForeignTarget _ (ForeignConvention _ _ _ _ rr ras)) = (rr, ras) +foreignTargetReps (PrimTarget op) = callishMachOpReps op + +foreignTargetHints :: HasCallStack => ForeignTarget -> ([ForeignHint], [ForeignHint]) foreignTargetHints target = ( res_hints ++ repeat NoHint , arg_hints ++ repeat NoHint ) @@ -310,7 +338,7 @@ (res_hints, arg_hints) = case target of PrimTarget op -> callishMachOpHints op - ForeignTarget _ (ForeignConvention _ arg_hints res_hints _) -> + ForeignTarget _ (ForeignConvention _ arg_hints res_hints _ _ _) -> (res_hints, arg_hints) -------------------------------------------------- @@ -376,7 +404,7 @@ activeRegs = activeStgRegs platform activeCallerSavesRegs = filter (callerSaves platform) activeRegs - foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = [] + foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns _ _)) = [] foreignTargetRegs _ = activeCallerSavesRegs -- Note [Safe foreign calls clobber STG registers] diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -263,6 +263,8 @@ import qualified Data.Map as M import qualified Data.ByteString.Char8 as BS8 +import TyCon (PrimRep(..)) + #include "GhclibHsVersions.h" } @@ -1204,7 +1206,27 @@ expr' = adjCallTarget dflags conv expr args (arg_exprs, arg_hints) = unzip args (res_regs, res_hints) = unzip results - fc = ForeignConvention conv arg_hints res_hints ret + res_cmm_tys = zip (map localRegType res_regs) res_hints + arg_cmm_tys = zip (map (cmmExprType dflags) arg_exprs) arg_hints + res_rep :: (CmmType, ForeignHint) -> PrimRep + res_rep (_, AddrHint) = AddrRep + res_rep (t, _) | isGcPtrType t = Word64Rep + res_rep (t, SignedHint) | t `cmmEqType` b8 = Int8Rep + res_rep (t, SignedHint) | t `cmmEqType` b16 = Int16Rep + res_rep (t, SignedHint) | t `cmmEqType` b32 = Int32Rep + res_rep (t, SignedHint) | t `cmmEqType` b64 = Int64Rep + res_rep (t, NoHint) | t `cmmEqType` b8 = Word8Rep + res_rep (t, NoHint) | t `cmmEqType` b16 = Word16Rep + res_rep (t, NoHint) | t `cmmEqType` b32 = Word32Rep + res_rep (t, NoHint) | t `cmmEqType` b64 = Word64Rep + res_rep (t, _) | t `cmmEqType` f32 = FloatRep + res_rep (t, _) | t `cmmEqType` f64 = DoubleRep + + ret_rep = case (map res_rep res_cmm_tys) of + [] -> VoidRep + [r] -> r + x -> (panic $ show x) + fc = ForeignConvention conv arg_hints res_hints ret ret_rep (map res_rep arg_cmm_tys) target = ForeignTarget expr' fc _ <- code $ emitForeignCall safety res_regs target arg_exprs return () diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -11,7 +11,7 @@ module CmmUtils( -- CmmType - primRepCmmType, slotCmmType, slotForeignHint, + primRepCmmType, slotCmmType, typeCmmType, typeForeignHint, primRepForeignHint, -- CmmLit @@ -116,11 +116,12 @@ primRepCmmType _ (VecRep len rep) = vec len (primElemRepCmmType rep) slotCmmType :: DynFlags -> SlotTy -> CmmType -slotCmmType dflags PtrSlot = gcWord dflags -slotCmmType dflags WordSlot = bWord dflags -slotCmmType _ Word64Slot = b64 -slotCmmType _ FloatSlot = f32 -slotCmmType _ DoubleSlot = f64 +slotCmmType dflags PtrLiftedSlot = gcWord dflags +slotCmmType dflags PtrUnliftedSlot = gcWord dflags +slotCmmType dflags WordSlot = bWord dflags +slotCmmType _ Word64Slot = b64 +slotCmmType _ FloatSlot = f32 +slotCmmType _ DoubleSlot = f64 primElemRepCmmType :: PrimElemRep -> CmmType primElemRepCmmType Int8ElemRep = b8 @@ -155,13 +156,6 @@ primRepForeignHint FloatRep = NoHint primRepForeignHint DoubleRep = NoHint primRepForeignHint (VecRep {}) = NoHint - -slotForeignHint :: SlotTy -> ForeignHint -slotForeignHint PtrSlot = AddrHint -slotForeignHint WordSlot = NoHint -slotForeignHint Word64Slot = NoHint -slotForeignHint FloatSlot = NoHint -slotForeignHint DoubleSlot = NoHint typeForeignHint :: UnaryType -> ForeignHint typeForeignHint = primRepForeignHint . typePrimRep1 diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -235,7 +235,7 @@ hresults = zip results res_hints hargs = zip args arg_hints - ForeignConvention cconv _ _ ret = conv + ForeignConvention cconv _ _ ret _ _ = conv cast_fn = parens (cCast (pprCFunType (char '*') cconv hresults hargs) fn) @@ -1164,7 +1164,7 @@ bewareLoadStoreAlignment ArchMipseb = True bewareLoadStoreAlignment ArchMipsel = True bewareLoadStoreAlignment (ArchARM {}) = True - bewareLoadStoreAlignment ArchARM64 = True + bewareLoadStoreAlignment ArchAArch64 = True bewareLoadStoreAlignment ArchSPARC = True bewareLoadStoreAlignment ArchSPARC64 = True -- Pessimistically assume that they will also cause problems diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -155,7 +155,7 @@ pprConvention GC = text "" pprForeignConvention :: ForeignConvention -> SDoc -pprForeignConvention (ForeignConvention c args res ret) = +pprForeignConvention (ForeignConvention c args res ret _ _) = doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res <+> ppr ret pprReturnInfo :: CmmReturnInfo -> SDoc diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs --- a/compiler/deSugar/DsCCall.hs +++ b/compiler/deSugar/DsCCall.hs @@ -47,6 +47,7 @@ import Data.Maybe +import RepType (mkCCallSpec) {- Desugaring of @ccall@s consists of adding some state manipulation, unboxing any boxed primitive arguments and boxing the result if @@ -97,8 +98,14 @@ uniq <- newUnique dflags <- getDynFlags let + arg_tys = map exprType args + + raw_res_ty = case tcSplitIOType_maybe result_ty of + Just (_ioTyCon, res_ty) -> res_ty + Nothing -> result_ty + target = StaticTarget NoSourceText lbl Nothing True - the_fcall = CCall (CCallSpec target CCallConv may_gc) + the_fcall = CCall (mkCCallSpec target CCallConv may_gc raw_res_ty arg_tys) the_prim_app = mkFCall dflags uniq the_fcall unboxed_args ccall_result_ty return (foldr ($) (res_wrapper the_prim_app) arg_wrappers) diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -173,9 +173,13 @@ return ([(id, rhs')], empty, empty) dsCImport id co (CFunction target) cconv@PrimCallConv safety _ - = dsPrimCall id co (CCall (CCallSpec target cconv safety)) + = dsPrimCall id co (CCall (mkCCallSpec target cconv safety + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps"))) dsCImport id co (CFunction target) cconv safety mHeader - = dsFCall id co (CCall (CCallSpec target cconv safety)) mHeader + = dsFCall id co (CCall (mkCCallSpec target cconv safety + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps"))) mHeader dsCImport id co CWrapper cconv _ _ = dsFExportDynamic id co cconv @@ -203,7 +207,7 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header -> DsM ([(Id, Expr TyVar)], SDoc, SDoc) -dsFCall fn_id co fcall mDeclHeader = do +dsFCall fn_id co (CCall (CCallSpec target cconv safety _ _)) mDeclHeader = do let ty = pFst $ coercionKind co (tv_bndrs, rho) = tcSplitForAllVarBndrs ty @@ -221,16 +225,19 @@ work_uniq <- newUnique dflags <- getDynFlags - (fcall', cDoc) <- - case fcall of + + let + fcall = CCall (mkCCallSpec target cconv safety io_res_ty arg_tys) + + (fcall', cDoc) <- case fcall of CCall (CCallSpec (StaticTarget _ cName mUnitId isFun) - CApiConv safety) -> + CApiConv safety _ _) -> do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName) - let fcall' = CCall (CCallSpec + let fcall' = CCall (mkCCallSpec (StaticTarget NoSourceText wrapperName mUnitId True) - CApiConv safety) + CApiConv safety io_res_ty arg_tys) c = includes $$ fun_proto <+> braces (cRet <> semi) includes = vcat [ text "#include \"" <> ftext h @@ -304,7 +311,7 @@ dsPrimCall :: Id -> Coercion -> ForeignCall -> DsM ([(Id, Expr TyVar)], SDoc, SDoc) -dsPrimCall fn_id co fcall = do +dsPrimCall fn_id co (CCall (CCallSpec target cconv safety _ _)) = do let ty = pFst $ coercionKind co (tvs, fun_ty) = tcSplitForAllTys ty @@ -315,6 +322,7 @@ ccall_uniq <- newUnique dflags <- getDynFlags let + fcall = CCall (mkCCallSpec target cconv safety io_res_ty arg_tys) call_app = mkFCall dflags ccall_uniq fcall (map Var args) io_res_ty rhs = mkLams tvs (mkLams args call_app) rhs' = Cast rhs co @@ -820,6 +828,12 @@ = case typePrimRep1 (getPrimTyOf ty) of IntRep -> signed_word WordRep -> unsigned_word + Int8Rep -> 'B' + Word8Rep -> 'b' + Int16Rep -> 'S' + Word16Rep -> 's' + Int32Rep -> 'W' + Word32Rep -> 'w' Int64Rep -> 'L' Word64Rep -> 'l' AddrRep -> 'p' diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs --- a/compiler/ghci/ByteCodeGen.hs +++ b/compiler/ghci/ByteCodeGen.hs @@ -1151,7 +1151,7 @@ -> Id -- of target, for type info -> [AnnExpr' Id DVarSet] -- args (atoms) -> BcM BCInstrList -generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l +generateCCall d0 s p (CCallSpec target cconv safety _rep_ret _rep_args) fn args_r_to_l = do dflags <- getDynFlags @@ -1359,6 +1359,12 @@ VoidRep -> FFIVoid IntRep -> signed_word WordRep -> unsigned_word + Int8Rep -> FFISInt8 + Word8Rep -> FFIUInt8 + Int16Rep -> FFISInt16 + Word16Rep -> FFIUInt16 + Int32Rep -> FFISInt32 + Word32Rep -> FFIUInt32 Int64Rep -> FFISInt64 Word64Rep -> FFIUInt64 AddrRep -> FFIPointer @@ -1834,7 +1840,7 @@ -- | Indicate if the calling convention is supported isSupportedCConv :: CCallSpec -> Bool -isSupportedCConv (CCallSpec _ cconv _) = case cconv of +isSupportedCConv (CCallSpec _ cconv _ _ _) = case cconv of CCallConv -> True -- we explicitly pattern match on every StdCallConv -> True -- convention to ensure that a warning PrimCallConv -> False -- is triggered when a new one is added diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -58,7 +58,8 @@ let doWarn = wopt Opt_WarnUnsupportedLlvmVersion dflags when (not (llvmVersionSupported ver) && doWarn) $ putMsg dflags $ "You are using an unsupported version of LLVM!" $$ - "Currently only " <> text (llvmVersionStr supportedLlvmVersion) <> " is supported." <+> + "Currently only" <+> text (llvmVersionStr supportedLlvmVersionMin) <+> + "to" <+> text (llvmVersionStr supportedLlvmVersionMax) <+> "is supported." <+> "System LLVM version: " <> text (llvmVersionStr ver) $$ "We will try though..." let isS390X = platformArch (targetPlatform dflags) == ArchS390X @@ -67,8 +68,14 @@ "Warning: For s390x the GHC calling convention is only supported since LLVM version 10." <+> "You are using LLVM version: " <> text (llvmVersionStr ver) + -- HACK: the Nothing case here is potentially wrong here but we + -- currently don't use the LLVM version to guide code generation + -- so this is okay. + let llvm_ver :: LlvmVersion + llvm_ver = fromMaybe supportedLlvmVersionMin mb_ver + -- run code generation - a <- runLlvm dflags (fromMaybe supportedLlvmVersion mb_ver) bufh $ + a <- runLlvm dflags llvm_ver bufh $ llvmCodeGen' (liftStream cmm_stream) bFlush bufh diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -13,7 +13,8 @@ LiveGlobalRegs, LlvmUnresData, LlvmData, UnresLabel, UnresStatic, - LlvmVersion, supportedLlvmVersion, llvmVersionSupported, parseLlvmVersion, + LlvmVersion, llvmVersionSupported, parseLlvmVersion, + supportedLlvmVersionMin, supportedLlvmVersionMax, llvmVersionStr, llvmVersionList, LlvmM, @@ -268,6 +269,7 @@ -- Newtype to avoid using the Eq instance! newtype LlvmVersion = LlvmVersion { llvmVersionNE :: NE.NonEmpty Int } + deriving (Eq, Ord) parseLlvmVersion :: String -> Maybe LlvmVersion parseLlvmVersion = @@ -284,11 +286,13 @@ (ver_str, rest) = span isDigit s -- | The LLVM Version that is currently supported. -supportedLlvmVersion :: LlvmVersion -supportedLlvmVersion = LlvmVersion (sUPPORTED_LLVM_VERSION NE.:| []) +supportedLlvmVersionMin, supportedLlvmVersionMax :: LlvmVersion +supportedLlvmVersionMin = LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| []) +supportedLlvmVersionMax = LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| []) llvmVersionSupported :: LlvmVersion -> Bool -llvmVersionSupported (LlvmVersion v) = NE.head v == sUPPORTED_LLVM_VERSION +llvmVersionSupported v = + v > supportedLlvmVersionMin && v <= supportedLlvmVersionMax llvmVersionStr :: LlvmVersion -> String llvmVersionStr = intercalate "." . map show . llvmVersionList diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -43,6 +43,8 @@ import Data.List ( nub ) import Data.Maybe ( catMaybes ) +import TyCon (PrimRep(..)) + type Atomic = Bool type LlvmStatements = OrdList LlvmStatement @@ -400,23 +402,44 @@ -- Handle all other foreign calls and prim ops. genCall target res args = runStmtsDecls $ do dflags <- getDynFlags + platform <- lift $ getLlvmPlatform - -- parameter types - let arg_type (_, AddrHint) = i8Ptr - -- cast pointers to i8*. Llvm equivalent of void* - arg_type (expr, _) = cmmToLlvmType $ cmmExprType dflags expr + let primRepToLlvmTy VoidRep = (Unsigned, LMVoid) + -- GHC's IntRep is not the same as CIntRep, GHC's + -- IntRep is always Word Sized. This conversely also + -- means that any CInt needs to be mapped to Int32Rep + -- and any custom signature that expects to to C FFI + -- needs to also be Int32Rep. + primRepToLlvmTy IntRep = (Signed, widthToLlvmInt (wordWidth dflags)) + primRepToLlvmTy Int8Rep = (Signed, i8) + primRepToLlvmTy Int16Rep = (Signed, i16) + primRepToLlvmTy Int32Rep = (Signed, i32) + primRepToLlvmTy Int64Rep = (Signed, i64) + primRepToLlvmTy WordRep = (Unsigned, widthToLlvmInt (wordWidth dflags)) + primRepToLlvmTy Word8Rep = (Unsigned, i8) + primRepToLlvmTy Word16Rep = (Unsigned, i16) + primRepToLlvmTy Word32Rep = (Unsigned, i32) + primRepToLlvmTy Word64Rep = (Unsigned, i64) + primRepToLlvmTy FloatRep = (Signed, LMFloat) + primRepToLlvmTy DoubleRep = (Signed, LMDouble) + -- pointers + primRepToLlvmTy AddrRep = (Unsigned, i8Ptr) + primRepToLlvmTy LiftedRep = (Unsigned, i8Ptr) + primRepToLlvmTy UnliftedRep = (Unsigned, i8Ptr) + primRepToLlvmTy _ = panic "LlvmCodeGen.CodeGen.genCall: Invalid primRep; cannot convert to llvm type" + -- ret type - let ret_type [] = LMVoid - ret_type [(_, AddrHint)] = i8Ptr - ret_type [(reg, _)] = cmmToLlvmType $ localRegType reg - ret_type t = panic $ "genCall: Too many return values! Can only handle" - ++ " 0 or 1, given " ++ show (length t) ++ "." + let -- similarly to arg_type_cmm, we may need to widen/narrow the result. + -- most likely widen, as cmm regs will be 64bit wide. + ret_type_cmm [] = LMVoid + ret_type_cmm [(_, AddrHint)] = i8Ptr + ret_type_cmm [(reg, _)] = cmmToLlvmType $ localRegType reg + ret_type_cmm _ = panic "LlvmCodeGen.CodeGen.genCall: invalid return type; we only support single return values" -- extract Cmm call convention, and translate to LLVM call convention - platform <- lift $ getLlvmPlatform let lmconv = case target of - ForeignTarget _ (ForeignConvention conv _ _ _) -> + ForeignTarget _ (ForeignConvention conv _ _ _ _ _) -> case conv of StdCallConv -> case platformArch platform of ArchX86 -> CC_X86_Stdcc @@ -442,22 +465,25 @@ | otherwise = llvmStdFunAttrs never_returns = case target of - ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns) -> True + ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns _ _) -> True _ -> False -- fun type - let (res_hints, arg_hints) = foreignTargetHints target - let args_hints = zip args arg_hints + let (res_hints, _arg_hints) = foreignTargetHints target + let (ret_rep, args_rep) = foreignTargetReps target + let ress_hints = zip res res_hints let ccTy = StdCall -- tail calls should be done through CmmJump - let retTy = ret_type ress_hints - let argTy = tysToParams $ map arg_type args_hints + + let retTyCmm = ret_type_cmm ress_hints + + let argTy = tysToParams $ map (snd . primRepToLlvmTy) args_rep + let retTy = snd $ primRepToLlvmTy ret_rep let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible lmconv retTy FixedArgs argTy (llvmFunAlign dflags) - argVars <- arg_varsW args_hints ([], nilOL, []) - fptr <- getFunPtrW funTy target + let args_with_reps = zip args (map primRepToLlvmTy args_rep) let doReturn | ccTy == TailCall = statement $ Return Nothing | never_returns = statement $ Unreachable @@ -466,19 +492,23 @@ doTrashStmts -- make the actual call + argVars <- arg_varsW2 args_with_reps ([], nilOL, []) + fptr <- getFunPtrW funTy target case retTy of LMVoid -> do statement $ Expr $ Call ccTy fptr argVars fnAttrs _ -> do - v1 <- doExprW retTy $ Call ccTy fptr argVars fnAttrs + let (signage, retTy) = primRepToLlvmTy ret_rep + v0 <- doExprW retTy $ Call ccTy fptr argVars fnAttrs + v1 <- castVarW signage v0 retTyCmm -- get the return register let ret_reg [reg] = reg ret_reg t = panic $ "genCall: Bad number of registers! Can only handle" ++ " 1, given " ++ show (length t) ++ "." let creg = ret_reg res vreg <- getCmmRegW (CmmLocal creg) - if retTy == pLower (getVarType vreg) + if retTyCmm == pLower (getVarType vreg) then do statement $ Store v1 vreg doReturn @@ -580,8 +610,7 @@ dstV <- getCmmReg (CmmLocal dst) - let (_, arg_hints) = foreignTargetHints t - let args_hints = zip args arg_hints + let args_hints = zip args (snd (foreignTargetHints t)) (argsV, stmts2, top2) <- arg_vars args_hints ([], nilOL, []) (argsV', stmts4) <- castVars Signed $ zip argsV [width] (retV, s1) <- doExpr width $ Call StdCall fptr argsV' [] @@ -668,6 +697,14 @@ tell $ LlvmAccum stmts decls return vars +arg_varsW2 :: [(CmmActual, (Signage, LlvmType))] + -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl]) + -> WriterT LlvmAccum LlvmM [LlvmVar] +arg_varsW2 xs ys = do + (vars, stmts, decls) <- lift $ arg_vars2 xs ys + tell $ LlvmAccum stmts decls + return vars + -- | Conversion of call arguments. arg_vars :: [(CmmActual, ForeignHint)] -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl]) @@ -678,14 +715,11 @@ arg_vars ((e, AddrHint):rest) (vars, stmts, tops) = do (v1, stmts', top') <- exprToVar e - dflags <- getDynFlags let op = case getVarType v1 of ty | isPointer ty -> LM_Bitcast ty | isInt ty -> LM_Inttoptr - a -> panic $ "genCall: Can't cast llvmType to i8*! (" - ++ showSDoc dflags (ppr a) ++ ")" - + a -> pprPanic "genCall: Can't cast llvmType to i8*!" (ppr a) (v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr arg_vars rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1, tops ++ top') @@ -695,6 +729,27 @@ arg_vars rest (vars ++ [v1], stmts `appOL` stmts', tops ++ top') +arg_vars2 :: [(CmmActual, (Signage, LlvmType))] + -> ([LlvmVar], LlvmStatements, [LlvmCmmDecl]) + -> LlvmM ([LlvmVar], LlvmStatements, [LlvmCmmDecl]) +arg_vars2 [] x = return x +arg_vars2 ((e, (_s, ty0)):rest) (vars, stmts, tops) + | ty0 == i8Ptr + = do (v1, stmts', top') <- exprToVar e + let op = case getVarType v1 of + ty | isPointer ty -> LM_Bitcast + ty | isInt ty -> LM_Inttoptr + + a -> pprPanic "genCall: Can't cast llvmType to i8*!" (ppr a) + (v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr + arg_vars2 rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1, + tops ++ top') + +arg_vars2 ((e, (s, ty)):rest) (vars, stmts, tops) + = do (v1, stmts', top') <- exprToVar e + (v2, s1) <- castVar s v1 ty + arg_vars2 rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1, tops ++ top') + -- | Cast a collection of LLVM variables to specific types. castVarsW :: Signage -> [(LlvmVar, LlvmType)] @@ -738,6 +793,12 @@ where extend = case signage of Signed -> LM_Sext Unsigned -> LM_Zext + +castVarW :: Signage -> LlvmVar -> LlvmType -> WriterT LlvmAccum LlvmM LlvmVar +castVarW signage var ty = do + (var, stmt) <- lift $ castVar signage var ty + statement $ stmt + return var cmmPrimOpRetValSignage :: CallishMachOp -> Signage diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -39,7 +39,7 @@ import System.FilePath import System.IO import System.IO.Error ( isEOFError ) -import Control.Monad ( when ) +import Control.Monad ( when, forM_ ) import Data.Maybe ( isJust ) import Data.IORef @@ -224,6 +224,16 @@ -- Emit std dependency of the object(s) on the source file -- Something like A.o : A.hs ; writeDependency root hdl obj_files src_file + + -- add dependency between objects and their corresponding .hi-boot + -- files if the module has a corresponding .hs-boot file (#14482) + ; when (isBootSummary node) $ do + let hi_boot = msHiFilePath node + let obj = removeBootSuffix (msObjFilePath node) + forM_ extra_suffixes $ \suff -> do + let way_obj = insertSuffixes obj [suff] + let way_hi_boot = insertSuffixes hi_boot [suff] + mapM_ (writeDependency root hdl way_obj) way_hi_boot -- Emit a dependency for each CPP import ; when (depIncludeCppDeps dflags) $ do diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1854,10 +1854,10 @@ not staticLink && (platformOS platform == OSDarwin) && case platformArch platform of - ArchX86 -> True - ArchX86_64 -> True - ArchARM {} -> True - ArchARM64 -> True + ArchX86 -> True + ArchX86_64 -> True + ArchARM {} -> True + ArchAArch64 -> True _ -> False then ["-Wl,-no_compact_unwind"] else []) diff --git a/compiler/main/Elf.hs b/compiler/main/Elf.hs --- a/compiler/main/Elf.hs +++ b/compiler/main/Elf.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {- ----------------------------------------------------------------------------- -- @@ -14,6 +15,9 @@ makeElfNote ) where +#include +#include "GhclibHsVersions.h" + import GhcPrelude import AsmUtils @@ -362,14 +366,22 @@ -- read notes recursively until the one with a valid identifier is found findNote hdr = do +#if defined(aarch64_HOST_ARCH) + align 8 +#else align 4 +#endif namesz <- gw32 hdr descsz <- gw32 hdr _ <- gw32 hdr -- we don't use the note type name <- if namesz == 0 then return LBS.empty else getLazyByteStringNul +#if defined(aarch64_HOST_ARCH) + align 8 +#else align 4 +#endif desc <- if descsz == 0 then return LBS.empty else getLazyByteString (fromIntegral descsz) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1182,7 +1182,7 @@ where inferredImportWarn = unitBag $ makeIntoWarning (Reason Opt_WarnInferredSafeImports) - $ mkErrMsg dflags l (pkgQual dflags) + $ mkWarnMsg dflags l (pkgQual dflags) $ sep [ text "Importing Safe-Inferred module " <> ppr (moduleName m) diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs --- a/compiler/main/SysTools.hs +++ b/compiler/main/SysTools.hs @@ -370,7 +370,7 @@ ++ [ Option "-undefined", Option "dynamic_lookup", Option "-single_module" ] - ++ (if platformArch platform == ArchX86_64 + ++ (if platformArch platform `elem` [ ArchX86_64, ArchAArch64 ] then [ ] else [ Option "-Wl,-read_only_relocs,suppress" ]) ++ [ Option "-install_name", Option instName ] diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs --- a/compiler/main/SysTools/Tasks.hs +++ b/compiler/main/SysTools/Tasks.hs @@ -23,7 +23,7 @@ import System.Process import GhcPrelude -import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion) +import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersionMin, supportedLlvmVersionMax, llvmVersionStr, parseLlvmVersion) import SysTools.Process import SysTools.Info @@ -236,8 +236,10 @@ errorMsg dflags $ vcat [ text "Warning:", nest 9 $ text "Couldn't figure out LLVM version!" $$ - text ("Make sure you have installed LLVM " ++ - llvmVersionStr supportedLlvmVersion) ] + text ("Make sure you have installed LLVM between " + ++ llvmVersionStr supportedLlvmVersionMin + ++ " and " + ++ llvmVersionStr supportedLlvmVersionMax) ] return Nothing) diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs --- a/compiler/nativeGen/AsmCodeGen.hs +++ b/compiler/nativeGen/AsmCodeGen.hs @@ -172,7 +172,7 @@ ArchSPARC -> nCG' (sparcNcgImpl dflags) ArchSPARC64 -> panic "nativeCodeGen: No NCG for SPARC64" ArchARM {} -> panic "nativeCodeGen: No NCG for ARM" - ArchARM64 -> panic "nativeCodeGen: No NCG for ARM64" + ArchAArch64 -> panic "nativeCodeGen: No NCG for ARM64" ArchPPC_64 _ -> nCG' (ppcNcgImpl dflags) ArchAlpha -> panic "nativeCodeGen: No NCG for Alpha" ArchMipseb -> panic "nativeCodeGen: No NCG for mipseb" diff --git a/compiler/nativeGen/BlockLayout.hs b/compiler/nativeGen/BlockLayout.hs --- a/compiler/nativeGen/BlockLayout.hs +++ b/compiler/nativeGen/BlockLayout.hs @@ -239,9 +239,46 @@ Assuming that Lwork is large the chance that the "call" ends up in the same cache line is also fairly small. --} + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + ~~~ Note [Layout relevant edge weights] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The input to the chain based code layout algorithm is a CFG + with edges annotated with their frequency. The frequency + of traversal corresponds quite well to the cost of not placing + the connected blocks next to each other. + However even if having the same frequency certain edges are + inherently more or less relevant to code layout. + + In particular: + + * Edges which cross an info table are less relevant than others. + + If we place the blocks across this edge next to each other + they are still separated by the info table which negates + much of the benefit. It makes it less likely both blocks + will share a cache line reducing the benefits from locality. + But it also prevents us from eliminating jump instructions. + + * Conditional branches and switches are slightly less relevant. + + We can completely remove unconditional jumps by placing them + next to each other. This is not true for conditional branch edges. + We apply a small modifier to them to ensure edges for which we can + eliminate the overhead completely are considered first. See also #18053. + + * Edges constituted by a call are ignored. + + Considering these hardly helped with performance and ignoring + them helps quite a bit to improve compiler performance. + + So we perform a preprocessing step where we apply a multiplicator + to these kinds of edges. + + -} + + -- | Look at X number of blocks in two chains to determine -- if they are "neighbours". neighbourOverlapp :: Int @@ -653,17 +690,31 @@ directEdges :: [CfgEdge] directEdges = sortBy (flip compare) $ catMaybes . map relevantWeight $ (infoEdgeList weights) where + -- Apply modifiers to turn edge frequencies into useable weights + -- for computing code layout. + -- See also Note [Layout relevant edge weights] relevantWeight :: CfgEdge -> Maybe CfgEdge relevantWeight edge@(CfgEdge from to edgeInfo) | (EdgeInfo CmmSource { trans_cmmNode = CmmCall {} } _) <- edgeInfo - -- Ignore edges across calls + -- Ignore edges across calls. = Nothing | mapMember to info , w <- edgeWeight edgeInfo - -- The payoff is small if we jump over an info table + -- The payoff is quite small if we jump over an info table = Just (CfgEdge from to edgeInfo { edgeWeight = w/8 }) + | (EdgeInfo CmmSource { trans_cmmNode = exitNode } _) <- edgeInfo + , cantEliminate exitNode + , w <- edgeWeight edgeInfo + -- A small penalty to edge types which + -- we can't optimize away by layout. + -- w * 0.96875 == w - w/32 + = Just (CfgEdge from to edgeInfo { edgeWeight = w * 0.96875 }) | otherwise = Just edge + where + cantEliminate CmmCondBranch {} = True + cantEliminate CmmSwitch {} = True + cantEliminate _ = False blockMap :: LabelMap (GenBasicBlock i) blockMap diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -115,7 +115,7 @@ ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" - ArchARM64 -> panic "trivColorable ArchARM64" + ArchAArch64 -> panic "trivColorable ArchAArch64" ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" @@ -146,7 +146,7 @@ ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 0 ArchARM _ _ _ -> panic "trivColorable ArchARM" - ArchARM64 -> panic "trivColorable ArchARM64" + ArchAArch64 -> panic "trivColorable ArchAArch64" ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" @@ -179,7 +179,7 @@ ArchSPARC64 -> panic "trivColorable ArchSPARC64" ArchPPC_64 _ -> 20 ArchARM _ _ _ -> panic "trivColorable ArchARM" - ArchARM64 -> panic "trivColorable ArchARM64" + ArchAArch64 -> panic "trivColorable ArchAArch64" ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs --- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs @@ -79,11 +79,10 @@ ArchSPARC -> SPARC.Instr.maxSpillSlots dflags ArchSPARC64 -> panic "maxSpillSlots ArchSPARC64" ArchARM _ _ _ -> panic "maxSpillSlots ArchARM" - ArchARM64 -> panic "maxSpillSlots ArchARM64" + ArchAArch64 -> panic "maxSpillSlots ArchAArch64" ArchPPC_64 _ -> PPC.Instr.maxSpillSlots dflags ArchAlpha -> panic "maxSpillSlots ArchAlpha" ArchMipseb -> panic "maxSpillSlots ArchMipseb" ArchMipsel -> panic "maxSpillSlots ArchMipsel" ArchJavaScript-> panic "maxSpillSlots ArchJavaScript" ArchUnknown -> panic "maxSpillSlots ArchUnknown" - diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -216,7 +216,7 @@ ArchSPARC64 -> panic "linearRegAlloc ArchSPARC64" ArchPPC -> go $ (frInitFreeRegs platform :: PPC.FreeRegs) ArchARM _ _ _ -> panic "linearRegAlloc ArchARM" - ArchARM64 -> panic "linearRegAlloc ArchARM64" + ArchAArch64 -> panic "linearRegAlloc ArchAArch64" ArchPPC_64 _ -> go $ (frInitFreeRegs platform :: PPC.FreeRegs) ArchAlpha -> panic "linearRegAlloc ArchAlpha" ArchMipseb -> panic "linearRegAlloc ArchMipseb" @@ -915,4 +915,3 @@ loadTemp _ _ _ spills = return spills - diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -49,7 +49,7 @@ ArchSPARC64 -> panic "targetVirtualRegSqueeze ArchSPARC64" ArchPPC_64 _ -> PPC.virtualRegSqueeze ArchARM _ _ _ -> panic "targetVirtualRegSqueeze ArchARM" - ArchARM64 -> panic "targetVirtualRegSqueeze ArchARM64" + ArchAArch64 -> panic "targetVirtualRegSqueeze ArchAArch64" ArchAlpha -> panic "targetVirtualRegSqueeze ArchAlpha" ArchMipseb -> panic "targetVirtualRegSqueeze ArchMipseb" ArchMipsel -> panic "targetVirtualRegSqueeze ArchMipsel" @@ -68,7 +68,7 @@ ArchSPARC64 -> panic "targetRealRegSqueeze ArchSPARC64" ArchPPC_64 _ -> PPC.realRegSqueeze ArchARM _ _ _ -> panic "targetRealRegSqueeze ArchARM" - ArchARM64 -> panic "targetRealRegSqueeze ArchARM64" + ArchAArch64 -> panic "targetRealRegSqueeze ArchAArch64" ArchAlpha -> panic "targetRealRegSqueeze ArchAlpha" ArchMipseb -> panic "targetRealRegSqueeze ArchMipseb" ArchMipsel -> panic "targetRealRegSqueeze ArchMipsel" @@ -86,7 +86,7 @@ ArchSPARC64 -> panic "targetClassOfRealReg ArchSPARC64" ArchPPC_64 _ -> PPC.classOfRealReg ArchARM _ _ _ -> panic "targetClassOfRealReg ArchARM" - ArchARM64 -> panic "targetClassOfRealReg ArchARM64" + ArchAArch64 -> panic "targetClassOfRealReg ArchAArch64" ArchAlpha -> panic "targetClassOfRealReg ArchAlpha" ArchMipseb -> panic "targetClassOfRealReg ArchMipseb" ArchMipsel -> panic "targetClassOfRealReg ArchMipsel" @@ -104,7 +104,7 @@ ArchSPARC64 -> panic "targetMkVirtualReg ArchSPARC64" ArchPPC_64 _ -> PPC.mkVirtualReg ArchARM _ _ _ -> panic "targetMkVirtualReg ArchARM" - ArchARM64 -> panic "targetMkVirtualReg ArchARM64" + ArchAArch64 -> panic "targetMkVirtualReg ArchAArch64" ArchAlpha -> panic "targetMkVirtualReg ArchAlpha" ArchMipseb -> panic "targetMkVirtualReg ArchMipseb" ArchMipsel -> panic "targetMkVirtualReg ArchMipsel" @@ -122,7 +122,7 @@ ArchSPARC64 -> panic "targetRegDotColor ArchSPARC64" ArchPPC_64 _ -> PPC.regDotColor ArchARM _ _ _ -> panic "targetRegDotColor ArchARM" - ArchARM64 -> panic "targetRegDotColor ArchARM64" + ArchAArch64 -> panic "targetRegDotColor ArchAArch64" ArchAlpha -> panic "targetRegDotColor ArchAlpha" ArchMipseb -> panic "targetRegDotColor ArchMipseb" ArchMipsel -> panic "targetRegDotColor ArchMipsel" diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -2440,7 +2440,12 @@ CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] - CmmMayReturn) + CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) genCCall' dflags is32Bit target dest_regs args bid where format = intFormat width @@ -2473,7 +2478,12 @@ CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] - CmmMayReturn) + CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) genCCall' dflags is32Bit target dest_regs args bid where format = intFormat width @@ -2506,7 +2516,12 @@ CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] - CmmMayReturn) + CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) genCCall' dflags is32Bit target dest_regs args bid where format = intFormat width @@ -2518,7 +2533,12 @@ targetExpr <- cmmMakeDynamicReference dflags CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] - CmmMayReturn) + CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) genCCall' dflags is32Bit target dest_regs args bid | otherwise = do @@ -2561,7 +2581,12 @@ CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv [NoHint] [NoHint] - CmmMayReturn) + CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) genCCall' dflags is32Bit target dest_regs args bid where lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) @@ -2900,7 +2925,7 @@ -- We have to pop any stack padding we added -- even if we are doing stdcall, though (#5052) pop_size - | ForeignConvention StdCallConv _ _ _ <- cconv = arg_pad_size + | ForeignConvention StdCallConv _ _ _ _ _ <- cconv = arg_pad_size | otherwise = tot_arg_size call = callinsns `appOL` @@ -3274,7 +3299,12 @@ dflags <- getDynFlags targetExpr <- cmmMakeDynamicReference dflags CallReference lbl let target = ForeignTarget targetExpr - (ForeignConvention CCallConv [] [] CmmMayReturn) + (ForeignConvention CCallConv [] [] CmmMayReturn + -- this is only safe, because + -- genCCall32' and genCCall64' + -- never inspect these arguments. + (panic "Missing Return PrimRep") + (panic "Missing Argument PrimReps")) -- We know foreign calls results in no new basic blocks, so we can ignore -- the returned block id. diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -1231,11 +1231,11 @@ ********************************************************* -} -reportUnusedNames :: TcGblEnv -> RnM () -reportUnusedNames gbl_env +reportUnusedNames :: TcGblEnv -> HscSource -> RnM () +reportUnusedNames gbl_env hsc_src = do { keep <- readTcRef (tcg_keep gbl_env) ; traceRn "RUN" (ppr (tcg_dus gbl_env)) - ; warnUnusedImportDecls gbl_env + ; warnUnusedImportDecls gbl_env hsc_src ; warnUnusedTopBinds $ unused_locals keep ; warnMissingSignatures gbl_env } where @@ -1357,8 +1357,8 @@ , [GlobalRdrElt] -- What *is* used (normalised) , [Name] ) -- What is imported but *not* used -warnUnusedImportDecls :: TcGblEnv -> RnM () -warnUnusedImportDecls gbl_env +warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM () +warnUnusedImportDecls gbl_env hsc_src = do { uses <- readMutVar (tcg_used_gres gbl_env) ; let user_imports = filterOut (ideclImplicit . unLoc) @@ -1380,7 +1380,7 @@ mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage ; whenGOptM Opt_D_dump_minimal_imports $ - printMinimalImports usage } + printMinimalImports hsc_src usage } findImportUsage :: [LImportDecl GhcRn] -> [GlobalRdrElt] @@ -1608,9 +1608,9 @@ all_non_overloaded = all (not . flIsOverloaded) -printMinimalImports :: [ImportDeclUsage] -> RnM () +printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM () -- See Note [Printing minimal imports] -printMinimalImports imports_w_usage +printMinimalImports hsc_src imports_w_usage = do { imports' <- getMinimalImports imports_w_usage ; this_mod <- getModule ; dflags <- getDynFlags @@ -1627,7 +1627,11 @@ | Just d <- dumpDir dflags = d basefn | otherwise = basefn where - basefn = moduleNameString (moduleName this_mod) ++ ".imports" + suffix = case hsc_src of + HsBootFile -> ".imports-boot" + HsSrcFile -> ".imports" + HsigFile -> ".imports" + basefn = moduleNameString (moduleName this_mod) ++ suffix to_ie_post_rn_var :: (HasOccName name) => Located name -> LIEWrappedName name diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -621,8 +621,8 @@ lvlMFE env strict_ctxt ann_expr | floatTopLvlOnly env && not (isTopLvl dest_lvl) -- Only floating to the top level is allowed. - || anyDVarSet isJoinId fvs -- If there is a free join, don't float - -- See Note [Free join points] + || hasFreeJoin env fvs -- If there is a free join, don't float + -- See Note [Free join points] || isExprLevPoly expr -- We can't let-bind levity polymorphic expressions -- See Note [Levity polymorphism invariants] in CoreSyn @@ -717,6 +717,14 @@ saves_alloc = isTopLvl dest_lvl && floatConsts env && (not strict_ctxt || is_bot || exprIsHNF expr) + +hasFreeJoin :: LevelEnv -> DVarSet -> Bool +-- Has a free join point which is not being floated to top level. +-- (In the latter case it won't be a join point any more.) +-- Not treating top-level ones specially had a massive effect +-- on nofib/minimax/Prog.prog +hasFreeJoin env fvs + = not (maxFvLevel isJoinId env fvs == tOP_LEVEL) isBottomThunk :: Maybe (Arity, s) -> Bool -- See Note [Bottoming floats] (2) diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -29,6 +29,7 @@ ArgInfo(..), ArgSpec(..), mkArgInfo, addValArgTo, addCastTo, addTyArgTo, argInfoExpr, argInfoAppArgs, pushSimplifiedArgs, + isStrictArgInfo, lazyArgContext, abstractFloats, @@ -150,8 +151,9 @@ | StrictArg -- (StrictArg (f e1 ..en) K)[e] = K[ f e1 .. en e ] { sc_dup :: DupFlag -- Always Simplified or OkToDup , sc_fun :: ArgInfo -- Specifies f, e1..en, Whether f has rules, etc - -- plus strictness flags for *further* args - , sc_cci :: CallCtxt -- Whether *this* argument position is interesting + -- plus demands and discount flags for *this* arg + -- and further args + -- So ai_dmds and ai_discs are never empty , sc_cont :: SimplCont } | TickIt -- (TickIt t K)[e] = K[ tick t e ] @@ -263,29 +265,52 @@ -- or an enclosing one has rules (recursively) -- True => be keener to inline in all args - ai_strs :: [Bool], -- Strictness of remaining arguments + ai_dmds :: [Demand], -- Demands on remaining value arguments (beyond ai_args) -- Usually infinite, but if it is finite it guarantees -- that the function diverges after being given -- that number of args - ai_discs :: [Int] -- Discounts for remaining arguments; non-zero => be keener to inline + + ai_discs :: [Int] -- Discounts for remaining value arguments (beyong ai_args) + -- non-zero => be keener to inline -- Always infinite } data ArgSpec - = ValArg OutExpr -- Apply to this (coercion or value); c.f. ApplyToVal + = ValArg { as_dmd :: Demand -- Demand placed on this argument + , as_arg :: OutExpr } -- Apply to this (coercion or value); c.f. ApplyToVal + | TyArg { as_arg_ty :: OutType -- Apply to this type; c.f. ApplyToTy , as_hole_ty :: OutType } -- Type of the function (presumably forall a. blah) + | CastBy OutCoercion -- Cast by this; c.f. CastIt +instance Outputable ArgInfo where + ppr (ArgInfo { ai_fun = fun, ai_args = args, ai_dmds = dmds }) + = text "ArgInfo" <+> braces + (sep [ text "fun =" <+> ppr fun + , text "dmds =" <+> ppr dmds + , text "args =" <+> ppr args ]) + instance Outputable ArgSpec where - ppr (ValArg e) = text "ValArg" <+> ppr e + ppr (ValArg { as_arg = e }) = text "ValArg" <+> ppr e ppr (TyArg { as_arg_ty = ty }) = text "TyArg" <+> ppr ty ppr (CastBy c) = text "CastBy" <+> ppr c addValArgTo :: ArgInfo -> OutExpr -> ArgInfo -addValArgTo ai arg = ai { ai_args = ValArg arg : ai_args ai - , ai_type = applyTypeToArg (ai_type ai) arg - , ai_rules = decRules (ai_rules ai) } +addValArgTo ai arg + | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs, ai_rules = rules, ai_type = ty } <- ai + -- Pop the top demand and and discounts off + , let arg_spec = ValArg { as_arg = arg + , as_dmd = dmd } + = ai { ai_args = arg_spec : ai_args ai + , ai_dmds = dmds + , ai_discs = discs + , ai_rules = decRules rules + , ai_type = applyTypeToArg ty arg + } + | otherwise + = pprPanic "addValArgTo" (ppr ai $$ ppr arg) + -- There should always be enough demands and discounts addTyArgTo :: ArgInfo -> OutType -> ArgInfo addTyArgTo ai arg_ty = ai { ai_args = arg_spec : ai_args ai @@ -299,10 +324,16 @@ addCastTo ai co = ai { ai_args = CastBy co : ai_args ai , ai_type = pSnd (coercionKind co) } +isStrictArgInfo :: ArgInfo -> Bool +-- True if the function is strict in the next argument +isStrictArgInfo (ArgInfo { ai_dmds = dmds }) + | dmd:_ <- dmds = isStrictDmd dmd + | otherwise = False + argInfoAppArgs :: [ArgSpec] -> [OutExpr] argInfoAppArgs [] = [] argInfoAppArgs (CastBy {} : _) = [] -- Stop at a cast -argInfoAppArgs (ValArg e : as) = e : argInfoAppArgs as +argInfoAppArgs (ValArg { as_arg = e } : as) = e : argInfoAppArgs as argInfoAppArgs (TyArg { as_arg_ty = ty } : as) = Type ty : argInfoAppArgs as pushSimplifiedArgs :: SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont @@ -311,7 +342,7 @@ = case arg of TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty } -> ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = rest } - ValArg e -> ApplyToVal { sc_arg = e, sc_env = env, sc_dup = Simplified, sc_cont = rest } + ValArg { as_arg = e } -> ApplyToVal { sc_arg = e, sc_env = env, sc_dup = Simplified, sc_cont = rest } CastBy c -> CastIt c rest where rest = pushSimplifiedArgs env args k @@ -324,7 +355,7 @@ = go rev_args where go [] = Var fun - go (ValArg a : as) = go as `App` a + go (ValArg { as_arg = a } : as) = go as `App` a go (TyArg { as_arg_ty = ty } : as) = go as `App` Type ty go (CastBy co : as) = mkCast (go as) co @@ -434,8 +465,8 @@ | otherwise = go [] cont where lone (ApplyToTy {}) = False -- See Note [Lone variables] in CoreUnfold - lone (ApplyToVal {}) = False - lone (CastIt {}) = False + lone (ApplyToVal {}) = False -- NB: even a type application or cast + lone (CastIt {}) = False -- stops it being "lone" lone _ = True go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k }) @@ -462,17 +493,18 @@ = ArgInfo { ai_fun = fun, ai_args = [], ai_type = fun_ty , ai_rules = fun_rules , ai_encl = False - , ai_strs = vanilla_stricts + , ai_dmds = vanilla_dmds , ai_discs = vanilla_discounts } | otherwise - = ArgInfo { ai_fun = fun, ai_args = [], ai_type = fun_ty + = ArgInfo { ai_fun = fun + , ai_args = [] + , ai_type = fun_ty , ai_rules = fun_rules , ai_encl = interestingArgContext rules call_cont - , ai_strs = arg_stricts + , ai_dmds = add_type_strictness fun_ty arg_dmds , ai_discs = arg_discounts } where fun_ty = idType fun - fun_rules = mkFunRules rules vanilla_discounts, arg_discounts :: [Int] @@ -482,14 +514,14 @@ -> discounts ++ vanilla_discounts _ -> vanilla_discounts - vanilla_stricts, arg_stricts :: [Bool] - vanilla_stricts = repeat False + vanilla_dmds, arg_dmds :: [Demand] + vanilla_dmds = repeat topDmd - arg_stricts + arg_dmds | not (sm_inline (seMode env)) - = vanilla_stricts -- See Note [Do not expose strictness if sm_inline=False] + = vanilla_dmds -- See Note [Do not expose strictness if sm_inline=False] | otherwise - = add_type_str fun_ty $ + = -- add_type_str fun_ty $ case splitStrictSig (idStrictness fun) of (demands, result_info) | not (demands `lengthExceeds` n_val_args) @@ -499,38 +531,43 @@ -- interesting context. This avoids substituting -- top-level bindings for (say) strings into -- calls to error. But now we are more careful about - -- inlining lone variables, so its ok (see SimplUtils.analyseCont) + -- inlining lone variables, so its ok + -- (see GHC.Core.Op.Simplify.Utils.analyseCont) if isBotRes result_info then - map isStrictDmd demands -- Finite => result is bottom + demands -- Finite => result is bottom else - map isStrictDmd demands ++ vanilla_stricts + demands ++ vanilla_dmds | otherwise -> WARN( True, text "More demands than arity" <+> ppr fun <+> ppr (idArity fun) <+> ppr n_val_args <+> ppr demands ) - vanilla_stricts -- Not enough args, or no strictness + vanilla_dmds -- Not enough args, or no strictness - add_type_str :: Type -> [Bool] -> [Bool] + add_type_strictness :: Type -> [Demand] -> [Demand] -- If the function arg types are strict, record that in the 'strictness bits' -- No need to instantiate because unboxed types (which dominate the strict -- types) can't instantiate type variables. - -- add_type_str is done repeatedly (for each call); + -- add_type_strictness is done repeatedly (for each call); -- might be better once-for-all in the function -- But beware primops/datacons with no strictness - add_type_str _ [] = [] - add_type_str fun_ty all_strs@(str:strs) + add_type_strictness fun_ty dmds + | null dmds = [] + + | Just (_, fun_ty') <- splitForAllTy_maybe fun_ty + = add_type_strictness fun_ty' dmds -- Look through foralls + | Just (arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info - = (str || Just False == isLiftedType_maybe arg_ty) - : add_type_str fun_ty' strs + , dmd : rest_dmds <- dmds + , let dmd' = case isLiftedType_maybe arg_ty of + Just False -> strictenDmd dmd + _ -> dmd + = dmd' : add_type_strictness fun_ty' rest_dmds -- If the type is levity-polymorphic, we can't know whether it's -- strict. isLiftedType_maybe will return Just False only when -- we're sure the type is unlifted. - | Just (_, fun_ty') <- splitForAllTy_maybe fun_ty - = add_type_str fun_ty' all_strs -- Look through foralls - | otherwise - = all_strs + = dmds {- Note [Unsaturated functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -619,6 +656,26 @@ and it looks plausible to me. -} +lazyArgContext :: ArgInfo -> CallCtxt +-- Use this for lazy arguments +lazyArgContext (ArgInfo { ai_encl = encl_rules, ai_discs = discs }) + | encl_rules = RuleArgCtxt + | disc:_ <- discs, disc > 0 = DiscArgCtxt -- Be keener here + | otherwise = BoringCtxt -- Nothing interesting + +strictArgContext :: ArgInfo -> CallCtxt +strictArgContext (ArgInfo { ai_encl = encl_rules, ai_discs = discs }) +-- Use this for strict arguments + | encl_rules = RuleArgCtxt + | disc:_ <- discs, disc > 0 = DiscArgCtxt -- Be keener here + | otherwise = RhsCtxt + -- Why RhsCtxt? if we see f (g x) (h x), and f is strict, we + -- want to be a bit more eager to inline g, because it may + -- expose an eval (on x perhaps) that can be eliminated or + -- shared. I saw this in nofib 'boyer2', RewriteFuns.onewayunify1 + -- It's worth an 18% improvement in allocation for this + -- particular benchmark; 5% on 'mate' and 1.3% on 'multiplier' + interestingCallContext :: SimplEnv -> SimplCont -> CallCtxt -- See Note [Interesting call context] interestingCallContext env cont @@ -635,7 +692,7 @@ -- motivation to inline. See Note [Cast then apply] -- in CoreUnfold - interesting (StrictArg { sc_cci = cci }) = cci + interesting (StrictArg { sc_fun = fun }) = strictArgContext fun interesting (StrictBind {}) = BoringCtxt interesting (Stop _ cci) = cci interesting (TickIt _ k) = interesting k @@ -685,16 +742,13 @@ go (Select {}) = False go (ApplyToVal {}) = False -- Shouldn't really happen go (ApplyToTy {}) = False -- Ditto - go (StrictArg { sc_cci = cci }) = interesting cci + go (StrictArg { sc_fun = fun }) = ai_encl fun go (StrictBind {}) = False -- ?? go (CastIt _ c) = go c - go (Stop _ cci) = interesting cci + go (Stop _ RuleArgCtxt) = True + go (Stop _ _) = False go (TickIt _ c) = go c - interesting RuleArgCtxt = True - interesting _ = False - - {- Note [Interesting arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ An argument is interesting if it deserves a discount for unfoldings @@ -1173,7 +1227,7 @@ extend_subst_with inl_rhs = extendIdSubst env bndr (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) - one_occ (OneOcc { occ_one_br = True -- One textual occurrence + one_occ (OneOcc { occ_n_br = 1 -- One textual occurrence , occ_in_lam = in_lam , occ_int_cxt = int_cxt }) | not in_lam = isNotTopLevel top_lvl || early_phase @@ -1291,24 +1345,15 @@ | exprIsTrivial rhs = True | otherwise = case occ_info of - -- The point of examining occ_info here is that for *non-values* - -- that occur outside a lambda, the call-site inliner won't have - -- a chance (because it doesn't know that the thing - -- only occurs once). The pre-inliner won't have gotten - -- it either, if the thing occurs in more than one branch - -- So the main target is things like - -- let x = f y in - -- case v of - -- True -> case x of ... - -- False -> case x of ... - -- This is very important in practice; e.g. wheel-seive1 doubles - -- in allocation if you miss this out - OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt } - -- OneOcc => no code-duplication issue - -> smallEnoughToInline dflags unfolding -- Small enough to dup + OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br } + -- See Note [Inline small things to avoid creating a thunk] + + -> n_br < 100 -- See Note [Suppress exponential blowup] + + && smallEnoughToInline dflags unfolding -- Small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true -- - -- NB: Do NOT inline arbitrarily big things, even if one_br is True + -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1 -- Reason: doing so risks exponential behaviour. We simplify a big -- expression, inline it, and simplify it again. But if the -- very same thing happens in the big expression, we get @@ -1355,7 +1400,56 @@ active = isActive (sm_phase (getMode env)) (idInlineActivation bndr) -- See Note [pre/postInlineUnconditionally in gentle mode] -{- +{- Note [Inline small things to avoid creating a thunk] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The point of examining occ_info here is that for *non-values* that +occur outside a lambda, the call-site inliner won't have a chance +(because it doesn't know that the thing only occurs once). The +pre-inliner won't have gotten it either, if the thing occurs in more +than one branch So the main target is things like + + let x = f y in + case v of + True -> case x of ... + False -> case x of ... + +This is very important in practice; e.g. wheel-seive1 doubles +in allocation if you miss this out. And bits of GHC itself start +to allocate more. An egregious example is test perf/compiler/T14697, +where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more. + +Note [Suppress exponential blowup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #13253, and several related tickets, we got an exponential blowup +in code size from postInlineUnconditionally. The trouble comes when +we have + let j1a = case f y of { True -> p; False -> q } + j1b = case f y of { True -> q; False -> p } + j2a = case f (y+1) of { True -> j1a; False -> j1b } + j2b = case f (y+1) of { True -> j1b; False -> j1a } + ... + in case f (y+10) of { True -> j10a; False -> j10b } + +when there are many branches. In pass 1, postInlineUnconditionally +inlines j10a and j10b (they are both small). Now we have two calls +to j9a and two to j9b. In pass 2, postInlineUnconditionally inlines +all four of these calls, leaving four calls to j8a and j8b. Etc. +Yikes! This is exponential! + +A possible plan: stop doing postInlineUnconditionally +for some fixed, smallish number of branches, say 4. But that turned +out to be bad: see Note [Inline small things to avoid creating a thunk]. +And, as it happened, the problem with #13253 was solved in a +different way (Note [Duplicating StrictArg] in Simplify). + +So I just set an arbitrary, high limit of 100, to stop any +totally exponential behaviour. + +This still leaves the nasty possiblity that /ordinary/ inlining (not +postInlineUnconditionally) might inline these join points, each of +which is individually quiet small. I'm still not sure what to do +about this (e.g. see #15488). + Note [Top level and postInlineUnconditionally] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We don't do postInlineUnconditionally for top-level things (even for diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -6,6 +6,7 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Simplify ( simplTopBinds, simplExpr, simplRules ) where #include "GhclibHsVersions.h" @@ -34,14 +35,14 @@ , StrictnessMark (..) ) import CoreMonad ( Tick(..), SimplMode(..) ) import CoreSyn -import Demand ( StrictSig(..), dmdTypeDepth, isStrictDmd ) +import Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrictDmd ) import PprCore ( pprCoreExpr ) import CoreUnfold import CoreUtils import CoreOpt ( pushCoTyArg, pushCoValArg , joinPointBinding_maybe, joinPointBindings_maybe ) import Rules ( mkRuleInfo, lookupRule, getRules ) -import Demand ( mkClosedStrictSig, topDmd, botRes ) +import Demand ( mkClosedStrictSig, topDmd, seqDmd, botRes ) import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, RecFlag(..), Arity ) import MonadUtils ( mapAccumLM, liftIO ) @@ -463,7 +464,7 @@ = do { (is_exp, floats1, fun') <- go (n_val_args+1) fun ; case is_exp of False -> return (False, emptyLetFloats, App fun arg) - True -> do { (floats2, arg') <- makeTrivial mode top_lvl occ arg + True -> do { (floats2, arg') <- makeTrivial mode top_lvl topDmd occ arg ; return (True, floats1 `addLetFlts` floats2, App fun' arg') } } go n_val_args (Var fun) = return (is_exp, emptyLetFloats, Var fun) @@ -544,19 +545,20 @@ -} makeTrivialArg :: SimplMode -> ArgSpec -> SimplM (LetFloats, ArgSpec) -makeTrivialArg mode (ValArg e) - = do { (floats, e') <- makeTrivial mode NotTopLevel (fsLit "arg") e - ; return (floats, ValArg e') } +makeTrivialArg mode arg@(ValArg { as_arg = e, as_dmd = dmd }) + = do { (floats, e') <- makeTrivial mode NotTopLevel dmd (fsLit "arg") e + ; return (floats, arg { as_arg = e' }) } makeTrivialArg _ arg = return (emptyLetFloats, arg) -- CastBy, TyArg -makeTrivial :: SimplMode -> TopLevelFlag +makeTrivial :: SimplMode -> TopLevelFlag -> Demand -> FastString -- ^ A "friendly name" to build the new binder from -> OutExpr -- ^ This expression satisfies the let/app invariant -> SimplM (LetFloats, OutExpr) -- Binds the expression to a variable, if it's not trivial, returning the variable -makeTrivial mode top_lvl context expr - = makeTrivialWithInfo mode top_lvl context vanillaIdInfo expr +-- For the Demand argument, see Note [Keeping demand info in StrictArg Plan A] +makeTrivial mode top_lvl dmd occ_fs expr + = makeTrivialWithInfo mode top_lvl occ_fs (vanillaIdInfo `setDemandInfo` dmd) expr makeTrivialWithInfo :: SimplMode -> TopLevelFlag -> FastString -- ^ a "friendly name" to build the new binder from @@ -1467,7 +1469,7 @@ simplLam env' bndrs body cont } -- Deal with strict bindings - | isStrictId bndr -- Includes coercions + | isStrictId bndr -- Includes coercions, and unlifted types , sm_case_case (getMode env) = simplExprF (rhs_se `setInScopeFromE` env) rhs (StrictBind { sc_bndr = bndr, sc_bndrs = bndrs, sc_body = body @@ -1816,7 +1818,7 @@ -- - and rebuild ---------- Bottoming applications -------------- -rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_strs = [] }) cont +rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont -- When we run out of strictness args, it means -- that the call is definitely bottom; see SimplUtils.mkArgInfo -- Then we want to discard the entire strict continuation. E.g. @@ -1863,18 +1865,18 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont }) = rebuildCall env (addTyArgTo info arg_ty) cont -rebuildCall env info@(ArgInfo { ai_encl = encl_rules, ai_type = fun_ty - , ai_strs = str:strs, ai_discs = disc:discs }) +rebuildCall env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup_flag, sc_cont = cont }) | isSimplified dup_flag -- See Note [Avoid redundant simplification] - = rebuildCall env (addValArgTo info' arg) cont + = rebuildCall env (addValArgTo fun_info arg) cont - | str -- Strict argument + -- Strict argument + | isStrictArgInfo fun_info , sm_case_case (getMode env) = -- pprTrace "Strict Arg" (ppr arg $$ ppr (seIdSubst env) $$ ppr (seInScope env)) $ simplExprF (arg_se `setInScopeFromE` env) arg - (StrictArg { sc_fun = info', sc_cci = cci_strict + (StrictArg { sc_fun = fun_info , sc_dup = Simplified, sc_cont = cont }) -- Note [Shadowing] @@ -1884,28 +1886,13 @@ -- have to be very careful about bogus strictness through -- floating a demanded let. = do { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg - (mkLazyArgStop arg_ty cci_lazy) - ; rebuildCall env (addValArgTo info' arg') cont } + (mkLazyArgStop arg_ty (lazyArgContext fun_info)) + ; rebuildCall env (addValArgTo fun_info arg') cont } where - info' = info { ai_strs = strs, ai_discs = discs } + fun_ty = ai_type fun_info arg_ty = funArgTy fun_ty - -- Use this for lazy arguments - cci_lazy | encl_rules = RuleArgCtxt - | disc > 0 = DiscArgCtxt -- Be keener here - | otherwise = BoringCtxt -- Nothing interesting - -- ..and this for strict arguments - cci_strict | encl_rules = RuleArgCtxt - | disc > 0 = DiscArgCtxt - | otherwise = RhsCtxt - -- Why RhsCtxt? if we see f (g x) (h x), and f is strict, we - -- want to be a bit more eager to inline g, because it may - -- expose an eval (on x perhaps) that can be eliminated or - -- shared. I saw this in nofib 'boyer2', RewriteFuns.onewayunify1 - -- It's worth an 18% improvement in allocation for this - -- particular benchmark; 5% on 'mate' and 1.3% on 'multiplier' - ---------- No further useful info, revert to generic rebuild ------------ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont @@ -2100,7 +2087,8 @@ , as_hole_ty = res1_ty } , TyArg { as_arg_ty = rhs_ty , as_hole_ty = res2_ty } - , ValArg no_cast_scrut] + , ValArg { as_arg = no_cast_scrut + , as_dmd = seqDmd } ] rule_cont = ApplyToVal { sc_dup = NoDup, sc_arg = rhs , sc_env = in_env, sc_cont = cont } -- Lazily evaluated, so we don't do most of this @@ -3043,31 +3031,41 @@ is_bot_alt (_,_,rhs) = exprIsBottom rhs ------------------------- -mkDupableCont :: SimplEnv -> SimplCont +mkDupableCont :: SimplEnv + -> SimplCont -> SimplM ( SimplFloats -- Incoming SimplEnv augmented with -- extra let/join-floats and in-scope variables , SimplCont) -- dup_cont: duplicable continuation - mkDupableCont env cont + = mkDupableContWithDmds env (repeat topDmd) cont + +mkDupableContWithDmds + :: SimplEnv -> [Demand] -- Demands on arguments; always infinite + -> SimplCont -> SimplM ( SimplFloats, SimplCont) + +mkDupableContWithDmds env _ cont | contIsDupable cont = return (emptyFloats env, cont) -mkDupableCont _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn +mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn -mkDupableCont env (CastIt ty cont) - = do { (floats, cont') <- mkDupableCont env cont +mkDupableContWithDmds env dmds (CastIt ty cont) + = do { (floats, cont') <- mkDupableContWithDmds env dmds cont ; return (floats, CastIt ty cont') } -- Duplicating ticks for now, not sure if this is good or not -mkDupableCont env (TickIt t cont) - = do { (floats, cont') <- mkDupableCont env cont +mkDupableContWithDmds env dmds (TickIt t cont) + = do { (floats, cont') <- mkDupableContWithDmds env dmds cont ; return (floats, TickIt t cont') } -mkDupableCont env (StrictBind { sc_bndr = bndr, sc_bndrs = bndrs - , sc_body = body, sc_env = se, sc_cont = cont}) - -- See Note [Duplicating StrictBind] +mkDupableContWithDmds env _ + (StrictBind { sc_bndr = bndr, sc_bndrs = bndrs + , sc_body = body, sc_env = se, sc_cont = cont}) +-- See Note [Duplicating StrictBind] +-- K[ let x = <> in b ] --> join j x = K[ b ] +-- j <> = do { let sb_env = se `setInScopeFromE` env - ; (sb_env1, bndr') <- simplBinder sb_env bndr + ; (sb_env1, bndr') <- simplBinder sb_env bndr ; (floats1, join_inner) <- simplLam sb_env1 bndrs body cont -- No need to use mkDupableCont before simplLam; we -- use cont once here, and then share the result if necessary @@ -3075,52 +3073,64 @@ ; let join_body = wrapFloats floats1 join_inner res_ty = contResultType cont - ; (floats2, body2) - <- if exprIsDupable (seDynFlags env) join_body - then return (emptyFloats env, join_body) - else do { join_bndr <- newJoinId [bndr'] res_ty - ; let join_call = App (Var join_bndr) (Var bndr') - join_rhs = Lam (setOneShotLambda bndr') join_body - join_bind = NonRec join_bndr join_rhs - floats = emptyFloats env `extendFloats` join_bind - ; return (floats, join_call) } - ; return ( floats2 - , StrictBind { sc_bndr = bndr', sc_bndrs = [] - , sc_body = body2 - , sc_env = zapSubstEnv se `setInScopeFromF` floats2 - -- See Note [StaticEnv invariant] in SimplUtils - , sc_dup = OkToDup - , sc_cont = mkBoringStop res_ty } ) } + ; mkDupableStrictBind env bndr' join_body res_ty } -mkDupableCont env (StrictArg { sc_fun = info, sc_cci = cci, sc_cont = cont }) - -- See Note [Duplicating StrictArg] - -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - = do { (floats1, cont') <- mkDupableCont env cont +mkDupableContWithDmds env _ + (StrictArg { sc_fun = fun, sc_cont = cont }) + -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable + | thumbsUpPlanA cont + = -- Use Plan A of Note [Duplicating StrictArg] + do { let (_ : dmds) = ai_dmds fun + ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + -- Use the demands from the function to add the right + -- demand info on any bindings we make for further args ; (floats_s, args') <- mapAndUnzipM (makeTrivialArg (getMode env)) - (ai_args info) + (ai_args fun) ; return ( foldl' addLetFloats floats1 floats_s - , StrictArg { sc_fun = info { ai_args = args' } - , sc_cci = cci + , StrictArg { sc_fun = fun { ai_args = args' } , sc_cont = cont' , sc_dup = OkToDup} ) } -mkDupableCont env (ApplyToTy { sc_cont = cont - , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) - = do { (floats, cont') <- mkDupableCont env cont + | otherwise + = -- Use Plan B of Note [Duplicating StrictArg] + -- K[ f a b <> ] --> join j x = K[ f a b x ] + -- j <> + do { let fun_ty = ai_type fun + ; let arg_ty = funArgTy fun_ty + rhs_ty = contResultType cont + ; arg_bndr <- newId (fsLit "arg") arg_ty -- ToDo: check this linearity argument + ; let env' = env `addNewInScopeIds` [arg_bndr] + ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr)) cont + ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty } + where + thumbsUpPlanA (StrictArg {}) = False + thumbsUpPlanA (CastIt _ k) = thumbsUpPlanA k + thumbsUpPlanA (TickIt _ k) = thumbsUpPlanA k + thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k + thumbsUpPlanA (ApplyToTy { sc_cont = k }) = thumbsUpPlanA k + thumbsUpPlanA (Select {}) = True + thumbsUpPlanA (StrictBind {}) = True + thumbsUpPlanA (Stop {}) = True + +mkDupableContWithDmds env dmds + (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) + = do { (floats, cont') <- mkDupableContWithDmds env dmds cont ; return (floats, ApplyToTy { sc_cont = cont' , sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) } -mkDupableCont env (ApplyToVal { sc_arg = arg, sc_dup = dup - , sc_env = se, sc_cont = cont }) +mkDupableContWithDmds env dmds + (ApplyToVal { sc_arg = arg, sc_dup = dup + , sc_env = se, sc_cont = cont }) = -- e.g. [...hole...] (...arg...) -- ==> -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { (floats1, cont') <- mkDupableCont env cont + do { let (dmd:_) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg - ; (let_floats2, arg'') <- makeTrivial (getMode env) NotTopLevel (fsLit "karg") arg' + ; (let_floats2, arg'') <- makeTrivial (getMode env) NotTopLevel dmd (fsLit "karg") arg' ; let all_floats = floats1 `addLetFloats` let_floats2 ; return ( all_floats , ApplyToVal { sc_arg = arg'' @@ -3131,8 +3141,8 @@ -- See Note [StaticEnv invariant] in SimplUtils , sc_dup = OkToDup, sc_cont = cont' }) } -mkDupableCont env (Select { sc_bndr = case_bndr, sc_alts = alts - , sc_env = se, sc_cont = cont }) +mkDupableContWithDmds env _ + (Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont }) = -- e.g. (case [...hole...] of { pi -> ei }) -- ===> -- let ji = \xij -> ei @@ -3172,6 +3182,33 @@ -- See Note [StaticEnv invariant] in SimplUtils , sc_cont = mkBoringStop (contResultType cont) } ) } +mkDupableStrictBind :: SimplEnv -> OutId -> OutExpr -> OutType + -> SimplM (SimplFloats, SimplCont) +mkDupableStrictBind env arg_bndr join_rhs res_ty + | exprIsDupable (seDynFlags env) join_rhs + = return (emptyFloats env + , StrictBind { sc_bndr = arg_bndr, sc_bndrs = [] + , sc_body = join_rhs + , sc_env = zapSubstEnv env + -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils + , sc_dup = OkToDup + , sc_cont = mkBoringStop res_ty } ) + | otherwise + = do { join_bndr <- newJoinId [arg_bndr] res_ty + ; let arg_info = ArgInfo { ai_fun = join_bndr + , ai_type = idType join_bndr + , ai_rules = Nothing, ai_args = [] + , ai_encl = False, ai_dmds = repeat topDmd + , ai_discs = repeat 0 } + ; return ( addJoinFloats (emptyFloats env) $ + unitJoinFloat $ + NonRec join_bndr $ + Lam (setOneShotLambda arg_bndr) join_rhs + , StrictArg { sc_dup = OkToDup + , sc_fun = arg_info + , sc_cont = mkBoringStop res_ty + } ) } + mkDupableAlt :: DynFlags -> OutId -> JoinFloats -> OutAlt -> SimplM (JoinFloats, OutAlt) @@ -3345,58 +3382,103 @@ Note [Duplicating StrictArg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We make a StrictArg duplicable simply by making all its -stored-up arguments (in sc_fun) trivial, by let-binding -them. Thus: - f E [..hole..] - ==> let a = E - in f a [..hole..] -Now if the thing in the hole is a case expression (which is when -we'll call mkDupableCont), we'll push the function call into the -branches, which is what we want. Now RULES for f may fire, and -call-pattern specialisation. Here's an example from #3116 +Dealing with making a StrictArg continuation duplicable has turned out +to be one of the trickiest corners of the simplifier, giving rise +to several cases in which the simplier expanded the program's size +*exponentially*. They include + #13253 exponential inlining + #10421 ditto + #18140 strict constructors + #18282 another nested-function call case + +Suppose we have a call + f e1 (case x of { True -> r1; False -> r2 }) e3 +and f is strict in its second argument. Then we end up in +mkDupableCont with a StrictArg continuation for (f e1 <> e3). +There are two ways to make it duplicable. + +* Plan A: move the entire call inwards, being careful not + to duplicate e1 or e3, thus: + let a1 = e1 + a3 = e3 + in case x of { True -> f a1 r1 a3 + ; False -> f a1 r2 a3 } + +* Plan B: make a join point: + join $j x = f e1 x e3 + in case x of { True -> jump $j r1 + ; False -> jump $j r2 } + Notice that Plan B is very like the way we handle strict + bindings; see Note [Duplicating StrictBind]. + +Plan A is good. Here's an example from #3116 go (n+1) (case l of 1 -> bs' _ -> Chunk p fpc (o+1) (l-1) bs') -If we can push the call for 'go' inside the case, we get + +If we pushed the entire call for 'go' inside the case, we get call-pattern specialisation for 'go', which is *crucial* for -this program. +this particular program. -Here is the (&&) example: +Here is another example. && E (case x of { T -> F; F -> T }) - ==> let a = E in - case x of { T -> && a F; F -> && a T } -Much better! -Notice that - * Arguments to f *after* the strict one are handled by - the ApplyToVal case of mkDupableCont. Eg - f [..hole..] E +Pushing the call inward (being careful not to duplicate E) + let a = E + in case x of { T -> && a F; F -> && a T } - * We can only do the let-binding of E because the function - part of a StrictArg continuation is an explicit syntax - tree. In earlier versions we represented it as a function - (CoreExpr -> CoreEpxr) which we couldn't take apart. +and now the (&& a F) etc can optimise. Moreover there might +be a RULE for the function that can fire when it "sees" the +particular case alterantive. -Historical aide: previously we did this (where E is a -big argument: - f E [..hole..] - ==> let $j = \a -> f E a - in $j [..hole..] +But Plan A can have terrible, terrible behaviour. Here is a classic +case: + f (f (f (f (f True)))) -But this is terrible! Here's an example: - && E (case x of { T -> F; F -> T }) -Now, && is strict so we end up simplifying the case with -an ArgOf continuation. If we let-bind it, we get - let $j = \v -> && E v - in simplExpr (case x of { T -> F; F -> T }) - (ArgOf (\r -> $j r) -And after simplifying more we get - let $j = \v -> && E v - in case x of { T -> $j F; F -> $j T } -Which is a Very Bad Thing +Suppose f is strict, and has a body that is small enough to inline. +The innermost call inlines (seeing the True) to give + f (f (f (f (case v of { True -> e1; False -> e2 })))) +Now, suppose we naively push the entire continuation into both +case branches (it doesn't look large, just f.f.f.f). We get + case v of + True -> f (f (f (f e1))) + False -> f (f (f (f e2))) +And now the process repeats, so we end up with an exponentially large +number of copies of f. No good! + +CONCLUSION: we want Plan A in general, but do Plan B is there a +danger of this nested call behaviour. The function that decides +this is called thumbsUpPlanA. + +Note [Keeping demand info in StrictArg Plan A] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Following on from Note [Duplicating StrictArg], another common code +pattern that can go bad is this: + f (case x1 of { T -> F; F -> T }) + (case x2 of { T -> F; F -> T }) + ...etc... +when f is strict in all its arguments. (It might, for example, be a +strict data constructor whose wrapper has not yet been inlined.) + +We use Plan A (because there is no nesting) giving + let a2 = case x2 of ... + a3 = case x3 of ... + in case x1 of { T -> f F a2 a3 ... ; F -> f T a2 a3 ... } + +Now we must be careful! a2 and a3 are small, and the OneOcc code in +postInlineUnconditionally may inline them both at both sites; see Note +Note [Inline small things to avoid creating a thunk] in +Simplify.Utils. But if we do inline them, the entire process will +repeat -- back to exponential behaviour. + +So we are careful to keep the demand-info on a2 and a3. Then they'll +be /strict/ let-bindings, which will be dealt with by StrictBind. +That's why contIsDupableWithDmds is careful to propagage demand +info to the auxiliary bindings it creates. See the Demand argument +to makeTrivial. + Note [Duplicating StrictBind] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We make a StrictBind duplicable in a very similar way to @@ -3404,9 +3486,10 @@ let x* = e in b is similar to case e of x -> b So we potentially make a join-point for the body, thus: - let x = [] in b ==> join j x = b - in let x = [] in j x + let x = <> in b ==> join j x = b + in j <> +Just like StrictArg in fact -- and indeed they share code. Note [Join point abstraction] Historical note ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/simplStg/UnariseStg.hs b/compiler/simplStg/UnariseStg.hs --- a/compiler/simplStg/UnariseStg.hs +++ b/compiler/simplStg/UnariseStg.hs @@ -124,6 +124,44 @@ (# 2#, rubbish, 2#, 3# #). + +Note [Don't merge lifted and unlifted slots] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When merging slots, one might be tempted to collapse lifted and unlifted +pointers. However, as seen in #19645, this is wrong. Imagine that you have +the program: + + test :: (# Char | ByteArray# #) -> ByteArray# + test (# c | #) = doSomething c + test (# | ba #) = ba + +Collapsing the Char and ByteArray# slots would produce STG like: + + test :: forall {t}. (# t | GHC.Prim.ByteArray# #) -> GHC.Prim.ByteArray# + = {} \r [ (tag :: Int#) (slot0 :: (Any :: Type)) ] + case tag of tag' + 1# -> doSomething slot0 + 2# -> slot0; + +Note how `slot0` has a lifted type, despite being bound to an unlifted +ByteArray# in the 2# alternative. This liftedness would cause the code generator to +attempt to enter it upon returning. As unlifted objects do not have entry code, +this causes a runtime crash. + +For this reason, Unarise treats unlifted and lifted things as distinct slot +types, despite both being GC pointers. This approach is a slight pessimisation +(since we need to pass more arguments) but appears to be the simplest way to +avoid #19645. Other alternatives considered include: + + a. Giving unlifted objects "trivial" entry code. However, we ultimately + concluded that the value of the "unlifted things are never entered" invariant + outweighed the simplicity of this approach. + + b. Annotating occurrences with calling convention information instead of + relying on the binder's type. This seemed like a very complicated + way to fix what is ultimately a corner-case. + + Note [Types in StgConApp] ~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have this unboxed sum term: @@ -578,7 +616,8 @@ = slotRubbishArg slot : mkTupArgs (arg_idx + 1) slots_left arg_map slotRubbishArg :: SlotTy -> StgArg - slotRubbishArg PtrSlot = StgVarArg aBSENT_SUM_FIELD_ERROR_ID + slotRubbishArg PtrLiftedSlot = StgVarArg aBSENT_SUM_FIELD_ERROR_ID + slotRubbishArg PtrUnliftedSlot = StgVarArg aBSENT_SUM_FIELD_ERROR_ID -- See Note [aBSENT_SUM_FIELD_ERROR_ID] in MkCore slotRubbishArg WordSlot = StgLitArg (LitNumber LitNumWord 0 wordPrimTy) slotRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0 word64PrimTy) diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -587,19 +587,11 @@ -- Specialise the bindings of this module ; (binds', uds) <- runSpecM dflags this_mod (go binds) - -- Specialise imported functions - ; hpt_rules <- getRuleBase - ; let rule_base = extendRuleBaseList hpt_rules local_rules - ; (new_rules, spec_binds) <- specImports dflags this_mod top_env emptyVarSet - [] rule_base uds - - ; let final_binds - | null spec_binds = binds' - | otherwise = Rec (flattenBinds spec_binds) : binds' - -- Note [Glom the bindings if imported functions are specialised] + ; (spec_rules, spec_binds) <- specImports dflags this_mod top_env + local_rules uds - ; return (guts { mg_binds = final_binds - , mg_rules = new_rules ++ local_rules }) } + ; return (guts { mg_binds = spec_binds ++ binds' + , mg_rules = spec_rules ++ local_rules }) } where -- We need to start with a Subst that knows all the things -- that are in scope, so that the substitution engine doesn't @@ -643,72 +635,93 @@ * * ********************************************************************* -} --- | Specialise a set of calls to imported bindings -specImports :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope - -> VarSet -- Don't specialise these ones - -- See Note [Avoiding recursive specialisation] - -> [Id] -- Stack of imported functions being specialised - -> RuleBase -- Rules from this module and the home package - -- (but not external packages, which can change) - -> UsageDetails -- Calls for imported things, and floating bindings - -> CoreM ( [CoreRule] -- New rules - , [CoreBind] ) -- Specialised bindings - -- See Note [Wrapping bindings returned by specImports] -specImports dflags this_mod top_env done callers rule_base +specImports :: DynFlags -> Module -> SpecEnv + -> [CoreRule] + -> UsageDetails + -> CoreM ([CoreRule], [CoreBind]) +specImports dflags this_mod top_env local_rules (MkUD { ud_binds = dict_binds, ud_calls = calls }) - -- See Note [Disabling cross-module specialisation] | not $ gopt Opt_CrossModuleSpecialise dflags - = return ([], []) + -- See Note [Disabling cross-module specialisation] + = return ([], wrapDictBinds dict_binds []) | otherwise - = do { let import_calls = dVarEnvElts calls - ; (rules, spec_binds) <- go rule_base import_calls + = do { hpt_rules <- getRuleBase + ; let rule_base = extendRuleBaseList hpt_rules local_rules + ; (spec_rules, spec_binds) <- spec_imports dflags this_mod top_env + [] rule_base + dict_binds calls + -- Don't forget to wrap the specialized bindings with -- bindings for the needed dictionaries. -- See Note [Wrap bindings returned by specImports] - ; let spec_binds' = wrapDictBinds dict_binds spec_binds + -- and Note [Glom the bindings if imported functions are specialised] + ; let final_binds + | null spec_binds = wrapDictBinds dict_binds [] + | otherwise = [Rec $ flattenBinds $ + wrapDictBinds dict_binds spec_binds] - ; return (rules, spec_binds') } + ; return (spec_rules, final_binds) + } + +-- | Specialise a set of calls to imported bindings +spec_imports :: DynFlags + -> Module + -> SpecEnv -- Passed in so that all top-level Ids are in scope + -> [Id] -- Stack of imported functions being specialised + -- See Note [specImport call stack] + -> RuleBase -- Rules from this module and the home package + -- (but not external packages, which can change) + -> Bag DictBind -- Dict bindings, used /only/ for filterCalls + -- See Note [Avoiding loops in specImports] + -> CallDetails -- Calls for imported things + -> CoreM ( [CoreRule] -- New rules + , [CoreBind] ) -- Specialised bindings +spec_imports dflags this_mod top_env + callers rule_base dict_binds calls + = do { let import_calls = dVarEnvElts calls + -- ; debugTraceMsg (text "specImports {" <+> + -- vcat [ text "calls:" <+> ppr import_calls + -- , text "dict_binds:" <+> ppr dict_binds ]) + ; (rules, spec_binds) <- go rule_base import_calls + -- ; debugTraceMsg (text "End specImports }" <+> ppr import_calls) + + ; return (rules, spec_binds) } where go :: RuleBase -> [CallInfoSet] -> CoreM ([CoreRule], [CoreBind]) go _ [] = return ([], []) - go rb (cis@(CIS fn _) : other_calls) - = do { let ok_calls = filterCalls cis dict_binds - -- Drop calls that (directly or indirectly) refer to fn - -- See Note [Avoiding loops] --- ; debugTraceMsg (text "specImport" <+> vcat [ ppr fn --- , text "calls" <+> ppr cis --- , text "ud_binds =" <+> ppr dict_binds --- , text "dump set =" <+> ppr dump_set --- , text "filtered calls =" <+> ppr ok_calls ]) - ; (rules1, spec_binds1) <- specImport dflags this_mod top_env - done callers rb fn ok_calls + go rb (cis : other_calls) + = do { -- debugTraceMsg (text "specImport {" <+> ppr cis) + ; (rules1, spec_binds1) <- spec_import dflags this_mod top_env + callers rb dict_binds cis + -- ; debugTraceMsg (text "specImport }" <+> ppr cis) ; (rules2, spec_binds2) <- go (extendRuleBaseList rb rules1) other_calls ; return (rules1 ++ rules2, spec_binds1 ++ spec_binds2) } -specImport :: DynFlags - -> Module - -> SpecEnv -- Passed in so that all top-level Ids are in scope - -> VarSet -- Don't specialise these - -- See Note [Avoiding recursive specialisation] - -> [Id] -- Stack of imported functions being specialised - -> RuleBase -- Rules from this module - -> Id -> [CallInfo] -- Imported function and calls for it - -> CoreM ( [CoreRule] -- New rules - , [CoreBind] ) -- Specialised bindings -specImport dflags this_mod top_env done callers rb fn calls_for_fn - | fn `elemVarSet` done +spec_import :: DynFlags + -> Module + -> SpecEnv -- Passed in so that all top-level Ids are in scope + -> [Id] -- Stack of imported functions being specialised + -- See Note [specImport call stack] + -> RuleBase -- Rules from this module + -> Bag DictBind -- Dict bindings, used /only/ for filterCalls + -- See Note [Avoiding loops in specImports] + -> CallInfoSet -- Imported function and calls for it + -> CoreM ( [CoreRule] -- New rules + , [CoreBind] ) -- Specialised bindings +spec_import dflags this_mod top_env callers + rb dict_binds cis@(CIS fn _) + | isIn "specImport" fn callers = return ([], []) -- No warning. This actually happens all the time -- when specialising a recursive function, because -- the RHS of the specialised function contains a recursive -- call to the original function - | null calls_for_fn -- We filtered out all the calls in deleteCallsMentioning - = return ([], []) + | null good_calls + = do { -- debugTraceMsg (text "specImport:no valid calls") + ; return ([], []) } | wantSpecImport dflags unfolding , Just rhs <- maybeUnfoldingTemplate unfolding @@ -721,32 +734,37 @@ ; let full_rb = unionRuleBase rb (eps_rule_base eps) rules_for_fn = getRules (RuleEnv full_rb vis_orphs) fn - ; (rules1, spec_pairs, uds) - <- -- pprTrace "specImport1" (vcat [ppr fn, ppr calls_for_fn, ppr rhs]) $ - runSpecM dflags this_mod $ - specCalls (Just this_mod) top_env rules_for_fn calls_for_fn fn rhs + ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls }) + <- do { -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs]) + ; runSpecM dflags this_mod $ + specCalls (Just this_mod) top_env rules_for_fn good_calls fn rhs } ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs] -- After the rules kick in we may get recursion, but -- we rely on a global GlomBinds to sort that out later -- See Note [Glom the bindings if imported functions are specialised] -- Now specialise any cascaded calls - ; (rules2, spec_binds2) <- -- pprTrace "specImport 2" (ppr fn $$ ppr rules1 $$ ppr spec_binds1) $ - specImports dflags this_mod top_env - (extendVarSet done fn) - (fn:callers) - (extendRuleBaseList rb rules1) - uds + -- ; debugTraceMsg (text "specImport 2" <+> (ppr fn $$ ppr rules1 $$ ppr spec_binds1)) + ; (rules2, spec_binds2) <- spec_imports dflags this_mod top_env + (fn:callers) + (extendRuleBaseList rb rules1) + (dict_binds `unionBags` dict_binds1) + new_calls - ; let final_binds = spec_binds2 ++ spec_binds1 + ; let final_binds = wrapDictBinds dict_binds1 $ + spec_binds2 ++ spec_binds1 ; return (rules2 ++ rules1, final_binds) } - | otherwise = do { tryWarnMissingSpecs dflags callers fn calls_for_fn - ; return ([], [])} + | otherwise + = do { tryWarnMissingSpecs dflags callers fn good_calls + ; return ([], [])} where unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers + good_calls = filterCalls cis dict_binds + -- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn + -- See Note [Avoiding loops in specImports] -- | Returns whether or not to show a missed-spec warning. -- If -Wall-missed-specializations is on, show the warning. @@ -788,8 +806,114 @@ -- inside it that we want to specialise | otherwise -> False -- Stable, not INLINE, hence INLINABLE -{- Note [Warning about missed specialisations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Avoiding loops in specImports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must take great care when specialising instance declarations +(functions like $fOrdList) lest we accidentally build a recursive +dictionary. See Note [Avoiding loops]. + +The basic strategy of Note [Avoiding loops] is to use filterCalls +to discard loopy specialisations. But to do that we must ensure +that the in-scope dict-binds (passed to filterCalls) contains +all the needed dictionary bindings. In particular, in the recursive +call to spec_imorpts in spec_import, we must include the dict-binds +from the parent. Lacking this caused #17151, a really nasty bug. + +Here is what happened. +* Class struture: + Source is a superclass of Mut + Index is a superclass of Source + +* We started with these dict binds + dSource = $fSourcePix @Int $fIndexInt + dIndex = sc_sel dSource + dMut = $fMutPix @Int dIndex + and these calls to specialise + $fMutPix @Int dIndex + $fSourcePix @Int $fIndexInt + +* We specialised the call ($fMutPix @Int dIndex) + ==> new call ($fSourcePix @Int dIndex) + (because Source is a superclass of Mut) + +* We specialised ($fSourcePix @Int dIndex) + ==> produces specialised dict $s$fSourcePix, + a record with dIndex as a field + plus RULE forall d. ($fSourcePix @Int d) = $s$fSourcePix + *** This is the bogus step *** + +* Now we decide not to specialise the call + $fSourcePix @Int $fIndexInt + because we alredy have a RULE that matches it + +* Finally the simplifer rewrites + dSource = $fSourcePix @Int $fIndexInt + ==> dSource = $s$fSourcePix + +Disaster. Now we have + +Rewrite dSource's RHS to $s$fSourcePix Disaster + dSource = $s$fSourcePix + dIndex = sc_sel dSource + $s$fSourcePix = MkSource dIndex ... + +Solution: filterCalls should have stopped the bogus step, +by seeing that dIndex transitively uses $fSourcePix. But +it can only do that if it sees all the dict_binds. Wow. + +-------------- +Here's another example (#13429). Suppose we have + class Monoid v => C v a where ... + +We start with a call + f @ [Integer] @ Integer $fC[]Integer + +Specialising call to 'f' gives dict bindings + $dMonoid_1 :: Monoid [Integer] + $dMonoid_1 = M.$p1C @ [Integer] $fC[]Integer + + $dC_1 :: C [Integer] (Node [Integer] Integer) + $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 + +...plus a recursive call to + f @ [Integer] @ (Node [Integer] Integer) $dC_1 + +Specialising that call gives + $dMonoid_2 :: Monoid [Integer] + $dMonoid_2 = M.$p1C @ [Integer] $dC_1 + + $dC_2 :: C [Integer] (Node [Integer] Integer) + $dC_2 = M.$fCvNode @ [Integer] $dMonoid_2 + +Now we have two calls to the imported function + M.$fCvNode :: Monoid v => C v a + M.$fCvNode @v @a m = C m some_fun + +But we must /not/ use the call (M.$fCvNode @ [Integer] $dMonoid_2) +for specialisation, else we get: + + $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 + $dMonoid_2 = M.$p1C @ [Integer] $dC_1 + $s$fCvNode = C $dMonoid_2 ... + RULE M.$fCvNode [Integer] _ _ = $s$fCvNode + +Now use the rule to rewrite the call in the RHS of $dC_1 +and we get a loop! + + +Note [specImport call stack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When specialising an imports function 'f', we may get new calls +of an imported fuction 'g', which we want to specialise in turn, +and similarly specialising 'g' might expose a new call to 'h'. + +We track the stack of enclosing functions. So when specialising 'h' we +haev a specImport call stack of [g,f]. We do this for two reasons: +* Note [Warning about missed specialisations] +* Note [Avoiding recursive specialisation] + +Note [Warning about missed specialisations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose * In module Lib, you carefully mark a function 'foo' INLINABLE * Import Lib(foo) into another module M @@ -805,6 +929,16 @@ ToDo: warn about missed opportunities for local functions. +Note [Avoiding recursive specialisation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we specialise 'f' we may find new overloaded calls to 'g', 'h' in +'f's RHS. So we want to specialise g,h. But we don't want to +specialise f any more! It's possible that f's RHS might have a +recursive yet-more-specialised call, so we'd diverge in that case. +And if the call is to the same type, one specialisation is enough. +Avoiding this recursive specialisation loop is one reason for the +'callers' stack passed to specImports and specImport. + Note [Specialise imported INLINABLE things] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ What imported functions do we specialise? The basic set is @@ -840,15 +974,6 @@ the specialisations for imported bindings recursive. -Note [Avoiding recursive specialisation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we specialise 'f' we may find new overloaded calls to 'g', 'h' in -'f's RHS. So we want to specialise g,h. But we don't want to -specialise f any more! It's possible that f's RHS might have a -recursive yet-more-specialised call, so we'd diverge in that case. -And if the call is to the same type, one specialisation is enough. -Avoiding this recursive specialisation loop is the reason for the -'done' VarSet passed to specImports and specImport. ************************************************************************ * * @@ -1660,13 +1785,11 @@ None of these definitions is recursive. What happened was that we generated a specialisation: - RULE forall d. dfun T d = dT :: C [T] dT = (MkD a d (meth d)) [T/a, d1/d] = MkD T d1 (meth d1) But now we use the RULE on the RHS of d2, to get - d2 = dT = MkD d1 (meth d1) d1 = $p1 d2 @@ -1682,46 +1805,6 @@ Discard all calls that mention dictionaries that depend (directly or indirectly) on the dfun we are specialising. This is done by 'filterCalls' - --------------- -Here's another example, this time for an imported dfun, so the call -to filterCalls is in specImports (#13429). Suppose we have - class Monoid v => C v a where ... - -We start with a call - f @ [Integer] @ Integer $fC[]Integer - -Specialising call to 'f' gives dict bindings - $dMonoid_1 :: Monoid [Integer] - $dMonoid_1 = M.$p1C @ [Integer] $fC[]Integer - - $dC_1 :: C [Integer] (Node [Integer] Integer) - $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 - -...plus a recursive call to - f @ [Integer] @ (Node [Integer] Integer) $dC_1 - -Specialising that call gives - $dMonoid_2 :: Monoid [Integer] - $dMonoid_2 = M.$p1C @ [Integer] $dC_1 - - $dC_2 :: C [Integer] (Node [Integer] Integer) - $dC_2 = M.$fCvNode @ [Integer] $dMonoid_2 - -Now we have two calls to the imported function - M.$fCvNode :: Monoid v => C v a - M.$fCvNode @v @a m = C m some_fun - -But we must /not/ use the call (M.$fCvNode @ [Integer] $dMonoid_2) -for specialisation, else we get: - - $dC_1 = M.$fCvNode @ [Integer] $dMonoid_1 - $dMonoid_2 = M.$p1C @ [Integer] $dC_1 - $s$fCvNode = C $dMonoid_2 ... - RULE M.$fCvNode [Integer] _ _ = $s$fCvNode - -Now use the rule to rewrite the call in the RHS of $dC_1 -and we get a loop! -------------- Here's yet another example diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -561,7 +561,7 @@ -- A call to some primitive Cmm function. FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) - PrimCallConv _)) + PrimCallConv _ _ _)) -> ASSERT( saturated ) StgOpApp (StgPrimCallOp (PrimCall lbl pkgId)) args' res_ty diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -296,13 +296,17 @@ -- Do this /after/ typeinference, so that when reporting -- a function with no type signature we can give the -- inferred type - reportUnusedNames tcg_env + reportUnusedNames tcg_env hsc_src ; -- add extra source files to tcg_dependent_files addDependentFiles src_files - ; tcg_env <- runTypecheckerPlugin mod_sum hsc_env tcg_env - ; -- Dump output and return - tcDump tcg_env - ; return tcg_env } + -- Ensure plugins run with the same tcg_env that we pass in + ; setGblEnv tcg_env + $ do { tcg_env <- runTypecheckerPlugin mod_sum hsc_env tcg_env + ; -- Dump output and return + tcDump tcg_env + ; return tcg_env + } + } } } } diff --git a/ghc-lib.cabal b/ghc-lib.cabal --- a/ghc-lib.cabal +++ b/ghc-lib.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib -version: 8.10.4.20210206 +version: 8.10.5.20210606 license: BSD3 license-file: LICENSE category: Development @@ -20,8 +20,7 @@ extra-source-files: ghc-lib/stage0/lib/ghcautoconf.h ghc-lib/stage0/lib/ghcplatform.h - ghc-lib/stage0/lib/ghcversion.h - ghc-lib/stage0/lib/DerivedConstants.h + ghc-lib/stage0/lib/GhclibDerivedConstants.h ghc-lib/stage0/lib/GHCConstantsHaskellExports.hs ghc-lib/stage0/lib/GHCConstantsHaskellWrappers.hs ghc-lib/stage0/lib/GHCConstantsHaskellType.hs @@ -44,8 +43,8 @@ includes/MachDeps.h includes/stg/MachRegs.h includes/CodeGen.Platform.hs - compiler/GhclibHsVersions.h compiler/Unique.h + compiler/GhclibHsVersions.h source-repository head type: git location: git@github.com:digital-asset/ghc-lib.git @@ -66,8 +65,9 @@ else build-depends: Win32 build-depends: - ghc-prim > 0.2 && < 0.7, - base >= 4.12 && < 4.15, + rts, + ghc-prim > 0.2 && < 0.8, + base >= 4.12 && < 4.16, containers >= 0.5 && < 0.7, bytestring >= 0.9 && < 0.11, binary == 0.8.*, @@ -80,7 +80,7 @@ transformers == 0.5.*, process >= 1 && < 1.7, hpc == 0.6.*, - ghc-lib-parser == 8.10.4.20210206 + ghc-lib-parser == 8.10.5.20210606 build-tools: alex >= 3.1, happy >= 1.19.4 other-extensions: BangPatterns @@ -427,8 +427,8 @@ GHC.HsToCore.PmCheck GHC.HsToCore.PmCheck.Oracle GHC.HsToCore.PmCheck.Ppr + GHC.Platform.AArch64 GHC.Platform.ARM - GHC.Platform.ARM64 GHC.Platform.Host GHC.Platform.NoRegs GHC.Platform.PPC diff --git a/ghc-lib/stage0/lib/DerivedConstants.h b/ghc-lib/stage0/lib/DerivedConstants.h deleted file mode 100644 --- a/ghc-lib/stage0/lib/DerivedConstants.h +++ /dev/null @@ -1,555 +0,0 @@ -/* This file is created automatically. Do not edit by hand.*/ - -#define CONTROL_GROUP_CONST_291 291 -#define STD_HDR_SIZE 1 -#define PROF_HDR_SIZE 2 -#define STACK_DIRTY 1 -#define BLOCK_SIZE 4096 -#define MBLOCK_SIZE 1048576 -#define BLOCKS_PER_MBLOCK 252 -#define TICKY_BIN_COUNT 9 -#define OFFSET_StgRegTable_rR1 0 -#define OFFSET_StgRegTable_rR2 8 -#define OFFSET_StgRegTable_rR3 16 -#define OFFSET_StgRegTable_rR4 24 -#define OFFSET_StgRegTable_rR5 32 -#define OFFSET_StgRegTable_rR6 40 -#define OFFSET_StgRegTable_rR7 48 -#define OFFSET_StgRegTable_rR8 56 -#define OFFSET_StgRegTable_rR9 64 -#define OFFSET_StgRegTable_rR10 72 -#define OFFSET_StgRegTable_rF1 80 -#define OFFSET_StgRegTable_rF2 84 -#define OFFSET_StgRegTable_rF3 88 -#define OFFSET_StgRegTable_rF4 92 -#define OFFSET_StgRegTable_rF5 96 -#define OFFSET_StgRegTable_rF6 100 -#define OFFSET_StgRegTable_rD1 104 -#define OFFSET_StgRegTable_rD2 112 -#define OFFSET_StgRegTable_rD3 120 -#define OFFSET_StgRegTable_rD4 128 -#define OFFSET_StgRegTable_rD5 136 -#define OFFSET_StgRegTable_rD6 144 -#define OFFSET_StgRegTable_rXMM1 152 -#define OFFSET_StgRegTable_rXMM2 168 -#define OFFSET_StgRegTable_rXMM3 184 -#define OFFSET_StgRegTable_rXMM4 200 -#define OFFSET_StgRegTable_rXMM5 216 -#define OFFSET_StgRegTable_rXMM6 232 -#define OFFSET_StgRegTable_rYMM1 248 -#define OFFSET_StgRegTable_rYMM2 280 -#define OFFSET_StgRegTable_rYMM3 312 -#define OFFSET_StgRegTable_rYMM4 344 -#define OFFSET_StgRegTable_rYMM5 376 -#define OFFSET_StgRegTable_rYMM6 408 -#define OFFSET_StgRegTable_rZMM1 440 -#define OFFSET_StgRegTable_rZMM2 504 -#define OFFSET_StgRegTable_rZMM3 568 -#define OFFSET_StgRegTable_rZMM4 632 -#define OFFSET_StgRegTable_rZMM5 696 -#define OFFSET_StgRegTable_rZMM6 760 -#define OFFSET_StgRegTable_rL1 824 -#define OFFSET_StgRegTable_rSp 832 -#define OFFSET_StgRegTable_rSpLim 840 -#define OFFSET_StgRegTable_rHp 848 -#define OFFSET_StgRegTable_rHpLim 856 -#define OFFSET_StgRegTable_rCCCS 864 -#define OFFSET_StgRegTable_rCurrentTSO 872 -#define OFFSET_StgRegTable_rCurrentNursery 888 -#define OFFSET_StgRegTable_rHpAlloc 904 -#define OFFSET_StgRegTable_rRet 912 -#define REP_StgRegTable_rRet b64 -#define StgRegTable_rRet(__ptr__) REP_StgRegTable_rRet[__ptr__+OFFSET_StgRegTable_rRet] -#define OFFSET_StgRegTable_rNursery 880 -#define REP_StgRegTable_rNursery b64 -#define StgRegTable_rNursery(__ptr__) REP_StgRegTable_rNursery[__ptr__+OFFSET_StgRegTable_rNursery] -#define OFFSET_stgEagerBlackholeInfo -24 -#define OFFSET_stgGCEnter1 -16 -#define OFFSET_stgGCFun -8 -#define OFFSET_Capability_r 24 -#define OFFSET_Capability_lock 1208 -#define OFFSET_Capability_no 944 -#define REP_Capability_no b32 -#define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no] -#define OFFSET_Capability_mut_lists 1016 -#define REP_Capability_mut_lists b64 -#define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists] -#define OFFSET_Capability_context_switch 1176 -#define REP_Capability_context_switch b32 -#define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch] -#define OFFSET_Capability_interrupt 1180 -#define REP_Capability_interrupt b32 -#define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt] -#define OFFSET_Capability_sparks 1312 -#define REP_Capability_sparks b64 -#define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks] -#define OFFSET_Capability_total_allocated 1184 -#define REP_Capability_total_allocated b64 -#define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated] -#define OFFSET_Capability_weak_ptr_list_hd 1160 -#define REP_Capability_weak_ptr_list_hd b64 -#define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd] -#define OFFSET_Capability_weak_ptr_list_tl 1168 -#define REP_Capability_weak_ptr_list_tl b64 -#define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl] -#define OFFSET_bdescr_start 0 -#define REP_bdescr_start b64 -#define bdescr_start(__ptr__) REP_bdescr_start[__ptr__+OFFSET_bdescr_start] -#define OFFSET_bdescr_free 8 -#define REP_bdescr_free b64 -#define bdescr_free(__ptr__) REP_bdescr_free[__ptr__+OFFSET_bdescr_free] -#define OFFSET_bdescr_blocks 48 -#define REP_bdescr_blocks b32 -#define bdescr_blocks(__ptr__) REP_bdescr_blocks[__ptr__+OFFSET_bdescr_blocks] -#define OFFSET_bdescr_gen_no 40 -#define REP_bdescr_gen_no b16 -#define bdescr_gen_no(__ptr__) REP_bdescr_gen_no[__ptr__+OFFSET_bdescr_gen_no] -#define OFFSET_bdescr_link 16 -#define REP_bdescr_link b64 -#define bdescr_link(__ptr__) REP_bdescr_link[__ptr__+OFFSET_bdescr_link] -#define OFFSET_bdescr_flags 46 -#define REP_bdescr_flags b16 -#define bdescr_flags(__ptr__) REP_bdescr_flags[__ptr__+OFFSET_bdescr_flags] -#define SIZEOF_generation 384 -#define OFFSET_generation_n_new_large_words 56 -#define REP_generation_n_new_large_words b64 -#define generation_n_new_large_words(__ptr__) REP_generation_n_new_large_words[__ptr__+OFFSET_generation_n_new_large_words] -#define OFFSET_generation_weak_ptr_list 112 -#define REP_generation_weak_ptr_list b64 -#define generation_weak_ptr_list(__ptr__) REP_generation_weak_ptr_list[__ptr__+OFFSET_generation_weak_ptr_list] -#define SIZEOF_CostCentreStack 96 -#define OFFSET_CostCentreStack_ccsID 0 -#define REP_CostCentreStack_ccsID b64 -#define CostCentreStack_ccsID(__ptr__) REP_CostCentreStack_ccsID[__ptr__+OFFSET_CostCentreStack_ccsID] -#define OFFSET_CostCentreStack_mem_alloc 72 -#define REP_CostCentreStack_mem_alloc b64 -#define CostCentreStack_mem_alloc(__ptr__) REP_CostCentreStack_mem_alloc[__ptr__+OFFSET_CostCentreStack_mem_alloc] -#define OFFSET_CostCentreStack_scc_count 48 -#define REP_CostCentreStack_scc_count b64 -#define CostCentreStack_scc_count(__ptr__) REP_CostCentreStack_scc_count[__ptr__+OFFSET_CostCentreStack_scc_count] -#define OFFSET_CostCentreStack_prevStack 16 -#define REP_CostCentreStack_prevStack b64 -#define CostCentreStack_prevStack(__ptr__) REP_CostCentreStack_prevStack[__ptr__+OFFSET_CostCentreStack_prevStack] -#define OFFSET_CostCentre_ccID 0 -#define REP_CostCentre_ccID b64 -#define CostCentre_ccID(__ptr__) REP_CostCentre_ccID[__ptr__+OFFSET_CostCentre_ccID] -#define OFFSET_CostCentre_link 56 -#define REP_CostCentre_link b64 -#define CostCentre_link(__ptr__) REP_CostCentre_link[__ptr__+OFFSET_CostCentre_link] -#define OFFSET_StgHeader_info 0 -#define REP_StgHeader_info b64 -#define StgHeader_info(__ptr__) REP_StgHeader_info[__ptr__+OFFSET_StgHeader_info] -#define OFFSET_StgHeader_ccs 8 -#define REP_StgHeader_ccs b64 -#define StgHeader_ccs(__ptr__) REP_StgHeader_ccs[__ptr__+OFFSET_StgHeader_ccs] -#define OFFSET_StgHeader_ldvw 16 -#define REP_StgHeader_ldvw b64 -#define StgHeader_ldvw(__ptr__) REP_StgHeader_ldvw[__ptr__+OFFSET_StgHeader_ldvw] -#define SIZEOF_StgSMPThunkHeader 8 -#define OFFSET_StgClosure_payload 0 -#define StgClosure_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgClosure_payload + WDS(__ix__)] -#define OFFSET_StgEntCounter_allocs 48 -#define REP_StgEntCounter_allocs b64 -#define StgEntCounter_allocs(__ptr__) REP_StgEntCounter_allocs[__ptr__+OFFSET_StgEntCounter_allocs] -#define OFFSET_StgEntCounter_allocd 16 -#define REP_StgEntCounter_allocd b64 -#define StgEntCounter_allocd(__ptr__) REP_StgEntCounter_allocd[__ptr__+OFFSET_StgEntCounter_allocd] -#define OFFSET_StgEntCounter_registeredp 0 -#define REP_StgEntCounter_registeredp b64 -#define StgEntCounter_registeredp(__ptr__) REP_StgEntCounter_registeredp[__ptr__+OFFSET_StgEntCounter_registeredp] -#define OFFSET_StgEntCounter_link 56 -#define REP_StgEntCounter_link b64 -#define StgEntCounter_link(__ptr__) REP_StgEntCounter_link[__ptr__+OFFSET_StgEntCounter_link] -#define OFFSET_StgEntCounter_entry_count 40 -#define REP_StgEntCounter_entry_count b64 -#define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count] -#define SIZEOF_StgUpdateFrame_NoHdr 8 -#define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8) -#define SIZEOF_StgCatchFrame_NoHdr 16 -#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16) -#define SIZEOF_StgStopFrame_NoHdr 0 -#define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0) -#define SIZEOF_StgMutArrPtrs_NoHdr 16 -#define SIZEOF_StgMutArrPtrs (SIZEOF_StgHeader+16) -#define OFFSET_StgMutArrPtrs_ptrs 0 -#define REP_StgMutArrPtrs_ptrs b64 -#define StgMutArrPtrs_ptrs(__ptr__) REP_StgMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_ptrs] -#define OFFSET_StgMutArrPtrs_size 8 -#define REP_StgMutArrPtrs_size b64 -#define StgMutArrPtrs_size(__ptr__) REP_StgMutArrPtrs_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_size] -#define SIZEOF_StgSmallMutArrPtrs_NoHdr 8 -#define SIZEOF_StgSmallMutArrPtrs (SIZEOF_StgHeader+8) -#define OFFSET_StgSmallMutArrPtrs_ptrs 0 -#define REP_StgSmallMutArrPtrs_ptrs b64 -#define StgSmallMutArrPtrs_ptrs(__ptr__) REP_StgSmallMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgSmallMutArrPtrs_ptrs] -#define SIZEOF_StgArrBytes_NoHdr 8 -#define SIZEOF_StgArrBytes (SIZEOF_StgHeader+8) -#define OFFSET_StgArrBytes_bytes 0 -#define REP_StgArrBytes_bytes b64 -#define StgArrBytes_bytes(__ptr__) REP_StgArrBytes_bytes[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_bytes] -#define OFFSET_StgArrBytes_payload 8 -#define StgArrBytes_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_payload + WDS(__ix__)] -#define OFFSET_StgTSO__link 0 -#define REP_StgTSO__link b64 -#define StgTSO__link(__ptr__) REP_StgTSO__link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO__link] -#define OFFSET_StgTSO_global_link 8 -#define REP_StgTSO_global_link b64 -#define StgTSO_global_link(__ptr__) REP_StgTSO_global_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_global_link] -#define OFFSET_StgTSO_what_next 24 -#define REP_StgTSO_what_next b16 -#define StgTSO_what_next(__ptr__) REP_StgTSO_what_next[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_what_next] -#define OFFSET_StgTSO_why_blocked 26 -#define REP_StgTSO_why_blocked b16 -#define StgTSO_why_blocked(__ptr__) REP_StgTSO_why_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_why_blocked] -#define OFFSET_StgTSO_block_info 32 -#define REP_StgTSO_block_info b64 -#define StgTSO_block_info(__ptr__) REP_StgTSO_block_info[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_block_info] -#define OFFSET_StgTSO_blocked_exceptions 80 -#define REP_StgTSO_blocked_exceptions b64 -#define StgTSO_blocked_exceptions(__ptr__) REP_StgTSO_blocked_exceptions[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_blocked_exceptions] -#define OFFSET_StgTSO_id 40 -#define REP_StgTSO_id b32 -#define StgTSO_id(__ptr__) REP_StgTSO_id[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_id] -#define OFFSET_StgTSO_cap 64 -#define REP_StgTSO_cap b64 -#define StgTSO_cap(__ptr__) REP_StgTSO_cap[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cap] -#define OFFSET_StgTSO_saved_errno 44 -#define REP_StgTSO_saved_errno b32 -#define StgTSO_saved_errno(__ptr__) REP_StgTSO_saved_errno[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_saved_errno] -#define OFFSET_StgTSO_trec 72 -#define REP_StgTSO_trec b64 -#define StgTSO_trec(__ptr__) REP_StgTSO_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_trec] -#define OFFSET_StgTSO_flags 28 -#define REP_StgTSO_flags b32 -#define StgTSO_flags(__ptr__) REP_StgTSO_flags[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_flags] -#define OFFSET_StgTSO_dirty 48 -#define REP_StgTSO_dirty b32 -#define StgTSO_dirty(__ptr__) REP_StgTSO_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_dirty] -#define OFFSET_StgTSO_bq 88 -#define REP_StgTSO_bq b64 -#define StgTSO_bq(__ptr__) REP_StgTSO_bq[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_bq] -#define OFFSET_StgTSO_alloc_limit 96 -#define REP_StgTSO_alloc_limit b64 -#define StgTSO_alloc_limit(__ptr__) REP_StgTSO_alloc_limit[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_alloc_limit] -#define OFFSET_StgTSO_cccs 112 -#define REP_StgTSO_cccs b64 -#define StgTSO_cccs(__ptr__) REP_StgTSO_cccs[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cccs] -#define OFFSET_StgTSO_stackobj 16 -#define REP_StgTSO_stackobj b64 -#define StgTSO_stackobj(__ptr__) REP_StgTSO_stackobj[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_stackobj] -#define OFFSET_StgStack_sp 8 -#define REP_StgStack_sp b64 -#define StgStack_sp(__ptr__) REP_StgStack_sp[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_sp] -#define OFFSET_StgStack_stack 16 -#define OFFSET_StgStack_stack_size 0 -#define REP_StgStack_stack_size b32 -#define StgStack_stack_size(__ptr__) REP_StgStack_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_stack_size] -#define OFFSET_StgStack_dirty 4 -#define REP_StgStack_dirty b8 -#define StgStack_dirty(__ptr__) REP_StgStack_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_dirty] -#define SIZEOF_StgTSOProfInfo 8 -#define OFFSET_StgUpdateFrame_updatee 0 -#define REP_StgUpdateFrame_updatee b64 -#define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee] -#define OFFSET_StgCatchFrame_handler 8 -#define REP_StgCatchFrame_handler b64 -#define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler] -#define OFFSET_StgCatchFrame_exceptions_blocked 0 -#define REP_StgCatchFrame_exceptions_blocked b64 -#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked] -#define SIZEOF_StgPAP_NoHdr 16 -#define SIZEOF_StgPAP (SIZEOF_StgHeader+16) -#define OFFSET_StgPAP_n_args 4 -#define REP_StgPAP_n_args b32 -#define StgPAP_n_args(__ptr__) REP_StgPAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_n_args] -#define OFFSET_StgPAP_fun 8 -#define REP_StgPAP_fun gcptr -#define StgPAP_fun(__ptr__) REP_StgPAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_fun] -#define OFFSET_StgPAP_arity 0 -#define REP_StgPAP_arity b32 -#define StgPAP_arity(__ptr__) REP_StgPAP_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_arity] -#define OFFSET_StgPAP_payload 16 -#define StgPAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_payload + WDS(__ix__)] -#define SIZEOF_StgAP_NoThunkHdr 16 -#define SIZEOF_StgAP_NoHdr 24 -#define SIZEOF_StgAP (SIZEOF_StgHeader+24) -#define OFFSET_StgAP_n_args 12 -#define REP_StgAP_n_args b32 -#define StgAP_n_args(__ptr__) REP_StgAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_n_args] -#define OFFSET_StgAP_fun 16 -#define REP_StgAP_fun gcptr -#define StgAP_fun(__ptr__) REP_StgAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_fun] -#define OFFSET_StgAP_payload 24 -#define StgAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_payload + WDS(__ix__)] -#define SIZEOF_StgAP_STACK_NoThunkHdr 16 -#define SIZEOF_StgAP_STACK_NoHdr 24 -#define SIZEOF_StgAP_STACK (SIZEOF_StgHeader+24) -#define OFFSET_StgAP_STACK_size 8 -#define REP_StgAP_STACK_size b64 -#define StgAP_STACK_size(__ptr__) REP_StgAP_STACK_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_size] -#define OFFSET_StgAP_STACK_fun 16 -#define REP_StgAP_STACK_fun gcptr -#define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun] -#define OFFSET_StgAP_STACK_payload 24 -#define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)] -#define SIZEOF_StgSelector_NoThunkHdr 8 -#define SIZEOF_StgSelector_NoHdr 16 -#define SIZEOF_StgSelector (SIZEOF_StgHeader+16) -#define OFFSET_StgInd_indirectee 0 -#define REP_StgInd_indirectee gcptr -#define StgInd_indirectee(__ptr__) REP_StgInd_indirectee[__ptr__+SIZEOF_StgHeader+OFFSET_StgInd_indirectee] -#define SIZEOF_StgMutVar_NoHdr 8 -#define SIZEOF_StgMutVar (SIZEOF_StgHeader+8) -#define OFFSET_StgMutVar_var 0 -#define REP_StgMutVar_var b64 -#define StgMutVar_var(__ptr__) REP_StgMutVar_var[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutVar_var] -#define SIZEOF_StgAtomicallyFrame_NoHdr 16 -#define SIZEOF_StgAtomicallyFrame (SIZEOF_StgHeader+16) -#define OFFSET_StgAtomicallyFrame_code 0 -#define REP_StgAtomicallyFrame_code b64 -#define StgAtomicallyFrame_code(__ptr__) REP_StgAtomicallyFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_code] -#define OFFSET_StgAtomicallyFrame_result 8 -#define REP_StgAtomicallyFrame_result b64 -#define StgAtomicallyFrame_result(__ptr__) REP_StgAtomicallyFrame_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_result] -#define OFFSET_StgTRecHeader_enclosing_trec 0 -#define REP_StgTRecHeader_enclosing_trec b64 -#define StgTRecHeader_enclosing_trec(__ptr__) REP_StgTRecHeader_enclosing_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTRecHeader_enclosing_trec] -#define SIZEOF_StgCatchSTMFrame_NoHdr 16 -#define SIZEOF_StgCatchSTMFrame (SIZEOF_StgHeader+16) -#define OFFSET_StgCatchSTMFrame_handler 8 -#define REP_StgCatchSTMFrame_handler b64 -#define StgCatchSTMFrame_handler(__ptr__) REP_StgCatchSTMFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_handler] -#define OFFSET_StgCatchSTMFrame_code 0 -#define REP_StgCatchSTMFrame_code b64 -#define StgCatchSTMFrame_code(__ptr__) REP_StgCatchSTMFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_code] -#define SIZEOF_StgCatchRetryFrame_NoHdr 24 -#define SIZEOF_StgCatchRetryFrame (SIZEOF_StgHeader+24) -#define OFFSET_StgCatchRetryFrame_running_alt_code 0 -#define REP_StgCatchRetryFrame_running_alt_code b64 -#define StgCatchRetryFrame_running_alt_code(__ptr__) REP_StgCatchRetryFrame_running_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_running_alt_code] -#define OFFSET_StgCatchRetryFrame_first_code 8 -#define REP_StgCatchRetryFrame_first_code b64 -#define StgCatchRetryFrame_first_code(__ptr__) REP_StgCatchRetryFrame_first_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_first_code] -#define OFFSET_StgCatchRetryFrame_alt_code 16 -#define REP_StgCatchRetryFrame_alt_code b64 -#define StgCatchRetryFrame_alt_code(__ptr__) REP_StgCatchRetryFrame_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_alt_code] -#define OFFSET_StgTVarWatchQueue_closure 0 -#define REP_StgTVarWatchQueue_closure b64 -#define StgTVarWatchQueue_closure(__ptr__) REP_StgTVarWatchQueue_closure[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_closure] -#define OFFSET_StgTVarWatchQueue_next_queue_entry 8 -#define REP_StgTVarWatchQueue_next_queue_entry b64 -#define StgTVarWatchQueue_next_queue_entry(__ptr__) REP_StgTVarWatchQueue_next_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_next_queue_entry] -#define OFFSET_StgTVarWatchQueue_prev_queue_entry 16 -#define REP_StgTVarWatchQueue_prev_queue_entry b64 -#define StgTVarWatchQueue_prev_queue_entry(__ptr__) REP_StgTVarWatchQueue_prev_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_prev_queue_entry] -#define SIZEOF_StgTVar_NoHdr 24 -#define SIZEOF_StgTVar (SIZEOF_StgHeader+24) -#define OFFSET_StgTVar_current_value 0 -#define REP_StgTVar_current_value b64 -#define StgTVar_current_value(__ptr__) REP_StgTVar_current_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_current_value] -#define OFFSET_StgTVar_first_watch_queue_entry 8 -#define REP_StgTVar_first_watch_queue_entry b64 -#define StgTVar_first_watch_queue_entry(__ptr__) REP_StgTVar_first_watch_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_first_watch_queue_entry] -#define OFFSET_StgTVar_num_updates 16 -#define REP_StgTVar_num_updates b64 -#define StgTVar_num_updates(__ptr__) REP_StgTVar_num_updates[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_num_updates] -#define SIZEOF_StgWeak_NoHdr 40 -#define SIZEOF_StgWeak (SIZEOF_StgHeader+40) -#define OFFSET_StgWeak_link 32 -#define REP_StgWeak_link b64 -#define StgWeak_link(__ptr__) REP_StgWeak_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_link] -#define OFFSET_StgWeak_key 8 -#define REP_StgWeak_key b64 -#define StgWeak_key(__ptr__) REP_StgWeak_key[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_key] -#define OFFSET_StgWeak_value 16 -#define REP_StgWeak_value b64 -#define StgWeak_value(__ptr__) REP_StgWeak_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_value] -#define OFFSET_StgWeak_finalizer 24 -#define REP_StgWeak_finalizer b64 -#define StgWeak_finalizer(__ptr__) REP_StgWeak_finalizer[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_finalizer] -#define OFFSET_StgWeak_cfinalizers 0 -#define REP_StgWeak_cfinalizers b64 -#define StgWeak_cfinalizers(__ptr__) REP_StgWeak_cfinalizers[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_cfinalizers] -#define SIZEOF_StgCFinalizerList_NoHdr 40 -#define SIZEOF_StgCFinalizerList (SIZEOF_StgHeader+40) -#define OFFSET_StgCFinalizerList_link 0 -#define REP_StgCFinalizerList_link b64 -#define StgCFinalizerList_link(__ptr__) REP_StgCFinalizerList_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_link] -#define OFFSET_StgCFinalizerList_fptr 8 -#define REP_StgCFinalizerList_fptr b64 -#define StgCFinalizerList_fptr(__ptr__) REP_StgCFinalizerList_fptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_fptr] -#define OFFSET_StgCFinalizerList_ptr 16 -#define REP_StgCFinalizerList_ptr b64 -#define StgCFinalizerList_ptr(__ptr__) REP_StgCFinalizerList_ptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_ptr] -#define OFFSET_StgCFinalizerList_eptr 24 -#define REP_StgCFinalizerList_eptr b64 -#define StgCFinalizerList_eptr(__ptr__) REP_StgCFinalizerList_eptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_eptr] -#define OFFSET_StgCFinalizerList_flag 32 -#define REP_StgCFinalizerList_flag b64 -#define StgCFinalizerList_flag(__ptr__) REP_StgCFinalizerList_flag[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_flag] -#define SIZEOF_StgMVar_NoHdr 24 -#define SIZEOF_StgMVar (SIZEOF_StgHeader+24) -#define OFFSET_StgMVar_head 0 -#define REP_StgMVar_head b64 -#define StgMVar_head(__ptr__) REP_StgMVar_head[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_head] -#define OFFSET_StgMVar_tail 8 -#define REP_StgMVar_tail b64 -#define StgMVar_tail(__ptr__) REP_StgMVar_tail[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_tail] -#define OFFSET_StgMVar_value 16 -#define REP_StgMVar_value b64 -#define StgMVar_value(__ptr__) REP_StgMVar_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_value] -#define SIZEOF_StgMVarTSOQueue_NoHdr 16 -#define SIZEOF_StgMVarTSOQueue (SIZEOF_StgHeader+16) -#define OFFSET_StgMVarTSOQueue_link 0 -#define REP_StgMVarTSOQueue_link b64 -#define StgMVarTSOQueue_link(__ptr__) REP_StgMVarTSOQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_link] -#define OFFSET_StgMVarTSOQueue_tso 8 -#define REP_StgMVarTSOQueue_tso b64 -#define StgMVarTSOQueue_tso(__ptr__) REP_StgMVarTSOQueue_tso[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_tso] -#define SIZEOF_StgBCO_NoHdr 32 -#define SIZEOF_StgBCO (SIZEOF_StgHeader+32) -#define OFFSET_StgBCO_instrs 0 -#define REP_StgBCO_instrs b64 -#define StgBCO_instrs(__ptr__) REP_StgBCO_instrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_instrs] -#define OFFSET_StgBCO_literals 8 -#define REP_StgBCO_literals b64 -#define StgBCO_literals(__ptr__) REP_StgBCO_literals[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_literals] -#define OFFSET_StgBCO_ptrs 16 -#define REP_StgBCO_ptrs b64 -#define StgBCO_ptrs(__ptr__) REP_StgBCO_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_ptrs] -#define OFFSET_StgBCO_arity 24 -#define REP_StgBCO_arity b32 -#define StgBCO_arity(__ptr__) REP_StgBCO_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_arity] -#define OFFSET_StgBCO_size 28 -#define REP_StgBCO_size b32 -#define StgBCO_size(__ptr__) REP_StgBCO_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_size] -#define OFFSET_StgBCO_bitmap 32 -#define StgBCO_bitmap(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_bitmap + WDS(__ix__)] -#define SIZEOF_StgStableName_NoHdr 8 -#define SIZEOF_StgStableName (SIZEOF_StgHeader+8) -#define OFFSET_StgStableName_sn 0 -#define REP_StgStableName_sn b64 -#define StgStableName_sn(__ptr__) REP_StgStableName_sn[__ptr__+SIZEOF_StgHeader+OFFSET_StgStableName_sn] -#define SIZEOF_StgBlockingQueue_NoHdr 32 -#define SIZEOF_StgBlockingQueue (SIZEOF_StgHeader+32) -#define OFFSET_StgBlockingQueue_bh 8 -#define REP_StgBlockingQueue_bh b64 -#define StgBlockingQueue_bh(__ptr__) REP_StgBlockingQueue_bh[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_bh] -#define OFFSET_StgBlockingQueue_owner 16 -#define REP_StgBlockingQueue_owner b64 -#define StgBlockingQueue_owner(__ptr__) REP_StgBlockingQueue_owner[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_owner] -#define OFFSET_StgBlockingQueue_queue 24 -#define REP_StgBlockingQueue_queue b64 -#define StgBlockingQueue_queue(__ptr__) REP_StgBlockingQueue_queue[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_queue] -#define OFFSET_StgBlockingQueue_link 0 -#define REP_StgBlockingQueue_link b64 -#define StgBlockingQueue_link(__ptr__) REP_StgBlockingQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_link] -#define SIZEOF_MessageBlackHole_NoHdr 24 -#define SIZEOF_MessageBlackHole (SIZEOF_StgHeader+24) -#define OFFSET_MessageBlackHole_link 0 -#define REP_MessageBlackHole_link b64 -#define MessageBlackHole_link(__ptr__) REP_MessageBlackHole_link[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_link] -#define OFFSET_MessageBlackHole_tso 8 -#define REP_MessageBlackHole_tso b64 -#define MessageBlackHole_tso(__ptr__) REP_MessageBlackHole_tso[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_tso] -#define OFFSET_MessageBlackHole_bh 16 -#define REP_MessageBlackHole_bh b64 -#define MessageBlackHole_bh(__ptr__) REP_MessageBlackHole_bh[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_bh] -#define SIZEOF_StgCompactNFData_NoHdr 64 -#define SIZEOF_StgCompactNFData (SIZEOF_StgHeader+64) -#define OFFSET_StgCompactNFData_totalW 0 -#define REP_StgCompactNFData_totalW b64 -#define StgCompactNFData_totalW(__ptr__) REP_StgCompactNFData_totalW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_totalW] -#define OFFSET_StgCompactNFData_autoBlockW 8 -#define REP_StgCompactNFData_autoBlockW b64 -#define StgCompactNFData_autoBlockW(__ptr__) REP_StgCompactNFData_autoBlockW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_autoBlockW] -#define OFFSET_StgCompactNFData_nursery 32 -#define REP_StgCompactNFData_nursery b64 -#define StgCompactNFData_nursery(__ptr__) REP_StgCompactNFData_nursery[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_nursery] -#define OFFSET_StgCompactNFData_last 40 -#define REP_StgCompactNFData_last b64 -#define StgCompactNFData_last(__ptr__) REP_StgCompactNFData_last[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_last] -#define OFFSET_StgCompactNFData_hp 16 -#define REP_StgCompactNFData_hp b64 -#define StgCompactNFData_hp(__ptr__) REP_StgCompactNFData_hp[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hp] -#define OFFSET_StgCompactNFData_hpLim 24 -#define REP_StgCompactNFData_hpLim b64 -#define StgCompactNFData_hpLim(__ptr__) REP_StgCompactNFData_hpLim[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hpLim] -#define OFFSET_StgCompactNFData_hash 48 -#define REP_StgCompactNFData_hash b64 -#define StgCompactNFData_hash(__ptr__) REP_StgCompactNFData_hash[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hash] -#define OFFSET_StgCompactNFData_result 56 -#define REP_StgCompactNFData_result b64 -#define StgCompactNFData_result(__ptr__) REP_StgCompactNFData_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_result] -#define SIZEOF_StgCompactNFDataBlock 24 -#define OFFSET_StgCompactNFDataBlock_self 0 -#define REP_StgCompactNFDataBlock_self b64 -#define StgCompactNFDataBlock_self(__ptr__) REP_StgCompactNFDataBlock_self[__ptr__+OFFSET_StgCompactNFDataBlock_self] -#define OFFSET_StgCompactNFDataBlock_owner 8 -#define REP_StgCompactNFDataBlock_owner b64 -#define StgCompactNFDataBlock_owner(__ptr__) REP_StgCompactNFDataBlock_owner[__ptr__+OFFSET_StgCompactNFDataBlock_owner] -#define OFFSET_StgCompactNFDataBlock_next 16 -#define REP_StgCompactNFDataBlock_next b64 -#define StgCompactNFDataBlock_next(__ptr__) REP_StgCompactNFDataBlock_next[__ptr__+OFFSET_StgCompactNFDataBlock_next] -#define OFFSET_RtsFlags_ProfFlags_showCCSOnException 285 -#define REP_RtsFlags_ProfFlags_showCCSOnException b8 -#define RtsFlags_ProfFlags_showCCSOnException(__ptr__) REP_RtsFlags_ProfFlags_showCCSOnException[__ptr__+OFFSET_RtsFlags_ProfFlags_showCCSOnException] -#define OFFSET_RtsFlags_DebugFlags_apply 228 -#define REP_RtsFlags_DebugFlags_apply b8 -#define RtsFlags_DebugFlags_apply(__ptr__) REP_RtsFlags_DebugFlags_apply[__ptr__+OFFSET_RtsFlags_DebugFlags_apply] -#define OFFSET_RtsFlags_DebugFlags_sanity 223 -#define REP_RtsFlags_DebugFlags_sanity b8 -#define RtsFlags_DebugFlags_sanity(__ptr__) REP_RtsFlags_DebugFlags_sanity[__ptr__+OFFSET_RtsFlags_DebugFlags_sanity] -#define OFFSET_RtsFlags_DebugFlags_weak 218 -#define REP_RtsFlags_DebugFlags_weak b8 -#define RtsFlags_DebugFlags_weak(__ptr__) REP_RtsFlags_DebugFlags_weak[__ptr__+OFFSET_RtsFlags_DebugFlags_weak] -#define OFFSET_RtsFlags_GcFlags_initialStkSize 16 -#define REP_RtsFlags_GcFlags_initialStkSize b32 -#define RtsFlags_GcFlags_initialStkSize(__ptr__) REP_RtsFlags_GcFlags_initialStkSize[__ptr__+OFFSET_RtsFlags_GcFlags_initialStkSize] -#define OFFSET_RtsFlags_MiscFlags_tickInterval 192 -#define REP_RtsFlags_MiscFlags_tickInterval b64 -#define RtsFlags_MiscFlags_tickInterval(__ptr__) REP_RtsFlags_MiscFlags_tickInterval[__ptr__+OFFSET_RtsFlags_MiscFlags_tickInterval] -#define SIZEOF_StgFunInfoExtraFwd 32 -#define OFFSET_StgFunInfoExtraFwd_slow_apply 24 -#define REP_StgFunInfoExtraFwd_slow_apply b64 -#define StgFunInfoExtraFwd_slow_apply(__ptr__) REP_StgFunInfoExtraFwd_slow_apply[__ptr__+OFFSET_StgFunInfoExtraFwd_slow_apply] -#define OFFSET_StgFunInfoExtraFwd_fun_type 0 -#define REP_StgFunInfoExtraFwd_fun_type b32 -#define StgFunInfoExtraFwd_fun_type(__ptr__) REP_StgFunInfoExtraFwd_fun_type[__ptr__+OFFSET_StgFunInfoExtraFwd_fun_type] -#define OFFSET_StgFunInfoExtraFwd_arity 4 -#define REP_StgFunInfoExtraFwd_arity b32 -#define StgFunInfoExtraFwd_arity(__ptr__) REP_StgFunInfoExtraFwd_arity[__ptr__+OFFSET_StgFunInfoExtraFwd_arity] -#define OFFSET_StgFunInfoExtraFwd_bitmap 16 -#define REP_StgFunInfoExtraFwd_bitmap b64 -#define StgFunInfoExtraFwd_bitmap(__ptr__) REP_StgFunInfoExtraFwd_bitmap[__ptr__+OFFSET_StgFunInfoExtraFwd_bitmap] -#define SIZEOF_StgFunInfoExtraRev 24 -#define OFFSET_StgFunInfoExtraRev_slow_apply_offset 0 -#define REP_StgFunInfoExtraRev_slow_apply_offset b32 -#define StgFunInfoExtraRev_slow_apply_offset(__ptr__) REP_StgFunInfoExtraRev_slow_apply_offset[__ptr__+OFFSET_StgFunInfoExtraRev_slow_apply_offset] -#define OFFSET_StgFunInfoExtraRev_fun_type 16 -#define REP_StgFunInfoExtraRev_fun_type b32 -#define StgFunInfoExtraRev_fun_type(__ptr__) REP_StgFunInfoExtraRev_fun_type[__ptr__+OFFSET_StgFunInfoExtraRev_fun_type] -#define OFFSET_StgFunInfoExtraRev_arity 20 -#define REP_StgFunInfoExtraRev_arity b32 -#define StgFunInfoExtraRev_arity(__ptr__) REP_StgFunInfoExtraRev_arity[__ptr__+OFFSET_StgFunInfoExtraRev_arity] -#define OFFSET_StgFunInfoExtraRev_bitmap 8 -#define REP_StgFunInfoExtraRev_bitmap b64 -#define StgFunInfoExtraRev_bitmap(__ptr__) REP_StgFunInfoExtraRev_bitmap[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap] -#define OFFSET_StgFunInfoExtraRev_bitmap_offset 8 -#define REP_StgFunInfoExtraRev_bitmap_offset b32 -#define StgFunInfoExtraRev_bitmap_offset(__ptr__) REP_StgFunInfoExtraRev_bitmap_offset[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap_offset] -#define OFFSET_StgLargeBitmap_size 0 -#define REP_StgLargeBitmap_size b64 -#define StgLargeBitmap_size(__ptr__) REP_StgLargeBitmap_size[__ptr__+OFFSET_StgLargeBitmap_size] -#define OFFSET_StgLargeBitmap_bitmap 8 -#define SIZEOF_snEntry 24 -#define OFFSET_snEntry_sn_obj 16 -#define REP_snEntry_sn_obj b64 -#define snEntry_sn_obj(__ptr__) REP_snEntry_sn_obj[__ptr__+OFFSET_snEntry_sn_obj] -#define OFFSET_snEntry_addr 0 -#define REP_snEntry_addr b64 -#define snEntry_addr(__ptr__) REP_snEntry_addr[__ptr__+OFFSET_snEntry_addr] -#define SIZEOF_spEntry 8 -#define OFFSET_spEntry_addr 0 -#define REP_spEntry_addr b64 -#define spEntry_addr(__ptr__) REP_spEntry_addr[__ptr__+OFFSET_spEntry_addr] diff --git a/ghc-lib/stage0/lib/GhclibDerivedConstants.h b/ghc-lib/stage0/lib/GhclibDerivedConstants.h new file mode 100644 --- /dev/null +++ b/ghc-lib/stage0/lib/GhclibDerivedConstants.h @@ -0,0 +1,555 @@ +/* This file is created automatically. Do not edit by hand.*/ + +#define CONTROL_GROUP_CONST_291 291 +#define STD_HDR_SIZE 1 +#define PROF_HDR_SIZE 2 +#define STACK_DIRTY 1 +#define BLOCK_SIZE 4096 +#define MBLOCK_SIZE 1048576 +#define BLOCKS_PER_MBLOCK 252 +#define TICKY_BIN_COUNT 9 +#define OFFSET_StgRegTable_rR1 0 +#define OFFSET_StgRegTable_rR2 8 +#define OFFSET_StgRegTable_rR3 16 +#define OFFSET_StgRegTable_rR4 24 +#define OFFSET_StgRegTable_rR5 32 +#define OFFSET_StgRegTable_rR6 40 +#define OFFSET_StgRegTable_rR7 48 +#define OFFSET_StgRegTable_rR8 56 +#define OFFSET_StgRegTable_rR9 64 +#define OFFSET_StgRegTable_rR10 72 +#define OFFSET_StgRegTable_rF1 80 +#define OFFSET_StgRegTable_rF2 84 +#define OFFSET_StgRegTable_rF3 88 +#define OFFSET_StgRegTable_rF4 92 +#define OFFSET_StgRegTable_rF5 96 +#define OFFSET_StgRegTable_rF6 100 +#define OFFSET_StgRegTable_rD1 104 +#define OFFSET_StgRegTable_rD2 112 +#define OFFSET_StgRegTable_rD3 120 +#define OFFSET_StgRegTable_rD4 128 +#define OFFSET_StgRegTable_rD5 136 +#define OFFSET_StgRegTable_rD6 144 +#define OFFSET_StgRegTable_rXMM1 152 +#define OFFSET_StgRegTable_rXMM2 168 +#define OFFSET_StgRegTable_rXMM3 184 +#define OFFSET_StgRegTable_rXMM4 200 +#define OFFSET_StgRegTable_rXMM5 216 +#define OFFSET_StgRegTable_rXMM6 232 +#define OFFSET_StgRegTable_rYMM1 248 +#define OFFSET_StgRegTable_rYMM2 280 +#define OFFSET_StgRegTable_rYMM3 312 +#define OFFSET_StgRegTable_rYMM4 344 +#define OFFSET_StgRegTable_rYMM5 376 +#define OFFSET_StgRegTable_rYMM6 408 +#define OFFSET_StgRegTable_rZMM1 440 +#define OFFSET_StgRegTable_rZMM2 504 +#define OFFSET_StgRegTable_rZMM3 568 +#define OFFSET_StgRegTable_rZMM4 632 +#define OFFSET_StgRegTable_rZMM5 696 +#define OFFSET_StgRegTable_rZMM6 760 +#define OFFSET_StgRegTable_rL1 824 +#define OFFSET_StgRegTable_rSp 832 +#define OFFSET_StgRegTable_rSpLim 840 +#define OFFSET_StgRegTable_rHp 848 +#define OFFSET_StgRegTable_rHpLim 856 +#define OFFSET_StgRegTable_rCCCS 864 +#define OFFSET_StgRegTable_rCurrentTSO 872 +#define OFFSET_StgRegTable_rCurrentNursery 888 +#define OFFSET_StgRegTable_rHpAlloc 904 +#define OFFSET_StgRegTable_rRet 912 +#define REP_StgRegTable_rRet b64 +#define StgRegTable_rRet(__ptr__) REP_StgRegTable_rRet[__ptr__+OFFSET_StgRegTable_rRet] +#define OFFSET_StgRegTable_rNursery 880 +#define REP_StgRegTable_rNursery b64 +#define StgRegTable_rNursery(__ptr__) REP_StgRegTable_rNursery[__ptr__+OFFSET_StgRegTable_rNursery] +#define OFFSET_stgEagerBlackholeInfo -24 +#define OFFSET_stgGCEnter1 -16 +#define OFFSET_stgGCFun -8 +#define OFFSET_Capability_r 24 +#define OFFSET_Capability_lock 1208 +#define OFFSET_Capability_no 944 +#define REP_Capability_no b32 +#define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no] +#define OFFSET_Capability_mut_lists 1016 +#define REP_Capability_mut_lists b64 +#define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists] +#define OFFSET_Capability_context_switch 1176 +#define REP_Capability_context_switch b32 +#define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch] +#define OFFSET_Capability_interrupt 1180 +#define REP_Capability_interrupt b32 +#define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt] +#define OFFSET_Capability_sparks 1312 +#define REP_Capability_sparks b64 +#define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks] +#define OFFSET_Capability_total_allocated 1184 +#define REP_Capability_total_allocated b64 +#define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated] +#define OFFSET_Capability_weak_ptr_list_hd 1160 +#define REP_Capability_weak_ptr_list_hd b64 +#define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd] +#define OFFSET_Capability_weak_ptr_list_tl 1168 +#define REP_Capability_weak_ptr_list_tl b64 +#define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl] +#define OFFSET_bdescr_start 0 +#define REP_bdescr_start b64 +#define bdescr_start(__ptr__) REP_bdescr_start[__ptr__+OFFSET_bdescr_start] +#define OFFSET_bdescr_free 8 +#define REP_bdescr_free b64 +#define bdescr_free(__ptr__) REP_bdescr_free[__ptr__+OFFSET_bdescr_free] +#define OFFSET_bdescr_blocks 48 +#define REP_bdescr_blocks b32 +#define bdescr_blocks(__ptr__) REP_bdescr_blocks[__ptr__+OFFSET_bdescr_blocks] +#define OFFSET_bdescr_gen_no 40 +#define REP_bdescr_gen_no b16 +#define bdescr_gen_no(__ptr__) REP_bdescr_gen_no[__ptr__+OFFSET_bdescr_gen_no] +#define OFFSET_bdescr_link 16 +#define REP_bdescr_link b64 +#define bdescr_link(__ptr__) REP_bdescr_link[__ptr__+OFFSET_bdescr_link] +#define OFFSET_bdescr_flags 46 +#define REP_bdescr_flags b16 +#define bdescr_flags(__ptr__) REP_bdescr_flags[__ptr__+OFFSET_bdescr_flags] +#define SIZEOF_generation 384 +#define OFFSET_generation_n_new_large_words 56 +#define REP_generation_n_new_large_words b64 +#define generation_n_new_large_words(__ptr__) REP_generation_n_new_large_words[__ptr__+OFFSET_generation_n_new_large_words] +#define OFFSET_generation_weak_ptr_list 112 +#define REP_generation_weak_ptr_list b64 +#define generation_weak_ptr_list(__ptr__) REP_generation_weak_ptr_list[__ptr__+OFFSET_generation_weak_ptr_list] +#define SIZEOF_CostCentreStack 96 +#define OFFSET_CostCentreStack_ccsID 0 +#define REP_CostCentreStack_ccsID b64 +#define CostCentreStack_ccsID(__ptr__) REP_CostCentreStack_ccsID[__ptr__+OFFSET_CostCentreStack_ccsID] +#define OFFSET_CostCentreStack_mem_alloc 72 +#define REP_CostCentreStack_mem_alloc b64 +#define CostCentreStack_mem_alloc(__ptr__) REP_CostCentreStack_mem_alloc[__ptr__+OFFSET_CostCentreStack_mem_alloc] +#define OFFSET_CostCentreStack_scc_count 48 +#define REP_CostCentreStack_scc_count b64 +#define CostCentreStack_scc_count(__ptr__) REP_CostCentreStack_scc_count[__ptr__+OFFSET_CostCentreStack_scc_count] +#define OFFSET_CostCentreStack_prevStack 16 +#define REP_CostCentreStack_prevStack b64 +#define CostCentreStack_prevStack(__ptr__) REP_CostCentreStack_prevStack[__ptr__+OFFSET_CostCentreStack_prevStack] +#define OFFSET_CostCentre_ccID 0 +#define REP_CostCentre_ccID b64 +#define CostCentre_ccID(__ptr__) REP_CostCentre_ccID[__ptr__+OFFSET_CostCentre_ccID] +#define OFFSET_CostCentre_link 56 +#define REP_CostCentre_link b64 +#define CostCentre_link(__ptr__) REP_CostCentre_link[__ptr__+OFFSET_CostCentre_link] +#define OFFSET_StgHeader_info 0 +#define REP_StgHeader_info b64 +#define StgHeader_info(__ptr__) REP_StgHeader_info[__ptr__+OFFSET_StgHeader_info] +#define OFFSET_StgHeader_ccs 8 +#define REP_StgHeader_ccs b64 +#define StgHeader_ccs(__ptr__) REP_StgHeader_ccs[__ptr__+OFFSET_StgHeader_ccs] +#define OFFSET_StgHeader_ldvw 16 +#define REP_StgHeader_ldvw b64 +#define StgHeader_ldvw(__ptr__) REP_StgHeader_ldvw[__ptr__+OFFSET_StgHeader_ldvw] +#define SIZEOF_StgSMPThunkHeader 8 +#define OFFSET_StgClosure_payload 0 +#define StgClosure_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgClosure_payload + WDS(__ix__)] +#define OFFSET_StgEntCounter_allocs 48 +#define REP_StgEntCounter_allocs b64 +#define StgEntCounter_allocs(__ptr__) REP_StgEntCounter_allocs[__ptr__+OFFSET_StgEntCounter_allocs] +#define OFFSET_StgEntCounter_allocd 16 +#define REP_StgEntCounter_allocd b64 +#define StgEntCounter_allocd(__ptr__) REP_StgEntCounter_allocd[__ptr__+OFFSET_StgEntCounter_allocd] +#define OFFSET_StgEntCounter_registeredp 0 +#define REP_StgEntCounter_registeredp b64 +#define StgEntCounter_registeredp(__ptr__) REP_StgEntCounter_registeredp[__ptr__+OFFSET_StgEntCounter_registeredp] +#define OFFSET_StgEntCounter_link 56 +#define REP_StgEntCounter_link b64 +#define StgEntCounter_link(__ptr__) REP_StgEntCounter_link[__ptr__+OFFSET_StgEntCounter_link] +#define OFFSET_StgEntCounter_entry_count 40 +#define REP_StgEntCounter_entry_count b64 +#define StgEntCounter_entry_count(__ptr__) REP_StgEntCounter_entry_count[__ptr__+OFFSET_StgEntCounter_entry_count] +#define SIZEOF_StgUpdateFrame_NoHdr 8 +#define SIZEOF_StgUpdateFrame (SIZEOF_StgHeader+8) +#define SIZEOF_StgCatchFrame_NoHdr 16 +#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16) +#define SIZEOF_StgStopFrame_NoHdr 0 +#define SIZEOF_StgStopFrame (SIZEOF_StgHeader+0) +#define SIZEOF_StgMutArrPtrs_NoHdr 16 +#define SIZEOF_StgMutArrPtrs (SIZEOF_StgHeader+16) +#define OFFSET_StgMutArrPtrs_ptrs 0 +#define REP_StgMutArrPtrs_ptrs b64 +#define StgMutArrPtrs_ptrs(__ptr__) REP_StgMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_ptrs] +#define OFFSET_StgMutArrPtrs_size 8 +#define REP_StgMutArrPtrs_size b64 +#define StgMutArrPtrs_size(__ptr__) REP_StgMutArrPtrs_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutArrPtrs_size] +#define SIZEOF_StgSmallMutArrPtrs_NoHdr 8 +#define SIZEOF_StgSmallMutArrPtrs (SIZEOF_StgHeader+8) +#define OFFSET_StgSmallMutArrPtrs_ptrs 0 +#define REP_StgSmallMutArrPtrs_ptrs b64 +#define StgSmallMutArrPtrs_ptrs(__ptr__) REP_StgSmallMutArrPtrs_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgSmallMutArrPtrs_ptrs] +#define SIZEOF_StgArrBytes_NoHdr 8 +#define SIZEOF_StgArrBytes (SIZEOF_StgHeader+8) +#define OFFSET_StgArrBytes_bytes 0 +#define REP_StgArrBytes_bytes b64 +#define StgArrBytes_bytes(__ptr__) REP_StgArrBytes_bytes[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_bytes] +#define OFFSET_StgArrBytes_payload 8 +#define StgArrBytes_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgArrBytes_payload + WDS(__ix__)] +#define OFFSET_StgTSO__link 0 +#define REP_StgTSO__link b64 +#define StgTSO__link(__ptr__) REP_StgTSO__link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO__link] +#define OFFSET_StgTSO_global_link 8 +#define REP_StgTSO_global_link b64 +#define StgTSO_global_link(__ptr__) REP_StgTSO_global_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_global_link] +#define OFFSET_StgTSO_what_next 24 +#define REP_StgTSO_what_next b16 +#define StgTSO_what_next(__ptr__) REP_StgTSO_what_next[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_what_next] +#define OFFSET_StgTSO_why_blocked 26 +#define REP_StgTSO_why_blocked b16 +#define StgTSO_why_blocked(__ptr__) REP_StgTSO_why_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_why_blocked] +#define OFFSET_StgTSO_block_info 32 +#define REP_StgTSO_block_info b64 +#define StgTSO_block_info(__ptr__) REP_StgTSO_block_info[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_block_info] +#define OFFSET_StgTSO_blocked_exceptions 80 +#define REP_StgTSO_blocked_exceptions b64 +#define StgTSO_blocked_exceptions(__ptr__) REP_StgTSO_blocked_exceptions[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_blocked_exceptions] +#define OFFSET_StgTSO_id 40 +#define REP_StgTSO_id b32 +#define StgTSO_id(__ptr__) REP_StgTSO_id[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_id] +#define OFFSET_StgTSO_cap 64 +#define REP_StgTSO_cap b64 +#define StgTSO_cap(__ptr__) REP_StgTSO_cap[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cap] +#define OFFSET_StgTSO_saved_errno 44 +#define REP_StgTSO_saved_errno b32 +#define StgTSO_saved_errno(__ptr__) REP_StgTSO_saved_errno[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_saved_errno] +#define OFFSET_StgTSO_trec 72 +#define REP_StgTSO_trec b64 +#define StgTSO_trec(__ptr__) REP_StgTSO_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_trec] +#define OFFSET_StgTSO_flags 28 +#define REP_StgTSO_flags b32 +#define StgTSO_flags(__ptr__) REP_StgTSO_flags[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_flags] +#define OFFSET_StgTSO_dirty 48 +#define REP_StgTSO_dirty b32 +#define StgTSO_dirty(__ptr__) REP_StgTSO_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_dirty] +#define OFFSET_StgTSO_bq 88 +#define REP_StgTSO_bq b64 +#define StgTSO_bq(__ptr__) REP_StgTSO_bq[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_bq] +#define OFFSET_StgTSO_alloc_limit 96 +#define REP_StgTSO_alloc_limit b64 +#define StgTSO_alloc_limit(__ptr__) REP_StgTSO_alloc_limit[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_alloc_limit] +#define OFFSET_StgTSO_cccs 112 +#define REP_StgTSO_cccs b64 +#define StgTSO_cccs(__ptr__) REP_StgTSO_cccs[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_cccs] +#define OFFSET_StgTSO_stackobj 16 +#define REP_StgTSO_stackobj b64 +#define StgTSO_stackobj(__ptr__) REP_StgTSO_stackobj[__ptr__+SIZEOF_StgHeader+OFFSET_StgTSO_stackobj] +#define OFFSET_StgStack_sp 8 +#define REP_StgStack_sp b64 +#define StgStack_sp(__ptr__) REP_StgStack_sp[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_sp] +#define OFFSET_StgStack_stack 16 +#define OFFSET_StgStack_stack_size 0 +#define REP_StgStack_stack_size b32 +#define StgStack_stack_size(__ptr__) REP_StgStack_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_stack_size] +#define OFFSET_StgStack_dirty 4 +#define REP_StgStack_dirty b8 +#define StgStack_dirty(__ptr__) REP_StgStack_dirty[__ptr__+SIZEOF_StgHeader+OFFSET_StgStack_dirty] +#define SIZEOF_StgTSOProfInfo 8 +#define OFFSET_StgUpdateFrame_updatee 0 +#define REP_StgUpdateFrame_updatee b64 +#define StgUpdateFrame_updatee(__ptr__) REP_StgUpdateFrame_updatee[__ptr__+SIZEOF_StgHeader+OFFSET_StgUpdateFrame_updatee] +#define OFFSET_StgCatchFrame_handler 8 +#define REP_StgCatchFrame_handler b64 +#define StgCatchFrame_handler(__ptr__) REP_StgCatchFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_handler] +#define OFFSET_StgCatchFrame_exceptions_blocked 0 +#define REP_StgCatchFrame_exceptions_blocked b64 +#define StgCatchFrame_exceptions_blocked(__ptr__) REP_StgCatchFrame_exceptions_blocked[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchFrame_exceptions_blocked] +#define SIZEOF_StgPAP_NoHdr 16 +#define SIZEOF_StgPAP (SIZEOF_StgHeader+16) +#define OFFSET_StgPAP_n_args 4 +#define REP_StgPAP_n_args b32 +#define StgPAP_n_args(__ptr__) REP_StgPAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_n_args] +#define OFFSET_StgPAP_fun 8 +#define REP_StgPAP_fun gcptr +#define StgPAP_fun(__ptr__) REP_StgPAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_fun] +#define OFFSET_StgPAP_arity 0 +#define REP_StgPAP_arity b32 +#define StgPAP_arity(__ptr__) REP_StgPAP_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_arity] +#define OFFSET_StgPAP_payload 16 +#define StgPAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgPAP_payload + WDS(__ix__)] +#define SIZEOF_StgAP_NoThunkHdr 16 +#define SIZEOF_StgAP_NoHdr 24 +#define SIZEOF_StgAP (SIZEOF_StgHeader+24) +#define OFFSET_StgAP_n_args 12 +#define REP_StgAP_n_args b32 +#define StgAP_n_args(__ptr__) REP_StgAP_n_args[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_n_args] +#define OFFSET_StgAP_fun 16 +#define REP_StgAP_fun gcptr +#define StgAP_fun(__ptr__) REP_StgAP_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_fun] +#define OFFSET_StgAP_payload 24 +#define StgAP_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_payload + WDS(__ix__)] +#define SIZEOF_StgAP_STACK_NoThunkHdr 16 +#define SIZEOF_StgAP_STACK_NoHdr 24 +#define SIZEOF_StgAP_STACK (SIZEOF_StgHeader+24) +#define OFFSET_StgAP_STACK_size 8 +#define REP_StgAP_STACK_size b64 +#define StgAP_STACK_size(__ptr__) REP_StgAP_STACK_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_size] +#define OFFSET_StgAP_STACK_fun 16 +#define REP_StgAP_STACK_fun gcptr +#define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun] +#define OFFSET_StgAP_STACK_payload 24 +#define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)] +#define SIZEOF_StgSelector_NoThunkHdr 8 +#define SIZEOF_StgSelector_NoHdr 16 +#define SIZEOF_StgSelector (SIZEOF_StgHeader+16) +#define OFFSET_StgInd_indirectee 0 +#define REP_StgInd_indirectee gcptr +#define StgInd_indirectee(__ptr__) REP_StgInd_indirectee[__ptr__+SIZEOF_StgHeader+OFFSET_StgInd_indirectee] +#define SIZEOF_StgMutVar_NoHdr 8 +#define SIZEOF_StgMutVar (SIZEOF_StgHeader+8) +#define OFFSET_StgMutVar_var 0 +#define REP_StgMutVar_var b64 +#define StgMutVar_var(__ptr__) REP_StgMutVar_var[__ptr__+SIZEOF_StgHeader+OFFSET_StgMutVar_var] +#define SIZEOF_StgAtomicallyFrame_NoHdr 16 +#define SIZEOF_StgAtomicallyFrame (SIZEOF_StgHeader+16) +#define OFFSET_StgAtomicallyFrame_code 0 +#define REP_StgAtomicallyFrame_code b64 +#define StgAtomicallyFrame_code(__ptr__) REP_StgAtomicallyFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_code] +#define OFFSET_StgAtomicallyFrame_result 8 +#define REP_StgAtomicallyFrame_result b64 +#define StgAtomicallyFrame_result(__ptr__) REP_StgAtomicallyFrame_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgAtomicallyFrame_result] +#define OFFSET_StgTRecHeader_enclosing_trec 0 +#define REP_StgTRecHeader_enclosing_trec b64 +#define StgTRecHeader_enclosing_trec(__ptr__) REP_StgTRecHeader_enclosing_trec[__ptr__+SIZEOF_StgHeader+OFFSET_StgTRecHeader_enclosing_trec] +#define SIZEOF_StgCatchSTMFrame_NoHdr 16 +#define SIZEOF_StgCatchSTMFrame (SIZEOF_StgHeader+16) +#define OFFSET_StgCatchSTMFrame_handler 8 +#define REP_StgCatchSTMFrame_handler b64 +#define StgCatchSTMFrame_handler(__ptr__) REP_StgCatchSTMFrame_handler[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_handler] +#define OFFSET_StgCatchSTMFrame_code 0 +#define REP_StgCatchSTMFrame_code b64 +#define StgCatchSTMFrame_code(__ptr__) REP_StgCatchSTMFrame_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchSTMFrame_code] +#define SIZEOF_StgCatchRetryFrame_NoHdr 24 +#define SIZEOF_StgCatchRetryFrame (SIZEOF_StgHeader+24) +#define OFFSET_StgCatchRetryFrame_running_alt_code 0 +#define REP_StgCatchRetryFrame_running_alt_code b64 +#define StgCatchRetryFrame_running_alt_code(__ptr__) REP_StgCatchRetryFrame_running_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_running_alt_code] +#define OFFSET_StgCatchRetryFrame_first_code 8 +#define REP_StgCatchRetryFrame_first_code b64 +#define StgCatchRetryFrame_first_code(__ptr__) REP_StgCatchRetryFrame_first_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_first_code] +#define OFFSET_StgCatchRetryFrame_alt_code 16 +#define REP_StgCatchRetryFrame_alt_code b64 +#define StgCatchRetryFrame_alt_code(__ptr__) REP_StgCatchRetryFrame_alt_code[__ptr__+SIZEOF_StgHeader+OFFSET_StgCatchRetryFrame_alt_code] +#define OFFSET_StgTVarWatchQueue_closure 0 +#define REP_StgTVarWatchQueue_closure b64 +#define StgTVarWatchQueue_closure(__ptr__) REP_StgTVarWatchQueue_closure[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_closure] +#define OFFSET_StgTVarWatchQueue_next_queue_entry 8 +#define REP_StgTVarWatchQueue_next_queue_entry b64 +#define StgTVarWatchQueue_next_queue_entry(__ptr__) REP_StgTVarWatchQueue_next_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_next_queue_entry] +#define OFFSET_StgTVarWatchQueue_prev_queue_entry 16 +#define REP_StgTVarWatchQueue_prev_queue_entry b64 +#define StgTVarWatchQueue_prev_queue_entry(__ptr__) REP_StgTVarWatchQueue_prev_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVarWatchQueue_prev_queue_entry] +#define SIZEOF_StgTVar_NoHdr 24 +#define SIZEOF_StgTVar (SIZEOF_StgHeader+24) +#define OFFSET_StgTVar_current_value 0 +#define REP_StgTVar_current_value b64 +#define StgTVar_current_value(__ptr__) REP_StgTVar_current_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_current_value] +#define OFFSET_StgTVar_first_watch_queue_entry 8 +#define REP_StgTVar_first_watch_queue_entry b64 +#define StgTVar_first_watch_queue_entry(__ptr__) REP_StgTVar_first_watch_queue_entry[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_first_watch_queue_entry] +#define OFFSET_StgTVar_num_updates 16 +#define REP_StgTVar_num_updates b64 +#define StgTVar_num_updates(__ptr__) REP_StgTVar_num_updates[__ptr__+SIZEOF_StgHeader+OFFSET_StgTVar_num_updates] +#define SIZEOF_StgWeak_NoHdr 40 +#define SIZEOF_StgWeak (SIZEOF_StgHeader+40) +#define OFFSET_StgWeak_link 32 +#define REP_StgWeak_link b64 +#define StgWeak_link(__ptr__) REP_StgWeak_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_link] +#define OFFSET_StgWeak_key 8 +#define REP_StgWeak_key b64 +#define StgWeak_key(__ptr__) REP_StgWeak_key[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_key] +#define OFFSET_StgWeak_value 16 +#define REP_StgWeak_value b64 +#define StgWeak_value(__ptr__) REP_StgWeak_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_value] +#define OFFSET_StgWeak_finalizer 24 +#define REP_StgWeak_finalizer b64 +#define StgWeak_finalizer(__ptr__) REP_StgWeak_finalizer[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_finalizer] +#define OFFSET_StgWeak_cfinalizers 0 +#define REP_StgWeak_cfinalizers b64 +#define StgWeak_cfinalizers(__ptr__) REP_StgWeak_cfinalizers[__ptr__+SIZEOF_StgHeader+OFFSET_StgWeak_cfinalizers] +#define SIZEOF_StgCFinalizerList_NoHdr 40 +#define SIZEOF_StgCFinalizerList (SIZEOF_StgHeader+40) +#define OFFSET_StgCFinalizerList_link 0 +#define REP_StgCFinalizerList_link b64 +#define StgCFinalizerList_link(__ptr__) REP_StgCFinalizerList_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_link] +#define OFFSET_StgCFinalizerList_fptr 8 +#define REP_StgCFinalizerList_fptr b64 +#define StgCFinalizerList_fptr(__ptr__) REP_StgCFinalizerList_fptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_fptr] +#define OFFSET_StgCFinalizerList_ptr 16 +#define REP_StgCFinalizerList_ptr b64 +#define StgCFinalizerList_ptr(__ptr__) REP_StgCFinalizerList_ptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_ptr] +#define OFFSET_StgCFinalizerList_eptr 24 +#define REP_StgCFinalizerList_eptr b64 +#define StgCFinalizerList_eptr(__ptr__) REP_StgCFinalizerList_eptr[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_eptr] +#define OFFSET_StgCFinalizerList_flag 32 +#define REP_StgCFinalizerList_flag b64 +#define StgCFinalizerList_flag(__ptr__) REP_StgCFinalizerList_flag[__ptr__+SIZEOF_StgHeader+OFFSET_StgCFinalizerList_flag] +#define SIZEOF_StgMVar_NoHdr 24 +#define SIZEOF_StgMVar (SIZEOF_StgHeader+24) +#define OFFSET_StgMVar_head 0 +#define REP_StgMVar_head b64 +#define StgMVar_head(__ptr__) REP_StgMVar_head[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_head] +#define OFFSET_StgMVar_tail 8 +#define REP_StgMVar_tail b64 +#define StgMVar_tail(__ptr__) REP_StgMVar_tail[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_tail] +#define OFFSET_StgMVar_value 16 +#define REP_StgMVar_value b64 +#define StgMVar_value(__ptr__) REP_StgMVar_value[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVar_value] +#define SIZEOF_StgMVarTSOQueue_NoHdr 16 +#define SIZEOF_StgMVarTSOQueue (SIZEOF_StgHeader+16) +#define OFFSET_StgMVarTSOQueue_link 0 +#define REP_StgMVarTSOQueue_link b64 +#define StgMVarTSOQueue_link(__ptr__) REP_StgMVarTSOQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_link] +#define OFFSET_StgMVarTSOQueue_tso 8 +#define REP_StgMVarTSOQueue_tso b64 +#define StgMVarTSOQueue_tso(__ptr__) REP_StgMVarTSOQueue_tso[__ptr__+SIZEOF_StgHeader+OFFSET_StgMVarTSOQueue_tso] +#define SIZEOF_StgBCO_NoHdr 32 +#define SIZEOF_StgBCO (SIZEOF_StgHeader+32) +#define OFFSET_StgBCO_instrs 0 +#define REP_StgBCO_instrs b64 +#define StgBCO_instrs(__ptr__) REP_StgBCO_instrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_instrs] +#define OFFSET_StgBCO_literals 8 +#define REP_StgBCO_literals b64 +#define StgBCO_literals(__ptr__) REP_StgBCO_literals[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_literals] +#define OFFSET_StgBCO_ptrs 16 +#define REP_StgBCO_ptrs b64 +#define StgBCO_ptrs(__ptr__) REP_StgBCO_ptrs[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_ptrs] +#define OFFSET_StgBCO_arity 24 +#define REP_StgBCO_arity b32 +#define StgBCO_arity(__ptr__) REP_StgBCO_arity[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_arity] +#define OFFSET_StgBCO_size 28 +#define REP_StgBCO_size b32 +#define StgBCO_size(__ptr__) REP_StgBCO_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_size] +#define OFFSET_StgBCO_bitmap 32 +#define StgBCO_bitmap(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgBCO_bitmap + WDS(__ix__)] +#define SIZEOF_StgStableName_NoHdr 8 +#define SIZEOF_StgStableName (SIZEOF_StgHeader+8) +#define OFFSET_StgStableName_sn 0 +#define REP_StgStableName_sn b64 +#define StgStableName_sn(__ptr__) REP_StgStableName_sn[__ptr__+SIZEOF_StgHeader+OFFSET_StgStableName_sn] +#define SIZEOF_StgBlockingQueue_NoHdr 32 +#define SIZEOF_StgBlockingQueue (SIZEOF_StgHeader+32) +#define OFFSET_StgBlockingQueue_bh 8 +#define REP_StgBlockingQueue_bh b64 +#define StgBlockingQueue_bh(__ptr__) REP_StgBlockingQueue_bh[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_bh] +#define OFFSET_StgBlockingQueue_owner 16 +#define REP_StgBlockingQueue_owner b64 +#define StgBlockingQueue_owner(__ptr__) REP_StgBlockingQueue_owner[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_owner] +#define OFFSET_StgBlockingQueue_queue 24 +#define REP_StgBlockingQueue_queue b64 +#define StgBlockingQueue_queue(__ptr__) REP_StgBlockingQueue_queue[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_queue] +#define OFFSET_StgBlockingQueue_link 0 +#define REP_StgBlockingQueue_link b64 +#define StgBlockingQueue_link(__ptr__) REP_StgBlockingQueue_link[__ptr__+SIZEOF_StgHeader+OFFSET_StgBlockingQueue_link] +#define SIZEOF_MessageBlackHole_NoHdr 24 +#define SIZEOF_MessageBlackHole (SIZEOF_StgHeader+24) +#define OFFSET_MessageBlackHole_link 0 +#define REP_MessageBlackHole_link b64 +#define MessageBlackHole_link(__ptr__) REP_MessageBlackHole_link[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_link] +#define OFFSET_MessageBlackHole_tso 8 +#define REP_MessageBlackHole_tso b64 +#define MessageBlackHole_tso(__ptr__) REP_MessageBlackHole_tso[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_tso] +#define OFFSET_MessageBlackHole_bh 16 +#define REP_MessageBlackHole_bh b64 +#define MessageBlackHole_bh(__ptr__) REP_MessageBlackHole_bh[__ptr__+SIZEOF_StgHeader+OFFSET_MessageBlackHole_bh] +#define SIZEOF_StgCompactNFData_NoHdr 64 +#define SIZEOF_StgCompactNFData (SIZEOF_StgHeader+64) +#define OFFSET_StgCompactNFData_totalW 0 +#define REP_StgCompactNFData_totalW b64 +#define StgCompactNFData_totalW(__ptr__) REP_StgCompactNFData_totalW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_totalW] +#define OFFSET_StgCompactNFData_autoBlockW 8 +#define REP_StgCompactNFData_autoBlockW b64 +#define StgCompactNFData_autoBlockW(__ptr__) REP_StgCompactNFData_autoBlockW[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_autoBlockW] +#define OFFSET_StgCompactNFData_nursery 32 +#define REP_StgCompactNFData_nursery b64 +#define StgCompactNFData_nursery(__ptr__) REP_StgCompactNFData_nursery[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_nursery] +#define OFFSET_StgCompactNFData_last 40 +#define REP_StgCompactNFData_last b64 +#define StgCompactNFData_last(__ptr__) REP_StgCompactNFData_last[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_last] +#define OFFSET_StgCompactNFData_hp 16 +#define REP_StgCompactNFData_hp b64 +#define StgCompactNFData_hp(__ptr__) REP_StgCompactNFData_hp[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hp] +#define OFFSET_StgCompactNFData_hpLim 24 +#define REP_StgCompactNFData_hpLim b64 +#define StgCompactNFData_hpLim(__ptr__) REP_StgCompactNFData_hpLim[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hpLim] +#define OFFSET_StgCompactNFData_hash 48 +#define REP_StgCompactNFData_hash b64 +#define StgCompactNFData_hash(__ptr__) REP_StgCompactNFData_hash[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_hash] +#define OFFSET_StgCompactNFData_result 56 +#define REP_StgCompactNFData_result b64 +#define StgCompactNFData_result(__ptr__) REP_StgCompactNFData_result[__ptr__+SIZEOF_StgHeader+OFFSET_StgCompactNFData_result] +#define SIZEOF_StgCompactNFDataBlock 24 +#define OFFSET_StgCompactNFDataBlock_self 0 +#define REP_StgCompactNFDataBlock_self b64 +#define StgCompactNFDataBlock_self(__ptr__) REP_StgCompactNFDataBlock_self[__ptr__+OFFSET_StgCompactNFDataBlock_self] +#define OFFSET_StgCompactNFDataBlock_owner 8 +#define REP_StgCompactNFDataBlock_owner b64 +#define StgCompactNFDataBlock_owner(__ptr__) REP_StgCompactNFDataBlock_owner[__ptr__+OFFSET_StgCompactNFDataBlock_owner] +#define OFFSET_StgCompactNFDataBlock_next 16 +#define REP_StgCompactNFDataBlock_next b64 +#define StgCompactNFDataBlock_next(__ptr__) REP_StgCompactNFDataBlock_next[__ptr__+OFFSET_StgCompactNFDataBlock_next] +#define OFFSET_RtsFlags_ProfFlags_showCCSOnException 285 +#define REP_RtsFlags_ProfFlags_showCCSOnException b8 +#define RtsFlags_ProfFlags_showCCSOnException(__ptr__) REP_RtsFlags_ProfFlags_showCCSOnException[__ptr__+OFFSET_RtsFlags_ProfFlags_showCCSOnException] +#define OFFSET_RtsFlags_DebugFlags_apply 228 +#define REP_RtsFlags_DebugFlags_apply b8 +#define RtsFlags_DebugFlags_apply(__ptr__) REP_RtsFlags_DebugFlags_apply[__ptr__+OFFSET_RtsFlags_DebugFlags_apply] +#define OFFSET_RtsFlags_DebugFlags_sanity 223 +#define REP_RtsFlags_DebugFlags_sanity b8 +#define RtsFlags_DebugFlags_sanity(__ptr__) REP_RtsFlags_DebugFlags_sanity[__ptr__+OFFSET_RtsFlags_DebugFlags_sanity] +#define OFFSET_RtsFlags_DebugFlags_weak 218 +#define REP_RtsFlags_DebugFlags_weak b8 +#define RtsFlags_DebugFlags_weak(__ptr__) REP_RtsFlags_DebugFlags_weak[__ptr__+OFFSET_RtsFlags_DebugFlags_weak] +#define OFFSET_RtsFlags_GcFlags_initialStkSize 16 +#define REP_RtsFlags_GcFlags_initialStkSize b32 +#define RtsFlags_GcFlags_initialStkSize(__ptr__) REP_RtsFlags_GcFlags_initialStkSize[__ptr__+OFFSET_RtsFlags_GcFlags_initialStkSize] +#define OFFSET_RtsFlags_MiscFlags_tickInterval 192 +#define REP_RtsFlags_MiscFlags_tickInterval b64 +#define RtsFlags_MiscFlags_tickInterval(__ptr__) REP_RtsFlags_MiscFlags_tickInterval[__ptr__+OFFSET_RtsFlags_MiscFlags_tickInterval] +#define SIZEOF_StgFunInfoExtraFwd 32 +#define OFFSET_StgFunInfoExtraFwd_slow_apply 24 +#define REP_StgFunInfoExtraFwd_slow_apply b64 +#define StgFunInfoExtraFwd_slow_apply(__ptr__) REP_StgFunInfoExtraFwd_slow_apply[__ptr__+OFFSET_StgFunInfoExtraFwd_slow_apply] +#define OFFSET_StgFunInfoExtraFwd_fun_type 0 +#define REP_StgFunInfoExtraFwd_fun_type b32 +#define StgFunInfoExtraFwd_fun_type(__ptr__) REP_StgFunInfoExtraFwd_fun_type[__ptr__+OFFSET_StgFunInfoExtraFwd_fun_type] +#define OFFSET_StgFunInfoExtraFwd_arity 4 +#define REP_StgFunInfoExtraFwd_arity b32 +#define StgFunInfoExtraFwd_arity(__ptr__) REP_StgFunInfoExtraFwd_arity[__ptr__+OFFSET_StgFunInfoExtraFwd_arity] +#define OFFSET_StgFunInfoExtraFwd_bitmap 16 +#define REP_StgFunInfoExtraFwd_bitmap b64 +#define StgFunInfoExtraFwd_bitmap(__ptr__) REP_StgFunInfoExtraFwd_bitmap[__ptr__+OFFSET_StgFunInfoExtraFwd_bitmap] +#define SIZEOF_StgFunInfoExtraRev 24 +#define OFFSET_StgFunInfoExtraRev_slow_apply_offset 0 +#define REP_StgFunInfoExtraRev_slow_apply_offset b32 +#define StgFunInfoExtraRev_slow_apply_offset(__ptr__) REP_StgFunInfoExtraRev_slow_apply_offset[__ptr__+OFFSET_StgFunInfoExtraRev_slow_apply_offset] +#define OFFSET_StgFunInfoExtraRev_fun_type 16 +#define REP_StgFunInfoExtraRev_fun_type b32 +#define StgFunInfoExtraRev_fun_type(__ptr__) REP_StgFunInfoExtraRev_fun_type[__ptr__+OFFSET_StgFunInfoExtraRev_fun_type] +#define OFFSET_StgFunInfoExtraRev_arity 20 +#define REP_StgFunInfoExtraRev_arity b32 +#define StgFunInfoExtraRev_arity(__ptr__) REP_StgFunInfoExtraRev_arity[__ptr__+OFFSET_StgFunInfoExtraRev_arity] +#define OFFSET_StgFunInfoExtraRev_bitmap 8 +#define REP_StgFunInfoExtraRev_bitmap b64 +#define StgFunInfoExtraRev_bitmap(__ptr__) REP_StgFunInfoExtraRev_bitmap[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap] +#define OFFSET_StgFunInfoExtraRev_bitmap_offset 8 +#define REP_StgFunInfoExtraRev_bitmap_offset b32 +#define StgFunInfoExtraRev_bitmap_offset(__ptr__) REP_StgFunInfoExtraRev_bitmap_offset[__ptr__+OFFSET_StgFunInfoExtraRev_bitmap_offset] +#define OFFSET_StgLargeBitmap_size 0 +#define REP_StgLargeBitmap_size b64 +#define StgLargeBitmap_size(__ptr__) REP_StgLargeBitmap_size[__ptr__+OFFSET_StgLargeBitmap_size] +#define OFFSET_StgLargeBitmap_bitmap 8 +#define SIZEOF_snEntry 24 +#define OFFSET_snEntry_sn_obj 16 +#define REP_snEntry_sn_obj b64 +#define snEntry_sn_obj(__ptr__) REP_snEntry_sn_obj[__ptr__+OFFSET_snEntry_sn_obj] +#define OFFSET_snEntry_addr 0 +#define REP_snEntry_addr b64 +#define snEntry_addr(__ptr__) REP_snEntry_addr[__ptr__+OFFSET_snEntry_addr] +#define SIZEOF_spEntry 8 +#define OFFSET_spEntry_addr 0 +#define REP_spEntry_addr b64 +#define spEntry_addr(__ptr__) REP_spEntry_addr[__ptr__+OFFSET_spEntry_addr] diff --git a/ghc-lib/stage0/lib/ghcautoconf.h b/ghc-lib/stage0/lib/ghcautoconf.h --- a/ghc-lib/stage0/lib/ghcautoconf.h +++ b/ghc-lib/stage0/lib/ghcautoconf.h @@ -75,12 +75,7 @@ /* Define to 1 if __thread is supported */ #define CC_SUPPORTS_TLS 1 -/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP - systems. This function is required for `alloca.c' support on those systems. - */ -/* #undef CRAY_STACKSEG_END */ - -/* Define to 1 if using `alloca.c'. */ +/* Define to 1 if using 'alloca.c'. */ /* #undef C_ALLOCA */ /* Define to 1 if your processor stores words of floats with the most @@ -90,11 +85,10 @@ /* Has visibility hidden */ #define HAS_VISIBILITY_HIDDEN 1 -/* Define to 1 if you have `alloca', as a function or macro. */ +/* Define to 1 if you have 'alloca', as a function or macro. */ #define HAVE_ALLOCA 1 -/* Define to 1 if you have and it should be used (not on Ultrix). - */ +/* Define to 1 if works. */ #define HAVE_ALLOCA_H 1 /* Define to 1 if you have the header file. */ @@ -203,12 +197,12 @@ /* Define to 1 if the system has the type `long long'. */ #define HAVE_LONG_LONG 1 -/* Define to 1 if you have the header file. */ -#define HAVE_MEMORY_H 1 - /* Define to 1 if you have the mingwex library. */ /* #undef HAVE_MINGWEX */ +/* Define to 1 if you have the header file. */ +/* #undef HAVE_MINIX_CONFIG_H */ + /* Define to 1 if you have the header file. */ #define HAVE_NLIST_H 1 @@ -224,9 +218,18 @@ /* Define to 1 if you have the header file. */ #define HAVE_PTHREAD_H 1 +/* Define to 1 if you have the header file. */ +/* #undef HAVE_PTHREAD_NP_H */ + /* Define to 1 if you have the glibc version of pthread_setname_np */ /* #undef HAVE_PTHREAD_SETNAME_NP */ +/* Define to 1 if you have the Darwin version of pthread_setname_np */ +#define HAVE_PTHREAD_SETNAME_NP_DARWIN 1 + +/* Define to 1 if you have pthread_set_name_np */ +/* #undef HAVE_PTHREAD_SET_NAME_NP */ + /* Define to 1 if you have the header file. */ #define HAVE_PWD_H 1 @@ -251,6 +254,9 @@ /* Define to 1 if you have the header file. */ #define HAVE_STDINT_H 1 +/* Define to 1 if you have the header file. */ +#define HAVE_STDIO_H 1 + /* Define to 1 if you have the header file. */ #define HAVE_STDLIB_H 1 @@ -335,6 +341,9 @@ /* Define to 1 if you have the header file. */ /* #undef HAVE_VFORK_H */ +/* Define to 1 if you have the header file. */ +#define HAVE_WCHAR_H 1 + /* Define to 1 if you have the header file. */ /* #undef HAVE_WINDOWS_H */ @@ -449,13 +458,16 @@ STACK_DIRECTION = 0 => direction of growth unknown */ /* #undef STACK_DIRECTION */ -/* Define to 1 if you have the ANSI C header files. */ +/* Define to 1 if all of the C90 standard headers exist (not just the ones + required in a freestanding environment). This macro is provided for + backward compatibility; new code need not use it. */ #define STDC_HEADERS 1 /* Define to 1 if info tables are layed out next to code */ #define TABLES_NEXT_TO_CODE 1 -/* Define to 1 if you can safely include both and . */ +/* Define to 1 if you can safely include both and . This + macro is obsolete. */ #define TIME_WITH_SYS_TIME 1 /* Enable single heap address space support */ @@ -468,21 +480,87 @@ #ifndef _ALL_SOURCE # define _ALL_SOURCE 1 #endif +/* Enable general extensions on macOS. */ +#ifndef _DARWIN_C_SOURCE +# define _DARWIN_C_SOURCE 1 +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# define __EXTENSIONS__ 1 +#endif /* Enable GNU extensions on systems that have them. */ #ifndef _GNU_SOURCE # define _GNU_SOURCE 1 #endif -/* Enable threading extensions on Solaris. */ +/* Enable X/Open compliant socket functions that do not require linking + with -lxnet on HP-UX 11.11. */ +#ifndef _HPUX_ALT_XOPEN_SOCKET_API +# define _HPUX_ALT_XOPEN_SOCKET_API 1 +#endif +/* Identify the host operating system as Minix. + This macro does not affect the system headers' behavior. + A future release of Autoconf may stop defining this macro. */ +#ifndef _MINIX +/* # undef _MINIX */ +#endif +/* Enable general extensions on NetBSD. + Enable NetBSD compatibility extensions on Minix. */ +#ifndef _NETBSD_SOURCE +# define _NETBSD_SOURCE 1 +#endif +/* Enable OpenBSD compatibility extensions on NetBSD. + Oddly enough, this does nothing on OpenBSD. */ +#ifndef _OPENBSD_SOURCE +# define _OPENBSD_SOURCE 1 +#endif +/* Define to 1 if needed for POSIX-compatible behavior. */ +#ifndef _POSIX_SOURCE +/* # undef _POSIX_SOURCE */ +#endif +/* Define to 2 if needed for POSIX-compatible behavior. */ +#ifndef _POSIX_1_SOURCE +/* # undef _POSIX_1_SOURCE */ +#endif +/* Enable POSIX-compatible threading on Solaris. */ #ifndef _POSIX_PTHREAD_SEMANTICS # define _POSIX_PTHREAD_SEMANTICS 1 #endif +/* Enable extensions specified by ISO/IEC TS 18661-5:2014. */ +#ifndef __STDC_WANT_IEC_60559_ATTRIBS_EXT__ +# define __STDC_WANT_IEC_60559_ATTRIBS_EXT__ 1 +#endif +/* Enable extensions specified by ISO/IEC TS 18661-1:2014. */ +#ifndef __STDC_WANT_IEC_60559_BFP_EXT__ +# define __STDC_WANT_IEC_60559_BFP_EXT__ 1 +#endif +/* Enable extensions specified by ISO/IEC TS 18661-2:2015. */ +#ifndef __STDC_WANT_IEC_60559_DFP_EXT__ +# define __STDC_WANT_IEC_60559_DFP_EXT__ 1 +#endif +/* Enable extensions specified by ISO/IEC TS 18661-4:2015. */ +#ifndef __STDC_WANT_IEC_60559_FUNCS_EXT__ +# define __STDC_WANT_IEC_60559_FUNCS_EXT__ 1 +#endif +/* Enable extensions specified by ISO/IEC TS 18661-3:2015. */ +#ifndef __STDC_WANT_IEC_60559_TYPES_EXT__ +# define __STDC_WANT_IEC_60559_TYPES_EXT__ 1 +#endif +/* Enable extensions specified by ISO/IEC TR 24731-2:2010. */ +#ifndef __STDC_WANT_LIB_EXT2__ +# define __STDC_WANT_LIB_EXT2__ 1 +#endif +/* Enable extensions specified by ISO/IEC 24747:2009. */ +#ifndef __STDC_WANT_MATH_SPEC_FUNCS__ +# define __STDC_WANT_MATH_SPEC_FUNCS__ 1 +#endif /* Enable extensions on HP NonStop. */ #ifndef _TANDEM_SOURCE # define _TANDEM_SOURCE 1 #endif -/* Enable general extensions on Solaris. */ -#ifndef __EXTENSIONS__ -# define __EXTENSIONS__ 1 +/* Enable X/Open extensions. Define to 500 only if necessary + to make mbstate_t available. */ +#ifndef _XOPEN_SOURCE +/* # undef _XOPEN_SOURCE */ #endif @@ -501,27 +579,12 @@ # endif #endif -/* Enable large inode numbers on Mac OS X 10.5. */ -#ifndef _DARWIN_USE_64_BIT_INODE -# define _DARWIN_USE_64_BIT_INODE 1 -#endif - /* Number of bits in a file offset, on hosts where this is settable. */ /* #undef _FILE_OFFSET_BITS */ /* Define for large files, on AIX-style hosts. */ /* #undef _LARGE_FILES */ -/* Define to 1 if on MINIX. */ -/* #undef _MINIX */ - -/* Define to 2 if the system does not provide POSIX.1 features except with - this defined. */ -/* #undef _POSIX_1_SOURCE */ - -/* Define to 1 if you need to in order for `stat' and other things to work. */ -/* #undef _POSIX_SOURCE */ - /* ARM pre v6 */ /* #undef arm_HOST_ARCH_PRE_ARMv6 */ @@ -531,11 +594,14 @@ /* Define to empty if `const' does not conform to ANSI C. */ /* #undef const */ -/* Define to `int' if does not define. */ +/* Define as a signed integer type capable of holding a process identifier. */ /* #undef pid_t */ -/* The supported LLVM version number */ -#define sUPPORTED_LLVM_VERSION (9) +/* The maximum supported LLVM version number */ +#define sUPPORTED_LLVM_VERSION_MAX (12) + +/* The minimum supported LLVM version number */ +#define sUPPORTED_LLVM_VERSION_MIN (10) /* Define to `unsigned int' if does not define. */ /* #undef size_t */ diff --git a/ghc-lib/stage0/lib/ghcversion.h b/ghc-lib/stage0/lib/ghcversion.h deleted file mode 100644 --- a/ghc-lib/stage0/lib/ghcversion.h +++ /dev/null @@ -1,18 +0,0 @@ -#if !defined(__GHCVERSION_H__) -#define __GHCVERSION_H__ - -#if !defined(__GLASGOW_HASKELL__) -# define __GLASGOW_HASKELL__ 810 -#endif - -#define __GLASGOW_HASKELL_PATCHLEVEL1__ 4 - -#define MIN_VERSION_GLASGOW_HASKELL(ma,mi,pl1,pl2) (\ - ((ma)*100+(mi)) < __GLASGOW_HASKELL__ || \ - ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \ - && (pl1) < __GLASGOW_HASKELL_PATCHLEVEL1__ || \ - ((ma)*100+(mi)) == __GLASGOW_HASKELL__ \ - && (pl1) == __GLASGOW_HASKELL_PATCHLEVEL1__ \ - && (pl2) <= __GLASGOW_HASKELL_PATCHLEVEL2__ ) - -#endif /* __GHCVERSION_H__ */ diff --git a/ghc-lib/stage0/lib/llvm-targets b/ghc-lib/stage0/lib/llvm-targets --- a/ghc-lib/stage0/lib/llvm-targets +++ b/ghc-lib/stage0/lib/llvm-targets @@ -1,6 +1,6 @@ -[("i386-unknown-windows", ("e-m:x-p:32:32-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", "")) -,("i686-unknown-windows", ("e-m:x-p:32:32-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", "")) -,("x86_64-unknown-windows", ("e-m:w-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +[("i386-unknown-windows", ("e-m:x-p:32:32-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", "")) +,("i686-unknown-windows", ("e-m:x-p:32:32-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:32-n8:16:32-a:0:32-S32", "pentium4", "")) +,("x86_64-unknown-windows", ("e-m:w-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("arm-unknown-linux-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("arm-unknown-linux-musleabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("armv6-unknown-linux-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1136jf-s", "+strict-align")) @@ -20,28 +20,30 @@ ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux-musl", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) -,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) -,("i386-unknown-linux-musl", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) -,("i386-unknown-linux", ("e-m:e-p:32:32-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) -,("x86_64-unknown-linux-gnu", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) -,("x86_64-unknown-linux-musl", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) -,("x86_64-unknown-linux", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) -,("x86_64-unknown-linux-android", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "+sse4.2 +popcnt +cx16")) -,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+fpregs +vfp2 +vfp2d16 +vfp2d16sp +vfp2sp +vfp3 +vfp3d16 +vfp3d16sp +vfp3sp -fp16 -vfp4 -vfp4d16 -vfp4d16sp -vfp4sp -fp-armv8 -fp-armv8d16 -fp-armv8d16sp -fp-armv8sp -fullfp16 +fp64 +d32 +neon -crypto -fp16fml")) +,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) +,("i386-unknown-linux-musl", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) +,("i386-unknown-linux", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) +,("x86_64-unknown-linux-gnu", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux-musl", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-linux-android", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "+sse4.2 +popcnt +cx16")) +,("armv7-unknown-linux-androideabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+vfp2 +vfp2sp +vfp3 +vfp3d16 +vfp3d16sp +vfp3sp -fp16 -vfp4 -vfp4d16 -vfp4d16sp -vfp4sp -fp-armv8 -fp-armv8d16 -fp-armv8d16sp -fp-armv8sp -fullfp16 +fp64 +d32 +neon -crypto -fp16fml")) ,("aarch64-unknown-linux-android", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) -,("armv7a-unknown-linux-androideabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+fpregs +vfp2 +vfp2d16 +vfp2d16sp +vfp2sp +vfp3 +vfp3d16 +vfp3d16sp +vfp3sp -fp16 -vfp4 -vfp4d16 -vfp4d16sp -vfp4sp -fp-armv8 -fp-armv8d16 -fp-armv8d16sp -fp-armv8sp -fullfp16 +fp64 +d32 +neon -crypto -fp16fml")) +,("armv7a-unknown-linux-androideabi", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+vfp2 +vfp2sp +vfp3 +vfp3d16 +vfp3d16sp +vfp3sp -fp16 -vfp4 -vfp4d16 -vfp4d16sp -vfp4sp -fp-armv8 -fp-armv8d16 -fp-armv8d16sp -fp-armv8sp -fullfp16 +fp64 +d32 +neon -crypto -fp16fml")) ,("powerpc64le-unknown-linux-gnu", ("e-m:e-i64:64-n32:64", "ppc64le", "")) ,("powerpc64le-unknown-linux-musl", ("e-m:e-i64:64-n32:64", "ppc64le", "+secure-plt")) ,("powerpc64le-unknown-linux", ("e-m:e-i64:64-n32:64", "ppc64le", "")) ,("s390x-ibm-linux", ("E-m:e-i1:8:16-i8:8:16-i64:64-f128:64-a:8:16-n32:64", "z10", "")) -,("i386-apple-darwin", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) -,("x86_64-apple-darwin", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) -,("armv7-apple-ios", ("e-m:o-p:32:32-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32", "generic", "")) -,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "generic", "+neon")) -,("i386-apple-ios", ("e-m:o-p:32:32-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) -,("x86_64-apple-ios", ("e-m:o-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) -,("amd64-portbld-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) -,("x86_64-unknown-freebsd", ("e-m:e-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("i386-apple-darwin", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) +,("x86_64-apple-darwin", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) +,("arm64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes")) +,("aarch64-apple-darwin", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes")) +,("armv7-apple-ios", ("e-m:o-p:32:32-Fi8-f64:32:64-v64:32:64-v128:32:128-a:0:32-n32-S32", "generic", "")) +,("aarch64-apple-ios", ("e-m:o-i64:64-i128:128-n32:64-S128", "apple-a7", "+fp-armv8 +neon +crypto +zcm +zcz +sha2 +aes")) +,("i386-apple-ios", ("e-m:o-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:128-n8:16:32-S128", "yonah", "")) +,("x86_64-apple-ios", ("e-m:o-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "core2", "")) +,("amd64-portbld-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) +,("x86_64-unknown-freebsd", ("e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128", "x86-64", "")) ,("aarch64-unknown-freebsd", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("armv6-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "arm1176jzf-s", "+strict-align")) ,("armv7-unknown-freebsd-gnueabihf", ("e-m:e-p:32:32-Fi8-i64:64-v128:64:128-a:0:32-n32-S64", "generic", "+strict-align")) diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs --- a/includes/CodeGen.Platform.hs +++ b/includes/CodeGen.Platform.hs @@ -94,7 +94,7 @@ # define zmm14 30 # define zmm15 31 --- Note: these are only needed for ARM/ARM64 because globalRegMaybe is now used in CmmSink.hs. +-- Note: these are only needed for ARM/AArch64 because globalRegMaybe is now used in CmmSink.hs. -- Since it's only used to check 'isJust', the actual values don't matter, thus -- I'm not sure if these are the correct numberings. -- Normally, the register names are just stringified as part of the REG() macro @@ -1096,4 +1096,3 @@ freeReg = panic "freeReg not defined for this platform" #endif - diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc --- a/libraries/ghci/GHCi/InfoTable.hsc +++ b/libraries/ghci/GHCi/InfoTable.hsc @@ -73,7 +73,7 @@ | ArchX86_64 | ArchAlpha | ArchARM - | ArchARM64 + | ArchAArch64 | ArchPPC64 | ArchPPC64LE | ArchS390X @@ -95,7 +95,7 @@ #elif defined(arm_HOST_ARCH) ArchARM #elif defined(aarch64_HOST_ARCH) - ArchARM64 + ArchAArch64 #elif defined(powerpc64_HOST_ARCH) ArchPPC64 #elif defined(powerpc64le_HOST_ARCH) @@ -211,7 +211,7 @@ , 0x11, 0xff, 0x2f, 0xe1 , byte0 w32, byte1 w32, byte2 w32, byte3 w32] - ArchARM64 { } -> + ArchAArch64 { } -> -- Generates: -- -- ldr x1, label @@ -360,7 +360,11 @@ -- Note: Must return proper pointer for use in a closure newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ()) newExecConItbl obj con_desc +#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) + = do +#else = alloca $ \pcode -> do +#endif let lcon_desc = BS.length con_desc + 1{- null terminator -} -- SCARY -- This size represents the number of bytes in an StgConInfoTable. @@ -369,8 +373,13 @@ -- table, because on a 64-bit platform we reference this string -- with a 32-bit offset relative to the info table, so if we -- allocated the string separately it might be out of range. +#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) + wr_ptr <- _allocateWrite (sz + fromIntegral lcon_desc) + let ex_ptr = wr_ptr +#else wr_ptr <- _allocateExec (sz + fromIntegral lcon_desc) pcode ex_ptr <- peek pcode +#endif let cinfo = StgConInfoTable { conDesc = ex_ptr `plusPtr` fromIntegral sz , infoTable = obj } pokeConItbl wr_ptr ex_ptr cinfo @@ -379,6 +388,9 @@ let null_off = fromIntegral sz + fromIntegral (BS.length con_desc) poke (castPtr wr_ptr `plusPtr` null_off) (0 :: Word8) _flushExec sz ex_ptr -- Cache flush (if needed) +#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) + _markExec (sz + fromIntegral lcon_desc) ex_ptr +#endif #if defined(TABLES_NEXT_TO_CODE) return (castPtrToFunPtr (ex_ptr `plusPtr` conInfoTableSizeB)) #else @@ -391,6 +403,12 @@ foreign import ccall unsafe "flushExec" _flushExec :: CUInt -> Ptr a -> IO () +#if RTS_LINKER_USE_MMAP && MIN_VERSION_rts(1,0,1) +foreign import ccall unsafe "allocateWrite" + _allocateWrite :: CUInt -> IO (Ptr a) +foreign import ccall unsafe "markExec" + _markExec :: CUInt -> Ptr a -> IO () +#endif -- ----------------------------------------------------------------------------- -- Constants and config