/* Pointer.pmc
 *  Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
 *  CVS Info
 *     $Id: pointer.pmc,v 1.12 2003/08/28 13:17:01 leo Exp $
 *  Overview:
 *     These are the vtable functions for the Pointer base class
 *  Data Structure and Algorithms:
 *  History:
 *  Notes:  The actual pointer is in PMC_data
 *  References:
 */

#include "parrot/parrot.h"
#define POINTER_ERROR internal_exception(PARROT_POINTER_ERROR, "An illegal operation was performed on a Pointer (vtable function at %s line %d).\n", __FILE__, __LINE__);

pmclass Pointer need_ext {

    void init () {
        PObj_custom_mark_SET(SELF);
    }

    void morph (INTVAL type) {
    }

    void mark () {
        void (*mark_function)(struct Parrot_Interp*, void*) =
            (void (*)(struct Parrot_Interp*, void*))
	    	D2FPTR(SELF->cache.struct_val);
        if (PMC_data(SELF) == NULL)
		return;
        if (SELF->cache.struct_val == NULL)
		return;
        (*mark_function)(INTERP, PMC_data(SELF));
    }

    void clone (PMC *dest) {
        PObj_custom_mark_SET(dest);
        PMC_data(dest) = PMC_data(SELF);
    }

    INTVAL get_integer () {
        return (INTVAL)PMC_data(SELF);
    }

    FLOATVAL get_number () {
        return (FLOATVAL)(INTVAL)PMC_data(SELF);
    }

    STRING* get_string () {
        STRING* ret;
        char *target=mem_sys_allocate(64);

        /* XXX Dangerous if you have a 196-bit system or above
        (and if you do, you have too comfortable a life and
        deserve to be tormented by coredumps). */
        sprintf(target, "Pointer=0x%p", PMC_data(SELF));
        ret=string_make(interpreter, target, strlen(target), 0, 0, 0);

        mem_sys_free(target);
        return ret;
    }

    INTVAL get_bool () {
        return (INTVAL)(PMC_data(SELF) != NULL);
    }

    INTVAL is_same (PMC* pmc2) {
        return (INTVAL)(SELF->vtable == pmc2->vtable &&
		PMC_data(SELF) == PMC_data(pmc2));
    }

    void set_integer (PMC* value) {
        POINTER_ERROR;
    }

    void set_integer_native (INTVAL value) {
        POINTER_ERROR;
    }

    void set_integer_same (PMC* value) {
        POINTER_ERROR;
    }

    void set_number (PMC* value) {
        POINTER_ERROR;
    }

    void set_number_native (FLOATVAL value) {
        POINTER_ERROR;
    }

    void set_number_same (PMC* value) {
        POINTER_ERROR;
    }

    void set_string (PMC* value) {
        POINTER_ERROR;
    }

    void set_string_native (STRING* value) {
        POINTER_ERROR;
    }

    void set_string_same (PMC* value) {
        POINTER_ERROR;
    }
}
