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