cvsuser 04/02/24 16:28:58
Modified: include/parrot objects.h
ops object.ops
src objects.c
t/pmc objects.t
Log:
Inching ever-closer
Revision Changes Path
1.15 +2 -2 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- objects.h 24 Feb 2004 20:17:24 -0000 1.14
+++ objects.h 25 Feb 2004 00:28:52 -0000 1.15
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.14 2004/02/24 20:17:24 dan Exp $
+ * $Id: objects.h,v 1.15 2004/02/25 00:28:52 dan Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -45,7 +45,7 @@
INTVAL Parrot_object_isa(Parrot_Interp interpreter, PMC *, PMC *);
PMC *Parrot_new_method_cache(Parrot_Interp);
PMC *Parrot_find_method_with_cache(Parrot_Interp, PMC *, STRING *);
-INTVAL Parrot_add_attribute(Parrot_Interp, PMC*, STRING*, STRING*);
+INTVAL Parrot_add_attribute(Parrot_Interp, PMC*, STRING*);
void Parrot_note_method_offset(Parrot_Interp, UINTVAL, PMC *);
#endif
1.26 +4 -5 parrot/ops/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/ops/object.ops,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- object.ops 24 Feb 2004 15:07:19 -0000 1.25
+++ object.ops 25 Feb 2004 00:28:54 -0000 1.26
@@ -267,15 +267,14 @@
goto NEXT();
}
-=item B<addattribute>(in PMC, in STR, in STR)
+=item B<addattribute>(in PMC, in STR)
-Add the attribute named $2 to the class $1. $3 is the fully-qualified
-attribute name.
+Add the attribute named $2 to the class $1.
=cut
-inline op addattribute(in PMC, in STR, in STR) {
- Parrot_add_attribute(interpreter, $1, $2, $3);
+inline op addattribute(in PMC, in STR) {
+ Parrot_add_attribute(interpreter, $1, $2);
goto NEXT();
}
1.37 +18 -25 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- objects.c 24 Feb 2004 20:17:33 -0000 1.36
+++ objects.c 25 Feb 2004 00:28:56 -0000 1.37
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.36 2004/02/24 20:17:33 dan Exp $
+$Id: objects.c,v 1.37 2004/02/25 00:28:56 dan Exp $
=head1 NAME
@@ -645,41 +645,34 @@
*/
+/* Life is ever so much easiser if a class keeps its attributes at the
+ end of the attribute array, since we don't have to insert and
+ reorder attributes. Inserting's no big deal, especially since we're
+ going to break horribly if you insert into a class that's been
+ subclassed, but it'll do for now */
+
INTVAL
-Parrot_add_attribute(Parrot_Interp interpreter, PMC* class, STRING* attr, STRING
*full_attr_name)
+Parrot_add_attribute(Parrot_Interp interpreter, PMC* class, STRING* attr)
{
PMC *class_array;
STRING *class_name;
INTVAL idx;
PMC *offs_hash;
PMC *attr_hash;
+ PMC *attr_array;
+ STRING *full_attr_name;
class_array = (PMC*) PMC_data(class);
class_name = VTABLE_get_string_keyed_int(interpreter,
class_array, PCD_CLASS_NAME);
- /*
- * our attributes start at offset found in hash at PCD_ATTRIB_OFFS
- */
- offs_hash = VTABLE_get_pmc_keyed_int(interpreter,
- class_array, PCD_ATTRIB_OFFS);
- if (VTABLE_exists_keyed_str(interpreter, offs_hash, class_name))
- idx = VTABLE_get_integer_keyed_str(interpreter, offs_hash, class_name);
- else {
- PMC* parent_array = VTABLE_get_pmc_keyed_int(interpreter,
- class_array, PCD_ALL_PARENTS);
- if (VTABLE_elements(interpreter, parent_array)) {
- PMC *parent = VTABLE_get_pmc_keyed_int(interpreter,
- parent_array, 0);
- PMC *parent_attr_hash = VTABLE_get_pmc_keyed_int(interpreter,
- (PMC*) PMC_data(parent), PCD_ATTRIBUTES);
- idx = VTABLE_elements(interpreter, parent_attr_hash);
- }
- else
- idx = 0;
- VTABLE_set_integer_keyed_str(interpreter, offs_hash, class_name, idx);
- }
- attr_hash = VTABLE_get_pmc_keyed_int(interpreter,
- class_array, PCD_ATTRIBUTES);
+ attr_array = VTABLE_get_pmc_keyed_int(interpreter, class_array,
PCD_CLASS_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);
+ full_attr_name = string_concat(interpreter, class_name,
string_from_cstring(interpreter, "\0", 1), 0);
+ full_attr_name = string_concat(interpreter, full_attr_name, attr, 0);
+
+
/*
* TODO check if someone is trying to add attributes to a parent class
* while there are already child class attrs
1.17 +4 -4 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- objects.t 24 Feb 2004 15:07:23 -0000 1.16
+++ objects.t 25 Feb 2004 00:28:58 -0000 1.17
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.16 2004/02/24 15:07:23 dan Exp $
+# $Id: objects.t,v 1.17 2004/02/25 00:28:58 dan Exp $
=head1 NAME
@@ -766,9 +766,9 @@
output_like(<<'CODE', $output_re , "float attributes");
newclass P0, "Foo"
find_type I1, "Foo"
- addattribute P0, "b", "Foo::b"
- addattribute P0, "l", "Foo::l"
- addattribute P0, "a", "Foo::a"
+ addattribute P0, "b"
+ addattribute P0, "l"
+ addattribute P0, "a"
new P1, I1
