2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section{Code output phase}
7 module CodeOutput( codeOutput ) where
9 #include "HsVersions.h"
11 #if ! OMIT_NATIVE_CODEGEN
12 import AsmCodeGen ( nativeCodeGen )
15 import AbsCSyn ( AbstractC, absCNop )
16 import PprAbsC ( dumpRealC, writeRealC )
17 import UniqSupply ( UniqSupply )
18 import Module ( Module, moduleString )
20 import Maybes ( maybeToBool )
21 import ErrUtils ( doIfSet, dumpIfSet )
23 import IO ( IOMode(..), hPutStr, hClose, openFile, stderr )
29 -> SDoc -- C stubs for foreign exported functions
30 -> SDoc -- Header file prototype for foreign exported functions
31 -> AbstractC -- Compiled abstract C
34 codeOutput mod_name c_code h_code flat_abstractC ncg_uniqs
35 = -- You can have C (c_output) or assembly-language (ncg_output),
36 -- but not both. [Allowing for both gives a space leak on
37 -- flat_abstractC. WDP 94/10]
39 dumpIfSet opt_D_dump_stix "Final stix code" stix_final >>
41 dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d >>
42 doOutput opt_ProduceS ncg_output_w >>
44 dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d >>
45 outputForeignStubs True{-.h output-} opt_ProduceExportHStubs stub_h_output_w >>
47 dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
48 outputForeignStubs False{-not .h-} opt_ProduceExportCStubs stub_c_output_w >>
50 dumpIfSet opt_D_dump_realC "Real C" c_output_d >>
51 doOutput opt_ProduceC c_output_w
54 (flat_absC_c, flat_absC_ncg) =
55 case (maybeToBool opt_ProduceC || opt_D_dump_realC,
56 maybeToBool opt_ProduceS || opt_D_dump_asm) of
57 (True, False) -> (flat_abstractC, absCNop)
58 (False, True) -> (absCNop, flat_abstractC)
59 (False, False) -> (absCNop, absCNop)
60 (True, True) -> error "ERROR: Can't do both .hc and .s at the same time"
62 -- C stubs for "foreign export"ed functions.
63 stub_c_output_d = pprCode CStyle c_code
64 stub_c_output_w = showSDoc stub_c_output_d
66 -- Header file protos for "foreign export"ed functions.
67 stub_h_output_d = pprCode CStyle h_code
68 stub_h_output_w = showSDoc stub_h_output_d
70 c_output_d = dumpRealC flat_absC_c
71 c_output_w = (\ f -> writeRealC f flat_absC_c)
73 -- Native code generation done here!
74 #if OMIT_NATIVE_CODEGEN
75 ncg_output_d = error "*** GHC not built with a native-code generator ***"
76 ncg_output_w = ncg_output_d
78 (stix_raw, stix_opt, stix_final, ncg_output_d)
79 = nativeCodeGen flat_absC_ncg ncg_uniqs
80 ncg_output_w = (\ f -> printForAsm f ncg_output_d)
84 -- don't use doOutput for dumping the f. export stubs
85 -- since it is more than likely that the stubs file will
86 -- turn out to be empty, in which case no file should be created.
87 outputForeignStubs is_header switch "" = return ()
88 outputForeignStubs is_header switch doc_str =
91 Just fname -> writeFile fname (include_prefix ++ doc_str)
94 | is_header = "#include \"Rts.h\"\n"
95 | otherwise = "#include \"RtsAPI.h\"\n"
97 doOutput switch io_action
101 openFile fname WriteMode >>= \ handle ->