[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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