cvsuser 03/12/19 04:49:22
Modified: . MANIFEST
include/parrot thread.h
src events.c interpreter.c thread.c tsq.c
Added: classes tqueue.pmc version.pmc
t/pmc tqueue.t
Log:
parrot-threads-7
* wait for other threads on main interpreter destruction
* initialize/destroy interp array mutex
* add TQueue PMC class to experiment with shared PMCs
(currently usage is single-threaded only)
* add Version PMC class - no functionality
Patches welcome
Revision Changes Path
1.518 +3 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.517
retrieving revision 1.518
diff -u -w -r1.517 -r1.518
--- MANIFEST 18 Dec 2003 12:20:24 -0000 1.517
+++ MANIFEST 19 Dec 2003 12:49:04 -0000 1.518
@@ -77,7 +77,9 @@
classes/scratchpad.pmc []
classes/sub.pmc []
classes/timer.pmc []
+classes/tqueue.pmc []
classes/unmanagedstruct.pmc []
+classes/version.pmc []
config/auto/alignptrs.pl []
config/auto/alignptrs/test_c.in []
config/auto/byteorder.pl []
@@ -2268,6 +2270,7 @@
t/pmc/scratchpad.t []
t/pmc/sub.t []
t/pmc/timer.t []
+t/pmc/tqueue.t []
t/src/README []
t/src/basic.t []
t/src/exit.t []
1.1 parrot/classes/tqueue.pmc
Index: tqueue.pmc
===================================================================
/* 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 $
* Overview:
* Threadsafe queue class
* Data Structure and Algorithms:
* History:
* 2003.12.19 leo initial rev
* Notes:
*
* new P0, .TQueue
* push P0, some
* new P2, .ParrotThread
* ...
*
* and in other thread (at least, when shared PMCs work :)
*
* shift P1, P0
*
* References:
*/
#include "parrot/parrot.h"
#include <assert.h>
pmclass TQueue need_ext {
void init () {
SELF->cache.int_val = 0;
PMC_data(SELF) = queue_init(0);
}
void mark () {
/* TODO */
}
void destroy () {
/* TODO */
}
INTVAL defined () {
return SELF.get_integer() != 0;
}
INTVAL get_integer () {
INTVAL items;
QUEUE *queue = PMC_data(SELF);
queue_lock(queue);
items = SELF->cache.int_val;
queue_unlock(queue);
return items;
}
void push_pmc(PMC *item) {
QUEUE_ENTRY* entry = mem_sys_allocate(sizeof(QUEUE_ENTRY));
QUEUE *queue = PMC_data(SELF);
entry->data = item;
entry->type = QUEUE_ENTRY_TYPE_NONE;
/* s. tsq.c:quene_push */
queue_lock(queue);
++SELF->cache.int_val;
/* Is there something in the queue? */
if (queue->tail) {
queue->tail->next = entry;
queue->tail = entry;
} else {
queue->head = entry;
queue->tail = entry;
}
queue_broadcast(queue); /* signal all waiters */
queue_unlock(queue);
}
PMC* shift_pmc() {
QUEUE_ENTRY *entry;
QUEUE *queue = PMC_data(SELF);
PMC *ret;
queue_lock(queue);
while (queue->head == NULL) {
queue_wait(queue);
}
entry = nosync_pop_entry(queue);
--SELF->cache.int_val;
queue_unlock(queue);
ret = entry->data;
mem_sys_free(entry);
return ret;
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 parrot/classes/version.pmc
Index: version.pmc
===================================================================
/* version.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
* $Id: version.pmc,v 1.1 2003/12/19 12:49:14 leo Exp $
* Overview:
* Parrot and module version data
* Data Structure and Algorithms:
* History:
* 2003.12.19 leo initial rev
* Notes:
* Parrot and each module SHOULD have a version. This class
* implements version comparison (number and string).
* A version can be a simple string (0.13.1-devel) or a list
* of pairs of version strings.
* References:
*/
#include "parrot/parrot.h"
#include <assert.h>
pmclass Version need_ext {
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* vim: expandtab shiftwidth=4:
*/
1.1 parrot/t/pmc/tqueue.t
Index: tqueue.t
===================================================================
#! perl -w
use Parrot::Test tests => 1;
use Test::More;
output_is(<<'CODE', <<'OUT', "thread safe queue 1");
new P6, .TQueue
print "ok 1\n"
set I0, P6
print I0
print "\n"
new P7, .PerlString
set P7, "ok 2\n"
push P6, P7
new P7, .PerlString
set P7, "ok 3\n"
push P6, P7
set I0, P6
print I0
print "\n"
shift P8, P6
print P8
shift P8, P6
print P8
end
CODE
ok 1
0
2
ok 2
ok 3
OUT
1.13 +2 -1 parrot/include/parrot/thread.h
Index: thread.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/thread.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- thread.h 18 Dec 2003 17:14:58 -0000 1.12
+++ thread.h 19 Dec 2003 12:49:18 -0000 1.13
@@ -1,7 +1,7 @@
/* thread.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: thread.h,v 1.12 2003/12/18 17:14:58 leo Exp $
+ * $Id: thread.h,v 1.13 2003/12/19 12:49:18 leo Exp $
* Overview:
* This is the api header for the thread primitives
* Data Structure and Algorithms:
@@ -90,6 +90,7 @@
void * pt_thread_join(UINTVAL);
void pt_thread_detach(UINTVAL);
void pt_thread_kill(UINTVAL);
+void pt_join_threads(Parrot_Interp);
/*
* Local variables:
1.14 +6 -1 parrot/src/events.c
Index: events.c
===================================================================
RCS file: /cvs/public/parrot/src/events.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- events.c 18 Dec 2003 16:15:10 -0000 1.13
+++ events.c 19 Dec 2003 12:49:21 -0000 1.14
@@ -1,7 +1,7 @@
/* events.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: events.c,v 1.13 2003/12/18 16:15:10 leo Exp $
+ * $Id: events.c,v 1.14 2003/12/19 12:49:21 leo Exp $
* Overview:
* Event handling stuff
* Data Structure and Algorithms:
@@ -71,6 +71,11 @@
init_events_first(Parrot_Interp interpreter)
{
Parrot_thread the_thread;
+ /*
+ * we need a global mutex to protect the interpreter array
+ */
+
+ MUTEX_INIT(interpreter_array_mutex);
/*
* init event queue - be sure its done only once
* we could use pthread_once for queue_init
1.243 +6 -1 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.242
retrieving revision 1.243
diff -u -w -r1.242 -r1.243
--- interpreter.c 18 Dec 2003 12:20:29 -0000 1.242
+++ interpreter.c 19 Dec 2003 12:49:21 -0000 1.243
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.242 2003/12/18 12:20:29 leo Exp $
+ * $Id: interpreter.c,v 1.243 2003/12/19 12:49:21 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -1047,6 +1047,11 @@
struct Stash *stash, *next_stash;
UNUSED(exit_code);
+
+ /*
+ * wait for threads to complete if needed
+ */
+ pt_join_threads(interpreter);
/* if something needs destruction (e.g. closing PIOs)
* we must destroy it now:
* no DOD run, so everything is considered dead
1.5 +44 -1 parrot/src/thread.c
Index: thread.c
===================================================================
RCS file: /cvs/public/parrot/src/thread.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- thread.c 18 Dec 2003 17:15:01 -0000 1.4
+++ thread.c 19 Dec 2003 12:49:22 -0000 1.5
@@ -1,7 +1,7 @@
/* thread.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: thread.c,v 1.4 2003/12/18 17:15:01 leo Exp $
+ * $Id: thread.c,v 1.5 2003/12/19 12:49:22 leo Exp $
* Overview:
* Thread handling stuff
* Data Structure and Algorithms:
@@ -174,6 +174,49 @@
UNLOCK(interpreter_array_mutex);
internal_exception(1, "join: illegal thread state %d tid %d", state, tid);
return NULL;
+}
+
+/*
+ * possibly wait for other running threads - called when destructing
+ * the passed interpreter
+ */
+void
+pt_join_threads(Parrot_Interp interpreter)
+{
+ size_t i;
+
+ LOCK(interpreter_array_mutex);
+ /*
+ * if no threads where started - fine
+ */
+ if (!n_interpreters) {
+ UNLOCK(interpreter_array_mutex);
+ return;
+ }
+ /*
+ * only the first interpreter waits for other threads
+ */
+ if (interpreter != interpreter_array[0]) {
+ UNLOCK(interpreter_array_mutex);
+ return;
+ }
+
+ for (i = 1; i < n_interpreters; ++i) {
+ Parrot_Interp thread_interp = interpreter_array[i];
+ if (thread_interp == NULL)
+ continue;
+ if (thread_interp->thread_data->state == THREAD_STATE_JOINABLE ||
+ thread_interp->thread_data->state == THREAD_STATE_FINISHED) {
+ void *retval;
+ thread_interp->thread_data->state |= THREAD_STATE_JOINED;
+ UNLOCK(interpreter_array_mutex);
+ JOIN(thread_interp->thread_data->thread, retval);
+ LOCK(interpreter_array_mutex);
+ }
+ }
+ UNLOCK(interpreter_array_mutex);
+ MUTEX_DESTROY(interpreter_array_mutex);
+ return;
}
/*
1.11 +2 -2 parrot/src/tsq.c
Index: tsq.c
===================================================================
RCS file: /cvs/public/parrot/src/tsq.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- tsq.c 16 Dec 2003 11:33:17 -0000 1.10
+++ tsq.c 19 Dec 2003 12:49:22 -0000 1.11
@@ -1,7 +1,7 @@
/* tsq.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tsq.c,v 1.10 2003/12/16 11:33:17 leo Exp $
+ * $Id: tsq.c,v 1.11 2003/12/19 12:49:22 leo Exp $
* Overview:
* Thread-safe queues
* Data Structure and Algorithms:
@@ -77,7 +77,7 @@
queue->head = entry;
queue->tail = entry;
}
- queue_signal(queue);
+ queue_signal(queue); /* assumes only one waiter */
queue_unlock(queue);
}
