cvsuser 03/12/20 03:56:35
Modified: classes tqueue.pmc
examples/assembly thr-primes.imc
include/parrot pobj.h
src interpreter.c smallobject.c
Log:
parrot-threads-10
* reduce arena size memory
* set stack limit for all interpreters
* fix TQueue mark
* comment thr-primes.imc
Revision Changes Path
1.3 +4 -1 parrot/classes/tqueue.pmc
Index: tqueue.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/tqueue.pmc,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- tqueue.pmc 19 Dec 2003 14:07:40 -0000 1.2
+++ tqueue.pmc 20 Dec 2003 11:56:29 -0000 1.3
@@ -1,7 +1,7 @@
/* tqueue.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: tqueue.pmc,v 1.2 2003/12/19 14:07:40 leo Exp $
+ * $Id: tqueue.pmc,v 1.3 2003/12/20 11:56:29 leo Exp $
* Overview:
* Threadsafe queue class
* Data Structure and Algorithms:
@@ -46,6 +46,8 @@
entry = queue->head;
while (entry) {
pobject_lives(INTERP, (PObj*) entry->data);
+ if (entry == queue->tail)
+ break;
entry = entry->next;
}
queue_unlock(queue);
@@ -115,6 +117,7 @@
ret = entry->data;
mem_sys_free(entry);
return ret;
+ /* return VTABLE_clone(INTERP, ret); XXX */
}
1.2 +33 -7 parrot/examples/assembly/thr-primes.imc
Index: thr-primes.imc
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/thr-primes.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- thr-primes.imc 19 Dec 2003 16:42:35 -0000 1.1
+++ thr-primes.imc 20 Dec 2003 11:56:31 -0000 1.2
@@ -40,15 +40,20 @@
# translate to PIR by leo
-# Runs currently only with DOD turned off
-# and SIGSEGVs at prime 193 here
+# Runs here (i386/linux 256MB mem) w.
+# ARENA_DOD_FLAGS = 1 MAX=500 (~ 95 threads)
+# ARENA_DOD_FLAGS = 0 MAX=1000 (~ 168 threads)
+
.sub _main
+ .const int MAX = 500
.sym pmc kid
.sym pmc Check_num
.sym pmc stream
#sweepoff
+# 9 my $stream = new Thread::Queue;
stream = new TQueue
+# 10 my $kid = new threads(\&check_num, $stream, 2);
Check_num = global "_check_num"
kid = new ParrotThread
$P2 = new PerlInt
@@ -63,18 +68,23 @@
.nci_call Thread_new
.pcc_end
+# 12 for my $i ( 3 .. 1000 ) {
.sym int i
i = 3
lp:
+# 13 $stream->enqueue($i);
$P3 = new PerlInt
$P3 = i
push stream, $P3
inc i
- if i <= 100 goto lp
+ if i <= MAX goto lp
+# 14 }
+# 16 $stream->enqueue(undef);
$P4 = new PerlUndef
push stream, $P4
+# 17 $kid->join;
.sym int tid
tid = kid
.sym pmc Thread_join
@@ -86,34 +96,45 @@
end
.end
+# 19 sub check_num {
+# 20 my ($upstream, $cur_prime) = @_;
+# XXX still no comments inside pcc param block
.sub _check_num prototyped
.param pmc self
.param pmc sub
.param pmc upstream
.param pmc cur_prime
- sweepoff
- .sym pmc downstream
- downstream = new TQueue
- .sym pmc Num
+# 21 my $kid;
.sym pmc kid
kid = new PerlUndef
+# 22 my $downstream = new Thread::Queue;
+ .sym pmc downstream
+ downstream = new TQueue
+# 23 while (my $num = $upstream->dequeue) {
+ .sym pmc Num # num is a reserved word
lp:
shift Num, upstream
$I0 = defined Num
unless $I0 goto ewhile
+# 24 next unless $num % $cur_prime;
$P0 = new PerlInt
$P0 = Num % cur_prime
unless $P0 goto lp
+# 25 if ($kid) {
$I1 = defined kid
unless $I1 goto no_kid1
+# 26 $downstream->enqueue($num);
push downstream, Num
goto lp
+# 27 } else {
no_kid1:
+# 28 print "Found prime $num\n";
print "Found prime "
print Num
print "\n"
+# 29 $kid = new threads(\&check_num, $downstream, $num);
kid = new ParrotThread
.sym pmc Thread_new
find_method Thread_new, kid, "thread"
@@ -125,14 +146,17 @@
.nci_call Thread_new
.pcc_end
goto lp
+# 31 }
ewhile:
+# 32 $downstream->enqueue(undef) if $kid;
$I1 = defined kid
unless $I1 goto no_kid2
$P4 = new PerlUndef
push downstream, $P4
+# 33 $kid->join if $kid;
.sym int tid
tid = kid
.sym pmc Thread_join
@@ -143,6 +167,8 @@
.pcc_end
no_kid2:
+# 34 }
+ # sleep 1 # turn on for watching memory usage
.pcc_begin_return
.pcc_end_return
.end
1.30 +3 -3 parrot/include/parrot/pobj.h
Index: pobj.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pobj.h,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- pobj.h 27 Oct 2003 15:14:33 -0000 1.29
+++ pobj.h 20 Dec 2003 11:56:33 -0000 1.30
@@ -1,7 +1,7 @@
/* pobj.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pobj.h,v 1.29 2003/10/27 15:14:33 leo Exp $
+ * $Id: pobj.h,v 1.30 2003/12/20 11:56:33 leo Exp $
* Overview:
* Parrot Object data members and flags enum
* Data Structure and Algorithms:
@@ -243,9 +243,9 @@
# define d_PObj_needs_early_DOD_FLAG 0x08
/*
- * arenas are constant sized ~32 byte object size, ~128K objects
+ * arenas are constant sized ~32 byte object size, ~16K objects
*/
-# define ARENA_SIZE (32*1024*128)
+# define ARENA_SIZE (32*1024*16)
# define ARENA_ALIGN ARENA_SIZE
# define ARENA_MASK (~ (ARENA_SIZE-1) )
#if INTVAL_SIZE == 4
1.244 +5 -6 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.243
retrieving revision 1.244
diff -u -w -r1.243 -r1.244
--- interpreter.c 19 Dec 2003 12:49:21 -0000 1.243
+++ interpreter.c 20 Dec 2003 11:56:35 -0000 1.244
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.c,v 1.243 2003/12/19 12:49:21 leo Exp $
+ * $Id: interpreter.c,v 1.244 2003/12/20 11:56:35 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -482,12 +482,11 @@
(opcode_t *(*) (struct Parrot_Interp *, opcode_t *)) 0;
/*
- * if we are entering the run-loop first-time, set the stack limit
+ * setup event function ptrs and set the stack limit
*/
- if (interpreter->resume_flag & RESUME_INITIAL) {
setup_event_func_ptrs(interpreter);
interpreter->lo_var_ptr = (void *)&lo_var_ptr;
- }
+
interpreter->resume_offset = offset;
interpreter->resume_flag |= RESUME_RESTART;
1.30 +4 -2 parrot/src/smallobject.c
Index: smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- smallobject.c 22 Nov 2003 09:55:49 -0000 1.29
+++ smallobject.c 20 Dec 2003 11:56:35 -0000 1.30
@@ -1,7 +1,7 @@
/* resources.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: smallobject.c,v 1.29 2003/11/22 09:55:49 leo Exp $
+ * $Id: smallobject.c,v 1.30 2003/12/20 11:56:35 leo Exp $
* Overview:
* Handles the accessing of small object pools (header pools)
* Data Structure and Algorithms:
@@ -249,7 +249,7 @@
size = ARENA_SIZE;
/*
* [ Note: Linux ]
- * Albeit we reserve 8 pools with 4MB each, the memory footprint
+ * Albeit we reserve x pools with 500KB each, the memory footprint
* of a running program is much smaller, if only a few objects per pool
* are used. The unused pages of the arenas are only mapped (they use space
* in the page tables, but no physical memory).
@@ -260,6 +260,8 @@
* or turn off ARENA_DOD_FLAGS.
*/
new_arena = Parrot_memalign(ARENA_ALIGN, size);
+ if (!new_arena)
+ internal_exception(ALLOCATION_ERROR, "Out of arena memory");
/* offset in bytes of whole Objects */
offset = ( 1 + sizeof(struct Small_Object_Arena) / pool->object_size) *
pool->object_size;
