ghc/rts/Interpreter.c

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