[project @ 1999-05-10 08:23:55 by sof]

Added a DllMain() which starts up RTS upon DLL load.

diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h
index 081bcf9..f219b7a 100644 (file)
--- a/ghc/includes/Stg.h
+++ b/ghc/includes/Stg.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------

- * $Id: Stg.h,v 1.10 1999/05/04 08:52:22 sof Exp $
+ * $Id: Stg.h,v 1.11 1999/05/10 08:23:57 sof Exp $

  *
  * (c) The GHC Team, 1998-1999
  *
  *
  * (c) The GHC Team, 1998-1999
  *

@@ -119,7 +119,7 @@ void _stgAssert (char *, unsigned int);
 #include "Hooks.h"
 
 /* Misc stuff without a home */
 #include "Hooks.h"
 
 /* Misc stuff without a home */

-#ifdef BUILDING_RTS_DLL
+#if defined(ENABLE_WIN32_DLL_SUPPOT) && !defined(COMPILING_RTS)

 extern DLLIMPORT char **prog_argv;     /* so we can get at these from Haskell */
 extern DLLIMPORT int    prog_argc;
 #else
 extern DLLIMPORT char **prog_argv;     /* so we can get at these from Haskell */
 extern DLLIMPORT int    prog_argc;
 #else

diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
index 1b7bcba..45c1596 100644 (file)
--- a/ghc/rts/Main.c
+++ b/ghc/rts/Main.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------

- * $Id: Main.c,v 1.6 1999/03/03 19:20:42 sof Exp $
+ * $Id: Main.c,v 1.7 1999/05/10 08:23:55 sof Exp $

  *
  * (c) The GHC Team 1998-1999
  *
  *
  * (c) The GHC Team 1998-1999
  *

@@ -29,21 +29,28 @@
 #include "LLC.h"
 #endif
 
 #include "LLC.h"
 #endif
 

+#ifdef HAVE_WINDOWS_H
+#include <windows.h>
+#endif
+
+
+#ifndef ENABLE_WIN32_DLL_SUPPORT
+

 /* Hack: we assume that we're building a batch-mode system unless 
  * INTERPRETER is set
  */
 /* Hack: we assume that we're building a batch-mode system unless 
  * INTERPRETER is set
  */

-#ifndef INTERPRETER /* Hack */
+# ifndef INTERPRETER /* Hack */

 int main(int argc, char *argv[])
 {
     SchedulerStatus status;
     startupHaskell(argc,argv);
 
 int main(int argc, char *argv[])
 {
     SchedulerStatus status;
     startupHaskell(argc,argv);
 

-#ifndef PAR
+#  ifndef PAR

     MainTSO = createIOThread(stg_max(BLOCK_SIZE_W,
                                     RtsFlags.GcFlags.initialStkSize),
                             (StgClosure *)&mainIO_closure);
     status = schedule(MainTSO,NULL);
     MainTSO = createIOThread(stg_max(BLOCK_SIZE_W,
                                     RtsFlags.GcFlags.initialStkSize),
                             (StgClosure *)&mainIO_closure);
     status = schedule(MainTSO,NULL);

-#else
+#  else

     if (IAmMainThread == rtsTrue) {
     /*Just to show we're alive */
       fprintf(stderr, "Main Thread Started ...\n");
     if (IAmMainThread == rtsTrue) {
     /*Just to show we're alive */
       fprintf(stderr, "Main Thread Started ...\n");

@@ -56,7 +63,7 @@ int main(int argc, char *argv[])
       WaitForPEOp(PP_FINISH,SysManTask);
       exit(EXIT_SUCCESS);
     }
       WaitForPEOp(PP_FINISH,SysManTask);
       exit(EXIT_SUCCESS);
     }

-#endif /* PAR */
+#  endif /* PAR */

     switch (status) {
     case AllBlocked:
       barf("Scheduler stopped, all threads blocked");
     switch (status) {
     case AllBlocked:
       barf("Scheduler stopped, all threads blocked");

@@ -72,4 +79,32 @@ int main(int argc, char *argv[])
     shutdownHaskell();
     stg_exit(EXIT_SUCCESS);
 }
     shutdownHaskell();
     stg_exit(EXIT_SUCCESS);
 }

-#endif /* BATCH_MODE */
+# endif /* BATCH_MODE */
+
+#else   /* !ENABLE_WIN32_DLL_SUPPORT */
+
+static char* args[] = { "ghcRts" };
+
+BOOL
+WINAPI
+DllMain ( HINSTANCE hInstance
+        , DWORD reason
+       , LPVOID reserved
+       )
+{
+  /*
+    ToDo: let the user configure RTS options to use
+          via the registry.
+   */
+  switch (reason) {
+  case DLL_PROCESS_ATTACH:
+    startupHaskell(args,1);
+    /* ToDo: gracefully handle startupHaskell() failures.. */
+    return TRUE;
+  case DLL_PROCESS_DETACH:
+    shutdownHaskell();
+  }
+  return TRUE;
+}
+
+#endif /* !ENABLE_WIN32_DLL_SUPPORT */

diff --git a/ghc/rts/Makefile b/ghc/rts/Makefile
index 44da0b7..5de1c24 100644 (file)
--- a/ghc/rts/Makefile
+++ b/ghc/rts/Makefile
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
 #-----------------------------------------------------------------------------

-# $Id: Makefile,v 1.9 1999/05/04 10:19:17 sof Exp $
+# $Id: Makefile,v 1.10 1999/05/10 08:23:55 sof Exp $

 
 #  This is the Makefile for the runtime-system stuff.
 #  This stuff is written in C (and cannot be written in Haskell).
 
 #  This is the Makefile for the runtime-system stuff.
 #  This stuff is written in C (and cannot be written in Haskell).

@@ -88,14 +88,21 @@ unexport CC
 # 
 ifeq "$(way)" "dll"
 DLL_NAME          = HSrts.dll
 # 
 ifeq "$(way)" "dll"
 DLL_NAME          = HSrts.dll

-SRC_BLD_DLL_OPTS += --def HSrts.def -lwinmm -lHS_imp -lgmp -L. -Lgmp
+SRC_BLD_DLL_OPTS += --def HSrts.def -lwinmm -lHS_imp_stub -lgmp -L. -Lgmp

 
 

-LIBOBJS := $(filter-out Main.$(way_)o, $(LIBOBJS))
+#
+# Need an import library containing the symbols the RTS uses from the Prelude.
+# So, to avoid bootstrapping trouble, we build one containing just the syms
+# we need. Weirdly named to avoid clashing later on when compiling the contents
+# of ghc/lib/..
+#
+# Note: if you do change the name of the Prelude DLL, the "--dllname <nm>.dll"
+# below will need to be updated as well.

 
 

-$(DLL_NAME) :: libHS_imp.a
+$(DLL_NAME) :: libHS_imp_stub.a

 
 

-libHS_imp.a :
-       dlltool --output-lib libHS_imp.a --def HSprel.def --dllname HSprel.dll
+libHS_imp_stub.a :
+       dlltool --output-lib libHS_imp_stub.a --def HSprel.def --dllname HSprel.dll

 
 # It's not included in the DLL, but we need to compile it up separately.
 all :: Main.dll_o
 
 # It's not included in the DLL, but we need to compile it up separately.
 all :: Main.dll_o

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index c8cc084..49ccb42 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
 /* -----------------------------------------------------------------------------

- * $Id: RtsStartup.c,v 1.11 1999/05/04 10:19:19 sof Exp $
+ * $Id: RtsStartup.c,v 1.12 1999/05/10 08:23:56 sof Exp $

  *
  * (c) The GHC Team, 1998-1999
  *
  *
  * (c) The GHC Team, 1998-1999
  *

@@ -35,7 +35,8 @@
  */
 struct RTS_FLAGS RtsFlags;
 
  */
 struct RTS_FLAGS RtsFlags;
 

-extern void startupHaskell(int argc, char *argv[])
+void
+startupHaskell(int argc, char *argv[])

 {
     static int rts_has_started_up = 0;
     int i;
 {
     static int rts_has_started_up = 0;
     int i;

@@ -87,7 +88,7 @@ extern void startupHaskell(int argc, char *argv[])
     prog_argc = argc;
     prog_argv = argv;
 
     prog_argc = argc;
     prog_argv = argv;
 

-#if defined(PAR)
+#ifdef PAR

    /* Initialise the parallel system -- before initHeap! */
     initParallelSystem();
    /* And start GranSim profiling if required: omitted for now
    /* Initialise the parallel system -- before initHeap! */
     initParallelSystem();
    /* And start GranSim profiling if required: omitted for now

@@ -122,8 +123,6 @@ extern void startupHaskell(int argc, char *argv[])
        filling in the tables with references to where the
        static info tables have been loaded inside the running
        process.
        filling in the tables with references to where the
        static info tables have been loaded inside the running
        process.

-       
-       Ditto for Bool closure tbl.

     */
 #ifdef ENABLE_WIN32_DLL_SUPPORT
     for(i=0;i<=255;i++)
     */
 #ifdef ENABLE_WIN32_DLL_SUPPORT
     for(i=0;i<=255;i++)