/* -----------------------------------------------------------------------------
- * $Id: StgCRun.c,v 1.25 2001/08/07 20:06:41 ken Exp $
+ * $Id: StgCRun.c,v 1.27 2002/01/07 22:35:55 ken Exp $
*
* (c) The GHC Team, 1998-2000
*
* the whatever way C returns a value.
*
* NOTE: StgRun/StgReturn do *NOT* load or store Hp or any
- * other registers (other than saving the C callee-saves
+ * other registers (other than saving the C callee-saves
* registers). Instead, the called function "f" must do that
* in STG land.
- *
+ *
* GCC will have assumed that pushing/popping of C-stack frames is
* going on when it generated its code, and used stack space
* accordingly. However, we actually {\em post-process away} all
* such stack-framery (see \tr{ghc/driver/ghc-asm.lprl}). Things will
* be OK however, if we initially make sure there are
* @RESERVED_C_STACK_BYTES@ on the C-stack to begin with, for local
- * variables.
+ * variables.
*
* -------------------------------------------------------------------------- */
+#include "PosixSource.h"
+
/*
* We define the following (unused) global register variables, because for
* definition has been read. Any point after #include "Stg.h" would be too
* late.
*
- * You can define alpha_EXTRA_CAREFUL here to save $s6, $f8 and $f9 -- registers
- * that we don't use but which are callee-save registers. It shouldn't be
- * necessary.
+ * We define alpha_EXTRA_CAREFUL here to save $s6, $f8 and $f9 -- registers
+ * that we don't use but which are callee-save registers. The __divq() routine
+ * in libc.a clobbers $s6.
*/
#include "config.h"
#ifdef alpha_TARGET_ARCH
-#undef alpha_EXTRA_CAREFUL
+#define alpha_EXTRA_CAREFUL
register long fake_ra __asm__("$26");
#ifdef alpha_EXTRA_CAREFUL
register long fake_s6 __asm__("$15");
/* -----------------------------------------------------------------------------
any architecture (using miniinterpreter)
-------------------------------------------------------------------------- */
-
-/* The static @jmp_environment@ variable allows @miniInterpret@ to
- * communicate with @StgReturn@.
- *
- * Because @StgRun@ may be used recursively, we carefully
- * save and restore the whole of @jmp_environment@.
- */
-#include <setjmp.h>
-#include <string.h> /* for memcpy */
-
-static jmp_buf jmp_environment;
-
-#if 1
extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
{
return 0;
}
-#else
-
-#define CHECK_STACK 0
-#define STACK_DETAILS 0
-
-static int enters = 0;
-
-static void scanStackSeg ( W_* ptr, int nwords )
-{
- W_ w;
-#if CHECK_STACK
- int nwords0 = nwords;
-#if STACK_DETAILS
- while (nwords > 0) {
- w = *ptr;
- if (IS_ARG_TAG(w)) {
- fprintf ( stderr, "%d",w ); nwords--; ptr++;
- while (w) { fprintf(stderr, "_"); w--; nwords--; ptr++; }
- }
- else {
- fprintf(stderr, "p");
- nwords--; ptr++;
- }
- }
- if (nwords < 0) fprintf(stderr, "erk: nwords < 0\n");
-#endif
- checkStackChunk ( ptr, ptr-nwords0 );
-#endif
-}
-
-extern StgFunPtr stg_enterStackTop;
-extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
-{
- char* nm;
- while (1) {
-
-#if CHECK_STACK
- {
- int i;
- StgTSO* tso = basereg->rCurrentTSO;
- StgWord* sb = tso->stack + tso->stack_size;
- StgWord* sp;
- StgWord* su;
- int ws;
-
- if (f == &stg_enterStackTop) {
- sp = tso->sp;
- su = tso->su;
- } else {
- sp = basereg->rSp;
- su = basereg->rSu;
- }
-
-#if STACK_DETAILS
- fprintf(stderr,
- "== SB = %p SP = %p(%p) SU = %p SpLim = %p(%p)\n",
- sb, sp, tso->sp, su, basereg->rSpLim, tso->stack + RESERVED_STACK_WORDS);
-#endif
-
- if (su >= sb) goto postloop;
- if (!sp || !su) goto postloop;
-
- printStack ( sp, sb, su);
-
- while (1) {
- ws = su - sp;
- switch (get_itbl((StgClosure*)su)->type) {
- case STOP_FRAME:
- scanStackSeg(sp,ws);
-#if STACK_DETAILS
- fprintf(stderr, "S%d ",ws);
- fprintf(stderr, "\n");
-#endif
- goto postloop;
- case UPDATE_FRAME:
- scanStackSeg(sp,ws);
-#if STACK_DETAILS
- fprintf(stderr,"U%d ",ws);
-#endif
- sp = su + sizeofW(StgUpdateFrame);
- su = ((StgUpdateFrame*)su)->link;
- break;
- case SEQ_FRAME:
- scanStackSeg(sp,ws);
-#if STACK_DETAILS
- fprintf(stderr,"Q%d ",ws);
-#endif
- sp = su + sizeofW(StgSeqFrame);
- su = ((StgSeqFrame*)su)->link;
- break;
- case CATCH_FRAME:
- scanStackSeg(sp,ws);
-#if STACK_DETAILS
- fprintf(stderr,"C%d ",ws);
-#endif
- sp = su + sizeofW(StgCatchFrame);
- su = ((StgCatchFrame*)su)->link;
- break;
- default:
- fprintf(stderr, "?\nweird record on stack\n");
- assert(0);
- goto postloop;
- }
- }
- postloop:
- }
-#endif
-#if STACK_DETAILS
- fprintf(stderr,"\n");
-#endif
-#if 1
- fprintf(stderr,"-- enter %p ", f);
- nm = nameFromOPtr ( f );
- if (nm) fprintf(stderr, "%s", nm); else
- printPtr((P_)f);
- fprintf ( stderr, "\n");
-#endif
-#if STACK_DETAILS
- fprintf(stderr,"\n");
-#endif
- zzz:
- if (enters % 1000 == 0) fprintf(stderr, "%d enters\n",enters);
- enters++;
- f = (StgFunPtr) (f)();
- if (!f) break;
- }
- fprintf (stderr, "miniInterpreter: bye!\n\n" );
- return (StgThreadReturnCode)R1.i;
-}
-
-EXTFUN(StgReturn)
-{
- return 0;
-}
-#endif
-
-
-
#else /* !USE_MINIINTERPRETER */
#ifdef LEADING_UNDERSCORE
/* -----------------------------------------------------------------------------
x86 architecture
-------------------------------------------------------------------------- */
-
+
#ifdef i386_TARGET_ARCH
StgThreadReturnCode
StgThreadReturnCode r;
__asm__ volatile (
- /*
+ /*
* save callee-saves registers on behalf of the STG code.
*/
"movl %%esp, %%eax\n\t"
/* -----------------------------------------------------------------------------
Sparc architecture
- --
+ --
OLD COMMENT from GHC-3.02:
We want tailjumps to be calls, because `call xxx' is the only Sparc
Updated info (GHC 4.08.2): not saving %i7 any more (see below).
-------------------------------------------------------------------------- */
-
+
#ifdef sparc_TARGET_ARCH
StgThreadReturnCode
#endif
f();
__asm__ volatile (
- ".align 4\n"
+ ".align 4\n"
".global " STG_RETURN "\n"
- STG_RETURN ":"
+ STG_RETURN ":"
: : : "l0","l1","l2","l3","l4","l5","l6","l7");
/* we tell the C compiler that l0-l7 are clobbered on return to
* StgReturn, otherwise it tries to use these to save eg. the
* call to f(), this gets clobbered in STG land and we end up
* dereferencing a bogus pointer in StgReturn.
*/
- __asm__ volatile ("ld %1,%0"
+ __asm__ volatile ("ld %1,%0"
: "=r" (i7) : "m" (((void **)(space))[100]));
#endif
return (StgThreadReturnCode)R1.i;
Architecture Reference Manual_, and as a result of asynchronous software
actions."
- -- Compaq Computer Corporation, Houston. Tru64 UNIX Calling Standard for
+ -- Compaq Computer Corporation, Houston. Tru64 UNIX Calling Standard for
Alpha Systems, 5.1 edition, August 2000, section 3.2.1. http://www.
tru64unix.compaq.com/docs/base_doc/DOCUMENTATION/V51_PDF/ARH9MBTE.PDF
-------------------------------------------------------------------------- */
#ifdef alpha_TARGET_ARCH
StgThreadReturnCode
-StgRun(StgFunPtr f, StgRegTable *basereg)
+StgRun(StgFunPtr f, StgRegTable *basereg)
{
register long real_ra __asm__("$26"); volatile long save_ra;
#ifdef alpha_EXTRA_CAREFUL
register long real_s6 __asm__("$15"); volatile long save_s6;
#endif
-
+
register double real_f2 __asm__("$f2"); volatile double save_f2;
register double real_f3 __asm__("$f3"); volatile double save_f3;
register double real_f4 __asm__("$f4"); volatile double save_f4;
#ifdef hppa1_1_TARGET_ARCH
StgThreadReturnCode
-StgRun(StgFunPtr f, StgRegTable *basereg)
+StgRun(StgFunPtr f, StgRegTable *basereg)
{
StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
StgThreadReturnCode ret;
"\tfldds 8(0,%%r19),%%fr19\n"
"\tldo 32(%%r19),%%r19\n"
"\tfldds -16(0,%%r19),%%fr20\n"
- "\tfldds -8(0,%%r19),%%fr21\n"
+ "\tfldds -8(0,%%r19),%%fr21\n"
: "=r" (ret)
: "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
: "%r19"
projects / ghc-hetmet.git / blobdiff