Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1191 lines (922 sloc) 32.3 KB
/*
Copyright (C) 2001-2015, Parrot Foundation.
=head1 NAME
src/pmc/resizablepmcarray.pmc - ResizablePMCArray PMC
=head1 DESCRIPTION
This class, ResizablePMCArray, implements an resizable array which stores
PMCs. It changes values into Integer, Float, or String PMCs as appropriate.
Resize thresholds steps are 8 and 4096.
Between 8b and 4K resize it overallocates by factor 1.5, over 4K it aligns up to
the next 4K block.
We use now the faster nqp/qrpa model with O(1) shift/unshift
ops, by moving an extra offset index, with 8 slots reserve. See #1152
=head2 Internal Functions
=over 4
=cut
*/
#define PMC_size(x) ((Parrot_ResizablePMCArray_attributes *)PMC_data(x))->size
#define PMC_array(x) ((Parrot_ResizablePMCArray_attributes *)PMC_data(x))->pmc_array
#define PMC_offset(x) ((Parrot_ResizablePMCArray_attributes *)PMC_data(x))->offset
#define PMC_threshold(x) ((Parrot_ResizablePMCArray_attributes *)PMC_data(x))->threshold
#ifdef NDEBUG
# define TRACE_RPA(s)
# define TRACE_RPAn(s)
# define TRACE_RPAsize(s)
# define TRACE_RPAself(s, self)
# define TRACE_RPAdata(s, data)
# define TRACE_PMC(i, pmc)
# define TRACE_SPLC
#else
# include "parrot/runcore_trace.h"
# define TRACE_RPA(s) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, "# rpa %-12s: (%ld,%ld,%ld) ", \
(s), offset, size, threshold);
# define TRACE_RPAn(s) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, "# rpa %-12s: (%ld,%ld,%ld)\n", \
(s), offset, size, threshold);
# define TRACE_RPAsize(s) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, "# rpa %-12s: (%ld,%ld,%ld) -> size=%ld\n", \
(s), offset, size, threshold, n);
# define TRACE_RPAself(s, self) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, "# rpa %-12s: (%ld,%ld,%ld) ", \
(s), PMC_offset(self), PMC_size(self), PMC_threshold(self));
# define TRACE_RPAdata(s, data) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, "# rpa %-12s: (%ld,%ld,%ld) ", \
(s), (data)->offset, (data)->size, (data)->threshold);
# define TRACE_PMC(i, pmc) \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) { \
fprintf(stderr, " rpa[%ld]=", (i)); \
trace_pmc_dump(interp, (pmc)); \
fprintf(stderr, "\n"); \
}
# define TRACE_SPLC \
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)) \
fprintf(stderr, " off=%ld, count=%ld, elems1=%ld, tail=%ld, sizediff=%ld\n", \
off, count, elems1, tail, sizediff)
#endif
/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_INLINE
static void do_shift(PARROT_INTERP,
ARGIN(Parrot_ResizablePMCArray_attributes *data))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_INLINE
static void do_unshift(PARROT_INTERP, ARGIN(PMC *arr), ARGIN(PMC *val))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
PARROT_DOES_NOT_RETURN
PARROT_INLINE
static void throw_pop_empty(PARROT_INTERP)
__attribute__nonnull__(1);
PARROT_DOES_NOT_RETURN
PARROT_INLINE
static void throw_shift_empty(PARROT_INTERP)
__attribute__nonnull__(1);
#define ASSERT_ARGS_do_shift __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(data))
#define ASSERT_ARGS_do_unshift __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(arr) \
, PARROT_ASSERT_ARG(val))
#define ASSERT_ARGS_throw_pop_empty __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
#define ASSERT_ARGS_throw_shift_empty __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
=item C<static void do_shift(PARROT_INTERP, Parrot_ResizablePMCArray_attributes
*data)>
Removes and returns an item from the start of the array.
=cut
*/
PARROT_INLINE
static void
do_shift(PARROT_INTERP, ARGIN(Parrot_ResizablePMCArray_attributes *data))
{
ASSERT_ARGS(do_shift)
data->size--;
PARROT_ASSERT(data->size + data->offset <= data->threshold);
data->offset++;
TRACE_RPAdata("shift fast", data);
TRACE_PMC(data->offset-1, data->pmc_array[data->offset-1]); /* XXX GC problem */
#ifdef DEBUG_FILL_SLACK
data->pmc_array[data->offset] = PMCNULL;
#endif
}
/*
=item C<static void do_unshift(PARROT_INTERP, PMC *arr, PMC *val)>
Adds an item at the start of the array.
If offset == 0 moves the whole rest of the array around.
=cut
*/
PARROT_INLINE
static void
do_unshift(PARROT_INTERP, ARGIN(PMC *arr), ARGIN(PMC *val))
{
ASSERT_ARGS(do_unshift)
#ifndef NDEBUG
const INTVAL threshold = PMC_threshold(arr);
#endif
INTVAL size = PMC_size(arr);
INTVAL offset = PMC_offset(arr);
if (offset > 0) {
TRACE_RPA("unshift fast");
offset--;
PMC_size(arr)++;
PMC_offset(arr) = offset;
PMC_array(arr)[offset] = val;
TRACE_PMC(offset, val);
}
else {
PMC **array;
TRACE_RPA("unshift slow");
TRACE_PMC(offset, val);
VTABLE_set_integer_native(interp, arr, size + 1);
array = PMC_array(arr);
/* if there's enough room on the right, move the offset right by 3
anticipating more unshifts. we have to move the items anyway. */
#if 0
if (PMC_threshold(arr) - size > 3) {
PMC_offset(arr) += 3;
size += 3;
}
#endif
memmove(array + 1, array, size * sizeof (PMC *));
array[0] = val;
}
}
/*
=back
=head1 Vtable Functions
=over
=cut
*/
pmclass ResizablePMCArray extends FixedPMCArray auto_attrs provides array {
/* inheriting: size, pmc_array */
ATTR INTVAL offset; /* of first index, to leave max 8 slots in front for unshift */
ATTR INTVAL threshold; /* allocated number of elements, max size before array needs resizing */
/*
=item C<void init_int(INTVAL size)>
Initializes the array.
=cut
*/
VTABLE void init_int(INTVAL n) :manual_wb {
if (UNLIKELY(n < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"illegal argument");
SUPER(n);
PMC_offset(SELF) = 0;
if (LIKELY(n > 0)) {
PMC_threshold(SELF) = n;
}
}
/*
=item C<void set_integer_native(INTVAL size)>
Resizes the array to C<size> elements.
=cut
*/
VTABLE void set_integer_native(INTVAL n) :manual_wb {
INTVAL size = PMC_size(SELF);
INTVAL offset = PMC_offset(SELF);
INTVAL threshold = PMC_threshold(SELF); /* i.e. allocated size */
PMC **array = PMC_array(SELF);
if (UNLIKELY(n < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"illegal argument");
if (UNLIKELY(!array)) {
/* empty - used fixed routine */
PMC_offset(SELF) = 0;
if (n < 8) {
SUPER(8);
PMC_size(SELF) = n;
PMC_threshold(SELF) = 8;
}
else {
SUPER(n);
PMC_threshold(SELF) = n;
}
TRACE_RPAsize("resize init");
}
else if (n == size) {
return;
}
else if (n <= threshold - offset) {
TRACE_RPAsize("resize skip");
PMC_size(SELF) = n;
/* PARROT_GC_WRITE_BARRIER(INTERP, SELF); */
/* we could shrink here, but this would need a GC mark */
return;
}
/* enough room at the left */
else if (offset > 0 && n + offset > size && n <= threshold) {
/* if there aren't enough slots at the end, shift off empty
* slots from the beginning first */
if (size > 0) {
/* 7,1,8 n:6 =>5. 1,5,10 n=10 =>1 */
const INTVAL diff = n - size > offset ? offset : n - size;
size_t i;
TRACE_RPAsize("resize off move"); /* move diff to the left */
PARROT_ASSERT(offset >= diff);
memmove(&array[offset - diff], &array[offset], size * sizeof (PMC *));
#ifdef DEBUG_FILL_SLACK
for (i=-diff; i<0; ++i) { /* fill the slack */
array[offset+size+i] = PMCNULL;
}
#endif
PMC_offset(SELF) -= diff;
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
}
else { /* for empty arrays just reset the offset */
PMC_offset(SELF) = 0;
TRACE_RPAsize("resize off empty");
}
PMC_size(SELF) = n;
}
else {
INTVAL old;
old = threshold;
n += offset;
if (n < 8192) {
INTVAL newsize = threshold; /* overallocate small blocks by 1.5 */
newsize += newsize/2;
threshold = (n < newsize) ? newsize : n;
if (threshold < 8) threshold = 8;
}
else {
const INTVAL needed = n - threshold;
threshold += needed + 4096; /* next block */
threshold &= ~0xfff;
}
array = mem_gc_realloc_n_typed(INTERP, array, threshold, PMC *);
#ifdef DEBUG_FILL_SLACK
for (; old < threshold; ++old) { /* fill the slack */
array[old] = PMCNULL;
}
#endif
PMC_threshold(SELF) = threshold;
PMC_size(SELF) = n - offset;
if (PMC_array(SELF) != array) { /* data moved? */
PMC_array(SELF) = array;
TRACE_RPAsize("resize move");
}
#ifndef NDEBUG
else {
TRACE_RPAsize("resize fast realloc");
}
#endif
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
}
}
/*
=item C<FLOATVAL shift_float()>
=item C<INTVAL shift_integer()>
=item C<PMC *shift_pmc()>
=item C<STRING *shift_string()>
Removes and returns an item from the start of the array.
This throws an OUT_OF_BOUNDS exception if the array is already empty,
unlike the perl5 and perl6 shift operator.
=cut
*/
VTABLE FLOATVAL shift_float() :no_wb {
Parrot_ResizablePMCArray_attributes * const data = PARROT_RESIZABLEPMCARRAY(SELF);
FLOATVAL value;
if (UNLIKELY(0 == data->size))
throw_shift_empty(INTERP);
value = VTABLE_get_number(INTERP, data->pmc_array[data->offset]);
do_shift(INTERP, data);
return value;
}
VTABLE INTVAL shift_integer() :no_wb {
Parrot_ResizablePMCArray_attributes * const data = PARROT_RESIZABLEPMCARRAY(SELF);
INTVAL value;
if (UNLIKELY(0 == data->size))
throw_shift_empty(INTERP);
value = VTABLE_get_integer(INTERP, data->pmc_array[data->offset]);
do_shift(INTERP, data);
return value;
}
VTABLE PMC *shift_pmc() :no_wb {
Parrot_ResizablePMCArray_attributes * const data = PARROT_RESIZABLEPMCARRAY(SELF);
PMC *value;
if (UNLIKELY(0 == data->size))
throw_shift_empty(INTERP);
value = data->pmc_array[data->offset];
do_shift(INTERP, data);
return value;
}
VTABLE STRING *shift_string() :no_wb {
Parrot_ResizablePMCArray_attributes * const data = PARROT_RESIZABLEPMCARRAY(SELF);
STRING *value;
if (UNLIKELY(0 == data->size))
throw_shift_empty(INTERP);
value = VTABLE_get_string(INTERP, data->pmc_array[data->offset]);
do_shift(INTERP, data);
return value;
}
/*
=item C<PMC *get_pmc_keyed_int(INTVAL key)>
Returns the PMC value of the element at index C<key>.
=cut
*/
VTABLE PMC *get_pmc_keyed_int(INTVAL key) :no_wb {
PMC **data;
const INTVAL size = PMC_size(SELF);
const INTVAL offset = PMC_offset(SELF);
PMC *val;
if (UNLIKELY(key < 0))
key += size;
if (UNLIKELY(key < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"get: index out of bounds");
if (UNLIKELY(key >= size))
return PMCNULL;
#ifndef NDEBUG
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)
&& Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG)) {
fprintf(stderr, "# rpa get keyed: (%ld,%ld,%ld): [%ld]=",
offset, size, PMC_threshold(SELF), key);
trace_pmc_dump(INTERP, PMC_array(SELF)[key + offset]);
fprintf(stderr, "\n");
}
#endif
data = PMC_array(SELF);
val = data[key + offset];
if (PMC_IS_NULL(val))
return PMCNULL; /* handles NULL also */
return val;
}
/*
=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>.
=item C<void set_pmc_keyed(PMC *key, PMC *src)>
Sets the PMC value of the element keyed by C<key> to C<*src>.
=cut
*/
VTABLE void set_pmc_keyed_int(INTVAL key, PMC *src) {
const INTVAL size = PMC_size(SELF);
INTVAL offset = PMC_offset(SELF);
if (UNLIKELY(key < 0))
key += size;
if (UNLIKELY(key < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"set: index out of bounds");
#ifndef NDEBUG
if (Interp_trace_TEST(interp, PARROT_TRACE_ARRAY_STATE_FLAG)
&& Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG)) {
fprintf(stderr, "# rpa set keyed: (%ld,%ld,%ld): [%ld]=",
offset, size, PMC_threshold(SELF), key);
trace_pmc_dump(INTERP, src);
fprintf(stderr, "\n");
}
#endif
if (UNLIKELY(key >= size)) {
INTVAL i;
PMC ** array;
SELF.set_integer_native(key + 1);
offset = PMC_offset(SELF);
array = PMC_array(SELF);
for (i=size+offset; i<PMC_size(SELF)+offset; ++i) { /* fill the slack */
array[i] = PMCNULL;
}
}
PMC_array(SELF)[key + offset] = src;
}
VTABLE void set_pmc_keyed(PMC *key, PMC *src) :manual_wb {
SUPER(key, src);
}
VTABLE void set_pmc(PMC *value) {
INTVAL size;
INTVAL i;
PMC ** data = PMC_array(SELF);
if (SELF == value)
return;
if (UNLIKELY(!VTABLE_does(INTERP, value, CONST_STRING(INTERP, "array"))))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"Can't set self from this type");
PMC_offset(SELF) = 0;
size = PMC_size(SELF) = VTABLE_elements(INTERP, value);
/* TODO realloc */
if (data) mem_gc_free(INTERP, data);
data = PMC_array(SELF) = mem_gc_allocate_n_typed(INTERP, size, PMC *);
for (i = 0; i < size; ++i)
data[i] = VTABLE_get_pmc_keyed_int(INTERP, value, i);
}
/*
=item C<void delete_keyed_int(INTVAL key)>
=item C<void delete_keyed(PMC *key)>
Delete the element at index C<key> and shift the rest to the left.
=cut
*/
VTABLE void delete_keyed(PMC *key) :manual_wb {
const INTVAL idx = VTABLE_get_integer(INTERP, key);
SELF.delete_keyed_int(idx);
}
VTABLE void delete_keyed_int(INTVAL key) {
Parrot_ResizablePMCArray_attributes * const data = PARROT_RESIZABLEPMCARRAY(SELF);
/* TODO ignore delete[0] for empty array for now to keep PGE happy. GH #1154.
But add a new warning */
if (!data->size && !key) {
TRACE_RPAdata("delete oob", data);
Parrot_warn(interp, PARROT_WARNINGS_UNDEF_FLAG,
"invalid delete argument ignored (deprecated)");
return;
}
if (UNLIKELY(key < 0 || key >= data->size)) {
TRACE_RPAdata("delete oob", data);
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"delete: index out of bounds");
}
data->size--;
if (0 == key) {
data->offset++;
TRACE_RPAdata("delete fast", data);
TRACE_PMC(key, data->pmc_array[data->offset-1]);
}
else {
PMC ** const off = &data->pmc_array[key + data->offset];
TRACE_RPAdata("delete slow", data);
TRACE_PMC(key + data->offset, data->pmc_array[key + data->offset]);
if (data->size > key) { /* skip when last element */
memmove(off, off + 1, (data->size - key) * sizeof (PMC *));
}
}
}
/*
=item C<INTVAL exists_keyed_int(INTVAL key)>
=item C<INTVAL exists_keyed(PMC *key)>
Returns TRUE is the element at C<key> exists; otherwise returns false.
=cut
*/
VTABLE INTVAL exists_keyed_int(INTVAL key) :no_wb {
PMC ** const data = PMC_array(SELF);
const INTVAL size = PMC_size(SELF);
const INTVAL offset = PMC_offset(SELF);
UNUSED(INTERP)
if (UNLIKELY(key < 0))
key += size;
if (UNLIKELY(key < 0 || key >= size))
return 0;
return !PMC_IS_NULL(data[key + offset]);
}
VTABLE INTVAL exists_keyed(PMC *key) :no_wb {
const INTVAL ix = VTABLE_get_integer(INTERP, key);
return SELF.exists_keyed_int(ix);
}
/*
=item C<INTVAL defined_keyed_int(INTVAL key)>
Returns TRUE is the element at C<key> is defined; otherwise returns false.
=cut
*/
VTABLE INTVAL defined_keyed_int(INTVAL key) :no_wb {
PMC *val;
const INTVAL size = PMC_size(SELF);
if (UNLIKELY(key < 0))
key += size;
if (UNLIKELY(key < 0 || key >= size))
return 0;
val = SELF.get_pmc_keyed_int(key);
if (UNLIKELY(PMC_IS_NULL(val))) {
return 0;
}
return VTABLE_defined(INTERP, val);
}
/*
=item C<void push_float(FLOATVAL value)>
=item C<void push_integer(INTVAL value)>
=item C<void push_pmc(PMC *value)>
=item C<void push_string(STRING *value)>
Extends the array by adding an element of value C<*value> to the end of
the array.
=cut
*/
VTABLE void push_float(FLOATVAL value) :manual_wb {
const INTVAL size = PMC_size(SELF);
PMC * const val = Parrot_pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, val, value);
SELF.push_pmc(val);
}
VTABLE void push_integer(INTVAL value) :manual_wb {
const INTVAL size = PMC_size(SELF);
PMC * const val = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, value);
SELF.push_pmc(val);
}
VTABLE void push_pmc(PMC *value) {
const INTVAL threshold = PMC_threshold(SELF);
const INTVAL size = PMC_size(SELF);
INTVAL offset = PMC_offset(SELF);
/* if there's enough room on the right */
if (PMC_array(SELF) && (offset + size < threshold)) {
PMC_size(SELF)++;
TRACE_RPAself("push fast", SELF);
}
else {
SELF.set_integer_native(size + 1);
offset = PMC_offset(SELF);
TRACE_RPAself("push slow", SELF);
}
((PMC **)PMC_array(SELF))[offset + size] = value;
TRACE_PMC(offset+size, value);
}
VTABLE void push_string(STRING *value) :manual_wb {
const INTVAL size = PMC_size(SELF);
PMC * const val = Parrot_pmc_new(INTERP, enum_class_String);
VTABLE_assign_string_native(INTERP, val, value);
SELF.push_pmc(val);
}
/*
=item C<INTVAL pop_float()>
=item C<INTVAL pop_integer()>
=item C<PMC *pop_pmc()>
=item C<STRING *pop_string()>
Removes and returns the last element in the array.
This throws an OUT_OF_BOUNDS exception if the array is already empty,
unlike the perl5 and perl6 shift operator.
=cut
*/
VTABLE FLOATVAL pop_float() :manual_wb {
PMC * const val = SELF.pop_pmc();
return VTABLE_get_number(INTERP, val);
}
VTABLE INTVAL pop_integer() :manual_wb {
PMC * const val = SELF.pop_pmc();
return VTABLE_get_integer(INTERP, val);
}
VTABLE PMC *pop_pmc() :manual_wb {
INTVAL size = PMC_size(SELF);
const INTVAL offset = PMC_offset(SELF);
PMC *val;
if (UNLIKELY(0 == size))
throw_pop_empty(INTERP);
--size;
PMC_size(SELF) = size;
val = PMC_array(SELF)[offset + size];
PARROT_GC_WRITE_BARRIER(INTERP, SELF);
return val;
}
VTABLE STRING *pop_string() :manual_wb {
PMC * const val = SELF.pop_pmc();
return VTABLE_get_string(INTERP, val);
}
/*
=item C<void unshift_float(FLOATVAL value)>
=item C<void unshift_integer(INTVAL value)>
=item C<void unshift_pmc(PMC *value)>
=item C<void unshift_string(STRING *value)>
Extends the array by adding an element of value C<*value> to the begin of
the array.
=cut
*/
VTABLE void unshift_float(FLOATVAL value) {
PMC * const val = Parrot_pmc_new(INTERP, enum_class_Float);
VTABLE_set_number_native(INTERP, val, value);
do_unshift(INTERP, SELF, val);
}
VTABLE void unshift_integer(INTVAL value) {
PMC * const val = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, value);
do_unshift(INTERP, SELF, val);
}
VTABLE void unshift_pmc(PMC *value) {
do_unshift(INTERP, SELF, value);
}
VTABLE void unshift_string(STRING *value) {
PMC * const val = Parrot_pmc_new(INTERP, enum_class_String);
VTABLE_set_string_native(INTERP, val, value);
do_unshift(INTERP, SELF, val);
}
/*
=item C<void mark(void)>
Mark the array.
=cut
*/
VTABLE void mark() :no_wb {
PMC ** data = PMC_array(SELF);
if (LIKELY(data)) {
INTVAL i = PMC_size(SELF);
data += PMC_offset(SELF);
for (i--; i >= 0; --i)
Parrot_gc_mark_PMC_alive(INTERP, data[i]);
}
}
/*
=item C<PMC *clone()>
Creates and returns a copy of the array.
=cut
*/
VTABLE PMC *clone() :no_wb {
/* keep the slack and offset */
PMC * const copy = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
const INTVAL size = PMC_size(SELF);
const INTVAL tresh = PMC_threshold(SELF);
if (size) {
PMC_size(copy) = size;
PMC_array(copy) = mem_gc_allocate_n_typed(INTERP, tresh, PMC *);
mem_copy_n_typed(PMC_array(copy), PMC_array(SELF), tresh, PMC *);
PObj_custom_mark_destroy_SETALL(copy);
}
PMC_threshold(copy) = tresh;
PMC_offset(copy) = PMC_offset(SELF);
return copy;
}
/*
=item C<STRING *get_repr()>
Returns the Parrot string representation of the C<ResizablePMCArray>.
=cut
*/
VTABLE STRING *get_repr() :no_wb {
INTVAL j;
const INTVAL size = PMC_size(SELF);
STRING *res = CONST_STRING(INTERP, "[ ");
STRING *ret;
for (j = 0; j < size; ++j) {
PMC * const val = SELF.get_pmc_keyed_int(j);
res = Parrot_str_concat(INTERP, res, VTABLE_get_repr(INTERP, val));
if (j < size - 1)
res = Parrot_str_concat(INTERP, res, CONST_STRING(INTERP, ", "));
}
ret = Parrot_str_concat(INTERP, res, CONST_STRING(INTERP, " ]"));
return ret;
}
/*
=item C<void splice(PMC *from, INTVAL offset, INTVAL count)>
Replaces C<count> elements starting at C<offset> with the elements in
C<from>.
Note that the C<from> PMC can be of any of the various array types.
=cut
*/
VTABLE void splice(PMC *from, INTVAL off, INTVAL count) {
const INTVAL size = PMC_size(SELF);
const INTVAL threshold = PMC_threshold(SELF);
INTVAL offset = PMC_offset(SELF);
const INTVAL elems1 = VTABLE_elements(INTERP, from);
PMC **item;
INTVAL tail = 0, sizediff = 0, newsize;
#ifndef NDEBUG
int no_debug = 0; /* if we didn't branch into a TRACE_RPA */
#endif
/* start from end? */
if (UNLIKELY(off < 0))
off += size;
if (UNLIKELY(count < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"illegal argument");
if (UNLIKELY(off < 0))
Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
"splice: index out of bounds");
if (UNLIKELY(off > size)) {
Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG, /* _MISC in perl5 */
"splice: offset past end of array");
TRACE_RPAself("splice off > size", SELF);
TRACE_SPLC;
off = size;
}
/* number of elements to the right of the splice (the "tail") */
tail = size - off - count;
if (tail < 0) tail = 0;
/* [0 ^ ... ... ] */
/* self offset size threshold */
item = PMC_array(SELF);
sizediff = count - elems1;
if (tail > 0 && sizediff > 0) {
/* we're shrinking the array, so first move the tail left. */
/* maybe we can just adjust the offset. */
if (!off && offset >= sizediff) { /* enough room at the left to fill in from */
TRACE_RPAself("splice shrink fast", SELF);
TRACE_SPLC;
item += offset + elems1;
offset += sizediff;
PMC_offset(SELF) = offset;
PMC_size(SELF) -= sizediff;
goto splice_copy;
}
else {
TRACE_RPAself("splice shrink", SELF);
TRACE_SPLC;
memmove(item + offset + off + elems1, item + offset + off + count,
tail * sizeof (PMC *));
}
}
#ifndef NDEBUG
else {
no_debug = 1;
}
#endif
/* now resize the array */
newsize = off + elems1 + tail;
if (newsize > threshold - offset) {
SELF.set_integer_native(newsize);
offset = PMC_offset(SELF);
item = PMC_array(SELF);
}
else {
PMC_size(SELF) = newsize; /* enough room */
}
item += offset;
if (tail > 0 && sizediff < 0) { /* elems1 > count */
TRACE_RPAself("splice grow", SELF);
TRACE_SPLC;
PARROT_ASSERT(offset + newsize <= PMC_threshold(SELF));
/* the array grew, so move the tail to the right */
memmove(item + off + elems1, item + off + count,
tail * sizeof (PMC *));
}
#ifndef NDEBUG
else if (!no_debug) {
no_debug = 1;
}
#endif
splice_copy:
/* now copy C<from>'s elements into SELF */
if (elems1 > 0) {
INTVAL i;
PMC *iter = VTABLE_get_iter(INTERP, from);
TRACE_RPAself("splice fill", SELF);
TRACE_SPLC;
for (i = 0; i < elems1; i++)
item[off + i] = VTABLE_shift_pmc(INTERP, iter);
}
#ifndef NDEBUG
else if (no_debug) {
/* we are better of with a simple resize here */
TRACE_RPAself("splice noop", SELF);
TRACE_SPLC;
}
#endif
}
/*
=item C<void visit(PMC *info)>
This is used by freeze/thaw to visit the contents of the array.
C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
=item C<void freeze(PMC *info)>
Used to archive the array.
=item C<void thaw(PMC *info)>
Used to unarchive the array.
=cut
*/
VTABLE void visit(PMC *info) :no_wb {
INTVAL i;
const INTVAL n = VTABLE_elements(INTERP, SELF);
PMC **pos = PMC_array(SELF) + PMC_offset(SELF);
for (i = 0; i < n; ++i, ++pos) {
VISIT_PMC(INTERP, info, *pos);
}
SUPER(info);
}
VTABLE void freeze(PMC *info) :no_wb {
VTABLE_push_integer(INTERP, info, VTABLE_elements(INTERP, SELF));
}
VTABLE void thaw(PMC *info) :manual_wb {
SELF.init_int(VTABLE_shift_integer(INTERP, info));
}
/*
=back
=head2 Methods
=over 4
=item METHOD append(PMC *other)
Append the other array to this array.
=cut
*/
METHOD append(PMC *other) {
const INTVAL n = VTABLE_elements(INTERP, SELF);
const INTVAL m = VTABLE_elements(INTERP, other);
const INTVAL offset = PMC_offset(SELF);
if (!m)
return;
/* pre-size it */
VTABLE_set_integer_native(INTERP, SELF, n + m);
if (other->vtable->base_type == SELF->vtable->base_type
|| other->vtable->base_type == enum_class_FixedPMCArray) {
PMC ** const other_data = PMC_array(other);
PMC ** const this_data = PMC_array(SELF) + offset;
/* libc is faster at copying data than a manual loop here */
memmove(this_data + n, other_data, m * sizeof (PMC *));
}
else {
PMC ** const this_data = PMC_array(SELF);
INTVAL i;
for (i = offset; i < m; ++i)
this_data[n + i] = VTABLE_get_pmc_keyed_int(INTERP, other, i);
}
RETURN(void);
}
/*
=item METHOD PMC* shift()
=item METHOD PMC* pop()
Method forms to remove and return a PMC from the beginning or
end of the array.
=cut
*/
METHOD shift() :manual_wb {
PMC * const value = VTABLE_shift_pmc(INTERP, SELF);
RETURN(PMC *value);
}
METHOD pop() :manual_wb {
PMC * const value = VTABLE_pop_pmc(INTERP, SELF);
RETURN(PMC *value);
}
/*
=item METHOD unshift(PMC* value)
=item METHOD push(PMC* value)
Method forms to add a PMC to the beginning or end of the array.
=cut
*/
METHOD unshift(PMC* value) :manual_wb {
VTABLE_unshift_pmc(INTERP, SELF, value);
}
METHOD push(PMC* value) :manual_wb {
VTABLE_push_pmc(INTERP, SELF, value);
}
/*
=item C<METHOD sort(PMC *cmp_func)>
Sort this array, optionally using the provided cmp_func
=cut
*/
METHOD sort(PMC *cmp_func :optional) {
const INTVAL n = SELF.elements();
const INTVAL offset = PMC_offset(SELF);
PMC ** array = PMC_array(SELF);
if (n > 1) {
/* XXX Workaround for TT #218 */
if (PObj_is_object_TEST(SELF)) {
PMC * const parent = SELF.get_attr_str(CONST_STRING(INTERP, "proxy"));
Parrot_pcc_invoke_method_from_c_args(INTERP, parent, CONST_STRING(INTERP, "sort"), "P->", cmp_func);
}
else {
array += offset;
Parrot_util_quicksort(INTERP, (void **)array, n, cmp_func, "PP->I");
}
}
RETURN(PMC *SELF);
}
/*
=item C<METHOD reverse()>
Reverse the contents of the array.
=cut
*/
METHOD reverse() {
const INTVAL offset = PMC_offset(SELF);
INTVAL n = SELF.elements();
if (n > 1) {
PMC *val;
PMC **data = PMC_array(SELF) + offset;
INTVAL i;
for (i = 0; i <= --n; i++) {
val = data[i];
data[i] = data[n];
data[n] = val;
}
}
}
}
/*
=back
=head2 Auxiliar functions
=over 4
=item C<static void do_shift(PARROT_INTERP, PMC *arr)>
Common part for all shift operations.
=item C<static void do_unshift(PARROT_INTERP, PMC *arr, PMC *val)>
Common part for all unshift operations.
=item C<static void throw_shift_empty(PARROT_INTERP)>
=item C<static void throw_pop_empty(PARROT_INTERP)>
Throws with the appropriate message.
=cut
*/
PARROT_DOES_NOT_RETURN
PARROT_INLINE
static void
throw_shift_empty(PARROT_INTERP)
{
ASSERT_ARGS(throw_shift_empty)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_OUT_OF_BOUNDS,
"Can't shift from an empty array");
}
PARROT_DOES_NOT_RETURN
PARROT_INLINE
static void
throw_pop_empty(PARROT_INTERP)
{
ASSERT_ARGS(throw_pop_empty)
Parrot_ex_throw_from_c_noargs(interp, EXCEPTION_OUT_OF_BOUNDS,
"Can't pop from an empty array");
}
/*
=back
=head1 See also
F<docs/pdds/pdd17_basic_types.pod>.
=cut
*/
/*
* Local variables:
* c-file-style: "parrot"
* End:
* vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
*/