[Gd-chatter] r11130 - in trunk/libraries: programming-tools/multi-thread-test registry/generic

[hannes at gwydiondylan.org]

Author: hannes
Date: Sun Jan 14 03:55:41 2007
New Revision: 11130

Added:
   trunk/libraries/programming-tools/multi-thread-test/
   trunk/libraries/programming-tools/multi-thread-test/library.dylan   (contents, props changed)
   trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.dylan   (contents, props changed)
   trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.lid   (contents, props changed)
   trunk/libraries/registry/generic/multi-thread-test   (contents, props changed)
Log:
Job: minor
*test for my current problem:
  *multiple threads are slow
  *when running in gdb, quite stable
  *when running in strace, a SIGABRT
  *when running standalone, <socket-creation-error>
(currently only tested without preemption)


Added: trunk/libraries/programming-tools/multi-thread-test/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/multi-thread-test/library.dylan	Sun Jan 14 03:55:41 2007
@@ -0,0 +1,16 @@
+module: dylan-user
+
+define library multi-thread-test
+  use dylan;
+  use system;
+  use memory-manager;
+
+  use io;
+end;
+
+define module multi-thread-test
+  use dylan;
+  use memory-manager;
+  use threads;
+  use format-out;
+end;

Added: trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.dylan	Sun Jan 14 03:55:41 2007
@@ -0,0 +1,42 @@
+module: multi-thread-test
+
+
+define variable *counter* :: <integer> = 1;
+
+define constant $lock = make(<lock>);
+define function counter () => (res :: <integer>)
+  with-lock($lock)
+    *counter* := *counter* + 1;
+    *counter*;
+  end;
+end;
+
+
+define class <thread-server> (<object>)
+  slot lock = make(<lock>);
+  slot threads :: <collection> = make(<stretchy-vector>);
+end;
+
+define function thread-worker (ts :: <thread-server>, count :: <integer>) => ()
+  with-lock (ts.lock)
+    add!(ts.threads, count)
+  end;
+  sleep(1);
+  with-lock (ts.lock)
+    remove!(ts.threads, count)
+  end;
+  collect-garbage()
+end;
+
+define function main () => ()
+  let ts = make(<thread-server>);
+  while(#t)
+    let count = counter();
+    make(<thread>, function: curry(thread-worker, ts, count));
+    format-out("Started %d thread [%d]\n", count, ts.threads.size);
+  end;
+end;
+
+begin
+  main();
+end;
\ No newline at end of file

Added: trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/multi-thread-test/multi-thread-test.lid	Sun Jan 14 03:55:41 2007
@@ -0,0 +1,3 @@
+library: multi-thread-test
+files:	library
+	multi-thread-test

Added: trunk/libraries/registry/generic/multi-thread-test
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/multi-thread-test	Sun Jan 14 03:55:41 2007
@@ -0,0 +1 @@
+abstract://dylan/programming-tools/multi-thread-test/multi-thread-test.lid