I'm probably misunderstanding something, but I'm using keys for groups
in regular expressions (the uses are internal and so require no
assembler support), and I was getting a lot of seg faults. After
taking a look, I don't understand the reason for the extra level of
indirection to KEY_PAIRs. A KEY contains an array of pointers to
KEY_PAIRs; I don't see why it can't just have an array of KEY_PAIRs.
For example, this macro in core.ops:
#define MAKE_KEY(k,k_p,v,c,t) if (v) {\
k_p.type = c;\
k_p.cache.t = v;\
k.size = 1;\
k.keys[0] = &k_p;\
}
does not work with an example usage of:
KEY key;
KEY_PAIR key_p;
MAKE_KEY(key, key_p, 42, enum_key_int, int_val);
because key.keys is an uninitialized array, so you can't assign to the
zeroth slot.
However, if KEY contains an array of KEY_PAIR, then the macro can be
#define MAKE_KEY(k,k_p,v,c,t) if (v) {\
k_p.type = c;\
k_p.cache.t = v;\
k.size = 1;\
k.keys = &k_p;\
}
and it'll work.
The following patch makes the change and updates array.pmc and
perlarray.pmc to use it. It also fixes the inconsistent semantics of
the argument to array_resize() (the source of more core dumps).
Sometimes it was the index of the last element, sometimes it was the
size of the array. Also, it zeroes out any new space allocated, and
when a new element is autovivified, it sticks a PerlUndef into it.
Dunno if that's what's supposed to happen, but it seemed better than
the core dumps.
I'll send a followup patch that updates the .ops files (mainly rx.ops)
to define and use the working MAKE_KEY.
Index: include/parrot/key.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/key.h,v
retrieving revision 1.9
diff -p -u -b -r1.9 key.h
--- include/parrot/key.h 4 Mar 2002 03:17:21 -0000 1.9
+++ include/parrot/key.h 27 Mar 2002 18:41:28 -0000
@@ -39,7 +39,7 @@ typedef struct _key_pair KEY_PAIR;
struct _key {
INTVAL size;
- KEY_PAIR **keys;
+ KEY_PAIR *keys;
};
typedef struct _key KEY;
Index: key.c
===================================================================
RCS file: /home/perlcvs/parrot/key.c,v
retrieving revision 1.23
diff -p -u -b -r1.23 key.c
--- key.c 5 Mar 2002 04:26:10 -0000 1.23
+++ key.c 27 Mar 2002 18:41:28 -0000
@@ -29,7 +29,7 @@ debug_key(struct Parrot_Interp *interpre
fprintf(stderr, " *** key %p\n", key);
fprintf(stderr, " *** size " INTVAL_FMT "\n", key->size);
for (i = 0; i < key->size; i++) {
- INTVAL type = key->keys[i]->type;
+ INTVAL type = key->keys[i].type;
if (type == enum_key_bucket) {
fprintf(stderr, " *** Bucket " INTVAL_FMT " type " INTVAL_FMT "\n",
i, type);
@@ -199,9 +199,9 @@ key_set_size(struct Parrot_Interp *inter
(KEY_PAIR *)realloc(key->keys, sizeof(KEY_PAIR *) * size);
if (pair != NULL) {
INTVAL i;
- key->keys = (KEY_PAIR **)pair;
+ key->keys = pair;
for (i = key->size; i < size; i++) {
- key->keys[i]->type = enum_key_undef;
+ key->keys[i].type = enum_key_undef;
}
}
else {
@@ -215,7 +215,7 @@ key_set_size(struct Parrot_Interp *inter
/* Memory leak in the making */
}
key->keys =
- (KEY_PAIR **)realloc(key->keys, sizeof(KEY_PAIR *) * size);
+ (KEY_PAIR *)realloc(key->keys, sizeof(KEY_PAIR *) * size);
}
key->size = size;
}
@@ -316,7 +316,7 @@ key_element_value_s(struct Parrot_Interp
hash = hash % NUM_BUCKETS;
pair =
find_bucket(interpreter,
- (BUCKET *)key->keys[hash]->cache.struct_val, idx);
+ (BUCKET *)key->keys[hash].cache.struct_val, idx);
if (pair == NULL) {
internal_exception(KEY_NOT_FOUND,
"*** key_element_value_s pair returning a null
key\n");
@@ -384,14 +384,14 @@ key_set_element_value_s(struct Parrot_In
if (hash >= key->size) {
key_set_size(interpreter, key, hash + 1);
}
- if (key->keys[hash]->type != enum_key_undef) {
- STRING *tmp = key->keys[hash]->cache.struct_val;
+ if (key->keys[hash].type != enum_key_undef) {
+ STRING *tmp = key->keys[hash].cache.struct_val;
bucket->next = (BUCKET *)tmp;
}
else {
}
- key->keys[hash]->cache.struct_val = (STRING *)bucket;
- key->keys[hash]->type = enum_key_bucket;
+ key->keys[hash].cache.struct_val = (STRING *)bucket;
+ key->keys[hash].type = enum_key_bucket;
}
else {
fprintf(stderr,
@@ -430,7 +430,7 @@ key_chop(struct Parrot_Interp *interpret
/* Memory leak in the making */
key->size--;
key->keys =
- (KEY_PAIR **)realloc(key->keys,
+ (KEY_PAIR *)realloc(key->keys,
sizeof(KEY_PAIR *) * key->size);
}
else if (key->size == 0) {
Index: classes/array.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/array.pmc,v
retrieving revision 1.18
diff -p -u -b -r1.18 array.pmc
--- classes/array.pmc 14 Mar 2002 14:46:23 -0000 1.18
+++ classes/array.pmc 27 Mar 2002 18:41:29 -0000
@@ -83,7 +83,7 @@ pmclass Array {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -107,7 +107,7 @@ pmclass Array {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -131,7 +131,7 @@ pmclass Array {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -184,7 +184,7 @@ pmclass Array {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -221,7 +221,7 @@ pmclass Array {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -256,7 +256,7 @@ pmclass Array {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp2int(INTERP, *kp);
if (ix > SELF->cache.int_val || ix < 0) {
@@ -275,7 +275,7 @@ pmclass Array {
src = src->vtable->get_pmc_keyed(INTERP, src, src_key);
}
if (dest_key) {
- INTVAL ix = kp2int(INTERP, *((dest_key->keys)[0]));
+ INTVAL ix = kp2int(INTERP, dest_key->keys[0]);
PMC* dest = ((PMC**)(((Buffer *)SELF->data)->bufstart))[ix];
dest->vtable->set_pmc(INTERP, dest, src);
}
Index: classes/perlarray.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/perlarray.pmc,v
retrieving revision 1.23
diff -p -u -b -r1.23 perlarray.pmc
--- classes/perlarray.pmc 14 Mar 2002 14:46:23 -0000 1.23
+++ classes/perlarray.pmc 27 Mar 2002 18:41:30 -0000
@@ -13,10 +13,12 @@
#include "parrot/parrot.h"
static void resize_array ( struct Parrot_Interp *interpreter, PMC* self, INTVAL size
) {
- size++;
+ int oldsize = self->cache.int_val;
if(self->data != NULL) {
if(size >= 0) {
- ((Buffer *)self->data)->bufstart = mem_realloc(interpreter,
self->data,self->cache.int_val*sizeof(PMC *),sizeof(PMC*)*size);
+ ((Buffer *)self->data)->bufstart = mem_realloc(interpreter,
+self->data,oldsize*sizeof(PMC *),size*sizeof(PMC*));
+ if (size > oldsize)
+ memset(self->data + oldsize * sizeof(PMC *), 0, (size - oldsize) *
+sizeof(PMC *));
}
else {
internal_exception(OUT_OF_BOUNDS,
@@ -26,7 +28,10 @@ static void resize_array ( struct Parrot
else {
self->data = new_buffer_header(interpreter);
((Buffer *)self->data)->bufstart = Parrot_allocate(interpreter,
sizeof(PMC*)*size);
+ memset(self->data, 0, size * sizeof(PMC *));
}
+
+ self->cache.int_val = size;
}
pmclass PerlArray {
@@ -75,17 +80,18 @@ pmclass PerlArray {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
if (ix < 0) {
ix += SELF->cache.int_val;
}
value = ((PMC**)(SELF->data))[ix];
+ if (value == NULL) value = pmc_new(INTERP, enum_class_PerlUndef);
return value->vtable->get_integer(INTERP, value);
}
@@ -102,11 +108,11 @@ pmclass PerlArray {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
if (ix < 0) {
ix += SELF->cache.int_val;
@@ -129,11 +135,11 @@ pmclass PerlArray {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
else if (ix < 0) {
ix += SELF->cache.int_val;
@@ -186,27 +192,32 @@ pmclass PerlArray {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
else if (ix < 0) {
ix += SELF->cache.int_val;
}
pmc2 = ((PMC**)(SELF->data))[ix];
+ if (pmc2 == NULL) {
+ pmc2 = pmc_new(INTERP, enum_class_PerlInt);
+ ((PMC**)(SELF->data))[ix] = pmc2;
+ }
+
pmc2->vtable->set_integer_native(INTERP, pmc2, value);
}
void set_number (PMC * value) {
INTVAL size = (INTVAL)value->cache.num_val;
- resize_array(interpreter, SELF,size);
+ resize_array(interpreter, SELF, size+1);
}
void set_number_native (FLOATVAL size) {
- resize_array(interpreter, SELF,(INTVAL)size);
+ resize_array(interpreter, SELF, (INTVAL)size);
}
void set_number_bigfloat (BIGFLOAT value) {
@@ -226,11 +237,11 @@ pmclass PerlArray {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
else if (ix < 0) {
ix += SELF->cache.int_val;
@@ -264,11 +275,11 @@ pmclass PerlArray {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
- if (ix > SELF->cache.int_val) {
- resize_array(interpreter, SELF,ix);
+ if (ix >= SELF->cache.int_val) {
+ resize_array(interpreter, SELF, ix+1);
}
else if (ix < 0) {
ix += SELF->cache.int_val;
Index: classes/perlhash.pmc
===================================================================
RCS file: /home/perlcvs/parrot/classes/perlhash.pmc,v
retrieving revision 1.15
diff -p -u -b -r1.15 perlhash.pmc
--- classes/perlhash.pmc 10 Mar 2002 21:18:13 -0000 1.15
+++ classes/perlhash.pmc 27 Mar 2002 18:41:31 -0000
@@ -59,7 +59,7 @@ pmclass PerlHash {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
@@ -89,7 +89,7 @@ pmclass PerlHash {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
@@ -119,7 +119,7 @@ pmclass PerlHash {
return 0;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
@@ -177,7 +177,7 @@ pmclass PerlHash {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
@@ -219,7 +219,7 @@ pmclass PerlHash {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
@@ -259,7 +259,7 @@ pmclass PerlHash {
return;
}
- kp = (key->keys)[0];
+ kp = &key->keys[0];
ix = kp->cache.int_val;
if (ix > SELF->cache.int_val) {
