X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStgStartup.hc;h=d3e4c2f0ed79f5c0b6e05f2432712f2d1c2c51cf;hb=2c5525a9fae00927d8068dc5294421868350daf9;hp=bed23129b0c0231940ff53df1a9d4084dc32ef68;hpb=50027272414438955dbc41696541cbd25da55883;p=ghc-hetmet.git diff --git a/ghc/rts/StgStartup.hc b/ghc/rts/StgStartup.hc index bed2312..d3e4c2f 100644 --- a/ghc/rts/StgStartup.hc +++ b/ghc/rts/StgStartup.hc @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: StgStartup.hc,v 1.15 2001/03/23 16:36:21 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. * @@ -27,10 +27,8 @@ #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); @@ -43,53 +41,65 @@ 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 Sp to the last word on the stack, and Su to just past the end - * of the stack. We then place the return value at the top of the stack. - */ - Sp += sizeofW(StgStopFrame) - 1; - Su = (StgUpdateFrame *)(Sp+1); - Sp[0] = R1.w; + // + // 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! */ + SaveThreadState(); // inline! - /* R1 contains the return value of the thread */ - R1.p = (P_)ThreadFinished; + // R1 contains the return value of the thread + R1.i = ThreadFinished; JMP_(StgReturn); FE_ @@ -97,10 +107,8 @@ STGFUN(stg_stop_thread_entry) /* ----------------------------------------------------------------------------- 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) @@ -108,35 +116,82 @@ 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_PrelMain). So - we currently disable module initialisation for Hugs. -------------------------------------------------------------------------- */ extern F_ *init_stack; @@ -150,7 +205,7 @@ STGFUN(stg_init_ret) /* On entry to stg_init: * init_stack[0] = &stg_init_ret; - * init_stack[1] = __init_Something; + * init_stack[1] = __stginit_Something; */ STGFUN(stg_init) { @@ -159,8 +214,3 @@ STGFUN(stg_init) JMP_(POP_INIT_STACK()); FE_ } - -/* PrelGHC doesn't really exist... */ - -START_MOD_INIT(__init_PrelGHC); -END_MOD_INIT();