Very simple patch which just passes size argument to the init vtable
method so PMCs have the option to know how to size themselves
at creation. size could be N elements or a byte count, depending
on the PMC or it can just be ignored.
Minor patch to the assembler for the new_p_ic_ic opcode to
work same as new_p_ic (looks up a named class).
-Melvin
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/core.ops,v
retrieving revision 1.101
diff -u -r1.101 core.ops
--- core.ops 6 Mar 2002 15:45:28 -0000 1.101
+++ core.ops 10 Mar 2002 07:14:55 -0000
@@ -2517,13 +2517,18 @@
=item B<new>(out PMC, in INT)
+=item B<new>(out PMC, in INT, in INT)
+
Create a new PMC of class C<i>; look in F<pmc.h> for the base
vtable types. The assembler allows you to specify PMCs by type
name as well as by integer - you should do this for compatibility,
to avoid problems if the base types get reassigned. For example:
- new P0, PerlScalar
+Optionally a size may be passed to the constructor which may or
+may not be used by the particular class.
+ new P0, PerlScalar
+ new P0, PerlStruct, 64
=cut
op new(out PMC, in INT) {
@@ -2532,6 +2537,16 @@
abort(); /* Deserve to lose */
}
newpmc = pmc_new(interpreter, $2);
+ $1 = newpmc;
+ goto NEXT();
+}
+
+op new(out PMC, in INT, in INT) {
+ PMC* newpmc;
+ if ($2 <0 || $2 >= enum_class_max) {
+ abort(); /* Deserve to lose */
+ }
+ newpmc = pmc_new_sized(interpreter, $2, $3);
$1 = newpmc;
goto NEXT();
}
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/pmc.c,v
retrieving revision 1.10
diff -u -r1.10 pmc.c
--- pmc.c 5 Mar 2002 05:30:17 -0000 1.10
+++ pmc.c 10 Mar 2002 07:14:55 -0000
@@ -52,7 +52,35 @@
return NULL;
}
- pmc->vtable->init(interpreter, pmc);
+ pmc->vtable->init(interpreter, pmc, 0);
+ return pmc;
+}
+
+PMC *
+pmc_new_sized(struct Parrot_Interp *interpreter, INTVAL base_type, INTVAL
size)
+{
+ PMC *pmc = new_pmc_header(interpreter);
+
+ if (!pmc) {
+ internal_exception(ALLOCATION_ERROR,
+ "Parrot VM: PMC allocation failed!\n");
+ return NULL;
+ }
+
+ pmc->flags = 0;
+ pmc->data = 0;
+
+ pmc->vtable = &(Parrot_base_vtables[base_type]);
+
+ if (!pmc->vtable || !pmc->vtable->init) {
+ /* This is usually because you either didn't call init_world early
+ * enough or you added a new PMC class without adding
+ * Parrot_(classname)_class_init to init_world. */
+ PANIC("Null vtable used");
+ return NULL;
+ }
+
+ pmc->vtable->init(interpreter, pmc, size);
return pmc;
}
Index: classes/array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.16
diff -u -r1.16 array.pmc
--- classes/array.pmc 6 Mar 2002 17:02:59 -0000 1.16
+++ classes/array.pmc 10 Mar 2002 07:14:56 -0000
@@ -53,7 +53,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->data = new_pmc_header(interpreter);
((Buffer *)SELF->data)->bufstart = NULL;
SELF->flags |= (PMC_is_buffer_ptr_FLAG | PMC_is_PMC_ptr_FLAG);
Index: classes/default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.13
diff -u -r1.13 default.pmc
--- classes/default.pmc 11 Feb 2002 20:03:19 -0000 1.13
+++ classes/default.pmc 10 Mar 2002 07:14:57 -0000
@@ -21,7 +21,7 @@
return NULL;
}
- void init () {
+ void init (INTVAL size) {
}
void clone (PMC* dest) {
Index: classes/intqueue.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/intqueue.pmc,v
retrieving revision 1.5
diff -u -r1.5 intqueue.pmc
--- classes/intqueue.pmc 9 Feb 2002 04:46:32 -0000 1.5
+++ classes/intqueue.pmc 10 Mar 2002 07:14:58 -0000
@@ -92,7 +92,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->data = (STRING*)new_container();
}
Index: classes/parrotpointer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotpointer.pmc,v
retrieving revision 1.8
diff -u -r1.8 parrotpointer.pmc
--- classes/parrotpointer.pmc 9 Feb 2002 04:46:32 -0000 1.8
+++ classes/parrotpointer.pmc 10 Mar 2002 07:14:58 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->data=NULL;
SELF->flags=PMC_private_GC_FLAG;
}
Index: classes/perlarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlarray.pmc,v
retrieving revision 1.21
diff -u -r1.21 perlarray.pmc
--- classes/perlarray.pmc 6 Mar 2002 20:31:53 -0000 1.21
+++ classes/perlarray.pmc 10 Mar 2002 07:14:59 -0000
@@ -39,7 +39,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->data = mem_sys_allocate(sizeof(PMC*));
SELF->cache.int_val = 0;
}
Index: classes/perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.14
diff -u -r1.14 perlhash.pmc
--- classes/perlhash.pmc 1 Mar 2002 06:02:47 -0000 1.14
+++ classes/perlhash.pmc 10 Mar 2002 07:15:00 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->data = key_new(INTERP);
key_set_size(INTERP,SELF->data,0);
}
Index: classes/perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.16
diff -u -r1.16 perlint.pmc
--- classes/perlint.pmc 8 Feb 2002 04:52:32 -0000 1.16
+++ classes/perlint.pmc 10 Mar 2002 07:15:01 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->cache.int_val = 0;
}
Index: classes/perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.18
diff -u -r1.18 perlnum.pmc
--- classes/perlnum.pmc 8 Feb 2002 04:52:32 -0000 1.18
+++ classes/perlnum.pmc 10 Mar 2002 07:15:01 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->cache.num_val = 0.0;
}
Index: classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.17
diff -u -r1.17 perlstring.pmc
--- classes/perlstring.pmc 1 Mar 2002 06:02:47 -0000 1.17
+++ classes/perlstring.pmc 10 Mar 2002 07:15:02 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
SELF->cache.struct_val = string_make(INTERP,NULL,0,NULL,0,NULL);
}
Index: classes/perlundef.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlundef.pmc,v
retrieving revision 1.9
diff -u -r1.9 perlundef.pmc
--- classes/perlundef.pmc 9 Feb 2002 04:46:32 -0000 1.9
+++ classes/perlundef.pmc 10 Mar 2002 07:15:03 -0000
@@ -22,7 +22,7 @@
return whoami;
}
- void init () {
+ void init (INTVAL size) {
/* Nothing */
}
Index: include/parrot/pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.22
diff -u -r1.22 pmc.h
--- include/parrot/pmc.h 5 Mar 2002 17:39:10 -0000 1.22
+++ include/parrot/pmc.h 10 Mar 2002 07:15:04 -0000
@@ -103,6 +103,8 @@
/* Prototypes */
PMC *pmc_new(struct Parrot_Interp *interpreter, INTVAL base_type);
+PMC *pmc_new_sized(struct Parrot_Interp *interpreter, INTVAL base_type,
+ INTVAL size);
#endif
Index: lib/Parrot/Assembler.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Assembler.pm,v
retrieving revision 1.19
diff -u -r1.19 Assembler.pm
--- lib/Parrot/Assembler.pm 30 Jan 2002 19:08:35 -0000 1.19
+++ lib/Parrot/Assembler.pm 10 Mar 2002 07:15:06 -0000
@@ -1147,7 +1147,7 @@
#
elsif ($args[$_] =~ m/^[A-Za-z_][A-Za-z0-9_]+$/) {
- if ($opcode eq "new_p_ic") {
+ if ($opcode =~ m/^new_p_ic/) {
my $type = $pmc_types{lc $args[$_]};
defined $type
or error("Unknown PMC type '$args[$_]'!", $file, $line);
