Commit 720a87c7 authored by Peter Wortmann's avatar Peter Wortmann Committed by dterei

Extend globals to aliases

Also give them a proper constructor - getGlobalVar and getGlobalValue
map directly to the accessors.
parent 99d39221
......@@ -32,7 +32,8 @@ module Llvm (
-- * Variables and Type System
LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
LlvmAlias, LMGlobal, LMString, LMSection, LMAlign,
LlvmAlias, LMGlobal(..), LMString, LMSection, LMAlign,
LMConst(..),
-- ** Some basic types
i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
......@@ -42,7 +43,7 @@ module Llvm (
-- ** Operations on the type system.
isGlobal, getLitType, getVarType,
getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
getLink, getStatType, pVarLift, pVarLower,
pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
-- * Pretty Printing
......
......@@ -61,7 +61,7 @@ ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
-- | Print out a global mutable variable definition
ppLlvmGlobal :: LMGlobal -> SDoc
ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
let sect = case x of
Just x' -> text ", section" <+> doubleQuotes (ftext x')
Nothing -> empty
......@@ -74,12 +74,16 @@ ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
Just stat -> ppr stat
Nothing -> ppr (pLower $ getVarType var)
const' = if c then text "constant" else text "global"
-- Position of linkage is different for aliases.
const_link = case c of
Global -> ppr link <+> text "global"
Constant -> ppr link <+> text "constant"
Alias -> text "alias" <+> ppr link
in ppAssignment var $ ppr link <+> const' <+> rhs <> sect <> align
in ppAssignment var $ const_link <+> rhs <> sect <> align
$+$ newLine
ppLlvmGlobal (var, val) = sdocWithDynFlags $ \dflags ->
ppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \dflags ->
error $ "Non Global var ppr as global! "
++ showSDoc dflags (ppr var) ++ " " ++ showSDoc dflags (ppr val)
......
......@@ -27,7 +27,11 @@ import GHC.Float
--
-- | A global mutable variable. Maybe defined or external
type LMGlobal = (LlvmVar, Maybe LlvmStatic)
data LMGlobal = LMGlobal {
getGlobalVar :: LlvmVar, -- ^ Returns the variable of the 'LMGlobal'
getGlobalValue :: Maybe LlvmStatic -- ^ Return the value of the 'LMGlobal'
}
-- | A String in LLVM
type LMString = FastString
......@@ -86,7 +90,11 @@ ppParams varg p
-- | An LLVM section definition. If Nothing then let LLVM decide the section
type LMSection = Maybe LMString
type LMAlign = Maybe Int
type LMConst = Bool -- ^ is a variable constant or not
data LMConst = Global -- ^ Mutable global variable
| Constant -- ^ Constant global variable
| Alias -- ^ Alias of another variable
deriving (Eq)
-- | LLVM Variables
data LlvmVar
......@@ -239,14 +247,6 @@ getStatType (LMAdd t _) = getStatType t
getStatType (LMSub t _) = getStatType t
getStatType (LMComment _) = error "Can't call getStatType on LMComment!"
-- | Return the 'LlvmType' of the 'LMGlobal'
getGlobalType :: LMGlobal -> LlvmType
getGlobalType (v, _) = getVarType v
-- | Return the 'LlvmVar' part of a 'LMGlobal'
getGlobalVar :: LMGlobal -> LlvmVar
getGlobalVar (v, _) = v
-- | Return the 'LlvmLinkageType' for a 'LlvmVar'
getLink :: LlvmVar -> LlvmLinkageType
getLink (LMGlobalVar _ _ l _ _ _) = l
......@@ -634,7 +634,7 @@ instance Outputable LlvmLinkageType where
-- in Llvm.
ppr ExternallyVisible = empty
ppr External = text "external"
ppr Private = text "private"
-- -----------------------------------------------------------------------------
-- * LLVM Operations
......
......@@ -128,8 +128,9 @@ cmmProcLlvmGens dflags h _ _ [] _ ivars
cast x = LMBitc (LMStaticPointer (pVarLift x)) i8Ptr
ty = (LMArray (length ivars') i8Ptr)
usedArray = LMStaticArray (map cast ivars') ty
lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
(Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
lmUsedVar = LMGlobalVar (fsLit "llvm.used") ty Appending
(Just $ fsLit "llvm.metadata") Nothing Global
lmUsed = LMGlobal lmUsedVar (Just usedArray)
cmmProcLlvmGens dflags h us env ((CmmData _ _) : cmms) count ivars
= cmmProcLlvmGens dflags h us env cmms count ivars
......
......@@ -261,7 +261,7 @@ genCmmLabelRef env = genStringLabelRef (getDflags env) . strCLabel_llvm env
genStringLabelRef :: DynFlags -> LMString -> LMGlobal
genStringLabelRef dflags cl
= let ty = LMPointer $ LMArray 0 (llvmWord dflags)
in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
in LMGlobal (LMGlobalVar cl ty External Nothing Nothing Global) Nothing
-- ----------------------------------------------------------------------------
-- * Misc
......
......@@ -156,7 +156,7 @@ oldBarrier env = do
FixedArgs (tysToParams [i1, i1, i1, i1, i1]) (llvmFunAlign dflags)
let fty = LMFunction funSig
let fv = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing False
let fv = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing Global
let tops = case funLookup fname env of
Just _ -> []
Nothing -> [CmmData Data [([],[fty])]]
......@@ -417,14 +417,14 @@ getFunPtr env funTy targ = case targ of
Just ty'@(LMFunction sig) -> do
-- Function in module in right form
let fun = LMGlobalVar name ty' (funcLinkage sig)
Nothing Nothing False
Nothing Nothing Global
return (env, fun, nilOL, [])
Just ty' -> do
-- label in module but not function pointer, convert
let fty@(LMFunction sig) = funTy name
fun = LMGlobalVar name (pLift ty') (funcLinkage sig)
Nothing Nothing False
Nothing Nothing Global
(v1, s1) <- doExpr (pLift fty)
$ Cast LM_Bitcast fun (pLift fty)
return (env, v1, unitOL s1, [])
......@@ -433,7 +433,7 @@ getFunPtr env funTy targ = case targ of
-- label not in module, create external reference
let fty@(LMFunction sig) = funTy name
fun = LMGlobalVar name fty (funcLinkage sig)
Nothing Nothing False
Nothing Nothing Global
top = [CmmData Data [([],[fty])]]
env' = funInsert name fty env
return (env', fun, nilOL, top)
......@@ -1427,7 +1427,7 @@ genLit _ env cmm@(CmmLabel l)
in case ty of
-- Make generic external label definition and then pointer to it
Nothing -> do
let glob@(var, _) = genStringLabelRef dflags label
let glob@(LMGlobal var _) = genStringLabelRef dflags label
let ldata = [CmmData Data [([glob], [])]]
let env' = funInsert label (pLower $ getVarType var) env
(v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
......@@ -1437,7 +1437,7 @@ genLit _ env cmm@(CmmLabel l)
-- pointer to it.
Just ty' -> do
let var = LMGlobalVar label (LMPointer ty')
ExternallyVisible Nothing Nothing False
ExternallyVisible Nothing Nothing Global
(v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
return (env, v1, unitOL s1, [])
......@@ -1557,13 +1557,13 @@ getHsFunc env live lbl
in case ty of
-- Function in module in right form
Just ty'@(LMFunction sig) -> do
let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing False
let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing Global
return (env, fun, nilOL, [])
-- label in module but not function pointer, convert
Just ty' -> do
let fun = LMGlobalVar fn (pLift ty') ExternallyVisible
Nothing Nothing False
Nothing Nothing Global
(v1, s1) <- doExpr (pLift (llvmFunTy dflags live)) $
Cast LM_Bitcast fun (pLift (llvmFunTy dflags live))
return (env, v1, unitOL s1, [])
......@@ -1571,7 +1571,7 @@ getHsFunc env live lbl
-- label not in module, create external reference
Nothing -> do
let ty' = LMFunction $ llvmFunSig env live lbl ExternallyVisible
let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing False
let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing Global
let top = CmmData Data [([],[ty'])]
let env' = funInsert fn ty' env
return (env', fun, nilOL, [top])
......
......@@ -66,9 +66,9 @@ resolveLlvmData env (lbl, sec, alias, unres) =
label = strCLabel_llvm env lbl
link = if (externallyVisibleCLabel lbl)
then ExternallyVisible else Internal
const = isSecConstant sec
const = if isSecConstant sec then Constant else Global
glob = LMGlobalVar label alias link Nothing Nothing const
in (env', ((glob,struct):refs, [alias]))
in (env', ((LMGlobal glob struct):refs, [alias]))
-- | Should a data in this section be considered constant
isSecConstant :: Section -> Bool
......@@ -114,7 +114,7 @@ resData env (Left cmm@(CmmLabel l)) =
in case ty of
-- Make generic external label defenition and then pointer to it
Nothing ->
let glob@(var, _) = genStringLabelRef dflags label
let glob@(LMGlobal var _) = genStringLabelRef dflags label
env' = funInsert label (pLower $ getVarType var) env
ptr = LMStaticPointer var
in (env', LMPtoI ptr lmty, [glob])
......@@ -122,7 +122,7 @@ resData env (Left cmm@(CmmLabel l)) =
-- pointer to it.
Just ty' ->
let var = LMGlobalVar label (LMPointer ty')
ExternallyVisible Nothing Nothing False
ExternallyVisible Nothing Nothing Global
ptr = LMStaticPointer var
in (env, LMPtoI ptr lmty, [])
......
......@@ -75,8 +75,8 @@ moduleLayout = sdocWithPlatform $ \platform ->
-- | Pretty print LLVM data code
pprLlvmData :: LlvmData -> SDoc
pprLlvmData (globals, types) =
let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s)
tryConst g@(_, Nothing) = ppLlvmGlobal g
let tryConst (LMGlobal v (Just s)) = ppLlvmGlobal (LMGlobal v $ Just s)
tryConst g@(LMGlobal _ Nothing) = ppLlvmGlobal g
ppLlvmTys (LMAlias a) = ppLlvmAlias a
ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f
......@@ -119,13 +119,13 @@ pprInfoTable env count info_lbl stat
unres = genLlvmData env (Text, stat)
(_, (ldata, ltypes)) = resolveLlvmData env unres
setSection ((LMGlobalVar _ ty l _ _ c), d)
setSection (LMGlobal (LMGlobalVar _ ty l _ _ c) d)
= let sec = mkLayoutSection count
ilabel = strCLabel_llvm env info_lbl
`appendFS` fsLit iTableSuf
gv = LMGlobalVar ilabel ty l sec (llvmInfAlign dflags) c
v = if l == Internal then [gv] else []
in ((gv, d), v)
in (LMGlobal gv d, v)
setSection v = (v,[])
(ldata', llvmUsed) = setSection (last ldata)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment