Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

patch to support nums, strings and pmcs as attributes

18 views
Skip to first unread message

Stéphane Payrard

unread,
Jan 10, 2004, 4:22:48 PM1/10/04
to perl6-i...@perl.org
--- classes/parrotobject.pmc.orig 2003-12-06 01:00:29.000000000 +0100
+++ classes/parrotobject.pmc 2004-01-10 21:09:08.000000000 +0100
@@ -87,7 +87,12 @@
}

INTVAL get_integer_keyed (PMC* attr) {
- return SELF.get_integer_keyed_str(key_string(interpreter, attr));
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ return SELF.get_integer_keyed_int(key_integer(interpreter, attr));
+ } else {
+ return SELF.get_integer_keyed_str(key_string(interpreter, attr));
+ }
}

void set_integer_keyed_int (INTVAL idx, INTVAL value) {
@@ -107,6 +112,175 @@
}

void set_integer_keyed (PMC* attr, INTVAL value) {
- SELF.set_integer_keyed_str(key_string(interpreter, attr), value);
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ SELF.set_integer_keyed_int(key_integer(interpreter, attr), value);
+ } else {
+ SELF.set_integer_keyed_str(key_string(interpreter, attr), value);
+ }
}
+
+
+ FLOATVAL get_number_keyed_int (INTVAL idx) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ return VTABLE_get_number_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val);
+ }
+
+ FLOATVAL get_number_keyed_str (STRING* attr) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ return SELF.get_number_keyed_int(idx);
+ }
+
+ FLOATVAL get_number_keyed (PMC* attr) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ return SELF.get_number_keyed_int(key_integer(interpreter, attr));
+ } else {
+ return SELF.get_number_keyed_str(key_string(interpreter, attr));
+ }
+
+ }
+
+ void set_number_keyed_int (INTVAL idx, FLOATVAL value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ VTABLE_set_number_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val, value);
+ }
+
+ void set_number_keyed_str (STRING* attr, FLOATVAL value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ SELF.set_number_keyed_int(idx, value);
+ }
+
+ void set_number_keyed (PMC* attr, FLOATVAL value) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ SELF.set_number_keyed_int(key_integer(interpreter, attr), value);
+ } else {
+ SELF.set_number_keyed_str(key_string(interpreter, attr), value);
+ }
+
+ }
+
+
+
+
+
+
+ STRING* get_string_keyed_int (INTVAL idx) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ return VTABLE_get_string_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val);
+ }
+
+ STRING* get_string_keyed_str (STRING* attr) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ return SELF.get_string_keyed_int(idx);
+ }
+
+ STRING* get_string_keyed (PMC* attr) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ return SELF.get_string_keyed_int(key_integer(interpreter, attr));
+ } else {
+ return SELF.get_string_keyed_str(key_string(interpreter, attr));
+ }
+ }
+
+ void set_string_keyed_int (INTVAL idx, STRING* value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ VTABLE_set_string_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val, value);
+ }
+
+ void set_string_keyed_str (STRING* attr, STRING* value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ SELF.set_string_keyed_int(idx, value);
+ }
+
+ void set_string_keyed (PMC* attr, STRING* value) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ SELF.set_string_keyed_int(key_integer(interpreter, attr), value);
+ } else {
+ SELF.set_string_keyed_str(key_string(interpreter, attr), value);
+ }
+ }
+
+
+
+
+ PMC* get_pmc_keyed_int (INTVAL idx) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ return VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val);
+ }
+
+ PMC* get_pmc_keyed_str (STRING* attr) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ return SELF.get_pmc_keyed_int(idx);
+ }
+
+ PMC* get_pmc_keyed (PMC* attr) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ return SELF.get_pmc_keyed_int(key_integer(interpreter, attr));
+ } else {
+ return SELF.get_pmc_keyed_str(key_string(interpreter, attr));
+ }
+
+ }
+
+ void set_pmc_keyed_int (INTVAL idx, PMC* value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ VTABLE_set_pmc_keyed_int(interpreter, data_array,
+ idx + SELF->cache.int_val, value);
+ }
+
+ void set_pmc_keyed_str (STRING* attr, PMC* value) {
+ PMC* data_array = (PMC*) PMC_data(SELF);
+ PMC *class = VTABLE_get_pmc_keyed_int(interpreter, data_array,
+ POD_CLASS);
+ INTVAL idx = VTABLE_get_integer_keyed_str(interpreter, class, attr);
+ if (idx < 0)
+ internal_exception(1, "No such attribute");
+ SELF.set_pmc_keyed_int(idx, value);
+ }
+
+ void set_pmc_keyed (PMC* attr, PMC* value) {
+ int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;
+ if ( flag & KEY_integer_FLAG) {
+ SELF.set_pmc_keyed_int(key_integer(interpreter, attr), value);
+ } else {
+ SELF.set_pmc_keyed_str(key_string(interpreter, attr), value);
+ }
+ }
+
+
}

Leopold Toetsch

unread,
Jan 11, 2004, 6:33:16 AM1/11/04
to st...@payrard.net, perl6-i...@perl.org
Stéphane Payrard <st...@payrard.net> wrote:

Thanks, applied - plus ...

> INTVAL get_integer_keyed (PMC* attr) {
> - return SELF.get_integer_keyed_str(key_string(interpreter, attr));
> + int flag = PObj_get_FLAGS(attr) & KEY_type_FLAGS;

... a comment, why we might need that.

leo

Stéphane Payrard

unread,
Jan 11, 2004, 1:33:12 PM1/11/04
to perl6-i...@perl.org

Also the following patch exercises all the variations including
the susmentioned access thru a key pmc that may contain either a
string or an int.

A previous version I tried to attach to a mail and eventually got
attached as a Fortran file must be ignored. With the present
patch, the test is now included in objects.t instead of being a
separate file.

--
stef

--- t/pmc/objects.t.orig 2003-12-05 17:00:25.000000000 +0100
+++ t/pmc/objects.t 2004-01-11 19:21:48.000000000 +0100
@@ -1,6 +1,6 @@
#! perl -w

-use Parrot::Test tests => 22;
+use Parrot::Test tests => 24;
use Test::More;

output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -565,3 +565,271 @@
130
140
OUTPUT
+
+
+output_is(<<'CODE', (join '', map { "$_\n" }42..65), "attributes");
+ newclass P0, "Foo"
+ find_type I1, "Foo"
+ addattrib I0, P0, "b"
+ addattrib I0, P0, "l"
+ addattrib I0, P0, "a"
+ new P1, I1
+
+ set P1["Foo\x00a"], 42
+ set I2, P1["Foo\x00a"]
+ print I2
+ print "\n"
+
+ set S0, "Foo\x00a"
+ set P1[S0], 43
+ set I2, P1[S0]
+ print I2
+ print "\n"
+
+ set P1[2], 44
+ set I2, P1[2]
+ print I2
+ print "\n"
+
+ set I3, 2
+ set P1[I3], 45
+ set I2, P1[I3]
+ print I2
+ print "\n"
+
+
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+
+ set P1[P2], 46
+ set I2, P1[P2]
+ print I2
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+
+ set P1[P2], 47
+ set I2, P1[P2]
+ print I2
+ print "\n"
+
+
+
+# strings
+
+ set P1["Foo\x00a"], "48"
+ set S2, P1["Foo\x00a"]
+ print S2
+ print "\n"
+
+ set S0, "Foo\x00a"
+ set P1[S0], "49"
+ set S2, P1[S0]
+ print S2
+ print "\n"
+
+ set P1[2], "50"
+ set S2, P1[2]
+ print S2
+ print "\n"
+
+ set I3, 2
+ set P1[I3], "51"
+ set S2, P1[I3]
+ print S2
+ print "\n"
+
+
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+
+ set P1[P2], "52"
+ set S2, P1[P2]
+ print S2
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+
+ set P1[P2], "53"
+ set S2, P1[P2]
+ print S2
+ print "\n"
+
+# pmc
+
+
+ set P1["Foo\x00a"], 54
+ set P4, P1["Foo\x00a"]
+ print P4
+ print "\n"
+
+ set S0, "Foo\x00a"
+ set P1[S0], 55
+ set P4, P1[S0]
+ print P4
+ print "\n"
+
+ set P1[2], 56
+ set P4, P1[2]
+ print P4
+ print "\n"
+
+ set I3, 2
+ set P1[I3], 57
+ set P4, P1[I3]
+ print P4
+ print "\n"
+
+
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+
+ set P1[P2], 58
+ set P4, P1[P2]
+ print P4
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+
+ set P1[P2], 59
+ set P4, P1[P2]
+ print P4
+ print "\n"
+
+
+ set P1["Foo\x00a"], "60"
+ set P4, P1["Foo\x00a"]
+ print P4
+ print "\n"
+
+ set S0, "Foo\x00a"
+ set P1[S0], "61"
+ set P4, P1[S0]
+ print P4
+ print "\n"
+
+ set P1[2], "62"
+ set P4, P1[2]
+ print P4
+ print "\n"
+
+ set I3, 2
+ set P1[I3], "63"
+ set P4, P1[I3]
+ print P4
+ print "\n"
+
+
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+
+ set P1[P2], "64"
+ set P4, P1[P2]
+ print P4
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+
+ set P1[P2], "65"
+ set P4, P1[P2]
+ print P4
+ print "\n"
+ end
+CODE
+
+my $output_re = join '', map { "$_.00.*[\\n\\r]+" } 4..15;
+$output_re = qr/^$output_re$/;
+output_like(<<'CODE', $output_re , "float attributes");
+ newclass P0, "Foo"
+ find_type I1, "Foo"
+ addattrib I0, P0, "b"
+ addattrib I0, P0, "l"
+ addattrib I0, P0, "a"
+ new P1, I1
+
+
+ set P1["Foo\x00a"], 4.00001
+ set N2, P1["Foo\x00a"]
+ print N2
+ print "\n"
+
+
+ set S0, "Foo\x00a"
+ set P1[S0], 5.00001
+ set N2, P1[S0]
+ print N2
+ print "\n"
+
+
+ set P1[2], 6.00001
+ set N2, P1[2]
+ print N2
+ print "\n"
+
+ set I3, 2
+ set P1[I3], 7.00001
+ set N2, P1[I3]
+ print N2
+ print "\n"
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+ set P1[P2], 8.00001
+ set N2, P1[P2]
+ print N2
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+ set P1[P2], 9.00001
+ set N2, P1[P2]
+ print N2
+ print "\n"
+
+ set P1["Foo\x00a"], 10.00001
+ set P4, P1["Foo\x00a"]
+ print P4
+ print "\n"
+
+ set S0, "Foo\x00a"
+ set P1[S0], 11.00001
+ set P4, P1[S0]
+ print P4
+ print "\n"
+
+ set P1[2], 12.00001
+ set P4, P1[2]
+ print P4
+ print "\n"
+
+ set I3, 2
+ set P1[I3], 13.00001
+ set P4, P1[I3]
+ print P4
+ print "\n"
+
+
+ new P2, .Key
+ set P2, "Foo\x00a"
+ set P1[P2], 14.00001
+ set P4, P1[P2]
+ print P4
+ print "\n"
+
+ new P2, .Key
+ set P2, 0
+ set P1[P2], 15.00001
+ set P4, P1[P2]
+ print P4
+ print "\n"
+
+
+CODE

Dan Sugalski

unread,
Jan 12, 2004, 9:49:03 AM1/12/04
to st...@payrard.net, perl6-i...@perl.org
At 10:22 PM +0100 1/10/04, Stéphane Payrard wrote:
>--- classes/parrotobject.pmc.orig 2003-12-06 01:00:29.000000000 +0100
>+++ classes/parrotobject.pmc 2004-01-10 21:09:08.000000000 +0100

Keen. And, while worth applying, I'm not sure it
should go to parrotobject. (Or, rather, I think
it ought not, and should instead be applied to
default or one of the array/hash base classes
instead)

Access to actual attribute slots for a PMC ought
be done through a separate vtable entry. I'm not
sure if I've talked about this any in the past,
but even if I have objects have dragged on so
long I'm not surprised nobody remembers.
--
Dan

--------------------------------------"it's like this"-------------------
Dan Sugalski even samurai
d...@sidhe.org have teddy bears and even
teddy bears get drunk

Leopold Toetsch

unread,
Jan 12, 2004, 10:34:16 AM1/12/04
to Dan Sugalski, perl6-i...@perl.org
Dan Sugalski <d...@sidhe.org> wrote:
> At 10:22 PM +0100 1/10/04, Stéphane Payrard wrote:
>>--- classes/parrotobject.pmc.orig 2003-12-06 01:00:29.000000000 +0100
>>+++ classes/parrotobject.pmc 2004-01-10 21:09:08.000000000 +0100

> Keen. And, while worth applying, I'm not sure it
> should go to parrotobject.

It is already applied.

> ... (Or, rather, I think


> it ought not, and should instead be applied to
> default or one of the array/hash base classes
> instead)

The ParrotObject attribute accessors are mainly wrappers only adding the
reserved internal count and then passing the method on to the array.
The keyed_str variants additionally do a lookup for the attribute index
first.

> Access to actual attribute slots for a PMC ought
> be done through a separate vtable entry. I'm not
> sure if I've talked about this any in the past,
> but even if I have objects have dragged on so
> long I'm not surprised nobody remembers.

I'm pretty sure that attribute access wasn't mentioned yet. So I had
implemented integers some time ago. Please have a look at

t/pmc/object*.t

for some experiments with attribute access syntax (and even a method
call). I had also asked about attribute name mangling, but the thread
drifted off towards globals name mangling, so this is still not
addressed.

leo

Nicholas Clark

unread,
Jan 12, 2004, 2:12:16 PM1/12/04
to Stéphane Payrard, perl6-i...@perl.org
On Sun, Jan 11, 2004 at 07:33:12PM +0100, Stéphane Payrard wrote:
> Also the following patch exercises all the variations including
> the susmentioned access thru a key pmc that may contain either a
> string or an int.

Thanks, applied

Nicholas Clark

0 new messages