compiler/llvmGen/LlvmCodeGen/Data.hs

   1 -- ----------------------------------------------------------------------------
   2 -- | Handle conversion of CmmData to LLVM code.
   3 --
   4
   5 module LlvmCodeGen.Data (
   6         genLlvmData, resolveLlvmDatas, resolveLlvmData
   7     ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Llvm
  12 import LlvmCodeGen.Base
  13
  14 import BlockId
  15 import CLabel
  16 import Cmm
  17
  18 import DynFlags
  19 import FastString
  20 import qualified Outputable
  21
  22 import Data.Maybe
  23
  24
  25 -- ----------------------------------------------------------------------------
  26 -- * Constants
  27 --
  28
  29 -- | The string appended to a variable name to create its structure type alias
  30 structStr :: LMString
  31 structStr = fsLit "_struct"
  32
  33 -- ----------------------------------------------------------------------------
  34 -- * Top level
  35 --
  36
  37 -- | Pass a CmmStatic section to an equivalent Llvm code. Can't
  38 -- complete this completely though as we need to pass all CmmStatic
  39 -- sections before all references can be resolved. This last step is
  40 -- done by 'resolveLlvmData'.
  41 genLlvmData :: DynFlags -> (Section, [CmmStatic]) -> LlvmUnresData
  42 genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
  43     let static  = map genData xs
  44         label   = strCLabel_llvm lbl
  45
  46         types   = map getStatTypes static
  47         getStatTypes (Left  x) = cmmToLlvmType $ cmmLitType x
  48         getStatTypes (Right x) = getStatType x
  49
  50         strucTy = LMStruct types
  51         alias   = LMAlias (label `appendFS` structStr) strucTy
  52     in (lbl, alias, static)
  53
  54 genLlvmData _ _ = panic "genLlvmData: CmmData section doesn't start with label!"
  55
  56 resolveLlvmDatas :: DynFlags -> LlvmEnv -> [LlvmUnresData] -> [LlvmData]
  57                  -> (LlvmEnv, [LlvmData])
  58 resolveLlvmDatas _ env [] ldata
  59   = (env, ldata)
  60
  61 resolveLlvmDatas dflags env (udata : rest) ldata
  62   = let (env', ndata) = resolveLlvmData dflags env udata
  63     in resolveLlvmDatas dflags env' rest (ldata ++ [ndata])
  64
  65 -- | Fix up CLabel references now that we should have passed all CmmData.
  66 resolveLlvmData :: DynFlags -> LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
  67 resolveLlvmData _ env (lbl, alias, unres) =
  68     let (env', static, refs) = resDatas env unres ([], [])
  69         refs'          = catMaybes refs
  70         struct         = Just $ LMStaticStruc static alias
  71         label          = strCLabel_llvm lbl
  72         link           = if (externallyVisibleCLabel lbl)
  73                             then ExternallyVisible else Internal
  74         glob           = LMGlobalVar label alias link Nothing Nothing
  75     in (env', (refs' ++ [(glob, struct)], [alias]))
  76
  77
  78 -- ----------------------------------------------------------------------------
  79 -- ** Resolve Data/CLabel references
  80 --
  81
  82 -- | Resolve data list
  83 resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
  84          -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
  85
  86 resDatas env [] (stat, glob)
  87   = (env, stat, glob)
  88
  89 resDatas env (cmm : rest) (stats, globs)
  90   = let (env', nstat, nglob) = resData env cmm
  91     in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
  92
  93 -- | Resolve an individual static label if it needs to be.
  94 --
  95 -- We check the 'LlvmEnv' to see if the reference has been defined in this
  96 -- module. If it has we can retrieve its type and make a pointer, otherwise
  97 -- we introduce a generic external defenition for the referenced label and
  98 -- then make a pointer.
  99 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
 100
 101 resData env (Right stat) = (env, stat, [Nothing])
 102
 103 resData env (Left cmm@(CmmLabel l)) =
 104     let label = strCLabel_llvm l
 105         ty = funLookup label env
 106         lmty = cmmToLlvmType $ cmmLitType cmm
 107     in case ty of
 108             -- Make generic external label defenition and then pointer to it
 109             Nothing ->
 110                 let glob@(var, _) = genStringLabelRef label
 111                     env' =  funInsert label (pLower $ getVarType var) env
 112                     ptr  = LMStaticPointer var
 113                 in  (env', LMPtoI ptr lmty, [Just glob])
 114             -- Referenced data exists in this module, retrieve type and make
 115             -- pointer to it.
 116             Just ty' ->
 117                 let var = LMGlobalVar label (LMPointer ty')
 118                             ExternallyVisible Nothing Nothing
 119                     ptr  = LMStaticPointer var
 120                 in (env, LMPtoI ptr lmty, [Nothing])
 121
 122 resData env (Left (CmmLabelOff label off)) =
 123     let (env', var, glob) = resData env (Left (CmmLabel label))
 124         offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
 125     in (env', LMAdd var offset, glob)
 126
 127 resData env (Left (CmmLabelDiffOff l1 l2 off)) =
 128     let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
 129         (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
 130         var = LMSub var1 var2
 131         offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
 132     in (env2, LMAdd var offset, glob1 ++ glob2)
 133
 134 resData _ _ = panic "resData: Non CLabel expr as left type!"
 135
 136 -- ----------------------------------------------------------------------------
 137 -- * Generate static data
 138 --
 139
 140 -- | Handle static data
 141 -- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
 142 genData :: CmmStatic -> UnresStatic
 143
 144 genData (CmmString str) =
 145     let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
 146         ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
 147     in Right $ LMStaticArray ve (LMArray (length ve) i8)
 148
 149 genData (CmmUninitialised bytes)
 150     = Right $ LMUninitType (LMArray bytes i8)
 151
 152 genData (CmmStaticLit lit)
 153     = genStaticLit lit
 154
 155 genData (CmmAlign _)
 156     = panic "genData: Can't handle CmmAlign!"
 157
 158 genData (CmmDataLabel _)
 159     = panic "genData: Can't handle data labels not at top of data!"
 160
 161
 162 -- | Generate Llvm code for a static literal.
 163 --
 164 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
 165 -- which isn't yet known.
 166 genStaticLit :: CmmLit -> UnresStatic
 167 genStaticLit (CmmInt i w)
 168     = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 169
 170 genStaticLit (CmmFloat r w)
 171     = Right $ LMStaticLit (LMFloatLit r (widthToLlvmFloat w))
 172
 173 -- Leave unresolved, will fix later
 174 genStaticLit c@(CmmLabel        _    ) = Left $ c
 175 genStaticLit c@(CmmLabelOff     _   _) = Left $ c
 176 genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
 177
 178 genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
 179
 180 genStaticLit (CmmHighStackMark)
 181     = panic "genStaticLit: CmmHighStackMark unsupported!"
 182
 183
 184 -- -----------------------------------------------------------------------------
 185 -- * Misc
 186 --
 187
 188 -- | Error Function
 189 panic :: String -> a
 190 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
 191