cvsuser 04/03/20 09:49:29
Modified: include/parrot interpreter.h
src objects.c
Log:
method cache
Revision Changes Path
1.124 +2 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.123
retrieving revision 1.124
diff -u -w -r1.123 -r1.124
--- interpreter.h 23 Feb 2004 19:38:55 -0000 1.123
+++ interpreter.h 20 Mar 2004 17:49:24 -0000 1.124
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.123 2004/02/23 19:38:55 dan Exp $
+ * $Id: interpreter.h,v 1.124 2004/03/20 17:49:24 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -263,6 +263,7 @@
PMC* DOD_registry; /* registered PMCs added to the root set */
struct MMD_table *binop_mmd_funcs; /* Table of MMD function pointers */
PMC** nci_method_table; /* Method table PMC for NCI stubs per class */
+ void * method_cache;
size_t nci_method_table_size; /* allocated size of this table */
struct QUEUE* task_queue; /* per interpreter queue */
int sleeping; /* used durning sleep in events */
1.62 +96 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -w -r1.61 -r1.62
--- objects.c 18 Mar 2004 08:57:18 -0000 1.61
+++ objects.c 20 Mar 2004 17:49:29 -0000 1.62
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.61 2004/03/18 08:57:18 leo Exp $
+$Id: objects.c,v 1.62 2004/03/20 17:49:29 leo Exp $
=head1 NAME
@@ -752,9 +752,103 @@
*/
+static PMC * find_method_with_cache(Parrot_Interp, PMC *, STRING*);
+typedef struct _meth_cache_entry {
+ void * strstart; /* string address */
+ PMC * pmc; /* the mthod */
+ struct _meth_cache_entry *next;
+} Meth_cache_entry;
+typedef struct {
+ UINTVAL size; /* sizeof table */
+ Meth_cache_entry ***idx; /* bufstart idx */
+ /* PMC **hash */ /* for non-constant keys */
+} Meth_cache;
+
+
+#define TBL_SIZE_MASK 0x1ff /* x bits 2..10 */
+#define TBL_SIZE (1 + TBL_SIZE_MASK)
+/*
+ * quick'n'dirty method cache
+ * TODO: integrae NCI meth lookup
+ * TODO: use a hash if method_name is not constant
+ * i.e. from obj.$Sreg(args)
+ * If this hash is implemented mark it during DOD
+ */
PMC *
Parrot_find_method_with_cache(Parrot_Interp interpreter, PMC *class,
- STRING *method_name) {
+ STRING *method_name)
+{
+
+ UINTVAL type = class->vtable->base_type;
+ Meth_cache *mc = interpreter->method_cache;
+ PMC *found;
+ int store_it = 0;
+ int is_const = PObj_constant_TEST(method_name);
+ UINTVAL bits = (((UINTVAL) method_name->strstart ) >> 2) & TBL_SIZE_MASK;
+ Meth_cache_entry *e, *old = NULL;
+
+ if (!is_const) {
+ /* TODO use hash - for now just go look up */
+ goto find_it;
+ }
+
+ if (!mc || type >= mc->size || !mc->idx[type] || !mc->idx[type][bits]) {
+ store_it = 1;
+find_it:
+ found = find_method_with_cache(interpreter, class, method_name);
+ }
+ else {
+ e = mc->idx[type][bits];
+ while (e && e->strstart != method_name->strstart) {
+ old = e;
+ e = e->next;
+ }
+ if (!e) {
+ found = find_method_with_cache(interpreter, class, method_name);
+ goto store_e;
+ }
+ return e->pmc;
+ }
+ if (store_it) {
+ UINTVAL i;
+ if (!mc) {
+ mc = interpreter->method_cache = mem_sys_allocate(sizeof(*mc));
+ mc->size = 0;
+ mc->idx = NULL;
+ }
+ if (type >= mc->size) {
+ mc->idx = mem_sys_realloc(mc->idx,
+ sizeof(UINTVAL*) * (type + 1));
+ for (i = mc->size; i <= type; ++i)
+ mc->idx[i] = NULL;
+ mc->size = type + 1;
+ }
+ if (!mc->idx[type]) {
+ mc->idx[type] = mem_sys_allocate(sizeof(Meth_cache_entry*) *
+ TBL_SIZE);
+ for (i = 0; i < TBL_SIZE; ++i)
+ mc->idx[type][i] = NULL;
+ }
+ old = mc->idx[type][bits];
+store_e:
+ /* when here no or no correct entry was at [bits] */
+ e = mem_sys_allocate(sizeof(Meth_cache_entry));
+ if (old)
+ old->next = e;
+ else
+ mc->idx[type][bits] = e;
+
+ e->pmc = found;
+ e->next = NULL;
+ e->strstart = method_name->strstart;
+ }
+ return found;
+}
+
+static PMC *
+find_method_with_cache(Parrot_Interp interpreter, PMC *class,
+ STRING *method_name)
+{
PMC* method = NULL; /* The method we ultimately return */
PMC* curclass; /* PMC for the current search class */
PMC* classsearch_array; /* The array of classes we're searching
