X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FHeapStackCheck.cmm;h=a0322cbb3df3d45621bbb2da63fe5b433a0c6527;hb=0d52a0a134871d317b5f8b53a952c882ce5ae5b6;hp=88d18063e23986e8b9de32fe28e5fab322100983;hpb=c8898df0380dad4705353de00a48ea105d00bcc5;p=ghc-hetmet.git diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm index 88d1806..a0322cb 100644 --- a/ghc/rts/HeapStackCheck.cmm +++ b/ghc/rts/HeapStackCheck.cmm @@ -55,7 +55,7 @@ CLOSE_NURSERY(); \ CurrentNursery = bdescr_link(CurrentNursery); \ OPEN_NURSERY(); \ - if (CInt[context_switch] != 0) { \ + if (CInt[context_switch] != 0 :: CInt) { \ R1 = ThreadYielding; \ goto sched; \ } else { \ @@ -594,7 +594,13 @@ __stg_gc_fun size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info)); } else { if (type == ARG_GEN_BIG) { +#ifdef TABLES_NEXT_TO_CODE + // bitmap field holds an offset + size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) + + %GET_ENTRY(R1) /* ### */ ); +#else size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) ); +#endif } else { size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]); } @@ -864,7 +870,7 @@ INFO_TABLE_RET( stg_block_async, 0/*framesize*/, 0/*bitmap*/, RET_SMALL ) len = StgAsyncIOResult_len(ares); errC = StgAsyncIOResult_errCode(ares); StgTSO_block_info(CurrentTSO) = NULL; - foreign "C" free(ares); + foreign "C" free(ares "ptr"); R1 = len; Sp(0) = errC; jump %ENTRY_CODE(Sp(1)); @@ -877,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