Use Type Based Alias Analysis (TBAA) in LLVM backend (#5567)
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Regs.hs
index ecce7a3..55b2e0d 100644 (file)
@@ -3,7 +3,8 @@
 --
 
 module LlvmCodeGen.Regs (
-        lmGlobalRegArg, lmGlobalRegVar, alwaysLive
+        lmGlobalRegArg, lmGlobalRegVar, alwaysLive,
+        stgTBAA, top, base, stack, heap, rx, tbaa, getTBAA
     ) where
 
 #include "HsVersions.h"
@@ -11,8 +12,8 @@ module LlvmCodeGen.Regs (
 import Llvm
 
 import CmmExpr
-import Outputable ( panic )
 import FastString
+import Outputable ( panic )
 
 -- | Get the LlvmVar function variable storing the real register
 lmGlobalRegVar :: GlobalReg -> LlvmVar
@@ -49,6 +50,8 @@ lmGlobalReg suf reg
         DoubleReg 2    -> doubleGlobal $ "D2" ++ suf
         _other         -> panic $ "LlvmCodeGen.Reg: GlobalReg (" ++ (show reg)
                                 ++ ") not supported!"
+        -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
+        -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
     where
         wordGlobal   name = LMNLocalVar (fsLit name) llvmWord
         ptrGlobal    name = LMNLocalVar (fsLit name) llvmWordPtr
@@ -59,3 +62,41 @@ lmGlobalReg suf reg
 alwaysLive :: [GlobalReg]
 alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]
 
+-- | STG Type Based Alias Analysis metadata
+stgTBAA :: [LlvmMeta]
+stgTBAA
+  = [ MetaUnamed topN   [MetaStr (fsLit "top")]
+    , MetaUnamed stackN [MetaStr (fsLit "stack"), MetaNode topN]
+    , MetaUnamed heapN  [MetaStr (fsLit "heap"),  MetaNode topN]
+    , MetaUnamed rxN    [MetaStr (fsLit "rx"),    MetaNode heapN]
+    , MetaUnamed baseN  [MetaStr (fsLit "base"),  MetaNode topN]
+    ]
+
+-- | Id values
+topN, stackN, heapN, rxN, baseN :: LlvmMetaUnamed
+topN   = LMMetaUnamed 0
+stackN = LMMetaUnamed 1
+heapN  = LMMetaUnamed 2
+rxN    = LMMetaUnamed 3
+baseN  = LMMetaUnamed 4
+
+-- | The various TBAA types
+top, heap, stack, rx, base :: MetaData
+top   = (tbaa, topN)
+heap  = (tbaa, heapN)
+stack = (tbaa, stackN)
+rx    = (tbaa, rxN)
+base  = (tbaa, baseN)
+
+-- | The TBAA metadata identifier
+tbaa :: LMString
+tbaa = fsLit "tbaa"
+
+-- | Get the correct TBAA metadata information for this register type
+getTBAA :: GlobalReg -> MetaData
+getTBAA BaseReg          = base
+getTBAA Sp               = stack
+getTBAA Hp               = heap
+getTBAA (VanillaReg _ _) = rx
+getTBAA _                = top
+