ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.25 2001/08/07 20:06:41 ken 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
  37 /*
  38  * We define the following (unused) global register variables, because for
  39  * some reason gcc generates sub-optimal code for StgRun() on the Alpha
  40  * (unnecessarily saving extra registers on the stack) if we don't.
  41  *
  42  * Why do it at the top of this file, rather than near StgRun() below?  Because
  43  * gcc doesn't let us define global register variables after any function
  44  * definition has been read.  Any point after #include "Stg.h" would be too
  45  * late.
  46  *
  47  * You can define alpha_EXTRA_CAREFUL here to save $s6, $f8 and $f9 -- registers
  48  * that we don't use but which are callee-save registers.  It shouldn't be
  49  * necessary.
  50  */
  51 #include "config.h"
  52 #ifdef alpha_TARGET_ARCH
  53 #undef alpha_EXTRA_CAREFUL
  54 register long   fake_ra __asm__("$26");
  55 #ifdef alpha_EXTRA_CAREFUL
  56 register long   fake_s6 __asm__("$15");
  57 register double fake_f8 __asm__("$f8");
  58 register double fake_f9 __asm__("$f9");
  59 #endif
  60 #endif
  61
  62 /* include Stg.h first because we want real machine regs in here: we
  63  * have to get the value of R1 back from Stg land to C land intact.
  64  */
  65 #include "Stg.h"
  66 #include "Rts.h"
  67 #include "StgRun.h"
  68
  69 #ifdef DEBUG
  70 #include "RtsFlags.h"
  71 #include "RtsUtils.h"
  72 #include "Printer.h"
  73 #endif
  74
  75 #ifdef USE_MINIINTERPRETER
  76
  77 /* -----------------------------------------------------------------------------
  78    any architecture (using miniinterpreter)
  79    -------------------------------------------------------------------------- */
  80
  81 /* The static @jmp_environment@ variable allows @miniInterpret@ to
  82  * communicate with @StgReturn@.
  83  *
  84  * Because @StgRun@ may be used recursively, we carefully
  85  * save and restore the whole of @jmp_environment@.
  86  */
  87 #include <setjmp.h>
  88 #include <string.h> /* for memcpy */
  89
  90 static jmp_buf jmp_environment;
  91
  92 #if 1
  93
  94 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
  95 {
  96    while (f) {
  97       IF_DEBUG(evaluator,
  98                fprintf(stderr,"Jumping to ");
  99                printPtr((P_)f);
 100                fprintf(stderr,"\n");
 101               );
 102       f = (StgFunPtr) (f)();
 103    }
 104    return (StgThreadReturnCode)R1.i;
 105 }
 106
 107 EXTFUN(StgReturn)
 108 {
 109    return 0;
 110 }
 111
 112 #else
 113
 114 #define CHECK_STACK   0
 115 #define STACK_DETAILS 0
 116
 117 static int enters = 0;
 118
 119 static void scanStackSeg ( W_* ptr, int nwords )
 120 {
 121    W_ w;
 122 #if CHECK_STACK
 123    int nwords0 = nwords;
 124 #if STACK_DETAILS
 125    while (nwords > 0) {
 126       w = *ptr;
 127       if (IS_ARG_TAG(w)) {
 128          fprintf ( stderr, "%d",w ); nwords--; ptr++;
 129          while (w) { fprintf(stderr, "_"); w--; nwords--; ptr++; }
 130       }
 131       else {
 132          fprintf(stderr, "p");
 133          nwords--; ptr++;
 134       }
 135    }
 136    if (nwords < 0) fprintf(stderr, "erk: nwords < 0\n");
 137 #endif
 138    checkStackChunk ( ptr, ptr-nwords0 );
 139 #endif
 140 }
 141
 142 extern StgFunPtr stg_enterStackTop;
 143 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
 144 {
 145     char* nm;
 146     while (1) {
 147
 148 #if CHECK_STACK
 149    {
 150    int i;
 151    StgTSO*  tso = basereg->rCurrentTSO;
 152    StgWord* sb  = tso->stack + tso->stack_size;
 153    StgWord* sp;
 154    StgWord* su;
 155    int ws;
 156
 157    if (f == &stg_enterStackTop) {
 158       sp = tso->sp;
 159       su = tso->su;
 160    } else {
 161       sp  = basereg->rSp;
 162       su  = basereg->rSu;
 163    }
 164
 165 #if STACK_DETAILS
 166    fprintf(stderr,
 167            "== SB = %p   SP = %p(%p)   SU = %p   SpLim = %p(%p)\n",
 168            sb, sp, tso->sp,   su, basereg->rSpLim, tso->stack + RESERVED_STACK_WORDS);
 169 #endif
 170
 171    if (su >= sb) goto postloop;
 172    if (!sp || !su) goto postloop;
 173
 174    printStack ( sp, sb, su);
 175
 176    while (1) {
 177       ws = su - sp;
 178       switch (get_itbl((StgClosure*)su)->type) {
 179          case STOP_FRAME:
 180             scanStackSeg(sp,ws);
 181 #if STACK_DETAILS
 182             fprintf(stderr, "S%d ",ws);
 183             fprintf(stderr, "\n");
 184 #endif
 185             goto postloop;
 186          case UPDATE_FRAME:
 187             scanStackSeg(sp,ws);
 188 #if STACK_DETAILS
 189             fprintf(stderr,"U%d ",ws);
 190 #endif
 191             sp = su + sizeofW(StgUpdateFrame);
 192             su = ((StgUpdateFrame*)su)->link;
 193             break;
 194          case SEQ_FRAME:
 195             scanStackSeg(sp,ws);
 196 #if STACK_DETAILS
 197             fprintf(stderr,"Q%d ",ws);
 198 #endif
 199             sp = su + sizeofW(StgSeqFrame);
 200             su = ((StgSeqFrame*)su)->link;
 201             break;
 202          case CATCH_FRAME:
 203             scanStackSeg(sp,ws);
 204 #if STACK_DETAILS
 205             fprintf(stderr,"C%d ",ws);
 206 #endif
 207             sp = su + sizeofW(StgCatchFrame);
 208             su = ((StgCatchFrame*)su)->link;
 209             break;
 210          default:
 211             fprintf(stderr, "?\nweird record on stack\n");
 212             assert(0);
 213             goto postloop;
 214       }
 215    }
 216    postloop:
 217    }
 218 #endif
 219 #if STACK_DETAILS
 220        fprintf(stderr,"\n");
 221 #endif
 222 #if 1
 223        fprintf(stderr,"-- enter %p ", f);
 224        nm = nameFromOPtr ( f );
 225           if (nm) fprintf(stderr, "%s", nm); else
 226           printPtr((P_)f);
 227        fprintf ( stderr, "\n");
 228 #endif
 229 #if STACK_DETAILS
 230        fprintf(stderr,"\n");
 231 #endif
 232     zzz:
 233        if (enters % 1000 == 0) fprintf(stderr, "%d enters\n",enters);
 234        enters++;
 235        f = (StgFunPtr) (f)();
 236        if (!f) break;
 237     }
 238     fprintf (stderr, "miniInterpreter: bye!\n\n" );
 239     return (StgThreadReturnCode)R1.i;
 240 }
 241
 242 EXTFUN(StgReturn)
 243 {
 244    return 0;
 245 }
 246 #endif
 247
 248
 249
 250 #else /* !USE_MINIINTERPRETER */
 251
 252 #ifdef LEADING_UNDERSCORE
 253 #define STG_RETURN "_StgReturn"
 254 #else
 255 #define STG_RETURN "StgReturn"
 256 #endif
 257
 258 /* -----------------------------------------------------------------------------
 259    x86 architecture
 260    -------------------------------------------------------------------------- */
 261
 262 #ifdef i386_TARGET_ARCH
 263
 264 StgThreadReturnCode
 265 StgRun(StgFunPtr f, StgRegTable *basereg) {
 266
 267     unsigned char space[ RESERVED_C_STACK_BYTES + 4*sizeof(void *) ];
 268     StgThreadReturnCode r;
 269
 270     __asm__ volatile (
 271         /*
 272          * save callee-saves registers on behalf of the STG code.
 273          */
 274         "movl %%esp, %%eax\n\t"
 275         "addl %4, %%eax\n\t"
 276         "movl %%ebx,0(%%eax)\n\t"
 277         "movl %%esi,4(%%eax)\n\t"
 278         "movl %%edi,8(%%eax)\n\t"
 279         "movl %%ebp,12(%%eax)\n\t"
 280         /*
 281          * Set BaseReg
 282          */
 283         "movl %3,%%ebx\n\t"
 284         /*
 285          * grab the function argument from the stack, and jump to it.
 286          */
 287         "movl %2,%%eax\n\t"
 288         "jmp *%%eax\n\t"
 289
 290         ".global " STG_RETURN "\n"
 291         STG_RETURN ":\n\t"
 292
 293         "movl %%esi, %%eax\n\t"   /* Return value in R1  */
 294
 295         /*
 296          * restore callee-saves registers.  (Don't stomp on %%eax!)
 297          */
 298         "movl %%esp, %%edx\n\t"
 299         "addl %4, %%edx\n\t"
 300         "movl 0(%%edx),%%ebx\n\t"       /* restore the registers saved above */
 301         "movl 4(%%edx),%%esi\n\t"
 302         "movl 8(%%edx),%%edi\n\t"
 303         "movl 12(%%edx),%%ebp\n\t"
 304
 305       : "=&a" (r), "=m" (space)
 306       : "m" (f), "m" (basereg), "i" (RESERVED_C_STACK_BYTES)
 307       : "edx" /* stomps on %edx */
 308     );
 309
 310     return r;
 311 }
 312
 313 #endif
 314
 315 /* -----------------------------------------------------------------------------
 316    Sparc architecture
 317
 318    --
 319    OLD COMMENT from GHC-3.02:
 320
 321    We want tailjumps to be calls, because `call xxx' is the only Sparc
 322    branch that allows an arbitrary label as a target.  (Gcc's ``goto
 323    *target'' construct ends up loading the label into a register and
 324    then jumping, at the cost of two extra instructions for the 32-bit
 325    load.)
 326
 327    When entering the threaded world, we stash our return address in a
 328    known location so that \tr{%i7} is available as an extra
 329    callee-saves register.  Of course, we have to restore this when
 330    coming out of the threaded world.
 331
 332    I hate this god-forsaken architecture.  Since the top of the
 333    reserved stack space is used for globals and the bottom is reserved
 334    for outgoing arguments, we have to stick our return address
 335    somewhere in the middle.  Currently, I'm allowing 100 extra
 336    outgoing arguments beyond the first 6.  --JSM
 337
 338    Updated info (GHC 4.06): we don't appear to use %i7 any more, so
 339    I'm not sure whether we still need to save it.  Incedentally, what
 340    does the last paragraph above mean when it says "the top of the
 341    stack is used for globals"?  What globals?  --SDM
 342
 343    Updated info (GHC 4.08.2): not saving %i7 any more (see below).
 344    -------------------------------------------------------------------------- */
 345
 346 #ifdef sparc_TARGET_ARCH
 347
 348 StgThreadReturnCode
 349 StgRun(StgFunPtr f, StgRegTable *basereg) {
 350
 351     unsigned char space[RESERVED_C_STACK_BYTES];
 352 #if 0
 353     register void *i7 __asm__("%i7");
 354     ((void **)(space))[100] = i7;
 355 #endif
 356     f();
 357     __asm__ volatile (
 358             ".align 4\n"
 359             ".global " STG_RETURN "\n"
 360             STG_RETURN ":"
 361             : : : "l0","l1","l2","l3","l4","l5","l6","l7");
 362     /* we tell the C compiler that l0-l7 are clobbered on return to
 363      * StgReturn, otherwise it tries to use these to save eg. the
 364      * address of space[100] across the call.  The correct thing
 365      * to do would be to save all the callee-saves regs, but we
 366      * can't be bothered to do that.
 367      *
 368      * The code that gcc generates for this little fragment is now
 369      * terrible.  We could do much better by coding it directly in
 370      * assembler.
 371      */
 372 #if 0
 373     /* updated 4.08.2: we don't save %i7 in the middle of the reserved
 374      * space any more, since gcc tries to save its address across the
 375      * call to f(), this gets clobbered in STG land and we end up
 376      * dereferencing a bogus pointer in StgReturn.
 377      */
 378     __asm__ volatile ("ld %1,%0"
 379                       : "=r" (i7) : "m" (((void **)(space))[100]));
 380 #endif
 381     return (StgThreadReturnCode)R1.i;
 382 }
 383
 384 #endif
 385
 386 /* -----------------------------------------------------------------------------
 387    alpha architecture
 388
 389    "The stack pointer (SP) must at all times denote an address that has octaword
 390     alignment. (This restriction has the side effect that the in-memory portion
 391     of the argument list, if any, will start on an octaword boundary.) Note that
 392     the stack grows toward lower addresses. During a procedure invocation, SP
 393     can never be set to a value that is higher than the value of SP at entry to
 394     that procedure invocation.
 395
 396    "The contents of the stack, located above the portion of the argument list
 397     (if any) that is passed in memory, belong to the calling procedure. Because
 398     they are part of the calling procedure, they should not be read or written
 399     by the called procedure, except as specified by indirect arguments or
 400     language-controlled up-level references.
 401
 402    "The SP value might be used by the hardware when raising exceptions and
 403     asynchronous interrupts. It must be assumed that the contents of the stack
 404     below the current SP value and within the stack for the current thread are
 405     continually and unpredictably modified, as specified in the _Alpha
 406     Architecture Reference Manual_, and as a result of asynchronous software
 407     actions."
 408
 409    -- Compaq Computer Corporation, Houston. Tru64 UNIX Calling Standard for
 410       Alpha Systems, 5.1 edition, August 2000, section 3.2.1.  http://www.
 411       tru64unix.compaq.com/docs/base_doc/DOCUMENTATION/V51_PDF/ARH9MBTE.PDF
 412    -------------------------------------------------------------------------- */
 413
 414 #ifdef alpha_TARGET_ARCH
 415
 416 StgThreadReturnCode
 417 StgRun(StgFunPtr f, StgRegTable *basereg)
 418 {
 419     register long   real_ra __asm__("$26"); volatile long   save_ra;
 420
 421     register long   real_s0 __asm__("$9" ); volatile long   save_s0;
 422     register long   real_s1 __asm__("$10"); volatile long   save_s1;
 423     register long   real_s2 __asm__("$11"); volatile long   save_s2;
 424     register long   real_s3 __asm__("$12"); volatile long   save_s3;
 425     register long   real_s4 __asm__("$13"); volatile long   save_s4;
 426     register long   real_s5 __asm__("$14"); volatile long   save_s5;
 427 #ifdef alpha_EXTRA_CAREFUL
 428     register long   real_s6 __asm__("$15"); volatile long   save_s6;
 429 #endif
 430
 431     register double real_f2 __asm__("$f2"); volatile double save_f2;
 432     register double real_f3 __asm__("$f3"); volatile double save_f3;
 433     register double real_f4 __asm__("$f4"); volatile double save_f4;
 434     register double real_f5 __asm__("$f5"); volatile double save_f5;
 435     register double real_f6 __asm__("$f6"); volatile double save_f6;
 436     register double real_f7 __asm__("$f7"); volatile double save_f7;
 437 #ifdef alpha_EXTRA_CAREFUL
 438     register double real_f8 __asm__("$f8"); volatile double save_f8;
 439     register double real_f9 __asm__("$f9"); volatile double save_f9;
 440 #endif
 441
 442     register StgFunPtr real_pv __asm__("$27");
 443
 444     StgThreadReturnCode ret;
 445
 446     save_ra = real_ra;
 447
 448     save_s0 = real_s0;
 449     save_s1 = real_s1;
 450     save_s2 = real_s2;
 451     save_s3 = real_s3;
 452     save_s4 = real_s4;
 453     save_s5 = real_s5;
 454 #ifdef alpha_EXTRA_CAREFUL
 455     save_s6 = real_s6;
 456 #endif
 457
 458     save_f2 = real_f2;
 459     save_f3 = real_f3;
 460     save_f4 = real_f4;
 461     save_f5 = real_f5;
 462     save_f6 = real_f6;
 463     save_f7 = real_f7;
 464 #ifdef alpha_EXTRA_CAREFUL
 465     save_f8 = real_f8;
 466     save_f9 = real_f9;
 467 #endif
 468
 469     real_pv = f;
 470
 471     __asm__ volatile(   "lda $30,-%0($30)"      "\n"
 472                 "\t"    "jmp ($27)"             "\n"
 473                 "\t"    ".align 3"              "\n"
 474                 ".globl " STG_RETURN            "\n"
 475                 STG_RETURN ":"                  "\n"
 476                 "\t"    "lda $30,%0($30)"       "\n"
 477                 : : "K" (RESERVED_C_STACK_BYTES));
 478
 479     ret = real_s5;
 480
 481     real_s0 = save_s0;
 482     real_s1 = save_s1;
 483     real_s2 = save_s2;
 484     real_s3 = save_s3;
 485     real_s4 = save_s4;
 486     real_s5 = save_s5;
 487 #ifdef alpha_EXTRA_CAREFUL
 488     real_s6 = save_s6;
 489 #endif
 490
 491     real_f2 = save_f2;
 492     real_f3 = save_f3;
 493     real_f4 = save_f4;
 494     real_f5 = save_f5;
 495     real_f6 = save_f6;
 496     real_f7 = save_f7;
 497 #ifdef alpha_EXTRA_CAREFUL
 498     real_f8 = save_f8;
 499     real_f9 = save_f9;
 500 #endif
 501
 502     real_ra = save_ra;
 503
 504     return ret;
 505 }
 506
 507 #endif /* alpha_TARGET_ARCH */
 508
 509 /* -----------------------------------------------------------------------------
 510    HP-PA architecture
 511    -------------------------------------------------------------------------- */
 512
 513 #ifdef hppa1_1_TARGET_ARCH
 514
 515 StgThreadReturnCode
 516 StgRun(StgFunPtr f, StgRegTable *basereg)
 517 {
 518     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
 519     StgThreadReturnCode ret;
 520
 521     __asm__ volatile ("ldo %0(%%r30),%%r19\n"
 522                       "\tstw %%r3, 0(0,%%r19)\n"
 523                       "\tstw %%r4, 4(0,%%r19)\n"
 524                       "\tstw %%r5, 8(0,%%r19)\n"
 525                       "\tstw %%r6,12(0,%%r19)\n"
 526                       "\tstw %%r7,16(0,%%r19)\n"
 527                       "\tstw %%r8,20(0,%%r19)\n"
 528                       "\tstw %%r9,24(0,%%r19)\n"
 529                       "\tstw %%r10,28(0,%%r19)\n"
 530                       "\tstw %%r11,32(0,%%r19)\n"
 531                       "\tstw %%r12,36(0,%%r19)\n"
 532                       "\tstw %%r13,40(0,%%r19)\n"
 533                       "\tstw %%r14,44(0,%%r19)\n"
 534                       "\tstw %%r15,48(0,%%r19)\n"
 535                       "\tstw %%r16,52(0,%%r19)\n"
 536                       "\tstw %%r17,56(0,%%r19)\n"
 537                       "\tstw %%r18,60(0,%%r19)\n"
 538                       "\tldo 80(%%r19),%%r19\n"
 539                       "\tfstds %%fr12,-16(0,%%r19)\n"
 540                       "\tfstds %%fr13, -8(0,%%r19)\n"
 541                       "\tfstds %%fr14,  0(0,%%r19)\n"
 542                       "\tfstds %%fr15,  8(0,%%r19)\n"
 543                       "\tldo 32(%%r19),%%r19\n"
 544                       "\tfstds %%fr16,-16(0,%%r19)\n"
 545                       "\tfstds %%fr17, -8(0,%%r19)\n"
 546                       "\tfstds %%fr18,  0(0,%%r19)\n"
 547                       "\tfstds %%fr19,  8(0,%%r19)\n"
 548                       "\tldo 32(%%r19),%%r19\n"
 549                       "\tfstds %%fr20,-16(0,%%r19)\n"
 550                       "\tfstds %%fr21, -8(0,%%r19)\n" : :
 551                       "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
 552                       );
 553
 554     f();
 555
 556     __asm__ volatile (".align 4\n"
 557                       "\t.EXPORT " STG_RETURN ",CODE\n"
 558                       "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
 559                       STG_RETURN "\n"
 560                       /* "\tldo %0(%%r3),%%r19\n" */
 561                       "\tldo %1(%%r30),%%r19\n"
 562                       "\tcopy %%r11, %0\n"  /* save R1 */
 563                       "\tldw  0(0,%%r19),%%r3\n"
 564                       "\tldw  4(0,%%r19),%%r4\n"
 565                       "\tldw  8(0,%%r19),%%r5\n"
 566                       "\tldw 12(0,%%r19),%%r6\n"
 567                       "\tldw 16(0,%%r19),%%r7\n"
 568                       "\tldw 20(0,%%r19),%%r8\n"
 569                       "\tldw 24(0,%%r19),%%r9\n"
 570                       "\tldw 28(0,%%r19),%%r10\n"
 571                       "\tldw 32(0,%%r19),%%r11\n"
 572                       "\tldw 36(0,%%r19),%%r12\n"
 573                       "\tldw 40(0,%%r19),%%r13\n"
 574                       "\tldw 44(0,%%r19),%%r14\n"
 575                       "\tldw 48(0,%%r19),%%r15\n"
 576                       "\tldw 52(0,%%r19),%%r16\n"
 577                       "\tldw 56(0,%%r19),%%r17\n"
 578                       "\tldw 60(0,%%r19),%%r18\n"
 579                       "\tldo 80(%%r19),%%r19\n"
 580                       "\tfldds -16(0,%%r19),%%fr12\n"
 581                       "\tfldds  -8(0,%%r19),%%fr13\n"
 582                       "\tfldds   0(0,%%r19),%%fr14\n"
 583                       "\tfldds   8(0,%%r19),%%fr15\n"
 584                       "\tldo 32(%%r19),%%r19\n"
 585                       "\tfldds -16(0,%%r19),%%fr16\n"
 586                       "\tfldds  -8(0,%%r19),%%fr17\n"
 587                       "\tfldds   0(0,%%r19),%%fr18\n"
 588                       "\tfldds   8(0,%%r19),%%fr19\n"
 589                       "\tldo 32(%%r19),%%r19\n"
 590                       "\tfldds -16(0,%%r19),%%fr20\n"
 591                       "\tfldds  -8(0,%%r19),%%fr21\n"
 592                          : "=r" (ret)
 593                          : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
 594                          : "%r19"
 595                       );
 596
 597     return ret;
 598 }
 599
 600 #endif /* hppa1_1_TARGET_ARCH */
 601
 602 #endif /* !USE_MINIINTERPRETER */