Commit 50a70f64 authored by sof's avatar sof
Browse files

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

Misc tweaks to Win32 DLL setup
parent 38171834
/* -----------------------------------------------------------------------------
* $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)));
......
/* -----------------------------------------------------------------------------
* $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
......
#-----------------------------------------------------------------------------
# $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
#
......
/* -----------------------------------------------------------------------------
* $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>
......
/* ----------------------------------------------------------------------------
* $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)
{
......
/* -----------------------------------------------------------------------------
* $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();
......
/* -----------------------------------------------------------------------------
* $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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment