ghc/rts/Interpreter.c

   1 #if 0
   2 /* -----------------------------------------------------------------------------
   3  * Bytecode evaluator
   4  *
   5  * Copyright (c) 1994-2000.
   6  *
   7  * $RCSfile: Interpreter.c,v $
   8  * $Revision: 1.2 $
   9  * $Date: 2000/12/11 17:59:01 $
  10  * ---------------------------------------------------------------------------*/
  11
  12 #include "Rts.h"
  13
  14
  15
  16 #include "RtsFlags.h"
  17 #include "RtsUtils.h"
  18 #include "Updates.h"
  19 #include "Storage.h"
  20 #include "SchedAPI.h" /* for createGenThread */
  21 #include "Schedule.h" /* for context_switch  */
  22 #include "Bytecodes.h"
  23 #include "Assembler.h" /* for CFun stuff */
  24 #include "ForeignCall.h"
  25 #include "PrimOps.h"   /* for __{encode,decode}{Float,Double} */
  26 #include "Prelude.h"
  27 #include "Itimer.h"
  28 #include "Evaluator.h"
  29 #include "sainteger.h"
  30
  31 #ifdef DEBUG
  32 #include "Printer.h"
  33 #include "Disassembler.h"
  34 #include "Sanity.h"
  35 #include "StgRun.h"
  36 #endif
  37
  38 #include <math.h>    /* These are for primops */
  39 #include <limits.h>  /* These are for primops */
  40 #include <float.h>   /* These are for primops */
  41 #ifdef HAVE_IEEE754_H
  42 #include <ieee754.h> /* These are for primops */
  43 #endif
  44
  45 #endif /* 0 */
  46
  47 #if 0
  48 /* --------------------------------------------------------------------------
  49  * The new bytecode interpreter
  50  * ------------------------------------------------------------------------*/
  51
  52 /* Sp points to the lowest live word on the stack. */
  53
  54 #define StackWord(n)  ((W_*)iSp)[n]
  55 #define BCO_NEXT      bco_instrs[bciPtr++]
  56 #define BCO_PTR(n)    bco_ptrs[n]
  57
  58
  59 StgThreadReturnCode enter ( Capability* cap )
  60 {
  61    /* On entry, the closure to interpret is on the top of the
  62       stack. */
  63
  64    /* Use of register here is primarily to make it clear to compilers
  65       that these entities are non-aliasable.
  66    */
  67     register StgPtr           iSp;    /* local state -- stack pointer */
  68     register StgUpdateFrame*  iSu;    /* local state -- frame pointer */
  69     register StgPtr           iSpLim; /* local state -- stack lim pointer */
  70     register StgClosure*      obj;
  71
  72     iSp    = cap->rCurrentTSO->sp;
  73     iSu    = cap->rCurrentTSO->su;
  74     iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
  75
  76     IF_DEBUG(evaluator,
  77              enterCountI++;
  78              fprintf(stderr,
  79              "\n---------------------------------------------------------------\n");
  80              fprintf(stderr,"Entering: ",); printObj(obj);
  81              fprintf(stderr,"xSp = %p\txSu = %p\n", xSp, xSu);
  82              fprintf(stderr, "\n" );
  83              printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
  84              fprintf(stderr, "\n\n");
  85             );
  86
  87     /* Main object-entering loop.  Object to be entered is on top of
  88        stack. */
  89     nextEnter:
  90
  91     obj = StackWord(0); iSp++;
  92
  93     switch ( get_itbl(obj)->type ) {
  94        case INVALID_OBJECT:
  95                barf("Invalid object %p",obj);
  96
  97        case BCO: bco_entry:
  98
  99        /* ---------------------------------------------------- */
 100        /* Start of the bytecode interpreter                    */
 101        /* ---------------------------------------------------- */
 102        {
 103           register StgWord8* bciPtr; /* instruction pointer */
 104           register StgBCO*   bco = (StgBCO*)obj;
 105           if (doYouWantToGC()) {
 106              iSp--; StackWord(0) = bco;
 107              return HeapOverflow;
 108           }
 109
 110           nextInsn:
 111
 112           ASSERT((StgWord)(PC) < bco->n_instrs);
 113           IF_DEBUG(evaluator,
 114           fprintf(stderr,"Sp = %p\tSu = %p\tpc = %d\t", xSp, xSu, PC);
 115                   disInstr(bco,PC);
 116                   if (0) { int i;
 117                            fprintf(stderr,"\n");
 118                            for (i = 8; i >= 0; i--)
 119                               fprintf(stderr, "%d  %p\n", i, (StgPtr)(*(gSp+i)));
 120                          }
 121                   fprintf(stderr,"\n");
 122                  );
 123
 124           switch (BCO_NEXT) {
 125
 126               case bci_PUSH_L: {
 127                  int o1 = BCO_NEXT;
 128                  StackWord(-1) = StackWord(o1);
 129                  Sp--;
 130                  goto nextInsn;
 131               }
 132               case bci_PUSH_LL: {
 133                  int o1 = BCO_NEXT;
 134                  int o2 = BCO_NEXT;
 135                  StackWord(-1) = StackWord(o1);
 136                  StackWord(-2) = StackWord(o2);
 137                  Sp -= 2;
 138                  goto nextInsn;
 139               }
 140               case bci_PUSH_LLL: {
 141                  int o1 = BCO_NEXT;
 142                  int o2 = BCO_NEXT;
 143                  int o3 = BCO_NEXT;
 144                  StackWord(-1) = StackWord(o1);
 145                  StackWord(-2) = StackWord(o2);
 146                  StackWord(-3) = StackWord(o3);
 147                  Sp -= 3;
 148                  goto nextInsn;
 149               }
 150               case bci_PUSH_G: {
 151                  int o1 = BCO_NEXT;
 152                  StackWord(-1) = BCO_PTR(o1);
 153                  Sp -= 3;
 154                  goto nextInsn;
 155               }
 156               case bci_PUSH_AS: {
 157                  int o_bco  = BCO_NEXT;
 158                  int o_itbl = BCO_NEXT;
 159                  StackWord(-1) = BCO_LITW(o_itbl);
 160                  StackWord(-2) = BCO_PTR(o_bco);
 161                  Sp -= 2;
 162                  goto nextInsn;
 163               }
 164               case bci_PUSH_LIT:{
 165                  int o = BCO_NEXT;
 166                  StackWord(-1) = BCO_LIT(o);
 167                  Sp --;
 168                  goto nextInsn;
 169               }
 170               case bci_PUSH_TAG: {
 171                  W_ tag = (W_)(BCO_NEXT);
 172                  StackWord(-1) = tag;
 173                  Sp --;
 174                  goto nextInsn;
 175               }
 176               case bci_SLIDE: {
 177                  int n  = BCO_NEXT;
 178                  int by = BCO_NEXT;
 179                  ASSERT(Sp+n+by <= (StgPtr)xSu);
 180                  /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
 181                  while(--n >= 0) {
 182                     StackWord(n+by) = StackWord(n);
 183                  }
 184                  Sp += by;
 185                  goto nextInsn;
 186               }
 187               case bci_ALLOC: {
 188                  int n_payload = BCO_NEXT;
 189                  P_ p = allocate(AP_sizeW(n_payload));
 190                  StackWord(-1) = p;
 191                  Sp --;
 192                  goto nextInsn;
 193               }
 194               case bci_MKAP:        {
 195                  int off = BCO_NEXT;
 196                  int n_payload = BCO_NEXT - 1;
 197                  StgAP_UPD* ap = StackWord(off);
 198                  ap->n_args = n_payload;
 199                  ap->fun = (StgClosure*)StackWord(0);
 200                  for (i = 0; i < n_payload; i++)
 201                     ap->payload[i] = StackWord(i+1);
 202                  Sp += n_payload+1;
 203                  goto nextInsn;
 204               }
 205               case bci_UNPACK: {
 206                  /* Unpack N ptr words from t.o.s constructor */
 207                  /* The common case ! */
 208                  int n_words = BCO_NEXT;
 209                  StgClosure* con = StackWord(0);
 210                  Sp -= n_words;
 211                  for (i = 0; i < n_words; i++)
 212                     StackWord(i) = con->payload[i];
 213                  goto nextInsn;
 214               }
 215               case bci_UNPACK_BX: {
 216                  /* Unpack N (non-ptr) words from offset M in the
 217                     constructor K words down the stack, and then push
 218                     N as a tag, on top of it.  Slow but general; we
 219                     hope it will be the rare case. */
 220                  int n_words = BCO_NEXT;
 221                  int con_off = BCO_NEXT;
 222                  int stk_off = BCO_NEXT;
 223                  StgClosure* con = StackWord(stk_off);
 224                  Sp -= n_words;
 225                  for (i = 0; i < n_words; i++)
 226                     StackWord(i) = con->payload[con_off + i];
 227                  Sp --;
 228                  StackWord(0) = n_words;
 229                  goto nextInsn;
 230               }
 231               case bci_PACK:
 232               case bci_TESTLT_I:
 233               case bci_TESTEQ_I:
 234               case bci_TESTLT_F:
 235               case bci_TESTEQ_F:
 236               case bci_TESTLT_D:
 237               case bci_TESTEQ_D:
 238               case bci_TESTLT_P:
 239               case bci_TESTEQ_P:
 240               case bci_CASEFAIL:
 241
 242               /* Control-flow ish things */
 243               case bci_ARGCHECK:
 244               case bci_ENTER:
 245               case bci_RETURN:
 246
 247               /* Errors */
 248               case bci_LABEL:
 249               default: barf
 250
 251           } /* switch on opcode */
 252           goto nextEnter;
 253
 254        }
 255        /* ---------------------------------------------------- */
 256        /* End of the bytecode interpreter                      */
 257        /* ---------------------------------------------------- */
 258
 259        default: {
 260           /* Can't handle this object; yield to sched. */
 261           fprintf(stderr, "entering unknown closure -- yielding to sched\n");
 262           printObj(obj);
 263           cap->rCurrentTSO->what_next = ThreadEnterGHC;
 264           iSp--; StackWord(0) = obj;
 265           return ThreadYielding;
 266        }
 267     } /* switch on object kind */
 268
 269     barf("fallen off end of switch in enter()");
 270 }
 271
 272
 273 #endif /* 0 */