cvsuser 03/12/01 10:54:38
Modified: classes parrotobject.pmc
config/gen/platform darwin.c
include/parrot objects.h pmc.h
src global_setup.c objects.c
Log:
Now will use native dynaloading on OS X 10.3
Inching closer to working objects
Revision Changes Path
1.6 +6 -2 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- parrotobject.pmc 16 Oct 2003 19:26:06 -0000 1.5
+++ parrotobject.pmc 1 Dec 2003 18:54:27 -0000 1.6
@@ -1,7 +1,7 @@
/* parrotobject.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotobject.pmc,v 1.5 2003/10/16 19:26:06 scog Exp $
+ * $Id: parrotobject.pmc,v 1.6 2003/12/01 18:54:27 dan Exp $
* Overview:
* These are the vtable functions for the ParrotObject base class
* Data Structure and Algorithms:
@@ -35,6 +35,10 @@
return SELF->vtable->base_type;
}
-
+ # Figure out which method PMC we need. By default we just defer to the
+ # system method lookup code
+ PMC* find_method(STRING* name) {
+ return Parrot_find_method_with_cache(INTERP, VTABLE_get_pmc_keyed_int(INTERP,
(PMC *)PMC_data(SELF), 0));
+ }
}
1.13 +46 -0 parrot/config/gen/platform/darwin.c
Index: darwin.c
===================================================================
RCS file: /cvs/public/parrot/config/gen/platform/darwin.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- darwin.c 16 Aug 2003 17:51:56 -0000 1.12
+++ darwin.c 1 Dec 2003 18:54:30 -0000 1.13
@@ -104,6 +104,50 @@
return getenv(name);
}
+
+/* The dl* functions showed up in OS X 10.3. If we have them, use
+ them, otherwise roll our own */
+#if defined(PARROT_HAS_HEADER_DLFCN)
+#include <dlfcn.h>
+void *
+Parrot_dlopen(const char *filename)
+{
+ return dlopen(filename, PARROT_DLOPEN_FLAGS);
+}
+
+
+/*
+** Parrot_dlerror()
+*/
+
+const char *
+Parrot_dlerror(void)
+{
+ return dlerror();
+}
+
+
+/*
+** Parrot_dlsym()
+*/
+
+void *
+Parrot_dlsym(void *handle, const char *symbol)
+{
+ return dlsym(handle, symbol);
+}
+
+
+/*
+** Parrot_dlclose()
+*/
+
+int
+Parrot_dlclose(void *handle)
+{
+ return dlclose(handle);
+}
+#else
/*
** Parrot_dlopen()
*/
@@ -186,6 +230,8 @@
{
return 0;
}
+
+#endif
/*
* itimer stuff
1.8 +4 -1 parrot/include/parrot/objects.h
Index: objects.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/objects.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- objects.h 3 Nov 2003 06:51:34 -0000 1.7
+++ objects.h 1 Dec 2003 18:54:32 -0000 1.8
@@ -1,7 +1,7 @@
/* objects.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.h,v 1.7 2003/11/03 06:51:34 mrjoltcola Exp $
+ * $Id: objects.h,v 1.8 2003/12/01 18:54:32 dan Exp $
* Overview:
* Parrot class and object header stuff
* Data Structure and Algorithms:
@@ -14,6 +14,9 @@
#define PARROT_OBJECTS_H_GUARD
#include "parrot/parrot.h"
+
+#define PARROT_NAMESPACE_SEPARATOR "\0"
+#define PARROT_NAMESPACE_SEPARATOR_LENGTH 1
PMC *Parrot_single_subclass(Parrot_Interp, PMC *, STRING *);
PMC *Parrot_new_class(Parrot_Interp, STRING *);
1.62 +2 -2 parrot/include/parrot/pmc.h
Index: pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -w -r1.61 -r1.62
--- pmc.h 28 Oct 2003 16:08:23 -0000 1.61
+++ pmc.h 1 Dec 2003 18:54:32 -0000 1.62
@@ -1,7 +1,7 @@
/* pmc.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc.h,v 1.61 2003/10/28 16:08:23 dan Exp $
+ * $Id: pmc.h,v 1.62 2003/12/01 18:54:32 dan Exp $
* Overview:
* This is the api header for the pmc subsystem
* Data Structure and Algorithms:
@@ -18,7 +18,7 @@
#include "parrot/thread.h"
#define PARROT_MAX_CLASSES 100
-VAR_SCOPE VTABLE *Parrot_base_vtables[PARROT_MAX_CLASSES];
+VAR_SCOPE VTABLE **Parrot_base_vtables;/*[PARROT_MAX_CLASSES];*/
VAR_SCOPE INTVAL enum_class_max;
VAR_SCOPE Parrot_mutex class_count_mutex;
1.48 +3 -3 parrot/src/global_setup.c
Index: global_setup.c
===================================================================
RCS file: /cvs/public/parrot/src/global_setup.c,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -w -r1.47 -r1.48
--- global_setup.c 25 Nov 2003 16:23:11 -0000 1.47
+++ global_setup.c 1 Dec 2003 18:54:34 -0000 1.48
@@ -1,7 +1,7 @@
/* global_setup.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: global_setup.c,v 1.47 2003/11/25 16:23:11 dan Exp $
+ * $Id: global_setup.c,v 1.48 2003/12/01 18:54:34 dan Exp $
* Overview:
* Performs all the global setting up of things. This includes the
* (very few) global variables that Parrot totes around
@@ -34,10 +34,10 @@
string_init(); /* Set up the string subsystem */
/* allocate core vtable */
-#if 0
+#if 1
/* no - we can't move existing vtables */
Parrot_base_vtables =
- mem_sys_allocate(sizeof(VTABLE *) * enum_class_core_max);
+ mem_sys_allocate_zeroed(sizeof(VTABLE *) * enum_class_core_max);
#endif
enum_class_max = enum_class_core_max;
1.16 +104 -3 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- objects.c 3 Nov 2003 07:02:08 -0000 1.15
+++ objects.c 1 Dec 2003 18:54:38 -0000 1.16
@@ -1,7 +1,7 @@
/* objects.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.c,v 1.15 2003/11/03 07:02:08 mrjoltcola Exp $
+ * $Id: objects.c,v 1.16 2003/12/01 18:54:38 dan Exp $
* Overview:
* Handles class and object manipulation
* Data Structure and Algorithms:
@@ -12,6 +12,19 @@
#include "parrot/parrot.h"
+/* This should be public, but for right now it's internal */
+static PMC *
+find_global(Parrot_Interp interpreter, STRING *globalname) {
+ PMC* key = key_new_string(interpreter, globalname);
+ if (!VTABLE_exists_keyed(interpreter,
+ interpreter->globals->stash_hash, key)) {
+ return NULL;
+ }
+
+ return VTABLE_get_pmc_keyed(interpreter,
+ interpreter->globals->stash_hash, key);
+}
+
/* Subclass a class. Single parent class, nice and
straightforward. If child_class is NULL, this is an anonymous
subclass we're creating, which happens commonly enough to warrant
@@ -87,6 +100,9 @@
temp_pmc);
VTABLE_set_pmc_keyed_int(interpreter, child_class_array, 4, temp_pmc);
+
+ Parrot_class_register(interpreter, child_class_name, child_class);
+
return child_class;
}
@@ -148,6 +164,24 @@
VTABLE_set_pmc_keyed(interpreter, interpreter->class_hash,
key_new_string(interpreter,class_name), new_class);
+ return;
+ /* Now build a new vtable for this class and register it in the
+ global registry */
+ {
+ /* The child class PMC has a ParrotClass vtable, which is a
+ good base to work from */
+ VTABLE *new_vtable = Parrot_clone_vtable(interpreter, new_class->vtable);
+ INTVAL new_type = pmc_register(interpreter, class_name);
+
+ /* Set the vtable's type to the newly allocated type */
+ Parrot_vtable_set_type(interpreter, new_vtable, new_type);
+
+ /* Reset the init method */
+ new_vtable->init = NULL;
+ new_class->vtable = new_vtable;
+
+ }
+
}
@@ -239,13 +273,80 @@
* interpreter, and name of the method.
*
* This routine should use the current scope's method cache, if there
- * is one. If not, it creates a new method cache
+ * is one. If not, it creates a new method cache. Or, rather, it will
+ * when we've got that bit working. For now it unconditionally goes
+ * and looks up the name in the global stash.
*
*/
PMC *
Parrot_find_method_with_cache(Parrot_Interp interpreter, PMC *class,
STRING *method_name) {
+ PMC* key = key_new_string(interpreter, method_name);
+ PMC* method = NULL; /* The method we ultimately return */
+ PMC* classname; /* The classname PMC for the currently
+ searched class */
+ PMC* curclass; /* PMC for the current search class */
+ PMC* classsearch_array; /* The array of classes we're searching
+ for the method in */
+ INTVAL searchoffset = 0; /* Where in that array we are */
+ INTVAL classcount = 0; /* The number of classes we need to
+ search */
+ STRING *FQ_method; /* The fully qualified name of the method
+ that we're going to look for, rebuilt for
+ each class we search */
+ STRING *fallback_name; /* The name of the fallback method for
+ this class */
+ STRING *shortcut_name; /* The method name with the separator
+ prepended */
+
+ /* For right now, no methods for non-classes. This should change,
+ but it'll do for the moment. */
+ if (!PObj_is_class_TEST(class)) {
return NULL;
+ }
+
+ /* We're going to make this over and over, so get it once and
+ skip the repeated string makes */
+ shortcut_name = string_concat(interpreter, string_from_cstring(interpreter,
PARROT_NAMESPACE_SEPARATOR, PARROT_NAMESPACE_SEPARATOR_LENGTH), method_name, 0);
+
+ /* The order of operations:
+ *
+ * - Look for the method in the class we were passed
+ * - If that doesn't exist, grab the parent class array
+ * - For each element in the parent class array, look for the
+ * method
+ * - If none of that works, try again looking for the fallback method
+ */
+
+ /* See if we get lucky and its in the class of the PMC */
+ FQ_method = string_concat(interpreter, VTABLE_get_string(interpreter,
VTABLE_get_pmc_keyed_int(interpreter, (PMC *)PMC_data(class), 1)), shortcut_name, 0);
+
+ method = find_global(interpreter, FQ_method);
+
+ /* Bail immediately if we got something */
+ if (NULL != method) {
+ return method;
+ }
+
+ /* If not, time to walk through the parent class array. Wheee */
+ classsearch_array = VTABLE_get_pmc_keyed_int(interpreter, (PMC
*)PMC_data(class), 2);
+ classcount = VTABLE_get_integer(interpreter, classsearch_array);
+
+ for (searchoffset = 0; NULL == method && searchoffset < classcount;
searchoffset++) {
+ curclass = VTABLE_get_pmc_keyed_int(interpreter, classsearch_array,
searchoffset);
+
+ FQ_method = string_concat(interpreter, VTABLE_get_string(interpreter,
VTABLE_get_pmc_keyed_int(interpreter, (PMC *)PMC_data(curclass), 1)), shortcut_name,
0);
+ method = find_global(interpreter, FQ_method);
+ }
+
+
+ /* Ultimately, if we've failed, pitch an exception */
+ if (NULL == method) {
+ real_exception(interpreter, NULL, METH_NOT_FOUND,
+ "Method '%s' not found\n",
+ string_to_cstring(interpreter, method_name));
+ }
+ return method;
}
/*
