/* -----------------------------------------------------------------------------
- * $Id: StgStartup.hc,v 1.8 2000/03/16 12:40:40 simonmar Exp $
+ * $Id: StgStartup.hc,v 1.21 2003/05/14 09:14:00 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2002
*
* Code for starting, stopping and restarting threads.
*
* ---------------------------------------------------------------------------*/
+#include "Stg.h"
#include "Rts.h"
#include "StgRun.h" /* StgReturn */
#include "StgStartup.h"
#define CHECK_SENSIBLE_REGS() \
ASSERT(Hp != (P_)0); \
ASSERT(Sp != (P_)0); \
- ASSERT(Su != (StgUpdateFrame *)0); \
ASSERT(SpLim != (P_)0); \
ASSERT(HpLim != (P_)0); \
- ASSERT(Sp <= (P_)Su); \
ASSERT(SpLim - RESERVED_STACK_WORDS <= Sp); \
ASSERT(HpLim >= Hp);
slot 0).
-------------------------------------------------------------------------- */
-EXTFUN(stg_stop_thread_entry);
+EXTFUN(stg_stop_thread_ret);
-#ifdef PROFILING
-#define STOP_THREAD_BITMAP 1
+#if defined(PROFILING)
+#define STOP_THREAD_BITMAP 3
+#define STOP_THREAD_WORDS 2
#else
#define STOP_THREAD_BITMAP 0
+#define STOP_THREAD_WORDS 0
#endif
/* VEC_POLY_INFO expects to see these names - but they should all be the same. */
-#define stg_stop_thread_0_entry stg_stop_thread_entry
-#define stg_stop_thread_1_entry stg_stop_thread_entry
-#define stg_stop_thread_2_entry stg_stop_thread_entry
-#define stg_stop_thread_3_entry stg_stop_thread_entry
-#define stg_stop_thread_4_entry stg_stop_thread_entry
-#define stg_stop_thread_5_entry stg_stop_thread_entry
-#define stg_stop_thread_6_entry stg_stop_thread_entry
-#define stg_stop_thread_7_entry stg_stop_thread_entry
-
-VEC_POLY_INFO_TABLE(stg_stop_thread,STOP_THREAD_BITMAP,0,0,0,STOP_FRAME,,EF_);
-
-STGFUN(stg_stop_thread_entry)
+#define stg_stop_thread_0_ret stg_stop_thread_ret
+#define stg_stop_thread_1_ret stg_stop_thread_ret
+#define stg_stop_thread_2_ret stg_stop_thread_ret
+#define stg_stop_thread_3_ret stg_stop_thread_ret
+#define stg_stop_thread_4_ret stg_stop_thread_ret
+#define stg_stop_thread_5_ret stg_stop_thread_ret
+#define stg_stop_thread_6_ret stg_stop_thread_ret
+#define stg_stop_thread_7_ret stg_stop_thread_ret
+
+VEC_POLY_INFO_TABLE( stg_stop_thread,
+ MK_SMALL_BITMAP(STOP_THREAD_WORDS, STOP_THREAD_BITMAP),
+ 0,0,0,STOP_FRAME,,EF_);
+
+STGFUN(stg_stop_thread_ret)
{
FB_
-
- /*
- * The final exit.
- *
- * The top-top-level closures (e.g., "main") are of type "IO a".
- * When entered, they perform an IO action and return an 'a' in R1.
- *
- * We save R1 on top of the stack where the scheduler can find it,
- * tidy up the registers and return to the scheduler.
- */
-
- /* Move Su just off the end of the stack, we're about to spam the
- * STOP_FRAME with the return value.
- */
- Su = (StgUpdateFrame *)(Sp+1);
- Sp[0] = R1.w;
-
- SaveThreadState(); /* inline! */
-
- /* R1 contains the return value of the thread */
- R1.p = (P_)ThreadFinished;
+ //
+ // The final exit.
+ //
+ // The top-top-level closures (e.g., "main") are of type "IO a".
+ // When entered, they perform an IO action and return an 'a' in R1.
+ //
+ // We save R1 on top of the stack where the scheduler can find it,
+ // tidy up the registers and return to the scheduler.
+ //
+ // We Leave the stack looking like this:
+ //
+ // +----------------+
+ // | -------------------> return value
+ // +----------------+
+ // | stg_enter_info |
+ // +----------------+
+ //
+ // The stg_enter_info is just a dummy info table so that the
+ // garbage collector can understand the stack (there must always
+ // be an info table on top of the stack).
+ //
+
+ Sp += sizeofW(StgStopFrame) - 2;
+ Sp[1] = R1.w;
+ Sp[0] = (W_)&stg_enter_info;
+
+ CurrentTSO->what_next = ThreadComplete;
+
+ SaveThreadState(); // inline!
+
+ // R1 contains the return value of the thread
+ R1.i = ThreadFinished;
JMP_(StgReturn);
FE_
/* -----------------------------------------------------------------------------
Start a thread from the scheduler by returning to the address on
- the top of the stack (and popping the address). This is used for
- returning to the slow entry point of a function after a garbage collection
- or re-schedule. The slow entry point expects the stack to contain the
- pending arguments only.
+ the top of the stack. This is used for all entries to STG code
+ from C land.
-------------------------------------------------------------------------- */
STGFUN(stg_returnToStackTop)
FB_
LoadThreadState();
CHECK_SENSIBLE_REGS();
+ JMP_(ENTRY_CODE(Sp[0]));
+ FE_
+}
+
+/* -----------------------------------------------------------------------------
+ Strict IO application - performing an IO action and entering its result.
+
+ rts_evalIO() lets you perform Haskell IO actions from outside of
+ Haskell-land, returning back to you their result. Want this result
+ to be evaluated to WHNF by that time, so that we can easily get at
+ the int/char/whatever using the various get{Ty} functions provided
+ by the RTS API.
+
+ forceIO takes care of this, performing the IO action and entering the
+ results that comes back.
+ ------------------------------------------------------------------------- */
+
+INFO_TABLE_RET( stg_forceIO_info,stg_forceIO_ret,
+ MK_SMALL_BITMAP(0/*size*/, 0/*BITMAP*/),
+ 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
+ RET_SMALL,, EF_, 0, 0);
+
+#ifdef REG_R1
+STGFUN(stg_forceIO_ret)
+{
+ FB_
Sp++;
- JMP_(ENTRY_CODE(Sp[-1]));
+ ENTER();
+ FE_
+}
+#else
+STGFUN(stg_forceIO_ret)
+{
+ FB_
+ R1.w = Sp[0];
+ Sp += 2;
+ ENTER();
FE_
}
+#endif
/* -----------------------------------------------------------------------------
- Start a thread from the scheduler by entering the closure pointed
- to by the word on the top of the stack.
- -------------------------------------------------------------------------- */
+ Non-strict IO application.
-STGFUN(stg_enterStackTop)
+ This stack frame works like stg_forceIO_info except that it
+ doesn't evaluate the return value. We need the layer because the
+ return convention for an IO action differs depending on whether R1
+ is a register or not.
+ ------------------------------------------------------------------------- */
+
+INFO_TABLE_RET( stg_noforceIO_info,stg_noforceIO_ret,
+ MK_SMALL_BITMAP(0/*size*/, 0/*BITMAP*/),
+ 0/*SRT*/, 0/*SRT_OFF*/, 0/*SRT_BITMAP*/,
+ RET_SMALL,, EF_, 0, 0);
+
+#ifdef REG_R1
+STGFUN(stg_noforceIO_ret)
{
FB_
- LoadThreadState();
- CHECK_SENSIBLE_REGS();
- /* don't count this enter for ticky-ticky profiling */
- R1.p = (P_)Sp[0];
Sp++;
- JMP_(GET_ENTRY(R1.cl));
+ JMP_(ENTRY_CODE(Sp[0]));
+ FE_
+}
+#else
+STGFUN(stg_noforceIO_ret)
+{
+ FB_
+ R1.w = Sp[0];
+ Sp += 2;
+ JMP_(ENTRY_CODE(Sp[0]));
FE_
}
+#endif
-
/* -----------------------------------------------------------------------------
Special STG entry points for module registration.
-
- This stuff is problematic for Hugs, because it introduces a
- dependency between the RTS and the program (ie. __init_Main). So
- we currently disable module initialisation for Hugs.
-------------------------------------------------------------------------- */
-#ifndef INTERPRETER
-
extern F_ *init_stack;
STGFUN(stg_init_ret)
FE_
}
+/* On entry to stg_init:
+ * init_stack[0] = &stg_init_ret;
+ * init_stack[1] = __stginit_Something;
+ */
STGFUN(stg_init)
{
- EF_(__init_Main);
- EF_(__init_Prelude);
FB_
- Sp = (P_)init_stack;
- PUSH_INIT_STACK(stg_init_ret);
- PUSH_INIT_STACK(__init_Prelude);
- JMP_(__init_Main);
+ Sp = BaseReg->rSp;
+ JMP_(POP_INIT_STACK());
FE_
}
-
-/* PrelGHC doesn't really exist... */
-
-START_MOD_INIT(__init_PrelGHC);
-END_MOD_INIT();
-
-#endif /* !INTERPRETER */
projects / ghc-hetmet.git / blobdiff