/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.21 2000/03/17 14:37:21 simonmar Exp $
+ * $Id: ClosureMacros.h,v 1.22 2000/05/26 10:14:33 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
#endif
-
-#ifdef HAVE_WIN32_DLL_SUPPORT
-extern int is_heap_alloced(const void* x);
-# define HEAP_ALLOCED(x) (is_heap_alloced(x))
+#ifdef HAVE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
+ extern int is_heap_alloced(const void* x);
+# define HEAP_ALLOCED(x) (is_heap_alloced(x))
#else
-# define HEAP_ALLOCED(x) IS_USER_PTR(x)
+# define HEAP_ALLOCED(x) IS_USER_PTR(x)
#endif
/* When working with Win32 DLLs, static closures are identified by
LOOKS_LIKE_STATIC()
- distinguishes between static and heap allocated data.
*/
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#if defined(HAVE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
+ /* definitely do not enable for mingw DietHEP */
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
/* Tiresome predicates needed to check for pointers into the closure tables */
-------------------------------------------------------------------------- */
#ifdef INTERPRETER
-#ifdef USE_MINIINTERPRETER
-/* yoiks: one of the dreaded pointer equality tests */
-#define IS_HUGS_CONSTR_INFO(info) (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
-#else
-#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
-#endif
+# ifdef USE_MINIINTERPRETER
+ /* yoiks: one of the dreaded pointer equality tests */
+# define IS_HUGS_CONSTR_INFO(info) \
+ (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
+# else
+# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+# endif
#else
-#define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
+# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
#endif
-#ifdef HAVE_WIN32_DLL_SUPPORT
-# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
+#ifdef HAVE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
+# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
+ && !LOOKS_LIKE_STATIC_CLOSURE(info))
#else
-# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
#endif
/* -----------------------------------------------------------------------------
/* ----------------------------------------------------------------------------
- * $Id: InfoMacros.h,v 1.11 2000/04/05 15:27:59 simonmar Exp $
+ * $Id: InfoMacros.h,v 1.12 2000/05/26 10:14:33 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
to distinguish these kinds of references.
(ToDo: fill in a more precise href.)
*/
-#ifdef HAVE_WIN32_DLL_SUPPORT
+#ifdef HAVE_WIN32_DLL_SUPPORT /* mingw DietHEP doesn't seem to care either way */
#define DLL_SRT_ENTRY(x) ((StgClosure*)(((char*)&DLL_IMPORT_DATA_VAR(x)) + 1))
#else
#define DLL_SRT_ENTRY(x) no-can-do
/* -----------------------------------------------------------------------------
- * $Id: Stg.h,v 1.30 2000/05/18 11:32:21 panne Exp $
+ * $Id: Stg.h,v 1.31 2000/05/26 10:14:33 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell */
DLL_IMPORT_RTS extern int prog_argc;
-extern char **environ;
+extern char **envyron;
extern void stackOverflow(void);
/* -----------------------------------------------------------------------------
- * $Id: TSO.h,v 1.15 2000/03/31 03:09:35 hwloidl Exp $
+ * $Id: TSO.h,v 1.16 2000/05/26 10:14:33 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
StgClosure *closure;
struct StgTSO_ *tso;
int fd;
-#if defined(INTERPRETER) && !defined(HAVE_SETITIMER)
- unsigned int target;
-#else
+#if defined(HAVE_SETITIMER) || defined(mingw32_TARGET_OS)
unsigned int delay;
+#else
+ unsigned int target;
#endif
} StgTSOBlockInfo;
wurble :: Int -> IO ()
wurble x = putStr ( "Hello Erik && Daan, today's magic number is: "
- ++ show x ++ "\n")
+ ++ show x
+ ++ show (take 100 (repeat 123.456))
+ ++ "\n")
EXPORTS
-DietHEP_impure_ptr = _impure_ptr
DH_GetProcAddress
DH_LoadLibrary
# --------------------------------------------------------------------------- #
-# $Id: Makefile,v 1.36 2000/05/12 13:49:54 sewardj Exp $ #
+# $Id: Makefile,v 1.37 2000/05/26 10:14:33 sewardj Exp $ #
# --------------------------------------------------------------------------- #
TOP = ..
# interpreter and relevant .a/.so files #
# --------------------------------------------------------------------- #
-ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
-DYN_EXT=.dll
-LIB_DL=
+ifneq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
+ ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
+ ## UNIX
+ LIB_BFD=-lbfd -liberty
+ DYN_EXT=.so
+ LIB_DL=-ldl
+ M_NO_CYGWIN=
+ else
+ ## mingw32
+ LIB_BFD=
+ DYN_EXT=.dll
+ LIB_DL=
+ M_NO_CYGWIN=-mno-cygwin
+ endif
else
-DYN_EXT=.so
-LIB_DL=-ldl
+ ## cygwin32
+ LIB_BFD=-lbfd -liberty
+ DYN_EXT=.dll
+ LIB_DL=
+ M_NO_CYGWIN=
endif
ifeq "$(HaveLibGmp)$" "YES"
translate.c codegen.c lift.c free.c stgSubst.c output.c \
hugs.c dynamic.c stg.c sainteger.c object.c interface.c
-SRC_CC_OPTS = -I$(GHC_INTERPRETER_DIR) -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) -D__HUGS__ -DCOMPILING_RTS -DNO_REGS -Wall -Wstrict-prototypes -Wno-unused -DDEBUG -Winline -g -O
+SRC_CC_OPTS = -I$(GHC_INTERPRETER_DIR) -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) -D__HUGS__ -DCOMPILING_RTS -DNO_REGS -Wall -Wstrict-prototypes -Wno-unused -DDEBUG -Winline $(M_NO_CYGWIN) -g -O
GHC_LIBS_NEEDED = $(GHC_RUNTIME_DIR)/libHSrts.a
../rts/StgCRun.o ../rts/PrimOps.o ../rts/Prelude.o ../rts/Storage.o \
../rts/Schedule.o ../rts/libHSrts.a
$(CC) -o $@ $(CC_OPTS) $^ $(GHC_LIBS_NEEDED) \
- -lbfd -liberty $(LibsReadline) $(LIB_DL) \
+ $(LIB_BFD) $(LibsReadline) $(LIB_DL) \
$(LIB_GMP) -lm
foobar:
make all
nHandle$(DYN_EXT): nHandle.c
-ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
+ifeq "$(DYN_EXT)" ".dll"
gcc -mno-cygwin -O -Wall -o nHandle.o -c nHandle.c
dllwrap -mno-cygwin --target=i386-mingw32 -o nHandle.dll \
-def nHandle.def nHandle.o
# --------------------------------------------------------------------------- #
-# $Id: Makefile-DietHEP,v 1.1 2000/05/12 15:59:37 sewardj Exp $ #
+# $Id: Makefile-DietHEP,v 1.2 2000/05/26 10:14:34 sewardj Exp $ #
# --------------------------------------------------------------------------- #
TOP = ..
# interpreter and relevant .a/.so files #
# --------------------------------------------------------------------- #
-ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
-DYN_EXT=.dll
-LIB_DL=
+ifneq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
+ ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
+ ## UNIX
+ LIB_BFD=-lbfd -liberty
+ DYN_EXT=.so
+ LIB_DL=-ldl
+ M_NO_CYGWIN=
+ else
+ ## mingw32
+ LIB_BFD=
+ DYN_EXT=.dll
+ LIB_DL=
+ M_NO_CYGWIN=-mno-cygwin
+ endif
else
-DYN_EXT=.so
-LIB_DL=-ldl
-endif
-
-ifeq "$(HaveLibGmp)$" "YES"
-LIB_GMP=-lgmp
-else
-LIB_GMP=../rts/gmp/libgmp.a
+ ## cygwin32
+ LIB_BFD=-lbfd -liberty
+ DYN_EXT=.dll
+ LIB_DL=
+ M_NO_CYGWIN=
endif
YACC = bison -y
translate.c codegen.c lift.c free.c stgSubst.c output.c \
hugs.c dynamic.c stg.c sainteger.c object.c interface.c
-SRC_CC_OPTS = -I$(GHC_INTERPRETER_DIR) -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) -D__HUGS__ -DCOMPILING_RTS -DNO_REGS -Wall -Wstrict-prototypes -Wno-unused -DDEBUG -Winline -g -DDIET_HEP
+SRC_CC_OPTS = -I$(GHC_INTERPRETER_DIR) -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) -D__HUGS__ -DCOMPILING_RTS -DNO_REGS -Wall -Wstrict-prototypes -Wno-unused -DDEBUG -Winline -g -DDIET_HEP -DBUILDING_DLL
GHC_LIBS_NEEDED = $(GHC_RUNTIME_DIR)/libHSrts.a \
$(GHC_RUNTIME_DIR)/gmp/libgmp.a
all :: parser.c $(GHC_LIBS_NEEDED) nHandle$(DYN_EXT) dh_demo.exe
-dh_demo.exe: DietHEP.dll
- gcc -Wall -g -o dh_demo.exe dh_demo.c DietHEP_dll.a
+dhtarfile: DietHEP.dll
+ rm -f DietHEP.h
+ ln -s ../includes/DietHEP.h .
+ tar cvf dhtarfile.tar --dereference DietHEP.h DietHEP.dll DietHEP_dll.a \
+ Dh_Demo.hs dh_demo.c dh_demo.exe \
+ lib library nHandle.dll Makefile-DietHEP
+ rm -f DietHEP.h
+ bzip2 -v dhtarfile.tar
+
+dh_demo.exe: DietHEP.dll dh_demo.c
+ gcc -Wall -g -o dh_demo.exe dh_demo.c -L./ -lDietHEP
### EXTREMELY hacky
-DietHEP.a: $(C_OBJS)
- rm -f DietHEP.o
- ld -r -o DietHEP.o $^ $(GHC_LIBS_NEEDED)
- rm -f DietHEP.a
- ar clq DietHEP.a DietHEP.o
- rm -f DietHEP.o
+DietHEP.dll: $(C_OBJS) $(GHC_LIBS_NEEDED)
+ dllwrap -o DietHEP.dll --def DietHEP.def --implib libDietHEP.a \
+ $(OBJS) $(GHC_LIBS_NEEDED)
foobar:
rm -f ../rts/libHSrts.a ../rts/libHSrts_u.a
make all
nHandle$(DYN_EXT): nHandle.c
-ifeq "$(TARGETPLATFORM)" "i386-unknown-cygwin32"
+ifeq "$(DYN_EXT)" ".dll"
gcc -mno-cygwin -O -Wall -o nHandle.o -c nHandle.c
dllwrap -mno-cygwin --target=i386-mingw32 -o nHandle.dll \
-def nHandle.def nHandle.o
# Cleanery & misc #
# --------------------------------------------------------------------- #
-CLEAN_FILES += hugs nHandle.dll
+CLEAN_FILES += hugs nHandle.dll DietHEP.dll
CLEAN_FILES += $(TOP)/ghc/rts/libHSrts.a $(TOP)/ghc/rts/*.o
CLEAN_FILES += parser.c
include $(TOP)/mk/target.mk
-
-
-include Makefile.DLLs
+++ /dev/null
-#-----------------------------------------------------------------------------#
-
-# Makefile.DLLs, version 0.7.
-
-# This Makefile contains rules for creating DLLs on Windows using gnu-win32.
-
-#-----------------------------------------------------------------------------#
-
-# The SYM_PREFIX is used as a prefix for the symbols in the files
-# that this makefiles automatically generates.
-#
-# The default SYM_PREFIX for libfoo.dll is `libfoo'.
-# But you can override this by setting `SYM_PREFIX-libfoo = blah'.
-
-SYM_PREFIX = $(firstword $(SYM_PREFIX-$*) $*)
-
-GUARD_MACRO = $(SYM_PREFIX)_GLOBALS_H
-DEFINE_DLL_MACRO = $(SYM_PREFIX)_DEFINE_DLL
-USE_DLL_MACRO = $(SYM_PREFIX)_USE_DLL
-IMP_MACRO = $(SYM_PREFIX)_IMP
-GLOBAL_MACRO = $(SYM_PREFIX)_GLOBAL
-IMPURE_PTR = $(SYM_PREFIX)_impure_ptr
-
-# This rule creates a `.def' file, which lists the symbols that are exported
-# from the DLL. We use `nm' to get a list of all the exported text (`T')
-# symbols and data symbols -- including uninitialized data (`B'),
-# initialized data (`D'), read-only data (`R'), and common blocks (`C').
-# We also export `_impure_ptr', suitably renamed, so that the
-# main program can do the necessary initialization of the DLL's _impure_ptr.
-# (Since there can be more than one DLL, we must rename _impure_ptr as
-# $(SYM_PREFIX)_impure_ptr to prevent name collisions.)
-#%.def: %.a
-# echo EXPORTS > $@
-# echo $(IMPURE_PTR) = _impure_ptr >> $@
-# nm $< | sed -n '/^........ [BCDRT] _/s/[^_]*_//p' >> $@
-
-# We need to use macros to access global data:
-# the user of the DLL must refer to `bar' as `(*__imp_bar)'.
-# This rule creates a pair of files `foo_dll.h' and `foo_globals.h'
-# which contains macros for doing this.
-#
-# The DLL may also contain some references to _impure_ptr
-# (e.g. stdin is defined as a macro which expands to _impure_ptr.stdin).
-# We need to provide a definition for this (otherwise it will link in
-# the definition in libccrt.o, which causes lots of problems,
-# eventually leading to undefined symbol `WinMain').
-# The DLL's entry function (below) will initialize the _impure_ptr variable
-# in the DLL so that they point to the main program's reent_data struct.
-
-%_dll.h:
- echo "/* automatically generated by Makefile.DLLs */" > $@
- echo "#ifndef $(GUARD_MACRO)" >> $@
- echo "#define $(GUARD_MACRO)" >> $@
- echo "" >> $@
- echo "#if defined(__GNUC__) && defined(__CYGWIN32__)" >> $@
- echo " #if defined($(USE_DLL_MACRO))" >> $@
- echo " #define $(IMP_MACRO)(name) __imp_##name" >> $@
- echo " #define $(GLOBAL_MACRO)(name) (*$(IMP_MACRO)(name))" >> $@
- echo " #include \"$*_globals.h\"" >> $@
- echo " #endif /* $(USE_DLL_MACRO) */" >> $@
- echo "#endif /* __GNUC__ && __CYGWIN32__ */" >> $@
- echo "" >> $@
- echo "#endif /* $(GUARD_MACRO) */" >> $@
-
-%_globals.h: %.a
- echo "/* automatically generated by Makefile.DLLs */" > $@
- for sym in $(IMPURE_PTR) \
- `nm $< | grep '^........ [BCDR] _' | sed 's/[^_]*_//'`; \
- do \
- echo "#define $$sym $(GLOBAL_MACRO)($$sym)" >> $@; \
- done
-
-%_dll.c:
- echo "/* automatically generated by Makefile.DLLs */" > $@
- echo "void *_impure_ptr;" >> $@
-
-# This rule creates the export object file (`foo.exp') which contains the
-# jump table array; this export object file becomes part of the DLL.
-# This rule also creates the import library (`foo_dll.a') which contains small
-# stubs for all the functions exported by the DLL which jump to them via the
-# jump table. Executables that will use the DLL must be linked against this
-# stub library.
-%.exp %_dll.a : %.def
- dlltool $(DLLTOOLFLAGS) $(DLLTOOLFLAGS-$*) \
- --def $< \
- --dllname $*.dll \
- --output-exp $*.exp \
- --output-lib $*_dll.a
-
-# The `sed' commands below are to convert DOS-style `C:\foo\bar'
-# pathnames into Unix-style `//c/foo/bar' pathnames.
-CYGWIN32_LIBS = $(shell echo \
- -L`dirname \`gcc -print-file-name=libgcc.a | \
- sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
- -L`dirname \`gcc -print-file-name=libcygwin.a | \
- sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
- -L`dirname \`gcc -print-file-name=libkernel32.a | \
- sed -e 's@^\\\\([A-Za-z]\\\\):@//\\\\1@g' -e 's@\\\\\\\\@/@g' \` ` \
- -lgcc -lcygwin -lkernel32 -lgcc)
-
-# Making relocatable DLLs doesn't seem to work.
-# Not quite sure why. The --image-base values below
-# where chosen at random, they seem to work on my machine.
-RELOCATABLE=no
-LDFLAGS-libgc += --image-base=0x2345000
-LDFLAGS-libmer += --image-base=0x1234000
-LDFLAGS-libmercury += --image-base=0x3456000
-
-ifeq "$(strip $(RELOCATABLE))" "yes"
-
-# to create relocatable DLLs, we need to do two passes
-# (warning: this is untested)
-%.dll: %.exp %.a %_dll.o dll_init.o dll_fixup.o
- $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $*.base \
- -e _dll_entry@12 \
- $*.exp $*.a $*_dll.o \
- dll_init.o dll_fixup.o \
- $(LDLIBS) $(LDLIBS-$*) \
- $(CYGWIN32_LIBS)
- # untested
- dlltool $(DLLTOOLFLAGS) $(DLLTOOLFLAGS-$*) \
- --def $*.def \
- --dllname $*.dll \
- --base-file $*.base \
- --output-exp $*.exp
- $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $*.base \
- -e _dll_entry@12 \
- $*.exp $*.a $*_dll.o \
- dll_init.o dll_fixup.o \
- $(LDLIBS) $(LDLIBS-$*) \
- $(CYGWIN32_LIBS)
- dlltool $(DLLTOOLFLAGS) $(DLLTOOLFLAGS-$*) \
- --def $*.def \
- --dllname $*.dll \
- --base-file $*.base \
- --output-exp $*.exp
- # end untested stuff
- $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll --base-file $*.base -o $@ \
- -e _dll_entry@12 \
- $*.exp $*.a $*_dll.o \
- dll_init.o dll_fixup.o \
- $(LDLIBS) $(LDLIBS-$*) \
- $(CYGWIN32_LIBS)
- rm -f $*.base
-
-else
-
-%.dll: %.exp %.a %_dll.o dll_fixup.o dll_init.o
- $(LD) $(LDFLAGS) $(LDFLAGS-$*) --dll -o $@ \
- -e _dll_entry@12 \
- $*.exp $*.a $*_dll.o \
- dll_init.o dll_fixup.o \
- $(LDLIBS) $(LDLIBS-$*) \
- $(CYGWIN32_LIBS)
-
-endif
-
-# This black magic piece of assembler needs to be linked in in order to
-# properly terminate the list of imported DLLs.
-dll_fixup.s:
- echo '.section .idata$$3' > dll_fixup.s
- echo '.long 0,0,0,0,0' >> dll_fixup.s
-
-dll_fixup.o: dll_fixup.s
- $(AS) $(ASFLAGS) -o dll_fixup.o dll_fixup.s
-
-# Windows requires each DLL to have an initialization function
-# that is called at certain points (thread/process attach/detach).
-# This one just initializes `_impure_ptr'.
-dll_init.c:
- echo '#include <stdio.h>' > dll_init.c
- echo 'extern struct _reent *_impure_ptr;' >> dll_init.c
- echo 'extern struct _reent *__imp_reent_data;' >> dll_init.c
- echo '__attribute__((stdcall))' >> dll_init.c
- echo 'int dll_entry(int handle, int reason, void *ptr)' >> dll_init.c
- echo '{ _impure_ptr=__imp_reent_data; return 1; }' >> dll_init.c
-
-# The following rule is just there to convince gcc
-# to keep otherwise unused intermediate targets around.
-dont_throw_away: dll_fixup.o dll_init.o
--- /dev/null
+
+Configure the rts with --target=i386-unknown-mingw32 (I think).
+Build it with this:
+
+ make EXTRA_HC_OPTS=-optc-DHAVE_WIN32_DLL_SUPPORT
+
+I think that will work.
+
+
* included in the distribution.
*
* $RCSfile: connect.h,v $
- * $Revision: 1.42 $
- * $Date: 2000/05/12 11:59:38 $
+ * $Revision: 1.43 $
+ * $Date: 2000/05/26 10:14:33 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
extern Void liftControl ( Int );
extern Void substitution ( Int );
extern Void typeChecker ( Int );
-extern Void interface ( Int );
+extern Void interfayce ( Int );
extern Void storage ( Int );
to get the signal mask to a sane state each time.
*/
#include <signal.h>
+
+#if !defined(mingw32_TARGET_OS)
+
#define setHandler(bh) { sigset_t mask; \
signal(SIGINT,bh); \
sigemptyset(&mask); \
sigprocmask(SIG_UNBLOCK, &mask, NULL); \
}
+#else
+
+#define setHandler(bh) do { } while(0)
+
+#endif /* !defined(mingw32_TARGET_OS) */
/*---------------------------------------------------------------------------
* Environment variables and the registry
#include <stdio.h>
#include <assert.h>
#include <windows.h>
-#include "../includes/DietHEP.h"
+//#include "../includes/DietHEP.h"
+
+
+typedef enum { dh_stdcall, dh_ccall } DH_CALLCONV;
+typedef int DH_MODULE;
+typedef char* DH_LPCSTR;
+
+__declspec(dllimport)
+extern DH_MODULE DH_LoadLibrary ( DH_LPCSTR modname );
+__declspec(dllimport)
+extern void* DH_GetProcAddress ( DH_CALLCONV cconv,
+ DH_MODULE hModule,
+ DH_LPCSTR lpProcName );
+
int main ( int argc, char** argv )
{
* included in the distribution.
*
* $RCSfile: hugs.c,v $
- * $Revision: 1.74 $
- * $Date: 2000/05/23 11:45:14 $
+ * $Revision: 1.75 $
+ * $Date: 2000/05/26 10:14:33 $
* ------------------------------------------------------------------------*/
#include <setjmp.h>
static Bool showStats = FALSE; /* TRUE => print stats after eval */
static Bool listScripts = TRUE; /* TRUE => list scripts after loading*/
static Bool addType = FALSE; /* TRUE => print type with value */
-static Bool useDots = RISCOS; /* TRUE => use dots in progress */
static Bool quiet = FALSE; /* TRUE => don't show progress */
static Bool lastWasObject = FALSE;
#ifdef DIET_HEP
+#include "StgDLL.h"
#include "DietHEP.h"
+extern void setRtsFlags ( int );
+
static int diet_hep_initialised = 0;
static
List modConIds; /* :: [CONID] */
Bool prelOK;
String s;
- String fakeargv[2] = { "diet_hep", NULL };
-
+ String fakeargv[] = { "diet_hep", "+RTS",
+ "-D0", "-RTS", NULL };
+ // GC = 32
+ // sanity = 128
if (diet_hep_initialised) return;
diet_hep_initialised = 1;
/* The following copied from interpreter() */
setBreakAction ( HugsIgnoreBreak );
- modConIds = initialize(0,fakeargv);
+ modConIds = initialize(sizeof(fakeargv)/sizeof(String)-1,fakeargv);
+ //setRtsFlags(4 | 128 | 32);
assert(isNull(modConIds));
setBreakAction ( HugsIgnoreBreak );
prelOK = loadThePrelude();
if (isModule(m)) return m; else return 0;
}
-DH_MODULE DH_LoadLibrary ( DH_LPCSTR modname )
-{
- int xxx;
- DH_MODULE hdl;
- diet_hep_initialise ( &xxx );
- hdl = DH_LoadLibrary_wrk ( modname );
- printf ( "hdl = %d\n", hdl );
- return hdl;
-}
-
-
static
void* DH_GetProcAddress_wrk ( DH_CALLCONV cconv,
DH_MODULE hModule,
return adj_thunk;
}
-void* DH_GetProcAddress ( DH_CALLCONV cconv,
- DH_MODULE hModule,
- DH_LPCSTR lpProcName )
+/*----------- EXPORTS -------------*/
+__declspec(dllexport)
+DH_MODULE
+DH_LoadLibrary ( DH_LPCSTR modname )
+{
+ int xxx;
+ DH_MODULE hdl;
+ diet_hep_initialise ( &xxx );
+ hdl = DH_LoadLibrary_wrk ( modname );
+ printf ( "hdl = %d\n", hdl );
+ return hdl;
+}
+
+
+__declspec(dllexport)
+void*
+DH_GetProcAddress ( DH_CALLCONV cconv,
+ DH_MODULE hModule,
+ DH_LPCSTR lpProcName )
{
int xxx;
diet_hep_initialise ( &xxx );
return DH_GetProcAddress_wrk ( cconv, hModule, lpProcName );
}
+
+#if 0
+BOOL APIENTRY
+DllMain (
+ HINSTANCE hInst /* Library instance handle. */ ,
+ DWORD reason /* Reason this function is being called. */ ,
+ LPVOID reserved /* Not used. */ )
+{
+
+ switch (reason)
+ {
+ case DLL_PROCESS_ATTACH:
+ break;
+
+ case DLL_PROCESS_DETACH:
+ break;
+
+ case DLL_THREAD_ATTACH:
+ break;
+
+ case DLL_THREAD_DETACH:
+ break;
+ }
+ return TRUE;
+}
+#endif
+
//---------------------------------
//--- testing it ...
+#if 0
int main ( int argc, char** argv )
{
void* proc;
fprintf ( stderr, "exiting safely\n");
return 0;
}
+#endif
#else
{'g', 1, "Print no. cells recovered after gc", &gcMessages},
{'l', 1, "Literate modules as default", &literateScripts},
{'e', 1, "Warn about errors in literate modules", &literateErrors},
- {'.', 1, "Print dots to show progress", &useDots},
{'q', 1, "Print nothing to show progress", &quiet},
{'w', 1, "Always show which modules are loaded", &listScripts},
{'k', 1, "Show kind errors in full", &kindExpert},
static Void local listNames() { /* list names matching optional pat*/
String pat = readFilename();
List names = NIL;
- Int width = getTerminalWidth() - 1;
+ Int width = 72;
Int count = 0;
Int termPos;
Module mod = currentModule;
#endif
currTarget = (t?t:1);
aiming = TRUE;
- if (useDots) {
- currPos = strlen(what);
- maxPos = getTerminalWidth() - 1;
- Printf("%s",what);
- }
- else
- for (charCount=0; *what; charCount++)
- Putchar(*what++);
+ for (charCount=0; *what; charCount++)
+ Putchar(*what++);
FlushStdout();
}
if (showInstRes)
return;
#endif
- if (useDots) {
- Int newPos = (Int)((maxPos * ((long)t))/currTarget);
-
- if (newPos>maxPos)
- newPos = maxPos;
-
- if (newPos>currPos) {
- do
- Putchar('.');
- while (newPos>++currPos);
- FlushStdout();
- }
- FlushStdout();
- }
}
Void done() { /* Goal has now been achieved */
if (showInstRes)
return;
#endif
- if (useDots) {
- while (maxPos>currPos++)
- Putchar('.');
- Putchar('\n');
+ for (; charCount>0; charCount--) {
+ Putchar('\b');
+ Putchar(' ');
+ Putchar('\b');
}
- else
- for (; charCount>0; charCount--) {
- Putchar('\b');
- Putchar(' ');
- Putchar('\b');
- }
aiming = FALSE;
FlushStdout();
}
typeChecker(what);
compiler(what);
codegen(what);
+ interfayce(what);
if (what == MARK) {
mark(moduleGraph);
* Hugs version 1.4, December 1997
*
* $RCSfile: interface.c,v $
- * $Revision: 1.58 $
- * $Date: 2000/05/12 13:34:07 $
+ * $Revision: 1.59 $
+ * $Date: 2000/05/26 10:14:33 $
* ------------------------------------------------------------------------*/
#include "hugsbasictypes.h"
SymX(__sel_10_upd_info) \
SymX(__sel_11_upd_info) \
SymX(__sel_12_upd_info) \
- SymX(Upd_frame_info) \
+ SymX(upd_frame_info) \
SymX(seq_frame_info) \
SymX(CAF_BLACKHOLE_info) \
SymX(IND_STATIC_info) \
SymX(INTLIKE_closure) \
SymX(suspendThread) \
SymX(resumeThread) \
- Sym(stackOverflow) \
+ SymX(stackOverflow) \
SymX(int2Integerzh_fast) \
- Sym(stg_gc_unbx_r1) \
+ Sym(stg_gc_unbx_r1) \
SymX(ErrorHdrHook) \
SymX(mkForeignObjzh_fast) \
SymX(__encodeDouble) \
/* needed by libHS_cbits */ \
SymX(malloc) \
SymX(close) \
- Sym(mkdir) \
SymX(close) \
Sym(opendir) \
Sym(closedir) \
Sym(readdir) \
- Sym(tcgetattr) \
- Sym(tcsetattr) \
SymX(isatty) \
SymX(read) \
SymX(lseek) \
SymX(write) \
- Sym(getrusage) \
SymX(realloc) \
SymX(getcwd) \
SymX(free) \
SymX(strcpy) \
- Sym(fcntl) \
SymX(fprintf) \
SymX(exit) \
- Sym(open) \
SymX(unlink) \
SymX(memcpy) \
SymX(memchr) \
SymX(rmdir) \
SymX(rename) \
SymX(chdir) \
- SymX(execl) \
- Sym(waitpid) \
SymX(getenv) \
#define EXTERN_SYMS_cygwin32 \
SymX(localtime) \
SymX(strftime) \
SymX(mktime) \
- SymX(gmtime)
+ SymX(execl) \
+ Sym(mkdir) \
+ Sym(open) \
+ Sym(tcgetattr) \
+ Sym(tcsetattr) \
+ Sym(getrusage) \
+ Sym(fcntl) \
+ Sym(waitpid) \
+ SymX(gmtime) \
#define EXTERN_SYMS_linux \
SymX(gmtime) \
Sym(setitimer) \
Sym(chmod) \
+ SymX(execl) \
+ Sym(mkdir) \
+ Sym(open) \
+ Sym(tcgetattr) \
+ Sym(tcsetattr) \
Sym(gettimeofday) \
+ Sym(getrusage) \
+ Sym(waitpid) \
+ Sym(fcntl) \
+
#define EXTERN_SYMS_solaris2 \
SymX(gettimeofday) \
#define EXTERN_SYMS_THISPLATFORM EXTERN_SYMS_cygwin32
#endif
+#if defined(mingw32_TARGET_OS)
+#define EXTERN_SYMS_THISPLATFORM /* */
+#endif
+
/* entirely bogus claims about types of these symbols */
if (strlen(nm2+first_real_char) > 7
&& strncmp(nm2+first_real_char, "__init_", 7)==0) {
t = unZcodeThenFindText(nm2+first_real_char+7);
- if (t == findText("PrelGHC")) return (4+NULL); /* kludge */
+ if (t == findText("PrelGHC")) return (4+(char*)NULL); /* kludge */
m = findModule(t);
if (isNull(m)) goto dire_straits;
a = lookupOTabName ( m, nm );
* Control:
* ------------------------------------------------------------------------*/
-Void interface(what)
+Void interfayce(what)
Int what; {
switch (what) {
case POSTPREL: break;
* included in the distribution.
*
* $RCSfile: machdep.c,v $
- * $Revision: 1.31 $
- * $Date: 2000/05/10 16:51:52 $
+ * $Revision: 1.32 $
+ * $Date: 2000/05/26 10:14:33 $
* ------------------------------------------------------------------------*/
#ifdef HAVE_SIGNAL_H
# include <types.h>
# endif
#endif
+
+#if 0
#if HAVE_SYS_PARAM_H
# include <sys/param.h>
#endif
+#endif
+
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#else
}
#endif
-#if 0 /* apparently unused */
-static String local RealPath(s) /* Find absolute pathname of file */
-String s; {
-#if HAVE__FULLPATH /* eg DOS */
- static char path[FILENAME_MAX+1];
- _fullpath(path,s,FILENAME_MAX+1);
-#elif HAVE_REALPATH /* eg Unix */
- static char path[MAXPATHLEN+1];
- realpath(s,path);
-#else
- static char path[FILENAME_MAX+1];
- strcpy(path,s);
-#endif
- return path;
-}
-#endif
-
-
-static int local pathCmp(p1,p2) /* Compare paths after normalisation */
-String p1;
-String p2; {
-#if HAVE__FULLPATH /* eg DOS */
- static char path1[FILENAME_MAX+1];
- static char path2[FILENAME_MAX+1];
- _fullpath(path1,p1,FILENAME_MAX+1);
- _fullpath(path2,p2,FILENAME_MAX+1);
-#elif HAVE_REALPATH /* eg Unix */
- static char path1[MAXPATHLEN+1];
- static char path2[MAXPATHLEN+1];
- realpath(p1,path1);
- realpath(p2,path2);
-#else
- static char path1[FILENAME_MAX+1];
- static char path2[FILENAME_MAX+1];
- strcpy(path1,p1);
- strcpy(path2,p2);
-#endif
-#if CASE_INSENSITIVE_FILENAMES
- strlwr(path1);
- strlwr(path2);
-#endif
- return filenamecmp(path1,path2);
-}
static String local normPath(s) /* Try, as much as possible, to normalize */
String s; { /* a pathname in some appropriate manner. */
#endif
/* --------------------------------------------------------------------------
- * Terminal dependent stuff:
- * ------------------------------------------------------------------------*/
-
-#if (HAVE_TERMIO_H | HAVE_SGTTY_H | HAVE_TERMIOS_H)
-
-/* grab the varargs prototype for ioctl */
-#if HAVE_SYS_IOCTL_H
-# include <sys/ioctl.h>
-#endif
-
-/* The order of these three tests is very important because
- * some systems have more than one of the requisite header file
- * but only one of them seems to work.
- * Anyone changing the order of the tests should try enabling each of the
- * three branches in turn and write down which ones work as well as which
- * OS/compiler they're using.
- *
- * OS Compiler sgtty termio termios notes
- * Linux 2.0.18 gcc 2.7.2 absent works works 1
- *
- * Notes:
- * 1) On Linux, termio.h just #includes termios.h and sgtty.h is
- * implemented using termios.h.
- * sgtty.h is in /usr/include/bsd which is not on my standard include
- * path. Adding it does no harm but you might as well use termios.
- * --
- * reid-alastair@cs.yale.edu
- */
-#if HAVE_TERMIOS_H
-
-#include <termios.h>
-typedef struct termios TermParams;
-#define getTerminal(tp) tcgetattr(fileno(stdin), &tp)
-#define setTerminal(tp) tcsetattr(fileno(stdin), TCSAFLUSH, &tp)
-#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
- tp.c_cc[VMIN] = 1; \
- tp.c_cc[VTIME] = 0;
-
-#elif HAVE_SGTTY_H
-
-#include <sgtty.h>
-typedef struct sgttyb TermParams;
-#define getTerminal(tp) ioctl(fileno(stdin),TIOCGETP,&tp)
-#define setTerminal(tp) ioctl(fileno(stdin),TIOCSETP,&tp)
-#if HPUX
-#define noEcho(tp) tp.sg_flags |= RAW; tp.sg_flags &= (~ECHO);
-#else
-#define noEcho(tp) tp.sg_flags |= CBREAK; tp.sg_flags &= (~ECHO);
-#endif
-
-#elif HAVE_TERMIO_H
-
-#include <termio.h>
-typedef struct termio TermParams;
-#define getTerminal(tp) ioctl(fileno(stdin),TCGETA,&tp)
-#define setTerminal(tp) ioctl(fileno(stdin),TCSETAF,&tp)
-#define noEcho(tp) tp.c_lflag &= ~(ICANON | ECHO); \
- tp.c_cc[VMIN] = 1; \
- tp.c_cc[VTIME] = 0;
-
-#endif
-
-static Bool messedWithTerminal = FALSE;
-static TermParams originalSettings;
-
-Void normalTerminal() { /* restore terminal initial state */
- if (messedWithTerminal)
- setTerminal(originalSettings);
-}
-
-Void noechoTerminal() { /* set terminal into noecho mode */
- TermParams settings;
-
- if (!messedWithTerminal) {
- getTerminal(originalSettings);
- messedWithTerminal = TRUE;
- }
- getTerminal(settings);
- noEcho(settings);
- setTerminal(settings);
-}
-
-Int getTerminalWidth() { /* determine width of terminal */
-#ifdef TIOCGWINSZ
-#ifdef _M_UNIX /* SCO Unix 3.2.4 defines TIOCGWINSZ*/
-#include <sys/stream.h> /* Required by sys/ptem.h */
-#include <sys/ptem.h> /* Required to declare winsize */
-#endif
- static struct winsize terminalSize;
- ioctl(fileno(stdout),TIOCGWINSZ,&terminalSize);
- return (terminalSize.ws_col==0)? 80 : terminalSize.ws_col;
-#else
- return 80;
-#endif
-}
-
-Int readTerminalChar() { /* read character from terminal */
- return getchar(); /* without echo, assuming that */
-} /* noechoTerminal() is active... */
-
-#elif SYMANTEC_C
-
-Int readTerminalChar() { /* read character from terminal */
- return getchar(); /* without echo, assuming that */
-} /* noechoTerminal() is active... */
-
-Int getTerminalWidth() {
- return console_options.ncols;
-}
-
-Void normalTerminal() {
- csetmode(C_ECHO, stdin);
-}
-
-Void noechoTerminal() {
- csetmode(C_NOECHO, stdin);
-}
-
-#else /* no terminal driver - eg DOS, RISCOS */
-
-static Bool terminalEchoReqd = TRUE;
-
-Int getTerminalWidth() {
-#if RISCOS
- int dummy, width;
- (void) os_swi3r(OS_ReadModeVariable, -1, 1, 0, &dummy, &dummy, &width);
- return width+1;
-#else
- return 80;
-#endif
-}
-
-Void normalTerminal() { /* restore terminal initial state */
- terminalEchoReqd = TRUE;
-}
-
-Void noechoTerminal() { /* turn terminal echo on/off */
- terminalEchoReqd = FALSE;
-}
-
-Int readTerminalChar() { /* read character from terminal */
- if (terminalEchoReqd) {
- return getchar();
- } else {
-#if IS_WIN32 && !__BORLANDC__
- /* When reading a character from the console/terminal, we want
- * to operate in 'raw' mode (to use old UNIX tty parlance) and have
- * it return when a character is available and _not_ wait until
- * the next time the user hits carriage return. On Windows platforms,
- * this _can_ be done by reading directly from the console, using
- * getch(). However, this doesn't sit well with programming
- * environments such as Emacs which allow you to create sub-processes
- * running Hugs, and then communicate with the running interpreter
- * through its standard input and output handles. If you use getch()
- * in that setting, you end up trying to read the (unused) console
- * of the editor itself, through which not a lot of characters is
- * bound to come out, since the editor communicates input to Hugs
- * via the standard input handle.
- *
- * To avoid this rather unfortunate situation, we use the Win32
- * console API and re-jig the input properties of the standard
- * input handle before trying to read a character using stdio's
- * getchar().
- *
- * The 'cost' of this solution is that it is Win32 specific and
- * won't work with Windows 3.1 + it is kind of ugly and verbose
- * to have to futz around with the console properties on a
- * per-char basis. Both of these disadvantages aren't in my
- * opinion fatal.
- *
- * -- sof 5/99
- */
- Int c;
- DWORD mo;
- HANDLE hIn;
-
- /* I don't quite understand why, but if the FILE*'s underlying file
- descriptor is in text mode, we seem to lose the first carriage
- return.
- */
- setmode(fileno(stdin), _O_BINARY);
- hIn = GetStdHandle(STD_INPUT_HANDLE);
- GetConsoleMode(hIn, &mo);
- SetConsoleMode(hIn, mo & ~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT));
- /*
- * On Win9x, the first time you change the mode (as above) a
- * raw '\n' is inserted. Since enter maps to a raw '\r', and we
- * map this (below) to '\n', we can just ignore all *raw* '\n's.
- */
- do {
- c = getc(stdin);
- } while (c == '\n');
-
- /* Same as it ever was - revert back state of stdin. */
- SetConsoleMode(hIn, mo);
- setmode(fileno(stdin), _O_TEXT);
-#else
- Int c = getch();
-#endif
- return c=='\r' ? '\n' : c; /* slight paranoia about CR-LF */
- }
-}
-
-#endif /* no terminal driver */
-
-/* --------------------------------------------------------------------------
* Interrupt handling:
* ------------------------------------------------------------------------*/
#endif
-/*---------------------------------------------------------------------------
- * Printf-related operations:
- *-------------------------------------------------------------------------*/
-
-#if !defined(HAVE_VSNPRINTF)
-int vsnprintf(buffer, count, fmt, ap)
-char* buffer;
-int count;
-const char* fmt;
-va_list ap; {
-#if defined(HAVE__VSNPRINTF)
- return _vsnprintf(buffer, count, fmt, ap);
-#else
- return 0;
-#endif
-}
-#endif /* HAVE_VSNPRINTF */
-
-#if !defined(HAVE_SNPRINTF)
-int snprintf(char* buffer, int count, const char* fmt, ...) {
-#if defined(HAVE__VSNPRINTF)
- int r;
- va_list ap; /* pointer into argument list */
- va_start(ap, fmt); /* make ap point to first arg after fmt */
- r = vsnprintf(buffer, count, fmt, ap);
- va_end(ap); /* clean up */
- return r;
-#else
- return 0;
-#endif
-}
-#endif /* HAVE_SNPRINTF */
-
/* --------------------------------------------------------------------------
* Things to do with the argv/argc and the env
* ------------------------------------------------------------------------*/
break;
case RESET :
case BREAK :
- case EXIT : normalTerminal();
+ case EXIT :
break;
}
}
* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.30 $
- * $Date: 2000/05/10 16:53:35 $
+ * $Revision: 1.31 $
+ * $Date: 2000/05/26 10:14:34 $
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
void asmEndPack( AsmBCO bco, AsmVar v, AsmSp start, AsmInfo info )
{
nat size = bco->sp - start;
- assert(bco->sp >= start);
- assert(start >= v);
+ ASSERT(bco->sp >= start);
+ ASSERT(start >= v);
/* only reason to include info is for this assertion */
- assert(info->layout.payload.ptrs == size);
+ ASSERT(info->layout.payload.ptrs == size);
emit_i_PACK(bco, bco->sp - v);
setSp(bco, start);
}
* Copyright (c) 1994-1998.
*
* $RCSfile: Evaluator.c,v $
- * $Revision: 1.53 $
- * $Date: 2000/05/18 09:54:47 $
+ * $Revision: 1.54 $
+ * $Date: 2000/05/26 10:14:34 $
* ---------------------------------------------------------------------------*/
#include "Rts.h"
numEnters++;
#ifdef DEBUG
- assert(gSp == tSp);
- assert(gSu == tSu);
- assert(gSpLim == tSpLim);
+ ASSERT(gSp == tSp);
+ ASSERT(gSu == tSu);
+ ASSERT(gSpLim == tSpLim);
IF_DEBUG(evaluator,
SSS;
enterCountI++;
ACQUIRE_LOCK(&sched_mutex);
#if defined(HAVE_SETITIMER) || defined(mingw32_TARGET_OS)
- cap->rCurrentTSO->block_info.delay
+ cap->rCurrentTSO->block_info.delay
= hugsBlock.delay + ticks_since_select;
#else
cap->rCurrentTSO->block_info.target
}
}
barf("Ran off the end of enter - yoiks");
- assert(0);
+ ASSERT(0);
}
#undef RETURN
/* fprintf(stderr, "myStackCheck\n"); */
if (!(gSpLim <= gSp && gSp <= stgCast(StgPtr,gSu))) {
fprintf(stderr, "myStackCheck: invalid initial gSp/gSu \n" );
- assert(0);
+ barf("aborting");
+ ASSERT(0);
}
while (1) {
if (!( (P_)gSu >= (P_)cap->rCurrentTSO->stack
(P_)gSu <= (P_)(cap->rCurrentTSO->stack
+ cap->rCurrentTSO->stack_size))) {
fprintf ( stderr, "myStackCheck: gSu out of stack\n" );
- assert(0);
+ barf("aborting");
+ ASSERT(0);
}
switch (get_itbl(stgCast(StgClosure*,gSu))->type) {
case CATCH_FRAME:
case STOP_FRAME:
goto postloop;
default:
- fprintf(stderr, "myStackCheck: invalid activation record\n"); assert(0);
+ fprintf(stderr, "myStackCheck: invalid activation record\n");
+ barf("aborting");
+ ASSERT(0);
}
}
postloop:
break;
}
case i_raiseInThread:
+ barf("raiseInThread");
ASSERT(0); /* not (yet) supported */
case i_delay:
{
/* -----------------------------------------------------------------------------
- * $Id: ForeignCall.c,v 1.16 2000/05/12 11:59:39 sewardj Exp $
+ * $Id: ForeignCall.c,v 1.17 2000/05/26 10:14:34 sewardj Exp $
*
* (c) The GHC Team 1994-1999.
*
printf("%c",(char)argstr[i]);
}
printf("' [%d arg(s)]\n",n_args);
- assert(0);
+ barf("aborting");
+ ASSERT(0);
}
#undef CALL
#undef CMP
projects / ghc-hetmet.git / commitdiff