--- 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 $'
! !
+