[project @ 1999-05-04 10:19:14 by sof]

Misc tweaks to Win32 DLL setup

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 05728ca..9bee6b2 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.57 1999/03/26 10:29:04 simonm Exp $
+ * $Id: GC.c,v 1.58 1999/05/04 10:19:14 sof Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -1134,8 +1134,8 @@ loop:
   /* make sure the info pointer is into text space */
   ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q))
               || IS_HUGS_CONSTR_INFO(GET_INFO(q))));
-
   info = get_itbl(q);
+
   switch (info -> type) {
 
   case BCO:
@@ -1511,7 +1511,7 @@ scavenge_srt(const StgInfoTable *info)
        If the SRT entry hasn't got bit 0 set, the SRT entry points to a
        closure that's fixed at link-time, and no extra magic is required.
     */
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef ENABLE_WIN32_DLL_SUPPORT
     if ( stgCast(unsigned long,*srt) & 0x1 ) {
        evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
     } else {
@@ -2323,8 +2323,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
      
     /* Is q a pointer to a closure?
      */
-
-    if (! LOOKS_LIKE_GHC_INFO(q)) {
+    if (! LOOKS_LIKE_GHC_INFO(q) ) {
 #ifdef DEBUG
       if ( 0 && LOOKS_LIKE_STATIC_CLOSURE(q) ) {  /* Is it a static closure? */
        ASSERT(closure_STATIC(stgCast(StgClosure*,q)));

diff --git a/ghc/rts/MBlock.h b/ghc/rts/MBlock.h
index 52467e5..fc23a1e 100644 (file)
--- a/ghc/rts/MBlock.h
+++ b/ghc/rts/MBlock.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: MBlock.h,v 1.5 1999/03/03 19:04:57 sof Exp $
+ * $Id: MBlock.h,v 1.6 1999/05/04 10:19:16 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -9,7 +9,7 @@
 
 extern lnat mblocks_allocated;
 
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef ENABLE_WIN32_DLL_SUPPORT
 extern int is_heap_alloced(const void* p);
 #endif
 

diff --git a/ghc/rts/Makefile b/ghc/rts/Makefile
index c7a7a67..44da0b7 100644 (file)
--- a/ghc/rts/Makefile
+++ b/ghc/rts/Makefile
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.8 1999/04/27 09:37:04 simonm Exp $
+# $Id: Makefile,v 1.9 1999/05/04 10:19:17 sof Exp $
 
 #  This is the Makefile for the runtime-system stuff.
 #  This stuff is written in C (and cannot be written in Haskell).
@@ -56,7 +56,9 @@ WARNING_OPTS += -optc-Wbad-function-cast
 SRC_HC_OPTS += -I../includes -I. -Igum $(WARNING_OPTS) $(GhcRtsHcOpts) -optc-DCOMPILING_RTS
 SRC_CC_OPTS = $(GhcRtsCcOpts)
 
-DLLWRAP = dllwrap
+ifneq "$(way)" "dll"
+SRC_HC_OPTS += -static
+endif
 
 ifeq "$(way)" "mp"
 SRC_HC_OPTS += -I$$PVM_ROOT/include
@@ -84,12 +86,22 @@ unexport CC
 #
 #  Building DLLs is only supported on mingw32 at the moment.
 # 
-ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-dll ::
-       $(CP) -f libHSrts.a libHSrts_dll.a
-       ar d libHSrts_dll.a Main.o
-       $(DLLWRAP) -mno-cygwin --target=i386-mingw32 --export-all --output-lib libHSrts_imp.a --def HSrts.def -o HSrts.dll libHSrts_dll.a -lwinmm -lHS -lgmp -L. -Lgmp
+ifeq "$(way)" "dll"
+DLL_NAME          = HSrts.dll
+SRC_BLD_DLL_OPTS += --def HSrts.def -lwinmm -lHS_imp -lgmp -L. -Lgmp
+
+LIBOBJS := $(filter-out Main.$(way_)o, $(LIBOBJS))
+
+$(DLL_NAME) :: libHS_imp.a
+
+libHS_imp.a :
+       dlltool --output-lib libHS_imp.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
+
 endif
+
 # -----------------------------------------------------------------------------
 # Compile GMP only if we don't have it already
 #

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 092dab3..0b71aef 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,6 +1,6 @@
 
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.11 1999/04/27 12:27:49 sewardj Exp $
+ * $Id: Printer.c,v 1.12 1999/05/04 10:19:17 sof Exp $
  *
  * Copyright (c) 1994-1999.
  *
@@ -704,7 +704,10 @@ static void printZcoded( const char *raw )
  * Symbol table loading
  * ------------------------------------------------------------------------*/
 
-#ifdef HAVE_BFD_H
+/* Causing linking trouble on Win32 plats, so I'm
+   disabling this for now. 
+*/
+#if defined(HAVE_BFD_H) && !defined(_WIN32)
 
 #include <bfd.h>
 

diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c
index 31067fa..0a48657 100644 (file)
--- a/ghc/rts/RtsAPI.c
+++ b/ghc/rts/RtsAPI.c
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: RtsAPI.c,v 1.5 1999/03/03 19:20:15 sof Exp $
+ * $Id: RtsAPI.c,v 1.6 1999/05/04 10:19:18 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -13,8 +13,11 @@
 #include "RtsFlags.h"
 #include "RtsUtils.h"
 
+/* This is a temporary fudge until the scheduler guarantees
+   that the result returned from an evalIO() is fully evaluated.
+*/
 #define CHASE_OUT_INDIRECTIONS(p) \
-   while ((p)->header.info == &IND_info) { p=((StgInd*)p)->indirectee; }
+   while ((p)->header.info == &IND_info || (p)->header.info == &IND_STATIC_info || (p)->header.info == &IND_OLDGEN_info || (p)->header.info == &IND_PERM_info || (p)->header.info == &IND_OLDGEN_PERM_info) { p=((StgInd*)p)->indirectee; }
 
 /* ----------------------------------------------------------------------------
    Building Haskell objects from C datatypes.
@@ -226,7 +229,21 @@ rts_getInt (HaskellObj p)
 {
   CHASE_OUT_INDIRECTIONS(p);
 
-  if ( 1 || /* ToDo: accommodate I32's here as well */
+  if ( 1 ||
+       p->header.info == (const StgInfoTable*)&Izh_con_info || 
+       p->header.info == (const StgInfoTable*)&Izh_static_info ) {
+    return (int)(p->payload[0]);
+  } else {
+    barf("getInt: not an Int");
+  }
+}
+
+int
+rts_getInt32 (HaskellObj p)
+{
+  CHASE_OUT_INDIRECTIONS(p);
+
+  if ( 1 ||
        p->header.info == (const StgInfoTable*)&Izh_con_info || 
        p->header.info == (const StgInfoTable*)&Izh_static_info ) {
     return (int)(p->payload[0]);
@@ -249,6 +266,20 @@ rts_getWord (HaskellObj p)
   }
 }
 
+unsigned int
+rts_getWord32 (HaskellObj p)
+{
+  CHASE_OUT_INDIRECTIONS(p);
+
+  if ( 1 || /* see above comment */
+       p->header.info == (const StgInfoTable*)&Wzh_con_info ||
+       p->header.info == (const StgInfoTable*)&Wzh_static_info ) {
+    return (unsigned int)(p->payload[0]);
+  } else {
+    barf("getWord: not a Word");
+  }
+}
+
 float
 rts_getFloat (HaskellObj p)
 {

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index e7b813f..c8cc084 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.10 1999/04/27 12:30:26 simonm Exp $
+ * $Id: RtsStartup.c,v 1.11 1999/05/04 10:19:19 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -125,15 +125,13 @@ extern void startupHaskell(int argc, char *argv[])
        
        Ditto for Bool closure tbl.
     */
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef ENABLE_WIN32_DLL_SUPPORT
     for(i=0;i<=255;i++)
        (CHARLIKE_closure[i]).header.info = (const StgInfoTable*)&Czh_static_info;
 
     for(i=0;i<=32;i++)
        (INTLIKE_closure[i]).header.info = (const StgInfoTable*)&Izh_static_info;
        
-    PrelBase_Bool_closure_tbl[0] = (const StgClosure*)&False_closure;
-    PrelBase_Bool_closure_tbl[1] = (const StgClosure*)&True_closure;
 #endif
     /* Record initialization times */
     end_init();

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 3b83f5b..f534104 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.20 1999/04/23 09:47:33 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.21 1999/05/04 10:19:19 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -463,7 +463,7 @@ INFO_TABLE_CONSTR(StablePtr_static_info,Hugs_CONSTR_entry,0,sizeofW(StgStablePtr
    replace them with references to the static objects.
    -------------------------------------------------------------------------- */
 
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef ENABLE_WIN32_DLL_SUPPORT
 /*
  * When sticking the RTS in a DLL, we delay populating the
  * Charlike and Intlike tables until load-time, which is only