From: rrt <unknown>
Date: Mon, 16 Jul 2001 09:23:24 +0000 (+0000)
Subject: [project @ 2001-07-16 09:23:24 by rrt]
X-Git-Tag: Approximately_9120_patches~1547
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=80bcde314e52e5722f319b95fe95f89a39d58a5e;p=ghc-hetmet.git

[project @ 2001-07-16 09:23:24 by rrt]
Add stubs for ILXized cbits DLL.

Don't call resetNonBlockingFd when DLLized; this stops the cbits DLL
depending on the RTS, which ILX needs; it doesn't matter for Windows, as
that doesn't have non-blocking IO implemented anyway.
---

diff --git a/ghc/lib/std/cbits/ilxstubs.c b/ghc/lib/std/cbits/ilxstubs.c
index 3378e6c..1a3e473 100644
--- a/ghc/lib/std/cbits/ilxstubs.c
+++ b/ghc/lib/std/cbits/ilxstubs.c
@@ -1,7 +1,7 @@
 /* 
  * (c) The GHC Team 2001
  *
- * $Id: ilxstubs.c,v 1.1 2001/07/13 13:40:48 rrt Exp $
+ * $Id: ilxstubs.c,v 1.2 2001/07/16 09:23:24 rrt Exp $
  *
  * ILX stubs for external function calls
  */
@@ -17,6 +17,7 @@
 */
 
 
+#include "Stg.h"
 #include "HsStd.h"
 #include <stdlib.h>
 #include <stddef.h>
@@ -25,7 +26,7 @@
 
 /* From the RTS */
 
-    /* StgPrimFloat Add to mini-RTS */
+    /* StgPrimFloat Add to mini-RTS, which is put in a DLL */
 
     /* Need to be implemented in ILX RTS */
      /*foreign label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
@@ -36,6 +37,39 @@ foreign label "ErrorHdrHook" errorHdrHook :: Ptr ()
 ../PrelTopHandler.lhs:77:foreign import ccall "stackOverflow" unsafe
 ../PrelTopHandler.lhs:80:foreign import ccall "stg_exit" unsafe */
 
+void
+stg_exit(I_ n)
+{
+  fprintf(stderr, "doing stg_exit(%d)\n", n);
+  exit(n);
+}
+
+/* The code is in includes/Stable.h [sic] */
+void
+freeStablePtr(StgStablePtr sp)
+{
+  fprintf(stderr, "Freeing stable ptr %p (NOT!)\n", sp);
+}
+
+void
+shutdownHaskellAndExit(int n)
+{
+  stg_exit(n);
+}
+
+void 
+stackOverflow(void)
+{
+}
+
+void
+ErrorHdrHook (long fd)
+{
+    const char msg[] = "\nFail: ";
+    write(fd, msg, sizeof(msg)-1);
+}
+
+
 
 /* Import directly from correct DLL */
 
diff --git a/ghc/lib/std/cbits/writeError.c b/ghc/lib/std/cbits/writeError.c
index 591f5ad..ba483a9 100644
--- a/ghc/lib/std/cbits/writeError.c
+++ b/ghc/lib/std/cbits/writeError.c
@@ -1,7 +1,7 @@
 /* 
  * (c) The GRASP/AQUA Project, Glasgow University, 1998
  *
- * $Id: writeError.c,v 1.7 2001/07/12 10:34:54 rrt Exp $
+ * $Id: writeError.c,v 1.8 2001/07/16 09:23:24 rrt Exp $
  *
  * hPutStr Runtime Support
  */
@@ -27,7 +27,9 @@ writeErrString__ (HsAddr msg_hdr, HsAddr msg, HsInt len)
   char* p  = (char*)msg;
   char  nl = '\n';
 
+#ifndef DLLized
   resetNonBlockingFd(2);
+#endif
 
   /* Print error msg header */
   if (msg_hdr) {