/* sarray.pmc
 *  Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
 *  CVS Info
 *     $Id: sarray.pmc,v 1.18 2003/10/05 13:49:26 leo Exp $
 *  Overview:
 *     These are the vtable functions for the SArray base class
 *  Data Structure and Algorithms:
 *     SArray data are kept in an malloced array of HASH_ENTRY's
 *     entry 0 = start_idx (for shift)
 *     entry 1 = end_idx   (for push)
 *     entry 2... data
 *  History:
 *     Initial version 2003.07.04 by leo
 *  Notes:
 *     This is the Simple (or Static) Array class for parameter
 *     passing according to pdd03.
 *     - SArrays are fixed size, implying:
 *     - The first operation on it must be setting its size.
 *     - only the most important vtable meths are implemented
 *  References:
 *     docs/pdds/pdd03_calling_conventions.pod
 */

#include "parrot/parrot.h"

pmclass SArray const_too need_ext does array {
    void init () {
	SELF->cache.int_val = 0;
        PMC_data(SELF) = NULL;
    }

    void morph(INTVAL type) { /* Const classes must have a morph */
	SUPER(type);
    }

    void mark () {
	HASH_ENTRY *e;
	int i, start, end;
	if (!PMC_data(SELF))
	    return;
	e = (HASH_ENTRY *) PMC_data(SELF);
	start = e[0].val.int_val;
	end = e[1].val.int_val;
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + start);
	for (i = start; i < end; i++, e++) {
	    switch (e->type) {
		case enum_hash_string:
		    if (e->val.string_val)
			pobject_lives(INTERP, (PObj *)e->val.string_val);
		    break;
		case enum_hash_pmc:
		    if (e->val.pmc_val)
			pobject_lives(INTERP, (PObj *)e->val.pmc_val);
		    break;
		default:
		    break;
	    }
	}
    }

    void destroy () {
        if (PMC_data(SELF))
            mem_sys_free(PMC_data(SELF));
	PMC_data(SELF) = NULL;
    }

    void clone (PMC *dest) {
	HASH_ENTRY *e, *d;
	int i, start, end;
	INTVAL size;
	PMC * np;

	if (!PMC_data(SELF))
	    return;
	size = SELF->cache.int_val;
	dest->cache.int_val = size;
	PMC_data(dest) = mem_sys_allocate_zeroed((2 + size) *
		sizeof(HASH_ENTRY));
	e = (HASH_ENTRY *) PMC_data(SELF);
	d = (HASH_ENTRY *) PMC_data(dest);
	start = e[0].val.int_val;
	end = e[1].val.int_val;
	d[0].val.int_val = start;
	d[1].val.int_val = end;
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + start);
	d = (HASH_ENTRY *) PMC_data(dest) + (2 + start);
	for (i = start; i < end; i++, e++, d++) {
	    d->type = e->type;
	    switch (e->type) {
		case enum_hash_int:
		    d->val.int_val = e->val.int_val;
		    break;
		case enum_hash_num:
		    d->val.num_val = e->val.num_val;
		    break;
		case enum_hash_string:
		    d->val.string_val = string_copy(INTERP, e->val.string_val);
		    break;
		case enum_hash_pmc:
		    np = pmc_new_noinit(interpreter,
			    e->val.pmc_val->vtable->base_type);
		    d->val.pmc_val = np;
		    VTABLE_clone(INTERP, e->val.pmc_val, np);
		    break;
		default:
		    break;
	    }
	}
	PObj_custom_mark_destroy_SETALL(dest);
    }

    INTVAL get_bool () {
        INTVAL size = DYNSELF.elements();
        return (INTVAL)(size != 0);
    }

    INTVAL elements () {
	HASH_ENTRY *e;
	if (!PMC_data(SELF))
	    return 0;
	e = (HASH_ENTRY *) PMC_data(SELF);
        return e[1].val.int_val - e[0].val.int_val;
    }

    INTVAL get_integer () {
        return DYNSELF.elements();
    }

    INTVAL type_keyed_int (INTVAL key) {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (key < 0) {
	    key += end_index;
	}
        key += start_index;   /* lower bound if already shifted */
	if (key < start_index || key >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	return e->type;
    }

    INTVAL get_integer_keyed_int (INTVAL key) {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (key < 0) {
	    key += end_index;
	}
        key += start_index;   /* lower bound if already shifted */
	if (key < start_index || key >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	if (e->type != enum_hash_int)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not an integer!\n");
        return e->val.int_val;
    }

    INTVAL get_integer_keyed (PMC* key) {
	/* simple int keys only */
	INTVAL k = key_integer(INTERP, key);
	return SELF.get_integer_keyed_int(k);
    }

    INTVAL shift_integer() {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        HASH_ENTRY *ret;
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (start_index >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");

	ret = (HASH_ENTRY *) PMC_data(SELF) + (2 + start_index++);

        /* Update the starting index */
        e[0].val.int_val = start_index;

	if (ret->type != enum_hash_int)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not an integer!\n");
        return ret->val.int_val;
    }

    FLOATVAL get_number_keyed_int (INTVAL key) {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (key < 0) {
	    key += end_index;
	}
        key += start_index;
	if (key < start_index || key >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	if (e->type != enum_hash_num)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not a num!\n");
        return e->val.num_val;
    }

    FLOATVAL get_number_keyed (PMC* key) {
	INTVAL k = key_integer(INTERP, key);
	return SELF.get_number_keyed_int(k);
    }

    FLOATVAL shift_float() {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        HASH_ENTRY *ret;
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (start_index >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");

	ret = (HASH_ENTRY *) PMC_data(SELF) + (2 + start_index++);

        /* Update the starting index */
        e[0].val.int_val = start_index;

	if (ret->type != enum_hash_num)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not a num!\n");
        return ret->val.num_val;
    }

    STRING* get_string_keyed_int (INTVAL key) {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (key < 0) {
	    key += end_index;
	}
        key += start_index;
	if (key < start_index || key >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	if (e->type != enum_hash_string)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not a string!\n");
        return e->val.string_val;
    }

    STRING* get_string_keyed(PMC* key) {
	INTVAL k = key_integer(INTERP, key);
	return SELF.get_string_keyed_int(k);
    }

    STRING* shift_string() {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        HASH_ENTRY *ret;
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (start_index >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");

	ret = (HASH_ENTRY *) PMC_data(SELF) + (2 + start_index++);

        /* Update the starting index */
        e[0].val.int_val = start_index;

	if (ret->type != enum_hash_string)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not a string!\n");
        return ret->val.string_val;
    }

    PMC* get_pmc_keyed_int (INTVAL key) {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
	PMC *ret;
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (key < 0) {
	    key += end_index;
	}
        key += start_index;
	if (key < start_index || key >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	switch (e->type) {
	    case enum_hash_int:
		ret = pmc_new(INTERP, enum_class_PerlUndef);
		VTABLE_set_integer_native(INTERP, ret, e->val.int_val);
		return ret;
	    case enum_hash_num:
		ret = pmc_new(INTERP, enum_class_PerlUndef);
		VTABLE_set_number_native(INTERP, ret, e->val.num_val);
		return ret;
	    case enum_hash_string:
		ret = pmc_new(INTERP, enum_class_PerlUndef);
		VTABLE_set_string_native(INTERP, ret, e->val.string_val);
		return ret;
	    case enum_hash_pmc:
		return e->val.pmc_val;
	    default:
		internal_exception(OUT_OF_BOUNDS, "SArray: Not a pmc!\n");
	}
	return NULL;
    }

    PMC* get_pmc_keyed(PMC* key) {
	INTVAL k = key_integer(INTERP, key);
	return SELF.get_pmc_keyed_int(k);
    }

    PMC* shift_pmc() {
        HASH_ENTRY *e = (HASH_ENTRY *) PMC_data(SELF);
        HASH_ENTRY *ret;
        INTVAL start_index = e[0].val.int_val;
        INTVAL end_index   = e[1].val.int_val;

	if (start_index >= end_index)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");

	ret = (HASH_ENTRY *) PMC_data(SELF) + (2 + start_index++);

        /* Update the starting index */
        e[0].val.int_val = start_index;

	if (ret->type != enum_hash_pmc)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Not a pmc!\n");
        return ret->val.pmc_val;
    }

    void set_integer (PMC* value) {
        INTVAL size = VTABLE_get_integer(INTERP,value);
        SELF.set_integer_native(size);
    }

    void set_integer_native (INTVAL size) {
	if (SELF->cache.int_val)
	    internal_exception(OUT_OF_BOUNDS, "SArray: Can't resize!\n");
	SELF->cache.int_val = size;
	PMC_data(SELF) = mem_sys_allocate_zeroed((2 + size) *
		sizeof(HASH_ENTRY));
	PObj_custom_mark_destroy_SETALL(SELF);
    }

    void set_integer_keyed_int (INTVAL key, INTVAL value) {
        HASH_ENTRY *e;
	if (key < 0 || key >= SELF->cache.int_val)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	e->type = enum_hash_int;
	e->val.int_val = value;
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	if (key >= e->val.int_val)
	    e->val.int_val = key + 1;
    }

    void push_integer (INTVAL value) {
	HASH_ENTRY *e;
	INTVAL nextix;
	if (!PMC_data(SELF))
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	nextix = e->val.int_val;
	DYNSELF.set_integer_keyed_int(nextix, value);
    }

    void set_number_keyed_int (INTVAL key, FLOATVAL value) {
        HASH_ENTRY *e;
	if (key < 0 || key >= SELF->cache.int_val)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	e->type = enum_hash_num;
	e->val.num_val = value;
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	if (key >= e->val.int_val)
	    e->val.int_val = key + 1;
    }

    void push_float (FLOATVAL value) {
        HASH_ENTRY *e;
	INTVAL nextix;
	if (!PMC_data(SELF))
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	nextix = e->val.int_val;
        DYNSELF.set_number_keyed_int(nextix, value);
    }

    void set_string_keyed_int (INTVAL key, STRING* value) {
        HASH_ENTRY *e;
	if (key < 0 || key >= SELF->cache.int_val)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	e->type = enum_hash_string;
	e->val.string_val = value;
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	if (key >= e->val.int_val)
	    e->val.int_val = key + 1;
    }

    void push_string (STRING* value) {
        HASH_ENTRY *e;
	INTVAL nextix;
	if (!PMC_data(SELF))
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	nextix = e->val.int_val;
        DYNSELF.set_string_keyed_int(nextix, value);
    }

    void set_pmc_keyed_int (INTVAL key, PMC* src) {
        HASH_ENTRY *e;
	if (key < 0 || key >= SELF->cache.int_val)
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + (2 + key);
	e->type = enum_hash_pmc;
	e->val.pmc_val = src;
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	if (key >= e->val.int_val)
	    e->val.int_val = key + 1;
    }

    void push_pmc (PMC* value) {

        HASH_ENTRY *e;
	INTVAL nextix;
	if (!PMC_data(SELF))
	    internal_exception(OUT_OF_BOUNDS, "SArray index out of bounds!\n");
	e = (HASH_ENTRY *) PMC_data(SELF) + 1;
	nextix = e->val.int_val;
        DYNSELF.set_pmc_keyed_int(nextix, value);
    }

    PMC* nextkey_keyed (PMC* key, INTVAL what) {
	PMC *ret = key;
        HASH_ENTRY *e;
	INTVAL n = SELF.elements();
        INTVAL start_index, end_index;

	PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
	PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
	if (!n) {
	    ret->cache.int_val = -1;
	    return ret;
	}
	e = (HASH_ENTRY *) PMC_data(SELF);
        start_index = e[0].val.int_val;
        end_index   = e[1].val.int_val;

	switch (what) {
	    case ITERATE_FROM_START:	/* reset key, iterate from start */
		ret->cache.int_val = start_index;
		break;
	    case ITERATE_GET_NEXT:
		if (ret->cache.int_val < end_index - 1)
		    ++ret->cache.int_val;
		else
		    ret->cache.int_val = -1;
		break;
	    case ITERATE_GET_PREV:
		if (ret->cache.int_val >= start_index)
		    --ret->cache.int_val;
		else
		    ret->cache.int_val = -1;
		break;
	    case ITERATE_FROM_END:
		ret->cache.int_val = end_index - 1;
		break;
	}
	return ret;
    }
}

