cvsuser 04/01/02 06:09:38
Modified: build_tools build_nativecall.pl
classes default.pmc parrotinterpreter.pmc parrotio.pmc
parrotthread.pmc
include/parrot interpreter.h
jit/i386 jit_emit.h
lib/Parrot Pmc2c.pm Vtable.pm
src dod.c interpreter.c thread.c
Log:
parrot-threads-17: make NCI thread-safe
* moved NCI method_table from global Parrot_base_vtables into interpreter
* reenable JITed NCI stubs for i386
* make all NCI meth objects constant - no mark needed anymore
* adapt PMCs to use the now extern enter_nci_method() function
* update defaults find_method() and can()
* implement P signature return value for i386/JITted NCIs
* protect threads return value from early death
* please make realclean; perl Configure.pl ...
Revision Changes Path
1.33 +2 -2 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -w -r1.32 -r1.33
--- build_nativecall.pl 28 Dec 2003 14:07:02 -0000 1.32
+++ build_nativecall.pl 2 Jan 2004 14:09:28 -0000 1.33
@@ -134,7 +134,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.32 2003/12/28 14:07:02 leo Exp $
+ * $Id: build_nativecall.pl,v 1.33 2004/01/02 14:09:28 leo Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -146,7 +146,7 @@
#include "parrot/parrot.h"
-#if defined(HAS_JIT) && defined(I386) && defined(threaded_NCI_is_ok)
+#if defined(HAS_JIT) && defined(I386)
# include "parrot/exec.h"
# include "parrot/jit.h"
# define CAN_BUILD_CALL_FRAMES
1.77 +20 -9 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -w -r1.76 -r1.77
--- default.pmc 4 Dec 2003 11:50:36 -0000 1.76
+++ default.pmc 2 Jan 2004 14:09:30 -0000 1.77
@@ -1,6 +1,6 @@
/* default.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
- * CVS Info $Id: default.pmc,v 1.76 2003/12/04 11:50:36 leo Exp $
+ * CVS Info $Id: default.pmc,v 1.77 2004/01/02 14:09:30 leo Exp $
* Overview:
* These are the vtable functions for the default PMC class
* Data Structure and Algorithms:
@@ -154,10 +154,16 @@
}
PMC* find_method(STRING* method_name) {
- if (SELF->vtable->method_table)
- return VTABLE_get_pmc_keyed(INTERP, SELF->vtable->method_table,
- key_new_string(INTERP, method_name));
+ PMC *meth_hash;
+ int type = SELF->vtable->base_type;
+
+ if (type >= (int)INTERP->nci_method_table_size)
+ return NULL;
+
+ meth_hash = INTERP->nci_method_table[type];
+ if (!meth_hash)
return NULL;
+ return VTABLE_get_pmc_keyed_str(INTERP, meth_hash, method_name);
}
INTVAL get_integer_keyed_int (INTVAL key) {
@@ -267,11 +273,16 @@
}
INTVAL can (STRING* method) {
- PMC *key;
- if (! SELF->vtable->method_table)
+ PMC *meth_hash;
+ int type = SELF->vtable->base_type;
+
+ if (type >= (int)INTERP->nci_method_table_size)
+ return 0;
+
+ meth_hash = INTERP->nci_method_table[type];
+ if (!meth_hash)
return 0;
- key = key_new_string(INTERP, method);
- return VTABLE_exists_keyed(INTERP, SELF->vtable->method_table, key);
+ return VTABLE_exists_keyed_str(INTERP, meth_hash, method);
}
1.22 +9 -34 parrot/classes/parrotinterpreter.pmc
Index: parrotinterpreter.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotinterpreter.pmc,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- parrotinterpreter.pmc 28 Dec 2003 14:07:05 -0000 1.21
+++ parrotinterpreter.pmc 2 Jan 2004 14:09:30 -0000 1.22
@@ -1,7 +1,7 @@
/* parrotinterpreter.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotinterpreter.pmc,v 1.21 2003/12/28 14:07:05 leo Exp $
+ * $Id: parrotinterpreter.pmc,v 1.22 2004/01/02 14:09:30 leo Exp $
* Overview:
* These are the vtable functions for the ParrotInterpreter base class
* Data Structure and Algorithms:
@@ -81,27 +81,6 @@
d->flags = s->flags;
}
-/*
- * copied from parrotio.pmc - this ought to be a global
- * helper function
- */
-static void
-enter_nci_method(struct Parrot_Interp *interpreter, PMC *method_table,
- void *func, const char *name, const char *proto)
-{
- PMC *method;
-
- method = pmc_new(interpreter, enum_class_NCI);
- VTABLE_set_string_keyed(interpreter, method, func,
- string_make(interpreter, proto, strlen(proto),
- NULL, PObj_constant_FLAG|PObj_external_FLAG, NULL));
- VTABLE_set_pmc_keyed_str(interpreter, method_table,
- string_make(interpreter, name,
- strlen(name), NULL,
- PObj_constant_FLAG|PObj_external_FLAG, NULL),
- method);
-}
-
void Parrot_NCI_class_init(Parrot_Interp, int);
void Parrot_PerlHash_class_init(Parrot_Interp, int);
void Parrot_PerlUndef_class_init(Parrot_Interp, int);
@@ -124,40 +103,36 @@
pmclass ParrotInterpreter need_ext {
void class_init () {
- PMC *method_table;
+ int typ = enum_class_ParrotInterpreter;
/* These classes are needed now so make sure they are inited */
Parrot_NCI_class_init(interp, enum_class_NCI);
Parrot_PerlHash_class_init(interp, enum_class_PerlHash);
Parrot_PerlUndef_class_init(interp, enum_class_PerlUndef);
- method_table = pmc_new(INTERP, enum_class_PerlHash);
-
/*
* thread start methods for threads type 1..3
* TODO fix signature, when P2/P5 object issues are clarified
*/
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_run_1), "thread1", "vIPP");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_run_2), "thread2", "vIPP");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_run_3), "thread3", "vIPP");
/*
* TODO unify and fix signatures
*/
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_yield), "yield", "v");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_join), "join", "PIi");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_detach), "detach", "vi");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, typ,
F2DPTR(pt_thread_kill), "kill", "vi");
- Parrot_base_vtables[enum_class_ParrotInterpreter]->method_table =
- method_table;
}
void init () {
1.16 +10 -31 parrot/classes/parrotio.pmc
Index: parrotio.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotio.pmc,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- parrotio.pmc 19 Dec 2003 10:01:36 -0000 1.15
+++ parrotio.pmc 2 Jan 2004 14:09:30 -0000 1.16
@@ -1,7 +1,7 @@
/* ParrotIO.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotio.pmc,v 1.15 2003/12/19 10:01:36 leo Exp $
+ * $Id: parrotio.pmc,v 1.16 2004/01/02 14:09:30 leo Exp $
* Overview:
* These are the vtable functions for Parrot IO
* Data Structure and Algorithms:
@@ -16,22 +16,6 @@
/* This class is actually part of the io subsystem */
#include "../io/io_private.h"
-static void
-enter_nci_method(struct Parrot_Interp *interpreter, PMC *method_table,
- void *func, const char *name, const char *proto)
-{
- PMC *method;
-
- method = pmc_new(interpreter, enum_class_NCI);
- VTABLE_set_string_keyed(interpreter, method, func,
- string_make(interpreter, proto, strlen(proto),
- NULL, PObj_constant_FLAG|PObj_external_FLAG, NULL));
- VTABLE_set_pmc_keyed_str(interpreter, method_table,
- string_make(interpreter, name,
- strlen(name), NULL,
- PObj_constant_FLAG|PObj_external_FLAG, NULL),
- method);
-}
void Parrot_NCI_class_init(Parrot_Interp, int);
void Parrot_PerlHash_class_init(Parrot_Interp, int);
@@ -40,35 +24,30 @@
pmclass ParrotIO need_ext {
void class_init () {
- PMC *method_table;
/* These classes are needed now so make sure they are inited */
Parrot_NCI_class_init(interp, enum_class_NCI);
Parrot_PerlHash_class_init(interp, enum_class_PerlHash);
Parrot_PerlUndef_class_init(interp, enum_class_PerlUndef);
- method_table = pmc_new(INTERP, enum_class_PerlHash);
-
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_close), "close", "iIP");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_flush), "flush", "vIP");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_read), "read", "iIPii");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_write), "write", "iIPii");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_setbuf), "setbuf", "iIPi");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_setlinebuf), "setlinebuf", "iIP");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_puts), "puts", "iIPt");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_seek), "seek", "iIPiii");
- enter_nci_method(INTERP, method_table,
+ enter_nci_method(INTERP, enum_class_ParrotIO,
F2DPTR(PIO_eof), "eof", "iIP");
-
- Parrot_base_vtables[enum_class_ParrotIO]->method_table = method_table;
}
void init () {
1.7 +3 -3 parrot/classes/parrotthread.pmc
Index: parrotthread.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotthread.pmc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- parrotthread.pmc 26 Dec 2003 12:49:48 -0000 1.6
+++ parrotthread.pmc 2 Jan 2004 14:09:30 -0000 1.7
@@ -1,7 +1,7 @@
/* parrotthread.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotthread.pmc,v 1.6 2003/12/26 12:49:48 leo Exp $
+ * $Id: parrotthread.pmc,v 1.7 2004/01/02 14:09:30 leo Exp $
* Overview:
* ParrotThread is a threaded ParrotInterpreter subclass
* Data Structure and Algorithms:
@@ -39,8 +39,8 @@
* inherit interpreter methods - needs interpreter already
* initialized
*/
- Parrot_base_vtables[enum_class_ParrotThread]->method_table =
- Parrot_base_vtables[enum_class_ParrotInterpreter]->method_table;
+ INTERP->nci_method_table[enum_class_ParrotThread] =
+ INTERP->nci_method_table[enum_class_ParrotInterpreter];
}
void init () {
1.114 +7 -3 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -w -r1.113 -r1.114
--- interpreter.h 31 Dec 2003 11:54:32 -0000 1.113
+++ interpreter.h 2 Jan 2004 14:09:32 -0000 1.114
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.113 2003/12/31 11:54:32 leo Exp $
+ * $Id: interpreter.h,v 1.114 2004/01/02 14:09:32 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -258,6 +258,8 @@
int has_early_DOD_PMCs; /* Flag that some want immediate destruction */
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 */
+ size_t nci_method_table_size; /* allocated size of this table */
struct QUEUE* task_queue; /* per interpreter queue */
struct _Thread_data *thread_data; /* thread specific items */
} Interp;
@@ -347,6 +349,8 @@
void clone_interpreter(PMC* dest, PMC* self);
+void enter_nci_method(Parrot_Interp, int type,
+ void *func, const char *name, const char *proto);
#else
typedef void * *(*native_func_t)(struct Parrot_Interp *interpreter,
1.97 +4 -1 parrot/jit/i386/jit_emit.h
Index: jit_emit.h
===================================================================
RCS file: /cvs/public/parrot/jit/i386/jit_emit.h,v
retrieving revision 1.96
retrieving revision 1.97
diff -u -w -r1.96 -r1.97
--- jit_emit.h 21 Dec 2003 10:15:10 -0000 1.96
+++ jit_emit.h 2 Jan 2004 14:09:34 -0000 1.97
@@ -3,7 +3,7 @@
*
* i386
*
- * $Id: jit_emit.h,v 1.96 2003/12/21 10:15:10 leo Exp $
+ * $Id: jit_emit.h,v 1.97 2004/01/02 14:09:34 leo Exp $
*/
#include <assert.h>
@@ -3048,6 +3048,9 @@
jit_emit_mov_mr_i(pc, &INT_REG(next_i++), emit_EAX);
/* fall through */
case 'v': /* void - do nothing */
+ break;
+ case 'P':
+ jit_emit_mov_mr_i(pc, &PMC_REG(next_i++), emit_EAX);
break;
case 'p': /* make a new unmanaged struct */
/* save return value on stack */
1.10 +0 -1 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- Pmc2c.pm 18 Dec 2003 14:51:23 -0000 1.9
+++ Pmc2c.pm 2 Jan 2004 14:09:36 -0000 1.10
@@ -340,7 +340,6 @@
NULL, /* package */
enum_class_$classname, /* base_type */
NULL, /* whoami */
- NULL, /* method_table */
$vtbl_flag, /* flags */
NULL, /* does_str */
NULL, /* isa_str */
1.29 +0 -1 parrot/lib/Parrot/Vtable.pm
Index: Vtable.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Vtable.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- Vtable.pm 10 Dec 2003 17:18:33 -0000 1.28
+++ Vtable.pm 2 Jan 2004 14:09:36 -0000 1.29
@@ -81,7 +81,6 @@
struct PACKAGE *package; /* Pointer to package this vtable belongs to */
INTVAL base_type; /* 'type' value for MMD */
STRING* whoami; /* Name of class this vtable is for */
- PMC* method_table; /* Method table PMC (?) */
UINTVAL flags; /* Flags. Duh */
STRING* does_str; /* space separated list of interfaces */
STRING* isa_str; /* space separated list of classes */
1.78 +1 -10 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -w -r1.77 -r1.78
--- dod.c 31 Dec 2003 11:54:41 -0000 1.77
+++ dod.c 2 Jan 2004 14:09:38 -0000 1.78
@@ -1,7 +1,7 @@
/* dod.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: dod.c,v 1.77 2003/12/31 11:54:41 leo Exp $
+ * $Id: dod.c,v 1.78 2004/01/02 14:09:38 leo Exp $
* Overview:
* Handles dead object destruction of the various headers
* Data Structure and Algorithms:
@@ -186,15 +186,6 @@
for (j = 0; j < 3; j++)
mark_stack(interpreter, stacks[j]);
- }
- /*
- * method_table may have PMCs
- */
- for (i = 1; i < (UINTVAL)enum_class_max; i++) {
- pobject_lives(interpreter, (PObj *)Parrot_base_vtables[i]->whoami);
- if (Parrot_base_vtables[i]->method_table)
- pobject_lives(interpreter,
- (PObj *)Parrot_base_vtables[i]->method_table);
}
/* Walk the iodata */
1.252 +46 -1 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.251
retrieving revision 1.252
diff -u -w -r1.251 -r1.252
--- interpreter.c 31 Dec 2003 11:54:41 -0000 1.251
+++ interpreter.c 2 Jan 2004 14:09:38 -0000 1.252
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.251 2003/12/31 11:54:41 leo Exp $
+ * $Id: interpreter.c,v 1.252 2004/01/02 14:09:38 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -1583,6 +1583,51 @@
* put table in place
*/
notify_func_table(interpreter, interpreter->evc_func_table, 1);
+}
+
+/*
+ * create an entry in the nci_method_table for the given
+ * NCI method of PMC class type
+ */
+void
+enter_nci_method(Parrot_Interp interpreter, int type,
+ void *func, const char *name, const char *proto)
+{
+ PMC *method, *method_table, **table;
+ int i;
+
+ if (type >= (int)interpreter->nci_method_table_size) {
+ if (!interpreter->nci_method_table_size) {
+ table = interpreter->nci_method_table =
+ mem_sys_allocate_zeroed((enum_class_max) * sizeof(PMC*));
+ for (i = 0; i < enum_class_max; ++i)
+ SET_NULL_P(table[i], PMC*);
+ interpreter->nci_method_table_size = enum_class_max;
+ }
+ else {
+ table = interpreter->nci_method_table =
+ mem_sys_realloc(interpreter->nci_method_table,
+ (type + 1) * sizeof(PMC*));
+ for (i = interpreter->nci_method_table_size; i < type + 1; ++i)
+ table[i] = NULL;
+ interpreter->nci_method_table_size = type + 1;
+ }
+ }
+ else
+ table = interpreter->nci_method_table;
+ if (!table[type])
+ table[type] = constant_pmc_new(interpreter, enum_class_PerlHash);
+ method_table = table[type];
+
+ method = constant_pmc_new(interpreter, enum_class_NCI);
+ VTABLE_set_string_keyed(interpreter, method, func,
+ string_make(interpreter, proto, strlen(proto),
+ NULL, PObj_constant_FLAG|PObj_external_FLAG, NULL));
+ VTABLE_set_pmc_keyed_str(interpreter, method_table,
+ string_make(interpreter, name,
+ strlen(name), NULL,
+ PObj_constant_FLAG|PObj_external_FLAG, NULL),
+ method);
}
/*
1.13 +21 -3 parrot/src/thread.c
Index: thread.c
===================================================================
RCS file: /cvs/public/parrot/src/thread.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- thread.c 28 Dec 2003 20:17:43 -0000 1.12
+++ thread.c 2 Jan 2004 14:09:38 -0000 1.13
@@ -1,7 +1,7 @@
/* thread.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: thread.c,v 1.12 2003/12/28 20:17:43 leo Exp $
+ * $Id: thread.c,v 1.13 2004/01/02 14:09:38 leo Exp $
* Overview:
* Thread handling stuff
* Data Structure and Algorithms:
@@ -236,13 +236,31 @@
CLEANUP_PUSH(mutex_unlock, &interpreter_array_mutex);
if (retval) {
- /* clone the PMC into caller */
- PMC *parent_ret = VTABLE_clone(parent, (PMC*)retval);
+ PMC *parent_ret;
+ /*
+ * clone the PMC into caller
+ * the PMC is not in the parents root set nor in the
+ * stack so block DOD during clone
+ * XXX should probably aquire the parent's interpreter mutex
+ */
+ Parrot_block_DOD(parent);
+ parent_ret = VTABLE_clone(parent, (PMC*)retval);
+ Parrot_unblock_DOD(parent);
+ /* this PMC is living only in the stack of this currently
+ * dying interpreter, so register it in parents DOD registry
+ */
+ dod_register_pmc(parent, parent_ret);
retval = parent_ret;
}
interpreter_array[tid] = NULL;
Parrot_really_destroy(0, interpreter);
CLEANUP_POP(1);
+ /*
+ * interpreter destruction is done - unregister the return
+ * value, caller gets it now
+ */
+ if (retval)
+ dod_unregister_pmc(parent, retval);
return retval;
}
/*
