1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
\section{Code output phase}
\begin{code}
module CodeOutput( codeOutput ) where
#include "HsVersions.h"
#if ! OMIT_NATIVE_CODEGEN
import AsmCodeGen ( nativeCodeGen )
#endif
import AbsCSyn ( AbstractC, absCNop )
import PprAbsC ( dumpRealC, writeRealC )
import UniqSupply ( UniqSupply )
import Module ( Module, moduleString )
import CmdLineOpts
import Maybes ( maybeToBool )
import ErrUtils ( doIfSet, dumpIfSet )
import Outputable
import IO ( IOMode(..), hPutStr, hClose, openFile, stderr )
\end{code}
\begin{code}
codeOutput :: Module
-> SDoc -- C stubs for foreign exported functions
-> SDoc -- Header file prototype for foreign exported functions
-> AbstractC -- Compiled abstract C
-> UniqSupply
-> IO ()
codeOutput mod_name 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]
dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d >>
doOutput opt_ProduceS ncg_output_w >>
dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d >>
outputHStub opt_ProduceExportHStubs stub_h_output_w >>
dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
outputCStub mod_name opt_ProduceExportCStubs stub_c_output_w >>
dumpIfSet opt_D_dump_realC "Real C" c_output_d >>
doOutput opt_ProduceC c_output_w
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"
-- C stubs for "foreign export"ed functions.
stub_c_output_d = pprCode CStyle c_code
stub_c_output_w = showSDoc stub_c_output_d
-- Header file protos for "foreign export"ed functions.
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)
-- Native code generation done here!
#if OMIT_NATIVE_CODEGEN
ncg_output_d = error "*** GHC not built with a native-code generator ***"
ncg_output_w = ncg_output_d
#else
ncg_output_d = nativeCodeGen flat_absC_ncg ncg_uniqs
ncg_output_w = (\ f -> printForAsm f ncg_output_d)
#endif
-- 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.
outputCStub mod_name switch ""
= return ()
outputCStub mod_name switch doc_str
= case switch of
Nothing -> return ()
Just fname -> writeFile fname ("#include \"Rts.h\"\n#include \"RtsAPI.h\"\n"++rest)
where
rest = "#include "++show (moduleString mod_name ++ "_stub.h") ++ '\n':doc_str
outputHStub switch ""
= return ()
outputHStub switch doc_str
= case switch of
Nothing -> return ()
Just fname -> writeFile fname ("#include \"Rts.h\"\n"++doc_str)
doOutput switch io_action
= case switch of
Nothing -> return ()
Just fname ->
openFile fname WriteMode >>= \ handle ->
io_action handle >>
hClose handle
\end{code}
|
