ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.21 2000/11/13 14:40:37 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-2000
   5  *
   6  * STG-to-C glue.
   7  *
   8  * To run an STG function from C land, call
   9  *
  10  *              rv = StgRun(f,BaseReg);
  11  *
  12  * where "f" is the STG function to call, and BaseReg is the address of the
  13  * RegTable for this run (we might have separate RegTables if we're running
  14  * multiple threads on an SMP machine).
  15  *
  16  * In the end, "f" must JMP to StgReturn (defined below),
  17  * passing the return-value "rv" in R1,
  18  * to return to the caller of StgRun returning "rv" in
  19  * the whatever way C returns a value.
  20  *
  21  * NOTE: StgRun/StgReturn do *NOT* load or store Hp or any
  22  * other registers (other than saving the C callee-saves
  23  * registers).  Instead, the called function "f" must do that
  24  * in STG land.
  25  *
  26  * GCC will have assumed that pushing/popping of C-stack frames is
  27  * going on when it generated its code, and used stack space
  28  * accordingly.  However, we actually {\em post-process away} all
  29  * such stack-framery (see \tr{ghc/driver/ghc-asm.lprl}). Things will
  30  * be OK however, if we initially make sure there are
  31  * @RESERVED_C_STACK_BYTES@ on the C-stack to begin with, for local
  32  * variables.
  33  *
  34  * -------------------------------------------------------------------------- */
  35
  36 /* include Stg.h first because we want real machine regs in here: we
  37  * have to get the value of R1 back from Stg land to C land intact.
  38  */
  39 #include "Stg.h"
  40 #include "Rts.h"
  41 #include "StgRun.h"
  42
  43 #ifdef DEBUG
  44 #include "RtsFlags.h"
  45 #include "RtsUtils.h"
  46 #include "Printer.h"
  47 #endif
  48
  49 #ifdef USE_MINIINTERPRETER
  50
  51 /* -----------------------------------------------------------------------------
  52    any architecture (using miniinterpreter)
  53    -------------------------------------------------------------------------- */
  54
  55 /* The static @jmp_environment@ variable allows @miniInterpret@ to
  56  * communicate with @StgReturn@.
  57  *
  58  * Because @StgRun@ may be used recursively, we carefully
  59  * save and restore the whole of @jmp_environment@.
  60  */
  61 #include <setjmp.h>
  62 #include <string.h> /* for memcpy */
  63
  64 static jmp_buf jmp_environment;
  65
  66 #if 1
  67
  68 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
  69 {
  70    while (f) {
  71       IF_DEBUG(evaluator,
  72                fprintf(stderr,"Jumping to ");
  73                printPtr((P_)f);
  74                fprintf(stderr,"\n");
  75               );
  76       f = (StgFunPtr) (f)();
  77    }
  78    return (StgThreadReturnCode)R1.i;
  79 }
  80
  81 EXTFUN(StgReturn)
  82 {
  83    return 0;
  84 }
  85
  86 #else
  87
  88 #define CHECK_STACK   0
  89 #define STACK_DETAILS 0
  90
  91 static int enters = 0;
  92
  93 static void scanStackSeg ( W_* ptr, int nwords )
  94 {
  95    W_ w;
  96 #if CHECK_STACK
  97    int nwords0 = nwords;
  98 #if STACK_DETAILS
  99    while (nwords > 0) {
 100       w = *ptr;
 101       if (IS_ARG_TAG(w)) {
 102          fprintf ( stderr, "%d",w ); nwords--; ptr++;
 103          while (w) { fprintf(stderr, "_"); w--; nwords--; ptr++; }
 104       }
 105       else {
 106          fprintf(stderr, "p");
 107          nwords--; ptr++;
 108       }
 109    }
 110    if (nwords < 0) fprintf(stderr, "erk: nwords < 0\n");
 111 #endif
 112    checkStackChunk ( ptr, ptr-nwords0 );
 113 #endif
 114 }
 115
 116 extern StgFunPtr stg_enterStackTop;
 117 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
 118 {
 119     char* nm;
 120     while (1) {
 121
 122 #if CHECK_STACK
 123    {
 124    int i;
 125    StgTSO*  tso = basereg->rCurrentTSO;
 126    StgWord* sb  = tso->stack + tso->stack_size;
 127    StgWord* sp;
 128    StgWord* su;
 129    int ws;
 130
 131    if (f == &stg_enterStackTop) {
 132       sp = tso->sp;
 133       su = tso->su;
 134    } else {
 135       sp  = basereg->rSp;
 136       su  = basereg->rSu;
 137    }
 138
 139 #if STACK_DETAILS
 140    fprintf(stderr,
 141            "== SB = %p   SP = %p(%p)   SU = %p   SpLim = %p(%p)\n",
 142            sb, sp, tso->sp,   su, basereg->rSpLim, tso->stack + RESERVED_STACK_WORDS);
 143 #endif
 144
 145    if (su >= sb) goto postloop;
 146    if (!sp || !su) goto postloop;
 147
 148    printStack ( sp, sb, su);
 149
 150    while (1) {
 151       ws = su - sp;
 152       switch (get_itbl((StgClosure*)su)->type) {
 153          case STOP_FRAME:
 154             scanStackSeg(sp,ws);
 155 #if STACK_DETAILS
 156             fprintf(stderr, "S%d ",ws);
 157             fprintf(stderr, "\n");
 158 #endif
 159             goto postloop;
 160          case UPDATE_FRAME:
 161             scanStackSeg(sp,ws);
 162 #if STACK_DETAILS
 163             fprintf(stderr,"U%d ",ws);
 164 #endif
 165             sp = su + sizeofW(StgUpdateFrame);
 166             su = ((StgUpdateFrame*)su)->link;
 167             break;
 168          case SEQ_FRAME:
 169             scanStackSeg(sp,ws);
 170 #if STACK_DETAILS
 171             fprintf(stderr,"Q%d ",ws);
 172 #endif
 173             sp = su + sizeofW(StgSeqFrame);
 174             su = ((StgSeqFrame*)su)->link;
 175             break;
 176          case CATCH_FRAME:
 177             scanStackSeg(sp,ws);
 178 #if STACK_DETAILS
 179             fprintf(stderr,"C%d ",ws);
 180 #endif
 181             sp = su + sizeofW(StgCatchFrame);
 182             su = ((StgCatchFrame*)su)->link;
 183             break;
 184          default:
 185             fprintf(stderr, "?\nweird record on stack\n");
 186             assert(0);
 187             goto postloop;
 188       }
 189    }
 190    postloop:
 191    }
 192 #endif
 193 #if STACK_DETAILS
 194        fprintf(stderr,"\n");
 195 #endif
 196 #if 1
 197        fprintf(stderr,"-- enter %p ", f);
 198        nm = nameFromOPtr ( f );
 199           if (nm) fprintf(stderr, "%s", nm); else
 200           printPtr((P_)f);
 201        fprintf ( stderr, "\n");
 202 #endif
 203 #if STACK_DETAILS
 204        fprintf(stderr,"\n");
 205 #endif
 206     zzz:
 207        if (enters % 1000 == 0) fprintf(stderr, "%d enters\n",enters);
 208        enters++;
 209        f = (StgFunPtr) (f)();
 210        if (!f) break;
 211     }
 212     fprintf (stderr, "miniInterpreter: bye!\n\n" );
 213     return (StgThreadReturnCode)R1.i;
 214 }
 215
 216 EXTFUN(StgReturn)
 217 {
 218    return 0;
 219 }
 220 #endif
 221
 222
 223
 224 #else /* !USE_MINIINTERPRETER */
 225
 226 #ifdef LEADING_UNDERSCORE
 227 #define STG_RETURN "_StgReturn"
 228 #else
 229 #define STG_RETURN "StgReturn"
 230 #endif
 231
 232 /* -----------------------------------------------------------------------------
 233    x86 architecture
 234    -------------------------------------------------------------------------- */
 235
 236 #ifdef i386_TARGET_ARCH
 237
 238 StgThreadReturnCode
 239 StgRun(StgFunPtr f, StgRegTable *basereg) {
 240
 241     unsigned char space[ RESERVED_C_STACK_BYTES + 4*sizeof(void *) ];
 242     StgThreadReturnCode r;
 243
 244     __asm__ volatile (
 245         /*
 246          * save callee-saves registers on behalf of the STG code.
 247          */
 248         "movl %%esp, %%eax\n\t"
 249         "addl %4, %%eax\n\t"
 250         "movl %%ebx,0(%%eax)\n\t"
 251         "movl %%esi,4(%%eax)\n\t"
 252         "movl %%edi,8(%%eax)\n\t"
 253         "movl %%ebp,12(%%eax)\n\t"
 254         /*
 255          * Set BaseReg
 256          */
 257         "movl %3,%%ebx\n\t"
 258         /*
 259          * grab the function argument from the stack, and jump to it.
 260          */
 261         "movl %2,%%eax\n\t"
 262         "jmp *%%eax\n\t"
 263
 264         ".global " STG_RETURN "\n"
 265         STG_RETURN ":\n\t"
 266
 267         "movl %%esi, %%eax\n\t"   /* Return value in R1  */
 268
 269         /*
 270          * restore callee-saves registers.  (Don't stomp on %%eax!)
 271          */
 272         "movl %%esp, %%edx\n\t"
 273         "addl %4, %%edx\n\t"
 274         "movl 0(%%edx),%%ebx\n\t"       /* restore the registers saved above */
 275         "movl 4(%%edx),%%esi\n\t"
 276         "movl 8(%%edx),%%edi\n\t"
 277         "movl 12(%%edx),%%ebp\n\t"
 278
 279       : "=&a" (r), "=m" (space)
 280       : "m" (f), "m" (basereg), "i" (RESERVED_C_STACK_BYTES)
 281       : "edx" /* stomps on %edx */
 282     );
 283
 284     return r;
 285 }
 286
 287 #endif
 288
 289 /* -----------------------------------------------------------------------------
 290    Sparc architecture
 291
 292    --
 293    OLD COMMENT from GHC-3.02:
 294
 295    We want tailjumps to be calls, because `call xxx' is the only Sparc
 296    branch that allows an arbitrary label as a target.  (Gcc's ``goto
 297    *target'' construct ends up loading the label into a register and
 298    then jumping, at the cost of two extra instructions for the 32-bit
 299    load.)
 300
 301    When entering the threaded world, we stash our return address in a
 302    known location so that \tr{%i7} is available as an extra
 303    callee-saves register.  Of course, we have to restore this when
 304    coming out of the threaded world.
 305
 306    I hate this god-forsaken architecture.  Since the top of the
 307    reserved stack space is used for globals and the bottom is reserved
 308    for outgoing arguments, we have to stick our return address
 309    somewhere in the middle.  Currently, I'm allowing 100 extra
 310    outgoing arguments beyond the first 6.  --JSM
 311
 312    Updated info (GHC 4.06): we don't appear to use %i7 any more, so
 313    I'm not sure whether we still need to save it.  Incedentally, what
 314    does the last paragraph above mean when it says "the top of the
 315    stack is used for globals"?  What globals?  --SDM
 316
 317    -------------------------------------------------------------------------- */
 318
 319 #ifdef sparc_TARGET_ARCH
 320
 321 StgThreadReturnCode
 322 StgRun(StgFunPtr f, StgRegTable *basereg) {
 323
 324     unsigned char space[RESERVED_C_STACK_BYTES];
 325 #if 0
 326     register void *i7 __asm__("%i7");
 327     ((void **)(space))[100] = i7;
 328 #endif
 329     f();
 330     __asm__ volatile (
 331             ".align 4\n"
 332             ".global " STG_RETURN "\n"
 333             STG_RETURN ":"
 334             : : : "l0","l1","l2","l3","l4","l5","l6","l7");
 335     /* we tell the C compiler that l0-l7 are clobbered on return to
 336      * StgReturn, otherwise it tries to use these to save eg. the
 337      * address of space[100] across the call.  The correct thing
 338      * to do would be to save all the callee-saves regs, but we
 339      * can't be bothered to do that.
 340      *
 341      * The code that gcc generates for this little fragment is now
 342      * terrible.  We could do much better by coding it directly in
 343      * assembler.
 344      */
 345 #if 0
 346     __asm__ volatile ("ld %1,%0"
 347                       : "=r" (i7) : "m" (((void **)(space))[100]));
 348 #endif
 349     return (StgThreadReturnCode)R1.i;
 350 }
 351
 352 #endif
 353
 354 /* -----------------------------------------------------------------------------
 355    alpha architecture
 356    -------------------------------------------------------------------------- */
 357
 358 #ifdef alpha_TARGET_ARCH
 359
 360 StgThreadReturnCode
 361 StgRun(StgFunPtr f, StgRegTable *basereg)
 362 {
 363     StgThreadReturnCode ret;
 364
 365     __asm__ volatile ("stq $9,-8($30)\n\t"
 366                       "stq $10,-16($30)\n\t"
 367                       "stq $11,-24($30)\n\t"
 368                       "stq $12,-32($30)\n\t"
 369                       "stq $13,-40($30)\n\t"
 370                       "stq $14,-48($30)\n\t"
 371                       "stq $15,-56($30)\n\t"
 372                       "stt $f2,-64($30)\n\t"
 373                       "stt $f3,-72($30)\n\t"
 374                       "stt $f4,-80($30)\n\t"
 375                       "stt $f5,-88($30)\n\t"
 376                       "stt $f6,-96($30)\n\t"
 377                       "stt $f7,-104($30)\n\t"
 378                       "stt $f8,-112($30)\n\t"
 379                       "stt $f9,-120($30)\n\t"
 380                       "lda $30,-%0($30)" : :
 381                       "K" (RESERVED_C_STACK_BYTES+
 382                            8*sizeof(double)+8*sizeof(long)));
 383
 384     f();
 385
 386     __asm__ volatile (".align 3\n"
 387                       ".globl " STG_RETURN "\n"
 388                       STG_RETURN ":\n\t"
 389                       "lda %0,($14)\n\t"  /* save R1 */
 390                       "lda $30,%0($30)\n\t"
 391                       "ldq $9,-8($30)\n\t"
 392                       "ldq $10,-16($30)\n\t"
 393                       "ldq $11,-24($30)\n\t"
 394                       "ldq $12,-32($30)\n\t"
 395                       "ldq $13,-40($30)\n\t"
 396                       "ldq $14,-48($30)\n\t"
 397                       "ldq $15,-56($30)\n\t"
 398                       "ldt $f2,-64($30)\n\t"
 399                       "ldt $f3,-72($30)\n\t"
 400                       "ldt $f4,-80($30)\n\t"
 401                       "ldt $f5,-88($30)\n\t"
 402                       "ldt $f6,-96($30)\n\t"
 403                       "ldt $f7,-104($30)\n\t"
 404                       "ldt $f8,-112($30)\n\t"
 405                       "ldt $f9,-120($30)"
 406                       : "=r" (ret)
 407                       : "K" (RESERVED_C_STACK_BYTES+
 408                            8*sizeof(double)+8*sizeof(long)));
 409
 410     return ret;
 411 }
 412
 413 #endif /* alpha_TARGET_ARCH */
 414
 415 /* -----------------------------------------------------------------------------
 416    HP-PA architecture
 417    -------------------------------------------------------------------------- */
 418
 419 #ifdef hppa1_1_TARGET_ARCH
 420
 421 StgThreadReturnCode
 422 StgRun(StgFunPtr f, StgRegTable *basereg)
 423 {
 424     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
 425     StgThreadReturnCode ret;
 426
 427     __asm__ volatile ("ldo %0(%%r30),%%r19\n"
 428                       "\tstw %%r3, 0(0,%%r19)\n"
 429                       "\tstw %%r4, 4(0,%%r19)\n"
 430                       "\tstw %%r5, 8(0,%%r19)\n"
 431                       "\tstw %%r6,12(0,%%r19)\n"
 432                       "\tstw %%r7,16(0,%%r19)\n"
 433                       "\tstw %%r8,20(0,%%r19)\n"
 434                       "\tstw %%r9,24(0,%%r19)\n"
 435                       "\tstw %%r10,28(0,%%r19)\n"
 436                       "\tstw %%r11,32(0,%%r19)\n"
 437                       "\tstw %%r12,36(0,%%r19)\n"
 438                       "\tstw %%r13,40(0,%%r19)\n"
 439                       "\tstw %%r14,44(0,%%r19)\n"
 440                       "\tstw %%r15,48(0,%%r19)\n"
 441                       "\tstw %%r16,52(0,%%r19)\n"
 442                       "\tstw %%r17,56(0,%%r19)\n"
 443                       "\tstw %%r18,60(0,%%r19)\n"
 444                       "\tldo 80(%%r19),%%r19\n"
 445                       "\tfstds %%fr12,-16(0,%%r19)\n"
 446                       "\tfstds %%fr13, -8(0,%%r19)\n"
 447                       "\tfstds %%fr14,  0(0,%%r19)\n"
 448                       "\tfstds %%fr15,  8(0,%%r19)\n"
 449                       "\tldo 32(%%r19),%%r19\n"
 450                       "\tfstds %%fr16,-16(0,%%r19)\n"
 451                       "\tfstds %%fr17, -8(0,%%r19)\n"
 452                       "\tfstds %%fr18,  0(0,%%r19)\n"
 453                       "\tfstds %%fr19,  8(0,%%r19)\n"
 454                       "\tldo 32(%%r19),%%r19\n"
 455                       "\tfstds %%fr20,-16(0,%%r19)\n"
 456                       "\tfstds %%fr21, -8(0,%%r19)\n" : :
 457                       "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
 458                       );
 459
 460     f();
 461
 462     __asm__ volatile (".align 4\n"
 463                       "\t.EXPORT " STG_RETURN ",CODE\n"
 464                       "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
 465                       STG_RETURN "\n"
 466                       /* "\tldo %0(%%r3),%%r19\n" */
 467                       "\tldo %1(%%r30),%%r19\n"
 468                       "\tcopy %%r11, %0\n"  /* save R1 */
 469                       "\tldw  0(0,%%r19),%%r3\n"
 470                       "\tldw  4(0,%%r19),%%r4\n"
 471                       "\tldw  8(0,%%r19),%%r5\n"
 472                       "\tldw 12(0,%%r19),%%r6\n"
 473                       "\tldw 16(0,%%r19),%%r7\n"
 474                       "\tldw 20(0,%%r19),%%r8\n"
 475                       "\tldw 24(0,%%r19),%%r9\n"
 476                       "\tldw 28(0,%%r19),%%r10\n"
 477                       "\tldw 32(0,%%r19),%%r11\n"
 478                       "\tldw 36(0,%%r19),%%r12\n"
 479                       "\tldw 40(0,%%r19),%%r13\n"
 480                       "\tldw 44(0,%%r19),%%r14\n"
 481                       "\tldw 48(0,%%r19),%%r15\n"
 482                       "\tldw 52(0,%%r19),%%r16\n"
 483                       "\tldw 56(0,%%r19),%%r17\n"
 484                       "\tldw 60(0,%%r19),%%r18\n"
 485                       "\tldo 80(%%r19),%%r19\n"
 486                       "\tfldds -16(0,%%r19),%%fr12\n"
 487                       "\tfldds  -8(0,%%r19),%%fr13\n"
 488                       "\tfldds   0(0,%%r19),%%fr14\n"
 489                       "\tfldds   8(0,%%r19),%%fr15\n"
 490                       "\tldo 32(%%r19),%%r19\n"
 491                       "\tfldds -16(0,%%r19),%%fr16\n"
 492                       "\tfldds  -8(0,%%r19),%%fr17\n"
 493                       "\tfldds   0(0,%%r19),%%fr18\n"
 494                       "\tfldds   8(0,%%r19),%%fr19\n"
 495                       "\tldo 32(%%r19),%%r19\n"
 496                       "\tfldds -16(0,%%r19),%%fr20\n"
 497                       "\tfldds  -8(0,%%r19),%%fr21\n"
 498                          : "=r" (ret)
 499                          : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
 500                          : "%r19"
 501                       );
 502
 503     return ret;
 504 }
 505
 506 #endif /* hppa1_1_TARGET_ARCH */
 507
 508 #endif /* !USE_MINIINTERPRETER */