cvsuser 03/12/19 06:07:47
Modified: classes parrotinterpreter.pmc tqueue.pmc
src thread.c
t/op interp.t
t/pmc tqueue.t
Log:
parrot-threads-8
* TQueue mark, destroy
* fake shared behavior in clone (just passes PMC on)
* is_equal method for interpreters and threads
Revision Changes Path
1.17 +17 -1 parrot/classes/parrotinterpreter.pmc
Index: parrotinterpreter.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotinterpreter.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- parrotinterpreter.pmc 19 Dec 2003 10:01:36 -0000 1.16
+++ parrotinterpreter.pmc 19 Dec 2003 14:07:40 -0000 1.17
@@ -1,7 +1,7 @@
/* parrotinterpreter.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotinterpreter.pmc,v 1.16 2003/12/19 10:01:36 leo Exp $
+ * $Id: parrotinterpreter.pmc,v 1.17 2003/12/19 14:07:40 leo Exp $
* Overview:
* These are the vtable functions for the ParrotInterpreter base class
* Data Structure and Algorithms:
@@ -233,6 +233,22 @@
PMC* dest = pmc_new(INTERP, SELF->vtable->base_type);
clone_interpreter(dest, SELF);
return dest;
+ }
+
+ INTVAL is_equal(PMC* val) {
+ Parrot_Interp self, other;
+ /*
+ * 2 interpreter (threads) are equal if both are non-threaded
+ * or they have the same tid
+ */
+ self = PMC_data(SELF);
+ other = PMC_data(val);
+ if (!self->thread_data && !other->thread_data)
+ return 1;
+ if (self->thread_data && other->thread_data &&
+ self->thread_data->tid == other->thread_data->tid)
+ return 1;
+ return 0;
}
}
1.2 +29 -3 parrot/classes/tqueue.pmc
Index: tqueue.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/tqueue.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- tqueue.pmc 19 Dec 2003 12:49:14 -0000 1.1
+++ tqueue.pmc 19 Dec 2003 14:07:40 -0000 1.2
@@ -1,7 +1,7 @@
/* tqueue.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tqueue.pmc,v 1.1 2003/12/19 12:49:14 leo Exp $
+ * $Id: tqueue.pmc,v 1.2 2003/12/19 14:07:40 leo Exp $
* Overview:
* Threadsafe queue class
* Data Structure and Algorithms:
@@ -29,14 +29,33 @@
void init () {
SELF->cache.int_val = 0;
PMC_data(SELF) = queue_init(0);
+ PObj_custom_mark_destroy_SETALL(SELF);
+ }
+
+ PMC* clone() {
+ /* XXX fake a shared PMC */
+ return SELF;
}
void mark () {
- /* TODO */
+ QUEUE *queue = PMC_data(SELF);
+ QUEUE_ENTRY *entry;
+ PMC *val;
+
+ queue_lock(queue);
+ entry = queue->head;
+ while (entry) {
+ pobject_lives(INTERP, (PObj*) entry->data);
+ entry = entry->next;
+ }
+ queue_unlock(queue);
}
void destroy () {
- /* TODO */
+ if (PMC_data(SELF)) {
+ mem_sys_free(PMC_data(SELF));
+ PMC_data(SELF) = NULL;
+ }
}
INTVAL defined () {
@@ -74,6 +93,13 @@
queue_unlock(queue);
}
+ /*
+ * XXX we just take out the PMCs that possibly another thread
+ * has created - that's wrong
+ * idea: remember push()ing interpreter in entry
+ * if shift()ing interpreter is different and data aren't shared
+ * then return clone()ed copies
+ */
PMC* shift_pmc() {
QUEUE_ENTRY *entry;
QUEUE *queue = PMC_data(SELF);
1.6 +2 -1 parrot/src/thread.c
Index: thread.c
===================================================================
RCS file: /cvs/public/parrot/src/thread.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- thread.c 19 Dec 2003 12:49:22 -0000 1.5
+++ thread.c 19 Dec 2003 14:07:42 -0000 1.6
@@ -1,7 +1,7 @@
/* thread.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: thread.c,v 1.5 2003/12/19 12:49:22 leo Exp $
+ * $Id: thread.c,v 1.6 2003/12/19 14:07:42 leo Exp $
* Overview:
* Thread handling stuff
* Data Structure and Algorithms:
@@ -36,6 +36,7 @@
*/
LOCK(interpreter_array_mutex);
interpreter->thread_data->state |= THREAD_STATE_FINISHED;
+ tid = interpreter->thread_data->tid;
if (interpreter != interpreter_array[tid]) {
UNLOCK(interpreter_array_mutex);
internal_exception(1, "thread finished: interpreter mismatch");
1.23 +21 -2 parrot/t/op/interp.t
Index: interp.t
===================================================================
RCS file: /cvs/public/parrot/t/op/interp.t,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -w -r1.22 -r1.23
--- interp.t 18 Dec 2003 16:15:12 -0000 1.22
+++ interp.t 19 Dec 2003 14:07:44 -0000 1.23
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 13;
+use Parrot::Test tests => 14;
output_is(<<'CODE', <<'OUTPUT', "runinterp - new style");
new P0, .ParrotInterpreter
@@ -242,7 +242,26 @@
OUTPUT
SKIP: {
- skip("No thread config yet" ,2) unless $^O eq 'linux';
+ skip("No thread config yet" ,3) unless $^O eq 'linux';
+
+output_is(<<'CODE', <<'OUTPUT', "interp identity");
+ getinterp P2
+ clone P3, P2
+ eq P3, P2, ok1
+ print "not"
+ok1:
+ print "ok 1\n"
+ new P4, .ParrotThread
+ ne P4, P2, ok2
+ print "not"
+ok2:
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "thread 1");
set I5, 1
1.2 +52 -8 parrot/t/pmc/tqueue.t
Index: tqueue.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/tqueue.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- tqueue.t 19 Dec 2003 12:49:16 -0000 1.1
+++ tqueue.t 19 Dec 2003 14:07:47 -0000 1.2
@@ -1,27 +1,27 @@
#! perl -w
-use Parrot::Test tests => 1;
+use Parrot::Test tests => 2;
use Test::More;
output_is(<<'CODE', <<'OUT', "thread safe queue 1");
- new P6, .TQueue
+ new P10, .TQueue
print "ok 1\n"
- set I0, P6
+ set I0, P10
print I0
print "\n"
new P7, .PerlString
set P7, "ok 2\n"
- push P6, P7
+ push P10, P7
new P7, .PerlString
set P7, "ok 3\n"
- push P6, P7
- set I0, P6
+ push P10, P7
+ set I0, P10
print I0
print "\n"
- shift P8, P6
+ shift P8, P10
print P8
- shift P8, P6
+ shift P8, P10
print P8
end
CODE
@@ -32,3 +32,47 @@
ok 3
OUT
+output_is(<<'CODE', <<'OUT', "multi-threaded");
+ new P10, .TQueue
+ new P7, .PerlString
+ set P7, "ok 1\n"
+ push P10, P7
+ new P7, .PerlString
+ set P7, "ok 2\n"
+ push P10, P7
+ new P7, .PerlString
+ set P7, "ok 3\n"
+ push P10, P7
+
+ new P5, .ParrotThread
+ find_global P6, "_foo"
+ find_method P0, P5, "thread"
+ invoke # start the thread
+ set I5, P5
+ getinterp P2
+ find_method P0, P2, "join"
+ invoke # join the thread
+ print "done main\n"
+ end
+
+.pcc_sub _foo:
+ set I0, P10
+ print I0
+ print "\n"
+loop:
+ set I0, P10
+ unless I0, ex
+ shift P8, P10
+ print P8
+ branch loop
+ex:
+ print "done thread\n"
+ invoke P1
+CODE
+3
+ok 1
+ok 2
+ok 3
+done thread
+done main
+OUT
