Delay.st
branchjv
changeset 17892 d86c8bd5ece3
parent 17869 9610c6c94e71
child 17910 8d796ca8bd1d
--- a/Delay.st	Fri Oct 28 08:45:38 2011 +0100
+++ b/Delay.st	Mon Oct 31 22:19:21 2011 +0000
@@ -12,7 +12,7 @@
 "{ Package: 'stx:libbasic' }"
 
 Object subclass:#Delay
-	instanceVariableNames:'millisecondDelta resumptionTime delaySemaphore'
+	instanceVariableNames:'millisecondDelta resumptionTime delaySemaphore isInterrupted'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Processes'
@@ -245,7 +245,6 @@
     "set the millisecond delta and create a new semaphore internally to wait upon"
 
     self assert:(numberOfMillis notNil).
-    self assert:(numberOfMillis isKindOf:SmallInteger).
     millisecondDelta := numberOfMillis.
     delaySemaphore := Semaphore new name:'delaySema'.
 
@@ -289,13 +288,42 @@
      has passed (if millisecondDelta is non-nil), or the absolute millisecondTime
      has been reached (if resumptionTime non-nil)."
 
-    |wasBlocked|
+    |wasBlocked currentDelta dueTime now then|
+
+    isInterrupted := false.
+
+    millisecondDelta notNil ifTrue:[
+        now := OperatingSystem getMillisecondTime.
+        currentDelta := millisecondDelta rounded.
+        currentDelta > 16r0fffffff ifTrue:[
+            "NOTE: the microsecondTime is increasing monotonically,
+                   while millisecondTime is wrapping at 16r1fffffff.
+                   So use the microsecondTime to check when we are finished"
+            dueTime := OperatingSystem getMicrosecondTime + (currentDelta * 1000).
+            currentDelta := 16r0fffffff.
+        ].
+        then := OperatingSystem millisecondTimeAdd:now and:currentDelta .
+    ] ifFalse:[
+        then := resumptionTime.
+    ].
 
     wasBlocked := OperatingSystem blockInterrupts.
     [
-        self startup.
-        Processor activeProcess state:#timeWait.
-        delaySemaphore wait.
+        [
+            Processor signal:delaySemaphore atMilliseconds:then.
+            Processor activeProcess state:#timeWait.
+            delaySemaphore wait.
+        ] doWhile:[
+            (dueTime notNil
+              and:[isInterrupted not
+              and:[(currentDelta := dueTime - OperatingSystem getMicrosecondTime) > 0]]
+            ) ifTrue:[
+                currentDelta := (currentDelta // 1000) min:16r0fffffff.
+                now := OperatingSystem getMillisecondTime.
+                then := OperatingSystem millisecondTimeAdd:now and:currentDelta.
+                true.
+            ] ifFalse:[ false ]
+        ].
     ] ensure:[
         wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
     ]
@@ -316,6 +344,7 @@
     "resume the waiter, even if the delay-time has not yet passed."
 
     [
+        isInterrupted := true.
         self disable.
         delaySemaphore signalOnce.
     ] valueUninterruptably
@@ -329,28 +358,19 @@
     "tell the ProcessorScheduler to forget about signaling my semaphore."
 
     Processor disableSemaphore:delaySemaphore
-!
-
-startup
-    "tell the ProcessorScheduler to signal my semaphore after a while"
-
-    millisecondDelta notNil ifTrue:[
-        Processor signal:delaySemaphore afterMilliseconds:millisecondDelta.
-    ] ifFalse:[
-        Processor signal:delaySemaphore atMilliseconds:resumptionTime.
-    ].
 ! !
 
 !Delay class methodsFor:'documentation'!
 
 version
-    ^ '$Id: Delay.st 10700 2011-09-29 15:44:37Z vranyj1 $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Delay.st,v 1.45 2011/10/27 16:43:56 stefan Exp $'
 !
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic/Delay.st,v 1.44 2010/12/22 13:18:18 cg Exp §'
+    ^ 'Header: /cvs/stx/stx/libbasic/Delay.st,v 1.45 2011/10/27 16:43:56 stefan Exp '
 !
 
 version_SVN
-    ^ '$Id: Delay.st 10700 2011-09-29 15:44:37Z vranyj1 $'
+    ^ '$Id: Delay.st 10729 2011-10-31 22:19:21Z vranyj1 $'
 ! !
+