From: rrt <unknown>
Date: Wed, 15 Aug 2001 09:32:40 +0000 (+0000)
Subject: [project @ 2001-08-15 09:32:40 by rrt]
X-Git-Tag: Approximately_9120_patches~1247
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;ds=sidebyside;h=3696ab397aa4207db05bd056035660aa5ec23799;p=ghc-hetmet.git

[project @ 2001-08-15 09:32:40 by rrt]
Driver support for ILX compilation
---

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 9a617e1..b839783 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -316,6 +316,10 @@ data DynFlags = DynFlags {
   opt_c			:: [String],
   opt_a			:: [String],
   opt_m			:: [String],
+#ifdef ILX			   
+  opt_I			:: [String],
+  opt_i			:: [String],
+#endif
 
   -- hsc dynamic flags
   flags      		:: [DynFlag]
@@ -344,6 +348,10 @@ defaultDynFlags = DynFlags {
   opt_c			= [],
   opt_a			= [],
   opt_m			= [],
+#ifdef ILX
+  opt_I                 = [],
+  opt_i                 = [],
+#endif
   flags = standardWarnings,
   }
 
diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 9a8efee..76c6082 100644
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.64 2001/08/13 15:49:38 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.65 2001/08/15 09:32:40 rrt Exp $
 --
 -- Driver flags
 --
@@ -305,6 +305,10 @@ dynamic_flags = [
   ,  ( "optc",		HasArg (addOpt_c) )
   ,  ( "optm",		HasArg (addOpt_m) )
   ,  ( "opta",		HasArg (addOpt_a) )
+#ifdef ILX
+  ,  ( "optI",		HasArg (addOpt_I) )
+  ,  ( "opti",		HasArg (addOpt_i) )
+#endif
 
 	------ HsCpp opts ---------------------------------------------------
 	-- With a C compiler whose system() doesn't use a UNIX shell (i.e.
@@ -520,11 +524,15 @@ machdepCCOpts
 
 
 
-addOpt_L a = updDynFlags (\s -> s{opt_L =  a : opt_L s})
-addOpt_P a = updDynFlags (\s -> s{opt_P =  a : opt_P s})
-addOpt_c a = updDynFlags (\s -> s{opt_c =  a : opt_c s})
-addOpt_a a = updDynFlags (\s -> s{opt_a =  a : opt_a s})
-addOpt_m a = updDynFlags (\s -> s{opt_m =  a : opt_m s})
+addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s})
+addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s})
+addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s})
+addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s})
+addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s})
+#ifdef ILX
+addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s})
+addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s})
+#endif
 
 addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
 
@@ -533,8 +541,7 @@ getOpts :: (DynFlags -> [a]) -> IO [a]
 getOpts opts = dynFlag opts >>= return . reverse
 
 -- we can only change HscC to HscAsm and vice-versa with dynamic flags 
--- (-fvia-C and -fasm).
--- NB: we can also set the new lang to ILX, via -filx.  I hope this is right
+-- (-fvia-C and -fasm). We can also set the new lang to ILX, via -filx.
 setLang l = updDynFlags (\ dfs -> case hscLang dfs of
 					HscC   -> dfs{ hscLang = l }
 					HscAsm -> dfs{ hscLang = l }
diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs
index 663b807..916c6bb 100644
--- a/ghc/compiler/main/DriverPhases.hs
+++ b/ghc/compiler/main/DriverPhases.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.11 2001/06/22 13:28:44 rrt Exp $
+-- $Id: DriverPhases.hs,v 1.12 2001/08/15 09:32:40 rrt Exp $
 --
 -- GHC Driver
 --
@@ -48,7 +48,11 @@ data Phase
 	| SplitMangle	-- after mangler if splitting
 	| SplitAs
 	| As
-	| Ln 
+	| Ln
+#ifdef ILX
+        | Ilx2Il
+	| Ilasm
+#endif
   deriving (Eq, Show)
 
 -- the first compilation phase for a given file is determined
@@ -77,6 +81,10 @@ phaseInputExt As          = "s"
 phaseInputExt SplitAs     = "split_s"   -- not really generated
 phaseInputExt Ln          = "o"
 phaseInputExt MkDependHS  = "dep"
+#ifdef ILX
+phaseInputExt Ilx2Il      = "ilx"
+phaseInputExt Ilasm       = "il"
+#endif
 
 haskellish_suffix     = (`elem` [ "hs", "hspp", "lhs", "hc", "raw_s" ])
 haskellish_src_suffix = (`elem` [ "hs", "hspp", "lhs" ])
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 9a95cdc..56f68f5 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.97 2001/08/15 00:36:54 sof Exp $
+-- $Id: DriverPipeline.hs,v 1.98 2001/08/15 09:32:40 rrt Exp $
 --
 -- GHC Driver
 --
@@ -175,7 +175,7 @@ genPipeline todo stop_flag persistent_output lang (filename,suffix)
 	HscJava	| split	          -> not_valid
 		| otherwise       -> error "not implemented: compiling via Java"
 	HscILX  | split           -> not_valid
-		| otherwise       -> [ Unlit, Cpp, Hsc ]
+		| otherwise       -> [ Unlit, Cpp, Hsc, Ilx2Il, Ilasm ]
 
       | cish      = [ Cc, As ]
 
@@ -684,6 +684,30 @@ run_phase SplitAs basename _suff _input_fn output_fn
 	mapM_ assemble_file [1..n]
 	return (Just output_fn)
 
+#ifdef ILX
+-----------------------------------------------------------------------------
+-- Ilx2Il phase
+-- Run ilx2il over the ILX output, getting an IL file
+
+run_phase Ilx2Il _basename _suff input_fn output_fn
+  = do	ilx2il_opts <- getOpts opt_I
+        SysTools.runIlx2il (ilx2il_opts
+                           ++ [ "--no-add-suffix-to-assembly", "mscorlib",
+				"-o", output_fn, input_fn ])
+	return (Just output_fn)
+
+-----------------------------------------------------------------------------
+-- Ilasm phase
+-- Run ilasm over the IL, getting a DLL
+
+run_phase Ilasm _basename _suff input_fn output_fn
+  = do	ilasm_opts <- getOpts opt_i
+        SysTools.runIlasm (ilasm_opts
+		           ++ [ "/QUIET", "/DLL", "/OUT="++output_fn, input_fn ])
+	return (Just output_fn)
+
+#endif -- ILX
+
 -----------------------------------------------------------------------------
 -- MoveBinary sort-of-phase
 -- After having produced a binary, move it somewhere else and generate a
@@ -999,8 +1023,7 @@ compile ghci_mode summary source_unchanged have_object
 	   HscC    | keep_hc   -> return (basename ++ '.':phaseInputExt HCc)
 		   | otherwise -> newTempName (phaseInputExt HCc)
            HscJava             -> newTempName "java" -- ToDo
-	   HscILX              -> return (basename ++ ".ilx") 	
-	   			    -- newTempName "ilx"	-- ToDo
+	   HscILX              -> return (phaseInputExt Ilx2Il) 	
 	   HscInterpreted      -> return (error "no output file")
 
    let dyn_flags' = dyn_flags { hscOutName = output_fn,
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index e3eedf9..cbd7bb1 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: SysTools.lhs,v 1.48 2001/08/13 15:49:38 simonmar Exp $
+-- $Id: SysTools.lhs,v 1.49 2001/08/15 09:32:40 rrt Exp $
 --
 -- (c) The University of Glasgow 2001
 --
@@ -23,6 +23,10 @@ module SysTools (
 	runMangle, runSplit,	 -- [Option] -> IO ()
 	runAs, runLink,		 -- [Option] -> IO ()
 	runMkDLL,
+#ifdef ILX
+        runIlx2il, runIlasm,     -- [String] -> IO ()
+#endif
+
 
 	touch,			-- String -> String -> IO ()
 	copy,			-- String -> String -> String -> IO ()
@@ -156,6 +160,10 @@ GLOBAL_VAR(v_Pgm_c,   	error "pgm_c",   String)	-- gcc
 GLOBAL_VAR(v_Pgm_m,   	error "pgm_m",   String)	-- asm code mangler
 GLOBAL_VAR(v_Pgm_s,   	error "pgm_s",   String)	-- asm code splitter
 GLOBAL_VAR(v_Pgm_a,   	error "pgm_a",   String)	-- as
+#ifdef ILX
+GLOBAL_VAR(v_Pgm_I,     error "pgm_I",   String)        -- ilx2il
+GLOBAL_VAR(v_Pgm_i,     error "pgm_i",   String)        -- ilasm
+#endif
 GLOBAL_VAR(v_Pgm_l,   	error "pgm_l",   String)	-- ld
 GLOBAL_VAR(v_Pgm_MkDLL, error "pgm_dll", String)	-- mkdll
 
@@ -307,6 +315,11 @@ initSysTools minusB_args
 	; let	as_path  = gcc_path
 		ld_path  = gcc_path
 
+#ifdef ILX
+       -- ilx2il and ilasm are specified in Config.hs
+       ; let    ilx2il_path = cILX2IL
+		ilasm_path  = cILASM
+#endif
 				       
 	-- Initialise the global vars
 	; writeIORef v_Path_package_config pkgconfig_path
@@ -322,6 +335,10 @@ initSysTools minusB_args
 	; writeIORef v_Pgm_m   	 	   mangle_path
 	; writeIORef v_Pgm_s   	 	   split_path
 	; writeIORef v_Pgm_a   	 	   as_path
+#ifdef ILX
+	; writeIORef v_Pgm_I               ilx2il_path
+	; writeIORef v_Pgm_i               ilasm_path
+#endif
 	; writeIORef v_Pgm_l   	 	   ld_path
 	; writeIORef v_Pgm_MkDLL 	   mkdll_path
 	; writeIORef v_Pgm_T   	 	   touch_path
@@ -333,7 +350,7 @@ initSysTools minusB_args
 
 setPgm is called when a command-line option like
 	-pgmLld
-is used to override a particular program with a new onw
+is used to override a particular program with a new one
 
 \begin{code}
 setPgm :: String -> IO ()
@@ -346,6 +363,10 @@ setPgm ('m' : pgm) = writeIORef v_Pgm_m pgm
 setPgm ('s' : pgm) = writeIORef v_Pgm_s pgm
 setPgm ('a' : pgm) = writeIORef v_Pgm_a pgm
 setPgm ('l' : pgm) = writeIORef v_Pgm_l pgm
+#ifdef ILX
+setPgm ('I' : pgm) = writeIORef v_Pgm_I pgm
+setPgm ('i' : pgm) = writeIORef v_Pgm_i pgm
+#endif
 setPgm pgm	   = unknownFlagErr ("-pgm" ++ pgm)
 \end{code}
 
@@ -467,6 +488,16 @@ runLink :: [Option] -> IO ()
 runLink args = do p <- readIORef v_Pgm_l
 	          runSomething "Linker" p args
 
+#ifdef ILX
+runIlx2il :: [String] -> IO ()
+runIlx2il args = do p <- readIORef v_Pgm_I
+	            runSomething "Ilx2Il" p args
+
+runIlasm :: [String] -> IO ()
+runIlasm args = do p <- readIORef v_Pgm_i
+	           runSomething "Ilasm" p args
+#endif
+
 runMkDLL :: [Option] -> IO ()
 runMkDLL args = do p <- readIORef v_Pgm_MkDLL
 	           runSomething "Make DLL" p args
@@ -683,6 +714,11 @@ unDosifyPath xs = subst '\\' '/' xs
 
 pgmPath dir pgm = dosifyPath dir ++ '\\' : pgm
 
+-- HACK!
+dosifyPath "\"/DLL\"" = "\"/DLL\""
+dosifyPath "\"/QUIET\"" = "\"/QUIET\""
+dosifyPath l@('"':'/':'O':'U':'T':_) = l
+-- end of HACK!
 dosifyPath stuff
   = subst '/' '\\' real_stuff
  where