diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 05728ca3eaa73ea80360d7e94cfd23488b129d97..9bee6b2696c258fcc1f1edb973587c938ef9d2a9 100644
--- 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 52467e5b78c80f4a2b86e788ba044830259bf541..fc23a1e9fde6299cb9efc1fc85d26a0b05e785c6 100644
--- 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 c7a7a67a2f40f700559552f0fdbda33a4dfeed54..44da0b70322f232a2bd1400581df59c683368baf 100644
--- 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 092dab3279995885ba700c53dbcb54a020fcd821..0b71aef5131f7c8a466455d11663868af9e3fe55 100644
--- 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 31067fae6564ad9c3530aefe207b63a8f1012874..0a486576129f2bb8d5fb1b699480c136347917dc 100644
--- 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 e7b813f6eb91da79dc58635b6010cff183813028..c8cc08420cf264c3bbbdb7f63b2fc3a66120cf87 100644
--- 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 3b83f5bd6370ae056d8c8f4392d925760e703926..f53410461f808d58a55cf2c1d40346877048f61b 100644
--- 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