Re: [Help-smalltalk] Timeouts for BlockClosures

[Holger Hans Peter Freyther]

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?


Notification subclass: TimeoutNotification [
    | blk |
    <category: 'osmo-misc'>
    <comment: 'I get send by the timeout handling of BlockClosures
and I am the indication that the time is up and that one should come
to and end.'>

    TimeoutNotification class >> on: aBlk [
        ^ self new
            block: aBlk; yourself
    ]

    block: aBlock [
        blk := aBlock
    ]

    block [
        ^ blk
    ]
]

Process extend [
    finishProcess: aBlock [
        "Stolen from queueInterrupt: but always resumes the Process"
        self interruptLock critical:
                [| block suspended |
                self isActive
                    ifTrue:
                        [aBlock value.
                        ^self].
                self isTerminated
                    ifTrue: [^SystemExceptions.ProcessTerminated signalOn: 
self].
                suspended := self isReady not.
                block := suspended
                            ifFalse:
                                [self suspend.
                                aBlock]
                            ifTrue:
                                [
                                 [self evaluate: aBlock ifNotTerminated: [self
resume]]].
                suspendedContext := block asContext: suspendedContext.
                self resume]
    ]
]

BlockClosure extend [
    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. I also have some issues
        with Delays and not breaking these properly.
        "
        | 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 finishProcess: [ ^ (TimeoutNotification on: self) 
signal].
                ].
            ] fork.

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

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