[commit: ghc] master: Define the right RTS config in the Windows dyn wrapper programs (192c7b7)

Ian Lynagh igloo at earth.li
Wed May 15 16:30:42 CEST 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/192c7b74eb439221c20203c603e5b3c5a9d98cc3

>---------------------------------------------------------------

commit 192c7b74eb439221c20203c603e5b3c5a9d98cc3
Author: Ian Lynagh <ian at well-typed.com>
Date:   Tue May 14 21:23:58 2013 +0100

    Define the right RTS config in the Windows dyn wrapper programs
    
    This is particularly important as without it validate fails, as it
    tries to pass RTS options to haddock, and with the default RTS config
    those options aren't permitted.

>---------------------------------------------------------------

 driver/utils/dynwrapper.c |  8 +++++---
 rules/build-prog.mk       | 17 +++++++++++++++++
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/driver/utils/dynwrapper.c b/driver/utils/dynwrapper.c
index eead8bd..a84b5ae 100644
--- a/driver/utils/dynwrapper.c
+++ b/driver/utils/dynwrapper.c
@@ -4,6 +4,7 @@ Need to concatenate this file with something that defines:
 LPTSTR path_dirs[];
 LPTSTR progDll;
 LPTSTR rtsDll;
+int rtsOpts;
 */
 
 #include <stdarg.h>
@@ -161,7 +162,7 @@ int main(int argc, char *argv[]) {
     LPTSTR oldPath;
 
     StgClosure *main_p;
-    RtsConfig *rts_config_p;
+    RtsConfig rts_config;
     hs_main_t hs_main_p;
 
     // MSDN says: An environment variable has a maximum size limit of
@@ -189,9 +190,10 @@ int main(int argc, char *argv[]) {
     hRtsDll = GetNonNullModuleHandle(rtsDll);
 
     hs_main_p    = GetNonNullProcAddress(hRtsDll,  "hs_main");
-    rts_config_p = GetNonNullProcAddress(hRtsDll,  "defaultRtsConfig");
     main_p       = GetNonNullProcAddress(hProgDll, "ZCMain_main_closure");
+    rts_config.rts_opts_enabled = rtsOpts;
+    rts_config.rts_opts = NULL;
 
-    return hs_main_p(argc, argv, main_p, *rts_config_p);
+    return hs_main_p(argc, argv, main_p, rts_config);
 }
 
diff --git a/rules/build-prog.mk b/rules/build-prog.mk
index 9d1e589..d362d42 100644
--- a/rules/build-prog.mk
+++ b/rules/build-prog.mk
@@ -213,15 +213,32 @@ endif
 
 ifeq "$$($1_$2_PROG_NEEDS_C_WRAPPER)" "YES"
 
+$1_$2_RTS_OPTS_FLAG = $$(lastword $$(filter -rtsopts -rtsopts=all -rtsopts=some -rtsopts=none -no-rtsopts,$$($1_$2_$$($1_$2_PROGRAM_WAY)_ALL_HC_OPTS)))
+ifeq "$$($1_$2_RTS_OPTS_FLAG)" "-rtsopts"
+$1_$2_RTS_OPTS = RtsOptsAll
+else ifeq "$$($1_$2_RTS_OPTS_FLAG)" "-rtsopts=all"
+$1_$2_RTS_OPTS = RtsOptsAll
+else ifeq "$$($1_$2_RTS_OPTS_FLAG)" "-rtsopts=some"
+$1_$2_RTS_OPTS = RtsOptsSafeOnly
+else ifeq "$$($1_$2_RTS_OPTS_FLAG)" "-rtsopts=none"
+$1_$2_RTS_OPTS = RtsOptsNone
+else ifeq "$$($1_$2_RTS_OPTS_FLAG)" "-no-rtsopts"
+$1_$2_RTS_OPTS = RtsOptsNone
+else
+$1_$2_RTS_OPTS = RtsOptsSafeOnly
+endif
+
 $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/.
 	$$(call removeFiles,$$@)
 	echo '#include <Windows.h>' >> $$@
+	echo '#include "Rts.h"' >> $$@
 	echo 'LPTSTR path_dirs[] = {' >> $$@
 	$$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo '    TEXT("$$d")$$(comma)' >> $$@))
 	echo '    TEXT("$1/$2/build/tmp/"),' >> $$@
 	echo '    NULL};' >> $$@
 	echo 'LPTSTR progDll = TEXT("../../$1/$2/build/tmp/$$($1_$2_PROG).dll");' >> $$@
 	echo 'LPTSTR rtsDll = TEXT("$$($$(WINDOWS_DYN_PROG_RTS))");' >> $$@
+	echo 'int rtsOpts = $$($1_$2_RTS_OPTS);' >> $$@
 	cat driver/utils/dynwrapper.c >> $$@
 
 $1/$2/build/tmp/$$($1_$2_PROG) : $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c $1/$2/build/tmp/$$($1_$2_PROG).dll | $$$$(dir $$$$@)/.





More information about the ghc-commits mailing list