Commit c30bd911 authored by simonpj's avatar simonpj

[project @ 2000-04-21 12:57:54 by simonpj]

/home/simonpj/tmp/msg
parent 1abb301c
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.73 2000/03/31 03:09:35 hwloidl Exp $
# $Id: Makefile,v 1.74 2000/04/21 12:57:54 simonpj Exp $
TOP = ..
include $(TOP)/mk/boilerplate.mk
......@@ -37,7 +37,7 @@ $(HS_PROG) :: $(HS_SRCS)
DIRS = \
utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn \
specialise simplCore stranal stgSyn simplStg codeGen absCSyn main \
profiling parser usageSP cprAnalysis
profiling parser usageSP cprAnalysis javaGen
ifeq ($(GhcWithNativeCodeGen),YES)
......
......@@ -27,7 +27,7 @@ import PrimRep ( getPrimRepSize, PrimRep(..) )
import Unique ( Unique{-instance Eq-} )
import UniqSupply ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
UniqSupply )
import CmdLineOpts ( opt_ProduceC, opt_EmitCExternDecls )
import CmdLineOpts ( opt_OutputLanguage, opt_EmitCExternDecls )
import Maybes ( maybeToBool )
import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) )
import Panic ( panic )
......@@ -330,7 +330,7 @@ flatAbsC (CSwitch discrim alts deflt)
returnFlt ( (tag, alt_heres), alt_tops )
flatAbsC stmt@(COpStmt results (CCallOp ccall) args vol_regs)
| isCandidate && maybeToBool opt_ProduceC
| isCandidate && opt_OutputLanguage == Just "C" -- Urgh
= returnFlt (stmt, tdef)
where
(isCandidate, isDyn) =
......
......@@ -133,11 +133,9 @@ module CmdLineOpts (
opt_NoImplicitPrelude,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
opt_ProduceC,
opt_ProduceExportCStubs,
opt_ProduceExportHStubs,
opt_ProduceHi,
opt_ProduceS,
opt_NoPruneDecls,
opt_ReportCompile,
opt_SourceUnchanged,
......@@ -145,6 +143,9 @@ module CmdLineOpts (
opt_Unregisterised,
opt_Verbose,
opt_OutputLanguage,
opt_OutputFile,
-- Code generation
opt_UseVanillaRegs,
opt_UseFloatRegs,
......@@ -412,11 +413,20 @@ opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check")
opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude")
opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
opt_ProduceC = lookup_str "-C="
opt_ProduceExportCStubs = lookup_str "-F="
opt_ProduceExportHStubs = lookup_str "-FH="
opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time
-- Language for output: "C", "asm", "java", maybe more
-- Nothing => don't output anything
opt_OutputLanguage :: Maybe String
opt_OutputLanguage = lookup_str "-olang="
opt_OutputFile :: String
opt_OutputFile = case lookup_str "-ofile=" of
Nothing -> panic "No output file specified (-ofile=xxx)"
Just f -> f
-- Simplifier switches
opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining")
-- NoPreInlining is there just to see how bad things
......@@ -439,7 +449,6 @@ opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::F
opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for
opt_UF_DearOp = ( 4 :: Int)
opt_ProduceS = lookup_str "-S="
opt_ReportCompile = lookUp SLIT("-freport-compile")
opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls")
opt_SourceUnchanged = lookUp SLIT("-fsource-unchanged")
......
......@@ -11,13 +11,18 @@ module CodeOutput( codeOutput ) where
#ifndef OMIT_NATIVE_CODEGEN
import AsmCodeGen ( nativeCodeGen )
#endif
#ifdef ILX
import IlxGen ( ilxGen )
#endif
import JavaGen ( javaGen )
import qualified PrintJava
import TyCon ( TyCon )
import Id ( Id )
import Class ( Class )
import CoreSyn ( CoreBind )
import StgSyn ( StgBinding )
import AbsCSyn ( AbstractC, absCNop )
import PprAbsC ( dumpRealC, writeRealC )
......@@ -31,52 +36,117 @@ import IO ( IOMode(..), hPutStr, hClose, openFile )
\end{code}
%************************************************************************
%* *
\subsection{Steering}
%* *
%************************************************************************
\begin{code}
codeOutput :: Module
-> [TyCon] -> [Class] -- Local tycons and classes
-> [CoreBind] -- Core bindings
-> [(StgBinding,[Id])] -- The STG program with SRTs
-> SDoc -- C stubs for foreign exported functions
-> SDoc -- Header file prototype for foreign exported functions
-> AbstractC -- Compiled abstract C
-> UniqSupply
-> IO ()
codeOutput mod_name tycons classes stg_binds c_code h_code flat_abstractC ncg_uniqs
codeOutput mod_name tycons classes core_binds stg_binds
c_code h_code flat_abstractC ncg_uniqs
= -- You can have C (c_output) or assembly-language (ncg_output),
-- but not both. [Allowing for both gives a space leak on
-- flat_abstractC. WDP 94/10]
do {
outputForeignStubs c_code h_code ;
case opt_OutputLanguage of {
Nothing -> return () -- No -olang=xxx flag; so no-op
; Just "asm" -> outputAsm flat_abstractC ncg_uniqs
; Just "C" -> outputC flat_abstractC
; Just "java" -> outputJava mod_name tycons core_binds
; Just foo -> pprPanic "Don't understand output language" (quotes (text foo))
} }
doOutput io_action
= (do handle <- openFile opt_OutputFile WriteMode
io_action handle
hClose handle)
`catch` (\err -> pprPanic "Failed to open or write code output file" (text opt_OutputFile))
\end{code}
%************************************************************************
%* *
\subsection{C}
%* *
%************************************************************************
\begin{code}
outputC flat_absC
= do
dumpIfSet opt_D_dump_realC "Real C" (dumpRealC flat_absC)
doOutput (\ h -> writeRealC h flat_absC)
\end{code}
%************************************************************************
%* *
\subsection{Assembler}
%* *
%************************************************************************
\begin{code}
outputAsm flat_absC ncg_uniqs
#ifndef OMIT_NATIVE_CODEGEN
let
(stix_final, ncg_output_d) = nativeCodeGen flat_absC_ncg ncg_uniqs
ncg_output_w = (\ f -> printForAsm f ncg_output_d)
in
dumpIfSet opt_D_dump_stix "Final stix code" stix_final >>
dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d >>
doOutput opt_ProduceS ncg_output_w >>
#else
#ifdef ILX
doOutput opt_ProduceS (\f -> printForUser f (ilxGen tycons stg_binds)) >>
#endif
#endif
dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d >>
outputForeignStubs True{-.h output-} opt_ProduceExportHStubs stub_h_output_w >>
= do dumpIfSet opt_D_dump_stix "Final stix code" stix_final
dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d
doOutput (\ f -> printForAsm f ncg_output_d)
where
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
#else /* OMIT_NATIVE_CODEGEN */
= do hPutStrLn stderr "This compiler was built without a native code generator"
hPutStrLn stderr "Use -fvia-C instead"
#endif
\end{code}
dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
outputForeignStubs False{-not .h-} opt_ProduceExportCStubs stub_c_output_w >>
dumpIfSet opt_D_dump_realC "Real C" c_output_d >>
doOutput opt_ProduceC c_output_w
%************************************************************************
%* *
\subsection{Java}
%* *
%************************************************************************
\begin{code}
outputJava mod tycons core_binds
= doOutput (\ f -> printForUser f pp_java)
-- User style printing for now to keep indentation
where
(flat_absC_c, flat_absC_ncg) =
case (maybeToBool opt_ProduceC || opt_D_dump_realC,
maybeToBool opt_ProduceS || opt_D_dump_asm) of
(True, False) -> (flat_abstractC, absCNop)
(False, True) -> (absCNop, flat_abstractC)
(False, False) -> (absCNop, absCNop)
(True, True) -> error "ERROR: Can't do both .hc and .s at the same time"
java_code = javaGen mod [{- Should be imports-}] tycons core_binds
pp_java = PrintJava.compilationUnit java_code
\end{code}
%************************************************************************
%* *
\subsection{Foreign import/export}
%* *
%************************************************************************
\begin{code}
outputForeignStubs c_code h_code
= do
dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d
outputForeignStubs_help True{-.h output-} opt_ProduceExportHStubs stub_h_output_w
dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d
outputForeignStubs_help False{-not .h-} opt_ProduceExportCStubs stub_c_output_w
where
-- C stubs for "foreign export"ed functions.
stub_c_output_d = pprCode CStyle c_code
stub_c_output_w = showSDoc stub_c_output_d
......@@ -85,15 +155,12 @@ codeOutput mod_name tycons classes stg_binds c_code h_code flat_abstractC ncg_un
stub_h_output_d = pprCode CStyle h_code
stub_h_output_w = showSDoc stub_h_output_d
c_output_d = dumpRealC flat_absC_c
c_output_w = (\ f -> writeRealC f flat_absC_c)
-- 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 is_header switch "" = return ()
outputForeignStubs is_header switch doc_str =
-- 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 switch "" = return ()
outputForeignStubs_help is_header switch doc_str =
case switch of
Nothing -> return ()
Just fname -> writeFile fname (include_prefix ++ doc_str)
......@@ -101,13 +168,5 @@ outputForeignStubs is_header switch doc_str =
include_prefix
| is_header = "#include \"Rts.h\"\n"
| otherwise = "#include \"RtsAPI.h\"\n"
doOutput switch io_action
= case switch of
Nothing -> return ()
Just fname ->
openFile fname WriteMode >>= \ handle ->
io_action handle >>
hClose handle
\end{code}
......@@ -208,7 +208,8 @@ doIt (core_cmds, stg_cmds)
-------------------------- Code output -------------------------------
show_pass "CodeOutput" >>
_scc_ "CodeOutput"
codeOutput this_mod local_tycons local_classes stg_binds2
codeOutput this_mod local_tycons local_classes
tidy_binds stg_binds2
c_code h_code abstractC
ncg_uniqs >>
......
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