summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/llvmGen/Llvm.hs5
-rw-r--r--compiler/llvmGen/Llvm/PpLlvm.hs12
-rw-r--r--compiler/llvmGen/Llvm/Types.hs22
-rw-r--r--compiler/llvmGen/LlvmCodeGen.hs5
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Base.hs2
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs18
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Data.hs8
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Ppr.hs8
8 files changed, 43 insertions, 37 deletions
diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index 8951d88869..85095997ae 100644
--- a/compiler/llvmGen/Llvm.hs
+++ b/compiler/llvmGen/Llvm.hs
@@ -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
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index dc5e92222d..d1cb0553bf 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -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)
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 2f165a2240..3ccdfecb14 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -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
diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 4f2bded6bb..f70693d53d 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -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
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 7cac844490..8de52eb0ba 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -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
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 84ada2435c..d6bd864003 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -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])
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 83b5453aa9..f31b3e5203 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -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, [])
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index 3afa9100e4..000bac1eae 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -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)
View Lorry Controller Status