languages/tcl/src/pmc/tclint.pmc

   1 /* TclInt.pmc
   2  *  Copyright (C) 2001-2008, The Perl Foundation.
   3  *  SVN Info
   4  *     $Id$
   5  *  Overview:
   6  *     These are the vtable functions for the TclInt base class
   7  *  Data Structure and Algorithms:
   8  *  History:
   9  *  References:
  10  */
  11
  12 #include "parrot/embed.h"
  13
  14 pmclass TclInt
  15     dynpmc
  16     extends TclObject
  17     extends Integer
  18     does    integer
  19     group   tcl_group
  20     hll     Tcl
  21     maps    Integer
  22 {
  23
  24     void assign_pmc(PMC* value) {
  25         STRING * const undef = string_from_cstring(INTERP, "Undef", 5);
  26
  27         if (VTABLE_isa(INTERP, value, undef))
  28             pmc_reuse(INTERP, SELF, value->vtable->base_type, 0);
  29         else
  30             SELF.set_integer_native(VTABLE_get_integer(INTERP, value));
  31     }
  32
  33
  34     /*
  35      * MMD Override:
  36      *   TclInt shouldn't automatically promote division to float.
  37      */
  38     PMC* divide(PMC* value, PMC* dest) {
  39       MMD_TclInt: {
  40         INTVAL n = PMC_int_val(SELF);
  41         INTVAL d = PMC_int_val(value);
  42
  43         if (d == 0)
  44             real_exception(INTERP, NULL, E_ZeroDivisionError, "divide by zero");
  45
  46         if (!dest)
  47             dest = pmc_new(INTERP, SELF->vtable->base_type);
  48
  49         VTABLE_set_integer_native(INTERP, dest, n / d);
  50         return dest;
  51       }
  52       MMD_DEFAULT: {
  53         FLOATVAL d = VTABLE_get_number(INTERP, value);
  54
  55         if (d == 0.0)
  56             real_exception(INTERP, NULL, E_ZeroDivisionError,
  57                            "float division by zero");
  58
  59         if (!dest)
  60             dest = pmc_new(INTERP, SELF->vtable->base_type);
  61         VTABLE_set_number_native(INTERP, dest, SELF.get_number() / d);
  62         return dest;
  63       }
  64     }
  65
  66 }
  67
  68 /*
  69  * Local variables:
  70  *   c-file-style: "parrot"
  71  * End:
  72  * vim: expandtab shiftwidth=4:
  73  */