[Gd-chatter] r11559 - trunk/fundev/sources/dylan

[hannes at gwydiondylan.org]

Author: hannes
Date: Wed Dec 19 00:03:13 2007
New Revision: 11559

Modified:
   trunk/fundev/sources/dylan/debugging.dylan
   trunk/fundev/sources/dylan/locks.dylan
Log:
Job: fd
debug code for locks, triggered only if debugging? is true
and #"lock" is present in debugging-parts


Modified: trunk/fundev/sources/dylan/debugging.dylan
==============================================================================
--- trunk/fundev/sources/dylan/debugging.dylan	(original)
+++ trunk/fundev/sources/dylan/debugging.dylan	Wed Dec 19 00:03:13 2007
@@ -9,7 +9,7 @@
 
 /// DEBUGGING
 
-define variable *debugging?* :: <boolean>      = #t;
+define variable *debugging?* :: <boolean>      = #f;
 define variable *debug-parts* :: <list>        = #();
 
 define sealed inline method debugging?

Modified: trunk/fundev/sources/dylan/locks.dylan
==============================================================================
--- trunk/fundev/sources/dylan/locks.dylan	(original)
+++ trunk/fundev/sources/dylan/locks.dylan	Wed Dec 19 00:03:13 2007
@@ -109,17 +109,23 @@
 
 
 define inline sealed method release (lock :: <semaphore>, #key) => ()
+  debug-out(#"lock", "Releasing lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = primitive-release-semaphore(lock);
   lock-release-result(lock, res);
 end method;
 
 
 define inline sealed method wait-for (lock :: <semaphore>, #key timeout) => (success?)
+  debug-out(#"lock", "Waiting for lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = if (timeout)
                primitive-wait-for-semaphore-timed(lock, timeout.millisecs)
              else
                primitive-wait-for-semaphore(lock)
              end if;
+  debug-out(#"lock", "Waiting for lock %= in thread %= returned %=\n", 
+            lock, current-thread-id(), res);
   lock-wait-result(lock, res);
 end method;
 
@@ -184,6 +190,8 @@
 
 
 define inline sealed method release (lock :: <recursive-lock>, #key) => ()
+  debug-out(#"lock", "Releasing lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = primitive-release-recursive-lock(lock);
   lock-release-result(lock, res);
 end method;
@@ -191,11 +199,15 @@
 
 define inline sealed method wait-for
       (lock :: <recursive-lock>, #key timeout) => (success?)
+  debug-out(#"lock", "Waiting for lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = if (timeout)
                primitive-wait-for-recursive-lock-timed(lock, timeout.millisecs)
              else
                primitive-wait-for-recursive-lock(lock)
              end if;
+  debug-out(#"lock", "Waiting for lock %= in thread %= returned %=\n", 
+            lock, current-thread-id(), res);
   lock-wait-result(lock, res);
 end method;
 
@@ -262,6 +274,8 @@
 
 
 define inline sealed method release (lock :: <simple-lock>, #key) => ()
+  debug-out(#"lock", "Releasing lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = primitive-release-simple-lock(lock);
   lock-release-result(lock, res);
 end method;
@@ -269,11 +283,15 @@
 
 define inline sealed method wait-for
       (lock :: <simple-lock>, #key timeout) => (success?)
+  debug-out(#"lock", "Waiting for lock %= in thread %=\n", 
+            lock, current-thread-id());
   let res = if (timeout)
                primitive-wait-for-simple-lock-timed(lock, timeout.millisecs)
              else
                primitive-wait-for-simple-lock(lock)
              end if;
+  debug-out(#"lock", "Waiting for lock %= in thread %= returned %=\n", 
+            lock, current-thread-id(), res);
   lock-wait-result(lock, res);
 end method;
 
@@ -331,6 +349,8 @@
 
 
 define sealed method release (lock :: <read-write-lock>, #key) => ()
+  debug-out(#"lock", "Releasing lock %= in thread %=\n", 
+            lock, current-thread-id());
   let monitor = lock.internal-monitor;
   let inner-lock = monitor.associated-lock;
   let res =
@@ -363,6 +383,8 @@
 define sealed method wait-for
       (lock :: <read-write-lock>, #key timeout, mode = #"read") => (success?)
   if (mode == #"read" | mode == #"write")
+    debug-out(#"lock", "Waiting for lock %= in thread %=\n", 
+              lock, current-thread-id());
     let monitor = lock.internal-monitor;
     let inner-lock = monitor.associated-lock;
     block (exit)
@@ -371,6 +393,8 @@
         if (mode == #"write")
           until (lock.lock-is-free?)
             unless (wait-for(monitor, timeout: timeout))
+              debug-out(#"lock", "Acquired lock %= in thread %=\n", 
+                        lock, current-thread-id());
               exit(#f);
             end unless;
           end until;
@@ -379,6 +403,8 @@
         else // mode == #"read"
           until (lock.lock-is-free-for-reading?)
             unless (wait-for(monitor, timeout: timeout))
+              debug-out(#"lock", "Acquired lock %= in thread %=\n", 
+                        lock, current-thread-id());
               exit(#f);
             end unless;
           end until;
@@ -426,4 +452,7 @@
 end method;
 
 
-
+//Helper for debug output
+define inline function current-thread-id () => (res)
+  current-thread().thread-name | current-thread();
+end;