cvsuser 04/02/23 11:39:02
Modified: classes parrotclass.pmc
include/parrot interpreter.h objects.h
ops var.ops
src objects.c
Log:
Add in global namespace stuff so we have a place to put methods
Revision Changes Path
1.17 +7 -3 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- parrotclass.pmc 22 Feb 2004 17:48:41 -0000 1.16
+++ parrotclass.pmc 23 Feb 2004 19:38:52 -0000 1.17
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotclass.pmc,v 1.16 2004/02/22 17:48:41 mikescott Exp $
+$Id: parrotclass.pmc,v 1.17 2004/02/23 19:38:52 dan Exp $
=head1 NAME
@@ -25,13 +25,17 @@
=item 2
-An array of all parents, in search order.
+A pruned array of all parents, in search order.
=item 3
-A hash, keys are the class names, values are the offsets to their attributes.
+A pruned array of all parents in reverse search order.
=item 4
+
+A hash, keys are the class names, values are the offsets to their attributes.
+
+=item 5
A hash, the keys are the classname/attrib name pair (separated by a
C<NULL>), while the value is the offset to the attribute.
1.123 +3 -2 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.122
retrieving revision 1.123
diff -u -w -r1.122 -r1.123
--- interpreter.h 21 Feb 2004 18:09:37 -0000 1.122
+++ interpreter.h 23 Feb 2004 19:38:55 -0000 1.123
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.122 2004/02/21 18:09:37 leo Exp $
+ * $Id: interpreter.h,v 1.123 2004/02/23 19:38:55 dan Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -137,7 +137,8 @@
Buffer * warns; /* Keeps track of what warnings
* have been activated */
Buffer * errors; /* fatals that can be turned off */
-
+ UINTVAL current_class_offset; /* Offset into the class array of the
+ currently found method */
} parrot_context_t;
1.12 +2 -1 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- objects.h 5 Dec 2003 12:07:54 -0000 1.11
+++ objects.h 23 Feb 2004 19:38:55 -0000 1.12
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.11 2003/12/05 12:07:54 leo Exp $
+ * $Id: objects.h,v 1.12 2004/02/23 19:38:55 dan Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -45,6 +45,7 @@
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*);
+void Parrot_note_method_offset(Parrot_Interp, UINTVAL, PMC *);
#endif
1.14 +132 -1 parrot/ops/var.ops
Index: var.ops
===================================================================
RCS file: /cvs/public/parrot/ops/var.ops,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- var.ops 4 Feb 2004 21:16:02 -0000 1.13
+++ var.ops 23 Feb 2004 19:38:59 -0000 1.14
@@ -231,6 +231,15 @@
Store global $2 as global symbol $1
+=item B<store_global>(in STR, in STR, in PMC)
+
+Store global $3 as global symbol $2 in namespace $1
+
+=item B<store_global>(in PMC, in STR, in PMC)
+
+Store global $3 as global symbol $2 in namespace $1
+
+
=cut
op store_global(in STR, in PMC) {
@@ -240,6 +249,36 @@
goto NEXT();
}
+op store_global(in STR, in STR, in PMC) {
+ /* XXX: All globals should go through an API */
+ PMC * globals = interpreter->globals->stash_hash;
+ PMC * stash;
+ if (!VTABLE_exists_keyed_str(interpreter, globals, $1)) {
+ stash = pmc_new(interpreter, enum_class_OrderedHash);
+ VTABLE_set_pmc_keyed_str(interpreter, globals, $1, stash);
+ }
+ else {
+ stash = VTABLE_get_pmc_keyed_str(interpreter, globals, $1);
+ }
+ VTABLE_set_pmc_keyed_str(interpreter, stash, $2, $3);
+ goto NEXT();
+}
+
+op store_global(in PMC, in str, in PMC) {
+ /* XXX: All globals should go through an API */
+ PMC * globals = interpreter->globals->stash_hash;
+ PMC * stash;
+ if (!VTABLE_exists_keyed(interpreter, globals, $1)) {
+ stash = pmc_new(interpreter, enum_class_OrderedHash);
+ VTABLE_set_pmc_keyed(interpreter, globals, $1, stash);
+ }
+ else {
+ stash = VTABLE_get_pmc_keyed(interpreter, globals, $1);
+ }
+ VTABLE_set_pmc_keyed_str(interpreter, stash, $2, $3);
+ goto NEXT();
+}
+
########################################
=item B<find_global>(out PMC, in STR)
@@ -248,6 +287,19 @@
either throws an exception or sets $1 to undef, depending on current
errors settings, s. B<errorson>.
+=item B<find_global>(out PMC, in STR, in STR)
+
+Find the global named $3 in namespace $2 and store it in $1. If the
+global doesn't exist either throws an exception or sets $1 to undef,
+depending on current errors settings, s. B<errorson>.
+
+=item B<find_global>(out PMC, in PMC, in STR)
+
+Find the global named $3 in the namespace specified by the key in $2
+and store it in $1. If the global doesn't exist either throws an
+exception or sets $1 to undef, depending on current errors settings,
+s. B<errorson>.
+
=cut
op find_global(out PMC, in STR) {
@@ -267,8 +319,87 @@
$1 = pmc_new(interpreter, enum_class_PerlUndef);
}
}
- else
+ else {
$1 = VTABLE_get_pmc_keyed_str(interpreter, globals, $2);
+ }
+ goto ADDRESS(next);
+}
+
+op find_global(out PMC, in STR, in STR) {
+ /* XXX: All globals should go through an API */
+ opcode_t * next;
+ PMC * globals = interpreter->globals->stash_hash;
+ PMC * stash;
+ if (!$2)
+ internal_exception(1, "Tried to get null global.");
+ if (!$3)
+ internal_exception(1, "Tried to get null global.");
+
+ next = expr NEXT();
+ if (!VTABLE_exists_keyed_str(interpreter, globals, $2)) {
+ if (PARROT_ERRORS_test(interpreter, PARROT_ERRORS_GLOBALS_FLAG)) {
+ real_exception(interpreter, next, GLOBAL_NOT_FOUND,
+ "Global '%Ss' not found\n", $2);
+ }
+ else {
+ stash = pmc_new(interpreter, enum_class_OrderedHash);
+ VTABLE_set_pmc_keyed_str(interpreter, globals, $2, stash);
+ }
+ }
+ else {
+ stash = VTABLE_get_pmc_keyed_str(interpreter, globals, $2);
+ }
+ if (!VTABLE_exists_keyed_str(interpreter, stash, $3)) {
+ if (PARROT_ERRORS_test(interpreter, PARROT_ERRORS_GLOBALS_FLAG)) {
+ real_exception(interpreter, next, GLOBAL_NOT_FOUND,
+ "Global '%Ss' not found\n", $3);
+ }
+ else {
+ $1 = pmc_new(interpreter, enum_class_PerlUndef);
+ }
+ }
+ else {
+ $1 = VTABLE_get_pmc_keyed_str(interpreter, stash, $3);
+ }
+ goto ADDRESS(next);
+}
+
+op find_global(out PMC, in PMC, in STR) {
+ /* XXX: All globals should go through an API */
+ opcode_t * next;
+ PMC * globals = interpreter->globals->stash_hash;
+ PMC * stash;
+ if (!$2)
+ internal_exception(1, "Tried to get null global.");
+ if (!$3)
+ internal_exception(1, "Tried to get null global.");
+
+ next = expr NEXT();
+ if (!VTABLE_exists_keyed(interpreter, globals, $2)) {
+ if (PARROT_ERRORS_test(interpreter, PARROT_ERRORS_GLOBALS_FLAG)) {
+ real_exception(interpreter, next, GLOBAL_NOT_FOUND,
+ "Global '%Ss' not found\n", $3);
+ }
+ else {
+ stash = pmc_new(interpreter, enum_class_PerlUndef);
+ VTABLE_set_pmc_keyed(interpreter, globals, $2, stash);
+ }
+ }
+ else {
+ stash = VTABLE_get_pmc_keyed(interpreter, globals, $2);
+ }
+ if (!VTABLE_exists_keyed_str(interpreter, stash, $3)) {
+ if (PARROT_ERRORS_test(interpreter, PARROT_ERRORS_GLOBALS_FLAG)) {
+ real_exception(interpreter, next, GLOBAL_NOT_FOUND,
+ "Global '%Ss' not found\n", $3);
+ }
+ else {
+ $1 = pmc_new(interpreter, enum_class_PerlUndef);
+ }
+ }
+ else {
+ $1 = VTABLE_get_pmc_keyed_str(interpreter, stash, $3);
+ }
goto ADDRESS(next);
}
1.31 +17 -1 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- objects.c 10 Feb 2004 09:38:59 -0000 1.30
+++ objects.c 23 Feb 2004 19:39:01 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.30 2004/02/10 09:38:59 leo Exp $
+$Id: objects.c,v 1.31 2004/02/23 19:39:01 dan Exp $
=head1 NAME
@@ -516,8 +516,24 @@
(PMC *)PMC_data(curclass), PCD_CLASS_NAME),
shortcut_name, 0);
method = find_global(interpreter, FQ_method);
+ Parrot_note_method_offset(interpreter, searchoffset, method);
}
return method;
+}
+
+/*
+=item C<void
+Parrot_note_method_offset(Parrot_Interp interpreter, UINTVAL offset, PMC *method)>
+
+Notes where in the hierarchy we just found a method. Used so that we
+can do a next and continue the search through the hierarchy for the
+next instance of this method.
+
+*/
+void
+Parrot_note_method_offset(Parrot_Interp interpreter, UINTVAL offset, PMC *method)
+{
+ interpreter->ctx.current_class_offset = offset;
}
/*
