# New Ticket Created by Leopold Toetsch
# Please include the string: [perl #17549]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17549 >
Attached patch
- corrects a bug in int_list_assign 1)
- makes direct access fly
intlist_3.pbc is with 1) already 10 times faster then the same test with
PerlArray (ok, that's not fair, .PerlArray has to new_pmc, which
accounts for ~40% difference).
With the patch there is another factor 10 speed gain.
So I think, we should make intlist the base class for our array class(es).
Please apply,
leo
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/38478/31277/a15b0f/intlist.patch
--- parrot/intlist.c Mon Sep 9 07:47:48 2002
+++ parrot-leo/intlist.c Tue Sep 24 06:44:44 2002
@@ -77,8 +77,10 @@
#include "parrot/parrot.h"
#include "parrot/intlist.h"
+static size_t rebuild_chunk_list(Interp *interpreter, IntList *list);
+
IntList*
-intlist_new(Interp *interpreter)
+intlist_new(Interp *interpreter, int initial)
{
IntList* list;
@@ -93,6 +95,13 @@
interpreter->GC_block_level++;
Parrot_allocate(interpreter, (Buffer*) list,
INTLIST_CHUNK_SIZE * sizeof(INTVAL));
+ if (initial) {
+ /* XXX managed memory or custom destroy? */
+ list->chunk_list = mem_sys_allocate(sizeof(IntList_Chunk *));
+ list->n_chunks = 1;
+ list->collect_runs = interpreter->collect_runs;
+ list->chunk_list[0] = (IntList_Chunk*) list;
+ }
interpreter->DOD_block_level--;
interpreter->GC_block_level--;
return list;
@@ -136,6 +145,25 @@
fprintf(fp, "\n");
}
+static size_t
+rebuild_chunk_list(Interp *interpreter, IntList *list)
+{
+ IntList_Chunk* chunk = (IntList_Chunk*) list;
+ IntList_Chunk* lastChunk = list->prev;
+ size_t len = 0;
+ while (1) {
+ if (len >= list->n_chunks)
+ list->chunk_list = mem_sys_realloc(list->chunk_list,
+ (len + 1)* sizeof(IntList*));
+ list->chunk_list[len] = chunk;
+ len++;
+ if (chunk == lastChunk) break;
+ chunk = chunk->next;
+ }
+ list->collect_runs = interpreter->collect_runs;
+ return len;
+}
+
static void
add_chunk(Interp* interpreter, IntList* list)
{
@@ -143,7 +171,7 @@
if (chunk->next == list) {
/* Need to add a new chunk */
- IntList_Chunk* new_chunk = intlist_new(interpreter);
+ IntList_Chunk* new_chunk = intlist_new(interpreter, 0);
new_chunk->next = list;
new_chunk->prev = chunk;
chunk->next = new_chunk;
@@ -161,6 +189,7 @@
add_chunk(interpreter, list);
list->prev->start = 0;
list->prev->end = 0;
+ list->n_chunks = rebuild_chunk_list(interpreter, list);
}
static void
@@ -198,6 +227,10 @@
unshift_chunk(interpreter, *list);
chunk = chunk->prev;
*list = chunk;
+ (*list)->chunk_list = chunk->chunk_list;
+ (*list)->n_chunks = chunk->n_chunks;
+ chunk->chunk_list = 0;
+ (*list)->n_chunks = rebuild_chunk_list(interpreter, *list);
}
((INTVAL*)chunk->buffer.bufstart)[--chunk->start] = data;
@@ -225,6 +258,10 @@
chunk->next->prev = chunk->prev;
chunk->prev->next = chunk;
*list = chunk->next;
+ (*list)->chunk_list = chunk->chunk_list;
+ (*list)->n_chunks = chunk->n_chunks;
+ chunk->chunk_list = 0;
+ (*list)->n_chunks = rebuild_chunk_list(interpreter, *list);
}
(*list)->length = length;
@@ -245,6 +282,7 @@
chunk->next = list;
list->prev = chunk->prev;
chunk = chunk->prev;
+ list->n_chunks--;
}
/* Quick sanity check */
@@ -265,6 +303,12 @@
IntList_Chunk* chunk = list;
UNUSED(interpreter);
+ /* XXX do we need this? */
+ if (list->collect_runs != interpreter->collect_runs)
+ rebuild_chunk_list(interpreter, list);
+
+ return list->chunk_list[idx / INTLIST_CHUNK_SIZE];
+#if 0
/* Possible optimization: start from the closer end of the chunk list */
/* Find the chunk containing the requested element */
@@ -274,6 +318,7 @@
}
return chunk;
+#endif
}
INTVAL
@@ -347,7 +392,9 @@
chunk = find_chunk(interpreter, list, idx);
- ((INTVAL*)chunk->buffer.bufstart)[idx] = val;
+ if (idx >= list->end - list->start) idx -= list->end - list->start;
+ idx = idx % INTLIST_CHUNK_SIZE;
+ ((INTVAL*)chunk->buffer.bufstart)[idx + chunk->start] = val;
}
/*
--- parrot/include/parrot/intlist.h Mon Sep 9 07:49:08 2002
+++ parrot-leo/include/parrot/intlist.h Tue Sep 24 06:32:06 2002
@@ -24,7 +24,10 @@
struct IntList_chunk_t {
Buffer buffer; /* This struct is a Buffer header subclass! */
- INTVAL length; /* Only valid for the "head" chunk */
+ INTVAL length; /* Only valid for the "head" chunk (1) */
+ size_t collect_runs; /* when chunklist was built (1) */
+ IntList_Chunk ** chunk_list; /* list of chunks for fast access (1) */
+ size_t n_chunks; /* number of chunks in chunk_list */
INTVAL start;
INTVAL end;
IntList_Chunk* next;
@@ -35,7 +38,7 @@
PMC* intlist_mark(Interp*, IntList*, PMC* last);
-IntList *intlist_new(Interp*);
+IntList *intlist_new(Interp*, int initial);
static INTVAL intlist_length(Interp* interpreter, IntList* list)
{
--- parrot/classes/intlist.pmc Mon Sep 9 07:48:15 2002
+++ parrot-leo/classes/intlist.pmc Tue Sep 24 06:31:38 2002
@@ -30,7 +30,7 @@
}
void init () {
- SELF->data = intlist_new(INTERP);
+ SELF->data = intlist_new(INTERP, 1);
SELF->cache.int_val = 0;
SELF->flags |= PMC_custom_mark_FLAG;
}
--- parrot/t/pmc/intlist.t Mon Sep 9 07:49:35 2002
+++ parrot-leo/t/pmc/intlist.t Tue Sep 24 06:30:07 2002
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "creation");
@@ -145,3 +145,38 @@
CODE
I need a shower.
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "direct access");
+ new P0, .IntList
+ set I10, 100000
+ set I0, 0
+lp:
+ set P0[I0], I0
+ inc I0
+ mod I9, I0, 100
+ ne I9, 0, lp1
+ # force GC => 142 DOD + 142 collects / 10^5 accesses
+ new P1, .PerlArray
+ set P1[I0], I0
+lp1:
+ le I0, I10, lp
+
+ set I0, 0
+lp2:
+ set I1, P0[I0]
+ ne I0, I1, err
+ inc I0
+ le I0, I10, lp2
+ print "ok\n"
+ end
+err:
+ print "err: wanted "
+ print I0
+ print " got "
+ print I1
+ print "\n"
+ end
+CODE
+ok
+OUTPUT
+
