ghc/rts/Interpreter.c

   1
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode evaluator
   4  *
   5  * Copyright (c) 1994-2000.
   6  *
   7  * $RCSfile: Interpreter.c,v $
   8  * $Revision: 1.14 $
   9  * $Date: 2001/02/05 17:27:48 $
  10  * ---------------------------------------------------------------------------*/
  11
  12 #ifdef GHCI
  13
  14 #include "Rts.h"
  15 #include "RtsAPI.h"
  16 #include "RtsUtils.h"
  17 #include "Closures.h"
  18 #include "TSO.h"
  19 #include "Schedule.h"
  20 #include "RtsFlags.h"
  21 #include "Storage.h"
  22 #include "Updates.h"
  23
  24 #include "Bytecodes.h"
  25 #include "Printer.h"
  26 #include "Disassembler.h"
  27 #include "Interpreter.h"
  28
  29
  30 /* --------------------------------------------------------------------------
  31  * The new bytecode interpreter
  32  * ------------------------------------------------------------------------*/
  33
  34 /* The interpreter can be compiled so it just interprets BCOs and
  35    hands literally everything else to the scheduler.  This gives a
  36    "reference interpreter" which is correct but slow -- useful for
  37    debugging.  By default, we handle certain closures specially so as
  38    to dramatically cut down on the number of deferrals to the
  39    scheduler.  Ie normally you don't want REFERENCE_INTERPRETER to be
  40    defined. */
  41
  42 /* #define REFERENCE_INTERPRETER */
  43
  44 /* Gather stats about entry, opcode, opcode-pair frequencies.  For
  45    tuning the interpreter. */
  46
  47 /* #define INTERP_STATS */
  48
  49
  50
  51 /* iSp points to the lowest live word on the stack. */
  52
  53 #define StackWord(n)  iSp[n]
  54 #define BCO_NEXT      instrs[bciPtr++]
  55 #define BCO_PTR(n)    (W_)ptrs[n]
  56 #define BCO_LIT(n)    (W_)literals[n]
  57 #define BCO_ITBL(n)   itbls[n]
  58
  59 #define LOAD_STACK_POINTERS \
  60     iSp = cap->rCurrentTSO->sp; iSu = cap->rCurrentTSO->su;
  61
  62 #define SAVE_STACK_POINTERS \
  63     cap->rCurrentTSO->sp = iSp; cap->rCurrentTSO->su = iSu;
  64
  65 #define RETURN(retcode) \
  66    SAVE_STACK_POINTERS; return retcode;
  67
  68
  69 static __inline__ StgPtr allocate_UPD ( int n_words )
  70 {
  71    if (n_words - sizeofW(StgHeader) < MIN_UPD_SIZE)
  72       n_words = MIN_UPD_SIZE + sizeofW(StgHeader);
  73    return allocate(n_words);
  74 }
  75
  76 static __inline__ StgPtr allocate_NONUPD ( int n_words )
  77 {
  78    if (n_words - sizeofW(StgHeader) < MIN_NONUPD_SIZE)
  79       n_words = MIN_NONUPD_SIZE + sizeofW(StgHeader);
  80    return allocate(n_words);
  81 }
  82
  83
  84 #ifdef INTERP_STATS
  85 /* Hacky stats, for tuning the interpreter ... */
  86 int it_unknown_entries[N_CLOSURE_TYPES];
  87 int it_total_unknown_entries;
  88 int it_total_entries;
  89
  90 int it_retto_BCO;
  91 int it_retto_UPDATE;
  92 int it_retto_other;
  93
  94 int it_slides;
  95 int it_insns;
  96 int it_BCO_entries;
  97
  98 int it_ofreq[26];
  99 int it_oofreq[26][26];
 100 int it_lastopc;
 101
 102 void interp_startup ( void )
 103 {
 104    int i, j;
 105    it_retto_BCO = it_retto_UPDATE = it_retto_other = 0;
 106    it_total_entries = it_total_unknown_entries = 0;
 107    for (i = 0; i < N_CLOSURE_TYPES; i++)
 108       it_unknown_entries[i] = 0;
 109    it_slides = it_insns = it_BCO_entries = 0;
 110    for (i = 0; i < 26; i++) it_ofreq[i] = 0;
 111    for (i = 0; i < 26; i++)
 112      for (j = 0; j < 26; j++)
 113         it_oofreq[i][j] = 0;
 114    it_lastopc = 0;
 115 }
 116
 117 void interp_shutdown ( void )
 118 {
 119    int i, j, k, o_max, i_max, j_max;
 120    fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ???)\n",
 121                    it_retto_BCO + it_retto_UPDATE + it_retto_other,
 122                    it_retto_BCO, it_retto_UPDATE, it_retto_other );
 123    fprintf(stderr, "%d total entries, %d unknown entries \n",
 124                    it_total_entries, it_total_unknown_entries);
 125    for (i = 0; i < N_CLOSURE_TYPES; i++) {
 126      if (it_unknown_entries[i] == 0) continue;
 127      fprintf(stderr, "   type %2d: unknown entries (%4.1f%%) == %d\n",
 128              i, 100.0 * ((double)it_unknown_entries[i]) /
 129                         ((double)it_total_unknown_entries),
 130              it_unknown_entries[i]);
 131    }
 132    fprintf(stderr, "%d insns, %d slides, %d BCO_entries\n",
 133                    it_insns, it_slides, it_BCO_entries);
 134    for (i = 0; i < 26; i++)
 135       fprintf(stderr, "opcode %2d got %d\n", i, it_ofreq[i] );
 136
 137    for (k = 1; k < 20; k++) {
 138       o_max = 0;
 139       i_max = j_max = 0;
 140       for (i = 0; i < 26; i++) {
 141          for (j = 0; j < 26; j++) {
 142             if (it_oofreq[i][j] > o_max) {
 143                o_max = it_oofreq[i][j];
 144                i_max = i; j_max = j;
 145             }
 146          }
 147       }
 148
 149       fprintf ( stderr, "%d:  count (%4.1f%%) %6d   is %d then %d\n",
 150                 k, ((double)o_max) * 100.0 / ((double)it_insns), o_max,
 151                    i_max, j_max );
 152       it_oofreq[i_max][j_max] = 0;
 153
 154    }
 155 }
 156 #endif
 157
 158
 159 StgThreadReturnCode interpretBCO ( Capability* cap )
 160 {
 161    /* On entry, the closure to interpret is on the top of the
 162       stack. */
 163
 164    /* Use of register here is primarily to make it clear to compilers
 165       that these entities are non-aliasable.
 166    */
 167     register W_*              iSp;    /* local state -- stack pointer */
 168     register StgUpdateFrame*  iSu;    /* local state -- frame pointer */
 169     register StgPtr           iSpLim; /* local state -- stack lim pointer */
 170     register StgClosure*      obj;
 171
 172     LOAD_STACK_POINTERS;
 173
 174     /* We don't change this ... */
 175     iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
 176
 177     /* Main object-entering loop.  Object to be entered is on top of
 178        stack. */
 179     nextEnter:
 180
 181     obj = (StgClosure*)StackWord(0); iSp++;
 182
 183     nextEnter_obj:
 184
 185 #   ifdef INTERP_STATS
 186     it_total_entries++;
 187 #   endif
 188
 189     IF_DEBUG(evaluator,
 190              fprintf(stderr,
 191              "\n---------------------------------------------------------------\n");
 192              fprintf(stderr,"Entering: "); printObj(obj);
 193              fprintf(stderr,"iSp = %p\tiSu = %p\n", iSp, iSu);
 194              fprintf(stderr, "\n" );
 195
 196              //      checkSanity(1);
 197              //             iSp--; StackWord(0) = obj;
 198              //             checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
 199              //             iSp++;
 200
 201              printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
 202              fprintf(stderr, "\n\n");
 203             );
 204
 205
 206
 207     switch ( get_itbl(obj)->type ) {
 208
 209        case INVALID_OBJECT:
 210                barf("Invalid object %p",(StgPtr)obj);
 211
 212 #      ifndef REFERENCE_INTERPRETER
 213
 214        case IND:
 215        case IND_OLDGEN:
 216        case IND_PERM:
 217        case IND_OLDGEN_PERM:
 218        case IND_STATIC:
 219        {
 220           obj = ((StgInd*)obj)->indirectee;
 221           goto nextEnter_obj;
 222        }
 223
 224        case CONSTR:
 225        case CONSTR_1_0:
 226        case CONSTR_0_1:
 227        case CONSTR_2_0:
 228        case CONSTR_1_1:
 229        case CONSTR_0_2:
 230        case CONSTR_INTLIKE:
 231        case CONSTR_CHARLIKE:
 232        case CONSTR_STATIC:
 233        case CONSTR_NOCAF_STATIC:
 234        nextEnter_obj_CONSTR:
 235        {
 236           StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(0);
 237           if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1p_info) {
 238 #            ifdef INTERP_STATS
 239              it_retto_BCO++;
 240 #            endif
 241              /* Returning this constr to a BCO.  Push the constr on
 242                 the stack and enter the return continuation BCO, which
 243                 is immediately underneath ret_itbl. */
 244              StackWord(-1) = (W_)obj;
 245              obj = (StgClosure*)StackWord(1);
 246              iSp --;
 247              if (get_itbl(obj)->type == BCO)
 248                 goto nextEnter_obj_BCO; /* fast-track common case */
 249              else
 250                 goto nextEnter_obj; /* a safe fallback */
 251           } else
 252           if (ret_itbl == (StgInfoTable*)&stg_upd_frame_info) {
 253 #            ifdef INTERP_STATS
 254              it_retto_UPDATE++;
 255 #            endif
 256              /* Returning this constr to an update frame.  Do the
 257                 update and re-enter the constr. */
 258              ASSERT((W_*)iSu == iSp);
 259              UPD_IND(iSu->updatee, obj);
 260              iSu = iSu->link;
 261              iSp += sizeofW(StgUpdateFrame);
 262              goto nextEnter_obj_CONSTR;
 263           }
 264 #         ifdef INTERP_STATS
 265           else it_retto_other++;
 266 #         endif
 267           goto defer_to_sched;
 268        }
 269
 270        case AP_UPD:
 271        /* Copied from stg_AP_UPD_entry. */
 272        {
 273           nat i, words;
 274           StgAP_UPD *ap = (StgAP_UPD*)obj;
 275           words = ap->n_args;
 276
 277           /* Stack check.  If a stack overflow might occur, don't enter
 278              the closure; let the scheduler handle it instead. */
 279           if (iSp - (words+sizeofW(StgUpdateFrame)) < iSpLim)
 280              goto defer_to_sched;
 281
 282           /* Ok; we're safe.  Party on.  Push an update frame. */
 283           iSp -= sizeofW(StgUpdateFrame);
 284           {
 285               StgUpdateFrame *__frame;
 286               __frame = (StgUpdateFrame *)iSp;
 287               SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info);
 288               __frame->link = iSu;
 289               __frame->updatee = (StgClosure *)(ap);
 290               iSu = __frame;
 291           }
 292
 293           /* Reload the stack */
 294           iSp -= words;
 295           for (i=0; i < words; i++) StackWord(i) = (W_)ap->payload[i];
 296
 297           obj = (StgClosure*)ap->fun;
 298           goto nextEnter_obj;
 299        }
 300
 301        case PAP:
 302        /* Copied from stg_PAP_entry. */
 303        {
 304           nat     words, i;
 305           StgPAP* pap = (StgPAP *)obj;
 306
 307           /*
 308            * remove any update frames on the top of the stack, by just
 309            * performing the update here.
 310            */
 311           while ((W_)iSu - (W_)iSp == 0) {
 312
 313              switch (get_itbl(iSu)->type) {
 314
 315              case UPDATE_FRAME:
 316                 /* We're sitting on top of an update frame, so let's
 317                    do the business. */
 318                 UPD_IND(iSu->updatee, pap);
 319                 iSu = iSu->link;
 320                 iSp += sizeofW(StgUpdateFrame);
 321                 continue;
 322
 323              case SEQ_FRAME:
 324                 /* Too complicated ... adopt the Usual Solution. */
 325                 fprintf(stderr, "!!! SEQ frame in PAP update\n");
 326                 goto defer_to_sched;
 327
 328              case CATCH_FRAME:
 329                 /* can't happen, see stg_update_PAP */
 330                 barf("interpretBCO: PAP_entry: CATCH_FRAME");
 331
 332              default:
 333                 barf("interpretBCO: PAP_entry: strange activation record");
 334              }
 335           }
 336
 337           words = pap->n_args;
 338
 339           /* Stack check.  If a stack overflow might occur, don't enter
 340              the closure; let the scheduler handle it instead. */
 341           if (iSp - words < iSpLim)
 342              goto defer_to_sched;
 343
 344           /* Ok; safe. */
 345           iSp -= words;
 346           for (i=0; i < words; i++) StackWord(i) = (W_)pap->payload[i];
 347
 348           obj = (StgClosure*)pap->fun;
 349           goto nextEnter_obj;
 350        }
 351
 352 #      endif /* ndef REFERENCE_INTERPRETER */
 353
 354        case BCO:
 355        /* ---------------------------------------------------- */
 356        /* Start of the bytecode interpreter                    */
 357        /* ---------------------------------------------------- */
 358        nextEnter_obj_BCO:
 359 #      ifdef INTERP_STATS
 360        it_BCO_entries++;
 361 #      endif
 362        {
 363           int do_print_stack = 1;
 364           register int       bciPtr     = 1; /* instruction pointer */
 365           register StgBCO*   bco        = (StgBCO*)obj;
 366           register UShort*   instrs     = (UShort*)(&bco->instrs->payload[0]);
 367           register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
 368           register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
 369           register StgInfoTable** itbls = (StgInfoTable**)
 370                                              (&bco->itbls->payload[0]);
 371
 372           if (doYouWantToGC()) {
 373              iSp--; StackWord(0) = (W_)bco;
 374              cap->rCurrentTSO->what_next = ThreadEnterGHC;
 375              RETURN(HeapOverflow);
 376           }
 377
 378 #         ifdef INTERP_STATS
 379           it_lastopc = 0; /* no opcode */
 380 #         endif
 381
 382           nextInsn:
 383
 384           ASSERT(bciPtr <= instrs[0]);
 385           IF_DEBUG(evaluator,
 386                    //if (do_print_stack) {
 387                    //fprintf(stderr, "\n-- BEGIN stack\n");
 388                    //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
 389                    //fprintf(stderr, "-- END stack\n\n");
 390                    //}
 391                    do_print_stack = 1;
 392                    fprintf(stderr,"iSp = %p   iSu = %p   pc = %d      ", iSp, iSu, bciPtr);
 393                    disInstr(bco,bciPtr);
 394                     if (0) { int i;
 395                              fprintf(stderr,"\n");
 396                              for (i = 8; i >= 0; i--)
 397                                 fprintf(stderr, "%d  %p\n", i, (StgPtr)(*(iSp+i)));
 398                              fprintf(stderr,"\n");
 399                            }
 400                     //if (do_print_stack) checkStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
 401                   );
 402
 403 #         ifdef INTERP_STATS
 404           it_insns++;
 405           ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 26 );
 406           it_ofreq[ (int)instrs[bciPtr] ] ++;
 407           it_oofreq[ it_lastopc ][ (int)instrs[bciPtr] ] ++;
 408           it_lastopc = (int)instrs[bciPtr];
 409 #         endif
 410
 411           switch (BCO_NEXT) {
 412
 413               case bci_ARGCHECK: {
 414                  int i;
 415                  StgPAP* pap;
 416                  int arg_words_reqd = BCO_NEXT;
 417                  int arg_words_avail = ((W_*)iSu) - ((W_*)iSp);
 418                  if (arg_words_avail >= arg_words_reqd) goto nextInsn;
 419
 420 #                ifndef REFERENCE_INTERPRETER
 421
 422                  /* Optimisation: if there are no args avail and the
 423                     t-o-s is an update frame, do the update, and
 424                     re-enter the object. */
 425                  if (arg_words_avail == 0
 426                     && get_itbl(iSu)->type == UPDATE_FRAME) {
 427                     UPD_IND(iSu->updatee, obj);
 428                     iSu = iSu->link;
 429                     iSp += sizeofW(StgUpdateFrame);
 430                     goto nextEnter_obj_BCO;
 431                  }
 432
 433 #                endif /* ndef REFERENCE_INTERPRETER */
 434
 435                  /* Handle arg check failure.  General case: copy the
 436                     spare args into a PAP frame. */
 437                  pap = (StgPAP*)allocate_UPD(PAP_sizeW(arg_words_avail));
 438                  SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/);
 439                  pap->n_args = arg_words_avail;
 440                  pap->fun = obj;
 441                  for (i = 0; i < arg_words_avail; i++)
 442                     pap->payload[i] = (StgClosure*)StackWord(i);
 443
 444                  /* Push on the stack and defer to the scheduler. */
 445                  iSp = (StgPtr)iSu;
 446                  iSp --;
 447                  StackWord(0) = (W_)pap;
 448                  IF_DEBUG(evaluator,
 449                           fprintf(stderr,"\tBuilt ");
 450                           printObj((StgClosure*)pap);
 451                          );
 452                  cap->rCurrentTSO->what_next = ThreadEnterGHC;
 453                  RETURN(ThreadYielding);
 454               }
 455               case bci_PUSH_L: {
 456                  int o1 = BCO_NEXT;
 457                  ASSERT((W_*)iSp+o1 < (W_*)iSu);
 458                  StackWord(-1) = StackWord(o1);
 459                  iSp--;
 460                  do_print_stack = 0;
 461                  goto nextInsn;
 462               }
 463               case bci_PUSH_LL: {
 464                  int o1 = BCO_NEXT;
 465                  int o2 = BCO_NEXT;
 466                  ASSERT((W_*)iSp+o1 < (W_*)iSu);
 467                  ASSERT((W_*)iSp+o2 < (W_*)iSu);
 468                  StackWord(-1) = StackWord(o1);
 469                  StackWord(-2) = StackWord(o2);
 470                  iSp -= 2;
 471                  goto nextInsn;
 472               }
 473               case bci_PUSH_LLL: {
 474                  int o1 = BCO_NEXT;
 475                  int o2 = BCO_NEXT;
 476                  int o3 = BCO_NEXT;
 477                  ASSERT((W_*)iSp+o1 < (W_*)iSu);
 478                  ASSERT((W_*)iSp+o2 < (W_*)iSu);
 479                  ASSERT((W_*)iSp+o3 < (W_*)iSu);
 480                  StackWord(-1) = StackWord(o1);
 481                  StackWord(-2) = StackWord(o2);
 482                  StackWord(-3) = StackWord(o3);
 483                  iSp -= 3;
 484                  goto nextInsn;
 485               }
 486               case bci_PUSH_G: {
 487                  int o1 = BCO_NEXT;
 488                  StackWord(-1) = BCO_PTR(o1);
 489                  iSp -= 1;
 490                  goto nextInsn;
 491               }
 492               case bci_PUSH_AS: {
 493                  int o_bco  = BCO_NEXT;
 494                  int o_itbl = BCO_NEXT;
 495                  StackWord(-2) = BCO_LIT(o_itbl);
 496                  StackWord(-1) = BCO_PTR(o_bco);
 497                  iSp -= 2;
 498                  goto nextInsn;
 499               }
 500               case bci_PUSH_UBX: {
 501                  int i;
 502                  int o_lits = BCO_NEXT;
 503                  int n_words = BCO_NEXT;
 504                  iSp -= n_words;
 505                  for (i = 0; i < n_words; i++)
 506                     StackWord(i) = BCO_LIT(o_lits+i);
 507                  do_print_stack = 0;
 508                  goto nextInsn;
 509               }
 510               case bci_PUSH_TAG: {
 511                  W_ tag = (W_)(BCO_NEXT);
 512                  StackWord(-1) = tag;
 513                  iSp --;
 514                  goto nextInsn;
 515               }
 516               case bci_SLIDE: {
 517                  int n  = BCO_NEXT;
 518                  int by = BCO_NEXT;
 519                  ASSERT((W_*)iSp+n+by <= (W_*)iSu);
 520                  /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
 521                  while(--n >= 0) {
 522                     StackWord(n+by) = StackWord(n);
 523                  }
 524                  iSp += by;
 525 #                ifdef INTERP_STATS
 526                  it_slides++;
 527 #                endif
 528                  goto nextInsn;
 529               }
 530               case bci_ALLOC: {
 531                  StgAP_UPD* ap;
 532                  int n_payload = BCO_NEXT - 1;
 533                  int request   = AP_sizeW(n_payload);
 534                  ap = (StgAP_UPD*)allocate_UPD(request);
 535                  StackWord(-1) = (W_)ap;
 536                  ap->n_args = n_payload;
 537                  SET_HDR(ap, &stg_AP_UPD_info, ??)
 538                  iSp --;
 539                  goto nextInsn;
 540               }
 541               case bci_MKAP: {
 542                  int i;
 543                  int stkoff = BCO_NEXT;
 544                  int n_payload = BCO_NEXT - 1;
 545                  StgAP_UPD* ap = (StgAP_UPD*)StackWord(stkoff);
 546                  ASSERT((int)ap->n_args == n_payload);
 547                  ap->fun = (StgClosure*)StackWord(0);
 548                  for (i = 0; i < n_payload; i++)
 549                     ap->payload[i] = (StgClosure*)StackWord(i+1);
 550                  iSp += n_payload+1;
 551                  IF_DEBUG(evaluator,
 552                           fprintf(stderr,"\tBuilt ");
 553                           printObj((StgClosure*)ap);
 554                          );
 555                  goto nextInsn;
 556               }
 557               case bci_UNPACK: {
 558                  /* Unpack N ptr words from t.o.s constructor */
 559                  /* The common case ! */
 560                  int i;
 561                  int n_words = BCO_NEXT;
 562                  StgClosure* con = (StgClosure*)StackWord(0);
 563                  iSp -= n_words;
 564                  for (i = 0; i < n_words; i++)
 565                     StackWord(i) = (W_)con->payload[i];
 566                  goto nextInsn;
 567               }
 568               case bci_UPK_TAG: {
 569                  /* Unpack N (non-ptr) words from offset M in the
 570                     constructor K words down the stack, and then push
 571                     N as a tag, on top of it.  Slow but general; we
 572                     hope it will be the rare case. */
 573                  int i;
 574                  int n_words = BCO_NEXT;
 575                  int con_off = BCO_NEXT;
 576                  int stk_off = BCO_NEXT;
 577                  StgClosure* con = (StgClosure*)StackWord(stk_off);
 578                  iSp -= n_words;
 579                  for (i = 0; i < n_words; i++)
 580                     StackWord(i) = (W_)con->payload[con_off + i];
 581                  iSp --;
 582                  StackWord(0) = n_words;
 583                  goto nextInsn;
 584               }
 585               case bci_PACK: {
 586                  int i;
 587                  int o_itbl         = BCO_NEXT;
 588                  int n_words        = BCO_NEXT;
 589                  StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_ITBL(o_itbl));
 590                  int request        = CONSTR_sizeW( itbl->layout.payload.ptrs,
 591                                                     itbl->layout.payload.nptrs );
 592                  StgClosure* con = (StgClosure*)allocate_NONUPD(request);
 593                  ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
 594                  SET_HDR(con, BCO_ITBL(o_itbl), CCS_SYSTEM/*ToDo*/);
 595                  for (i = 0; i < n_words; i++)
 596                     con->payload[i] = (StgClosure*)StackWord(i);
 597                  iSp += n_words;
 598                  iSp --;
 599                  StackWord(0) = (W_)con;
 600                  IF_DEBUG(evaluator,
 601                           fprintf(stderr,"\tBuilt ");
 602                           printObj((StgClosure*)con);
 603                          );
 604                  goto nextInsn;
 605               }
 606               case bci_TESTLT_P: {
 607                  int discr  = BCO_NEXT;
 608                  int failto = BCO_NEXT;
 609                  StgClosure* con = (StgClosure*)StackWord(0);
 610                  if (constrTag(con) >= discr)
 611                     bciPtr = failto;
 612                  goto nextInsn;
 613               }
 614               case bci_TESTEQ_P: {
 615                  int discr  = BCO_NEXT;
 616                  int failto = BCO_NEXT;
 617                  StgClosure* con = (StgClosure*)StackWord(0);
 618                  if (constrTag(con) != discr)
 619                     bciPtr = failto;
 620                  goto nextInsn;
 621               }
 622               case bci_TESTLT_I: {
 623                  /* The top thing on the stack should be a tagged int. */
 624                  int discr   = BCO_NEXT;
 625                  int failto  = BCO_NEXT;
 626                  I_ stackInt = (I_)StackWord(1);
 627                  ASSERT(1 == StackWord(0));
 628                  if (stackInt >= (I_)BCO_LIT(discr))
 629                     bciPtr = failto;
 630                  goto nextInsn;
 631               }
 632               case bci_TESTEQ_I: {
 633                  /* The top thing on the stack should be a tagged int. */
 634                  int discr   = BCO_NEXT;
 635                  int failto  = BCO_NEXT;
 636                  I_ stackInt = (I_)StackWord(1);
 637                  ASSERT(1 == StackWord(0));
 638                  if (stackInt != (I_)BCO_LIT(discr))
 639                     bciPtr = failto;
 640                  goto nextInsn;
 641               }
 642               case bci_TESTLT_D: {
 643                  /* The top thing on the stack should be a tagged double. */
 644                  int discr   = BCO_NEXT;
 645                  int failto  = BCO_NEXT;
 646                  StgDouble stackDbl, discrDbl;
 647                  ASSERT(sizeofW(StgDouble) == StackWord(0));
 648                  stackDbl = PK_DBL( & StackWord(1) );
 649                  discrDbl = PK_DBL( & BCO_LIT(discr) );
 650                  if (stackDbl >= discrDbl)
 651                     bciPtr = failto;
 652                  goto nextInsn;
 653               }
 654               case bci_TESTEQ_D: {
 655                  /* The top thing on the stack should be a tagged double. */
 656                  int discr   = BCO_NEXT;
 657                  int failto  = BCO_NEXT;
 658                  StgDouble stackDbl, discrDbl;
 659                  ASSERT(sizeofW(StgDouble) == StackWord(0));
 660                  stackDbl = PK_DBL( & StackWord(1) );
 661                  discrDbl = PK_DBL( & BCO_LIT(discr) );
 662                  if (stackDbl != discrDbl)
 663                     bciPtr = failto;
 664                  goto nextInsn;
 665               }
 666
 667               /* Control-flow ish things */
 668               case bci_ENTER: {
 669                  goto nextEnter;
 670               }
 671               case bci_RETURN: {
 672                  /* Figure out whether returning to interpreted or
 673                     compiled code. */
 674                  int           o_itoc_itbl = BCO_NEXT;
 675                  int           tag         = StackWord(0);
 676                  StgInfoTable* ret_itbl    = (StgInfoTable*)StackWord(tag +1);
 677                  ASSERT(tag <= 2); /* say ... */
 678                  if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1p_info
 679                      || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1n_info
 680                      || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_F1_info
 681                      || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_D1_info) {
 682                      /* Returning to interpreted code.  Interpret the BCO
 683                         immediately underneath the itbl. */
 684                      StgBCO* ret_bco = (StgBCO*)StackWord(tag +1+1);
 685                      iSp --;
 686                      StackWord(0) = (W_)ret_bco;
 687                      goto nextEnter;
 688                  } else {
 689                      /* Returning (unboxed value) to compiled code.
 690                         Replace tag with a suitable itbl and ask the
 691                         scheduler to run it.  The itbl code will copy
 692                         the TOS value into R1/F1/D1 and do a standard
 693                         compiled-code return. */
 694                      StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
 695                      StackWord(0) = (W_)magic_itbl;
 696                      cap->rCurrentTSO->what_next = ThreadRunGHC;
 697                      RETURN(ThreadYielding);
 698                  }
 699               }
 700
 701               case bci_CASEFAIL:
 702                  barf("interpretBCO: hit a CASEFAIL");
 703
 704               /* As yet unimplemented */
 705               case bci_TESTLT_F:
 706               case bci_TESTEQ_F:
 707
 708               /* Errors */
 709               default:
 710                  barf("interpretBCO: unknown or unimplemented opcode");
 711
 712           } /* switch on opcode */
 713
 714           barf("interpretBCO: fell off end of insn loop");
 715
 716        }
 717        /* ---------------------------------------------------- */
 718        /* End of the bytecode interpreter                      */
 719        /* ---------------------------------------------------- */
 720
 721        defer_to_sched:
 722        default: {
 723 #         ifdef INTERP_STATS
 724           { int j = get_itbl(obj)->type;
 725             ASSERT(j >= 0 && j < N_CLOSURE_TYPES);
 726             it_unknown_entries[j]++;
 727             it_total_unknown_entries++;
 728           }
 729 #         endif
 730
 731           /* Can't handle this object; yield to sched. */
 732           IF_DEBUG(evaluator,
 733                    fprintf(stderr, "entering unknown closure -- yielding to sched\n");
 734                    printObj(obj);
 735                   );
 736           iSp--; StackWord(0) = (W_)obj;
 737           cap->rCurrentTSO->what_next = ThreadEnterGHC;
 738           RETURN(ThreadYielding);
 739        }
 740     } /* switch on object kind */
 741
 742     barf("fallen off end of object-type switch in interpretBCO()");
 743 }
 744
 745 #endif /* GHCI */