+++ /dev/null
-/* -----------------------------------------------------------------------------
- * $Id: StgStartup.hc,v 1.21 2003/05/14 09:14:00 simonmar Exp $
- *
- * (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"
-
-/*
- * This module contains the two entry points and the final exit point
- * to/from the Haskell world. We can enter either by:
- *
- * a) returning to the address on the top of the stack, or
- * b) entering the closure on the top of the stack
- *
- * the function stg_stop_thread_entry is the final exit for a
- * thread: it is the last return address on the stack. It returns
- * to the scheduler marking the thread as finished.
- */
-
-#define CHECK_SENSIBLE_REGS() \
- ASSERT(Hp != (P_)0); \
- ASSERT(Sp != (P_)0); \
- ASSERT(SpLim != (P_)0); \
- ASSERT(HpLim != (P_)0); \
- ASSERT(SpLim - RESERVED_STACK_WORDS <= Sp); \
- ASSERT(HpLim >= Hp);
-
-/* -----------------------------------------------------------------------------
- Returning from the STG world.
-
- This is a polymorphic return address, meaning that any old constructor
- can be returned, we don't care (actually, it's probably going to be
- an IOok constructor, which will indirect through the vector table
- slot 0).
- -------------------------------------------------------------------------- */
-
-EXTFUN(stg_stop_thread_ret);
-
-#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_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.
- //
- // 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. 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++;
- ENTER();
- FE_
-}
-#else
-STGFUN(stg_forceIO_ret)
-{
- FB_
- R1.w = Sp[0];
- Sp += 2;
- ENTER();
- FE_
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- Non-strict IO application.
-
- 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_
- Sp++;
- 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.
- -------------------------------------------------------------------------- */
-
-extern F_ *init_stack;
-
-STGFUN(stg_init_ret)
-{
- FB_
- JMP_(StgReturn);
- FE_
-}
-
-/* On entry to stg_init:
- * init_stack[0] = &stg_init_ret;
- * init_stack[1] = __stginit_Something;
- */
-STGFUN(stg_init)
-{
- FB_
- Sp = BaseReg->rSp;
- JMP_(POP_INIT_STACK());
- FE_
-}
projects / ghc-hetmet.git / blobdiff