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