ghc/compiler/main/CodeOutput.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section{Code output phase}
   5
   6 \begin{code}
   7 module CodeOutput( codeOutput ) where
   8
   9 #include "HsVersions.h"
  10
  11 #if ! OMIT_NATIVE_CODEGEN
  12 import AsmCodeGen       ( nativeCodeGen )
  13 #endif
  14
  15 import AbsCSyn          ( AbstractC, absCNop )
  16 import PprAbsC          ( dumpRealC, writeRealC )
  17 import UniqSupply       ( UniqSupply )
  18 import Module           ( Module, moduleString )
  19 import CmdLineOpts
  20 import Maybes           ( maybeToBool )
  21 import ErrUtils         ( doIfSet, dumpIfSet )
  22 import Outputable
  23 import IO               ( IOMode(..), hPutStr, hClose, openFile, stderr )
  24 \end{code}
  25
  26
  27 \begin{code}
  28 codeOutput :: Module
  29            -> SDoc              -- C stubs for foreign exported functions
  30            -> SDoc              -- Header file prototype for foreign exported functions
  31            -> AbstractC         -- Compiled abstract C
  32            -> UniqSupply
  33            -> IO ()
  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]
  38
  39     dumpIfSet opt_D_dump_stix "Final stix code" stix_final >>
  40
  41     dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d    >>
  42     doOutput opt_ProduceS ncg_output_w                  >>
  43
  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        >>
  46
  47     dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
  48     outputForeignStubs False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w        >>
  49
  50     dumpIfSet opt_D_dump_realC "Real C" c_output_d      >>
  51     doOutput opt_ProduceC c_output_w
  52
  53   where
  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"
  61
  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
  65
  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
  69
  70     c_output_d = dumpRealC flat_absC_c
  71     c_output_w = (\ f -> writeRealC f flat_absC_c)
  72
  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
  77 #else
  78     (stix_final, ncg_output_d)
  79        = nativeCodeGen flat_absC_ncg ncg_uniqs
  80     ncg_output_w = (\ f -> printForAsm f ncg_output_d)
  81 #endif
  82
  83
  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 =
  89   case switch of
  90     Nothing    -> return ()
  91     Just fname -> writeFile fname (include_prefix ++ doc_str)
  92  where
  93   include_prefix
  94    | is_header   = "#include \"Rts.h\"\n"
  95    | otherwise   = "#include \"RtsAPI.h\"\n"
  96
  97 doOutput switch io_action
  98   = case switch of
  99           Nothing    -> return ()
 100           Just fname ->
 101             openFile fname WriteMode    >>= \ handle ->
 102             io_action handle            >>
 103             hClose handle
 104 \end{code}
 105