cvsuser 04/01/14 05:10:18
Modified: classes perlint.pmc tqueue.pmc
lib/Parrot Vtable.pm
src thread.c
t/pmc tqueue.t
. vtable.tbl
Log:
parrot-threads-19
* add a share vtable entry
* not much functionality yet - only PerlInts are considered
threadsafe and implement it
* adjust TQueue and test
This could need a make realclean; perl Configure.pl ...
Revision Changes Path
1.55 +9 -1 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -w -r1.54 -r1.55
--- perlint.pmc 4 Dec 2003 11:50:36 -0000 1.54
+++ perlint.pmc 14 Jan 2004 13:10:05 -0000 1.55
@@ -1,7 +1,7 @@
/* perlint.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlint.pmc,v 1.54 2003/12/04 11:50:36 leo Exp $
+ * $Id: perlint.pmc,v 1.55 2004/01/14 13:10:05 leo Exp $
* Overview:
* These are the vtable functions for the PerlInt base class
* Data Structure and Algorithms:
@@ -18,6 +18,14 @@
void init () {
SELF->cache.int_val = 0;
+ }
+
+ void share () {
+ /*
+ * assume that the access to an int is atomic
+ */
+ if (sizeof(INTVAL) != sizeof(int))
+ SUPER();
}
FLOATVAL get_number () {
1.5 +6 -2 parrot/classes/tqueue.pmc
Index: tqueue.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/tqueue.pmc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- tqueue.pmc 14 Jan 2004 10:20:57 -0000 1.4
+++ tqueue.pmc 14 Jan 2004 13:10:05 -0000 1.5
@@ -1,7 +1,7 @@
/* tqueue.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tqueue.pmc,v 1.4 2004/01/14 10:20:57 leo Exp $
+ * $Id: tqueue.pmc,v 1.5 2004/01/14 13:10:05 leo Exp $
* Overview:
* Threadsafe queue class for inter thread communication
* If you have an unthreaded program then please
@@ -99,9 +99,13 @@
QUEUE *queue = PMC_data(SELF);
/*
- * TODO: if item isn't shared nor const, then make
+ * if item isn't shared nor const, then make
* a shared item
*/
+ if (!(item->vtable->flags &
+ (VTABLE_IS_CONST_FLAG | VTABLE_IS_SHARED_FLAG)))
+ VTABLE_share(INTERP, item);
+
entry->data = item;
entry->type = QUEUE_ENTRY_TYPE_NONE;
/* s. tsq.c:quene_push */
1.30 +2 -1 parrot/lib/Parrot/Vtable.pm
Index: Vtable.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Vtable.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- Vtable.pm 2 Jan 2004 14:09:36 -0000 1.29
+++ Vtable.pm 14 Jan 2004 13:10:09 -0000 1.30
@@ -74,7 +74,8 @@
VTABLE_HAS_CONST_TOO = 0x02,
VTABLE_PMC_NEEDS_EXT = 0x04,
VTABLE_DATA_IS_PMC = 0x08,
- VTABLE_PMC_IS_SINGLETON = 0x10
+ VTABLE_PMC_IS_SINGLETON = 0x10,
+ VTABLE_IS_SHARED_FLAG = 0x20
} vtable_flags_t;
struct _vtable {
1.15 +10 -1 parrot/src/thread.c
Index: thread.c
===================================================================
RCS file: /cvs/public/parrot/src/thread.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- thread.c 14 Jan 2004 10:21:06 -0000 1.14
+++ thread.c 14 Jan 2004 13:10:13 -0000 1.15
@@ -1,7 +1,7 @@
/* thread.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: thread.c,v 1.14 2004/01/14 10:21:06 leo Exp $
+ * $Id: thread.c,v 1.15 2004/01/14 13:10:13 leo Exp $
* Overview:
* Thread handling stuff
* Data Structure and Algorithms:
@@ -18,6 +18,7 @@
#include "parrot/parrot.h"
#include <assert.h>
+static int running_threads;
void Parrot_really_destroy(int exit_code, void *interpreter);
/*
@@ -256,6 +257,9 @@
retval = parent_ret;
}
interpreter_array[tid] = NULL;
+ running_threads--;
+ if (Interp_flags_TEST(parent, PARROT_DEBUG_FLAG))
+ fprintf(stderr, "running threads %d\n", running_threads);
Parrot_really_destroy(0, interpreter);
CLEANUP_POP(1);
/*
@@ -400,11 +404,16 @@
interpreter->thread_data->tid = 0;
new_interp ->thread_data->tid = 1;
n_interpreters = 2;
+
+ running_threads = 2;
return;
}
/*
* look for an empty slot
*/
+ running_threads++;
+ if (Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG))
+ fprintf(stderr, "running threads %d\n", running_threads);
for (i = 0; i < n_interpreters; ++i) {
if (interpreter_array[i] == NULL) {
interpreter_array[i] = new_interp;
1.4 +82 -2 parrot/t/pmc/tqueue.t
Index: tqueue.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/tqueue.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- tqueue.t 26 Dec 2003 12:50:06 -0000 1.3
+++ tqueue.t 14 Jan 2004 13:10:16 -0000 1.4
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 4;
use Test::More;
output_is(<<'CODE', <<'OUT', "thread safe queue 1");
@@ -9,6 +9,85 @@
set I0, P10
print I0
print "\n"
+ new P7, .PerlInt
+ set P7, 2
+ push P10, P7
+ new P7, .PerlInt
+ set P7, 3
+ push P10, P7
+ set I0, P10
+ print I0
+ print "\n"
+
+ shift P8, P10
+ print P8
+ print "\n"
+ shift P8, P10
+ print P8
+ print "\n"
+ end
+CODE
+ok 1
+0
+2
+2
+3
+OUT
+
+output_is(<<'CODE', <<'OUT', "multi-threaded");
+ new P10, .TQueue
+ new P7, .PerlInt
+ set P7, 1
+ push P10, P7
+ new P7, .PerlInt
+ set P7, 2
+ push P10, P7
+ new P7, .PerlInt
+ set P7, 3
+ push P10, P7
+
+ new P5, .ParrotThread
+ find_global P6, "_foo"
+ find_method P0, P5, "thread3"
+ 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
+ print "\n"
+ branch loop
+ex:
+ print "done thread\n"
+ invoke P1
+CODE
+3
+1
+2
+3
+done thread
+done main
+OUT
+
+SKIP: {
+skip("no shared PerlStrings yet", 2);
+output_is(<<'CODE', <<'OUT', "thread safe queue strings 1");
+ new P10, .TQueue
+ print "ok 1\n"
+ set I0, P10
+ print I0
+ print "\n"
new P7, .PerlString
set P7, "ok 2\n"
push P10, P7
@@ -32,7 +111,7 @@
ok 3
OUT
-output_is(<<'CODE', <<'OUT', "multi-threaded");
+output_is(<<'CODE', <<'OUT', "multi-threaded strings");
new P10, .TQueue
new P7, .PerlString
set P7, "ok 1\n"
@@ -76,3 +155,4 @@
done thread
done main
OUT
+}
1.54 +3 -1 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -w -r1.53 -r1.54
--- vtable.tbl 19 Dec 2003 10:01:44 -0000 1.53
+++ vtable.tbl 14 Jan 2004 13:10:18 -0000 1.54
@@ -1,4 +1,4 @@
-# $Id: vtable.tbl,v 1.53 2003/12/19 10:01:44 leo Exp $
+# $Id: vtable.tbl,v 1.54 2004/01/14 13:10:18 leo Exp $
# [MAIN] #default section name
void init()
@@ -265,3 +265,5 @@
void thaw (visit_info* info)
void thawfinish (visit_info* info)
void visit (visit_info* info)
+
+void share()
