ghc/rts/StgCRun.c

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