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