Commit cecd2f2d authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Add -falignment-sanitization flag

Here we add a flag to instruct the native code generator to add
alignment checks in all info table dereferences. This is helpful in
catching pointer tagging issues.

Thanks to @jrtc27 for uncovering the tagging issues on Sparc which
inspired this flag.

Test Plan: Validate

Reviewers: simonmar, austin, erikd

Reviewed By: simonmar

Subscribers: rwbarton, trofi, thomie, jrtc27

Differential Revision: https://phabricator.haskell.org/D4101
parent 3b784d44
......@@ -59,6 +59,7 @@ module CLabel (
mkSMAP_FROZEN_infoLabel,
mkSMAP_FROZEN0_infoLabel,
mkSMAP_DIRTY_infoLabel,
mkBadAlignmentLabel,
mkEMPTY_MVAR_infoLabel,
mkArrWords_infoLabel,
......@@ -495,7 +496,7 @@ mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel,
mkArrWords_infoLabel, mkSMAP_FROZEN_infoLabel, mkSMAP_FROZEN0_infoLabel,
mkSMAP_DIRTY_infoLabel :: CLabel
mkSMAP_DIRTY_infoLabel, mkBadAlignmentLabel :: CLabel
mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
mkSplitMarkerLabel = CmmLabel rtsUnitId (fsLit "__stg_split_marker") CmmCode
mkUpdInfoLabel = CmmLabel rtsUnitId (fsLit "stg_upd_frame") CmmInfo
......@@ -513,6 +514,7 @@ mkArrWords_infoLabel = CmmLabel rtsUnitId (fsLit "stg_ARR_WORDS")
mkSMAP_FROZEN_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN") CmmInfo
mkSMAP_FROZEN0_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_FROZEN0") CmmInfo
mkSMAP_DIRTY_infoLabel = CmmLabel rtsUnitId (fsLit "stg_SMALL_MUT_ARR_PTRS_DIRTY") CmmInfo
mkBadAlignmentLabel = CmmLabel rtsUnitId (fsLit "stg_badAlignment") CmmEntry
-----
mkCmmInfoLabel, mkCmmEntryLabel, mkCmmRetInfoLabel, mkCmmRetLabel,
......
......@@ -417,9 +417,19 @@ srtEscape dflags = toStgHalfWord dflags (-1)
--
-------------------------------------------------------------------------
-- | Wrap a 'CmmExpr' in an alignment check when @-falignment-sanitisation@ is
-- enabled.
wordAligned :: DynFlags -> CmmExpr -> CmmExpr
wordAligned dflags e
| gopt Opt_AlignmentSanitisation dflags
= CmmMachOp (MO_AlignmentCheck (wORD_SIZE dflags) (wordWidth dflags)) [e]
| otherwise
= e
closureInfoPtr :: DynFlags -> CmmExpr -> CmmExpr
-- Takes a closure pointer and returns the info table pointer
closureInfoPtr dflags e = CmmLoad e (bWord dflags)
closureInfoPtr dflags e =
CmmLoad (wordAligned dflags e) (bWord dflags)
entryCode :: DynFlags -> CmmExpr -> CmmExpr
-- Takes an info pointer (the first word of a closure)
......
......@@ -138,9 +138,12 @@ data MachOp
-- Floating point vector operations
| MO_VF_Add Length Width
| MO_VF_Sub Length Width
| MO_VF_Neg Length Width -- unary -
| MO_VF_Neg Length Width -- unary negation
| MO_VF_Mul Length Width
| MO_VF_Quot Length Width
-- Alignment check (for -falignment-sanitisation)
| MO_AlignmentCheck Int Width
deriving (Eq, Show)
pprMachOp :: MachOp -> SDoc
......@@ -419,6 +422,8 @@ machOpResultType dflags mop tys =
MO_VF_Mul l w -> cmmVec l (cmmFloat w)
MO_VF_Quot l w -> cmmVec l (cmmFloat w)
MO_VF_Neg l w -> cmmVec l (cmmFloat w)
MO_AlignmentCheck _ _ -> ty1
where
(ty1:_) = tys
......@@ -509,6 +514,8 @@ machOpArgReps dflags op =
MO_VF_Quot _ r -> [r,r]
MO_VF_Neg _ r -> [r]
MO_AlignmentCheck _ r -> [r]
-----------------------------------------------------------------------------
-- CallishMachOp
-----------------------------------------------------------------------------
......
......@@ -723,6 +723,8 @@ pprMachOp_for_C mop = case mop of
(panic $ "PprC.pprMachOp_for_C: MO_VF_Quot"
++ " should have been handled earlier!")
MO_AlignmentCheck {} -> panic "-falignment-santisation not supported by unregisterised backend"
signedOp :: MachOp -> Bool -- Argument type(s) are signed ints
signedOp (MO_S_Quot _) = True
signedOp (MO_S_Rem _) = True
......
......@@ -1139,6 +1139,8 @@ genMachOp _ op [x] = case op of
all0s = LMLitVar $ LMVectorLit (replicate len all0)
in negateVec vecty all0s LM_MO_FSub
MO_AlignmentCheck _ _ -> panic "-falignment-sanitisation is not supported by -fllvm"
-- Handle unsupported cases explicitly so we get a warning
-- of missing case when new MachOps added
MO_Add _ -> panicOp
......@@ -1388,6 +1390,8 @@ genMachOp_slow opt op [x, y] = case op of
MO_VF_Neg {} -> panicOp
MO_AlignmentCheck {} -> panicOp
where
binLlvmOp ty binOp = runExprData $ do
vx <- exprToVarW x
......
......@@ -473,6 +473,7 @@ data GeneralFlag
| Opt_CprAnal
| Opt_WorkerWrapper
| Opt_SolveConstantDicts
| Opt_AlignmentSanitisation
| Opt_CatchBottoms
-- Interface files
......@@ -3801,6 +3802,7 @@ fFlagsDeps = [
flagSpec "worker-wrapper" Opt_WorkerWrapper,
flagSpec "solve-constant-dicts" Opt_SolveConstantDicts,
flagSpec "catch-bottoms" Opt_CatchBottoms,
flagSpec "alignment-sanitisation" Opt_AlignmentSanitisation,
flagSpec "show-warning-groups" Opt_ShowWarnGroups,
flagSpec "hide-source-paths" Opt_HideSourcePaths,
flagSpec "show-hole-constraints" Opt_ShowHoleConstraints,
......
......@@ -502,6 +502,9 @@ getRegister' dflags is32Bit (CmmReg reg)
getRegister' dflags is32Bit (CmmRegOff r n)
= getRegister' dflags is32Bit $ mangleIndexTree dflags r n
getRegister' dflags is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e])
= addAlignmentCheck align <$> getRegister' dflags is32Bit e
-- for 32-bit architectuers, support some 64 -> 32 bit conversions:
-- TO_W_(x), TO_W_(x >> 32)
......@@ -1254,6 +1257,21 @@ isOperand is32Bit (CmmLit lit) = is32BitLit is32Bit lit
|| isSuitableFloatingPointLit lit
isOperand _ _ = False
-- | Given a 'Register', produce a new 'Register' with an instruction block
-- which will check the value for alignment. Used for @-falignment-sanitisation@.
addAlignmentCheck :: Int -> Register -> Register
addAlignmentCheck align reg =
case reg of
Fixed fmt reg code -> Fixed fmt reg (code `appOL` check fmt reg)
Any fmt f -> Any fmt (\reg -> f reg `appOL` check fmt reg)
where
check :: Format -> Reg -> InstrBlock
check fmt reg =
ASSERT(not $ isFloatFormat fmt)
toOL [ TEST fmt (OpImm $ ImmInt $ align-1) (OpReg reg)
, JXX_GBL NE $ ImmCLbl mkBadAlignmentLabel
]
memConstant :: Int -> CmmLit -> NatM Amode
memConstant align lit = do
lbl <- getNewLabelNat
......
......@@ -696,6 +696,13 @@ Checking for consistency
instead of ``undef`` in calls. This makes it easier to catch subtle
code generator and runtime system bugs (e.g. see :ghc-ticket:`11487`).
.. ghc-flag:: -falignment-sanitisation
:shortdesc: Compile with alignment checks for all info table dereferences.
:type: dynamic
Compile with alignment checks for all info table dereferences. This can be
useful when finding pointer tagging issues.
.. ghc-flag:: -fcatch-bottoms
:shortdesc: Insert ``error`` expressions after bottoming expressions; useful
when debugging the compiler.
......
......@@ -314,3 +314,13 @@ rtsDebugMsgFn(const char *s, va_list ap)
_setmode (_fileno(stderr), mode);
#endif
}
// Used in stg_badAlignment_entry defined in StgStartup.cmm.
void rtsBadAlignmentBarf(void) GNUC3_ATTRIBUTE(__noreturn__);
void
rtsBadAlignmentBarf()
{
barf("Encountered incorrectly aligned pointer. This can't be good.");
}
......@@ -870,6 +870,7 @@
SymI_HasProto(stg_waitWritezh) \
SymI_HasProto(stg_writeTVarzh) \
SymI_HasProto(stg_yieldzh) \
SymI_NeedsProto(stg_badAlignment_entry) \
SymI_NeedsProto(stg_interp_constr1_entry) \
SymI_NeedsProto(stg_interp_constr2_entry) \
SymI_NeedsProto(stg_interp_constr3_entry) \
......
......@@ -181,3 +181,9 @@ INFO_TABLE_RET(stg_forceIO, RET_SMALL, P_ info_ptr)
{
ENTER(ret);
}
/* Called when compiled with -falignment-sanitisation on alignment failure */
stg_badAlignment_entry
{
foreign "C" barf();
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment