From 663b391470a783e8f23414c07c18a020850d2fb8 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Sun, 26 Aug 2007 07:33:22 +0000 Subject: [PATCH] Refactoring only: remove [Id] field from ForeignStubs We used to pass the list of top-level foreign exported bindings to the code generator so that it could create StablePtrs for them in the stginit code. Now we don't use stginit unless profiling, and the StablePtrs are generated by C functions marked with attribute((constructor)). This patch removes various bits associated with the old way of doing things, which were previously left in place in case we wanted to switch back, I presume. Also I refactored dsForeigns to clean it up a bit. --- compiler/codeGen/CodeGen.lhs | 8 ++-- compiler/deSugar/DsForeign.lhs | 88 ++++++++++++++++++++-------------------- compiler/main/CodeOutput.lhs | 6 +-- compiler/main/HscMain.lhs | 2 +- compiler/main/HscTypes.lhs | 2 - 5 files changed, 50 insertions(+), 56 deletions(-) diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs index 64ee9e4..eaaae2c 100644 --- a/compiler/codeGen/CodeGen.lhs +++ b/compiler/codeGen/CodeGen.lhs @@ -57,14 +57,13 @@ import Panic codeGen :: DynFlags -> Module -> [TyCon] - -> ForeignStubs -> [Module] -- directly-imported modules -> CollectedCCs -- (Local/global) cost-centres needing declaring/registering. -> [(StgBinding,[(Id,[Id])])] -- Bindings to convert, with SRTs -> HpcInfo -> IO [Cmm] -- Output -codeGen dflags this_mod data_tycons foreign_stubs imported_mods +codeGen dflags this_mod data_tycons imported_mods cost_centre_info stg_binds hpc_info = do { showPass dflags "CodeGen" @@ -79,7 +78,7 @@ codeGen dflags this_mod data_tycons foreign_stubs imported_mods ; cmm_tycons <- mapM cgTyCon data_tycons ; cmm_init <- getCmm (mkModuleInit way cost_centre_info this_mod main_mod - foreign_stubs imported_mods hpc_info) + imported_mods hpc_info) ; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init]) } -- Put datatype_stuff after code_stuff, because the @@ -141,11 +140,10 @@ mkModuleInit -> CollectedCCs -- cost centre info -> Module -> Module -- name of the Main module - -> ForeignStubs -> [Module] -> HpcInfo -> Code -mkModuleInit way cost_centre_info this_mod main_mod foreign_stubs imported_mods hpc_info +mkModuleInit way cost_centre_info this_mod main_mod imported_mods hpc_info = do { -- Allocate the static boolean that records if this -- module has been registered already emitData Data [CmmDataLabel moduleRegdLabel, diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 10e072e..ea264ab 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -40,6 +40,7 @@ import Outputable import FastString import Data.Maybe +import Data.List \end{code} Desugaring of @foreign@ declarations is naturally split up into @@ -64,32 +65,31 @@ dsForeigns :: [LForeignDecl Id] dsForeigns [] = returnDs (NoStubs, []) dsForeigns fos - = foldlDs combine (ForeignStubs empty empty [] [], []) fos - where - combine stubs (L loc decl) = putSrcSpanDs loc (combine1 stubs decl) - - combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) - (ForeignImport id _ spec) + = do + fives <- mapM do_ldecl fos + let + (hs, cs, hdrs, idss, bindss) = unzip5 fives + fe_ids = concat idss + fe_init_code = map foreignExportInitialiser fe_ids + -- + return (ForeignStubs + (vcat hs) + (vcat cs $$ vcat fe_init_code) + (nub (concat hdrs)), + (concat bindss)) + where + do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) + + do_decl (ForeignImport id _ spec) = traceIf (text "fi start" <+> ppr id) `thenDs` \ _ -> dsFImport (unLoc id) spec `thenDs` \ (bs, h, c, mbhd) -> traceIf (text "fi end" <+> ppr id) `thenDs` \ _ -> - returnDs (ForeignStubs (h $$ acc_h) - (c $$ acc_c) - (addH mbhd acc_hdrs) - acc_feb, - bs ++ acc_f) - - combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) - (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv))) + returnDs (h, c, maybeToList mbhd, [], bs) + + do_decl (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv))) = dsFExport id (idType id) ext_nm cconv False `thenDs` \(h, c, _, _) -> - returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb), - acc_f) - - addH Nothing ls = ls - addH (Just e) ls - | e `elem` ls = ls - | otherwise = e:ls + returnDs (h, c, [], [id], []) \end{code} @@ -505,28 +505,6 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi - -- Initialise foreign exports by registering a stable pointer from an - -- __attribute__((constructor)) function. - -- The alternative is to do this from stginit functions generated in - -- codeGen/CodeGen.lhs; however, stginit functions have a negative impact - -- on binary sizes and link times because the static linker will think that - -- all modules that are imported directly or indirectly are actually used by - -- the program. - -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) - - initialiser - = case maybe_target of - Nothing -> empty - Just hs_fn -> - vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "getStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) - ] - -- finally, the whole darn thing c_bits = space $$ @@ -559,8 +537,28 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc , if res_hty_is_unit then empty else text "return cret;" , rbrace - ] $$ - initialiser + ] + + +foreignExportInitialiser :: Id -> SDoc +foreignExportInitialiser hs_fn = + -- Initialise foreign exports by registering a stable pointer from an + -- __attribute__((constructor)) function. + -- The alternative is to do this from stginit functions generated in + -- codeGen/CodeGen.lhs; however, stginit functions have a negative impact + -- on binary sizes and link times because the static linker will think that + -- all modules that are imported directly or indirectly are actually used by + -- the program. + -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + vcat + [ text "static void stginit_export_" <> ppr hs_fn + <> text "() __attribute__((constructor));" + , text "static void stginit_export_" <> ppr hs_fn <> text "()" + , braces (text "getStablePtr" + <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") + <> semi) + ] + -- NB. the calculation here isn't strictly speaking correct. -- We have a primitive Haskell type (eg. Int#, Double#), and diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index b155a35..25a10f6 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -124,8 +124,8 @@ outputC dflags filenm mod location flat_absC ffi_decl_headers = case foreign_stubs of - NoStubs -> [] - ForeignStubs _ _ fdhs _ -> map unpackFS (nub fdhs) + NoStubs -> [] + ForeignStubs _ _ fdhs -> map unpackFS (nub fdhs) -- Remove duplicates, because distinct foreign import decls -- may cite the same #include. Order doesn't matter. @@ -217,7 +217,7 @@ outputForeignStubs dflags mod location stubs stub_h_exists <- doesFileExist stub_h return (stub_h_exists, stub_c_exists) - | ForeignStubs h_code c_code _ _ <- stubs + | ForeignStubs h_code c_code _ <- stubs = do let stub_c_output_d = pprCode CStyle c_code diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 346e804..a9c9a15 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -601,7 +601,7 @@ hscCompile cgguts ------------------ Code generation ------------------ abstractC <- {-# SCC "CodeGen" #-} codeGen dflags this_mod data_tycons - foreign_stubs dir_imps cost_centre_info + dir_imps cost_centre_info stg_binds hpc_info ------------------ Convert to CPS -------------------- --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index acb47c5..cb5022e 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -608,8 +608,6 @@ data ForeignStubs = NoStubs -- "foreign exported" functions [FastString] -- Headers that need to be included -- into C code generated for this module - [Id] -- Foreign-exported binders - -- we have to generate code to register these \end{code} -- 1.7.10.4