Data.hs 4.84 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2 3 4 5 6
-- ----------------------------------------------------------------------------
-- | Handle conversion of CmmData to LLVM code.
--

module LlvmCodeGen.Data (
7
        genLlvmData, genData
8 9 10 11 12 13 14 15 16
    ) where

#include "HsVersions.h"

import Llvm
import LlvmCodeGen.Base

import BlockId
import CLabel
17
import Cmm
18
import DynFlags
19 20

import FastString
21
import Outputable
22 23 24 25 26 27 28 29 30 31 32 33 34

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

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

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

Peter Wortmann's avatar
Peter Wortmann committed
35 36 37 38 39
-- | Pass a CmmStatic section to an equivalent Llvm code.
genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
genLlvmData (sec, Statics lbl xs) = do
    label <- strCLabel_llvm lbl
    static <- mapM genData xs
40
    lmsec <- llvmSection sec
Peter Wortmann's avatar
Peter Wortmann committed
41
    let types   = map getStatType static
42 43

        strucTy = LMStruct types
44
        tyAlias = LMAlias ((label `appendFS` structStr), strucTy)
45

46
        struct         = Just $ LMStaticStruc static tyAlias
47 48
        link           = if (externallyVisibleCLabel lbl)
                            then ExternallyVisible else Internal
Peter Wortmann's avatar
Peter Wortmann committed
49
        const          = if isSecConstant sec then Constant else Global
50
        varDef         = LMGlobalVar label tyAlias link lmsec Nothing const
51
        globDef        = LMGlobal varDef struct
Peter Wortmann's avatar
Peter Wortmann committed
52

53
    return ([globDef], [tyAlias])
54

55 56
-- | Should a data in this section be considered constant
isSecConstant :: Section -> Bool
57 58 59 60 61
isSecConstant (Section t _) = case t of
    Text                    -> True
    ReadOnlyData            -> True
    RelocatableReadOnlyData -> True
    ReadOnlyData16          -> True
62
    CString                 -> True
63 64 65
    Data                    -> False
    UninitialisedData       -> False
    (OtherSection _)        -> False
66

67 68 69 70 71 72 73 74 75
-- | Format the section type part of a Cmm Section
llvmSectionType :: SectionType -> FastString
llvmSectionType t = case t of
    Text                    -> fsLit ".text"
    ReadOnlyData            -> fsLit ".rodata"
    RelocatableReadOnlyData -> fsLit ".data.rel.ro"
    ReadOnlyData16          -> fsLit ".rodata.cst16"
    Data                    -> fsLit ".data"
    UninitialisedData       -> fsLit ".bss"
76
    CString                 -> fsLit ".cstring"
77 78 79 80 81 82 83 84 85 86 87 88
    (OtherSection _)        -> panic "llvmSectionType: unknown section type"

-- | Format a Cmm Section into a LLVM section name
llvmSection :: Section -> LlvmM LMSection
llvmSection (Section t suffix) = do
  dflags <- getDynFlags
  let splitSect = gopt Opt_SplitSections dflags
  if not splitSect
  then return Nothing
  else do
    lmsuffix <- strCLabel_llvm suffix
    return (Just (concatFS [llvmSectionType t, fsLit ".", lmsuffix]))
89

90 91 92 93 94
-- ----------------------------------------------------------------------------
-- * Generate static data
--

-- | Handle static data
Peter Wortmann's avatar
Peter Wortmann committed
95
genData :: CmmStatic -> LlvmM LlvmStatic
96

Peter Wortmann's avatar
Peter Wortmann committed
97
genData (CmmString str) = do
98 99
    let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
        ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
Peter Wortmann's avatar
Peter Wortmann committed
100
    return $ LMStaticArray ve (LMArray (length ve) i8)
101 102

genData (CmmUninitialised bytes)
Peter Wortmann's avatar
Peter Wortmann committed
103
    = return $ LMUninitType (LMArray bytes i8)
104 105 106 107 108 109 110 111

genData (CmmStaticLit lit)
    = genStaticLit lit

-- | 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.
Peter Wortmann's avatar
Peter Wortmann committed
112
genStaticLit :: CmmLit -> LlvmM LlvmStatic
113
genStaticLit (CmmInt i w)
Peter Wortmann's avatar
Peter Wortmann committed
114
    = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
115 116

genStaticLit (CmmFloat r w)
Peter Wortmann's avatar
Peter Wortmann committed
117
    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
118

119
genStaticLit (CmmVec ls)
Peter Wortmann's avatar
Peter Wortmann committed
120 121
    = do sls <- mapM toLlvmLit ls
         return $ LMStaticLit (LMVectorLit sls)
122
  where
Peter Wortmann's avatar
Peter Wortmann committed
123 124 125 126 127 128
    toLlvmLit :: CmmLit -> LlvmM LlvmLit
    toLlvmLit lit = do
      slit <- genStaticLit lit
      case slit of
        LMStaticLit llvmLit -> return llvmLit
        _ -> panic "genStaticLit"
129

130
-- Leave unresolved, will fix later
Peter Wortmann's avatar
Peter Wortmann committed
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
genStaticLit cmm@(CmmLabel l) = do
    var <- getGlobalPtr =<< strCLabel_llvm l
    dflags <- getDynFlags
    let ptr = LMStaticPointer var
        lmty = cmmToLlvmType $ cmmLitType dflags cmm
    return $ LMPtoI ptr lmty

genStaticLit (CmmLabelOff label off) = do
    dflags <- getDynFlags
    var <- genStaticLit (CmmLabel label)
    let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
    return $ LMAdd var offset

genStaticLit (CmmLabelDiffOff l1 l2 off) = do
    dflags <- getDynFlags
    var1 <- genStaticLit (CmmLabel l1)
    var2 <- genStaticLit (CmmLabel l2)
    let var = LMSub var1 var2
        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
    return $ LMAdd var offset
151

Peter Wortmann's avatar
Peter Wortmann committed
152
genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
153 154 155

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