From: sof <unknown>
Date: Tue, 9 Nov 2004 18:04:17 +0000 (+0000)
Subject: [project @ 2004-11-09 18:04:15 by sof]
X-Git-Tag: Initial_conversion_from_CVS_complete~1463
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ea22f57fe6b77cde3c3ec040f1246bf0e8ecef36

[project @ 2004-11-09 18:04:15 by sof]
threadDelay(mingw32): introduce and use the return continuation
stg_block_async_void; fixes mem leak, cf.

  http://haskell.org/pipermail/cvs-ghc/2004-November/022325.html
---

diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index caf9d13..0cdcccc 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -438,6 +438,7 @@ RTS_FUN(stg_block_putmvar);
 RTS_ENTRY(stg_block_putmvar_ret);
 #ifdef mingw32_TARGET_OS
 RTS_FUN(stg_block_async);
+RTS_FUN(stg_block_async_void);
 #endif
 
 /* Entry/exit points from StgStartup.cmm */
diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index 2a264b2..7a0828b 100644
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -883,4 +883,25 @@ stg_block_async
     BLOCK_GENERIC;
 }
 
+/* Used by threadDelay implementation; it would be desirable to get rid of
+ * this free()'ing void return continuation.
+ */
+INFO_TABLE_RET( stg_block_async_void, 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
+{
+    W_ ares;
+
+    ares = StgTSO_block_info(CurrentTSO);
+    StgTSO_block_info(CurrentTSO) = NULL;
+    foreign "C" free(ares "ptr");
+    Sp_adj(1);
+    jump %ENTRY_CODE(Sp(0));
+}
+
+stg_block_async_void
+{
+    Sp_adj(-1);
+    Sp(0) = stg_block_async_void_info;
+    BLOCK_GENERIC;
+}
+
 #endif
diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index 91c1325..9f69d16 100644
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -1407,6 +1407,7 @@ delayzh_fast
      */
     StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
     APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+    jump stg_block_async_void;
 
 #else
 
@@ -1431,9 +1432,8 @@ while:
     } else {
 	StgTSO_link(prev) = CurrentTSO;
     }
-#endif
-
     jump stg_block_noregs;
+#endif
 }