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