[project @ 2001-11-08 12:46:31 by simonmar]

[ghc-hetmet.git] / ghc / rts / HeapStackCheck.hc

diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc
index 1a30f44..5fa5f10 100644 (file)
--- a/ghc/rts/HeapStackCheck.hc
+++ b/ghc/rts/HeapStackCheck.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.11 2000/01/13 14:34:03 hwloidl Exp $
+ * $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -7,11 +7,11 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "Stg.h"
 #include "Rts.h"
 #include "Storage.h"           /* for CurrentTSO */
 #include "StgRun.h"    /* for StgReturn and register saving */
 #include "Schedule.h"   /* for context_switch */
-#include "HeapStackCheck.h"
 
 /* Stack/Heap Check Failure
  * ------------------------
@@ -20,7 +20,7 @@
  *
  *    - If the context_switch flag is set, indicating that there are more
  *      threads waiting to run, we yield to the scheduler 
- *     (return ThreadYeilding).
+ *     (return ThreadYielding).
  *
  *    - If Hp > HpLim, we've had a heap check failure.  This means we've
  *     come to the end of the current heap block, so we try to chain
@@ -50,7 +50,8 @@
 
 #define GC_GENERIC                                     \
   if (Hp > HpLim) {                                    \
-    if (ExtendNursery(Hp,HpLim)) {                     \
+    Hp -= HpAlloc;                                     \
+    if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
        if (context_switch) {                           \
            R1.i = ThreadYielding;                      \
        } else {                                        \
@@ -64,12 +65,13 @@
     R1.i = StackOverflow;                              \
   }                                                    \
   SaveThreadState();                                   \
-  CurrentTSO->whatNext = ThreadRunGHC;                 \
+  CurrentTSO->what_next = ThreadRunGHC;                        \
   JMP_(StgReturn);
 
 #define GC_ENTER                                       \
   if (Hp > HpLim) {                                    \
-    if (ExtendNursery(Hp,HpLim)) {                     \
+    Hp -= HpAlloc;                                     \
+    if (HpAlloc <= BLOCK_SIZE_W && ExtendNursery(Hp,HpLim)) {\
        if (context_switch) {                           \
            R1.i = ThreadYielding;                      \
        } else {                                        \
@@ -84,42 +86,42 @@
     R1.i = StackOverflow;                              \
   }                                                    \
   SaveThreadState();                                   \
-  CurrentTSO->whatNext = ThreadEnterGHC;               \
+  CurrentTSO->what_next = ThreadEnterGHC;              \
   JMP_(StgReturn);
 
 #define HP_GENERIC                     \
   SaveThreadState();                   \
-  CurrentTSO->whatNext = ThreadRunGHC; \
+  CurrentTSO->what_next = ThreadRunGHC;        \
   R1.i = HeapOverflow;                 \
   JMP_(StgReturn);
 
 #define STK_GENERIC                    \
   SaveThreadState();                   \
-  CurrentTSO->whatNext = ThreadRunGHC; \
+  CurrentTSO->what_next = ThreadRunGHC;        \
   R1.i = StackOverflow;                        \
   JMP_(StgReturn);
 
 #define YIELD_GENERIC                  \
   SaveThreadState();                   \
-  CurrentTSO->whatNext = ThreadRunGHC; \
+  CurrentTSO->what_next = ThreadRunGHC;        \
   R1.i = ThreadYielding;               \
   JMP_(StgReturn);
 
-#define YIELD_TO_HUGS                    \
+#define YIELD_TO_INTERPRETER             \
   SaveThreadState();                     \
-  CurrentTSO->whatNext = ThreadEnterHugs; \
+  CurrentTSO->what_next = ThreadEnterInterp; \
   R1.i = ThreadYielding;                 \
   JMP_(StgReturn);
 
 #define BLOCK_GENERIC                  \
   SaveThreadState();                   \
-  CurrentTSO->whatNext = ThreadRunGHC; \
+  CurrentTSO->what_next = ThreadRunGHC;        \
   R1.i = ThreadBlocked;                        \
   JMP_(StgReturn);
 
 #define BLOCK_ENTER                    \
   SaveThreadState();                   \
-  CurrentTSO->whatNext = ThreadEnterGHC;\
+  CurrentTSO->what_next = ThreadEnterGHC;\
   R1.i = ThreadBlocked;                        \
   JMP_(StgReturn);
 
@@ -150,7 +152,7 @@ EXTFUN(stg_gc_entertop)
    There are canned sequences for 'n' pointer values in registers.
    -------------------------------------------------------------------------- */
 
-EXTFUN(stg_gc_enter_1)
+EXTFUN(__stg_gc_enter_1)
 {
   FB_
   Sp -= 1;
@@ -166,7 +168,7 @@ EXTFUN(stg_gc_enter_1_hponly)
   Sp[0] = R1.w;
   R1.i = HeapOverflow;
   SaveThreadState();
-  CurrentTSO->whatNext = ThreadEnterGHC;
+  CurrentTSO->what_next = ThreadEnterGHC;
   JMP_(StgReturn);
   FE_
 }
@@ -289,7 +291,7 @@ EXTFUN(gran_yield_0)
 {
   FB_
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -301,7 +303,7 @@ EXTFUN(gran_yield_1)
   Sp -= 1;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -316,7 +318,7 @@ EXTFUN(gran_yield_2)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -332,7 +334,7 @@ EXTFUN(gran_yield_3)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -349,7 +351,7 @@ EXTFUN(gran_yield_4)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -367,7 +369,7 @@ EXTFUN(gran_yield_5)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -386,7 +388,7 @@ EXTFUN(gran_yield_6)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -406,7 +408,7 @@ EXTFUN(gran_yield_7)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -427,7 +429,7 @@ EXTFUN(gran_yield_8)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadYielding;
   JMP_(StgReturn);
   FE_
@@ -441,7 +443,7 @@ EXTFUN(gran_block_1)
   Sp -= 1;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -456,7 +458,7 @@ EXTFUN(gran_block_2)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -472,7 +474,7 @@ EXTFUN(gran_block_3)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -489,7 +491,7 @@ EXTFUN(gran_block_4)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -507,7 +509,7 @@ EXTFUN(gran_block_5)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -526,7 +528,7 @@ EXTFUN(gran_block_6)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -546,7 +548,7 @@ EXTFUN(gran_block_7)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -567,7 +569,7 @@ EXTFUN(gran_block_8)
   Sp[1] = R2.w;
   Sp[0] = R1.w;
   SaveThreadState();                                   
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -596,7 +598,7 @@ EXTFUN(par_block_1_no_jump)
 EXTFUN(par_jump)
 {
   FB_
-  CurrentTSO->whatNext = ThreadEnterGHC;               
+  CurrentTSO->what_next = ThreadEnterGHC;              
   R1.i = ThreadBlocked;
   JMP_(StgReturn);
   FE_
@@ -661,11 +663,11 @@ EXTFUN(stg_gc_noregs)
 
 /*-- R1 is boxed/unpointed -------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_info, stg_gc_unpt_r1_entry, 0/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_ret_info, stg_gc_unpt_r1_ret, 0/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
-EXTFUN(stg_gc_unpt_r1_entry)
+EXTFUN(stg_gc_unpt_r1_ret)
 {
   FB_
   R1.w = Sp[0];
@@ -679,19 +681,19 @@ EXTFUN(stg_gc_unpt_r1)
   FB_
   Sp -= 2;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_gc_unpt_r1_info;
+  Sp[0] = (W_)&stg_gc_unpt_r1_ret_info;
   GC_GENERIC
   FE_
 }
 
 /*-- R1 is unboxed -------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_info, stg_gc_unbx_r1_entry, 1/*BITMAP*/,
+INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_ret_info, stg_gc_unbx_r1_ret, 1/*BITMAP*/,
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 /* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
 
-EXTFUN(stg_gc_unbx_r1_entry)
+EXTFUN(stg_gc_unbx_r1_ret)
 {
   FB_
   R1.w = Sp[0];
@@ -705,18 +707,18 @@ EXTFUN(stg_gc_unbx_r1)
   FB_
   Sp -= 2;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_gc_unbx_r1_info;
+  Sp[0] = (W_)&stg_gc_unbx_r1_ret;
   GC_GENERIC
   FE_
 }
 
 /*-- F1 contains a float ------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_f1_info, stg_gc_f1_entry, 1/*BITMAP*/,
+INFO_TABLE_SRT_BITMAP(stg_gc_f1_ret_info, stg_gc_f1_ret, 1/*BITMAP*/,
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
-EXTFUN(stg_gc_f1_entry)
+EXTFUN(stg_gc_f1_ret)
 {
   FB_
   F1 = PK_FLT(Sp);
@@ -730,7 +732,7 @@ EXTFUN(stg_gc_f1)
   FB_
   Sp -= 2;
   ASSIGN_FLT(Sp+1, F1);
-  Sp[0] = (W_)&stg_gc_f1_info;
+  Sp[0] = (W_)&stg_gc_f1_ret_info;
   GC_GENERIC
   FE_
 }
@@ -745,11 +747,11 @@ EXTFUN(stg_gc_f1)
 #  define DBL_BITMAP 3
 #endif 
 
-INFO_TABLE_SRT_BITMAP(stg_gc_d1_info, stg_gc_d1_entry, DBL_BITMAP,
+INFO_TABLE_SRT_BITMAP(stg_gc_d1_ret_info, stg_gc_d1_ret, DBL_BITMAP,
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
-EXTFUN(stg_gc_d1_entry)
+EXTFUN(stg_gc_d1_ret)
 {
   FB_
   D1 = PK_DBL(Sp);
@@ -763,7 +765,7 @@ EXTFUN(stg_gc_d1)
   FB_
   Sp -= 1 + sizeofW(StgDouble);
   ASSIGN_DBL(Sp+1,D1);
-  Sp[0] = (W_)&stg_gc_d1_info;
+  Sp[0] = (W_)&stg_gc_d1_ret_info;
   GC_GENERIC
   FE_
 }
@@ -798,11 +800,11 @@ EXTFUN(stg_gc_d1)
 
 /*---- R1 contains a pointer: ------ */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_info, stg_gc_ut_1_0_entry, 1/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_ret_info, stg_gc_ut_1_0_ret, 1/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
-EXTFUN(stg_gc_ut_1_0_entry)
+EXTFUN(stg_gc_ut_1_0_ret)
 {
   FB_
   R1.w = Sp[1];
@@ -817,18 +819,18 @@ EXTFUN(stg_gc_ut_1_0)
   Sp -= 3;
   Sp[2] = R1.w;
   Sp[1] = R2.w;
-  Sp[0] = (W_)&stg_gc_ut_1_0_info;
+  Sp[0] = (W_)&stg_gc_ut_1_0_ret_info;
   GC_GENERIC
   FE_
 }
 
 /*---- R1 contains a non-pointer: ------ */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_info, stg_gc_ut_0_1_entry, 3/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_ret_info, stg_gc_ut_0_1_ret, 3/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
-EXTFUN(stg_gc_ut_0_1_entry)
+EXTFUN(stg_gc_ut_0_1_ret)
 {
   FB_
   R1.w = Sp[1];
@@ -841,7 +843,7 @@ EXTFUN(stg_gc_ut_0_1)
 {
   FB_
   Sp -= 3;
-  Sp[0] = (W_)&stg_gc_ut_0_1_info;
+  Sp[0] = (W_)&stg_gc_ut_0_1_ret_info;
   Sp[1] = R2.w;
   Sp[2] = R1.w;
   GC_GENERIC
@@ -879,7 +881,7 @@ EXTFUN(stg_gc_ut_0_1)
 
 /*- 0 Regs -------------------------------------------------------------------*/
 
-EXTFUN(stg_chk_0)
+EXTFUN(__stg_chk_0)
 {
   FB_
   Sp -= 1;
@@ -890,7 +892,7 @@ EXTFUN(stg_chk_0)
 
 /*- 1 Reg --------------------------------------------------------------------*/
 
-EXTFUN(stg_chk_1)
+EXTFUN(__stg_chk_1)
 {
   FB_
   Sp -= 2;
@@ -1176,11 +1178,11 @@ FN_(stg_yield_noregs)
   FE_
 }
 
-FN_(stg_yield_to_Hugs)
+FN_(stg_yield_to_interpreter)
 {
   FB_
   /* No need to save everything - no live registers */
-  YIELD_TO_HUGS
+  YIELD_TO_INTERPRETER
   FE_
 }
 
@@ -1213,3 +1215,71 @@ FN_(stg_block_1)
   BLOCK_ENTER;
   FE_
 }
+
+/* -----------------------------------------------------------------------------
+ * takeMVar/putMVar-specific blocks
+ *
+ * Stack layout for a thread blocked in takeMVar:
+ *      
+ *       ret. addr
+ *       ptr to MVar   (R1)
+ *       stg_block_takemvar_ret
+ *
+ * Stack layout for a thread blocked in putMVar:
+ *      
+ *       ret. addr
+ *       ptr to Value  (R2)
+ *       ptr to MVar   (R1)
+ *       stg_block_putmvar_ret
+ *
+ * See PrimOps.hc for a description of the workings of take/putMVar.
+ * 
+ * -------------------------------------------------------------------------- */
+
+INFO_TABLE_SRT_BITMAP(stg_block_takemvar_ret_info,  stg_block_takemvar_ret,
+                     0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
+                     RET_SMALL,, IF_, 0, 0);
+
+IF_(stg_block_takemvar_ret)
+{
+  FB_
+  R1.w = Sp[0];
+  Sp++;
+  JMP_(takeMVarzh_fast);
+  FE_
+}
+
+FN_(stg_block_takemvar)
+{
+  FB_
+  Sp -= 2;
+  Sp[1] = R1.w;
+  Sp[0] = (W_)&stg_block_takemvar_ret;
+  BLOCK_GENERIC;
+  FE_
+}
+
+INFO_TABLE_SRT_BITMAP(stg_block_putmvar_ret_info,  stg_block_putmvar_ret,
+                     0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
+                     RET_SMALL,, IF_, 0, 0);
+
+IF_(stg_block_putmvar_ret)
+{
+  FB_
+  R2.w = Sp[1];
+  R1.w = Sp[0];
+  Sp += 2;
+  JMP_(putMVarzh_fast);
+  FE_
+}
+
+FN_(stg_block_putmvar)
+{
+  FB_
+  Sp -= 3;
+  Sp[2] = R2.w;
+  Sp[1] = R1.w;
+  Sp[0] = (W_)&stg_block_putmvar_ret;
+  BLOCK_GENERIC;
+  FE_
+}