rts/Interpreter.c

   1 /* -----------------------------------------------------------------------------
   2  * Bytecode interpreter
   3  *
   4  * Copyright (c) The GHC Team, 1994-2002.
   5  * ---------------------------------------------------------------------------*/
   6
   7 #include "PosixSource.h"
   8 #include "Rts.h"
   9 #include "RtsAPI.h"
  10 #include "RtsUtils.h"
  11 #include "Closures.h"
  12 #include "TSO.h"
  13 #include "Schedule.h"
  14 #include "RtsFlags.h"
  15 #include "LdvProfile.h"
  16 #include "Updates.h"
  17 #include "Sanity.h"
  18 #include "Liveness.h"
  19
  20 #include "Bytecodes.h"
  21 #include "Printer.h"
  22 #include "Disassembler.h"
  23 #include "Interpreter.h"
  24
  25 #include <string.h>     /* for memcpy */
  26 #ifdef HAVE_ERRNO_H
  27 #include <errno.h>
  28 #endif
  29
  30
  31 /* --------------------------------------------------------------------------
  32  * The bytecode interpreter
  33  * ------------------------------------------------------------------------*/
  34
  35 /* Gather stats about entry, opcode, opcode-pair frequencies.  For
  36    tuning the interpreter. */
  37
  38 /* #define INTERP_STATS */
  39
  40
  41 /* Sp points to the lowest live word on the stack. */
  42
  43 #define BCO_NEXT      instrs[bciPtr++]
  44 #define BCO_NEXT_32   (bciPtr += 2, (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1]))
  45 #define BCO_NEXT_64   (bciPtr += 4, (((StgWord) instrs[bciPtr-4]) << 48) + (((StgWord) instrs[bciPtr-3]) << 32) + (((StgWord) instrs[bciPtr-2]) << 16) + ((StgWord) instrs[bciPtr-1]))
  46 #if WORD_SIZE_IN_BITS == 32
  47 #define BCO_NEXT_WORD BCO_NEXT_32
  48 #elif WORD_SIZE_IN_BITS == 64
  49 #define BCO_NEXT_WORD BCO_NEXT_64
  50 #else
  51 #error Cannot cope with WORD_SIZE_IN_BITS being nether 32 nor 64
  52 #endif
  53 #define BCO_GET_LARGE_ARG ((bci & bci_FLAG_LARGE_ARGS) ? BCO_NEXT_WORD : BCO_NEXT)
  54
  55 #define BCO_PTR(n)    (W_)ptrs[n]
  56 #define BCO_LIT(n)    literals[n]
  57
  58 #define LOAD_STACK_POINTERS                                     \
  59     Sp = cap->r.rCurrentTSO->sp;                                \
  60     /* We don't change this ... */                              \
  61     SpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS;
  62
  63 #define SAVE_STACK_POINTERS                     \
  64     cap->r.rCurrentTSO->sp = Sp
  65
  66 #define RETURN_TO_SCHEDULER(todo,retcode)       \
  67    SAVE_STACK_POINTERS;                         \
  68    cap->r.rCurrentTSO->what_next = (todo);      \
  69    threadPaused(cap,cap->r.rCurrentTSO);                \
  70    cap->r.rRet = (retcode);                     \
  71    return cap;
  72
  73 #define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)      \
  74    SAVE_STACK_POINTERS;                                 \
  75    cap->r.rCurrentTSO->what_next = (todo);              \
  76    cap->r.rRet = (retcode);                             \
  77    return cap;
  78
  79
  80 STATIC_INLINE StgPtr
  81 allocate_NONUPD (int n_words)
  82 {
  83     return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
  84 }
  85
  86 rtsBool stop_next_breakpoint = rtsFalse;
  87
  88 #ifdef INTERP_STATS
  89
  90 /* Hacky stats, for tuning the interpreter ... */
  91 int it_unknown_entries[N_CLOSURE_TYPES];
  92 int it_total_unknown_entries;
  93 int it_total_entries;
  94
  95 int it_retto_BCO;
  96 int it_retto_UPDATE;
  97 int it_retto_other;
  98
  99 int it_slides;
 100 int it_insns;
 101 int it_BCO_entries;
 102
 103 int it_ofreq[27];
 104 int it_oofreq[27][27];
 105 int it_lastopc;
 106
 107
 108 #define INTERP_TICK(n) (n)++
 109
 110 void interp_startup ( void )
 111 {
 112    int i, j;
 113    it_retto_BCO = it_retto_UPDATE = it_retto_other = 0;
 114    it_total_entries = it_total_unknown_entries = 0;
 115    for (i = 0; i < N_CLOSURE_TYPES; i++)
 116       it_unknown_entries[i] = 0;
 117    it_slides = it_insns = it_BCO_entries = 0;
 118    for (i = 0; i < 27; i++) it_ofreq[i] = 0;
 119    for (i = 0; i < 27; i++)
 120      for (j = 0; j < 27; j++)
 121         it_oofreq[i][j] = 0;
 122    it_lastopc = 0;
 123 }
 124
 125 void interp_shutdown ( void )
 126 {
 127    int i, j, k, o_max, i_max, j_max;
 128    debugBelch("%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
 129                    it_retto_BCO + it_retto_UPDATE + it_retto_other,
 130                    it_retto_BCO, it_retto_UPDATE, it_retto_other );
 131    debugBelch("%d total entries, %d unknown entries \n",
 132                    it_total_entries, it_total_unknown_entries);
 133    for (i = 0; i < N_CLOSURE_TYPES; i++) {
 134      if (it_unknown_entries[i] == 0) continue;
 135      debugBelch("   type %2d: unknown entries (%4.1f%%) == %d\n",
 136              i, 100.0 * ((double)it_unknown_entries[i]) /
 137                         ((double)it_total_unknown_entries),
 138              it_unknown_entries[i]);
 139    }
 140    debugBelch("%d insns, %d slides, %d BCO_entries\n",
 141                    it_insns, it_slides, it_BCO_entries);
 142    for (i = 0; i < 27; i++)
 143       debugBelch("opcode %2d got %d\n", i, it_ofreq[i] );
 144
 145    for (k = 1; k < 20; k++) {
 146       o_max = 0;
 147       i_max = j_max = 0;
 148       for (i = 0; i < 27; i++) {
 149          for (j = 0; j < 27; j++) {
 150             if (it_oofreq[i][j] > o_max) {
 151                o_max = it_oofreq[i][j];
 152                i_max = i; j_max = j;
 153             }
 154          }
 155       }
 156
 157       debugBelch("%d:  count (%4.1f%%) %6d   is %d then %d\n",
 158                 k, ((double)o_max) * 100.0 / ((double)it_insns), o_max,
 159                    i_max, j_max );
 160       it_oofreq[i_max][j_max] = 0;
 161
 162    }
 163 }
 164
 165 #else // !INTERP_STATS
 166
 167 #define INTERP_TICK(n) /* nothing */
 168
 169 #endif
 170
 171 static StgWord app_ptrs_itbl[] = {
 172     (W_)&stg_ap_p_info,
 173     (W_)&stg_ap_pp_info,
 174     (W_)&stg_ap_ppp_info,
 175     (W_)&stg_ap_pppp_info,
 176     (W_)&stg_ap_ppppp_info,
 177     (W_)&stg_ap_pppppp_info,
 178 };
 179
 180 HsStablePtr breakPointIOAction; // points to the IO action which is executed on a breakpoint
 181                                 // it is set in main/GHC.hs:runStmt
 182
 183 Capability *
 184 interpretBCO (Capability* cap)
 185 {
 186     // Use of register here is primarily to make it clear to compilers
 187     // that these entities are non-aliasable.
 188     register StgPtr       Sp;    // local state -- stack pointer
 189     register StgPtr       SpLim; // local state -- stack lim pointer
 190     register StgClosure*  obj;
 191     nat n, m;
 192
 193     LOAD_STACK_POINTERS;
 194
 195     // ------------------------------------------------------------------------
 196     // Case 1:
 197     //
 198     //       We have a closure to evaluate.  Stack looks like:
 199     //
 200     //          |   XXXX_info   |
 201     //          +---------------+
 202     //       Sp |      -------------------> closure
 203     //          +---------------+
 204     //
 205     if (Sp[0] == (W_)&stg_enter_info) {
 206        Sp++;
 207        goto eval;
 208     }
 209
 210     // ------------------------------------------------------------------------
 211     // Case 2:
 212     //
 213     //       We have a BCO application to perform.  Stack looks like:
 214     //
 215     //          |     ....      |
 216     //          +---------------+
 217     //          |     arg1      |
 218     //          +---------------+
 219     //          |     BCO       |
 220     //          +---------------+
 221     //       Sp |   RET_BCO     |
 222     //          +---------------+
 223     //
 224     else if (Sp[0] == (W_)&stg_apply_interp_info) {
 225         obj = (StgClosure *)Sp[1];
 226         Sp += 2;
 227         goto run_BCO_fun;
 228     }
 229
 230     // ------------------------------------------------------------------------
 231     // Case 3:
 232     //
 233     //       We have an unboxed value to return.  See comment before
 234     //       do_return_unboxed, below.
 235     //
 236     else {
 237         goto do_return_unboxed;
 238     }
 239
 240     // Evaluate the object on top of the stack.
 241 eval:
 242     obj = (StgClosure*)Sp[0]; Sp++;
 243
 244 eval_obj:
 245     INTERP_TICK(it_total_evals);
 246
 247     IF_DEBUG(interpreter,
 248              debugBelch(
 249              "\n---------------------------------------------------------------\n");
 250              debugBelch("Evaluating: "); printObj(obj);
 251              debugBelch("Sp = %p\n", Sp);
 252              debugBelch("\n" );
 253
 254              printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
 255              debugBelch("\n\n");
 256             );
 257
 258     IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
 259
 260     switch ( get_itbl(obj)->type ) {
 261
 262     case IND:
 263     case IND_OLDGEN:
 264     case IND_PERM:
 265     case IND_OLDGEN_PERM:
 266     case IND_STATIC:
 267     {
 268         obj = ((StgInd*)obj)->indirectee;
 269         goto eval_obj;
 270     }
 271
 272     case CONSTR:
 273     case CONSTR_1_0:
 274     case CONSTR_0_1:
 275     case CONSTR_2_0:
 276     case CONSTR_1_1:
 277     case CONSTR_0_2:
 278     case CONSTR_STATIC:
 279     case CONSTR_NOCAF_STATIC:
 280     case FUN:
 281     case FUN_1_0:
 282     case FUN_0_1:
 283     case FUN_2_0:
 284     case FUN_1_1:
 285     case FUN_0_2:
 286     case FUN_STATIC:
 287     case PAP:
 288         // already in WHNF
 289         break;
 290
 291     case BCO:
 292     {
 293         ASSERT(((StgBCO *)obj)->arity > 0);
 294         break;
 295     }
 296
 297     case AP:    /* Copied from stg_AP_entry. */
 298     {
 299         nat i, words;
 300         StgAP *ap;
 301
 302         ap = (StgAP*)obj;
 303         words = ap->n_args;
 304
 305         // Stack check
 306         if (Sp - (words+sizeofW(StgUpdateFrame)) < SpLim) {
 307             Sp -= 2;
 308             Sp[1] = (W_)obj;
 309             Sp[0] = (W_)&stg_enter_info;
 310             RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
 311         }
 312
 313         /* Ok; we're safe.  Party on.  Push an update frame. */
 314         Sp -= sizeofW(StgUpdateFrame);
 315         {
 316             StgUpdateFrame *__frame;
 317             __frame = (StgUpdateFrame *)Sp;
 318             SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info);
 319             __frame->updatee = (StgClosure *)(ap);
 320         }
 321
 322         /* Reload the stack */
 323         Sp -= words;
 324         for (i=0; i < words; i++) {
 325             Sp[i] = (W_)ap->payload[i];
 326         }
 327
 328         obj = (StgClosure*)ap->fun;
 329         ASSERT(get_itbl(obj)->type == BCO);
 330         goto run_BCO_fun;
 331     }
 332
 333     default:
 334 #ifdef INTERP_STATS
 335     {
 336         int j;
 337
 338         j = get_itbl(obj)->type;
 339         ASSERT(j >= 0 && j < N_CLOSURE_TYPES);
 340         it_unknown_entries[j]++;
 341         it_total_unknown_entries++;
 342     }
 343 #endif
 344     {
 345         // Can't handle this object; yield to scheduler
 346         IF_DEBUG(interpreter,
 347                  debugBelch("evaluating unknown closure -- yielding to sched\n");
 348                  printObj(obj);
 349             );
 350         Sp -= 2;
 351         Sp[1] = (W_)obj;
 352         Sp[0] = (W_)&stg_enter_info;
 353         RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
 354     }
 355     }
 356
 357     // ------------------------------------------------------------------------
 358     // We now have an evaluated object (obj).  The next thing to
 359     // do is return it to the stack frame on top of the stack.
 360 do_return:
 361     ASSERT(closure_HNF(obj));
 362
 363     IF_DEBUG(interpreter,
 364              debugBelch(
 365              "\n---------------------------------------------------------------\n");
 366              debugBelch("Returning: "); printObj(obj);
 367              debugBelch("Sp = %p\n", Sp);
 368              debugBelch("\n" );
 369              printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
 370              debugBelch("\n\n");
 371             );
 372
 373     IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
 374
 375     switch (get_itbl((StgClosure *)Sp)->type) {
 376
 377     case RET_SMALL: {
 378         const StgInfoTable *info;
 379
 380         // NOTE: not using get_itbl().
 381         info = ((StgClosure *)Sp)->header.info;
 382         if (info == (StgInfoTable *)&stg_ap_v_info) {
 383             n = 1; m = 0; goto do_apply;
 384         }
 385         if (info == (StgInfoTable *)&stg_ap_f_info) {
 386             n = 1; m = 1; goto do_apply;
 387         }
 388         if (info == (StgInfoTable *)&stg_ap_d_info) {
 389             n = 1; m = sizeofW(StgDouble); goto do_apply;
 390         }
 391         if (info == (StgInfoTable *)&stg_ap_l_info) {
 392             n = 1; m = sizeofW(StgInt64); goto do_apply;
 393         }
 394         if (info == (StgInfoTable *)&stg_ap_n_info) {
 395             n = 1; m = 1; goto do_apply;
 396         }
 397         if (info == (StgInfoTable *)&stg_ap_p_info) {
 398             n = 1; m = 1; goto do_apply;
 399         }
 400         if (info == (StgInfoTable *)&stg_ap_pp_info) {
 401             n = 2; m = 2; goto do_apply;
 402         }
 403         if (info == (StgInfoTable *)&stg_ap_ppp_info) {
 404             n = 3; m = 3; goto do_apply;
 405         }
 406         if (info == (StgInfoTable *)&stg_ap_pppp_info) {
 407             n = 4; m = 4; goto do_apply;
 408         }
 409         if (info == (StgInfoTable *)&stg_ap_ppppp_info) {
 410             n = 5; m = 5; goto do_apply;
 411         }
 412         if (info == (StgInfoTable *)&stg_ap_pppppp_info) {
 413             n = 6; m = 6; goto do_apply;
 414         }
 415         goto do_return_unrecognised;
 416     }
 417
 418     case UPDATE_FRAME:
 419         // Returning to an update frame: do the update, pop the update
 420         // frame, and continue with the next stack frame.
 421         INTERP_TICK(it_retto_UPDATE);
 422         UPD_IND(((StgUpdateFrame *)Sp)->updatee, obj);
 423         Sp += sizeofW(StgUpdateFrame);
 424         goto do_return;
 425
 426     case RET_BCO:
 427         // Returning to an interpreted continuation: put the object on
 428         // the stack, and start executing the BCO.
 429         INTERP_TICK(it_retto_BCO);
 430         Sp--;
 431         Sp[0] = (W_)obj;
 432         obj = (StgClosure*)Sp[2];
 433         ASSERT(get_itbl(obj)->type == BCO);
 434         goto run_BCO_return;
 435
 436     default:
 437     do_return_unrecognised:
 438     {
 439         // Can't handle this return address; yield to scheduler
 440         INTERP_TICK(it_retto_other);
 441         IF_DEBUG(interpreter,
 442                  debugBelch("returning to unknown frame -- yielding to sched\n");
 443                  printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
 444             );
 445         Sp -= 2;
 446         Sp[1] = (W_)obj;
 447         Sp[0] = (W_)&stg_enter_info;
 448         RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
 449     }
 450     }
 451
 452     // -------------------------------------------------------------------------
 453     // Returning an unboxed value.  The stack looks like this:
 454     //
 455     //    |     ....      |
 456     //    +---------------+
 457     //    |     fv2       |
 458     //    +---------------+
 459     //    |     fv1       |
 460     //    +---------------+
 461     //    |     BCO       |
 462     //    +---------------+
 463     //    | stg_ctoi_ret_ |
 464     //    +---------------+
 465     //    |    retval     |
 466     //    +---------------+
 467     //    |   XXXX_info   |
 468     //    +---------------+
 469     //
 470     // where XXXX_info is one of the stg_gc_unbx_r1_info family.
 471     //
 472     // We're only interested in the case when the real return address
 473     // is a BCO; otherwise we'll return to the scheduler.
 474
 475 do_return_unboxed:
 476     {
 477         int offset;
 478
 479         ASSERT( Sp[0] == (W_)&stg_gc_unbx_r1_info
 480                 || Sp[0] == (W_)&stg_gc_unpt_r1_info
 481                 || Sp[0] == (W_)&stg_gc_f1_info
 482                 || Sp[0] == (W_)&stg_gc_d1_info
 483                 || Sp[0] == (W_)&stg_gc_l1_info
 484                 || Sp[0] == (W_)&stg_gc_void_info // VoidRep
 485             );
 486
 487         // get the offset of the stg_ctoi_ret_XXX itbl
 488         offset = stack_frame_sizeW((StgClosure *)Sp);
 489
 490         switch (get_itbl((StgClosure *)Sp+offset)->type) {
 491
 492         case RET_BCO:
 493             // Returning to an interpreted continuation: put the object on
 494             // the stack, and start executing the BCO.
 495             INTERP_TICK(it_retto_BCO);
 496             obj = (StgClosure*)Sp[offset+1];
 497             ASSERT(get_itbl(obj)->type == BCO);
 498             goto run_BCO_return_unboxed;
 499
 500         default:
 501         {
 502             // Can't handle this return address; yield to scheduler
 503             INTERP_TICK(it_retto_other);
 504             IF_DEBUG(interpreter,
 505                      debugBelch("returning to unknown frame -- yielding to sched\n");
 506                      printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
 507                 );
 508             RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
 509         }
 510         }
 511     }
 512     // not reached.
 513
 514
 515     // -------------------------------------------------------------------------
 516     // Application...
 517
 518 do_apply:
 519     // we have a function to apply (obj), and n arguments taking up m
 520     // words on the stack.  The info table (stg_ap_pp_info or whatever)
 521     // is on top of the arguments on the stack.
 522     {
 523         switch (get_itbl(obj)->type) {
 524
 525         case PAP: {
 526             StgPAP *pap;
 527             nat i, arity;
 528
 529             pap = (StgPAP *)obj;
 530
 531             // we only cope with PAPs whose function is a BCO
 532             if (get_itbl(pap->fun)->type != BCO) {
 533                 goto defer_apply_to_sched;
 534             }
 535
 536             Sp++;
 537             arity = pap->arity;
 538             ASSERT(arity > 0);
 539             if (arity < n) {
 540                 // n must be greater than 1, and the only kinds of
 541                 // application we support with more than one argument
 542                 // are all pointers...
 543                 //
 544                 // Shuffle the args for this function down, and put
 545                 // the appropriate info table in the gap.
 546                 for (i = 0; i < arity; i++) {
 547                     Sp[(int)i-1] = Sp[i];
 548                     // ^^^^^ careful, i-1 might be negative, but i in unsigned
 549                 }
 550                 Sp[arity-1] = app_ptrs_itbl[n-arity-1];
 551                 Sp--;
 552                 // unpack the PAP's arguments onto the stack
 553                 Sp -= pap->n_args;
 554                 for (i = 0; i < pap->n_args; i++) {
 555                     Sp[i] = (W_)pap->payload[i];
 556                 }
 557                 obj = pap->fun;
 558                 goto run_BCO_fun;
 559             }
 560             else if (arity == n) {
 561                 Sp -= pap->n_args;
 562                 for (i = 0; i < pap->n_args; i++) {
 563                     Sp[i] = (W_)pap->payload[i];
 564                 }
 565                 obj = pap->fun;
 566                 goto run_BCO_fun;
 567             }
 568             else /* arity > n */ {
 569                 // build a new PAP and return it.
 570                 StgPAP *new_pap;
 571                 new_pap = (StgPAP *)allocate(PAP_sizeW(pap->n_args + m));
 572                 SET_HDR(new_pap,&stg_PAP_info,CCCS);
 573                 new_pap->arity = pap->arity - n;
 574                 new_pap->n_args = pap->n_args + m;
 575                 new_pap->fun = pap->fun;
 576                 for (i = 0; i < pap->n_args; i++) {
 577                     new_pap->payload[i] = pap->payload[i];
 578                 }
 579                 for (i = 0; i < m; i++) {
 580                     new_pap->payload[pap->n_args + i] = (StgClosure *)Sp[i];
 581                 }
 582                 obj = (StgClosure *)new_pap;
 583                 Sp += m;
 584                 goto do_return;
 585             }
 586         }
 587
 588         case BCO: {
 589             nat arity, i;
 590
 591             Sp++;
 592             arity = ((StgBCO *)obj)->arity;
 593             ASSERT(arity > 0);
 594             if (arity < n) {
 595                 // n must be greater than 1, and the only kinds of
 596                 // application we support with more than one argument
 597                 // are all pointers...
 598                 //
 599                 // Shuffle the args for this function down, and put
 600                 // the appropriate info table in the gap.
 601                 for (i = 0; i < arity; i++) {
 602                     Sp[(int)i-1] = Sp[i];
 603                     // ^^^^^ careful, i-1 might be negative, but i in unsigned
 604                 }
 605                 Sp[arity-1] = app_ptrs_itbl[n-arity-1];
 606                 Sp--;
 607                 goto run_BCO_fun;
 608             }
 609             else if (arity == n) {
 610                 goto run_BCO_fun;
 611             }
 612             else /* arity > n */ {
 613                 // build a PAP and return it.
 614                 StgPAP *pap;
 615                 nat i;
 616                 pap = (StgPAP *)allocate(PAP_sizeW(m));
 617                 SET_HDR(pap, &stg_PAP_info,CCCS);
 618                 pap->arity = arity - n;
 619                 pap->fun = obj;
 620                 pap->n_args = m;
 621                 for (i = 0; i < m; i++) {
 622                     pap->payload[i] = (StgClosure *)Sp[i];
 623                 }
 624                 obj = (StgClosure *)pap;
 625                 Sp += m;
 626                 goto do_return;
 627             }
 628         }
 629
 630         // No point in us applying machine-code functions
 631         default:
 632         defer_apply_to_sched:
 633             Sp -= 2;
 634             Sp[1] = (W_)obj;
 635             Sp[0] = (W_)&stg_enter_info;
 636             RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
 637     }
 638
 639     // ------------------------------------------------------------------------
 640     // Ok, we now have a bco (obj), and its arguments are all on the
 641     // stack.  We can start executing the byte codes.
 642     //
 643     // The stack is in one of two states.  First, if this BCO is a
 644     // function:
 645     //
 646     //    |     ....      |
 647     //    +---------------+
 648     //    |     arg2      |
 649     //    +---------------+
 650     //    |     arg1      |
 651     //    +---------------+
 652     //
 653     // Second, if this BCO is a continuation:
 654     //
 655     //    |     ....      |
 656     //    +---------------+
 657     //    |     fv2       |
 658     //    +---------------+
 659     //    |     fv1       |
 660     //    +---------------+
 661     //    |     BCO       |
 662     //    +---------------+
 663     //    | stg_ctoi_ret_ |
 664     //    +---------------+
 665     //    |    retval     |
 666     //    +---------------+
 667     //
 668     // where retval is the value being returned to this continuation.
 669     // In the event of a stack check, heap check, or context switch,
 670     // we need to leave the stack in a sane state so the garbage
 671     // collector can find all the pointers.
 672     //
 673     //  (1) BCO is a function:  the BCO's bitmap describes the
 674     //      pointerhood of the arguments.
 675     //
 676     //  (2) BCO is a continuation: BCO's bitmap describes the
 677     //      pointerhood of the free variables.
 678     //
 679     // Sadly we have three different kinds of stack/heap/cswitch check
 680     // to do:
 681
 682
 683 run_BCO_return:
 684     // Heap check
 685     if (doYouWantToGC()) {
 686         Sp--; Sp[0] = (W_)&stg_enter_info;
 687         RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 688     }
 689     // Stack checks aren't necessary at return points, the stack use
 690     // is aggregated into the enclosing function entry point.
 691
 692     goto run_BCO;
 693
 694 run_BCO_return_unboxed:
 695     // Heap check
 696     if (doYouWantToGC()) {
 697         RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 698     }
 699     // Stack checks aren't necessary at return points, the stack use
 700     // is aggregated into the enclosing function entry point.
 701
 702     goto run_BCO;
 703
 704 run_BCO_fun:
 705     IF_DEBUG(sanity,
 706              Sp -= 2;
 707              Sp[1] = (W_)obj;
 708              Sp[0] = (W_)&stg_apply_interp_info;
 709              checkStackChunk(Sp,SpLim);
 710              Sp += 2;
 711         );
 712
 713     // Heap check
 714     if (doYouWantToGC()) {
 715         Sp -= 2;
 716         Sp[1] = (W_)obj;
 717         Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
 718         RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
 719     }
 720
 721     // Stack check
 722     if (Sp - INTERP_STACK_CHECK_THRESH < SpLim) {
 723         Sp -= 2;
 724         Sp[1] = (W_)obj;
 725         Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
 726         RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
 727     }
 728
 729     goto run_BCO;
 730
 731     // Now, actually interpret the BCO... (no returning to the
 732     // scheduler again until the stack is in an orderly state).
 733 run_BCO:
 734     INTERP_TICK(it_BCO_entries);
 735     {
 736         register int       bciPtr     = 1; /* instruction pointer */
 737         register StgWord16 bci;
 738         register StgBCO*   bco        = (StgBCO*)obj;
 739         register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
 740         register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
 741         register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
 742
 743 #ifdef INTERP_STATS
 744         it_lastopc = 0; /* no opcode */
 745 #endif
 746
 747     nextInsn:
 748         ASSERT(bciPtr <= instrs[0]);
 749         IF_DEBUG(interpreter,
 750                  //if (do_print_stack) {
 751                  //debugBelch("\n-- BEGIN stack\n");
 752                  //printStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
 753                  //debugBelch("-- END stack\n\n");
 754                  //}
 755                  debugBelch("Sp = %p   pc = %d      ", Sp, bciPtr);
 756                  disInstr(bco,bciPtr);
 757                  if (0) { int i;
 758                  debugBelch("\n");
 759                  for (i = 8; i >= 0; i--) {
 760                      debugBelch("%d  %p\n", i, (StgPtr)(*(Sp+i)));
 761                  }
 762                  debugBelch("\n");
 763                  }
 764                  //if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
 765             );
 766
 767
 768         INTERP_TICK(it_insns);
 769
 770 #ifdef INTERP_STATS
 771         ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 27 );
 772         it_ofreq[ (int)instrs[bciPtr] ] ++;
 773         it_oofreq[ it_lastopc ][ (int)instrs[bciPtr] ] ++;
 774         it_lastopc = (int)instrs[bciPtr];
 775 #endif
 776
 777         bci = BCO_NEXT;
 778     /* We use the high 8 bits for flags, only the highest of which is
 779      * currently allocated */
 780     ASSERT((bci & 0xFF00) == (bci & 0x8000));
 781
 782     switch (bci & 0xFF) {
 783
 784         /* check for a breakpoint on the beginning of a let binding */
 785         case bci_BRK_FUN:
 786         {
 787             int arg1_brk_array, arg2_array_index, arg3_freeVars;
 788             StgArrWords *breakPoints;
 789             int returning_from_break;     // are we resuming execution from a breakpoint?
 790                                           //  if yes, then don't break this time around
 791             StgClosure *ioAction;         // the io action to run at a breakpoint
 792
 793             StgAP_STACK *new_aps;         // a closure to save the top stack frame on the heap
 794             int i;
 795             int size_words;
 796
 797             arg1_brk_array      = BCO_NEXT;  // 1st arg of break instruction
 798             arg2_array_index    = BCO_NEXT;  // 2nd arg of break instruction
 799             arg3_freeVars       = BCO_NEXT;  // 3rd arg of break instruction
 800
 801             // check if we are returning from a breakpoint - this info
 802             // is stored in the flags field of the current TSO
 803             returning_from_break = cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
 804
 805             // if we are returning from a break then skip this section
 806             // and continue executing
 807             if (!returning_from_break)
 808             {
 809                breakPoints = (StgArrWords *) BCO_PTR(arg1_brk_array);
 810
 811                // stop the current thread if either the
 812                // "stop_next_breakpoint" flag is true OR if the
 813                // breakpoint flag for this particular expression is
 814                // true
 815                if (stop_next_breakpoint == rtsTrue ||
 816                    breakPoints->payload[arg2_array_index] == rtsTrue)
 817                {
 818                   // make sure we don't automatically stop at the
 819                   // next breakpoint
 820                   stop_next_breakpoint = rtsFalse;
 821
 822                   // allocate memory for a new AP_STACK, enough to
 823                   // store the top stack frame plus an
 824                   // stg_apply_interp_info pointer and a pointer to
 825                   // the BCO
 826                   size_words = BCO_BITMAP_SIZE(obj) + 2;
 827                   new_aps = (StgAP_STACK *) allocate (AP_STACK_sizeW(size_words));
 828                   SET_HDR(new_aps,&stg_AP_STACK_info,CCS_SYSTEM);
 829                   new_aps->size = size_words;
 830                   new_aps->fun = &stg_dummy_ret_closure;
 831
 832                   // fill in the payload of the AP_STACK
 833                   new_aps->payload[0] = (StgClosure *)&stg_apply_interp_info;
 834                   new_aps->payload[1] = (StgClosure *)obj;
 835
 836                   // copy the contents of the top stack frame into the AP_STACK
 837                   for (i = 2; i < size_words; i++)
 838                   {
 839                      new_aps->payload[i] = (StgClosure *)Sp[i-2];
 840                   }
 841
 842                   // prepare the stack so that we can call the
 843                   // breakPointIOAction and ensure that the stack is
 844                   // in a reasonable state for the GC and so that
 845                   // execution of this BCO can continue when we resume
 846                   ioAction = (StgClosure *) deRefStablePtr (breakPointIOAction);
 847                   Sp -= 7;
 848                   Sp[6] = (W_)obj;
 849                   Sp[5] = (W_)&stg_apply_interp_info;
 850                   Sp[4] = (W_)new_aps;                 // the AP_STACK
 851                   Sp[3] = (W_)BCO_PTR(arg3_freeVars);  // the info about local vars of the breakpoint
 852                   Sp[2] = (W_)&stg_ap_ppv_info;
 853                   Sp[1] = (W_)ioAction;                // apply the IO action to its two arguments above
 854                   Sp[0] = (W_)&stg_enter_info;         // get ready to run the IO action
 855
 856                   // set the flag in the TSO to say that we are now
 857                   // stopping at a breakpoint so that when we resume
 858                   // we don't stop on the same breakpoint that we
 859                   // already stopped at just now
 860                   cap->r.rCurrentTSO->flags |= TSO_STOPPED_ON_BREAKPOINT;
 861
 862                   // stop this thread and return to the scheduler -
 863                   // eventually we will come back and the IO action on
 864                   // the top of the stack will be executed
 865                   RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
 866                }
 867             }
 868             // record that this thread is not stopped at a breakpoint anymore
 869             cap->r.rCurrentTSO->flags &= ~TSO_STOPPED_ON_BREAKPOINT;
 870
 871             // continue normal execution of the byte code instructions
 872             goto nextInsn;
 873         }
 874
 875         case bci_STKCHECK: {
 876             // Explicit stack check at the beginning of a function
 877             // *only* (stack checks in case alternatives are
 878             // propagated to the enclosing function).
 879             StgWord stk_words_reqd = BCO_GET_LARGE_ARG + 1;
 880             if (Sp - stk_words_reqd < SpLim) {
 881                 Sp -= 2;
 882                 Sp[1] = (W_)obj;
 883                 Sp[0] = (W_)&stg_apply_interp_info;
 884                 RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
 885             } else {
 886                 goto nextInsn;
 887             }
 888         }
 889
 890         case bci_PUSH_L: {
 891             int o1 = BCO_NEXT;
 892             Sp[-1] = Sp[o1];
 893             Sp--;
 894             goto nextInsn;
 895         }
 896
 897         case bci_PUSH_LL: {
 898             int o1 = BCO_NEXT;
 899             int o2 = BCO_NEXT;
 900             Sp[-1] = Sp[o1];
 901             Sp[-2] = Sp[o2];
 902             Sp -= 2;
 903             goto nextInsn;
 904         }
 905
 906         case bci_PUSH_LLL: {
 907             int o1 = BCO_NEXT;
 908             int o2 = BCO_NEXT;
 909             int o3 = BCO_NEXT;
 910             Sp[-1] = Sp[o1];
 911             Sp[-2] = Sp[o2];
 912             Sp[-3] = Sp[o3];
 913             Sp -= 3;
 914             goto nextInsn;
 915         }
 916
 917         case bci_PUSH_G: {
 918             int o1 = BCO_NEXT;
 919             Sp[-1] = BCO_PTR(o1);
 920             Sp -= 1;
 921             goto nextInsn;
 922         }
 923
 924         case bci_PUSH_ALTS: {
 925             int o_bco  = BCO_NEXT;
 926             Sp[-2] = (W_)&stg_ctoi_R1p_info;
 927             Sp[-1] = BCO_PTR(o_bco);
 928             Sp -= 2;
 929             goto nextInsn;
 930         }
 931
 932         case bci_PUSH_ALTS_P: {
 933             int o_bco  = BCO_NEXT;
 934             Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
 935             Sp[-1] = BCO_PTR(o_bco);
 936             Sp -= 2;
 937             goto nextInsn;
 938         }
 939
 940         case bci_PUSH_ALTS_N: {
 941             int o_bco  = BCO_NEXT;
 942             Sp[-2] = (W_)&stg_ctoi_R1n_info;
 943             Sp[-1] = BCO_PTR(o_bco);
 944             Sp -= 2;
 945             goto nextInsn;
 946         }
 947
 948         case bci_PUSH_ALTS_F: {
 949             int o_bco  = BCO_NEXT;
 950             Sp[-2] = (W_)&stg_ctoi_F1_info;
 951             Sp[-1] = BCO_PTR(o_bco);
 952             Sp -= 2;
 953             goto nextInsn;
 954         }
 955
 956         case bci_PUSH_ALTS_D: {
 957             int o_bco  = BCO_NEXT;
 958             Sp[-2] = (W_)&stg_ctoi_D1_info;
 959             Sp[-1] = BCO_PTR(o_bco);
 960             Sp -= 2;
 961             goto nextInsn;
 962         }
 963
 964         case bci_PUSH_ALTS_L: {
 965             int o_bco  = BCO_NEXT;
 966             Sp[-2] = (W_)&stg_ctoi_L1_info;
 967             Sp[-1] = BCO_PTR(o_bco);
 968             Sp -= 2;
 969             goto nextInsn;
 970         }
 971
 972         case bci_PUSH_ALTS_V: {
 973             int o_bco  = BCO_NEXT;
 974             Sp[-2] = (W_)&stg_ctoi_V_info;
 975             Sp[-1] = BCO_PTR(o_bco);
 976             Sp -= 2;
 977             goto nextInsn;
 978         }
 979
 980         case bci_PUSH_APPLY_N:
 981             Sp--; Sp[0] = (W_)&stg_ap_n_info;
 982             goto nextInsn;
 983         case bci_PUSH_APPLY_V:
 984             Sp--; Sp[0] = (W_)&stg_ap_v_info;
 985             goto nextInsn;
 986         case bci_PUSH_APPLY_F:
 987             Sp--; Sp[0] = (W_)&stg_ap_f_info;
 988             goto nextInsn;
 989         case bci_PUSH_APPLY_D:
 990             Sp--; Sp[0] = (W_)&stg_ap_d_info;
 991             goto nextInsn;
 992         case bci_PUSH_APPLY_L:
 993             Sp--; Sp[0] = (W_)&stg_ap_l_info;
 994             goto nextInsn;
 995         case bci_PUSH_APPLY_P:
 996             Sp--; Sp[0] = (W_)&stg_ap_p_info;
 997             goto nextInsn;
 998         case bci_PUSH_APPLY_PP:
 999             Sp--; Sp[0] = (W_)&stg_ap_pp_info;
1000             goto nextInsn;
1001         case bci_PUSH_APPLY_PPP:
1002             Sp--; Sp[0] = (W_)&stg_ap_ppp_info;
1003             goto nextInsn;
1004         case bci_PUSH_APPLY_PPPP:
1005             Sp--; Sp[0] = (W_)&stg_ap_pppp_info;
1006             goto nextInsn;
1007         case bci_PUSH_APPLY_PPPPP:
1008             Sp--; Sp[0] = (W_)&stg_ap_ppppp_info;
1009             goto nextInsn;
1010         case bci_PUSH_APPLY_PPPPPP:
1011             Sp--; Sp[0] = (W_)&stg_ap_pppppp_info;
1012             goto nextInsn;
1013
1014         case bci_PUSH_UBX: {
1015             int i;
1016             int o_lits = BCO_NEXT;
1017             int n_words = BCO_NEXT;
1018             Sp -= n_words;
1019             for (i = 0; i < n_words; i++) {
1020                 Sp[i] = (W_)BCO_LIT(o_lits+i);
1021             }
1022             goto nextInsn;
1023         }
1024
1025         case bci_SLIDE: {
1026             int n  = BCO_NEXT;
1027             int by = BCO_NEXT;
1028             /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
1029             while(--n >= 0) {
1030                 Sp[n+by] = Sp[n];
1031             }
1032             Sp += by;
1033             INTERP_TICK(it_slides);
1034             goto nextInsn;
1035         }
1036
1037         case bci_ALLOC_AP: {
1038             StgAP* ap;
1039             int n_payload = BCO_NEXT;
1040             ap = (StgAP*)allocate(AP_sizeW(n_payload));
1041             Sp[-1] = (W_)ap;
1042             ap->n_args = n_payload;
1043             SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
1044             Sp --;
1045             goto nextInsn;
1046         }
1047
1048         case bci_ALLOC_PAP: {
1049             StgPAP* pap;
1050             int arity = BCO_NEXT;
1051             int n_payload = BCO_NEXT;
1052             pap = (StgPAP*)allocate(PAP_sizeW(n_payload));
1053             Sp[-1] = (W_)pap;
1054             pap->n_args = n_payload;
1055             pap->arity = arity;
1056             SET_HDR(pap, &stg_PAP_info, CCS_SYSTEM/*ToDo*/)
1057             Sp --;
1058             goto nextInsn;
1059         }
1060
1061         case bci_MKAP: {
1062             int i;
1063             int stkoff = BCO_NEXT;
1064             int n_payload = BCO_NEXT;
1065             StgAP* ap = (StgAP*)Sp[stkoff];
1066             ASSERT((int)ap->n_args == n_payload);
1067             ap->fun = (StgClosure*)Sp[0];
1068
1069             // The function should be a BCO, and its bitmap should
1070             // cover the payload of the AP correctly.
1071             ASSERT(get_itbl(ap->fun)->type == BCO
1072                    && BCO_BITMAP_SIZE(ap->fun) == ap->n_args);
1073
1074             for (i = 0; i < n_payload; i++)
1075                 ap->payload[i] = (StgClosure*)Sp[i+1];
1076             Sp += n_payload+1;
1077             IF_DEBUG(interpreter,
1078                      debugBelch("\tBuilt ");
1079                      printObj((StgClosure*)ap);
1080                 );
1081             goto nextInsn;
1082         }
1083
1084         case bci_MKPAP: {
1085             int i;
1086             int stkoff = BCO_NEXT;
1087             int n_payload = BCO_NEXT;
1088             StgPAP* pap = (StgPAP*)Sp[stkoff];
1089             ASSERT((int)pap->n_args == n_payload);
1090             pap->fun = (StgClosure*)Sp[0];
1091
1092             // The function should be a BCO
1093             ASSERT(get_itbl(pap->fun)->type == BCO);
1094
1095             for (i = 0; i < n_payload; i++)
1096                 pap->payload[i] = (StgClosure*)Sp[i+1];
1097             Sp += n_payload+1;
1098             IF_DEBUG(interpreter,
1099                      debugBelch("\tBuilt ");
1100                      printObj((StgClosure*)pap);
1101                 );
1102             goto nextInsn;
1103         }
1104
1105         case bci_UNPACK: {
1106             /* Unpack N ptr words from t.o.s constructor */
1107             int i;
1108             int n_words = BCO_NEXT;
1109             StgClosure* con = (StgClosure*)Sp[0];
1110             Sp -= n_words;
1111             for (i = 0; i < n_words; i++) {
1112                 Sp[i] = (W_)con->payload[i];
1113             }
1114             goto nextInsn;
1115         }
1116
1117         case bci_PACK: {
1118             int i;
1119             int o_itbl         = BCO_NEXT;
1120             int n_words        = BCO_NEXT;
1121             StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_LIT(o_itbl));
1122             int request        = CONSTR_sizeW( itbl->layout.payload.ptrs,
1123                                                itbl->layout.payload.nptrs );
1124             StgClosure* con = (StgClosure*)allocate_NONUPD(request);
1125             ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
1126             SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), CCS_SYSTEM/*ToDo*/);
1127             for (i = 0; i < n_words; i++) {
1128                 con->payload[i] = (StgClosure*)Sp[i];
1129             }
1130             Sp += n_words;
1131             Sp --;
1132             Sp[0] = (W_)con;
1133             IF_DEBUG(interpreter,
1134                      debugBelch("\tBuilt ");
1135                      printObj((StgClosure*)con);
1136                 );
1137             goto nextInsn;
1138         }
1139
1140         case bci_TESTLT_P: {
1141             unsigned int discr  = BCO_NEXT;
1142             int failto = BCO_NEXT;
1143             StgClosure* con = (StgClosure*)Sp[0];
1144             if (GET_TAG(con) >= discr) {
1145                 bciPtr = failto;
1146             }
1147             goto nextInsn;
1148         }
1149
1150         case bci_TESTEQ_P: {
1151             unsigned int discr  = BCO_NEXT;
1152             int failto = BCO_NEXT;
1153             StgClosure* con = (StgClosure*)Sp[0];
1154             if (GET_TAG(con) != discr) {
1155                 bciPtr = failto;
1156             }
1157             goto nextInsn;
1158         }
1159
1160         case bci_TESTLT_I: {
1161             // There should be an Int at Sp[1], and an info table at Sp[0].
1162             int discr   = BCO_NEXT;
1163             int failto  = BCO_NEXT;
1164             I_ stackInt = (I_)Sp[1];
1165             if (stackInt >= (I_)BCO_LIT(discr))
1166                 bciPtr = failto;
1167             goto nextInsn;
1168         }
1169
1170         case bci_TESTEQ_I: {
1171             // There should be an Int at Sp[1], and an info table at Sp[0].
1172             int discr   = BCO_NEXT;
1173             int failto  = BCO_NEXT;
1174             I_ stackInt = (I_)Sp[1];
1175             if (stackInt != (I_)BCO_LIT(discr)) {
1176                 bciPtr = failto;
1177             }
1178             goto nextInsn;
1179         }
1180
1181         case bci_TESTLT_D: {
1182             // There should be a Double at Sp[1], and an info table at Sp[0].
1183             int discr   = BCO_NEXT;
1184             int failto  = BCO_NEXT;
1185             StgDouble stackDbl, discrDbl;
1186             stackDbl = PK_DBL( & Sp[1] );
1187             discrDbl = PK_DBL( & BCO_LIT(discr) );
1188             if (stackDbl >= discrDbl) {
1189                 bciPtr = failto;
1190             }
1191             goto nextInsn;
1192         }
1193
1194         case bci_TESTEQ_D: {
1195             // There should be a Double at Sp[1], and an info table at Sp[0].
1196             int discr   = BCO_NEXT;
1197             int failto  = BCO_NEXT;
1198             StgDouble stackDbl, discrDbl;
1199             stackDbl = PK_DBL( & Sp[1] );
1200             discrDbl = PK_DBL( & BCO_LIT(discr) );
1201             if (stackDbl != discrDbl) {
1202                 bciPtr = failto;
1203             }
1204             goto nextInsn;
1205         }
1206
1207         case bci_TESTLT_F: {
1208             // There should be a Float at Sp[1], and an info table at Sp[0].
1209             int discr   = BCO_NEXT;
1210             int failto  = BCO_NEXT;
1211             StgFloat stackFlt, discrFlt;
1212             stackFlt = PK_FLT( & Sp[1] );
1213             discrFlt = PK_FLT( & BCO_LIT(discr) );
1214             if (stackFlt >= discrFlt) {
1215                 bciPtr = failto;
1216             }
1217             goto nextInsn;
1218         }
1219
1220         case bci_TESTEQ_F: {
1221             // There should be a Float at Sp[1], and an info table at Sp[0].
1222             int discr   = BCO_NEXT;
1223             int failto  = BCO_NEXT;
1224             StgFloat stackFlt, discrFlt;
1225             stackFlt = PK_FLT( & Sp[1] );
1226             discrFlt = PK_FLT( & BCO_LIT(discr) );
1227             if (stackFlt != discrFlt) {
1228                 bciPtr = failto;
1229             }
1230             goto nextInsn;
1231         }
1232
1233         // Control-flow ish things
1234         case bci_ENTER:
1235             // Context-switch check.  We put it here to ensure that
1236             // the interpreter has done at least *some* work before
1237             // context switching: sometimes the scheduler can invoke
1238             // the interpreter with context_switch == 1, particularly
1239             // if the -C0 flag has been given on the cmd line.
1240             if (context_switch) {
1241                 Sp--; Sp[0] = (W_)&stg_enter_info;
1242                 RETURN_TO_SCHEDULER(ThreadInterpret, ThreadYielding);
1243             }
1244             goto eval;
1245
1246         case bci_RETURN:
1247             obj = (StgClosure *)Sp[0];
1248             Sp++;
1249             goto do_return;
1250
1251         case bci_RETURN_P:
1252             Sp--;
1253             Sp[0] = (W_)&stg_gc_unpt_r1_info;
1254             goto do_return_unboxed;
1255         case bci_RETURN_N:
1256             Sp--;
1257             Sp[0] = (W_)&stg_gc_unbx_r1_info;
1258             goto do_return_unboxed;
1259         case bci_RETURN_F:
1260             Sp--;
1261             Sp[0] = (W_)&stg_gc_f1_info;
1262             goto do_return_unboxed;
1263         case bci_RETURN_D:
1264             Sp--;
1265             Sp[0] = (W_)&stg_gc_d1_info;
1266             goto do_return_unboxed;
1267         case bci_RETURN_L:
1268             Sp--;
1269             Sp[0] = (W_)&stg_gc_l1_info;
1270             goto do_return_unboxed;
1271         case bci_RETURN_V:
1272             Sp--;
1273             Sp[0] = (W_)&stg_gc_void_info;
1274             goto do_return_unboxed;
1275
1276         case bci_SWIZZLE: {
1277             int stkoff = BCO_NEXT;
1278             signed short n = (signed short)(BCO_NEXT);
1279             Sp[stkoff] += (W_)n;
1280             goto nextInsn;
1281         }
1282
1283         case bci_CCALL: {
1284             void *tok;
1285             int stk_offset            = BCO_NEXT;
1286             int o_itbl                = BCO_NEXT;
1287             void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
1288             int ret_dyn_size =
1289                 RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
1290                 + sizeofW(StgRetDyn);
1291
1292 #ifdef THREADED_RTS
1293             // Threaded RTS:
1294             // Arguments on the TSO stack are not good, because garbage
1295             // collection might move the TSO as soon as we call
1296             // suspendThread below.
1297
1298             W_ arguments[stk_offset];
1299
1300             memcpy(arguments, Sp, sizeof(W_) * stk_offset);
1301 #endif
1302
1303             // Restore the Haskell thread's current value of errno
1304             errno = cap->r.rCurrentTSO->saved_errno;
1305
1306             // There are a bunch of non-ptr words on the stack (the
1307             // ccall args, the ccall fun address and space for the
1308             // result), which we need to cover with an info table
1309             // since we might GC during this call.
1310             //
1311             // We know how many (non-ptr) words there are before the
1312             // next valid stack frame: it is the stk_offset arg to the
1313             // CCALL instruction.   So we build a RET_DYN stack frame
1314             // on the stack frame to describe this chunk of stack.
1315             //
1316             Sp -= ret_dyn_size;
1317             ((StgRetDyn *)Sp)->liveness = NO_PTRS | N_NONPTRS(stk_offset);
1318             ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
1319
1320             SAVE_STACK_POINTERS;
1321             tok = suspendThread(&cap->r);
1322
1323 #ifndef THREADED_RTS
1324             // Careful:
1325             // suspendThread might have shifted the stack
1326             // around (stack squeezing), so we have to grab the real
1327             // Sp out of the TSO to find the ccall args again.
1328
1329             marshall_fn ( (void*)(cap->r.rCurrentTSO->sp + ret_dyn_size) );
1330 #else
1331             // Threaded RTS:
1332             // We already made a copy of the arguments above.
1333
1334             marshall_fn ( arguments );
1335 #endif
1336
1337             // And restart the thread again, popping the RET_DYN frame.
1338             cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - sizeof(StgFunTable)));
1339             LOAD_STACK_POINTERS;
1340             Sp += ret_dyn_size;
1341
1342             // Save the Haskell thread's current value of errno
1343             cap->r.rCurrentTSO->saved_errno = errno;
1344
1345 #ifdef THREADED_RTS
1346             // Threaded RTS:
1347             // Copy the "arguments", which might include a return value,
1348             // back to the TSO stack. It would of course be enough to
1349             // just copy the return value, but we don't know the offset.
1350             memcpy(Sp, arguments, sizeof(W_) * stk_offset);
1351 #endif
1352
1353             goto nextInsn;
1354         }
1355
1356         case bci_JMP: {
1357             /* BCO_NEXT modifies bciPtr, so be conservative. */
1358             int nextpc = BCO_NEXT;
1359             bciPtr     = nextpc;
1360             goto nextInsn;
1361         }
1362
1363         case bci_CASEFAIL:
1364             barf("interpretBCO: hit a CASEFAIL");
1365
1366             // Errors
1367         default:
1368             barf("interpretBCO: unknown or unimplemented opcode %d",
1369                  (int)BCO_NEXT);
1370
1371         } /* switch on opcode */
1372     }
1373     }
1374
1375     barf("interpretBCO: fell off end of the interpreter");
1376 }
1377
1378 /* temporary code for peeking inside a AP_STACK and pulling out values
1379    based on their stack offset - used in the debugger for inspecting
1380    the local values of a breakpoint
1381 */
1382 HsStablePtr rts_getApStackVal (HsStablePtr, int);
1383 HsStablePtr rts_getApStackVal (HsStablePtr apStackSptr, int offset)
1384 {
1385    HsStablePtr resultSptr;
1386    StgAP_STACK *apStack;
1387    StgClosure **payload;
1388    StgClosure *val;
1389
1390    apStack = (StgAP_STACK *) deRefStablePtr (apStackSptr);
1391    payload = apStack->payload;
1392    val = (StgClosure *) payload[offset+2];
1393    resultSptr = getStablePtr ((P_)val);
1394    return resultSptr;
1395 }
1396
1397 /* set the single step flag for the debugger to True -
1398    it gets set back to false in the interpreter everytime
1399    we hit a breakpoint
1400 */
1401 void rts_setStepFlag (void);
1402 void rts_setStepFlag (void)
1403 {
1404    stop_next_breakpoint = rtsTrue;
1405 }