+++ /dev/null
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Code for starting, stopping and restarting threads.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC. It is compiled by GHC directly. For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.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 != 0); \
- ASSERT(Sp != 0); \
- ASSERT(SpLim != 0); \
- ASSERT(HpLim != 0); \
- ASSERT(SpLim - WDS(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).
- -------------------------------------------------------------------------- */
-
-#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
-
-/* A polymorhpic return address, where all the vector slots point to the
- direct entry point. */
-INFO_TABLE_RET( stg_stop_thread, STOP_THREAD_WORDS, STOP_THREAD_BITMAP,
- STOP_FRAME,
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread),
- RET_LBL(stg_stop_thread) )
-{
- /*
- 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 = Sp + SIZEOF_StgStopFrame - WDS(2);
- Sp(1) = R1;
- Sp(0) = stg_enter_info;
-
- StgTSO_what_next(CurrentTSO) = ThreadComplete::I16;
-
- SAVE_THREAD_STATE();
-
- /* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
- StgRegTable_rRet(BaseReg) = ThreadFinished;
- R1 = BaseReg;
-
- jump StgReturn;
-}
-
-/* -----------------------------------------------------------------------------
- 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.
-
- On the way back, we (usually) pass through stg_returnToSched which saves
- the thread's state away nicely.
- -------------------------------------------------------------------------- */
-
-stg_returnToStackTop
-{
- LOAD_THREAD_STATE();
- CHECK_SENSIBLE_REGS();
- jump %ENTRY_CODE(Sp(0));
-}
-
-stg_returnToSched
-{
- SAVE_THREAD_STATE();
- foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
- jump StgReturn;
-}
-
-// A variant of stg_returntToSched that doesn't call threadPaused() on the
-// current thread. This is used for switching from compiled execution to the
-// interpreter, where calling threadPaused() on every switch would be too
-// expensive.
-stg_returnToSchedNotPaused
-{
- SAVE_THREAD_STATE();
- jump StgReturn;
-}
-
-// A variant of stg_returnToSched, but instead of returning directly to the
-// scheduler, we jump to the code fragment pointed to by R2. This lets us
-// perform some final actions after making the thread safe, such as unlocking
-// the MVar on which we are about to block in SMP mode.
-stg_returnToSchedButFirst
-{
- SAVE_THREAD_STATE();
- foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
- jump R2;
-}
-
-/* -----------------------------------------------------------------------------
- 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, 0/*size*/, 0/*bitmap*/, RET_SMALL)
-
-#ifdef REG_R1
-{
- Sp_adj(1);
- ENTER();
-}
-#else
-{
- R1 = Sp(0);
- Sp_adj(2);
- ENTER();
-}
-#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, 0/*size*/, 0/*bitmap*/, RET_SMALL )
-
-#ifdef REG_R1
-{
- Sp_adj(1);
- jump %ENTRY_CODE(Sp(0));
-}
-#else
-{
- R1 = Sp(0);
- Sp_adj(2);
- jump %ENTRY_CODE(Sp(0));
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- Special STG entry points for module registration.
- -------------------------------------------------------------------------- */
-
-stg_init_finish
-{
- jump StgReturn;
-}
-
-/* On entry to stg_init:
- * init_stack[0] = &stg_init_ret;
- * init_stack[1] = __stginit_Something;
- */
-stg_init
-{
- W_ next;
- Sp = W_[BaseReg + OFFSET_StgRegTable_rSp];
- next = W_[Sp];
- Sp_adj(1);
- jump next;
-}
projects / ghc-hetmet.git / blobdiff