Add -falignment-sanitization flag
authorBen Gamari <bgamari.foss@gmail.com>
Mon, 30 Oct 2017 00:46:45 +0000 (20:46 -0400)
committerBen Gamari <ben@smart-cactus.org>
Mon, 30 Oct 2017 00:47:05 +0000 (20:47 -0400)
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

compiler/cmm/CLabel.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmMachOp.hs
compiler/cmm/PprC.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/main/DynFlags.hs
compiler/nativeGen/X86/CodeGen.hs
docs/users_guide/debugging.rst
rts/RtsMessages.c
rts/RtsSymbols.c
rts/StgStartup.cmm

index 9c664c2..a2a2063 100644 (file)
@@ -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,
index 6d3e11c..4eb045a 100644 (file)
@@ -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)
index febb315..fba57be 100644 (file)
@@ -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
 -----------------------------------------------------------------------------
index e59a3ad..0fcadc2 100644 (file)
@@ -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
index 584d90c..300ebb9 100644 (file)
@@ -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
index 1b1837f..56fdc43 100644 (file)
@@ -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,
index 029b8e8..d6ef6d3 100644 (file)
@@ -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
index 4dbec3e..4e071a2 100644 (file)
@@ -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.
index ba1f02d..d976760 100644 (file)
@@ -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.");
+}
index 1ac143b..ff15d77 100644 (file)
       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)                         \
index 0cd1862..f673730 100644 (file)
@@ -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();
+}