Commit 3696ab39 authored by rrt's avatar rrt
Browse files

[project @ 2001-08-15 09:32:40 by rrt]

Driver support for ILX compilation
parent f1a74741
......@@ -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,
}
......
{-# 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 }
......
-----------------------------------------------------------------------------
-- $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" ])
......
-----------------------------------------------------------------------------
-- $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,
......
-----------------------------------------------------------------------------
-- $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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment