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