X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FCodeOutput.lhs;h=bc2dd1eafc5d225bd3a4584b1c6f7471efdd08e8;hp=3c82ea7508fe6a56dae42f661d4ab751000ff6fa;hb=24a3fee9f3ff6cef6fe471ab6f0a7ba9ac001faf;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2 diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 3c82ea7..bc2dd1e 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -9,9 +9,11 @@ module CodeOutput( codeOutput, outputForeignStubs ) where #include "HsVersions.h" #ifndef OMIT_NATIVE_CODEGEN -import UniqSupply ( mkSplitUniqSupply ) import AsmCodeGen ( nativeCodeGen ) #endif +import LlvmCodeGen ( llvmCodeGen ) + +import UniqSupply ( mkSplitUniqSupply ) #ifdef JAVA import JavaGen ( javaGen ) @@ -27,16 +29,18 @@ import Util import Cmm ( RawCmm ) import HscTypes import DynFlags +import Config import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) import Outputable import Module import Maybes ( firstJust ) -import Directory ( doesFileExist ) -import Monad ( when ) -import IO +import Control.Exception +import Control.Monad +import System.Directory import System.FilePath +import System.IO \end{code} %************************************************************************ @@ -79,6 +83,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC HscInterpreted -> return (); HscAsm -> outputAsm dflags filenm flat_abstractC; HscC -> outputC dflags filenm flat_abstractC pkg_deps; + HscLlvm -> outputLlvm dflags filenm flat_abstractC; HscJava -> #ifdef JAVA outputJava dflags filenm mod_name tycons core_binds; @@ -126,7 +131,7 @@ outputC dflags filenm flat_absC packages _ -> "#include \""++h_file++"\"" pkg_configs <- getPreloadPackagesAnd dflags packages - let pkg_names = map (display.package) pkg_configs + let pkg_names = map (display.sourcePackageId) pkg_configs doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") @@ -166,6 +171,20 @@ outputAsm _ _ _ %************************************************************************ %* * +\subsection{LLVM} +%* * +%************************************************************************ + +\begin{code} +outputLlvm :: DynFlags -> FilePath -> [RawCmm] -> IO () +outputLlvm dflags filenm flat_absC + = do ncg_uniqs <- mkSplitUniqSupply 'n' + doOutput filenm $ \f -> llvmCodeGen dflags f ncg_uniqs flat_absC +\end{code} + + +%************************************************************************ +%* * \subsection{Java} %* * %************************************************************************ @@ -224,6 +243,10 @@ outputForeignStubs dflags mod location stubs concatMap mk_include (includes rts_pkg) mk_include i = "#include \"" ++ i ++ "\"\n" + -- wrapper code mentions the ffi_arg type, which comes from ffi.h + ffi_includes | cLibFFI = "#include \"ffi.h\"\n" + | otherwise = "" + stub_h_file_exists <- outputForeignStubs_help stub_h stub_h_output_w ("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr @@ -236,6 +259,7 @@ outputForeignStubs dflags mod location stubs ("#define IN_STG_CODE 0\n" ++ "#include \"Rts.h\"\n" ++ rts_includes ++ + ffi_includes ++ cplusplus_hdr) cplusplus_ftr -- We're adding the default hc_header to the stub file, but this