This patch obsoletes my previous two key-related patches. It's a large patch that does a bunch of things, so I'd like somebody to give an opinion before I commit it.
- Changes KEY to contain a KEY_PAIR* instead of a KEY_PAIR** - Changes the MAKE_KEY macro to work within an expression - Changes the MAKE_KEY macro to not return NULL if the value is 0 or NULL. This is needed because an enum_int_val key, for example, will quite often have the value zero, but that shouldn't mean the whole aggregate. I think we'll have to add another macro or a flag for keys with those semantics. But this patch is trying to be the minimum necessary to get PerlArrays working again. - Adds various *_keyed ops to core.ops. This is an incomplete set, because I thought someone might be thinking about autogenerating some of them. This is enough to access command-line parameters and use PerlArrays of PerlInts. - Adds back in the copying of the command-line parameters to P0. - Makes the rx_*group* opcodes work again (they use PerlArrays) - Fixes the array_resize logic. It was totally inconsistent about whether its size parameter was a size or an index, and could seg fault as a result. - Makes array_resize zero out newly allocated memory. This is the only way to tell whether an array slot has been initialized yet. - Sets the PMC GC flags for PerlArrays. - Automatically creates PerlStrings/PerlInts/PerlNums when assigning strings, integers, or numbers to uninitialized PerlArray slots. I'm sorry this patch isn't split up more, but the lines overlap a lot, and I think the whole thing passes the "better than what's there now" test. -- WM ISO JOB. http://foxglove.dnsalias.org/~sfink/job.html C, perl, networking, performance optimization, Java, XML. Index: include/parrot/key.h =================================================================== RCS file: /home/perlcvs/parrot/include/parrot/key.h,v retrieving revision 1.9 diff -u -r1.9 key.h --- include/parrot/key.h 4 Mar 2002 03:17:21 -0000 1.9 +++ include/parrot/key.h 29 Mar 2002 06:04:39 -0000 @@ -39,7 +39,7 @@ struct _key { INTVAL size; - KEY_PAIR **keys; + KEY_PAIR *keys; }; typedef struct _key KEY; Index: core.ops =================================================================== RCS file: /home/perlcvs/parrot/core.ops,v retrieving revision 1.114 diff -u -r1.114 core.ops --- core.ops 28 Mar 2002 08:02:02 -0000 1.114 +++ core.ops 29 Mar 2002 06:04:24 -0000 @@ -2,15 +2,16 @@ ** core.ops */ -/* This convoluted mess avoids costly runtime creation of KEY -and KEY_PAIR structures. */ - -#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;\ - } +/* This (now even more) convoluted mess avoids costly runtime creation + * of KEY and KEY_PAIR structures, and can be used in an expression. + */ + +#define MAKE_KEY(k,k_p,v,c,t) (\ + k_p.type = c,\ + k_p.cache.t = v,\ + k.size = 1,\ + k.keys = &k_p,\ + &k) VERSION = PARROT_VERSION; @@ -565,6 +566,22 @@ goto NEXT(); } +inline op get_keyed(out INT, in PMC, in INT) { + KEY_PAIR key_p; + KEY key; + MAKE_KEY(key, key_p, $3, enum_key_int, int_val); + $1 = $2->vtable->get_integer_keyed(interpreter, $2, &key); + goto NEXT(); +} + +inline op get_keyed(out STR, in PMC, in INT) { + KEY_PAIR key_p; + KEY key; + MAKE_KEY(key, key_p, $3, enum_key_int, int_val); + $1 = $2->vtable->get_string_keyed(interpreter, $2, &key); + goto NEXT(); +} + =item B<set_keyed>(out PMC, out PMC, in PMC, in PMC) $1[$2] = $3[$4]; @@ -580,6 +597,26 @@ $1->vtable->set_pmc_keyed(interpreter, $1, $2 ? &src_key : NULL, $3, $4 ? &dest_key : NULL); + goto NEXT(); +} + +inline op set_keyed (out PMC, in INT, in INT) { + KEY_PAIR key_p; + KEY key; + + MAKE_KEY(key, key_p, $2, enum_key_int, int_val); + + $1->vtable->set_integer_keyed(interpreter, $1, &key, $3); + goto NEXT(); +} + +inline op set_keyed (out PMC, in INT, in STR) { + KEY_PAIR key_p; + KEY key; + + MAKE_KEY(key, key_p, $2, enum_key_int, int_val); + + $1->vtable->set_string_keyed(interpreter, $1, &key, $3); goto NEXT(); } Index: embed.c =================================================================== RCS file: /home/perlcvs/parrot/embed.c,v retrieving revision 1.18 diff -u -r1.18 embed.c --- embed.c 9 Mar 2002 00:59:56 -0000 1.18 +++ embed.c 29 Mar 2002 19:35:26 -0000 @@ -165,6 +165,8 @@ { INTVAL i; PMC *userargv; + KEY key; + KEY_PAIR key_p; if (interpreter->flags & PARROT_DEBUG_FLAG) { fprintf(stderr, "*** Parrot VM: Debugging enabled. ***\n"); @@ -195,20 +197,24 @@ } userargv = pmc_new(interpreter, enum_class_PerlArray); + /* immediately anchor pmc to root set */ + interpreter->pmc_reg.registers[0] = userargv; + + key.size = 1; + key.keys = &key_p; + key_p.type = enum_key_int; for (i = 0; i < argc; i++) { + STRING* arg = string_make(interpreter, argv[i], strlen(argv[i]), + 0, BUFFER_external_FLAG, 0); + if (interpreter->flags & PARROT_DEBUG_FLAG) { fprintf(stderr, "\t" INTVAL_FMT ": %s\n", i, argv[i]); } - /* XXX: Delayed - * userargv->vtable->set_string_index(interpreter, userargv, - * string_make(interpreter, argv[i], strlen(argv[i]), 0, 0, 0), i - * ); - */ + key_p.cache.int_val = i; + userargv->vtable->set_string_keyed(interpreter, userargv, &key, arg); } - - interpreter->pmc_reg.registers[0] = userargv; runops(interpreter, interpreter->code, 0); Index: key.c =================================================================== RCS file: /home/perlcvs/parrot/key.c,v retrieving revision 1.23 diff -u -r1.23 key.c --- key.c 5 Mar 2002 04:26:10 -0000 1.23 +++ key.c 29 Mar 2002 06:04:25 -0000 @@ -29,7 +29,7 @@ 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_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 @@ /* 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 @@ 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 @@ 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 @@ /* 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: rx.ops =================================================================== RCS file: /home/perlcvs/parrot/rx.ops,v retrieving revision 1.16 diff -u -r1.16 rx.ops --- rx.ops 15 Feb 2002 02:30:02 -0000 1.16 +++ rx.ops 29 Mar 2002 19:36:52 -0000 @@ -372,12 +372,13 @@ =cut op rx_info_getgroup(in pmc, out int, out int, in int) { + KEY_PAIR key_p; + KEY key; RX_dUNPACK($1); - /* Delayed XXX - $2=rx->groupstart->vtable->get_integer_index(interpreter, rx->groupstart, $4); - $3=rx->groupend->vtable->get_integer_index(interpreter, rx->groupend, $4); - */ + MAKE_KEY(key, key_p, $4, enum_key_int, int_val); + $2=rx->groupstart->vtable->get_integer_keyed(interpreter, rx->groupstart, +&key); + $3=rx->groupend->vtable->get_integer_keyed(interpreter, rx->groupend, &key); goto NEXT(); } @@ -635,11 +636,12 @@ =cut op rx_startgroup(in pmc, in int) { + KEY_PAIR key_p; + KEY key; RX_dUNPACK($1); - /* XXX Delayed - rx->groupstart->vtable->set_integer_index(interpreter, rx->groupstart, rx->index, $2); - */ + MAKE_KEY(key, key_p, $2, enum_key_int, int_val); + rx->groupstart->vtable->set_integer_keyed(interpreter, rx->groupstart, &key, +rx->index); goto NEXT(); } @@ -654,13 +656,14 @@ =cut op rx_endgroup(in pmc, in int) { - RX_dUNPACK($1); + KEY_PAIR key_p; + KEY key; + RX_dUNPACK($1); - /* XXX Delayed - rx->groupend->vtable->set_integer_index(interpreter, rx->groupend, rx->index, $2); - */ + MAKE_KEY(key, key_p, $2, enum_key_int, int_val); + rx->groupend->vtable->set_integer_keyed(interpreter, rx->groupend, &key, +rx->index); - goto NEXT(); + goto NEXT(); } ######################################## Index: classes/array.pmc =================================================================== RCS file: /home/perlcvs/parrot/classes/array.pmc,v retrieving revision 1.18 diff -u -r1.18 array.pmc --- classes/array.pmc 14 Mar 2002 14:46:23 -0000 1.18 +++ classes/array.pmc 29 Mar 2002 06:04:34 -0000 @@ -83,7 +83,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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/perlhash.pmc =================================================================== RCS file: /home/perlcvs/parrot/classes/perlhash.pmc,v retrieving revision 1.15 diff -u -r1.15 perlhash.pmc --- classes/perlhash.pmc 10 Mar 2002 21:18:13 -0000 1.15 +++ classes/perlhash.pmc 29 Mar 2002 06:04:37 -0000 @@ -59,7 +59,7 @@ 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 @@ 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 @@ 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 @@ return; } - kp = (key->keys)[0]; + kp = &key->keys[0]; ix = kp->cache.int_val; if (ix > SELF->cache.int_val) { @@ -219,7 +219,7 @@ return; } - kp = (key->keys)[0]; + kp = &key->keys[0]; ix = kp->cache.int_val; if (ix > SELF->cache.int_val) { @@ -259,7 +259,7 @@ return; } - kp = (key->keys)[0]; + kp = &key->keys[0]; ix = kp->cache.int_val; if (ix > SELF->cache.int_val) { Index: classes/perlarray.pmc =================================================================== RCS file: /home/perlcvs/parrot/classes/perlarray.pmc,v retrieving revision 1.23 diff -u -r1.23 perlarray.pmc --- classes/perlarray.pmc 14 Mar 2002 14:46:23 -0000 1.23 +++ classes/perlarray.pmc 29 Mar 2002 20:00:42 -0000 @@ -13,10 +13,13 @@ #include "parrot/parrot.h" static void resize_array ( struct Parrot_Interp *interpreter, PMC* self, INTVAL size ) { - size++; - if(self->data != NULL) { + int oldsize = self->cache.int_val; + Buffer* buffer = (Buffer *) self->data; + if(buffer != NULL) { if(size >= 0) { - ((Buffer *)self->data)->bufstart = mem_realloc(interpreter, self->data,self->cache.int_val*sizeof(PMC *),sizeof(PMC*)*size); + buffer->bufstart = mem_realloc(interpreter, buffer->bufstart, +oldsize*sizeof(PMC *), size*sizeof(PMC*)); + if (size > oldsize) + memset(buffer->bufstart + oldsize * sizeof(PMC *), 0, (size - +oldsize) * sizeof(PMC *)); } else { internal_exception(OUT_OF_BOUNDS, @@ -24,9 +27,14 @@ } } else { - self->data = new_buffer_header(interpreter); - ((Buffer *)self->data)->bufstart = Parrot_allocate(interpreter, sizeof(PMC*)*size); + buffer = (Buffer *) self->data = new_buffer_header(interpreter); + self->flags |= PMC_is_buffer_ptr_FLAG; + self->flags |= PMC_is_PMC_ptr_FLAG; + buffer->bufstart = Parrot_allocate(interpreter, sizeof(PMC*)*size); + memset(buffer->bufstart, 0, size * sizeof(PMC *)); } + + self->cache.int_val = size; } pmclass PerlArray { @@ -40,8 +48,10 @@ } void init (INTVAL size) { - SELF->data = mem_sys_allocate(sizeof(PMC*)); + SELF->flags |= PMC_is_container_FLAG; + SELF->data = NULL; SELF->cache.int_val = 0; + resize_array(INTERP, SELF, 0); } void clone (PMC* dest) { @@ -55,11 +65,11 @@ } INTVAL real_size () { - return 0; /* ->data is unused */ + return 0; /* ->data is unused */ /* XXX Huh? */ } void destroy () { - key_destroy(INTERP,SELF->data); + key_destroy(INTERP,SELF->data); /* XXX Huh? */ } INTVAL get_integer () { @@ -70,22 +80,25 @@ KEY_PAIR* kp; INTVAL ix; PMC* value; + PMC** array; if (!key) { 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]; + array = ((Buffer *) SELF->data)->bufstart; + value = array[ix]; + if (value == NULL) value = pmc_new(INTERP, enum_class_PerlUndef); return value->vtable->get_integer(INTERP, value); } @@ -97,22 +110,25 @@ KEY_PAIR* kp; INTVAL ix; PMC* value; + PMC** array; if (!key) { 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]; + array = ((Buffer *) SELF->data)->bufstart; + value = array[ix]; + if (value == NULL) value = pmc_new(INTERP, enum_class_PerlUndef); return value->vtable->get_number(INTERP, value); } @@ -124,22 +140,25 @@ KEY_PAIR* kp; INTVAL ix; PMC* value; + PMC** array; if (!key) { 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; } - value = ((PMC**)(SELF->data))[ix]; + array = ((Buffer *) SELF->data)->bufstart; + value = array[ix]; + if (value == NULL) value = pmc_new(INTERP, enum_class_PerlUndef); return value->vtable->get_string(INTERP, value); } @@ -162,11 +181,11 @@ void set_integer (PMC* value) { INTVAL size = value->vtable->get_integer(INTERP,value); - resize_array(interpreter, SELF,size); + resize_array(interpreter, SELF, size); } void set_integer_native (INTVAL size) { - resize_array(interpreter, SELF,size); + resize_array(interpreter, SELF, size); } void set_integer_bigint (BIGINT value) { @@ -174,39 +193,44 @@ void set_integer_same (PMC * value) { INTVAL size = value->cache.int_val; - resize_array(interpreter, SELF,size); + resize_array(interpreter, SELF, size); } void set_integer_keyed (KEY * key, INTVAL value) { KEY_PAIR* kp; INTVAL ix; PMC* pmc2; + PMC** array; if (!key) { 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]; + array = ((Buffer *) SELF->data)->bufstart; + pmc2 = array[ix]; + if (pmc2 == NULL) + array[ix] = pmc2 = pmc_new(INTERP, enum_class_PerlInt); + 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) { @@ -214,29 +238,34 @@ void set_number_same (PMC * value) { INTVAL size = value->cache.int_val; - resize_array(interpreter, SELF,size); + resize_array(interpreter, SELF, size); } void set_number_keyed (KEY * key, FLOATVAL value) { KEY_PAIR* kp; INTVAL ix; PMC* pmc2; + PMC** array; if (!key) { 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]; + array = ((Buffer *) SELF->data)->bufstart; + pmc2 = array[ix]; + if (pmc2 == NULL) + array[ix] = pmc2 = pmc_new(INTERP, enum_class_PerlNum); + pmc2->vtable->set_number_native(INTERP, pmc2, value); } @@ -259,22 +288,27 @@ KEY_PAIR* kp; INTVAL ix; PMC* pmc2; + PMC** array; if (!key) { 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]; + array = ((Buffer *) SELF->data)->bufstart; + pmc2 = array[ix]; + if (pmc2 == NULL) + array[ix] = pmc2 = pmc_new(INTERP, enum_class_PerlString); + pmc2->vtable->set_string_native(INTERP, pmc2, value); }
