# New Ticket Created by Steve Fink
# Please include the string: [perl #17039]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17039 >
Here is the new PMC I keep babbling about. Before I commit it, any
comments? Like, does anybody think this should be named differently?
It's really a dequeue (double-ended queue), meaning that push, pop,
shift, and unshift are all constant-time operations, but arbitrary
indexed lookup is theoretically linear-time. (It's linear in the
number of 256-element chunks, so in practice it's usually fast.)
It is implemented as a modification of rxstack.c. It is still a
circular, doubly-linked list of chunks containing a fairly large array
of integers, only now the first chunk can be partial as well as the
last, in order to efficiently support shift/unshift. The length is
cached in the first node. Also, these chunks are now Buffer
subclasses, so they are completely managed by GC (rxstack uses
mem_sys_allocate).
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/36692/29583/f4c51f/intarray.patch
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.212
diff -p -u -a -r1.212 MANIFEST
--- MANIFEST 5 Sep 2002 17:56:58 -0000 1.212
+++ MANIFEST 5 Sep 2002 19:17:21 -0000
@@ -23,6 +23,7 @@ classes/coroutine.pmc
classes/csub.pmc
classes/default.pmc
classes/genclass.pl
+classes/intarray.pmc
classes/intqueue.pmc
classes/key.pmc
classes/multiarray.pmc
@@ -206,6 +207,7 @@ include/parrot/exceptions.h
include/parrot/global_setup.h
include/parrot/hash.h
include/parrot/headers.h
+include/parrot/intarray.h
include/parrot/interp_guts.h
include/parrot/interpreter.h
include/parrot/io.h
@@ -235,6 +237,7 @@ include/parrot/sub.h
include/parrot/trace.h
include/parrot/unicode.h
include/parrot/warnings.h
+intarray.c
interpreter.c
io.ops
io/TODO
@@ -590,12 +593,14 @@ t/op/time.t
t/op/trans.t
t/pmc/array.t
t/pmc/boolean.t
+t/pmc/intarray.t
t/pmc/perlarray.t
t/pmc/perlhash.t
t/pmc/perlstring.t
t/pmc/pmc.t
t/pmc/sub.t
t/src/basic.t
+t/src/intarray.t
test_main.c
tools/dev/check_source_standards.pl
tools/dev/genrpt.pl
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.206
diff -p -u -a -r1.206 core.ops
--- core.ops 5 Sep 2002 15:03:23 -0000 1.206
+++ core.ops 5 Sep 2002 19:17:29 -0000
@@ -3428,6 +3428,146 @@ inline op restoreall() {
###############################################################################
+=head2 Fast access ops
+
+The fast access ops are shortcuts to common operations implemented in PMCs.
+
+=over 4
+
+=cut
+
+########################################
+
+=item B<push>(in PMC, in INT)
+
+=item B<push>(in PMC, in NUM)
+
+=item B<push>(in PMC, in STR)
+
+=item B<push>(in PMC, in PMC)
+
+Push $2 onto the end of the aggregate PMC $1, if that operation is defined.
+
+=cut
+
+inline op push (in PMC, in INT) {
+ $1->vtable->push_integer(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op push (in PMC, in NUM) {
+ $1->vtable->push_float(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op push (in PMC, in STR) {
+ $1->vtable->push_string(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op push (in PMC, in PMC) {
+ $1->vtable->push_pmc(interpreter, $1, $2);
+ goto NEXT();
+}
+
+=item B<pop>(out INT, in PMC)
+
+=item B<pop>(out NUM, in PMC)
+
+=item B<pop>(out STR, in PMC)
+
+=item B<pop>(out PMC, in PMC)
+
+Pop off last entry in the aggregate $2, placing the result in $1.
+
+=cut
+
+inline op pop (out INT, in PMC) {
+ $1 = $2->vtable->pop_integer(interpreter, $2);
+ goto NEXT();
+}
+
+inline op pop (out NUM, in PMC) {
+ $1 = $2->vtable->pop_float(interpreter, $2);
+ goto NEXT();
+}
+
+inline op pop (out STR, in PMC) {
+ $1 = $2->vtable->pop_string(interpreter, $2);
+ goto NEXT();
+}
+
+inline op pop (out PMC, in PMC) {
+ $1 = $2->vtable->pop_pmc(interpreter, $2);
+ goto NEXT();
+}
+
+=item B<unshift>(in PMC, in INT)
+
+=item B<unshift>(in PMC, in NUM)
+
+=item B<unshift>(in PMC, in STR)
+
+=item B<unshift>(in PMC, in PMC)
+
+Unshift $2 onto the end of the aggregate PMC $1, if that operation is defined.
+
+=cut
+
+inline op unshift (in PMC, in INT) {
+ $1->vtable->unshift_integer(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op unshift (in PMC, in NUM) {
+ $1->vtable->unshift_float(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op unshift (in PMC, in STR) {
+ $1->vtable->unshift_string(interpreter, $1, $2);
+ goto NEXT();
+}
+
+inline op unshift (in PMC, in PMC) {
+ $1->vtable->unshift_pmc(interpreter, $1, $2);
+ goto NEXT();
+}
+
+=item B<shift>(out INT, in PMC)
+
+=item B<shift>(out NUM, in PMC)
+
+=item B<shift>(out STR, in PMC)
+
+=item B<shift>(out PMC, in PMC)
+
+Shift off last entry in the aggregate $2, placing the result in $1.
+
+=cut
+
+inline op shift (out INT, in PMC) {
+ $1 = $2->vtable->shift_integer(interpreter, $2);
+ goto NEXT();
+}
+
+inline op shift (out NUM, in PMC) {
+ $1 = $2->vtable->shift_float(interpreter, $2);
+ goto NEXT();
+}
+
+inline op shift (out STR, in PMC) {
+ $1 = $2->vtable->shift_string(interpreter, $2);
+ goto NEXT();
+}
+
+inline op shift (out PMC, in PMC) {
+ $1 = $2->vtable->shift_pmc(interpreter, $2);
+ goto NEXT();
+}
+
+###############################################################################
+
=head2 Control flow
The control flow opcodes check conditions and manage program flow.
Index: intarray.c
===================================================================
RCS file: intarray.c
diff -N intarray.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ intarray.c 5 Sep 2002 19:17:30 -0000
@@ -0,0 +1,361 @@
+/* intarrays.c
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: rxstacks.c,v 1.8 2002/08/22 20:08:24 dan Exp $
+ * Overview:
+ * Regex stack handling routines for Parrot
+ * Data Structure and Algorithms:
+ *
+ * The basic data structure is a variant of a doubly-linked list
+ * of 'chunks', where a chunk is a Buffer header subclass
+ * containing the link pointers and other metadata for the chunk.
+ * As expected from it being a Buffer header, the .bufstart field
+ * points to the actual array of INTVALs. The handle used by
+ * external code for one of these IntArrays is just a pointer to a
+ * chunk, always called 'array' in this code.
+ *
+ * For now, all of the chunks are fixed-length in size. (That
+ * could easily be changed, at the cost of another integer in each
+ * header.)
+ *
+ * Notice that I said 'variant' of a doubly-linked list. That is
+ * because if you start at 'array' and follow prev pointers, you
+ * will loop through all the used nodes of the list, as usual. But
+ * if you follow next pointers instead, you might find a spare
+ * node hanging off the last node in the list (the last node is
+ * always array->prev, so if there is a spare node, it will be at
+ * array->prev->next. If no spare exists, then
+ * array->prev->next==array.)
+ *
+ * The first node in the list may be partly full; the intermediate
+ * nodes are always completely full; and the last node may be
+ * partly full. Each node has a .start field, giving the offset of
+ * the first valid element (always zero except for possibly the
+ * first node), and a .end field, giving one past the offset of
+ * the last valid element (always equal to INTARRAY_CHUNK_SIZE
+ * except for possibly the last node).
+ *
+ * To make it concrete, let's walk through some sample operations.
+ * To push onto the end of the array, first find the last chunk:
+ * array->prev. Then if chunk->end < INTARRAY_CHUNK_SIZE, there is
+ * space to fit another element and so just stick it in. If not,
+ * we must add a chunk to the end of the list. If there is a
+ * spare, just link it fully into the list (forming a conventional
+ * doubly-linked list). Otherwise, create a new chunk and link it
+ * fully into the list. Easy enough.
+ *
+ * To pop something off the end, first go to the end chunk
+ * (array->prev). Pop off an element and decrement .end if the
+ * chunk is nonempty. If it is empty, make that last chunk into
+ * the spare (discarding the previous spare). Then go to the
+ * previous chunk, which is guaranteed to have .end set to
+ * INTARRAY_CHUNK_SIZE, and return data[.end--].
+ *
+ * The length of the array is always cached in the overall header
+ * chunk. If an operation changes which chunk is the header (i.e.,
+ * shift or unshift), then the length is copied to the new header.
+ *
+ * Invariants:
+ *
+ * There is always space in array->prev to insert an element.
+ *
+ * The 'array' chunk is never empty unless the entire list is
+ * empty.
+ *
+ * In combination, the above invariants imply that the various
+ * operations are implemented as:
+ *
+ * push: write element, push a new chunk if necessary
+ * pop: check to see if we have to back up a chunk, read element
+ * shift: read element, discard chunk and advance if necessary
+ * unshift: unshift a chunk if necessary, write element
+ *
+ * History:
+ * Notes:
+ * References: */
+
+#include "parrot/parrot.h"
+#include "parrot/intarray.h"
+
+IntArray*
+intarray_new(Interp *interpreter)
+{
+ IntArray* array;
+
+ interpreter->DOD_block_level++;
+ array = (IntArray *) new_bufferlike_header(interpreter, sizeof(*array));
+ array->start = 0;
+ array->end = 0;
+ array->length = 0;
+ array->next = array;
+ array->prev = array;
+ array->buffer.bufstart = NULL;
+ interpreter->GC_block_level++;
+ Parrot_allocate(interpreter, (Buffer*) array,
+ INTARRAY_CHUNK_SIZE * sizeof(INTVAL));
+ interpreter->DOD_block_level--;
+ interpreter->GC_block_level--;
+ return array;
+}
+
+PMC*
+intarray_mark(Interp* interpreter, IntArray* array, PMC* last)
+{
+ IntArray_Chunk* chunk = (IntArray_Chunk*) array;
+ do {
+ buffer_lives((Buffer *) chunk);
+ chunk = chunk->next;
+ } while (chunk != (IntArray_Chunk*) array);
+
+ return last;
+}
+
+void
+intarray_dump(FILE* fp, IntArray* array, int verbose)
+{
+ IntArray_Chunk* chunk = (IntArray_Chunk*) array;
+ IntArray_Chunk* lastChunk = array->prev;
+ if (fp == NULL) fp = stderr; /* Useful for calling from gdb */
+
+ if (verbose) fprintf(fp, "LIST[%d]: ", (int) chunk->length);
+
+ while (1) {
+ int i;
+
+ if (verbose)
+ fprintf(fp, "[%d..%d] ", (int) chunk->start, (int) chunk->end-1);
+
+ for (i = chunk->start; i < chunk->end; i++) {
+ INTVAL* entries = (INTVAL*) chunk->buffer.bufstart;
+ fprintf(fp, INTVAL_FMT " ", entries[i]);
+ }
+ if (chunk == lastChunk) break;
+ chunk = chunk->next;
+ }
+
+ fprintf(fp, "\n");
+}
+
+static void
+add_chunk(Interp* interpreter, IntArray* array)
+{
+ IntArray_Chunk* chunk = array->prev;
+
+ if (chunk->next == array) {
+ /* Need to add a new chunk */
+ IntArray_Chunk* new_chunk = intarray_new(interpreter);
+ new_chunk->next = array;
+ new_chunk->prev = chunk;
+ chunk->next = new_chunk;
+ array->prev = new_chunk;
+ }
+ else {
+ /* Reuse the spare chunk we kept */
+ array->prev = chunk->next;
+ }
+}
+
+static void
+push_chunk(Interp* interpreter, IntArray* array)
+{
+ add_chunk(interpreter, array);
+ array->prev->start = 0;
+ array->prev->end = 0;
+}
+
+static void
+unshift_chunk(Interp* interpreter, IntArray* array)
+{
+ add_chunk(interpreter, array);
+ array->prev->start = INTARRAY_CHUNK_SIZE;
+ array->prev->end = INTARRAY_CHUNK_SIZE;
+}
+
+void
+intarray_push(Interp *interpreter, IntArray* array, INTVAL data)
+{
+ IntArray_Chunk* chunk = (IntArray *) array->prev;
+ INTVAL length = array->length + 1;
+
+ ((INTVAL*)chunk->buffer.bufstart)[chunk->end++] = data;
+
+ /* Add on a new chunk if necessary */
+ if (chunk->end == INTARRAY_CHUNK_SIZE)
+ push_chunk(interpreter, array);
+
+ array->length = length;
+}
+
+void
+intarray_unshift(Interp *interpreter, IntArray** array, INTVAL data)
+{
+ IntArray_Chunk* chunk = (IntArray_Chunk *) *array;
+ INTVAL length = chunk->length + 1;
+ INTVAL offset;
+
+ /* Add on a new chunk if necessary */
+ if (chunk->start == 0) {
+ unshift_chunk(interpreter, *array);
+ chunk = chunk->prev;
+ *array = chunk;
+ }
+
+ ((INTVAL*)chunk->buffer.bufstart)[--chunk->start] = data;
+
+ (*array)->length = length;
+}
+
+INTVAL
+intarray_shift(Interp *interpreter, IntArray** array)
+{
+ IntArray_Chunk* chunk = (IntArray_Chunk *) *array;
+ INTVAL length = chunk->length - 1;
+ INTVAL value;
+
+ if (chunk->start >= chunk->end) {
+ internal_exception(OUT_OF_BOUNDS, "No entries on array!\n");
+ return 0;
+ }
+
+ value = ((INTVAL*)chunk->buffer.bufstart)[chunk->start++];
+
+ if (chunk->start >= chunk->end) {
+ /* Just walked off the end of the initial chunk. Make initial
+ * chunk into the spare. */
+ chunk->next->prev = chunk->prev;
+ chunk->prev->next = chunk;
+ *array = chunk->next;
+ }
+
+ (*array)->length = length;
+
+ return value;
+}
+
+INTVAL
+intarray_pop(Interp *interpreter, IntArray* array)
+{
+ IntArray_Chunk* chunk = (IntArray *) array->prev;
+ INTVAL length = array->length - 1;
+
+ /* We may have an empty chunk at the end of the list */
+ if (chunk->start >= chunk->end) {
+ /* Discard this chunk by making it the spare. */
+ chunk->prev->next = chunk;
+ chunk->next = array;
+ array->prev = chunk->prev;
+ chunk = chunk->prev;
+ }
+
+ /* Quick sanity check */
+ if (chunk->end == chunk->start) {
+ internal_exception(OUT_OF_BOUNDS, "No entries on array!\n");
+ return 0;
+ }
+
+ array->length = length;
+
+ /* Decrement end and return the value */
+ return ((INTVAL*)chunk->buffer.bufstart)[--chunk->end];
+}
+
+static IntArray_Chunk*
+find_chunk(Interp* interpreter, IntArray* array, INTVAL idx)
+{
+ IntArray_Chunk* chunk = array;
+ UNUSED(interpreter);
+
+ /* Possible optimization: start from the closer end of the chunk list */
+
+ /* Find the chunk containing the requested element */
+ while (idx >= chunk->end - chunk->start) {
+ idx -= chunk->end - chunk->start;
+ chunk = chunk->next;
+ }
+
+ return chunk;
+}
+
+INTVAL
+intarray_get(Interp* interpreter, IntArray* array, INTVAL idx)
+{
+ IntArray_Chunk* chunk;
+ INTVAL length = array->length;
+
+ if (idx >= length || -idx > length) {
+ internal_exception(OUT_OF_BOUNDS,
+ "Invalid index, must be " INTVAL_FMT ".." INTVAL_FMT,
+ -length, length-1);
+ return 0;
+ }
+
+ if (idx < 0) idx += length;
+
+ chunk = find_chunk(interpreter, array, idx);
+
+ if (idx >= array->end - array->start) idx -= array->end - array->start;
+ idx = idx % INTARRAY_CHUNK_SIZE;
+
+ return ((INTVAL*)chunk->buffer.bufstart)[idx + chunk->start];
+}
+
+static void
+intarray_extend(Interp* interpreter, IntArray* array, INTVAL length)
+{
+ IntArray_Chunk* chunk = array->prev;
+ INTVAL to_add = length - array->length;
+
+ while (to_add > 0) {
+ INTVAL available = INTARRAY_CHUNK_SIZE - chunk->end;
+ INTVAL end;
+
+ /* Zero out all newly added elements */
+ end = (to_add <= available) ? chunk->end + to_add : INTARRAY_CHUNK_SIZE;
+ memset(&((INTVAL*)chunk->buffer.bufstart)[chunk->end],
+ 0,
+ sizeof(INTVAL) * (end - chunk->end));
+ to_add -= end - chunk->end;
+ chunk->end = end;
+
+ if (to_add > 0) push_chunk(interpreter, array);
+
+ chunk = chunk->next;
+ }
+
+ assert(length >= array->length);
+ array->length = length;
+}
+
+void
+intarray_assign(Interp* interpreter, IntArray* array, INTVAL idx, INTVAL val)
+{
+ IntArray_Chunk* chunk;
+ INTVAL length = array->length;
+
+ if (idx < -length) {
+ internal_exception(OUT_OF_BOUNDS,
+ "Invalid index, must be " INTVAL_FMT ".." INTVAL_FMT,
+ -length, length-1);
+ return;
+ }
+
+ if (idx < 0)
+ idx += length;
+ else if (idx >= length) {
+ intarray_extend(interpreter, array, idx + 1);
+ }
+
+ chunk = find_chunk(interpreter, array, idx);
+
+ ((INTVAL*)chunk->buffer.bufstart)[idx] = val;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
Index: include/parrot/intarray.h
===================================================================
RCS file: include/parrot/intarray.h
diff -N include/parrot/intarray.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ include/parrot/intarray.h 5 Sep 2002 19:17:30 -0000
@@ -0,0 +1,71 @@
+/* stacks.h
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: rxstacks.h,v 1.4 2002/08/22 20:08:59 dan Exp $
+ * Overview:
+ * Integer array routines. Constant-time push, pop, length operations.
+ * Fast linear-time lookup (requires walking through the chunks).
+ * All memory is managed by the Parrot garbage collector.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#if !defined(PARROT_INTARRAY_H_GUARD)
+#define PARROT_INTARRAY_H_GUARD
+
+#include "parrot/parrot.h"
+
+/* Number of entries (NOT bytes) in each chunk of the array */
+#define INTARRAY_CHUNK_SIZE 256
+
+typedef struct IntArray_chunk_t IntArray_Chunk;
+
+struct IntArray_chunk_t {
+ Buffer buffer; /* This struct is a Buffer header subclass! */
+ INTVAL length; /* Only valid for the "head" chunk */
+ INTVAL start;
+ INTVAL end;
+ IntArray_Chunk* next;
+ IntArray_Chunk* prev;
+};
+
+typedef IntArray_Chunk IntArray;
+
+PMC* intarray_mark(Interp*, IntArray*, PMC* last);
+
+IntArray *intarray_new(Interp*);
+
+static INTVAL intarray_length(Interp* interpreter, IntArray* array)
+{
+ UNUSED(interpreter);
+ return array->length;
+}
+
+void intarray_assign(Interp*, IntArray*, INTVAL idx, INTVAL val);
+
+void intarray_push(Interp*, IntArray*, INTVAL);
+
+INTVAL intarray_pop(Interp*, IntArray*);
+
+void intarray_unshift(Interp*, IntArray**, INTVAL);
+
+INTVAL intarray_shift(Interp *, IntArray**);
+
+INTVAL intarray_get(Interp*, IntArray*, INTVAL idx);
+
+/* Debugging use only */
+void intarray_dump(FILE* fp, IntArray* array, int verbose);
+
+#endif
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
Index: t/pmc/intarray.t
===================================================================
RCS file: t/pmc/intarray.t
diff -N t/pmc/intarray.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/pmc/intarray.t 5 Sep 2002 19:17:30 -0000
@@ -0,0 +1,147 @@
+#! perl -w
+
+use Parrot::Test tests => 2;
+use Test::More;
+
+output_is(<<'CODE', <<'OUTPUT', "creation");
+ new P0, .IntArray
+ set I0, P0
+ print "Created IntArray with "
+ print I0
+ print " elements to start with.\n"
+ end
+CODE
+Created IntArray with 0 elements to start with.
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "aerobics");
+ new P0, .IntArray
+ set I10, 10000
+
+ set I1, 0
+ set I0, 0
+buildup:
+ ge I0, I10, postBuildUp
+ push P0, I1
+ add I1, 1 # Push P0, I1++
+ push P0, I1
+ add I1, 1 # Push P0, I1++
+ push P0, I1
+ add I1, 1 # Push P0, I1++
+
+ pop I2, P0
+ mul I3, I0, 3
+ add I3, 2
+ ne I2, I3, errFirstPop # fail if pop != I0 * 3 + 2
+
+ pop I2, P0
+ mul I3, I0, 3
+ add I3, 1
+ ne I2, I3, errSecondPop # fail if pop != I0 * 3 + 1
+
+ set I2, P0
+ add I3, I0, 1
+ ne I2, I3, errBuildLen # fail if length != I0 + 1
+
+ add I0, 1
+ branch buildup
+postBuildUp:
+
+ set I0, 0
+checkBuildUpLeft:
+ ge I0, I10, postCheckBuildUpLeft
+ set I2, P0[I0]
+ mul I3, I0, 3
+ ne I2, I3, errLeftGet
+ add I0, 1
+ branch checkBuildUpLeft
+postCheckBuildUpLeft:
+
+ mul I0, I10, -1
+checkBuildUpRight:
+ ge I0, 0, postCheckBuildUpRight
+ set I2, P0[I0]
+ add I3, I0, I10
+ mul I3, 3
+ ne I2, I3, errRightGet
+ add I0, 1
+ branch checkBuildUpRight
+postCheckBuildUpRight:
+
+ mul I0, I10, 30
+ push P0, I0
+
+ set I0, I10
+tearDown:
+ le I0, 0, postTearDown
+ pop I2, P0
+ mul I3, I0, 30
+ ne I2, I3, errTearCap
+
+ pop I2, P0
+ sub I3, I0, 1
+ mul I3, 3
+ ne I2, I3, errTearInner
+
+ mul I3, 10
+ push P0, I3
+
+ set I2, P0
+ ne I2, I0, errTearLength
+
+ sub I0, 1
+ branch tearDown
+postTearDown:
+
+ pop I2, P0
+ ne I2, 0, errLast
+
+ print "I need a shower.\n"
+ end
+errFirstPop:
+ print "FAILED: first pop\n"
+ bsr info
+ end
+errSecondPop:
+ print "FAILED: second pop\n"
+ bsr info
+ end
+errBuildLen:
+ print "FAILED: buildup length\n"
+ bsr info
+ end
+errLeftGet:
+ print "FAILED: left get\n"
+ bsr info
+ end
+errRightGet:
+ print "FAILED: right get\n"
+ bsr info
+ end
+errTearCap:
+ print "FAILED: tear down cap\n"
+ bsr info
+ end
+errTearInner:
+ print "FAILED: tear down inner\n"
+ bsr info
+ end
+errTearLength:
+ print "FAILED: tear down length\n"
+ bsr info
+ end
+errLast:
+ print "FAILED: last element (zero)\n"
+ set I3, 0
+ bsr info
+ end
+info:
+ print "Found: "
+ print I2
+ print "\nWanted: "
+ print I3
+ print "\n"
+ ret
+CODE
+I need a shower.
+OUTPUT
Index: t/src/intarray.t
===================================================================
RCS file: t/src/intarray.t
diff -N t/src/intarray.t
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/src/intarray.t 5 Sep 2002 19:17:31 -0000
@@ -0,0 +1,296 @@
+#! perl -w
+
+use Parrot::Test tests => 4;
+
+c_output_is(<<'CODE', <<'OUTPUT', "creation");
+ #include <stdio.h>
+ #include "parrot/parrot.h"
+ #include "parrot/embed.h"
+
+ int main(int argc, char* argv[]) {
+ int x;
+ IntArray* array;
+
+ Interp* interpreter = Parrot_new();
+ if (interpreter == NULL) return 1;
+ Parrot_init(interpreter, (void*) &interpreter);
+
+ array = intarray_new(interpreter);
+ if (array == NULL) return 1;
+
+ intarray_push(interpreter, array, 42);
+ x = (int) intarray_get(interpreter, array, 0);
+
+ printf("The answer is %d.\n", x);
+ return 0;
+ }
+CODE
+The answer is 42.
+OUTPUT
+
+c_output_is(<<'CODE', <<'OUTPUT', "array aerobics");
+ #include <stdio.h>
+ #include "parrot/parrot.h"
+ #include "parrot/embed.h"
+
+ const char* aerobics()
+ {
+ int x = 0;
+ int N = 10000; /* Number of iterations */
+ int i;
+ IntArray* array;
+
+ Interp* interpreter = Parrot_new();
+ if (interpreter == NULL) return "create interpreter";
+ Parrot_init(interpreter, (void*) &interpreter);
+
+ array = intarray_new(interpreter);
+ if (array == NULL) return "create array";
+
+ /* Push 3, then pop 2. Repeat N times. */
+ for (i = 0; i < N; i++) {
+ intarray_push(interpreter, array, x++);
+ intarray_push(interpreter, array, x++);
+ intarray_push(interpreter, array, x++);
+ if (intarray_pop(interpreter, array) != i * 3 + 2)
+ return "build-up first pop";
+ if (intarray_pop(interpreter, array) != i * 3 + 1)
+ return "build-up second pop";
+ if (intarray_length(interpreter, array) != i + 1)
+ return "build-up length";
+ }
+
+ /* Check array_get for all values */
+ for (i = 0; i < N; i++) {
+ if (intarray_get(interpreter, array, i) != i * 3)
+ return "get from left";
+ }
+
+ /* Check array_get for all values, from the right */
+ for (i = -N; i < 0; i++) {
+ if (intarray_get(interpreter, array, i) != (i + N) * 3)
+ return "get from right";
+ }
+
+ /* Set up the receding run */
+ intarray_push(interpreter, array, N * 3 * 10);
+
+ /* Pop 2, then push 1. Repeat N times. */
+ for (i = N; i > 0; i--) {
+ if (intarray_pop(interpreter, array) != i * 3 * 10)
+ return "tear down cap";
+ if (intarray_pop(interpreter, array) != (i - 1) * 3)
+ return "tear down inner";
+ intarray_push(interpreter, array, (i - 1) * 3 * 10);
+ if (intarray_length(interpreter, array) != i)
+ return "tear down length";
+ }
+
+ /* And the final element is... */
+ if (intarray_pop(interpreter, array) != 0)
+ return "last survivor";
+
+ printf("I need a shower.\n");
+
+ return 0;
+ }
+
+ int main(int argc, char* argv[]) {
+ const char* failure = aerobics();
+ if (failure == NULL) return 0;
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+CODE
+I need a shower.
+OUTPUT
+
+c_output_is(<<'CODE', <<'OUTPUT', "step aerobics");
+ #include <stdio.h>
+ #include "parrot/parrot.h"
+ #include "parrot/embed.h"
+
+ const char* aerobics(Interp* interpreter, IntArray* array, int ground)
+ {
+ int x = 0;
+ int N = 1000; /* Number of iterations */
+ int i;
+ static char msg[2000];
+
+ /* Push 3, then pop 2. Repeat N times. */
+ for (i = 0; i < N; i++) {
+ intarray_push(interpreter, array, x++);
+ intarray_push(interpreter, array, x++);
+ intarray_push(interpreter, array, x++);
+ if (intarray_pop(interpreter, array) != i * 3 + 2)
+ return "build-up first pop";
+ if (intarray_pop(interpreter, array) != i * 3 + 1)
+ return "build-up second pop";
+ if (intarray_length(interpreter, array)-ground != i + 1)
+ return "build-up length";
+ }
+
+ /* Check array_get for all values */
+ for (i = 0; i < N; i++) {
+ if (intarray_get(interpreter, array, i+ground) != i * 3) {
+ sprintf(msg, "get from left: wanted %d, got %d",
+ i * 3, intarray_get(interpreter, array, i));
+ return msg;
+ }
+ }
+
+ /* Check array_get for all values, from the right */
+ for (i = -N; i < 0; i++) {
+ if (intarray_get(interpreter, array, i) != (i + N) * 3)
+ return "get from right";
+ }
+
+ /* Set up the receding run */
+ intarray_push(interpreter, array, N * 3 * 10);
+
+ /* Pop 2, then push 1. Repeat N times. */
+ for (i = N; i > 0; i--) {
+ if (intarray_pop(interpreter, array) != i * 3 * 10)
+ return "tear down cap";
+ if (intarray_pop(interpreter, array) != (i - 1) * 3)
+ return "tear down inner";
+ intarray_push(interpreter, array, (i - 1) * 3 * 10);
+ if (intarray_length(interpreter, array)-ground != i)
+ return "tear down length";
+ }
+
+ /* And the final element is... */
+ if (intarray_pop(interpreter, array) != 0)
+ return "last survivor";
+ }
+
+ int main(int argc, char* argv[]) {
+ int i;
+ const char* failure;
+
+ IntArray* array;
+ Interp* interpreter;
+
+ interpreter = Parrot_new();
+ if (interpreter == NULL) return 1;
+ Parrot_init(interpreter, (void*) &interpreter);
+
+ array = intarray_new(interpreter);
+ if (array == NULL) return 1;
+
+ printf("Step 1: 0\n");
+ if ((failure = aerobics(interpreter, array, 0)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Step 2: 1\n");
+ intarray_push(interpreter, array, 42);
+ if ((failure = aerobics(interpreter, array, 1)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Step 3: 2\n");
+ intarray_unshift(interpreter, &array, -42);
+ if ((failure = aerobics(interpreter, array, 2)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Step 4: 255\n");
+ intarray_assign(interpreter, array, 254, -1);
+ if ((failure = aerobics(interpreter, array, 255)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Step 5: 256\n");
+ intarray_unshift(interpreter, &array, -3);
+ if ((failure = aerobics(interpreter, array, 256)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Step 6: 257\n");
+ intarray_unshift(interpreter, &array, -2);
+ if ((failure = aerobics(interpreter, array, 257)) != NULL) {
+ printf("Failed: %s\n", failure);
+ return 1;
+ }
+
+ printf("Done.\n");
+ return 0;
+ }
+CODE
+Step 1: 0
+Step 2: 1
+Step 3: 2
+Step 4: 255
+Step 5: 256
+Step 6: 257
+Done.
+OUTPUT
+
+c_output_is(<<'CODE', <<'OUTPUT', "yoyo");
+ #include <stdio.h>
+ #include "parrot/parrot.h"
+ #include "parrot/embed.h"
+
+ void yoyo(Interp* interpreter, IntArray** arrayP, int size)
+ {
+ int i;
+ int x = 0;
+ int distance = 1000;
+
+ /* Set up the yoyo */
+ for (i = 0; i < size; i++) {
+ intarray_push(interpreter, *arrayP, x++);
+ }
+
+ /* Flick it out */
+ for (i = 0; i < distance; i++) {
+ intarray_push(interpreter, *arrayP, x++);
+ if (intarray_get(interpreter, *arrayP, -1) != i + size)
+ printf("Out get failed on i=%d\n", i);
+ if (intarray_shift(interpreter, arrayP) != i)
+ printf("Out shift failed on i=%d\n", i);
+ }
+
+ /* Suck it back */
+ for (i = 0; i < distance + 10; i++) {
+ intarray_unshift(interpreter, arrayP, x++);
+ intarray_pop(interpreter, *arrayP);
+ }
+
+ /* Clean up the yoyo */
+ for (i = 0; i < size; i++) {
+ intarray_pop(interpreter, *arrayP);
+ }
+ }
+
+ int main(int argc, char* argv[]) {
+ int i;
+ const char* failure;
+
+ IntArray* array;
+ Interp* interpreter;
+
+ interpreter = Parrot_new();
+ if (interpreter == NULL) return 1;
+ Parrot_init(interpreter, (void*) &interpreter);
+
+ array = intarray_new(interpreter);
+ if (array == NULL) return 1;
+
+ for (i = 0; i < INTARRAY_CHUNK_SIZE * 2.5; i++) {
+ yoyo(interpreter, &array, i);
+ }
+
+ printf("Done.\n");
+ }
+CODE
+Done.
+OUTPUT
+
+1;
Index: config/gen/makefiles/root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.36
diff -p -u -a -r1.36 root.in
--- config/gen/makefiles/root.in 5 Sep 2002 17:58:32 -0000 1.36
+++ config/gen/makefiles/root.in 5 Sep 2002 19:17:32 -0000
@@ -71,7 +71,7 @@ $(INC)/global_setup.h $(INC)/vtable.h $(
$(INC)/oplib/core_ops_prederef.h $(INC)/runops_cores.h $(INC)/trace.h \
$(INC)/pmc.h $(INC)/key.h $(INC)/hash.h $(INC)/resources.h \
$(INC)/core_pmcs.h $(INC)/platform.h ${cg_h} \
-$(INC)/interp_guts.h $(INC)/rx.h $(INC)/rxstacks.h \
+$(INC)/interp_guts.h $(INC)/rx.h $(INC)/rxstacks.h $(INC)/intarray.h \
$(INC)/embed.h $(INC)/warnings.h $(INC)/misc.h $(INC)/pmc.h \
$(INC)/key.h $(INC)/hash.h $(INC)/smallobject.h $(INC)/headers.h $(INC)/dod.h \
$(INC)/method_util.h
@@ -96,7 +96,7 @@ INTERP_O_FILES = exceptions$(O) global_s
packfile$(O) stacks$(O) string$(O) sub$(O)
encoding$(O) \
chartype$(O) runops_cores$(O) trace$(O) pmc$(O)
key$(O) hash$(O) \
core_pmcs$(O) platform$(O) ${jit_o} \
- resources$(O) rx$(O) rxstacks$(O) \
+ resources$(O) rx$(O) rxstacks$(O) intarray$(O) \
embed$(O) warnings$(O) misc$(O) ${cg_o} \
packout$(O) byteorder$(O) debug$(O) smallobject$(O) \
headers$(O) dod$(O) method_util$(O)
@@ -326,6 +326,8 @@ pmc$(O) : $(GENERAL_H_FILES)
hash$(O) : $(GENERAL_H_FILES)
+intarray$(O) : $(GENERAL_H_FILES)
+
jit$(O) : $(GENERAL_H_FILES) ${jit_h} $(INC)/jit_emit.h
jit_cpu$(O): $(GENERAL_H_FILES) ${jit_h} $(INC)/jit_emit.h
@@ -343,6 +345,8 @@ resources$(O) : $(GENERAL_H_FILES)
platform$(O) : $(GENERAL_H_FILES)
core_pmcs$(O) : $(GENERAL_H_FILES)
+
+trace$(O) : $(GENERAL_H_FILES)
debug$(O) : $(GENERAL_H_FILES) $(INC)/debug.h
Index: classes/intarray.pmc
===================================================================
RCS file: classes/intarray.pmc
diff -N classes/intarray.pmc
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ classes/intarray.pmc 5 Sep 2002 19:24:00 -0000
@@ -0,0 +1,173 @@
+/* intarray.pmc
+ * Copyright: (When this is determined...it will go here)
+ * CVS Info
+ * $Id: perlarray.pmc,v 1.43 2002/08/19 23:15:20 tom Exp $
+ * Overview:
+ * These are the vtable functions for the IntArray class
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#include "parrot/parrot.h"
+
+#define THROW_UNSUPPORTED internal_exception(INTERP_ERROR, "Operation not
+supported\n")
+
+pmclass IntArray {
+
+ INTVAL type () {
+ return enum_class_PerlArray;
+ }
+
+ STRING* name() {
+ return whoami;
+ }
+
+ PMC* clone () {
+ THROW_UNSUPPORTED;
+ return NULL;
+ }
+
+ void init () {
+ SELF->data = intarray_new(INTERP);
+ SELF->cache.int_val = 0;
+ SELF->flags |= PMC_custom_mark_FLAG;
+ }
+
+ /* The end_of_used_list parameter is passed into the mark_used
+ * function of the garbage collector. */
+ PMC* mark (PMC *end_of_used_list) {
+ return intarray_mark(INTERP, (IntArray *) SELF->data,
+ end_of_used_list);
+ }
+
+ void set_integer_keyed_int (INTVAL* key, INTVAL value) {
+ if (!key) return;
+ intarray_assign(INTERP, (IntArray*) SELF->data, *key, value);
+ };
+
+ void set_integer_keyed (PMC* key, INTVAL value) {
+ INTVAL ix;
+
+ if (!key) return;
+
+ ix = key_integer(INTERP, key);
+ intarray_assign(INTERP, (IntArray*) SELF->data, ix, value);
+ };
+
+
+ void set_number_keyed_int (INTVAL* key, FLOATVAL value) {
+ INTVAL ix;
+
+ if (!key) return;
+
+ intarray_assign(INTERP, (IntArray*) SELF->data, *key, (INTVAL) value);
+ };
+
+ void set_number_keyed (PMC* key, FLOATVAL value) {
+ INTVAL ix;
+
+ if (!key) return;
+
+ ix = key_integer(INTERP, key);
+ intarray_assign(INTERP, (IntArray*) SELF->data, ix, (INTVAL) value);
+ };
+
+ void set_string_keyed_int (INTVAL* key, STRING* value) {
+ THROW_UNSUPPORTED;
+ };
+
+ void set_string_keyed (PMC* key, STRING* value) {
+ THROW_UNSUPPORTED;
+ };
+
+ void set_pmc_keyed_int (INTVAL* key, PMC* src, INTVAL* src_key) {
+ INTVAL ix;
+ INTVAL value;
+
+ if (!key) return;
+
+ value = src->vtable->get_integer_keyed_int(INTERP, src, src_key);
+ intarray_assign(INTERP, (IntArray*) SELF->data, *key, value);
+ };
+
+ void set_pmc_keyed (PMC* key, PMC* src, PMC* src_key) {
+ INTVAL ix;
+ INTVAL value;
+
+ if (!key) return;
+
+ ix = key_integer(INTERP, key);
+
+ value = src->vtable->get_integer_keyed(INTERP, src, src_key);
+ intarray_assign(INTERP, (IntArray*) SELF->data, ix, value);
+ };
+
+ INTVAL get_integer () {
+ return intarray_length(INTERP, (IntArray*) SELF->data);
+ };
+
+ INTVAL get_integer_keyed_int (INTVAL* key) {
+ return intarray_get(INTERP, (IntArray*) SELF->data, *key);
+ };
+
+ INTVAL get_integer_keyed (PMC* key) {
+ INTVAL ix;
+ if (!key) return 0;
+ ix = key_integer(INTERP, key);
+ return intarray_get(INTERP, (IntArray*) SELF->data, ix);
+ }
+
+ FLOATVAL get_number_keyed_int (INTVAL* key) {
+ THROW_UNSUPPORTED;
+ return 0.0;
+ }
+
+ FLOATVAL get_number_keyed (PMC* key) {
+ THROW_UNSUPPORTED;
+ return 0.0;
+ }
+
+ STRING* get_string_keyed_int (INTVAL* key) {
+ THROW_UNSUPPORTED;
+ return NULL;
+ }
+
+ STRING* get_string_keyed (PMC* key) {
+ THROW_UNSUPPORTED;
+ return NULL;
+ }
+
+ PMC* get_pmc_keyed_int (INTVAL* key) {
+ THROW_UNSUPPORTED;
+ return NULL;
+ }
+
+ PMC* get_pmc_keyed (PMC* key) {
+ THROW_UNSUPPORTED;
+ return NULL;
+ }
+
+ void push_integer (INTVAL value) {
+ intarray_push(INTERP, (IntArray*) SELF->data, value);
+ }
+
+ void push_float (FLOATVAL value) {
+ intarray_push(INTERP, (IntArray*) SELF->data, (INTVAL) value);
+ }
+
+ INTVAL pop_integer() {
+ return intarray_pop(INTERP, (IntArray*) SELF->data);
+ }
+
+ INTVAL pop_integer_keyed(PMC* key) {
+ THROW_UNSUPPORTED;
+ return 0;
+ }
+
+ INTVAL pop_integer_keyed_int(INTVAL* key) {
+ THROW_UNSUPPORTED;
+ return 0;
+ }
+}
Index: include/parrot/parrot.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/parrot.h,v
retrieving revision 1.48
diff -p -u -a -r1.48 parrot.h
--- include/parrot/parrot.h 23 Aug 2002 13:46:21 -0000 1.48
+++ include/parrot/parrot.h 5 Sep 2002 19:27:09 -0000
@@ -174,6 +180,7 @@ typedef void (*funcptr_t)(void);
#include "parrot/pmc.h"
#include "parrot/events.h"
#include "parrot/stacks.h"
+#include "parrot/intarray.h"
#include "parrot/smallobject.h"
#include "parrot/headers.h"
#include "parrot/dod.h"
