cvsuser 04/02/25 06:48:51
Modified: include/parrot objects.h
ops object.ops
src objects.c
Log:
Can now get and set attribute values by offset in an object.
Note that attributes can't be looked up by name, and classes don't inherit
attributes yet.
Revision Changes Path
1.16 +4 -1 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- objects.h 25 Feb 2004 00:28:52 -0000 1.15
+++ objects.h 25 Feb 2004 14:48:40 -0000 1.16
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.15 2004/02/25 00:28:52 dan Exp $
+ * $Id: objects.h,v 1.16 2004/02/25 14:48:40 dan Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -47,6 +47,9 @@
PMC *Parrot_find_method_with_cache(Parrot_Interp, PMC *, STRING *);
INTVAL Parrot_add_attribute(Parrot_Interp, PMC*, STRING*);
void Parrot_note_method_offset(Parrot_Interp, UINTVAL, PMC *);
+PMC *Parrot_get_attrib_by_num(Parrot_Interp, PMC *, INTVAL);
+void Parrot_set_attrib_by_num(Parrot_Interp, PMC *, INTVAL, PMC *);
+INTVAL Parrot_get_attrib_num(Parrot_Interp, PMC *, STRING *);
#endif
1.27 +22 -0 parrot/ops/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/ops/object.ops,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- object.ops 25 Feb 2004 00:28:54 -0000 1.26
+++ object.ops 25 Feb 2004 14:48:47 -0000 1.27
@@ -286,6 +286,28 @@
=cut
+=item B<getattribute>(out PMC, in PMC, in INT)
+
+Get attribute number $3 from object $2 and put the result in $1.
+
+=cut
+
+inline op getattribute(out PMC, in PMC, in INT) {
+ $1 = Parrot_get_attrib_by_num(interpreter, $2, $3);
+ goto NEXT();
+}
+
+=item B<setattribute>(in PMC, in INT, in PMC)
+
+Set attribute $2 of object $1 to $3
+
+=cut
+
+inline op setattribute(in PMC, in INT, in PMC) {
+ Parrot_set_attrib_by_num(interpreter, $1, $2, $3);
+ goto NEXT();
+}
+
=item B<adddoes>(in PMC, in STR)
1.38 +38 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- objects.c 25 Feb 2004 00:28:56 -0000 1.37
+++ objects.c 25 Feb 2004 14:48:51 -0000 1.38
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.37 2004/02/25 00:28:56 dan Exp $
+$Id: objects.c,v 1.38 2004/02/25 14:48:51 dan Exp $
=head1 NAME
@@ -658,7 +658,7 @@
STRING *class_name;
INTVAL idx;
PMC *offs_hash;
- PMC *attr_hash;
+ PMC *attr_hash = NULL;
PMC *attr_array;
STRING *full_attr_name;
@@ -666,6 +666,7 @@
class_name = VTABLE_get_string_keyed_int(interpreter,
class_array, PCD_CLASS_NAME);
attr_array = VTABLE_get_pmc_keyed_int(interpreter, class_array,
PCD_CLASS_ATTRIBUTES);
+ attr_hash = VTABLE_get_pmc_keyed_int(interpreter, class_array, PCD_ATTRIBUTES);
idx = VTABLE_elements(interpreter, attr_array);
VTABLE_set_integer_native(interpreter, attr_array, idx + 1);
VTABLE_set_string_keyed_int(interpreter, attr_array, idx, attr);
@@ -684,6 +685,41 @@
assert(idx + 1 == VTABLE_elements(interpreter, attr_hash));
class->cache.int_val = idx + 1;
return idx;
+}
+
+/*
+
+=item C<PMC *
+Parrot_get_attrib_by_num(Parrot_Interp interpreter, PMC *object, INTVAL attrib)>
+
+Returns attribute number C<attrib> from C<object>. Presumably the code
+is asking for the correct attribute number.
+
+*/
+
+PMC *
+Parrot_get_attrib_by_num(Parrot_Interp interpreter, PMC *object, INTVAL attrib)
+{
+ PMC *attrib_array;
+ if (PObj_is_object_TEST(object)) {
+ attrib_array = PMC_data(object);
+ return VTABLE_get_pmc_keyed_int(interpreter, attrib_array, attrib);
+ }
+ else {
+ internal_exception(INTERNAL_NOT_IMPLEMENTED, "Can't get non-core object
attribs yet");
+ }
+}
+
+void
+Parrot_set_attrib_by_num(Parrot_Interp interpreter, PMC *object, INTVAL attrib, PMC
*value) {
+ PMC *attrib_array;
+ if (PObj_is_object_TEST(object)) {
+ attrib_array = PMC_data(object);
+ VTABLE_set_pmc_keyed_int(interpreter, attrib_array, attrib, value);
+ }
+ else {
+ internal_exception(INTERNAL_NOT_IMPLEMENTED, "Can't set non-core object
attribs yet");
+ }
}
/*
