From 8c84944d5782f2ee60d96c02977f15ba9e7ab935 Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Sat, 14 Nov 2009 06:04:55 +0000 Subject: [PATCH] Don't share low valued Int and Char closures with Windows DLLs --- compiler/codeGen/CgCon.lhs | 8 ++++++++ compiler/codeGen/StgCmmCon.hs | 8 +++++++- compiler/main/DriverPipeline.hs | 15 +++++++++++++-- includes/RtsAPI.h | 14 ++++++++++---- includes/stg/DLL.h | 8 ++++++++ rts/StgMiscClosures.cmm | 9 +++++++-- rts/sm/Evac.c | 12 +++++++++++- 7 files changed, 64 insertions(+), 10 deletions(-) diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 89a4e84..36c851d 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -165,7 +165,13 @@ which is guaranteed in range. Because of this, we use can safely return an addressing mode. +We don't support this optimisation when compiling into Windows DLLs yet +because they don't support cross package data references well. + \begin{code} + + +#if !(defined(__PIC__) && defined(mingw32_HOST_OS)) buildDynCon binder _ con [arg_amode] | maybeIntLikeCon con , (_, CmmLit (CmmInt val _)) <- arg_amode @@ -187,6 +193,8 @@ buildDynCon binder _ con [arg_amode] -- CHARLIKE closures consist of a header and one word payload charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW) ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) } +#endif + \end{code} Now the general case. diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 452a352..18c2509 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -147,8 +147,13 @@ work with any old argument, but for @Int@-like ones the argument has to be a literal. Reason: @Char@ like closures have an argument type which is guaranteed in range. -Because of this, we use can safely return an addressing mode. -} +Because of this, we use can safely return an addressing mode. +We don't support this optimisation when compiling into Windows DLLs yet +because they don't support cross package data references well. +-} + +#if !(defined(__PIC__) && defined(mingw32_HOST_OS)) buildDynCon binder _cc con [arg] | maybeIntLikeCon con , StgLitArg (MachInt val) <- arg @@ -172,6 +177,7 @@ buildDynCon binder _cc con [arg] -- CHARLIKE closures consist of a header and one word payload charlike_amode = cmmLabelOffW charlike_lbl offsetW ; return (litIdInfo binder (mkConLFInfo con) charlike_amode, mkNop) } +#endif -------- buildDynCon: the general case ----------- buildDynCon binder ccs con args diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index dae697d..1d94b49 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -974,14 +974,13 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc then [] else [ "-ffloat-store" ]) ++ #endif + -- gcc's -fstrict-aliasing allows two accesses to memory -- to be considered non-aliasing if they have different types. -- This interacts badly with the C code we generate, which is -- very weakly typed, being derived from C--. ["-fno-strict-aliasing"] - - liftIO $ SysTools.runCc dflags ( -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. @@ -997,6 +996,18 @@ runPhase cc_phase _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc ++ map SysTools.Option ( md_c_flags ++ pic_c_flags + +#if defined(__PIC__) && defined(mingw32_HOST_OS) + -- Stub files generated for foreign exports references the runIO_closure + -- and runNonIO_closure symbols, which are defined in the base package. + -- These symbols are imported into the stub.c file via RtsAPI.h, and the + -- way we do the import depends on whether we're currently compiling + -- the base package or not. + ++ (if thisPackage dflags == basePackageId + then [ "-DCOMPILING_BASE_PACKAGE" ] + else []) +#endif + #ifdef sparc_TARGET_ARCH -- We only support SparcV9 and better because V8 lacks an atomic CAS -- instruction. Note that the user can still override this diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h index ff2bc11..03dbce2 100644 --- a/includes/RtsAPI.h +++ b/includes/RtsAPI.h @@ -162,10 +162,16 @@ rts_getSchedStatus (Capability *cap); These are used by foreign export and foreign import "wrapper" stubs. ----------------------------------------------------------------------- */ -extern StgWord base_GHCziTopHandler_runIO_closure[]; -extern StgWord base_GHCziTopHandler_runNonIO_closure[]; -#define runIO_closure base_GHCziTopHandler_runIO_closure -#define runNonIO_closure base_GHCziTopHandler_runNonIO_closure +// When producing Windows DLLs the compiler needs to know which symbols +// are in the local package/DLL vs external ones. +// DLL_IMPORT_BASE expands to __declspec(dllimport) when we're not compiling +// the the base package. + +DLL_IMPORT_BASE extern StgWord base_GHCziTopHandler_runIO_closure[]; +DLL_IMPORT_BASE extern StgWord base_GHCziTopHandler_runNonIO_closure[]; + +#define runIO_closure base_GHCziTopHandler_runIO_closure +#define runNonIO_closure base_GHCziTopHandler_runNonIO_closure /* ------------------------------------------------------------------------ */ diff --git a/includes/stg/DLL.h b/includes/stg/DLL.h index b7e7c5a..f08d1cd 100644 --- a/includes/stg/DLL.h +++ b/includes/stg/DLL.h @@ -52,6 +52,14 @@ # endif #endif + +#ifdef COMPILING_BASE_PACKAGE +# define DLL_IMPORT_BASE +#else +# define DLL_IMPORT_BASE DLLIMPORT +#endif + + #ifdef COMPILING_STDLIB #define DLL_IMPORT_STDLIB #else diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index 95b22a9..5e74d3f 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -564,10 +564,12 @@ CLOSURE(stg_dummy_ret_closure,stg_dummy_ret); #if defined(__PIC__) && defined(mingw32_TARGET_OS) /* - * When sticking the RTS in a DLL, we delay populating the + * When sticking the RTS in a Windows DLL, we delay populating the * Charlike and Intlike tables until load-time, which is only * when we've got the real addresses to the C# and I# closures. - * + * + * -- this is currently broken BL 2009/11/14. + * we don't rewrite to static closures at all with Windows DLLs. */ #warning Is this correct? _imp is a pointer! #define Char_hash_static_info _imp__ghczmprim_GHCziTypes_Czh_static_info @@ -587,6 +589,7 @@ CLOSURE(stg_dummy_ret_closure,stg_dummy_ret); /* end the name with _closure, to convince the mangler this is a closure */ +#if !(defined(__PIC__) && defined(mingw32_HOST_OS)) section "data" { stg_CHARLIKE_closure: CHARLIKE_HDR(0) @@ -883,3 +886,5 @@ section "data" { INTLIKE_HDR(15) INTLIKE_HDR(16) /* MAX_INTLIKE == 16 */ } + +#endif // !(defined(__PIC__) && defined(mingw32_HOST_OS)) diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 379fbba..3212ce5 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -549,8 +549,17 @@ loop: copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); return; + // For ints and chars of low value, save space by replacing references to + // these with closures with references to common, shared ones in the RTS. + // + // * Except when compiling into Windows DLLs which don't support cross-package + // data references very well. + // case CONSTR_0_1: - { + { +#if defined(__PIC__) && defined(mingw32_HOST_OS) + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); +#else StgWord w = (StgWord)q->payload[0]; if (info == Czh_con_info && // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && @@ -568,6 +577,7 @@ loop: else { copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); } +#endif return; } -- 1.7.10.4