Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
3696ab39
Commit
3696ab39
authored
Aug 15, 2001
by
rrt
Browse files
[project @ 2001-08-15 09:32:40 by rrt]
Driver support for ILX compilation
parent
f1a74741
Changes
5
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/main/CmdLineOpts.lhs
View file @
3696ab39
...
...
@@ -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,
}
...
...
ghc/compiler/main/DriverFlags.hs
View file @
3696ab39
{-# OPTIONS -#include "hschooks.h" #-}
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.6
4
2001/08/1
3 15:49:38 simonmar
Exp $
-- $Id: DriverFlags.hs,v 1.6
5
2001/08/1
5 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
}
...
...
ghc/compiler/main/DriverPhases.hs
View file @
3696ab39
-----------------------------------------------------------------------------
-- $Id: DriverPhases.hs,v 1.1
1
2001/0
6/22 13:28
:4
4
rrt Exp $
-- $Id: DriverPhases.hs,v 1.1
2
2001/0
8/15 09:32
:4
0
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"
])
...
...
ghc/compiler/main/DriverPipeline.hs
View file @
3696ab39
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.9
7
2001/08/15 0
0
:3
6:54 sof
Exp $
-- $Id: DriverPipeline.hs,v 1.9
8
2001/08/15 0
9
:3
2: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
,
...
...
ghc/compiler/main/SysTools.lhs
View file @
3696ab39
-----------------------------------------------------------------------------
-- $Id: SysTools.lhs,v 1.4
8
2001/08/1
3 15:49:38 simonmar
Exp $
-- $Id: SysTools.lhs,v 1.4
9
2001/08/1
5 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 on
w
is used to override a particular program with a new on
e
\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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment