Add support of TNTC to llvm backend

We do this through a gnu as feature called subsections,
where you can put data/code into a numbered subsection
and those subsections will be joined together in descending
order by gas at compile time.

compiler/ghc.mk

@@ -43,12 +43,6 @@ compiler/stage2/package-data.mk : $(compiler_CONFIG_HS)
 compiler/stage3/package-data.mk : $(compiler_CONFIG_HS)
 endif
 
-ifeq "$(GhcEnableTablesNextToCode)" "NO"
-GhcWithLlvmCodeGen = YES
-else
-GhcWithLlvmCodeGen = NO
-endif
-
 $(compiler_CONFIG_HS) : mk/config.mk mk/project.mk
 	"$(RM)" $(RM_OPTS) $@
 	@echo "Creating $@ ... "
@@ -74,7 +68,7 @@ $(compiler_CONFIG_HS) : mk/config.mk mk/project.mk
 	@echo "cGhcWithNativeCodeGen :: String" >> $@
 	@echo "cGhcWithNativeCodeGen = \"$(GhcWithNativeCodeGen)\"" >> $@
 	@echo "cGhcWithLlvmCodeGen   :: String" >> $@
-	@echo "cGhcWithLlvmCodeGen   = \"$(GhcWithLlvmCodeGen)\"" >> $@
+	@echo "cGhcWithLlvmCodeGen   = \"YES\"" >> $@
 	@echo "cGhcWithSMP           :: String" >> $@
 	@echo "cGhcWithSMP           = \"$(GhcWithSMP)\"" >> $@
 	@echo "cGhcRTSWays           :: String" >> $@
@@ -321,7 +315,7 @@ ifeq "$(GhcEnableTablesNextToCode) $(GhcUnregisterised)" "YES NO"
 # or not?
 # XXX This should logically be a CPP option, but there doesn't seem to
 # be a flag for that
-compiler_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE
+compiler_stage2_CONFIGURE_OPTS += --ghc-option=-DGHCI_TABLES_NEXT_TO_CODE
 endif
 
 # Should the debugger commands be enabled?

compiler/llvmGen/Llvm.hs

@@ -28,15 +28,15 @@ module Llvm (
 
         -- * Variables and Type System
         LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..),
-        LMGlobal, LMString, LMConstant,
+        LMGlobal, LMString, LMConstant, LMSection, LMAlign,
 
         -- ** Some basic types
-        i64, i32, i16, i8, i1, llvmWord, llvmWordPtr,
+        i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr,
 
         -- ** Operations on the type system.
         isGlobal, getLitType, getLit, getName, getPlainName, getVarType,
-        getStatType, getGlobalVar, getGlobalType, pVarLower, pLift, pLower,
-        isInt, isFloat, isPointer, llvmWidthInBits,
+        getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
+        pLift, pLower, isInt, isFloat, isPointer, llvmWidthInBits,
 
         -- * Pretty Printing
         ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmConstants,

compiler/llvmGen/Llvm/AbsSyn.hs

@@ -44,13 +44,16 @@ data LlvmModule = LlvmModule  {
 -- | An LLVM Function
 data LlvmFunction = LlvmFunction {
     -- | The signature of this declared function.
-    funcDecl    :: LlvmFunctionDecl,
+    funcDecl  :: LlvmFunctionDecl,
 
     -- | The function attributes.
-    funcAttrs   :: [LlvmFuncAttr],
+    funcAttrs :: [LlvmFuncAttr],
+
+    -- | The section to put the function into,
+    funcSect  :: LMSection,
 
     -- | The body of the functions.
-    funcBody    :: LlvmBlocks
+    funcBody  :: LlvmBlocks
   }
 
 type LlvmFunctions  = [LlvmFunction]

compiler/llvmGen/Llvm/PpLlvm.hs

@@ -18,6 +18,8 @@ module Llvm.PpLlvm (
     ppLlvmFunctionDecl,
     ppLlvmFunctions,
     ppLlvmFunction,
+
+    -- * Utility functions
     llvmSDoc
 
     ) where
@@ -29,7 +31,7 @@ import Llvm.Types
 
 import Data.List ( intersperse )
 import Pretty
-import qualified Outputable as Outp
+import qualified Outputable as Out
 import Unique
 
 --------------------------------------------------------------------------------
@@ -54,7 +56,7 @@ ppLlvmComments comments = vcat $ map ppLlvmComment comments
 
 -- | Print out a comment, can be inside a function or on its own
 ppLlvmComment :: LMString -> Doc
-ppLlvmComment com = semi <+> (ftext com)
+ppLlvmComment com = semi <+> ftext com
 
 
 -- | Print out a list of global mutable variable definitions
@@ -63,14 +65,25 @@ ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls
 
 -- | Print out a global mutable variable definition
 ppLlvmGlobal :: LMGlobal -> Doc
-ppLlvmGlobal (var@(LMGlobalVar _ _ link), Nothing) =
-    ppAssignment var $ text (show link) <+> text "global" <+>
-        (text $ show (pLower $ getVarType var))
+ppLlvmGlobal = ppLlvmGlobal' (text "global")
+
+ppLlvmGlobal' :: Doc -> LMGlobal -> Doc
+ppLlvmGlobal' vty (var@(LMGlobalVar _ _ link x a), cont) =
+    let sect = case x of
+            Just x' -> text ", section" <+> doubleQuotes (ftext x')
+            Nothing -> empty
+
+        align = case a of
+            Just a' -> text ", align" <+> int a'
+            Nothing -> empty
+
+        rhs = case cont of
+            Just stat -> texts stat
+            Nothing   -> texts (pLower $ getVarType var)
 
-ppLlvmGlobal (var@(LMGlobalVar _ _ link), (Just stat)) =
-    ppAssignment var $ text (show link) <+> text "global" <+> text (show stat)
+    in ppAssignment var $ texts link <+> vty <+> rhs <> sect <> align
 
-ppLlvmGlobal oth = error $ "Non Global var ppr as global! " ++ show oth
+ppLlvmGlobal' _ oth = error $ "Non Global var ppr as global! " ++ show oth
 
 
 -- | Print out a list global constant variable
@@ -79,10 +92,7 @@ ppLlvmConstants cons = vcat $ map ppLlvmConstant cons
 
 -- | Print out a global constant variable
 ppLlvmConstant :: LMConstant -> Doc
-ppLlvmConstant (dst@(LMGlobalVar _ _ link), src) =
-    ppAssignment dst $ text (show link) <+> text "constant" <+> text (show src)
-
-ppLlvmConstant c = error $ "Non global var as constant! " ++ show c
+ppLlvmConstant (v,s) = ppLlvmGlobal' (text "constant") (v, Just s)
 
 
 -- | Print out a list of LLVM type aliases.
@@ -93,7 +103,7 @@ ppLlvmTypes tys = vcat $ map ppLlvmType tys
 ppLlvmType :: LlvmType -> Doc
 
 ppLlvmType al@(LMAlias _ t)
-  = (text $ show al) <+> equals <+> (text "type") <+> (text $ show t)
+  = texts al <+> equals <+> text "type" <+> texts t
 
 ppLlvmType (LMFunction t)
   = ppLlvmFunctionDecl t
@@ -107,10 +117,13 @@ ppLlvmFunctions funcs = vcat $ map ppLlvmFunction funcs
 
 -- | Print out a function definition.
 ppLlvmFunction :: LlvmFunction -> Doc
-ppLlvmFunction (LlvmFunction dec attrs body) =
+ppLlvmFunction (LlvmFunction dec attrs sec body) =
     let attrDoc = ppSpaceJoin attrs
-    in (text "define") <+> (ppLlvmFuncDecSig dec)
-        <+> attrDoc
+        secDoc = case sec of
+                      Just s' -> text "section " <+> (doubleQuotes $ ftext s')
+                      Nothing -> empty
+    in text "define" <+> texts dec
+        <+> attrDoc <+> secDoc
         $+$ lbrace
         $+$ ppLlvmBlocks body
         $+$ rbrace
@@ -124,22 +137,7 @@ ppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs
 -- Declarations define the function type but don't define the actual body of
 -- the function.
 ppLlvmFunctionDecl :: LlvmFunctionDecl -> Doc
-ppLlvmFunctionDecl dec = (text "declare") <+> ppLlvmFuncDecSig dec
-
--- | Print out a functions type signature.
--- This differs from [ppLlvmFunctionDecl] in that it is used for both function
--- declarations and defined functions to print out the type.
-ppLlvmFuncDecSig :: LlvmFunctionDecl -> Doc
-ppLlvmFuncDecSig (LlvmFunctionDecl name link cc retTy argTy params)
-  = let linkTxt = show link
-        linkDoc   | linkTxt == "" = empty
-                  | otherwise     = (text linkTxt) <> space
-        ppParams = either ppCommaJoin ppCommaJoin params <>
-                    (case argTy of
-                        VarArgs -> (text ", ...")
-                        FixedArgs -> empty)
-  in linkDoc <> (text $ show cc) <+> (text $ show retTy)
-      <+> atsym <> (ftext name) <> lparen <+> ppParams <+> rparen
+ppLlvmFunctionDecl dec = text "declare" <+> texts dec
 
 
 -- | Print out a list of LLVM blocks.
@@ -151,7 +149,7 @@ ppLlvmBlocks blocks = vcat $ map ppLlvmBlock blocks
 ppLlvmBlock :: LlvmBlock -> Doc
 ppLlvmBlock (LlvmBlock blockId stmts)
   = ppLlvmStatement (MkLabel blockId)
-        $+$ nest 4 (vcat $ map  ppLlvmStatement stmts)
+        $+$ nest 4 (vcat $ map ppLlvmStatement stmts)
 
 
 -- | Print out an LLVM statement.
@@ -198,7 +196,7 @@ ppCall ct fptr vals attrs = case fptr of
     LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d
 
     -- should be function type otherwise
-    LMGlobalVar _ (LMFunction d) _          -> ppCall' d
+    LMGlobalVar _ (LMFunction d) _ _ _      -> ppCall' d
 
     -- not pointer or function, so error
     _other -> error $ "ppCall called with non LMFunction type!\nMust be "
@@ -206,23 +204,23 @@ ppCall ct fptr vals attrs = case fptr of
                 ++ "local var of pointer function type."
 
     where
-        ppCall' (LlvmFunctionDecl _ _ cc ret argTy params) =
+        ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
             let tc = if ct == TailCall then text "tail " else empty
                 ppValues = ppCommaJoin vals
                 ppArgTy = either ppCommaJoin (\x -> ppCommaJoin $ map getVarType x) params <>
                            (case argTy of
-                               VarArgs -> (text ", ...")
+                               VarArgs   -> text ", ..."
                                FixedArgs -> empty)
-                fnty = space <> lparen <> ppArgTy <> rparen <> (text "*")
+                fnty = space <> lparen <> ppArgTy <> rparen <> text "*"
                 attrDoc = ppSpaceJoin attrs
-            in  tc <> (text "call") <+> (text $ show cc) <+> (text $ show ret)
+            in  tc <> text "call" <+> texts cc <+> texts ret
                     <> fnty <+> (text $ getName fptr) <> lparen <+> ppValues
                     <+> rparen <+> attrDoc
 
 
 ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> Doc
 ppMachOp op left right =
-  (text $ show op) <+> (text $ show (getVarType left)) <+> (text $ getName left)
+  (texts op) <+> (texts (getVarType left)) <+> (text $ getName left)
         <> comma <+> (text $ getName right)
 
 
@@ -234,7 +232,7 @@ ppCmpOp op left right =
         | otherwise = error ("can't compare different types, left = "
                 ++ (show $ getVarType left) ++ ", right = "
                 ++ (show $ getVarType right))
-  in cmpOp <+> (text $ show op) <+> (text $ show (getVarType left))
+  in cmpOp <+> texts op <+> texts (getVarType left)
         <+> (text $ getName left) <> comma <+> (text $ getName right)
 
 
@@ -243,83 +241,79 @@ ppAssignment var expr = (text $ getName var) <+> equals <+> expr
 
 
 ppLoad :: LlvmVar -> Doc
-ppLoad var = (text "load") <+> (text $ show var)
+ppLoad var = text "load" <+> texts var
 
 
 ppStore :: LlvmVar -> LlvmVar -> Doc
-ppStore val dst =
-  (text "store") <+> (text $ show val) <> comma <+> (text $ show dst)
+ppStore val dst = text "store" <+> texts val <> comma <+> texts dst
 
 
 ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> Doc
-ppCast op from to =
-  let castOp = text $ show op
-  in castOp <+> (text $ show from) <+> (text "to") <+> (text $ show to)
+ppCast op from to = texts op <+> texts from <+> text "to" <+> texts to
 
 
 ppMalloc :: LlvmType -> Int -> Doc
 ppMalloc tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in (text "malloc") <+> (text $ show tp) <> comma <+> (text $ show amount')
+  in text "malloc" <+> texts tp <> comma <+> texts amount'
 
 
 ppAlloca :: LlvmType -> Int -> Doc
 ppAlloca tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in (text "alloca") <+> (text $ show tp) <> comma <+> (text $ show amount')
+  in text "alloca" <+> texts tp <> comma <+> texts amount'
 
 
 ppGetElementPtr :: LlvmVar -> [Int] -> Doc
 ppGetElementPtr ptr idx =
-  let indexes = hcat $ map ((comma <+> (text $ show i32) <+>) . text . show) idx
-  in (text "getelementptr") <+> (text $ show ptr) <> indexes
+  let indexes = hcat $ map ((comma <+> texts i32 <+>) . texts) idx
+  in text "getelementptr" <+> texts ptr <> indexes
 
 
 ppReturn :: Maybe LlvmVar -> Doc
-ppReturn (Just var) = (text "ret") <+> (text $ show var)
-ppReturn Nothing    = (text "ret") <+> (text $ show LMVoid)
+ppReturn (Just var) = text "ret" <+> texts var
+ppReturn Nothing    = text "ret" <+> texts LMVoid
 
 
 ppBranch :: LlvmVar -> Doc
-ppBranch var = (text "br") <+> (text $ show var)
+ppBranch var = text "br" <+> texts var
 
 
 ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> Doc
 ppBranchIf cond trueT falseT
-  = (text "br") <+> (text $ show cond) <> comma <+> (text $ show trueT) <> comma
-        <+> (text $ show falseT)
+  = text "br" <+> texts cond <> comma <+> texts trueT <> comma <+> texts falseT
 
 
 ppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> Doc
 ppPhi tp preds =
   let ppPreds (val, label) = brackets $ (text $ getName val) <> comma
         <+> (text $ getName label)
-  in (text "phi") <+> (text $ show tp)
-        <+> (hcat $ intersperse comma (map ppPreds preds))
+  in text "phi" <+> texts tp <+> hcat (intersperse comma $ map ppPreds preds)
 
 
 ppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> Doc
 ppSwitch scrut dflt targets =
-  let ppTarget  (val, lab) = (text $ show val) <> comma <+> (text $ show lab)
+  let ppTarget  (val, lab) = texts val <> comma <+> texts lab
       ppTargets  xs        = brackets $ vcat (map ppTarget xs)
-  in (text "switch") <+> (text $ show scrut) <> comma <+> (text $ show dflt)
-        <+> (ppTargets targets)
+  in text "switch" <+> texts scrut <> comma <+> texts dflt
+        <+> ppTargets targets
 
 
 --------------------------------------------------------------------------------
 -- * Misc functions
 --------------------------------------------------------------------------------
-atsym :: Doc
-atsym = text "@"
-
 ppCommaJoin :: (Show a) => [a] -> Doc
-ppCommaJoin strs = hcat $ intersperse comma (map (text . show) strs)
+ppCommaJoin strs = hcat $ intersperse comma (map texts strs)
 
 ppSpaceJoin :: (Show a) => [a] -> Doc
-ppSpaceJoin strs = hcat $ intersperse space (map (text . show) strs)
+ppSpaceJoin strs = hcat $ intersperse space (map texts strs)
 
 -- | Convert SDoc to Doc
-llvmSDoc :: Outp.SDoc -> Doc
+llvmSDoc :: Out.SDoc -> Doc
 llvmSDoc d
-	= Outp.withPprStyleDoc (Outp.mkCodeStyle Outp.CStyle) d
+	= Out.withPprStyleDoc (Out.mkCodeStyle Out.CStyle) d
+
+-- | Showable to Doc
+texts :: (Show a) => a -> Doc
+texts = (text . show)
 

compiler/llvmGen/Llvm/Types.hs

@@ -59,18 +59,21 @@ instance Show LlvmType where
   show (LMVoid        ) = "void"
   show (LMStruct tys  ) = "{" ++ (commaCat tys) ++ "}"
 
-  show (LMFunction (LlvmFunctionDecl _ _ _ r VarArgs p))
-        = (show r) ++ " (" ++ (either commaCat commaCat p) ++ ", ...)"
-  show (LMFunction (LlvmFunctionDecl _ _ _ r FixedArgs p))
-        = (show r) ++ " (" ++ (either commaCat commaCat p) ++ ")"
+  show (LMFunction (LlvmFunctionDecl _ _ _ r VarArgs p _))
+        = show r ++ " (" ++ (either commaCat commaCat p) ++ ", ...)"
+  show (LMFunction (LlvmFunctionDecl _ _ _ r FixedArgs p _))
+        = show r ++ " (" ++ (either commaCat commaCat p) ++ ")"
 
   show (LMAlias s _   ) = "%" ++ unpackFS s
 
+-- | An LLVM section defenition. If Nothing then let LLVM decide the section
+type LMSection = Maybe LMString
+type LMAlign = Maybe Int
 
 -- | Llvm Variables
 data LlvmVar
   -- | Variables with a global scope.
-  = LMGlobalVar LMString LlvmType LlvmLinkageType
+  = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign
   -- | Variables local to a function or parameters.
   | LMLocalVar Unique LlvmType
   -- | Named local variables. Sometimes we need to be able to explicitly name
@@ -114,10 +117,10 @@ data LlvmStatic
   -- static expressions, could split out but leave
   -- for moment for ease of use. Not many of them.
 
+  | LMBitc LlvmStatic LlvmType         -- ^ Pointer to Pointer conversion
   | LMPtoI LlvmStatic LlvmType         -- ^ Pointer to Integer conversion
   | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation
   | LMSub LlvmStatic LlvmStatic        -- ^ Constant subtraction operation
-  deriving (Eq)
 
 instance Show LlvmStatic where
   show (LMComment       s) = "; " ++ unpackFS s
@@ -128,23 +131,22 @@ instance Show LlvmStatic where
   show (LMStaticArray d t)
       = let struc = case d of
               [] -> "[]"
-              ts -> "[" ++
-                      (show (head ts) ++ concat (map (\x -> "," ++ show x)
-                          (tail ts)))
-                      ++ "]"
+              ts -> "[" ++ show (head ts) ++
+                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "]"
         in show t ++ " " ++ struc
 
   show (LMStaticStruc d t)
       = let struc = case d of
               [] -> "{}"
-              ts -> "{" ++
-                      (show (head ts) ++ concat (map (\x -> "," ++ show x)
-                          (tail ts)))
-                      ++ "}"
+              ts -> "{" ++ show (head ts) ++
+                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "}"
         in show t ++ " " ++ struc
 
   show (LMStaticPointer v) = show v
 
+  show (LMBitc v t)
+      = show t ++ " bitcast (" ++ show v ++ " to " ++ show t ++ ")"
+
   show (LMPtoI v t)
       = show t ++ " ptrtoint (" ++ show v ++ " to " ++ show t ++ ")"
 
@@ -174,18 +176,18 @@ commaCat x  = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x))
 -- | Return the variable name or value of the 'LlvmVar'
 -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
 getName :: LlvmVar -> String
-getName v@(LMGlobalVar _ _ _ ) = "@" ++ getPlainName v
-getName v@(LMLocalVar  _ _   ) = "%" ++ getPlainName v
-getName v@(LMNLocalVar _ _   ) = "%" ++ getPlainName v
-getName v@(LMLitVar    _     ) = getPlainName v
+getName v@(LMGlobalVar _ _ _ _ _) = "@" ++ getPlainName v
+getName v@(LMLocalVar  _ _      ) = "%" ++ getPlainName v
+getName v@(LMNLocalVar _ _      ) = "%" ++ getPlainName v
+getName v@(LMLitVar    _        ) = getPlainName v
 
 -- | Return the variable name or value of the 'LlvmVar'
 -- in a plain textual representation (e.g. @x@, @y@ or @42@).
 getPlainName :: LlvmVar -> String
-getPlainName (LMGlobalVar x _ _) = unpackFS x
-getPlainName (LMLocalVar  x _  ) = show x
-getPlainName (LMNLocalVar x _  ) = unpackFS x
-getPlainName (LMLitVar    x    ) = getLit x
+getPlainName (LMGlobalVar x _ _ _ _) = unpackFS x
+getPlainName (LMLocalVar  x _      ) = show x
+getPlainName (LMNLocalVar x _      ) = unpackFS x
+getPlainName (LMLitVar    x        ) = getLit x
 
 -- | Print a literal value. No type.
 getLit :: LlvmLit -> String
@@ -198,10 +200,10 @@ getLit l = error $ "getLit: Usupported LlvmLit type! " ++ show (getLitType l)
 
 -- | Return the 'LlvmType' of the 'LlvmVar'
 getVarType :: LlvmVar -> LlvmType
-getVarType (LMGlobalVar _ y _) = y
-getVarType (LMLocalVar  _ y  ) = y
-getVarType (LMNLocalVar _ y  ) = y
-getVarType (LMLitVar    l    ) = getLitType l
+getVarType (LMGlobalVar _ y _ _ _) = y
+getVarType (LMLocalVar  _ y      ) = y
+getVarType (LMNLocalVar _ y      ) = y
+getVarType (LMLitVar    l        ) = getLitType l
 
 -- | Return the 'LlvmType' of a 'LlvmLit'
 getLitType :: LlvmLit -> LlvmType
@@ -216,6 +218,7 @@ getStatType (LMStaticStr   _ t) = t
 getStatType (LMStaticArray _ t) = t
 getStatType (LMStaticStruc _ t) = t
 getStatType (LMStaticPointer v) = getVarType v
+getStatType (LMBitc        _ t) = t
 getStatType (LMPtoI        _ t) = t
 getStatType (LMAdd         t _) = getStatType t
 getStatType (LMSub         t _) = getStatType t
@@ -231,8 +234,8 @@ getGlobalVar (v, _) = v
 
 -- | Return the 'LlvmLinkageType' for a 'LlvmVar'
 getLink :: LlvmVar -> LlvmLinkageType
-getLink (LMGlobalVar _ _ l) = l
-getLink _                   = ExternallyVisible
+getLink (LMGlobalVar _ _ l _ _) = l
+getLink _                       = Internal
 
 -- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid'
 -- cannot be lifted.
@@ -241,6 +244,13 @@ pLift (LMLabel) = error "Labels are unliftable"
 pLift (LMVoid)  = error "Voids are unliftable"
 pLift x         = LMPointer x
 
+-- | Lower a variable of 'LMPointer' type.
+pVarLift :: LlvmVar -> LlvmVar
+pVarLift (LMGlobalVar s t l x a) = LMGlobalVar s (pLift t) l x a
+pVarLift (LMLocalVar  s t      ) = LMLocalVar  s (pLift t)
+pVarLift (LMNLocalVar s t      ) = LMNLocalVar s (pLift t)
+pVarLift (LMLitVar    _        ) = error $ "Can't lower a literal type!"
+
 -- | Remove the pointer indirection of the supplied type. Only 'LMPointer'
 -- constructors can be lowered.
 pLower :: LlvmType -> LlvmType
@@ -249,10 +259,10 @@ pLower x  = error $ show x ++ " is a unlowerable type, need a pointer"
 
 -- | Lower a variable of 'LMPointer' type.
 pVarLower :: LlvmVar -> LlvmVar
-pVarLower (LMGlobalVar s t l) = LMGlobalVar s (pLower t) l
-pVarLower (LMLocalVar  s t  ) = LMLocalVar  s (pLower t)
-pVarLower (LMNLocalVar s t  ) = LMNLocalVar s (pLower t)
-pVarLower (LMLitVar    _    ) = error $ "Can't lower a literal type!"
+pVarLower (LMGlobalVar s t l x a) = LMGlobalVar s (pLower t) l x a
+pVarLower (LMLocalVar  s t      ) = LMLocalVar  s (pLower t)
+pVarLower (LMNLocalVar s t      ) = LMNLocalVar s (pLower t)
+pVarLower (LMLitVar    _        ) = error $ "Can't lower a literal type!"
 
 -- | Test if the given 'LlvmType' is an integer
 isInt :: LlvmType -> Bool
@@ -274,48 +284,45 @@ isPointer _             = False
 
 -- | Test if a 'LlvmVar' is global.
 isGlobal :: LlvmVar -> Bool
-isGlobal (LMGlobalVar _ _ _) = True
-isGlobal _                   = False
+isGlobal (LMGlobalVar _ _ _ _ _) = True
+isGlobal _                      = False
 
 -- | Width in bits of an 'LlvmType', returns 0 if not applicable
 llvmWidthInBits :: LlvmType -> Int
-llvmWidthInBits (LMInt n)        = n
-llvmWidthInBits (LMFloat)        = 32
-llvmWidthInBits (LMDouble)       = 64
-llvmWidthInBits (LMFloat80)      = 80
-llvmWidthInBits (LMFloat128)     = 128
+llvmWidthInBits (LMInt n)       = n
+llvmWidthInBits (LMFloat)       = 32
+llvmWidthInBits (LMDouble)      = 64
+llvmWidthInBits (LMFloat80)     = 80
+llvmWidthInBits (LMFloat128)    = 128
 -- Could return either a pointer width here or the width of what
 -- it points to. We will go with the former for now.
-llvmWidthInBits (LMPointer _)    = llvmWidthInBits llvmWord
-llvmWidthInBits (LMArray _ _)    = llvmWidthInBits llvmWord
-llvmWidthInBits LMLabel          = 0
-llvmWidthInBits LMVoid           = 0
-llvmWidthInBits (LMStruct tys)   = sum $ map llvmWidthInBits tys
-llvmWidthInBits (LMFunction  _)  = 0
-llvmWidthInBits (LMAlias _ t)    = llvmWidthInBits t
+llvmWidthInBits (LMPointer _)   = llvmWidthInBits llvmWord
+llvmWidthInBits (LMArray _ _)   = llvmWidthInBits llvmWord
+llvmWidthInBits LMLabel         = 0
+llvmWidthInBits LMVoid          = 0
+llvmWidthInBits (LMStruct tys)  = sum $ map llvmWidthInBits tys
+llvmWidthInBits (LMFunction  _) = 0
+llvmWidthInBits (LMAlias _ t)   = llvmWidthInBits t
 
 
 -- -----------------------------------------------------------------------------
 -- ** Shortcut for Common Types
 --
 
-i128, i64, i32, i16, i8, i1 :: LlvmType
-i128 = LMInt 128
-i64  = LMInt  64
-i32  = LMInt  32
-i16  = LMInt  16
-i8   = LMInt   8
-i1   = LMInt   1
+i128, i64, i32, i16, i8, i1, i8Ptr :: LlvmType
+i128  = LMInt 128
+i64   = LMInt  64
+i32   = LMInt  32
+i16   = LMInt  16
+i8    = LMInt   8
+i1    = LMInt   1
+i8Ptr = pLift i8
 
 -- | The target architectures word size
-llvmWord :: LlvmType
-llvmWord = LMInt (wORD_SIZE * 8)
-
--- | The target architectures pointer size
-llvmWordPtr :: LlvmType
+llvmWord, llvmWordPtr :: LlvmType
+llvmWord    = LMInt (wORD_SIZE * 8)
 llvmWordPtr = pLift llvmWord
 
-
 -- -----------------------------------------------------------------------------
 -- * LLVM Function Types
 --
@@ -334,21 +341,20 @@ data LlvmFunctionDecl = LlvmFunctionDecl {
         decVarargs    :: LlvmParameterListType,
         -- | Signature of the parameters, can be just types or full vars
         -- if parameter names are required.
-        decParams     :: Either [LlvmType] [LlvmVar]
+        decParams     :: Either [LlvmType] [LlvmVar],
+        -- | Function align value, must be power of 2
+        funcAlign     :: LMAlign
   }
+  deriving (Eq)
 
 instance Show LlvmFunctionDecl where
-  show (LlvmFunctionDecl n l c r VarArgs p)
-        = (show l) ++ " " ++  (show c) ++ " " ++ (show r)
-            ++ " @" ++ unpackFS n ++ "(" ++ (either commaCat commaCat p) ++ ", ...)"
-  show (LlvmFunctionDecl n l c r FixedArgs p)
-        = (show l) ++ " " ++  (show c) ++ " " ++ (show r)