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 #ifndef OMIT_NATIVE_CODEGEN
  12 import AsmCodeGen       ( nativeCodeGen )
  13 #endif
  14
  15 #ifdef ILX
  16 import IlxGen           ( ilxGen )
  17 #endif
  18
  19 import JavaGen          ( javaGen )
  20 import qualified PrintJava
  21
  22 import TyCon            ( TyCon )
  23 import Id               ( Id )
  24 import CoreSyn          ( CoreBind )
  25 import StgSyn           ( StgBinding )
  26 import AbsCSyn          ( AbstractC )
  27 import PprAbsC          ( dumpRealC, writeRealC )
  28 import Module           ( Module )
  29 import CmdLineOpts
  30 import ErrUtils         ( dumpIfSet_dyn, showPass )
  31 import Outputable
  32 import CmdLineOpts      ( DynFlags, HscLang(..), dopt_OutName )
  33 import TmpFiles         ( newTempName )
  34 import UniqSupply       ( mkSplitUniqSupply )
  35
  36 import IO               ( IOMode(..), hClose, openFile, Handle )
  37 \end{code}
  38
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection{Steering}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 \begin{code}
  47 codeOutput :: DynFlags
  48            -> Module
  49            -> [TyCon]                   -- Local tycons
  50            -> [CoreBind]                -- Core bindings
  51            -> [(StgBinding,[Id])]       -- The STG program with SRTs
  52            -> SDoc              -- C stubs for foreign exported functions
  53            -> SDoc              -- Header file prototype for foreign exported functions
  54            -> AbstractC         -- Compiled abstract C
  55            -> IO (Maybe FilePath, Maybe FilePath)
  56 codeOutput dflags mod_name tycons core_binds stg_binds
  57            c_code h_code flat_abstractC
  58   = -- You can have C (c_output) or assembly-language (ncg_output),
  59     -- but not both.  [Allowing for both gives a space leak on
  60     -- flat_abstractC.  WDP 94/10]
  61
  62     -- Dunno if the above comment is still meaningful now.  JRS 001024.
  63
  64     do  { showPass dflags "CodeOutput"
  65         ; let filenm = dopt_OutName dflags
  66         ; stub_names <- outputForeignStubs dflags c_code h_code
  67         ; case dopt_HscLang dflags of
  68              HscInterpreted -> return stub_names
  69              HscAsm         -> outputAsm dflags filenm flat_abstractC
  70                                >> return stub_names
  71              HscC           -> outputC dflags filenm flat_abstractC
  72                                >> return stub_names
  73              HscJava        -> outputJava dflags filenm mod_name tycons core_binds
  74                                >> return stub_names
  75         }
  76
  77 doOutput :: String -> (Handle -> IO ()) -> IO ()
  78 doOutput filenm io_action
  79   = (do handle <- openFile filenm WriteMode
  80         io_action handle
  81         hClose handle)
  82     `catch` (\err -> pprPanic "Failed to open or write code output file"
  83                               (text filenm))
  84 \end{code}
  85
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 \subsection{C}
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 \begin{code}
  94 outputC dflags filenm flat_absC
  95   = do dumpIfSet_dyn dflags Opt_D_dump_realC "Real C" (dumpRealC flat_absC)
  96        doOutput filenm (\ h -> writeRealC h flat_absC)
  97 \end{code}
  98
  99
 100 %************************************************************************
 101 %*                                                                      *
 102 \subsection{Assembler}
 103 %*                                                                      *
 104 %************************************************************************
 105
 106 \begin{code}
 107 outputAsm dflags filenm flat_absC
 108
 109 #ifndef OMIT_NATIVE_CODEGEN
 110
 111   = do ncg_uniqs <- mkSplitUniqSupply 'n'
 112        let (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
 113        dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
 114        dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
 115        doOutput filenm ( \f -> printForAsm f ncg_output_d)
 116   where
 117
 118 #else /* OMIT_NATIVE_CODEGEN */
 119
 120   = pprPanic "This compiler was built without a native code generator"
 121              (text "Use -fvia-C instead")
 122
 123 #endif
 124 \end{code}
 125
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection{Java}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 \begin{code}
 134 outputJava dflags filenm mod tycons core_binds
 135   = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java)
 136         -- User style printing for now to keep indentation
 137   where
 138     java_code = javaGen mod [{- Should be imports-}] tycons core_binds
 139     pp_java   = PrintJava.compilationUnit java_code
 140 \end{code}
 141
 142
 143 %************************************************************************
 144 %*                                                                      *
 145 \subsection{Foreign import/export}
 146 %*                                                                      *
 147 %************************************************************************
 148
 149 \begin{code}
 150 outputForeignStubs dflags c_code h_code
 151   = do
 152         dumpIfSet_dyn dflags Opt_D_dump_foreign
 153                       "Foreign export header file" stub_h_output_d
 154
 155         maybe_stub_h_file
 156            <- outputForeignStubs_help True{-.h output-} stub_h_output_w
 157
 158         dumpIfSet_dyn dflags Opt_D_dump_foreign
 159                       "Foreign export stubs" stub_c_output_d
 160
 161         maybe_stub_c_file
 162            <- outputForeignStubs_help False{-not .h-} stub_c_output_w
 163
 164         return (maybe_stub_h_file, maybe_stub_c_file)
 165   where
 166     -- C stubs for "foreign export"ed functions.
 167     stub_c_output_d = pprCode CStyle c_code
 168     stub_c_output_w = showSDoc stub_c_output_d
 169
 170     -- Header file protos for "foreign export"ed functions.
 171     stub_h_output_d = pprCode CStyle h_code
 172     stub_h_output_w = showSDoc stub_h_output_d
 173
 174
 175 -- Don't use doOutput for dumping the f. export stubs
 176 -- since it is more than likely that the stubs file will
 177 -- turn out to be empty, in which case no file should be created.
 178 outputForeignStubs_help is_header ""      = return Nothing
 179 outputForeignStubs_help is_header doc_str
 180    = do fname <- newTempName suffix
 181         writeFile fname (include_prefix ++ doc_str)
 182         return (Just fname)
 183   where
 184     suffix
 185        | is_header   = "h_stub"
 186        | otherwise   = "c_stub"
 187     include_prefix
 188        | is_header   = "#include \"HsFFI.h\"\n"
 189        | otherwise   = "#include \"RtsAPI.h\"\n"
 190 \end{code}
 191