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 OldCmm
  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 :: (Section, [CmmStatic]) -> LlvmUnresData
  41 genLlvmData (sec, 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, sec, alias, static)
  52
  53 genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
  54
  55
  56 resolveLlvmDatas ::  LlvmEnv -> [LlvmUnresData] -> [LlvmData]
  57                  -> (LlvmEnv, [LlvmData])
  58 resolveLlvmDatas env [] ldata
  59   = (env, ldata)
  60
  61 resolveLlvmDatas env (udata : rest) ldata
  62   = let (env', ndata) = resolveLlvmData env udata
  63     in resolveLlvmDatas env' rest (ldata ++ [ndata])
  64
  65 -- | Fix up CLabel references now that we should have passed all CmmData.
  66 resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
  67 resolveLlvmData env (lbl, sec, 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         const          = isSecConstant sec
  75         glob           = LMGlobalVar label alias link Nothing Nothing const
  76     in (env', (refs' ++ [(glob, struct)], [alias]))
  77
  78
  79 -- | Should a data in this section be considered constant
  80 isSecConstant :: Section -> Bool
  81 isSecConstant Text                    = True
  82 isSecConstant Data                    = False
  83 isSecConstant ReadOnlyData            = True
  84 isSecConstant RelocatableReadOnlyData = True
  85 isSecConstant UninitialisedData       = False
  86 isSecConstant ReadOnlyData16          = True
  87 isSecConstant (OtherSection _)        = False
  88
  89
  90 -- ----------------------------------------------------------------------------
  91 -- ** Resolve Data/CLabel references
  92 --
  93
  94 -- | Resolve data list
  95 resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
  96          -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
  97
  98 resDatas env [] (stat, glob)
  99   = (env, stat, glob)
 100
 101 resDatas env (cmm : rest) (stats, globs)
 102   = let (env', nstat, nglob) = resData env cmm
 103     in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
 104
 105 -- | Resolve an individual static label if it needs to be.
 106 --
 107 -- We check the 'LlvmEnv' to see if the reference has been defined in this
 108 -- module. If it has we can retrieve its type and make a pointer, otherwise
 109 -- we introduce a generic external definition for the referenced label and
 110 -- then make a pointer.
 111 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
 112
 113 resData env (Right stat) = (env, stat, [Nothing])
 114
 115 resData env (Left cmm@(CmmLabel l)) =
 116     let label = strCLabel_llvm l
 117         ty = funLookup label env
 118         lmty = cmmToLlvmType $ cmmLitType cmm
 119     in case ty of
 120             -- Make generic external label defenition and then pointer to it
 121             Nothing ->
 122                 let glob@(var, _) = genStringLabelRef label
 123                     env' =  funInsert label (pLower $ getVarType var) env
 124                     ptr  = LMStaticPointer var
 125                 in  (env', LMPtoI ptr lmty, [Just glob])
 126             -- Referenced data exists in this module, retrieve type and make
 127             -- pointer to it.
 128             Just ty' ->
 129                 let var = LMGlobalVar label (LMPointer ty')
 130                             ExternallyVisible Nothing Nothing False
 131                     ptr  = LMStaticPointer var
 132                 in (env, LMPtoI ptr lmty, [Nothing])
 133
 134 resData env (Left (CmmLabelOff label off)) =
 135     let (env', var, glob) = resData env (Left (CmmLabel label))
 136         offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
 137     in (env', LMAdd var offset, glob)
 138
 139 resData env (Left (CmmLabelDiffOff l1 l2 off)) =
 140     let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
 141         (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
 142         var = LMSub var1 var2
 143         offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
 144     in (env2, LMAdd var offset, glob1 ++ glob2)
 145
 146 resData _ _ = panic "resData: Non CLabel expr as left type!"
 147
 148 -- ----------------------------------------------------------------------------
 149 -- * Generate static data
 150 --
 151
 152 -- | Handle static data
 153 -- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
 154 genData :: CmmStatic -> UnresStatic
 155
 156 genData (CmmString str) =
 157     let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
 158         ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
 159     in Right $ LMStaticArray ve (LMArray (length ve) i8)
 160
 161 genData (CmmUninitialised bytes)
 162     = Right $ LMUninitType (LMArray bytes i8)
 163
 164 genData (CmmStaticLit lit)
 165     = genStaticLit lit
 166
 167 genData (CmmAlign _)
 168     = panic "genData: Can't handle CmmAlign!"
 169
 170 genData (CmmDataLabel _)
 171     = panic "genData: Can't handle data labels not at top of data!"
 172
 173
 174 -- | Generate Llvm code for a static literal.
 175 --
 176 -- Will either generate the code or leave it unresolved if it is a 'CLabel'
 177 -- which isn't yet known.
 178 genStaticLit :: CmmLit -> UnresStatic
 179 genStaticLit (CmmInt i w)
 180     = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 181
 182 genStaticLit (CmmFloat r w)
 183     = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
 184
 185 -- Leave unresolved, will fix later
 186 genStaticLit c@(CmmLabel        _    ) = Left $ c
 187 genStaticLit c@(CmmLabelOff     _   _) = Left $ c
 188 genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
 189
 190 genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
 191
 192 genStaticLit (CmmHighStackMark)
 193     = panic "genStaticLit: CmmHighStackMark unsupported!"
 194
 195
 196 -- -----------------------------------------------------------------------------
 197 -- * Misc
 198 --
 199
 200 -- | Error Function
 201 panic :: String -> a
 202 panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
 203