/*
Copyright (C) 2001-2006, The Perl Foundation.
$Id: sarray.pmc 16275 2006-12-28 01:20:44Z particle $

=head1 NAME

src/pmc/sarray.pmc - Simple Array or Subroutine Parameter Array

=head1 DESCRIPTION

Simple Array or Subroutine Parameter Array PMC.
SArray data are kept in an malloced array of C<HashEntry>'s:

=over 4

=item 0 C<start_idx>

First index, for C<shift>.

=item 1 C<end_idx>

Last index, for C<push>.

=item 2...

Data.

=back

SArrays are fixed size, implying that the first operation on it must be
setting its size, and that only the most important vtable methods are
implemented.

Currently SArray's are used for:

=over 4

=item Global data per interpreter

=item For implementing lists, see F<src/list.c>.

=item Base class of the Exception PMC, see F<src/exception.pmc>

=back

=head2 Functions

=over 4

=cut

*/

#include "parrot/parrot.h"

/*

=item C<static PARROT_INLINE INTVAL
ret_int(Interp* interp, HashEntry *e)>

Processes C<*e>, returning the appropriate integer, or raising an
exception if necessary.

=cut

*/

static PARROT_INLINE INTVAL
ret_int(Interp* interp, HashEntry *e)
{
    switch (e->type) {
    case enum_hash_int:
        return UVal_int(e->val);
    case enum_hash_pmc:
        return VTABLE_get_integer(interp, UVal_pmc(e->val));
    default:
        break;
    }
    real_exception(interp, NULL, E_IndexError,
            "SArray: Entry not an integer!");
    return 0;
}

/*

=item C<static PARROT_INLINE FLOATVAL
ret_num(Interp* interp, HashEntry *e)>

Processes C<*e>, returning the appropriate floating-point number, or
raising an exception if necessary.

=cut

*/

static PARROT_INLINE FLOATVAL
ret_num(Interp* interp, HashEntry *e)
{
    switch (e->type) {
        case enum_hash_num:
            return UVal_num(e->val);
        case enum_hash_pmc:
            return VTABLE_get_number(interp, UVal_pmc(e->val));
        default:
            break;
    }
    real_exception(interp, NULL, E_IndexError,
            "SArray: Entry not a number!");
    return 0;
}

/*

=item C<static PARROT_INLINE STRING *
ret_string(Interp* interp, HashEntry *e)>

Processes C<*e>, returning the appropriate Parrot string, or raising an
exception if necessary.

=cut

*/

static PARROT_INLINE STRING*
ret_string(Interp* interp, HashEntry *e)
{
    switch (e->type) {
        case enum_hash_string:
            return UVal_str(e->val);
        case enum_hash_pmc:
            return VTABLE_get_string(interp, UVal_pmc(e->val));
        default:
            break;
    }
    real_exception(interp, NULL, E_IndexError,
            "SArray: Entry not a string!");
    return 0;
}

/*

=item C<static PARROT_INLINE PMC *
ret_pmc(Interp* interp, HashEntry *e)>

Processes C<*e>, returning the appropriate PMC, or raising an exception
if necessary.

=cut

*/

static PARROT_INLINE PMC*
ret_pmc(Interp* interp, HashEntry *e)
{
    PMC *ret;
    switch (e->type) {
        case enum_hash_int:
            ret = pmc_new(interp, enum_class_Undef);
            VTABLE_set_integer_native(interp, ret, UVal_int(e->val));
            return ret;
        case enum_hash_num:
            ret = pmc_new(interp, enum_class_Undef);
            VTABLE_set_number_native(interp, ret, UVal_num(e->val));
            return ret;
        case enum_hash_string:
            ret = pmc_new(interp, enum_class_Undef);
            VTABLE_set_string_native(interp, ret, UVal_str(e->val));
            return ret;
        case enum_hash_pmc:
            return UVal_pmc(e->val);
        default:
            real_exception(interp, NULL, E_IndexError,
                    "SArray: Unknown entry!");
    }
    return NULL;
}

/*

=item C<static PARROT_INLINE HashEntry *
shift_entry(PMC *self)>

Removes and returns the first element from the array.

=cut

*/

static PARROT_INLINE HashEntry *
shift_entry(PMC *self)
{
    HashEntry *e = (HashEntry *) PMC_data(self);
    HashEntry *ret;
    INTVAL start_index = UVal_int(e[0].val);
    INTVAL end_index   = UVal_int(e[1].val);

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

    ret = (HashEntry *) PMC_data(self) + (2 + start_index++);

    /* Update the starting index */
    UVal_int(e[0].val) = start_index;
    return ret;
}

/*

=item C<static PARROT_INLINE HashEntry *
get_entry(PMC *self, INTVAL key)>

Returns the element for index C<key>.

=cut

*/

static PARROT_INLINE HashEntry*
get_entry(PMC *self, INTVAL key)
{
    HashEntry *e = (HashEntry *) PMC_data(self);
    INTVAL start_index = UVal_int(e[0].val);
    INTVAL end_index   = UVal_int(e[1].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!");
    e = (HashEntry *) PMC_data(self) + (2 + key);
    return e;
}

pmclass SArray const_too need_ext does array {

/*

=back

=head2 Methods

=over 4

=item C<void init()>

Initializes the array.

=cut

*/

    void init() {
        PMC_int_val(SELF) = 0;
        PMC_data(SELF) = NULL;
    }

/*

=item C<void morph(INTVAL type)>

Const PMCs must have a C<morph()>.

=cut

*/

    void morph(INTVAL type) {
        SUPER(type);
    }

/*

=item C<void mark()>

Marks the array as live.

=cut

*/

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

/*

=item C<void destroy()>

Destroys the array.

=cut

*/

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

/*

=item C<PMC *clone()>

Creates and returns a copy of the array.

=cut

*/

    PMC* clone() {
        HashEntry *e, *d;
        int i, start, end;
        INTVAL size;
        PMC * dest = pmc_new(INTERP, SELF->vtable->base_type);

        if (!PMC_data(SELF))
            return dest;
        size = PMC_int_val(SELF);
        PMC_int_val(dest) = size;
        PMC_data(dest) = mem_sys_allocate_zeroed((2 + size) *
            sizeof (HashEntry));
        e = (HashEntry *) PMC_data(SELF);
        d = (HashEntry *) PMC_data(dest);
        start = UVal_int(e[0].val);
        end   = UVal_int(e[1].val);
        UVal_int(d[0].val) = start;
        UVal_int(d[1].val) = end;
        e = (HashEntry *) PMC_data(SELF) + (2 + start);
        d = (HashEntry *) PMC_data(dest) + (2 + start);
        for (i = start; i < end; i++, e++, d++) {
            d->type = e->type;
            switch (e->type) {
                case enum_hash_int:
                    UVal_int(d->val) = UVal_int(e->val);
                    break;
                case enum_hash_num:
                    UVal_num(d->val) = UVal_num(e->val);
                    break;
                case enum_hash_string:
                    UVal_str(d->val) = string_copy(INTERP, UVal_str(e->val));
                    break;
                case enum_hash_pmc:
                    UVal_pmc(d->val) = VTABLE_clone(INTERP, UVal_pmc(e->val));
                    break;
                default:
                    break;
            }
        }
        PObj_custom_mark_destroy_SETALL(dest);
        return dest;
    }

/*

=item C<INTVAL get_bool()>

Returns whether the array has any elements.

=cut

*/

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

/*

=item C<INTVAL elements()>

=cut

*/

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

/*

=item C<INTVAL get_integer()>

Returns the number of elements in the array.

=cut

*/

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

/*

=item C<INTVAL type_keyed_int(INTVAL key)>

Returns the type of the element at index C<key>.

=cut

*/

    INTVAL type_keyed_int(INTVAL key) {
        HashEntry *e = get_entry(SELF, key);
        return e->type;
    }

/*

=item C<INTVAL get_integer_keyed_int(INTVAL key)>

Returns the integer value of the element at index C<key>.

=cut

*/

    INTVAL get_integer_keyed_int(INTVAL key) {
        HashEntry *e = get_entry(SELF, key);
        return ret_int(INTERP, e);
    }

/*

=item C<INTVAL get_integer_keyed(PMC *key)>

Returns the integer value of the element at index C<*key>.

=cut

*/

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

/*

=item C<INTVAL shift_integer()>

Removes the first element from the array and returns its integer value.

=cut

*/

    INTVAL shift_integer() {
        HashEntry *ret = shift_entry(SELF);
        return ret_int(INTERP, ret);
    }

/*

=item C<FLOATVAL get_number_keyed_int(INTVAL key)>

Returns the floating-point value of the element at index C<key>.

=cut

*/

    FLOATVAL get_number_keyed_int(INTVAL key) {
        HashEntry *e = get_entry(SELF, key);
        return ret_num(INTERP, e);
    }

/*

=item C<FLOATVAL get_number_keyed(PMC* key)>

Returns the floating-point value of the element at index C<*key>.

=cut

*/

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

/*

=item C<FLOATVAL shift_float()>

Removes the first element from the array and returns its floating-point
value.

=cut

*/

    FLOATVAL shift_float() {
        HashEntry *ret = shift_entry(SELF);
        return ret_num(INTERP, ret);
    }

/*

=item C<STRING *get_string_keyed_int(INTVAL key)>

Returns the Parrot string value of the element at index C<key>.

=cut

*/

    STRING* get_string_keyed_int(INTVAL key) {
        HashEntry *e = get_entry(SELF, key);
        return ret_string(INTERP, e);
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the Parrot string value of the element at index C<*key>.

=cut

*/

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

/*

=item C<STRING* shift_string()>

Removes the first element from the array and returns its Parrot string
value.

=cut

*/

    STRING* shift_string() {
        HashEntry *ret = shift_entry(SELF);
        return ret_string(INTERP, ret);
    }

/*

=item C<PMC *get_pmc_keyed_int(INTVAL key)>

Returns the PMC value of the element at index C<key>.

=cut

*/

    PMC* get_pmc_keyed_int(INTVAL key) {
        HashEntry *e = get_entry(SELF, key);
        return ret_pmc(INTERP, e);
    }

/*

=item C<PMC *get_pmc_keyed(PMC *key)>

Returns the PMC value of the element at index C<*key>.

=cut

*/

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

/*

=item C<PMC* shift_pmc()>

Removes the first element from the array and returns its PMC value.

=cut

*/

    PMC* shift_pmc() {
        HashEntry *ret = shift_entry(SELF);
        return ret_pmc(INTERP, ret);
    }

/*

=item C<void set_integer_native(INTVAL size)>

Resizes the array to C<size> elements.

=cut

*/

    void set_integer_native(INTVAL size) {
        if (PMC_int_val(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray: Can't resize!");
        PMC_int_val(SELF) = size;
        /* Probably ought to actually copy this... */
        if (PMC_data(SELF)) {
          mem_sys_free(PMC_data(SELF));
        }
        PMC_data(SELF) = mem_sys_allocate_zeroed((2 + size) *
            sizeof (HashEntry));
        PObj_custom_mark_destroy_SETALL(SELF);
    }

/*

=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>

Sets the integer value of the element at index C<key> to C<value>.

=cut

*/

    void set_integer_keyed_int(INTVAL key, INTVAL value) {
        HashEntry *e;
        if (key < 0 || key >= PMC_int_val(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + (2 + key);
        e->type = enum_hash_int;
        UVal_int(e->val) = value;
        e = (HashEntry *) PMC_data(SELF) + 1;
        if (key >= UVal_int(e->val))
            UVal_int(e->val) = key + 1;
    }

/*

=item C<void push_integer(INTVAL value)>

Adds an element with integer value C<value> to the end of the array.

=cut

*/

    void push_integer(INTVAL value) {
        HashEntry *e;
        INTVAL nextix;
        if (!PMC_data(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + 1;
        nextix = UVal_int(e->val);
        DYNSELF.set_integer_keyed_int(nextix, value);
    }

/*

=item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>

Sets the floating-point value of the element at index C<key> to
C<value>.

=cut

*/

    void set_number_keyed_int(INTVAL key, FLOATVAL value) {
        HashEntry *e;
        if (key < 0 || key >= PMC_int_val(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + (2 + key);
        e->type = enum_hash_num;
        UVal_num(e->val) = value;
        e = (HashEntry *) PMC_data(SELF) + 1;
        if (key >= UVal_int(e->val))
            UVal_int(e->val) = key + 1;
    }

/*

=item C<void push_float(FLOATVAL value)>

Adds an element with floating-point value C<value> to the end of the array.

=cut

*/

    void push_float(FLOATVAL value) {
        HashEntry *e;
        INTVAL nextix;
        if (!PMC_data(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + 1;
        nextix = UVal_int(e->val);
        DYNSELF.set_number_keyed_int(nextix, value);
    }

/*

=item C<void set_string_keyed_int(INTVAL key, STRING *value)>

Sets the Parrot string value of the element at index C<key> to C<value>.

=cut

*/

    void set_string_keyed_int(INTVAL key, STRING* value) {
        HashEntry *e;
        if (key < 0 || key >= PMC_int_val(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + (2 + key);
        e->type = enum_hash_string;
        UVal_str(e->val) = value;
        e = (HashEntry *) PMC_data(SELF) + 1;
        if (key >= UVal_int(e->val))
            UVal_int(e->val) = key + 1;
    }

/*

=item C<void push_string(STRING *value)>

Adds an element with Parrot string value C<*value> to the end of the
array.

=cut

*/

    void push_string(STRING* value) {
        HashEntry *e;
        INTVAL nextix;
        if (!PMC_data(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + 1;
        nextix = UVal_int(e->val);
        DYNSELF.set_string_keyed_int(nextix, value);
    }

/*

=item C<void set_pmc_keyed_int(INTVAL key, PMC *src)>

Sets the PMC value of the element at index C<key> to C<*src>.

=cut

*/

    void set_pmc_keyed_int(INTVAL key, PMC* src) {
        HashEntry *e;
        if (key < 0 || key >= PMC_int_val(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + (2 + key);
        e->type = enum_hash_pmc;
        DOD_WRITE_BARRIER(INTERP, SELF, UVal_pmc(e->val), src);
        UVal_pmc(e->val) = src;
        e = (HashEntry *) PMC_data(SELF) + 1;
        if (key >= UVal_int(e->val))
            UVal_int(e->val) = key + 1;
    }

/*

=item C<void push_pmc(PMC *value)>

Adds an element with PMC value C<*value> to the end of the array.

=cut

*/

    void push_pmc(PMC* value) {
        HashEntry *e;
        INTVAL nextix;
        if (!PMC_data(SELF))
            real_exception(interp, NULL, E_IndexError,
                    "SArray index out of bounds!");
        e = (HashEntry *) PMC_data(SELF) + 1;
        nextix = UVal_int(e->val);
        DYNSELF.set_pmc_keyed_int(nextix, value);
    }

}
/*

=back

=head1 SEE ALSO

F<docs/pdds/pdd03_calling_conventions.pod>.

=head1 HISTORY

Initial version 2003.07.04 by leo

2003.11.06 boemmels renamed HASH_ENTRY to HashEntry

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
