From fda822c6090472110b7cd7ab76ea95ca07299f5c Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 26 May 2000 10:14:34 +0000 Subject: [PATCH] [project @ 2000-05-26 10:14:33 by sewardj] Changes to allow Hugs to be built with mingw32, not cygwin. Also, updates so that DietHEP works properly for mingw32. Most changes are trivial (assert --> ASSERT), etc. For hugs, have deleted queries about the width of a terminal window, and so the printing of dots as progress indicators is gone too. No great loss. Zapped various other out-of-date platform-specific junk in machdep.c. --- ghc/includes/ClosureMacros.h | 36 ++-- ghc/includes/InfoMacros.h | 4 +- ghc/includes/Stg.h | 4 +- ghc/includes/TSO.h | 8 +- ghc/interpreter/Dh_Demo.hs | 4 +- ghc/interpreter/DietHEP.def | 1 - ghc/interpreter/Makefile | 32 +++- ghc/interpreter/Makefile-DietHEP | 63 ++++--- ghc/interpreter/Makefile.DLLs | 180 ------------------- ghc/interpreter/README.BUILDING.DIETHEP | 9 + ghc/interpreter/connect.h | 14 +- ghc/interpreter/dh_demo.c | 15 +- ghc/interpreter/hugs.c | 121 +++++++------ ghc/interpreter/interface.c | 45 +++-- ghc/interpreter/machdep.c | 292 +------------------------------ ghc/rts/Assembler.c | 10 +- ghc/rts/Evaluator.c | 25 +-- ghc/rts/ForeignCall.c | 5 +- 18 files changed, 250 insertions(+), 618 deletions(-) delete mode 100644 ghc/interpreter/Makefile.DLLs create mode 100644 ghc/interpreter/README.BUILDING.DIETHEP diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h index b1ac095..c8baeee 100644 --- a/ghc/includes/ClosureMacros.h +++ b/ghc/includes/ClosureMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -116,12 +116,11 @@ extern void* DATA_SECTION_END_MARKER_DECL; #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 @@ -138,7 +137,8 @@ extern int is_heap_alloced(const void* x); 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 */ @@ -165,20 +165,22 @@ extern int is_heap_alloced(const void* x); -------------------------------------------------------------------------- */ #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 /* ----------------------------------------------------------------------------- diff --git a/ghc/includes/InfoMacros.h b/ghc/includes/InfoMacros.h index 4992c70..7e64899 100644 --- a/ghc/includes/InfoMacros.h +++ b/ghc/includes/InfoMacros.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -609,7 +609,7 @@ typedef vec_info_8 StgPolyInfoTable; 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 diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h index ebc471a..ac7d976 100644 --- a/ghc/includes/Stg.h +++ b/ghc/includes/Stg.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -183,7 +183,7 @@ void _stgAssert (char *, unsigned int); 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); diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h index 9d79aca..6572a7e 100644 --- a/ghc/includes/TSO.h +++ b/ghc/includes/TSO.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -134,10 +134,10 @@ typedef union { 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; diff --git a/ghc/interpreter/Dh_Demo.hs b/ghc/interpreter/Dh_Demo.hs index fb6d6d0..2802b2f 100644 --- a/ghc/interpreter/Dh_Demo.hs +++ b/ghc/interpreter/Dh_Demo.hs @@ -3,4 +3,6 @@ module Dh_Demo where 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") diff --git a/ghc/interpreter/DietHEP.def b/ghc/interpreter/DietHEP.def index 8feafbd..2b5031e 100644 --- a/ghc/interpreter/DietHEP.def +++ b/ghc/interpreter/DietHEP.def @@ -1,4 +1,3 @@ EXPORTS -DietHEP_impure_ptr = _impure_ptr DH_GetProcAddress DH_LoadLibrary diff --git a/ghc/interpreter/Makefile b/ghc/interpreter/Makefile index 9152365..68d34f1 100644 --- a/ghc/interpreter/Makefile +++ b/ghc/interpreter/Makefile @@ -1,6 +1,6 @@ # --------------------------------------------------------------------------- # -# $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 = .. @@ -11,12 +11,26 @@ SUBDIRS = lib # 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" @@ -38,7 +52,7 @@ C_SRCS = link.c type.c static.c storage.c derive.c input.c compiler.c subst.c \ 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 @@ -50,7 +64,7 @@ hugs: $(C_OBJS) ../rts/Sanity.o ../rts/Assembler.o ../rts/Disassembler.o \ ../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: @@ -59,7 +73,7 @@ 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 diff --git a/ghc/interpreter/Makefile-DietHEP b/ghc/interpreter/Makefile-DietHEP index b64c281..98a7675 100644 --- a/ghc/interpreter/Makefile-DietHEP +++ b/ghc/interpreter/Makefile-DietHEP @@ -1,6 +1,6 @@ # --------------------------------------------------------------------------- # -# $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 = .. @@ -11,18 +11,26 @@ SUBDIRS = lib # 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 @@ -38,23 +46,29 @@ C_SRCS = link.c type.c static.c storage.c derive.c input.c compiler.c subst.c \ 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 @@ -62,7 +76,7 @@ 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 @@ -111,7 +125,7 @@ checkrun: all # 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 @@ -121,6 +135,3 @@ depend :: parser.c $(LOOPS) $(SRCS_UGNHS) include $(TOP)/mk/target.mk - - -include Makefile.DLLs diff --git a/ghc/interpreter/Makefile.DLLs b/ghc/interpreter/Makefile.DLLs deleted file mode 100644 index ca9613c..0000000 --- a/ghc/interpreter/Makefile.DLLs +++ /dev/null @@ -1,180 +0,0 @@ -#-----------------------------------------------------------------------------# - -# 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 ' > 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 diff --git a/ghc/interpreter/README.BUILDING.DIETHEP b/ghc/interpreter/README.BUILDING.DIETHEP new file mode 100644 index 0000000..ffd3685 --- /dev/null +++ b/ghc/interpreter/README.BUILDING.DIETHEP @@ -0,0 +1,9 @@ + +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. + + diff --git a/ghc/interpreter/connect.h b/ghc/interpreter/connect.h index 52d894a..0aae63b 100644 --- a/ghc/interpreter/connect.h +++ b/ghc/interpreter/connect.h @@ -9,8 +9,8 @@ * 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 $ * ------------------------------------------------------------------------*/ /* -------------------------------------------------------------------------- @@ -362,7 +362,7 @@ extern Void machdep ( Int ); extern Void liftControl ( Int ); extern Void substitution ( Int ); extern Void typeChecker ( Int ); -extern Void interface ( Int ); +extern Void interfayce ( Int ); extern Void storage ( Int ); @@ -566,6 +566,9 @@ extern HugsBreakAction setBreakAction ( HugsBreakAction ); to get the signal mask to a sane state each time. */ #include + +#if !defined(mingw32_TARGET_OS) + #define setHandler(bh) { sigset_t mask; \ signal(SIGINT,bh); \ sigemptyset(&mask); \ @@ -573,6 +576,11 @@ extern HugsBreakAction setBreakAction ( HugsBreakAction ); sigprocmask(SIG_UNBLOCK, &mask, NULL); \ } +#else + +#define setHandler(bh) do { } while(0) + +#endif /* !defined(mingw32_TARGET_OS) */ /*--------------------------------------------------------------------------- * Environment variables and the registry diff --git a/ghc/interpreter/dh_demo.c b/ghc/interpreter/dh_demo.c index 53ba464..f9de33d 100644 --- a/ghc/interpreter/dh_demo.c +++ b/ghc/interpreter/dh_demo.c @@ -3,7 +3,20 @@ #include #include #include -#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 ) { diff --git a/ghc/interpreter/hugs.c b/ghc/interpreter/hugs.c index fb3f722..68fc93f 100644 --- a/ghc/interpreter/hugs.c +++ b/ghc/interpreter/hugs.c @@ -9,8 +9,8 @@ * 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 @@ -103,7 +103,6 @@ static Bool printing = FALSE; /* TRUE => currently printing value*/ 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; @@ -138,8 +137,11 @@ static ConId currentModule_failed = NIL; /* Remember failed module from :r */ #ifdef DIET_HEP +#include "StgDLL.h" #include "DietHEP.h" +extern void setRtsFlags ( int ); + static int diet_hep_initialised = 0; static @@ -148,8 +150,10 @@ void diet_hep_initialise ( void* cstackbase ) 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; @@ -159,7 +163,8 @@ void diet_hep_initialise ( void* cstackbase ) /* 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(); @@ -188,17 +193,6 @@ DH_MODULE DH_LoadLibrary_wrk ( DH_LPCSTR modname ) 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, @@ -234,17 +228,61 @@ void* DH_GetProcAddress_wrk ( DH_CALLCONV cconv, 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; @@ -259,6 +297,7 @@ fprintf ( stderr, "just before calling it\n"); fprintf ( stderr, "exiting safely\n"); return 0; } +#endif #else @@ -740,7 +779,6 @@ struct options toggle[] = { /* List of command line toggles */ {'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}, @@ -2403,7 +2441,7 @@ Inst in; { 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; @@ -2603,14 +2641,8 @@ Target t; { #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(); } @@ -2622,20 +2654,6 @@ Target t; { /* has now reached t */ 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 */ @@ -2645,17 +2663,11 @@ 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(); } @@ -2896,6 +2908,7 @@ Int what; { /* system to respond as appropriate ... */ typeChecker(what); compiler(what); codegen(what); + interfayce(what); if (what == MARK) { mark(moduleGraph); diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c index 0da2db3..8b81bfe 100644 --- a/ghc/interpreter/interface.c +++ b/ghc/interpreter/interface.c @@ -7,8 +7,8 @@ * 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" @@ -2518,7 +2518,7 @@ Type type; { 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) \ @@ -2539,9 +2539,9 @@ Type type; { 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) \ @@ -2599,34 +2599,26 @@ Type type; { /* 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 \ @@ -2656,7 +2648,15 @@ Type type; { 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 \ @@ -2676,7 +2676,16 @@ Type type; { 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) \ @@ -2694,6 +2703,10 @@ Type type; { #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 */ @@ -2764,7 +2777,7 @@ void* lookupObjName ( char* nm ) 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 ); @@ -2826,7 +2839,7 @@ int is_not_dynamically_loaded_ptr ( char* p ) * Control: * ------------------------------------------------------------------------*/ -Void interface(what) +Void interfayce(what) Int what; { switch (what) { case POSTPREL: break; diff --git a/ghc/interpreter/machdep.c b/ghc/interpreter/machdep.c index 158fcf6..b5d9217 100644 --- a/ghc/interpreter/machdep.c +++ b/ghc/interpreter/machdep.c @@ -13,8 +13,8 @@ * 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 @@ -27,9 +27,13 @@ # include # endif #endif + +#if 0 #if HAVE_SYS_PARAM_H # include #endif +#endif + #ifdef HAVE_SYS_STAT_H # include #else @@ -281,49 +285,6 @@ static String local hscriptDir() { /* Directory containing hscript.dll */ } #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. */ @@ -942,212 +903,6 @@ Void gcCStack() { /* Garbage collect elements off */ #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 -#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 -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 -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 -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 /* Required by sys/ptem.h */ -#include /* 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: * ------------------------------------------------------------------------*/ @@ -1309,39 +1064,6 @@ int chdir(const char *s) { #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 * ------------------------------------------------------------------------*/ @@ -1369,7 +1091,7 @@ Int what; { /* initialisation etc.. */ break; case RESET : case BREAK : - case EXIT : normalTerminal(); + case EXIT : break; } } diff --git a/ghc/rts/Assembler.c b/ghc/rts/Assembler.c index c1f2dd7..ab80581 100644 --- a/ghc/rts/Assembler.c +++ b/ghc/rts/Assembler.c @@ -5,8 +5,8 @@ * 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. @@ -1717,10 +1717,10 @@ AsmSp asmBeginPack( AsmBCO bco ) 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); } diff --git a/ghc/rts/Evaluator.c b/ghc/rts/Evaluator.c index 6e2f1db..05f2d49 100644 --- a/ghc/rts/Evaluator.c +++ b/ghc/rts/Evaluator.c @@ -5,8 +5,8 @@ * 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" @@ -336,9 +336,9 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) 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++; @@ -375,7 +375,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) 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 @@ -1363,7 +1363,7 @@ StgThreadReturnCode enter( Capability* cap, StgClosure* obj0 ) } } barf("Ran off the end of enter - yoiks"); - assert(0); + ASSERT(0); } #undef RETURN @@ -2099,7 +2099,8 @@ static void myStackCheck ( Capability* cap ) /* 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 @@ -2107,7 +2108,8 @@ static void myStackCheck ( Capability* cap ) (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: @@ -2122,7 +2124,9 @@ static void myStackCheck ( Capability* cap ) 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: @@ -2939,6 +2943,7 @@ static void* enterBCO_primop2 ( int primop2code, break; } case i_raiseInThread: + barf("raiseInThread"); ASSERT(0); /* not (yet) supported */ case i_delay: { diff --git a/ghc/rts/ForeignCall.c b/ghc/rts/ForeignCall.c index 66e5477..a6a4646 100644 --- a/ghc/rts/ForeignCall.c +++ b/ghc/rts/ForeignCall.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $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. * @@ -205,7 +205,8 @@ static void universal_call_c_generic printf("%c",(char)argstr[i]); } printf("' [%d arg(s)]\n",n_args); - assert(0); + barf("aborting"); + ASSERT(0); } #undef CALL #undef CMP -- 1.7.10.4