Squeak
  links to this page:    
View this PageEdit this Page (locked)Uploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
How to time out a method
Last updated at 4:18 pm UTC on 14 January 2006
Question: October 20, 2004 I want to be able to "give up" on a method call if it doesn't return within some time interval. Is there some way of "waiting on on a return value"? SocketStream has a timeout, but is there a more general method? Something like:
 someCode value: v timeOut: t.
Answer: Boris Gaertner Allan M. Schiffman http://c2.com/cgi-bin/wiki?AllanSchiffman published a solution for Smalltalk-80 vs. 2.4. It can be found in the August 1989 issue of the ParcPlace newsletter. This newsletter is now difficult to find, so I attach Allans column to this mail

Fun with Exception-Handling Part I by Allan M. Schiffman

Source: ParcPlace Newsletter Autumn 1989, number 4 page 10.

[Note that this code is not immediately useable in Squeak. See email archives for a 3.7 change set]
Using the new Smalltalk-80 exception-handling facility (introduced in version 2.4 and enhanced in version 2.5) is a heady experience. If you're like me, after you use exception-handling for awhile, all sorts of weird control structures you could create pop into mind, leaving you faintly unnerved with how easy it was. And I have this unsettling image of myself hanging somewhere, with plenty of rope left over ...

Here's one that occured to me recently - how about being able to terminate a computation if if "takes too long", returning an easier to compute answer instead? For example, you were mildly interested in how much object memory you were using, but weren't willing to wait very long to find out, you could evaluate:
[Smalltalk core]            "sometimes takes > 10 seconds"
  valueOnTimeoutMs: 5000    "willing towait 5 seconds"
  do: [Transcript cr;show: 'only guessing'.
       #(35000 1800000)     "answer a wild guess if timed-out"
      ]
The code for class BlockClosure's message valueOnTimeoutMs:do: provided here creates a watchdog process which waits on an appropriate delay. The watchdog uses class Process's message interruptWith: to raise an exception in the original process, which has a handler that runs the timeout block when invoked.

Well, now that it's off my chest, I feel guilty, but better. More next issue!

valueOnTimeoutMs: milliseconds do: timeoutBlock
  "Evaluate the block (the receiver) and answer the result, if that
   evaluation completes in the given number of milliseconds. If not,
   evaluate the timeoutBlock and answer its result instead."
  | theProcess watchdog done dsem delay sig |
  "make a special timeout signal"
sig := Object informationSignal newSignal.
  "the block will be executed in the current process"
theProcess := Processor activeProcess.
delay := Delay forMilliseconds: milliseconds.
  "get the delay's semaphore so it can be signalled elsewhere too"
dsem := delay delaySemaphore.
  "make a watchdog process"
watchdog :=
 [delay wait.               "wait for timeout or completion"
  done ifFalse: [theProcess interruptWith: [sig raise]]] newProcess.
 "watchdog needs to run at high priority to do its job"
watchdog priority: Processor timingPriority.
^sig                          "catch the timeout signal"
  handle: [:ex | ex returnWith: timeoutBlock value]
  do: [ | result |
       done := false.
       watchdog resume.       "start up the atchdog"
       result := self value.  "now evaluate the block..."
       done := true.          "its completed, so ..."
      dsem signal.           "arrange for the watchdog to exit"
       result]


Answer: Brian Murphy-Dye added this method to BlockContext, and made a #TimedBlockError subclass of Error. I'm still learning, so it's not elegant, but maybe it will be helpful to you for now.
waitAtMost: aDuration
	"
	[(Delay forSeconds: 10) wait. 5] waitAtMost: 1 seconds
	[5] waitAtMost: 1 seconds
	[3 / 0] waitAtMost: 5 seconds
	"
	| answer error semaphore blockProcess waitProcess |
	answer := TimedBlockError new.
	semaphore := Semaphore new.
	[blockProcess := [[answer := self value.  semaphore signal]
		on: Exception do: [:e | error := e.  semaphore signal]] fork.
	waitProcess := [(Delay forDuration: aDuration) wait.  
                       semaphore signal] 
       fork]
	ensure:
		[semaphore wait.
		error ifNil: [blockProcess terminate].
		waitProcess ifNotNil: [waitProcess terminate]].
	^ error
		ifNil: [answer]
		ifNotNil: [error signal]
Comment:Bert Freudenberg This will run the block in another process, which is not what you'll want in general. See Boris' message for a better solution.