X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCodeOutput.lhs;h=df6337d08f88b728017da202360ab5540c000827;hb=af630baad68f35adf76d898f5be768f447bc7ff8;hp=5c61a5d6c615fd8cb6971a6baf29ae932270e7f8;hpb=b79fd0139e6469e52f1fa10663a7558b2abced05;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 5c61a5d..df6337d 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -33,9 +33,9 @@ import CmdLineOpts
 import ErrUtils		( dumpIfSet_dyn, showPass )
 import Outputable
 import CmdLineOpts	( DynFlags, HscLang(..), dopt_OutName )
-import TmpFiles		( newTempName )
 
 import IOExts
+import Monad		( when )
 import IO
 \end{code}
 
@@ -55,7 +55,7 @@ codeOutput :: DynFlags
 	   -> SDoc 		-- C stubs for foreign exported functions
 	   -> SDoc		-- Header file prototype for foreign exported functions
 	   -> AbstractC		-- Compiled abstract C
-	   -> IO (Maybe FilePath, Maybe FilePath)
+	   -> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-})
 codeOutput dflags mod_name tycons core_binds stg_binds 
 	   c_code h_code flat_abstractC
   = -- You can have C (c_output) or assembly-language (ncg_output),
@@ -75,9 +75,12 @@ codeOutput dflags mod_name tycons core_binds stg_binds
           		       >> return stub_names
              HscJava        -> outputJava dflags filenm mod_name tycons core_binds
           		       >> return stub_names
+	     HscILX         -> 
 #ifdef ILX
-	     HscILX         -> outputIlx dflags filenm mod_name tycons stg_binds
+	                       outputIlx dflags filenm mod_name tycons stg_binds
 			       >> return stub_names
+#else
+                               panic "ILX support not compiled into this ghc"
 #endif
 	}
 
@@ -98,14 +101,13 @@ doOutput filenm io_action
 %************************************************************************
 
 \begin{code}
-outputC dflags filenm flat_absC (maybe_stub_h, _)
+outputC dflags filenm flat_absC (stub_h_exists, _)
   = do dumpIfSet_dyn dflags Opt_D_dump_realC "Real C" (dumpRealC flat_absC)
        header <- readIORef v_HCHeader
        doOutput filenm $ \ h -> do
 	  hPutStr h header
-	  case maybe_stub_h of
-		Nothing       -> return ()
-		Just filename -> hPutStrLn h ("#include \"" ++ filename ++ "\"")
+	  when stub_h_exists $ 
+	     hPutStrLn h ("#include \"" ++ (hscStubHOutName dflags) ++ "\"")
 	  writeRealC h flat_absC
 \end{code}
 
@@ -184,16 +186,25 @@ outputForeignStubs dflags c_code h_code
 	dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export header file" stub_h_output_d
 
-	maybe_stub_h_file
-           <- outputForeignStubs_help True{-.h output-} stub_h_output_w
+	stub_h_file_exists
+           <- outputForeignStubs_help (hscStubHOutName dflags) stub_h_output_w
+		"#include \"HsFFI.h\"\n"
 
 	dumpIfSet_dyn dflags Opt_D_dump_foreign
                       "Foreign export stubs" stub_c_output_d
 
-        maybe_stub_c_file
-           <- outputForeignStubs_help False{-not .h-} stub_c_output_w
+        hc_header <- readIORef v_HCHeader
 
-        return (maybe_stub_h_file, maybe_stub_c_file)
+	stub_c_file_exists
+           <- outputForeignStubs_help (hscStubCOutName dflags) stub_c_output_w
+		("#define IN_STG_CODE 0\n" ++ 
+		 hc_header ++
+		 "#include \"RtsAPI.h\"\n")
+	   -- we're adding the default hc_header to the stub file, but this
+	   -- isn't really HC code, so we need to define IN_STG_CODE==0 to
+	   -- avoid the register variables etc. being enabled.
+
+        return (stub_h_file_exists, stub_c_file_exists)
   where
     -- C stubs for "foreign export"ed functions.
     stub_c_output_d = pprCode CStyle c_code
@@ -207,17 +218,9 @@ outputForeignStubs dflags c_code h_code
 -- Don't use doOutput for dumping the f. export stubs
 -- since it is more than likely that the stubs file will
 -- turn out to be empty, in which case no file should be created.
-outputForeignStubs_help is_header ""      = return Nothing
-outputForeignStubs_help is_header doc_str 
-   = do fname <- newTempName suffix
-        writeFile fname (include_prefix ++ doc_str)
-        return (Just fname)
-  where
-    suffix
-       | is_header   = "h_stub"
-       | otherwise   = "c_stub"
-    include_prefix
-       | is_header   = "#include \"HsFFI.h\"\n"
-       | otherwise   = "#include \"RtsAPI.h\"\n"
+outputForeignStubs_help fname "" injects     = return False
+outputForeignStubs_help fname doc_str injects
+   = do writeFile fname (injects ++ doc_str)
+        return True
 \end{code}