Data.hs 6.27 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
-- ----------------------------------------------------------------------------
-- | Handle conversion of CmmData to LLVM code.
--

module LlvmCodeGen.Data (
        genLlvmData, resolveLlvmDatas, resolveLlvmData
    ) where

#include "HsVersions.h"

import Llvm
import LlvmCodeGen.Base

import BlockId
import CLabel
import Cmm

import DynFlags
import FastString
import qualified Outputable

import Data.Maybe


-- ----------------------------------------------------------------------------
-- * Constants
--

-- | The string appended to a variable name to create its structure type alias
structStr :: LMString
structStr = fsLit "_struct"

-- ----------------------------------------------------------------------------
-- * Top level
--

-- | Pass a CmmStatic section to an equivalent Llvm code. Can't
-- complete this completely though as we need to pass all CmmStatic
-- sections before all references can be resolved. This last step is
-- done by 'resolveLlvmData'.
genLlvmData :: DynFlags -> (Section, [CmmStatic]) -> LlvmUnresData
genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
    let static  = map genData xs
        label   = strCLabel_llvm lbl

        types   = map getStatTypes static
        getStatTypes (Left  x) = cmmToLlvmType $ cmmLitType x
        getStatTypes (Right x) = getStatType x

        strucTy = LMStruct types
        alias   = LMAlias (label `appendFS` structStr) strucTy
    in (lbl, alias, static)

genLlvmData _ _ = panic "genLlvmData: CmmData section doesn't start with label!"

resolveLlvmDatas :: DynFlags -> LlvmEnv -> [LlvmUnresData] -> [LlvmData]
                 -> (LlvmEnv, [LlvmData])
resolveLlvmDatas _ env [] ldata
  = (env, ldata)

resolveLlvmDatas dflags env (udata : rest) ldata
  = let (env', ndata) = resolveLlvmData dflags env udata
    in resolveLlvmDatas dflags env' rest (ldata ++ [ndata])

-- | Fix up CLabel references now that we should have passed all CmmData.
resolveLlvmData :: DynFlags -> LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
resolveLlvmData _ env (lbl, alias, unres) =
    let (env', static, refs) = resDatas env unres ([], [])
        refs'          = catMaybes refs
        struct         = Just $ LMStaticStruc static alias
        label          = strCLabel_llvm lbl
        link           = if (externallyVisibleCLabel lbl)
                            then ExternallyVisible else Internal
        glob           = LMGlobalVar label alias link
    in (env', (refs' ++ [(glob, struct)], [alias]))


-- ----------------------------------------------------------------------------
-- ** Resolve Data/CLabel references
--

-- | Resolve data list
resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
         -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])

resDatas env [] (stat, glob)
  = (env, stat, glob)

resDatas env (cmm : rest) (stats, globs)
  = let (env', nstat, nglob) = resData env cmm
    in resDatas env' rest (stats ++ [nstat], globs ++ nglob)

-- | Resolve an individual static label if it needs to be.
--
-- We check the 'LlvmEnv' to see if the reference has been defined in this
-- module. If it has we can retrieve its type and make a pointer, otherwise
-- we introduce a generic external defenition for the referenced label and
-- then make a pointer.
resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])

resData env (Right stat) = (env, stat, [Nothing])

resData env (Left cmm@(CmmLabel l)) =
    let label = strCLabel_llvm l
        ty = funLookup label env
        lmty = cmmToLlvmType $ cmmLitType cmm
    in case ty of
            -- Make generic external label defenition and then pointer to it
            Nothing ->
                let glob@(var, _) = genStringLabelRef label
                    env' =  funInsert label (pLower $ getVarType var) env
                    ptr  = LMStaticPointer var
                in  (env', LMPtoI ptr lmty, [Just glob])
            -- Referenced data exists in this module, retrieve type and make
            -- pointer to it.
            Just ty' ->
                let var = LMGlobalVar label (LMPointer ty') ExternallyVisible
                    ptr  = LMStaticPointer var
                in (env, LMPtoI ptr lmty, [Nothing])

resData env (Left (CmmLabelOff label off)) =
    let (env', var, glob) = resData env (Left (CmmLabel label))
        offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
    in (env', LMAdd var offset, glob)

resData env (Left (CmmLabelDiffOff l1 l2 off)) =
    let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
        (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
        var = LMSub var1 var2
        offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
    in (env2, LMAdd var offset, glob1 ++ glob2)

resData _ _ = panic "resData: Non CLabel expr as left type!"

-- ----------------------------------------------------------------------------
-- * Generate static data
--

-- | Handle static data
-- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
genData :: CmmStatic -> UnresStatic

genData (CmmString str) =
    let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
        ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
    in Right $ LMStaticArray ve (LMArray (length ve) i8)

genData (CmmUninitialised bytes)
    = Right $ LMUninitType (LMArray bytes i8)

genData (CmmStaticLit lit)
    = genStaticLit lit

genData (CmmAlign _)
    = panic "genData: Can't handle CmmAlign!"

genData (CmmDataLabel _)
    = panic "genData: Can't handle data labels not at top of data!"


-- | Generate Llvm code for a static literal.
--
-- Will either generate the code or leave it unresolved if it is a 'CLabel'
-- which isn't yet known.
genStaticLit :: CmmLit -> UnresStatic
genStaticLit (CmmInt i w)
    = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))

genStaticLit (CmmFloat r w)
    = Right $ LMStaticLit (LMFloatLit r (widthToLlvmFloat w))

-- Leave unresolved, will fix later
genStaticLit c@(CmmLabel        _    ) = Left $ c
genStaticLit c@(CmmLabelOff     _   _) = Left $ c
genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c

genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b

genStaticLit (CmmHighStackMark)
    = panic "genStaticLit: CmmHighStackMark unsupported!"


-- -----------------------------------------------------------------------------
-- * Misc
--

-- | Error Function
panic :: String -> a
panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s