VALUE * argv = &SP ( argc-1 );

    if ( ctor->is_native () ) 
    {
      VALUE v = invoke_native ( ctor,  argc - 1, argv + 1 );
      POPN ( n );
      SP ( 0 ) = v;
    }
    else
    {
      CHECKSTACK ( FRAME_SIZE );
      code = ctor;
      package = code->klass () ->get_package ();
      SP ( n ) = code;
      SP ( n-1 ) = klass->create_instance ();
      PUSH ( argc );		/* argument count */
      PUSH ( eh_pos );
      PUSH ( m_stack_pos );
      PUSH ( int ( fp - stkbase ) );	/* old fp */
      PUSH ( int ( pc - cbase ) );	/* old pc */
      cbase = pc = ( unsigned char * ) code->bytecode ();
      fp = sp;
    }

  }

  void
    VM::opPMREF () 
  {

    CLASS *klass = get_class ( &SP ( 1 ) );
    CLASS *orig_klass = klass;
    CHECKTYPE ( 0, DT_SYMBOL );
    symbol_t selector = SP ( 0 ) .v.v_symbol;

    THING *thing = SP ( 1 ) .v.v_thing;
    while ( klass ) 
    {
      ENTRY e = klass->find ( selector );
      if ( e.is_valid () ) 
      {
        VALUE *vprop = e.value ();
        switch ( e.type () ) 
        {
        case ST_PROPERTY:
          {
            if ( vprop->v_type == DT_CODE ) 
            {
              if ( vprop->v.v_code->is_native () ) 
              {
                SP ( 1 ) = ( * ( vprop->v.v_code->native () ) ) ( 0, &SP ( 0 ) );
                POP;
                return;
              }
              else
              {
                SP ( 0 ) = SP ( 1 );
                CHECKSTACK ( FRAME_SIZE );
                code = vprop->v.v_code;
                package = code->klass () ->get_package ();
                SP ( 1 ) = code;
                PUSH ( 1 );		/* argument count */
                PUSH ( eh_pos );
                PUSH ( m_stack_pos );
                PUSH ( int ( fp - stkbase ) );	/* old fp */
                PUSH ( int ( pc - cbase ) );	/* old pc */
                cbase = pc = ( unsigned char * ) code->bytecode ();
                fp = sp;
                return;
              }
            }
            else
              error ( "'%s' is not a property function",  voc [ selector ] );

          }
          break;
        case ST_DATA:
          POP;
          SP ( 0 ) = sp->v.v_object->members [ vprop->v.v_integer ];
          return;
        case ST_CONST:
        case ST_SDATA:
          POP;
          SP ( 0 ) = *vprop;
          return;
        case ST_FUNCTION:
          POP;
          if ( vprop->v_type == DT_CODE ) 
          {
            SP ( 0 ) .set_method ( thing, vprop->v.v_code );
          }
          else assert ( false );
          return;
        }
      }

      klass = klass->base;

    }
    if ( orig_klass ) 
      error ( "'%s' not found in class '%s'", voc [ selector ], (const char *) orig_klass->full_name () );
    else
      error ( "'%s' is not an object", nameoftype ( SP ( 1 ) .v_type ) );
  }

  void
    VM::opPMSET () 
  {
    CLASS *klass = get_class ( &SP ( 2 ) );
    CLASS *i_klass = klass;
    CHECKTYPE ( 1, DT_SYMBOL );
    symbol_t selector = SP ( 1 ) .v.v_symbol;
    while ( klass ) 
    {
      ENTRY e = klass->find ( selector );
      if ( e.is_valid () ) 
      {
        VALUE *vprop = e.value ();
        switch ( e.type () ) 
        {
        case ST_PROPERTY:
          {
            int     argc = 2;
            VALUE t = SP ( 2 ); SP ( 2 ) = SP ( 1 ); SP ( 1 ) = t;
            VALUE * argv = &SP ( argc-1 );
            if ( vprop->v_type == DT_CODE ) 
            {
              if ( vprop->v.v_code->is_native () ) 
              {
                POP;
                SP ( 0 ) = ( * ( vprop->v.v_code->native () ) ) ( 1, argv+1 );
                return;
              }
              else
              {
                CHECKSTACK ( FRAME_SIZE );
                code = vprop->v.v_code;
                package = code->klass () ->get_package ();
                SP ( argc ) = code;
                PUSH ( argc );		    /* argument count */
                PUSH ( eh_pos );
                PUSH ( m_stack_pos );
                PUSH ( int ( fp - stkbase ) );	/* old fp */
                PUSH ( int ( pc - cbase ) );	/* old pc */
                cbase = pc = ( unsigned char * ) code->bytecode ();
                fp = sp;
                return;
              }
            }
            else
              error ( "'%s' is not a property function",  voc [ selector ] );
          }
          break;
        case ST_DATA:
          SP ( 2 ) .v.v_object->members [ vprop->v.v_integer ] = SP ( 0 );
          POPN ( 2 );
          return;
        case ST_SDATA:
          *vprop = SP ( 2 );
          POPN ( 2 );
          return;
          //default:
        }
      }

      klass = klass->base;

    }

    if ( i_klass ) 
      error ( "Property '%s' not found in class '%s'", voc [ selector ], voc [ i_klass->name ] );
    else
      error ( "Type '%s' is not an object", nameoftype ( SP ( 2 ) .v_type ) );
  }

  // opVREF - VREF opcode handler
  void
    VM::opVREF () 
  {
    CLASS *klass = get_class ( &SP ( 1 ) );
    string klass_name;
    if ( klass == 0 ) 
      klass_name = nameoftype ( SP ( 1 ) .v_type );
    else if ( klass->item_function == 0 ) 
      klass_name = klass->full_name ();
    else
    {
      CODE *code = klass->item_function;
      SP ( 1 ) = call ( code, SP ( 1 ), 1, &SP ( 0 ) );
      POP;
      return;
    }
    error ( "function [] not implemented for '%s'", ( const char * ) klass_name );
  }

  // opVSET - VSET opcode handler
  void
    VM::opVSET () 
  {
    CLASS *klass = get_class ( &SP ( 2 ) );
    string klass_name;
    if ( klass == 0 ) 
      klass_name = nameoftype ( SP ( 2 ) .v_type );
    else if ( klass->item_function == 0 ) 
      klass_name = klass->full_name ();
    else
    {
      CODE *code = klass->item_function;
      SP ( 2 ) = call ( code, SP ( 2 ), 2, &SP ( 1 ) );
      POPN ( 2 );
      return;
    }
    error ( "function [] not implemented for '%s'", ( const char * ) klass_name );
  }


  // type names
  static char *tnames [ ] =
  {
    "null", 
    "string", 
    "float", 
    "integer", 
    "class", 
    "object", 
    "array", 
    "function", 
    "var", 
    "native_object", 
    "symbol", 
    "method"
  };


  // nameoftype - get the name of a type
  char *
    nameoftype ( int type ) 
  {
    static char buf [ 20 ];
    if ( type >= _DTMIN && type <= _DTMAX )
      return ( tnames [ type ] );
    sprintf ( buf, " ( %d ) ", type );
    return ( buf );
  }

  // badtype - report a bad operand type
  void
    VM::badtype ( int off, int type ) 
  {
    string tn = nameoftype ( SP ( off ) .v_type );
    error ( "Bad argument type '%s',  expected '%s'", (const char *) tn,
                                                      nameoftype ( type ) );
  }

  // stackover - report a stack overflow error
  void
    VM::stackover () 
  {
    error ( "Stack overflow" );
  }

  string
    VM::stack_trace () 
  {

    string out;
    CODE *	        code;	          // current code vector
    VALUE *			    fp = this->fp;	// the frame pointer
    while ( fp != stkbase ) 
    {
      int  coff = FP ( FRAME_ARGC ) .v.v_integer + FRAME_SIZE;
      code = FP ( coff ) .v.v_code;
      out += string::format ( " -> %s () \n", ( const char * ) code->full_name () );
      fp = stkbase + FP ( FRAME_FPOFF ) .v.v_integer;
    }
    return out;
  }

  // error - print an error message and exit
  void
    VM::error ( const char *fmt,  ... ) 
  {
    char buf1 [ 200 ];

    va_list args;
    va_start ( args,  fmt );
    _vsnprintf ( buf1, 100, fmt,  args );
    va_end ( args );

    throw VM_RTE ( VM::current (), buf1 );
  }

  void
    VM::throw_error ( const VALUE& v ) 
  {
    throw VM_RTE ( VM::current (), v );
  }

  // wrongcnt - report wrong number of arguments
  void
    VM::wrongcnt ( int n, int cnt ) 
  {
    if ( n < cnt ) 
      error ( "Too many arguments" );
    else if ( n > cnt ) 
      error ( "Too few arguments" );
  }

  CLASS *
    VM::get_class ( const VALUE *v ) 
  {
    switch ( v->v_type ) 
    {
    case DT_OBJECT:
      return v->v.v_object->klass;
    case DT_STRING:
      return class_string;
    case DT_ARRAY:
      return class_array;
    case DT_EXT:
      return  v->v.v_thing->get_class ();
    }
    return NULL;
  }

  string
    VM::get_file_name () 
  {
    if ( code && code->klass () ) 
    {
      PACKAGE * pkg = code->klass () ->get_package ();
      return CSTR ( pkg->file_name );
    }
    return string ( "" );
  }

  // badtype - report a bad operand type
  void
    VM::checktype ( VALUE& vl, int type, int number ) 
  {
    if ( vl.v_type != type ) 
      error ( "Bad type of argument %d: %s expected %s", 
    number, nameoftype ( vl.v_type ), nameoftype ( type ) );
  }

  VALUE
    VM::call ( CODE *c, int argc, VALUE *argv ) 
  {
    start_call ( c, argc, argv );
    execute_call ();
    VALUE v = SP ( 0 );
    POP;
    return v;
  }

  VALUE
    VM::call ( CODE *c, VALUE& v_this, int argc,  VALUE *argv ) 
  {
    start_call ( c, v_this, argc, argv );
    execute_call ();
    VALUE v = SP ( 0 );
    POP;
    return v;
  }

  VALUE
    VM::call ( VALUE& c, int argc, VALUE *argv ) 
  {
    switch ( c.v_type ) 
    {
    case DT_CODE:
      start_call ( c.v.v_code, argc, argv );
      break;
    case DT_OBJECT_METHOD:
      start_call ( c.v.v_om.code, c.v.v_om.thing, argc, argv );
      break;
    default:
      error ( "Bad type of argument. Got '%s' instead of function or method",
              nameoftype ( c.v_type ) );
    }
    execute_call ();
    VALUE v = SP ( 0 );
    POP;
    return v;
  }

  VALUE
    VM::send ( VALUE& v, symbol_t t, int argc, VALUE *argv ) 
  {
    CLASS *klass = get_class ( &v );
    if ( klass == 0 ) error ( "%s is not an object", nameoftype ( v.v_type ) );
    CLASS *orig_klass = klass;
    VALUE r;

    while ( klass ) 
    {
      ENTRY e = klass->find ( t );
      if ( e.is_valid () && e.type () == ST_FUNCTION ) 
      {
        start_call ( e.value () ->v.v_code, v, argc, argv );
        execute_call ();
        r = SP ( 0 );
        POP;
        return r;
      }
      klass = klass->base;
    }
    error ( "method '%s' not found in class '%s'",  voc [ t ],
            (const char *) orig_klass->full_name () );
    return r;
  }

  VM_RTE::VM_RTE ( VM *vm, const char *msg ) : description ( msg ) 
  {
    line_no = vm->get_line_num ();
    source = vm->get_file_name ();
    if ( vm->native_code ) 
      function_name = vm->native_code->full_name ();
  }

  VM_RTE::VM_RTE ( VM *vm, const VALUE& ev ) : err_value ( ev ) 
  {
    line_no = 0;
    source = "";
    if ( vm->native_code ) 
      function_name = vm->native_code->full_name ();
  }

  string
    VM_RTE::report () 
  {
    string t;
    if ( line_no < 0 ) 
      t.printf ( "%s\n", ( const char * ) description );
    else
    {
      if ( description.length () == 0 ) 
        t.printf ( "%s - %s\n", 
      (const char * ) function_name, 
      (const char * ) err_value.to_string () 
       );
      else if ( function_name.length () ) 
        t.printf ( "%s - %s\n%s ( %d ) \n", 
                   (const char *) function_name, 
                   (const char *) description, 
                   (const char *) source, line_no
       );
      else
        t.printf ( "%s\n%s ( %d ) \n", 
                   (const char * ) description, 
                   (const char * ) source, line_no
       );
    }
    return t;
  }

};