Re: [Help-smalltalk] Timeouts for BlockClosures

[Paolo Bonzini]

On Sun, Apr 3, 2011 at 19:21, Holger Hans Peter Freyther
<address@hidden> wrote:
> On 04/03/2011 06:57 PM, Holger Hans Peter Freyther wrote:
>
>>
>> Hi again,
>>
>> so Process>>#queueInterrupt: will leave the process suspended if it was
>> suspended during the interrupt. In my case I end with semaphore wait and no
>> other link is in the list. What will be the sequence of adding my own
>> queueInterrupt which will resume the process at the end? E.g. what happens if
>> we are on a socket?
>>
>
> Hi Paolo,
>
> this is my current version that seems to work on first sight. It would be
> appreciated if you could comment about this approach and how wild it is and if
> we could host this code in GST itself, maybe as a TimeOut module or such?

Nice code!

I think you need to change the handling of a suspended process too.
Perhaps it's better to have #finishProcess: implemented in terms of
exceptions, like #signalInterrupt:.  This way we know that the
resumption will look for an exception handler.

Also, for completeness I'd make the TimeoutNotification non-resumable.

Process extend [
    signalInterrupt: anException [
        self interruptLock critical:
                [| block suspended |
                self isActive
                    ifTrue:
                        [anException signal.
                        ^self].
                suspended := self isReady not.
                block := [self evaluate: [anException signal]
                    ifNotTerminated: [suspended ifTrue: [self suspend]].
                suspendedContext := block asContext: suspendedContext.
                self resume]
    ]
]

BlockClosure extend [
    "perhaps pass a Delay here? so you can timeout at a given
     clock value"
    timeout: seconds do: aBlock [
       "I will execute myself for up to seconds and if a timeout
       occurs I will invoke the aBlock. If the timeout occurs early
       not much of the block is executed yet."

       | delay sem proc value timeout |
       "Use the semaphore to signal that we executed everything"
       sem := Semaphore new.

       "Remember the current process"
       proc := Processor activeProcess.

       timeout := false.

       "Start the waiting."
           "Start a process to wait in and then signal"
           [| delay |
               delay := Delay forSeconds: seconds.

               "Wait and see if it is timed out. If so send a signal."
               (delay timedWaitOn: sem) ifTrue: [
                      proc signalInterrupt: (TimeoutNotification on: self) ].
           ] fork.

       [[value := self value] ensure: [sem signal]]
              on: TimeoutNotification do: [:e |
              e block = self
                ifTrue:  [timeout := true. e return]
                ifFalse: [e pass].
        ].

       "Make sure we call the ensure's first."
       ^ timeout
           ifTrue:  [aBlock value]
           ifFalse: [value].
   ]
]

Untested---but if you have testcases I'll gladly merge it!  In
particular, I'd have said the last part could be written as

       ^[self ensure: [sem signal]]
              on: TimeoutNotification do: [:e |
              e block = self
                ifTrue:  [^aBlock value]
                ifFalse: [e pass] ]

but I suspect you found out it's not.

Paolo