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