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 #ifndef OMIT_NATIVE_CODEGEN
12 import AsmCodeGen ( nativeCodeGen )
15 import IlxGen ( ilxGen )
18 import TyCon ( TyCon )
20 import Class ( Class )
21 import StgSyn ( StgBinding )
22 import AbsCSyn ( AbstractC, absCNop )
23 import PprAbsC ( dumpRealC, writeRealC )
24 import UniqSupply ( UniqSupply )
25 import Module ( Module, moduleString )
27 import Maybes ( maybeToBool )
28 import ErrUtils ( doIfSet, dumpIfSet )
30 import IO ( IOMode(..), hPutStr, hClose, openFile )
36 -> [TyCon] -> [Class] -- Local tycons and classes
37 -> [(StgBinding,[Id])] -- The STG program with SRTs
38 -> SDoc -- C stubs for foreign exported functions
39 -> SDoc -- Header file prototype for foreign exported functions
40 -> AbstractC -- Compiled abstract C
43 codeOutput mod_name tycons classes stg_binds c_code h_code flat_abstractC ncg_uniqs
44 = -- You can have C (c_output) or assembly-language (ncg_output),
45 -- but not both. [Allowing for both gives a space leak on
46 -- flat_abstractC. WDP 94/10]
48 #ifndef OMIT_NATIVE_CODEGEN
50 (stix_final, ncg_output_d) = nativeCodeGen flat_absC_ncg ncg_uniqs
51 ncg_output_w = (\ f -> printForAsm f ncg_output_d)
53 dumpIfSet opt_D_dump_stix "Final stix code" stix_final >>
54 dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d >>
55 doOutput opt_ProduceS ncg_output_w >>
58 doOutput opt_ProduceS (\f -> printForUser f (ilxGen tycons stg_binds)) >>
62 dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d >>
63 outputForeignStubs True{-.h output-} opt_ProduceExportHStubs stub_h_output_w >>
65 dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
66 outputForeignStubs False{-not .h-} opt_ProduceExportCStubs stub_c_output_w >>
68 dumpIfSet opt_D_dump_realC "Real C" c_output_d >>
69 doOutput opt_ProduceC c_output_w
72 (flat_absC_c, flat_absC_ncg) =
73 case (maybeToBool opt_ProduceC || opt_D_dump_realC,
74 maybeToBool opt_ProduceS || opt_D_dump_asm) of
75 (True, False) -> (flat_abstractC, absCNop)
76 (False, True) -> (absCNop, flat_abstractC)
77 (False, False) -> (absCNop, absCNop)
78 (True, True) -> error "ERROR: Can't do both .hc and .s at the same time"
80 -- C stubs for "foreign export"ed functions.
81 stub_c_output_d = pprCode CStyle c_code
82 stub_c_output_w = showSDoc stub_c_output_d
84 -- Header file protos for "foreign export"ed functions.
85 stub_h_output_d = pprCode CStyle h_code
86 stub_h_output_w = showSDoc stub_h_output_d
88 c_output_d = dumpRealC flat_absC_c
89 c_output_w = (\ f -> writeRealC f flat_absC_c)
92 -- don't use doOutput for dumping the f. export stubs
93 -- since it is more than likely that the stubs file will
94 -- turn out to be empty, in which case no file should be created.
95 outputForeignStubs is_header switch "" = return ()
96 outputForeignStubs is_header switch doc_str =
99 Just fname -> writeFile fname (include_prefix ++ doc_str)
102 | is_header = "#include \"Rts.h\"\n"
103 | otherwise = "#include \"RtsAPI.h\"\n"
105 doOutput switch io_action
109 openFile fname WriteMode >>= \ handle ->