/* perlint.pmc
 *  Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
 *  CVS Info
 *     $Id: perlint.pmc,v 1.50 2003/10/23 08:08:15 leo Exp $
 *  Overview:
 *     These are the vtable functions for the PerlInt base class
 *  Data Structure and Algorithms:
 *  History:
 *  Notes:
 *  References:
 */

#include "parrot/parrot.h"
#include "parrot/perltypes.h"

pmclass PerlInt extends perlscalar {

    void init () {
        SELF->cache.int_val = 0;
    }

    FLOATVAL get_number () {
        return (FLOATVAL)SELF->cache.int_val;
    }

    BIGNUM* get_bignum () {
        /* XXX */
        return NULL;
    }

    STRING* get_string () {
        return string_from_int(INTERP, SELF->cache.int_val);
    }


    void set_integer_same (PMC * value) {
        SELF->cache.int_val = value->cache.int_val;
    }

    void set_number (PMC* value) {
	DYNSELF.morph(enum_class_PerlNum);
        DYNSELF.set_number(value);
    }

    void set_number_native (FLOATVAL value) {
	DYNSELF.morph(enum_class_PerlNum);
        DYNSELF.set_number_native(value);
    }

    void set_bignum (PMC* value) {
        /* XXX not sure if this can be optimized further safely */
        SELF->cache.struct_val = (DPOINTER*)VTABLE_get_bignum(INTERP, value);
	/* SELF->vtable = Parrot_base_vtables[enum_class_PerlBigNum]; */
    }

    void set_bignum_native (BIGNUM* value) {
        /* XXX Some of this bignum stuff is starting to look pretty redundant -DML */
        SELF->cache.struct_val = value; /* Maybe we need a copy */
        /* SELF->vtable = Parrot_base_vtables[enum_class_PerlBignum]; */
    }

    void set_string (PMC* value) {
	DYNSELF.morph(enum_class_PerlString);
        DYNSELF.set_string(value);
    }

    void set_string_native (STRING* value) {
	DYNSELF.morph(enum_class_PerlString);
        DYNSELF.set_string_native(value);
    }

    void add (PMC* value, PMC* dest) {
        INTVAL pmci;
	int vtype = VTABLE_type(INTERP, value);
	FLOATVAL valf;
	FLOATVAL sumf;

	pmci = SELF->cache.int_val;
	if (vtype == enum_class_PerlUndef) {
            VTABLE_set_integer_native(INTERP, dest, pmci);
	    return;
	}

	valf = VTABLE_get_number(INTERP, value);
	sumf = pmci + valf;
	if (vtype == enum_class_PerlNum) {
            VTABLE_set_number_native(INTERP, dest, sumf);
	    return;
	}
	{
	    INTVAL vali = (INTVAL) valf;
	    INTVAL   sumi = pmci + vali;
	    if (sumf == sumi)
		VTABLE_set_integer_native(INTERP, dest, sumi);
	    else {
		/* TODO BIG* promotion */
		VTABLE_set_number_native(INTERP, dest, sumf);
	    }
	    return;

	}
    }

    void add_same (PMC* value, PMC* dest) {
        dest->cache.int_val = SELF->cache.int_val + value->cache.int_val;
    }

    void subtract (PMC* value, PMC* dest) {
        INTVAL pmci;
	int vtype = VTABLE_type(INTERP, value);
	FLOATVAL valf;
	FLOATVAL diff;

	pmci = SELF->cache.int_val;
	if (vtype == enum_class_PerlUndef) {
            VTABLE_set_integer_native(INTERP, dest, pmci);
	    return;
	}

	valf = VTABLE_get_number(INTERP, value);
	diff = pmci - valf;
	if (vtype == enum_class_PerlNum) {
            VTABLE_set_number_native(INTERP, dest, diff);
	    return;
	}
	{
	    INTVAL vali = (INTVAL) valf;
	    INTVAL   difi = pmci - vali;
	    if (diff == difi)
		VTABLE_set_integer_native(INTERP, dest, difi);
	    else {
		/* TODO BIG* promotion */
		VTABLE_set_number_native(INTERP, dest, diff);
	    }
	    return;

	}
    }

    void subtract_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val - value
        );
    }

    void subtract_same (PMC* value, PMC* dest) {
        dest->cache.int_val = SELF->cache.int_val - value->cache.int_val;
    }

    void multiply (PMC* value, PMC* dest) {
        INTVAL pmci;
	int vtype = VTABLE_type(INTERP, value);
	FLOATVAL valf;
	FLOATVAL mulf;

	pmci = SELF->cache.int_val;
	if (vtype == enum_class_PerlUndef) {
            VTABLE_set_integer_native(INTERP, dest, 0);
	    return;
	}

	valf = VTABLE_get_number(INTERP, value);
	mulf = pmci * valf;
	if (vtype == enum_class_PerlNum) {
            VTABLE_set_number_native(INTERP, dest, mulf);
	    return;
	}
	{
	    INTVAL vali = (INTVAL) valf;
	    INTVAL   muli = pmci * vali;
	    if (mulf == muli)
		VTABLE_set_integer_native(INTERP, dest, muli);
	    else {
		/* TODO BIG* promotion */
		VTABLE_set_number_native(INTERP, dest, mulf);
	    }
	    return;

	}
    }

    void multiply_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val * value
        );
    }

    void multiply_same (PMC* value, PMC* dest) {
        dest->cache.int_val = SELF->cache.int_val * value->cache.int_val;
    }

    void divide (PMC* value, PMC* dest) {
        INTVAL pmci;
	int vtype = VTABLE_type(INTERP, value);
	FLOATVAL valf;
	FLOATVAL divf;

        /* TODO: Is this the appropriate way to throw the exception? */

	pmci = SELF->cache.int_val;
	if (vtype == enum_class_PerlUndef) {
            internal_exception(DIV_BY_ZERO, "division by zero!\n");
	    return;
	}

	valf = VTABLE_get_number(INTERP, value);
        if (valf == 0.0) {
            internal_exception(DIV_BY_ZERO, "division by zero!\n");
	    return;
	}

	divf = pmci / valf;
	if (vtype == enum_class_PerlNum) {
            VTABLE_set_number_native(INTERP, dest, divf);
	    return;
	}
	{
	    INTVAL vali = (INTVAL) valf;
	    INTVAL   divi = pmci / vali;
	    /* if result is an integer or zero yield an integer */
	    if (divf == divi || !pmci)
		VTABLE_set_integer_native(INTERP, dest, divi);
	    else {
		/* TODO BIG* promotion */
		VTABLE_set_number_native(INTERP, dest, divf);
	    }
	    return;

	}
    }

    void divide_int (INTVAL value, PMC* dest) {
	INTVAL pmci, divi;
	FLOATVAL valf, divf;

	pmci = SELF->cache.int_val;
	/* TODO exception */
	divf = (FLOATVAL)pmci / value;
	divi = pmci / value;
	if (divf == divi || !pmci)
	    VTABLE_set_integer_native(INTERP, dest, divi);
	else {
	    /* TODO BIG* promotion */
	    VTABLE_set_number_native(INTERP, dest, divf);
	}
    }

    void divide_same (PMC* value, PMC* dest) {
        SELF.divide_int(value->cache.int_val, dest);
    }

    void cmodulus (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
                                  SELF->cache.int_val %
                                  VTABLE_get_integer(INTERP, value));
    }

    void cmodulus_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val % value);
    }

    void modulus (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
		intval_mod(SELF->cache.int_val,
		    VTABLE_get_integer(INTERP, value)));
    }

    void modulus_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
		intval_mod(SELF->cache.int_val, value));
    }

    void modulus_same (PMC* value, PMC* dest) {
        dest->cache.int_val = SELF->cache.int_val % value->cache.int_val;
    }

    void neg (PMC* dest) {
	if (!dest)
	    SELF->cache.int_val = -SELF->cache.int_val;
	else
	    VTABLE_set_integer_native(INTERP, dest, -SELF->cache.int_val);
    }

    void bitwise_or (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val |
            VTABLE_get_integer(INTERP, value)
        );
    }

    void bitwise_or_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val | value
        );
    }

    void bitwise_or_same (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val |
            value->cache.int_val
        );
    }

    void bitwise_and (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val &
            VTABLE_get_integer(INTERP, value)
        );
    }

    void bitwise_and_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val & value
        );
    }

    void bitwise_and_same (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val &
            value->cache.int_val
        );
    }

    void bitwise_xor (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val ^
            VTABLE_get_integer(INTERP, value)
        );
    }

    void bitwise_xor_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val ^ value
        );
    }

    void bitwise_xor_same (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val ^
            value->cache.int_val
        );
    }

    void bitwise_not (PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest, ~SELF->cache.int_val);
    }

    void bitwise_shr (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val >>
            VTABLE_get_integer(INTERP, value)
        );
    }

    void bitwise_shr_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val >> value
        );
    }

    void bitwise_shr_same (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val >> value->cache.int_val
        );
    }

    void bitwise_shl (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val <<
            VTABLE_get_integer(INTERP, value)
        );
    }

    void bitwise_shl_int (INTVAL value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val << value
        );
    }

    void bitwise_shl_same (PMC* value, PMC* dest) {
        VTABLE_set_integer_native(INTERP, dest,
            SELF->cache.int_val << value->cache.int_val
        );
    }


    /* == operation */
    INTVAL is_equal (PMC* value) {
        return (INTVAL)(SELF->cache.int_val ==
	VTABLE_get_integer(INTERP, value));
    }

    INTVAL cmp(PMC* value) {
	if (value->vtable == Parrot_base_vtables[enum_class_PerlString]) {
	    FLOATVAL fdiff = SELF->cache.int_val
		- VTABLE_get_number(INTERP, value);
	    if (fdiff == 0) {
		INTVAL idiff = SELF->cache.int_val
		    - VTABLE_get_integer(INTERP, value);
		return idiff > 0 ? 1 : idiff < 0 ? -1 : 0;
	    } else {
		return fdiff > 0 ? 1 : -1;
	    }
	}
	else if (value->vtable == Parrot_base_vtables[enum_class_PerlNum]) {
	    FLOATVAL diff;
	    diff = (FLOATVAL)SELF->cache.int_val
		- VTABLE_get_number(INTERP, value);
	    return diff > 0 ? 1 : diff < 0 ? -1 : 0;
	}
	else {
	    /* int or undef */
	    INTVAL diff = SELF->cache.int_val
		- VTABLE_get_integer(INTERP, value);
	    return diff > 0 ? 1 : diff < 0 ? -1 : 0;
	}
    }

    INTVAL cmp_num(PMC* value) {
	if (value->vtable == Parrot_base_vtables[enum_class_PerlString]) {
	    FLOATVAL fdiff = SELF->cache.int_val
		- VTABLE_get_number(INTERP, value);
	    if (fdiff == 0) {
		INTVAL idiff = SELF->cache.int_val
		    - VTABLE_get_integer(INTERP, value);
		return idiff > 0 ? 1 : idiff < 0 ? -1 : 0;
	    } else {
		return fdiff > 0 ? 1 : -1;
	    }
	}
	else if (value->vtable == Parrot_base_vtables[enum_class_PerlNum]) {
	    FLOATVAL diff;
	    diff = (FLOATVAL)SELF->cache.int_val
		- VTABLE_get_number(INTERP, value);
	    return diff > 0 ? 1 : diff < 0 ? -1 : 0;
	}
	else {
	    /* int or undef */
	    INTVAL diff = SELF->cache.int_val
		- VTABLE_get_integer(INTERP, value);
	    return diff > 0 ? 1 : diff < 0 ? -1 : 0;
	}
    }


    void logical_not (PMC* value) {
	    VTABLE_set_integer_native(INTERP, value,
	    !SELF->cache.int_val);
    }

    void repeat (PMC* value, PMC* dest) {
	internal_exception(INVALID_OPERATION,
		"repeat() not implemented in class 'PerlInt'\n");
    }

    void repeat_int (INTVAL value, PMC* dest) {
	internal_exception(INVALID_OPERATION,
		"repeat() not implemented in class 'PerlInt'\n");
    }

    void increment () {
        SELF->cache.int_val ++;
    }

    void decrement () {
        SELF->cache.int_val --;
    }

}
