X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvmCodeGen.hs;h=56d8386431f0c1202a8e0dabfd869cc76f6295a7;hp=1b1fd9651452749c8079b1ec4d8e4f7c019ed48c;hb=0af06ed99ed56341adfdda4a92a0a36678780109;hpb=09e6aba8000ccf52943ada4fb9ac76e0d93a202f

diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs
index 1b1fd96..56d8386 100644
--- a/compiler/llvmGen/LlvmCodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen.hs
@@ -2,7 +2,7 @@
 -- | This is the top-level module in the LLVM code generator.
 --
 
-module LlvmCodeGen ( llvmCodeGen ) where
+module LlvmCodeGen ( llvmCodeGen, llvmFixupAsm ) where
 
 #include "HsVersions.h"
 
@@ -13,10 +13,12 @@ import LlvmCodeGen.CodeGen
 import LlvmCodeGen.Data
 import LlvmCodeGen.Ppr
 
+import LlvmMangler
+
 import CLabel
-import Cmm
 import CgUtils ( fixStgRegisters )
-import PprCmm
+import OldCmm
+import OldPprCmm
 
 import BufWrite
 import DynFlags
@@ -26,43 +28,41 @@ import Outputable
 import qualified Pretty as Prt
 import UniqSupply
 import Util
+import SysTools ( figureLlvmVersion )
 
+import Data.Maybe ( fromMaybe )
 import System.IO
 
 -- -----------------------------------------------------------------------------
--- | Top-level of the llvm codegen
+-- | Top-level of the LLVM Code generator
 --
 llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO ()
 llvmCodeGen dflags h us cmms
-  = do
-      bufh <- newBufHandle h
-
-      Prt.bufLeftRender bufh $ pprLlvmHeader
-
-      env' <- cmmDataLlvmGens dflags bufh env cdata []
-      cmmProcLlvmGens dflags bufh us env' cmm 1 []
-
-      bFlush bufh
-
-      return  ()
-  where
-        cmm = concat $ map (\(Cmm top) -> top) cmms
-
+  = let cmm = concat $ map (\(Cmm top) -> top) cmms
         (cdata,env) = foldr split ([],initLlvmEnv) cmm
-
-        split (CmmData _ d'   ) (d,e) = (d':d,e)
-        split (CmmProc i l _ _) (d,e) =
+        split (CmmData s d' ) (d,e) = ((s,d'):d,e)
+        split (CmmProc i l _) (d,e) =
             let lbl = strCLabel_llvm $ if not (null i)
                    then entryLblToInfoLbl l
                    else l
                 env' = funInsert lbl llvmFunTy e
             in (d,env')
+    in do
+        bufh <- newBufHandle h
+        Prt.bufLeftRender bufh $ pprLlvmHeader
+        ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags
+        
+        env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata []
+        cmmProcLlvmGens dflags bufh us env' cmm 1 []
+
+        bFlush bufh
+        return  ()
 
 
 -- -----------------------------------------------------------------------------
--- | Do llvm code generation on all these cmms data sections.
+-- | Do LLVM code generation on all these Cmms data sections.
 --
-cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]]
+cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])]
                 -> [LlvmUnresData] -> IO ( LlvmEnv )
 
 cmmDataLlvmGens dflags h env [] lmdata
@@ -74,13 +74,13 @@ cmmDataLlvmGens dflags h env [] lmdata
         return env'
 
 cmmDataLlvmGens dflags h env (cmm:cmms) lmdata
-  = let lmdata'@(l, ty, _) = genLlvmData cmm
+  = let lmdata'@(l, _, ty, _) = genLlvmData cmm
         env' = funInsert (strCLabel_llvm l) ty env
     in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata'])
 
 
 -- -----------------------------------------------------------------------------
--- | Do llvm code generation on all these cmms procs.
+-- | Do LLVM code generation on all these Cmms procs.
 --
 cmmProcLlvmGens :: DynFlags -> BufHandle -> UniqSupply -> LlvmEnv -> [RawCmmTop]
       -> Int          -- ^ count, used for generating unique subsections
@@ -95,9 +95,8 @@ cmmProcLlvmGens _ h _ _ [] _ ivars
         ty     = (LMArray (length ivars) i8Ptr)
         usedArray = LMStaticArray (map cast ivars) ty
         lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending
-                  (Just $ fsLit "llvm.metadata") Nothing, Just usedArray)
-    in do
-        Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
+                  (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray)
+    in Prt.bufLeftRender h $ pprLlvmData ([lmUsed], [])
 
 cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
   = do
@@ -109,10 +108,9 @@ cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars
     cmmProcLlvmGens dflags h us' env' cmms (count + 2) (concat ivar ++ ivars)
 
 
--- | Complete llvm code generation phase for a single top-level chunk of Cmm.
+-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
 cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop
             -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] )
-
 cmmLlvmGen dflags us env cmm
   = do
     -- rewrite assignments to global regs
@@ -122,20 +120,10 @@ cmmLlvmGen dflags us env cmm
         (pprCmm $ Cmm [fixed_cmm])
 
     -- generate llvm code from cmm
-    let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm
+    let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code"
         (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC)
 
     return (usGen, env', llvmBC)
 
-
--- -----------------------------------------------------------------------------
--- | Instruction selection
---
-genLlvmCode :: LlvmEnv -> RawCmmTop
-            -> UniqSM (LlvmEnv, [LlvmCmmTop])
-genLlvmCode env (CmmData _ _                 ) = return (env, [])
-genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, [])
-genLlvmCode env cp@(CmmProc _ _ _ _          ) = genLlvmProc env cp
-