[Armedbear-cvs] r14681 - in branches/1.3.1: . src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Thu Apr 17 11:33:21 2014
New Revision: 14681

Log:
Backport r14679-80: Non-zero timeouts CL:SLEEP and THREADS:OBJECT-WAIT
below the timer Planck limit interpolated as a nanosecond.

Thanks for James Lawrence for the consul.

Addresses #14632.

Modified:
   branches/1.3.1/CHANGES
   branches/1.3.1/src/org/armedbear/lisp/LispThread.java

Modified: branches/1.3.1/CHANGES
==============================================================================
--- branches/1.3.1/CHANGES	Thu Apr 17 11:32:05 2014	(r14680)
+++ branches/1.3.1/CHANGES	Thu Apr 17 11:33:21 2014	(r14681)
@@ -10,6 +10,9 @@
 
 ## Fixed
 
+* Interpolate CL:SLEEP and THREADS:OBJECT-WAIT for timeouts below the Planck
+  timer ("1ns") to a nanosecond
+
 *  Update to ASDF 3.1.0.103.
    r14661
 

Modified: branches/1.3.1/src/org/armedbear/lisp/LispThread.java
==============================================================================
--- branches/1.3.1/src/org/armedbear/lisp/LispThread.java	Thu Apr 17 11:32:05 2014	(r14680)
+++ branches/1.3.1/src/org/armedbear/lisp/LispThread.java	Thu Apr 17 11:33:21 2014	(r14681)
@@ -2,7 +2,7 @@
  * LispThread.java
  *
  * Copyright (C) 2003-2007 Peter Graves
- * $Id: LispThread.java 14465 2013-04-24 12:50:37Z rschlatte $
+ * $Id$
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -1264,7 +1264,9 @@
     doc="Causes the invoking thread to sleep for an interveral expressed in SECONDS.\n"
       + "SECONDS may be specified as a fraction of a second, with intervals\n"
       + "less than or equal to a nanosecond resulting in a yield of execution\n"
-      + "to other waiting threads rather than an actual sleep.")
+      + "to other waiting threads rather than an actual sleep.\n"
+      + "A zero value of SECONDS *may* result in the JVM sleeping indefinitely,\n"
+      + "depending on the implementation.")
     private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true)
     {
         @Override
@@ -1272,10 +1274,15 @@
         {
           long millis = sleepMillisPart(arg);
           int nanos = sleepNanosPart(arg);
+          boolean zeroArgP = arg.ZEROP() != NIL;
 
           try {
             if (millis == 0 && nanos == 0) { 
-              Thread.yield(); 
+              if (zeroArgP) {
+                Thread.sleep(0, 0);
+              } else { 
+                Thread.sleep(0, 1);
+              }
             } else {
               Thread.sleep(millis, nanos);
             } 
@@ -1440,6 +1447,7 @@
     doc="Causes the current thread to block until object-notify or object-notify-all is called on OBJECT.\n"
        + "Optionally unblock execution after TIMEOUT seconds.  A TIMEOUT of zero\n"
        + "means to wait indefinitely.\n"
+       + "A non-zero TIMEOUT of less than a nanosecond is interpolated as a nanosecond wait."
        + "\n"
        + "See the documentation of java.lang.Object.wait() for further\n"
        + "information.\n"
@@ -1467,9 +1475,20 @@
         public LispObject execute(LispObject object, LispObject timeout)
 
         {
+          long millis = sleepMillisPart(timeout);
+          int nanos = sleepNanosPart(timeout);
+          boolean zeroArgP = timeout.ZEROP() != NIL;
+          
             try {
-	      object.lockableInstance().wait(sleepMillisPart(timeout),
-					     sleepNanosPart(timeout));
+              if (millis == 0 && nanos == 0) { 
+                if (zeroArgP) {
+                  object.lockableInstance().wait(0, 0);
+                } else {
+                  object.lockableInstance().wait(0, 1);
+                }
+              } else {
+                object.lockableInstance().wait(millis, nanos);
+              }
             }
             catch (InterruptedException e) {
                 currentThread().processThreadInterrupts();