# New Ticket Created by "Sean O'Rourke"
# Please include the string: [perl #814]
# in the subject line of all future correspondence about this issue.
# <URL: http://bugs6.perl.org/rt2/Ticket/Display.html?id=814 >
PerlString sets the PMC_is_buffer_ptr_FLAG flag in pmc->flags, but none of
the other Perl types do. The GC uses this flag to tell whether or not to
look for a buffer pointer in the PMC. Certain operations currently change
a PMC from one type to another simply by updating its vtable pointer.
Since they don't update the flag, this causes problems in collection. The
problem I saw was a buffer not being marked, but the opposite could
happen as well -- interpreting a former-String PMC as a buffer pointer
could cause a seg fault or memory leak.
So we need to set the flag if we're turning something into a PerlString,
and clear it if we're turning something that is a string into something
else. This patch adds a macro to do these things, in a file
include/parrot/perltypes.h.
/s
-- attachment 1 ------------------------------------------------------
url: http://bugs6.perl.org/rt2/attach/3818/3540/dd0935/pmcs.patch
-- attachment 2 ------------------------------------------------------
url: http://bugs6.perl.org/rt2/attach/3818/3541/0c7fbb/perltypes.h
Index: classes/perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.24
diff -u -r1.24 perlint.pmc
--- classes/perlint.pmc 12 Jun 2002 22:12:18 -0000 1.24
+++ classes/perlint.pmc 14 Jul 2002 19:47:45 -0000
@@ -11,6 +11,7 @@
*/
#include "parrot/parrot.h"
+#include "parrot/perltypes.h"
pmclass PerlInt {
@@ -80,12 +81,12 @@
}
void set_number (PMC * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(pmc, PerlNum);
SELF->cache.num_val = value->cache.num_val;
}
void set_number_native (FLOATVAL value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(pmc, PerlNum);
SELF->cache.num_val = value;
}
@@ -94,7 +95,7 @@
}
void set_number_same (PMC * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(pmc, PerlNum);
SELF->cache.num_val = (FLOATVAL)value->cache.int_val;
}
@@ -125,33 +126,33 @@
}
void set_string (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(pmc, PerlString);
SELF->data = value->data;
}
void set_string_native (STRING* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(pmc, PerlString);
SELF->data = value;
}
void set_string_unicode (STRING* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(pmc, PerlString);
SELF->data = value;
}
void set_string_other (STRING* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(pmc, PerlString);
SELF->data = value;
}
void set_string_same (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(pmc, PerlString);
SELF->data = value->data;
}
void add (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val +
value->vtable->get_number(INTERP, value)
@@ -161,14 +162,14 @@
FLOATVAL f = value->vtable->get_number(INTERP, value);
INTVAL i = value->vtable->get_integer(INTERP, value);
if(f != i) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val +
value->vtable->get_number(INTERP, value)
);
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val +
value->vtable->get_integer(INTERP, value)
@@ -176,7 +177,7 @@
}
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val +
value->vtable->get_integer(INTERP, value)
@@ -197,7 +198,7 @@
void subtract (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val -
value->vtable->get_number(INTERP, value)
@@ -207,14 +208,14 @@
FLOATVAL f = value->vtable->get_number(INTERP, value);
INTVAL i = value->vtable->get_integer(INTERP, value);
if(f != i) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val -
value->vtable->get_number(INTERP, value)
);
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val -
value->vtable->get_integer(INTERP, value)
@@ -222,7 +223,7 @@
}
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val -
value->vtable->get_integer(INTERP, value)
@@ -248,7 +249,7 @@
void multiply (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val *
value->vtable->get_number(INTERP, value)
@@ -258,14 +259,14 @@
FLOATVAL f = value->vtable->get_number(INTERP, value);
INTVAL i = value->vtable->get_integer(INTERP, value);
if(f != i) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val *
value->vtable->get_number(INTERP, value)
);
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val *
value->vtable->get_integer(INTERP, value)
@@ -273,7 +274,7 @@
}
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val *
value->vtable->get_integer(INTERP, value)
@@ -299,7 +300,7 @@
void divide (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val /
value->vtable->get_number(INTERP, value)
@@ -309,14 +310,14 @@
FLOATVAL f = value->vtable->get_number(INTERP, value);
INTVAL i = value->vtable->get_integer(INTERP, value);
if(f != i) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.int_val /
value->vtable->get_number(INTERP, value)
);
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val /
value->vtable->get_integer(INTERP, value)
@@ -326,7 +327,7 @@
else {
/* Interesting race condition if SELF == dest */
FLOATVAL result = SELF->cache.int_val /
(FLOATVAL)value->vtable->get_integer(INTERP, value);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest, result);
}
}
@@ -358,7 +359,7 @@
fprintf(stderr,"perlint_modulus not implemented for floating point\n");
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val %
value->vtable->get_integer(INTERP, value)
@@ -366,7 +367,7 @@
}
}
else {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->cache.int_val %
value->vtable->get_integer(INTERP, value)
@@ -503,7 +504,7 @@
value->vtable->get_string(INTERP, value),
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -514,7 +515,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -525,7 +526,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -536,7 +537,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -547,7 +548,7 @@
value->vtable->get_string(INTERP, value),
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -590,7 +591,7 @@
}
void logical_not (PMC* value) {
- SELF->cache.int_val = (INTVAL)(!value->vtable->get_bool(INTERP, value));
+ value->vtable->set_integer_native(INTERP, value, !SELF->cache.int_val);
}
void repeat (PMC* value, PMC* dest) {
@@ -606,4 +607,5 @@
void decrement () {
SELF->cache.int_val --;
}
+
}
Index: classes/perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.25
diff -u -r1.25 perlnum.pmc
--- classes/perlnum.pmc 12 Jun 2002 22:12:18 -0000 1.25
+++ classes/perlnum.pmc 14 Jul 2002 19:47:45 -0000
@@ -11,6 +11,7 @@
*/
#include "parrot/parrot.h"
+#include "parrot/perltypes.h"
pmclass PerlNum {
@@ -76,12 +77,12 @@
}
void set_integer (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value->cache.int_val;
}
void set_integer_native (INTVAL value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value;
}
@@ -89,7 +90,7 @@
}
void set_integer_same (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value->cache.int_val;
}
@@ -124,47 +125,47 @@
}
void set_string (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(SELF, PerlString);
SELF->data = value->data;
}
void set_string_native (STRING * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(SELF, PerlString);
SELF->data = value;
}
void set_string_unicode (STRING * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(SELF, PerlString);
SELF->data = value;
}
void set_string_other (STRING * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(SELF, PerlString);
SELF->data = value;
}
void set_string_same (PMC * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
+ CHANGE_TYPE(SELF, PerlString);
SELF->data = value->data;
}
void add (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val +
value->vtable->get_number(INTERP, value)
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val +
value->vtable->get_number(INTERP, value)
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlString]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val +
value->vtable->get_number(INTERP, value)
@@ -189,14 +190,14 @@
void subtract (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val -
value->vtable->get_number(INTERP, value)
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val -
value->vtable->get_number(INTERP, value)
@@ -225,14 +226,14 @@
void multiply (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val *
value->vtable->get_number(INTERP, value)
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val *
value->vtable->get_number(INTERP, value)
@@ -261,14 +262,14 @@
void divide (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val /
value->vtable->get_number(INTERP, value)
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->cache.num_val /
value->vtable->get_number(INTERP, value)
@@ -318,6 +319,10 @@
fprintf(stderr,"modulus_same not implemented\n");
}
+ void neg (PMC * dest) {
+ dest->vtable->set_number_native(INTERP, dest, -SELF->cache.num_val);
+ }
+
void bitwise_or (PMC* value, PMC* dest) {
dest->vtable->set_integer_native(INTERP, dest,
(INTVAL)SELF->cache.num_val |
@@ -394,7 +399,7 @@
value->vtable->get_string(INTERP, value),
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -405,7 +410,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -416,7 +421,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -427,7 +432,7 @@
value,
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -438,7 +443,7 @@
value->vtable->get_string(INTERP, value),
0
);
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->vtable->set_string_native(INTERP,dest,s);
}
@@ -462,4 +467,5 @@
void decrement () {
SELF->cache.num_val --;
}
+
}
Index: classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.22
diff -u -r1.22 perlstring.pmc
--- classes/perlstring.pmc 12 Jun 2002 22:12:18 -0000 1.22
+++ classes/perlstring.pmc 14 Jul 2002 19:47:45 -0000
@@ -11,6 +11,7 @@
*/
#include "parrot/parrot.h"
+#include "parrot/perltypes.h"
pmclass PerlString {
@@ -34,6 +35,7 @@
PMC* dest;
dest = pmc_new(INTERP, enum_class_PerlString);
dest->vtable = SELF->vtable;
+ dest->flags = PMC_is_buffer_ptr_FLAG;
dest->data = string_copy(INTERP,SELF->data);
return dest;
}
@@ -73,12 +75,12 @@
}
void set_integer (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value->vtable->get_integer(INTERP,value);
}
void set_integer_native (INTVAL value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value;
}
@@ -86,17 +88,17 @@
}
void set_integer_same (PMC* value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlInt]);
+ CHANGE_TYPE(SELF, PerlInt);
SELF->cache.int_val = value->vtable->get_integer(INTERP,value);
}
void set_number (PMC * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(SELF, PerlNum);
SELF->cache.num_val = value->vtable->get_number(INTERP,value);
}
void set_number_native (FLOATVAL value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(SELF, PerlNum);
SELF->cache.num_val = value;
}
@@ -104,7 +106,7 @@
}
void set_number_same (PMC * value) {
- SELF->vtable = &(Parrot_base_vtables[enum_class_PerlNum]);
+ CHANGE_TYPE(SELF, PerlNum);
SELF->cache.num_val = (FLOATVAL)value->cache.int_val;
}
@@ -130,14 +132,14 @@
void add (PMC * value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) +
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) +
value->cache.num_val
@@ -148,7 +150,7 @@
}
void add_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) +
value
@@ -159,7 +161,7 @@
}
void add_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) +
value
@@ -171,14 +173,14 @@
void subtract (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) -
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) -
value->cache.num_val
@@ -189,7 +191,7 @@
}
void subtract_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) -
value
@@ -200,7 +202,7 @@
}
void subtract_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) -
value
@@ -212,14 +214,14 @@
void multiply (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) *
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) *
value->cache.num_val
@@ -230,7 +232,7 @@
}
void multiply_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) *
value
@@ -241,7 +243,7 @@
}
void multiply_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) *
value
@@ -253,14 +255,14 @@
void divide (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) /
value->cache.int_val
);
}
else if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) /
value->cache.num_val
@@ -271,7 +273,7 @@
}
void divide_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) /
value
@@ -282,7 +284,7 @@
}
void divide_float (FLOATVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(dest, PerlNum);
dest->vtable->set_number_native(INTERP, dest,
SELF->vtable->get_number(INTERP, SELF) /
value
@@ -294,7 +296,7 @@
void modulus (PMC* value, PMC* dest) {
if(value->vtable == &Parrot_base_vtables[enum_class_PerlInt]) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) %
value->cache.int_val
@@ -305,7 +307,7 @@
}
void modulus_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) %
value
@@ -322,7 +324,7 @@
}
void bitwise_or (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) |
value->vtable->get_integer(INTERP, value)
@@ -330,7 +332,7 @@
}
void bitwise_or_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) |
value
@@ -338,7 +340,7 @@
}
void bitwise_or_same (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) |
value->vtable->get_integer(INTERP, value)
@@ -346,7 +348,7 @@
}
void bitwise_and (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) &
value->vtable->get_integer(INTERP, value)
@@ -354,7 +356,7 @@
}
void bitwise_and_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) &
value
@@ -362,7 +364,7 @@
}
void bitwise_and_same (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) &
value->vtable->get_integer(INTERP, value)
@@ -370,7 +372,7 @@
}
void bitwise_xor (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) ^
value->vtable->get_integer(INTERP, value)
@@ -378,7 +380,7 @@
}
void bitwise_xor_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) ^
value
@@ -386,7 +388,7 @@
}
void bitwise_xor_same (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
SELF->vtable->get_integer(INTERP, SELF) ^
value->vtable->get_integer(INTERP, value)
@@ -394,7 +396,7 @@
}
void bitwise_not (PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(dest, PerlInt);
dest->vtable->set_integer_native(INTERP, dest,
~SELF->vtable->get_integer(INTERP, SELF)
);
@@ -462,7 +464,7 @@
}
void repeat (PMC* value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->data =
string_repeat(INTERP, SELF->data,
(UINTVAL)value->vtable->get_integer(INTERP, value), NULL
@@ -470,7 +472,7 @@
}
void repeat_int (INTVAL value, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->data = string_repeat(INTERP, SELF->data, (UINTVAL)value, NULL);
}
@@ -479,9 +481,9 @@
void decrement () {
}
-
+
void substr (INTVAL offset, INTVAL length, PMC* dest) {
- dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(dest, PerlString);
dest->data = string_substr(INTERP, SELF->data, offset, length, NULL);
}
Index: classes/perlundef.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlundef.pmc,v
retrieving revision 1.16
diff -u -r1.16 perlundef.pmc
--- classes/perlundef.pmc 21 Jun 2002 17:22:34 -0000 1.16
+++ classes/perlundef.pmc 14 Jul 2002 19:47:45 -0000
@@ -11,6 +11,7 @@
*/
#include "parrot/parrot.h"
+#include "parrot/perltypes.h"
pmclass PerlUndef {
@@ -74,12 +75,12 @@
}
void set_integer (PMC * value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(pmc, PerlInt);
pmc->vtable->set_integer(interpreter, pmc, value);
}
void set_integer_native (INTVAL value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlInt];
+ CHANGE_TYPE(pmc, PerlInt);
pmc->vtable->set_integer_native(interpreter, pmc, value);
}
@@ -88,12 +89,12 @@
}
void set_number (PMC* value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(pmc, PerlNum);
pmc->vtable->set_number(interpreter, pmc, value);
}
void set_number_native (FLOATVAL value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlNum];
+ CHANGE_TYPE(pmc, PerlNum);
pmc->vtable->set_number_native(interpreter, pmc, value);
}
@@ -117,22 +118,22 @@
}
void set_string (PMC* value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(pmc, PerlString);
pmc->vtable->set_string(interpreter, pmc, value);
}
void set_string_native (STRING* value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(pmc, PerlString);
pmc->vtable->set_string_native(interpreter, pmc, value);
}
void set_string_unicode (STRING* value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(pmc, PerlString);
pmc->vtable->set_string_unicode(interpreter, pmc, value);
}
void set_string_other (STRING* value) {
- pmc->vtable = &Parrot_base_vtables[enum_class_PerlString];
+ CHANGE_TYPE(pmc, PerlString);
pmc->vtable->set_string_other(interpreter, pmc, value);
}
@@ -446,5 +447,9 @@
void repeat_same (PMC* value, PMC* dest) {
Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG, "Use of uninitialized value
in repeat");
dest->vtable->set_string(INTERP, dest, NULL);
+ }
+
+ INTVAL defined () {
+ return 0;
}
}
/* perltypes.h
* Copyright: (When this is determined...it will go here)
* CVS Info
* $Id: $
* Overview:
* Header to be shared among Perl PMC classes
* Data Structure and Algorithms:
* History:
* Notes:
* References:
*/
/*
* Change PMC "thing" to scalar type "type", updating vtable and flags
* as necessary.
*/
#define CHANGE_TYPE(thing, type) do { \
if ((thing)->vtable == &Parrot_base_vtables[enum_class_PerlString]) { \
(thing)->flags &= ~(UINTVAL)PMC_is_buffer_ptr_FLAG; \
} \
(thing)->vtable = &Parrot_base_vtables[enum_class_ ## type]; \
if (enum_class_ ## type == enum_class_PerlString) { \
(thing)->flags = PMC_is_buffer_ptr_FLAG; \
} \
} while (0)
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
