[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

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 */

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

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
 }