[project @ 2002-12-05 23:49:43 by mthomas]

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

diff --git a/ghc/rts/HeapStackCheck.hc b/ghc/rts/HeapStackCheck.hc
index 5fa5f10..f3882fe 100644 (file)
--- a/ghc/rts/HeapStackCheck.hc
+++ b/ghc/rts/HeapStackCheck.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: HeapStackCheck.hc,v 1.18 2001/11/08 12:46:31 simonmar Exp $
+ * $Id: HeapStackCheck.hc,v 1.26 2002/03/02 17:43:44 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -47,7 +47,6 @@
  * ThreadRunGHC thread.
  */
 
-
 #define GC_GENERIC                                     \
   if (Hp > HpLim) {                                    \
     Hp -= HpAlloc;                                     \
@@ -635,13 +634,13 @@ EXTFUN(stg_gc_seq_1)
    cases are covered below.
    -------------------------------------------------------------------------- */
 
-/*-- No regsiters live (probably a void return) ----------------------------- */
+/*-- No registers live (probably a void return) ----------------------------- */
 
 /* If we change the policy for thread startup to *not* remove the
  * return address from the stack, we can get rid of this little
  * function/info table...  
  */
-INFO_TABLE_SRT_BITMAP(stg_gc_noregs_ret_info, stg_gc_noregs_ret, 0/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_noregs_info, stg_gc_noregs_ret, 0/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -656,14 +655,14 @@ EXTFUN(stg_gc_noregs)
 {
   FB_
   Sp -= 1;
-  Sp[0] = (W_)&stg_gc_noregs_ret_info;
+  Sp[0] = (W_)&stg_gc_noregs_info;
   GC_GENERIC
   FE_
 }
 
 /*-- R1 is boxed/unpointed -------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_ret_info, stg_gc_unpt_r1_ret, 0/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_unpt_r1_info, stg_gc_unpt_r1_ret, 0/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -681,14 +680,28 @@ EXTFUN(stg_gc_unpt_r1)
   FB_
   Sp -= 2;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_gc_unpt_r1_ret_info;
+  Sp[0] = (W_)&stg_gc_unpt_r1_info;
   GC_GENERIC
   FE_
 }
 
+/*-- Unboxed tuple return (unregisterised build only)------------------ */
+
+INFO_TABLE_SRT_BITMAP(stg_ut_1_0_unreg_info, stg_ut_1_0_unreg_ret, 0/*BITMAP*/, 
+                     0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
+                     RET_SMALL,, EF_, 0, 0);
+
+EXTFUN(stg_ut_1_0_unreg_ret)
+{
+  FB_
+  /* R1 is on the stack (*Sp) */
+  JMP_(ENTRY_CODE(Sp[1]));
+  FE_
+}
+
 /*-- R1 is unboxed -------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_ret_info, stg_gc_unbx_r1_ret, 1/*BITMAP*/,
+INFO_TABLE_SRT_BITMAP(stg_gc_unbx_r1_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. */
@@ -707,14 +720,14 @@ EXTFUN(stg_gc_unbx_r1)
   FB_
   Sp -= 2;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_gc_unbx_r1_ret;
+  Sp[0] = (W_)&stg_gc_unbx_r1_info;
   GC_GENERIC
   FE_
 }
 
 /*-- F1 contains a float ------------------------------------------------- */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_f1_ret_info, stg_gc_f1_ret, 1/*BITMAP*/,
+INFO_TABLE_SRT_BITMAP(stg_gc_f1_info, stg_gc_f1_ret, 1/*BITMAP*/,
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -732,7 +745,7 @@ EXTFUN(stg_gc_f1)
   FB_
   Sp -= 2;
   ASSIGN_FLT(Sp+1, F1);
-  Sp[0] = (W_)&stg_gc_f1_ret_info;
+  Sp[0] = (W_)&stg_gc_f1_info;
   GC_GENERIC
   FE_
 }
@@ -747,7 +760,7 @@ EXTFUN(stg_gc_f1)
 #  define DBL_BITMAP 3
 #endif 
 
-INFO_TABLE_SRT_BITMAP(stg_gc_d1_ret_info, stg_gc_d1_ret, DBL_BITMAP,
+INFO_TABLE_SRT_BITMAP(stg_gc_d1_info, stg_gc_d1_ret, DBL_BITMAP,
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -765,7 +778,41 @@ EXTFUN(stg_gc_d1)
   FB_
   Sp -= 1 + sizeofW(StgDouble);
   ASSIGN_DBL(Sp+1,D1);
-  Sp[0] = (W_)&stg_gc_d1_ret_info;
+  Sp[0] = (W_)&stg_gc_d1_info;
+  GC_GENERIC
+  FE_
+}
+
+
+/*-- L1 contains an int64 ------------------------------------------------- */
+
+/* we support int64s of either 1 or 2 words in size */
+
+#if SIZEOF_VOID_P == 8
+#  define LLI_BITMAP 1
+#else
+#  define LLI_BITMAP 3
+#endif 
+
+INFO_TABLE_SRT_BITMAP(stg_gc_l1_info, stg_gc_l1_ret, LLI_BITMAP,
+                     0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
+                     RET_SMALL,, EF_, 0, 0);
+
+EXTFUN(stg_gc_l1_ret)
+{
+  FB_
+  L1 = PK_Int64(Sp);
+  Sp += sizeofW(StgWord64);
+  JMP_(ENTRY_CODE(Sp[0]));
+  FE_
+}
+
+EXTFUN(stg_gc_l1)
+{
+  FB_
+  Sp -= 1 + sizeofW(StgWord64);
+  ASSIGN_Int64(Sp+1,L1);
+  Sp[0] = (W_)&stg_gc_l1_info;
   GC_GENERIC
   FE_
 }
@@ -800,7 +847,7 @@ EXTFUN(stg_gc_d1)
 
 /*---- R1 contains a pointer: ------ */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_ret_info, stg_gc_ut_1_0_ret, 1/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_ut_1_0_info, stg_gc_ut_1_0_ret, 1/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -819,14 +866,14 @@ EXTFUN(stg_gc_ut_1_0)
   Sp -= 3;
   Sp[2] = R1.w;
   Sp[1] = R2.w;
-  Sp[0] = (W_)&stg_gc_ut_1_0_ret_info;
+  Sp[0] = (W_)&stg_gc_ut_1_0_info;
   GC_GENERIC
   FE_
 }
 
 /*---- R1 contains a non-pointer: ------ */
 
-INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_ret_info, stg_gc_ut_0_1_ret, 3/*BITMAP*/, 
+INFO_TABLE_SRT_BITMAP(stg_gc_ut_0_1_info, stg_gc_ut_0_1_ret, 3/*BITMAP*/, 
                      0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, EF_, 0, 0);
 
@@ -843,7 +890,7 @@ EXTFUN(stg_gc_ut_0_1)
 {
   FB_
   Sp -= 3;
-  Sp[0] = (W_)&stg_gc_ut_0_1_ret_info;
+  Sp[0] = (W_)&stg_gc_ut_0_1_info;
   Sp[1] = R2.w;
   Sp[2] = R1.w;
   GC_GENERIC
@@ -1173,7 +1220,7 @@ FN_(stg_yield_noregs)
 {
   FB_
   Sp--;
-  Sp[0] = (W_)&stg_gc_noregs_ret_info;
+  Sp[0] = (W_)&stg_gc_noregs_info;
   YIELD_GENERIC;
   FE_
 }
@@ -1202,7 +1249,7 @@ FN_(stg_block_noregs)
 {
   FB_
   Sp--;
-  Sp[0] = (W_)&stg_gc_noregs_ret_info;
+  Sp[0] = (W_)&stg_gc_noregs_info;
   BLOCK_GENERIC;
   FE_
 }
@@ -1223,20 +1270,20 @@ FN_(stg_block_1)
  *      
  *       ret. addr
  *       ptr to MVar   (R1)
- *       stg_block_takemvar_ret
+ *       stg_block_takemvar_info
  *
  * Stack layout for a thread blocked in putMVar:
  *      
  *       ret. addr
  *       ptr to Value  (R2)
  *       ptr to MVar   (R1)
- *       stg_block_putmvar_ret
+ *       stg_block_putmvar_info
  *
  * 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,
+INFO_TABLE_SRT_BITMAP(stg_block_takemvar_info,  stg_block_takemvar_ret,
                      0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, IF_, 0, 0);
 
@@ -1254,12 +1301,12 @@ FN_(stg_block_takemvar)
   FB_
   Sp -= 2;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_block_takemvar_ret;
+  Sp[0] = (W_)&stg_block_takemvar_info;
   BLOCK_GENERIC;
   FE_
 }
 
-INFO_TABLE_SRT_BITMAP(stg_block_putmvar_ret_info,  stg_block_putmvar_ret,
+INFO_TABLE_SRT_BITMAP(stg_block_putmvar_info,  stg_block_putmvar_ret,
                      0/*BITMAP*/, 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_LEN*/, 
                      RET_SMALL,, IF_, 0, 0);
 
@@ -1279,7 +1326,7 @@ FN_(stg_block_putmvar)
   Sp -= 3;
   Sp[2] = R2.w;
   Sp[1] = R1.w;
-  Sp[0] = (W_)&stg_block_putmvar_ret;
+  Sp[0] = (W_)&stg_block_putmvar_info;
   BLOCK_GENERIC;
   FE_
 }