[BUG] Crash while working on a Future.

Hi all.

I've got this really difficult bug.

Attached is a small ChangeSet containing subset of classes that I'm
using. When I execute the following, Squeak crashes:

Future doing: [ByteStream].

The intended behaviour is that the value is returned immediately and is
usable (any invocation will block), but is filled in with the value of
the block when that block has finished executing.

It works for a few simple cases, but unfortunately the image has a spasm
and dies with the above.

Only alt-d this. Don't inspect or debug it straight off; you'll freeze
the image. Once the 'halt:' has popped up, you should be able to use
that debugger, although you might have to define instVarAt:,
instVarAt:put: and maybe one or two others in MessageCapture.

There is also debugging output logged to squeak.image.log.

I'm stuck on this. I have a feeling that it is more complicated that
what immediately is apparent.

Many thanks to any and all who have a crack at this! Oh, and the
attached code is released under the MIT license.

Mikevdg.


'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 21 June 2006 at 11:21:39 pm'!
Object subclass: #Future
        instanceVariableNames: 'semaphore messageCapture'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!Future commentStamp: 'mvdg 6/5/2006 19:59' prior: 0!
A future is an object which can be assigned as a return value, but doesn't become that value until that value has been computed by something else in the system. So it is a "future" in terms of a "future value". It lets code fork off a computation thread but still immediately return a value.

This class is actually only a manager. The actual object which will become: the value is a MessageCapture.!

Object subclass: #Logger
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!Logger commentStamp: 'mvdg 11/12/2005 08:50' prior: 0!
I just write log messages to a file. See my class methods.

This class is a quick hack and needs to be replaced with something more substantial.!

Logger class
        instanceVariableNames: 'outputFile doNotInterupt'!
ProtoObject subclass: #MessageCapture
        instanceVariableNames: 'target receiver proxyDestroySemaphore numCurrentInvokes'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!MessageCapture commentStamp: 'mikevdg 8/18/2003 10:18' prior: 0!
I intercept and forward messages going to another object.

To install me on an object:

Proxy interceptFrom: aTargetObject forwardTo: aReceivingObject

The receiving object can be any object, but must implement an "acceptFromProxy: theProxy message: aMessage" method.

Instance variables:
        target: the object I am capturing messages to.
        receiver: the object which is going to get those messages.

Don't forget about the return value from Intercepted messages!!

TODO: many methods are passed through to the target; this is not the desired behaviour.
TODO: there shouldn't be a target. Not all algorithms need it.!

Inspector subclass: #MessageCaptureInspector
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!
Exception subclass: #RemoteException
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!RemoteException commentStamp: 'mvdg 11/12/2005 08:23' prior: 0!
Currently used only in the MessageCapture class. !


!ProtoObject methodsFor: 'should be in Squeak' stamp: 'mvdg 6/21/2006 23:19'!
becomeForward: otherObject
        "Primitive. All variables in the entire system that used to point
        to the receiver now point to the argument.
        Fails if either argument is a SmallInteger."

        (Array with: self)
                elementsForwardIdentityTo:
                        (Array with: otherObject)! !


!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:33'!
acceptFromProxy: p message: m
        " Make the calling process wait. "
        Logger show: 'Future got: ', (m selector).
        semaphore wait.
        Logger show: 'Future doing: ', (m selector), 'on a ', (self class name).
        ^ messageCapture perform: (m selector) withArguments: (m arguments).
! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/21/2006 23:16'!
doing: aBlock
        | |
        messageCapture := MessageCapture new.
        messageCapture proxyReceiver: self.

        [ | target |
                target := aBlock value. " <--- This is the main part of the Future "
                messageCapture proxyTarget: target.
                Logger show: 'Future resolving to a ', (target class name).
                (ByteString == target) ifTrue: [self halt: 'about to crash.'].
          messageCapture proxyDestroy.
                Logger show: 'Future resolved to a ', (messageCapture class name asString).
          [semaphore isSignaled] whileFalse: [ semaphore signal ].
        ] fork.

        ^ messageCapture.! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:29'!
initialize
        semaphore := Semaphore new.
! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:56'!
youAreMyReceiver: bob! !


!Future class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:27'!
doing: aBlock
        ^ self new doing: aBlock.! !


!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 11/12/2005 09:00'!
close
        outputFile close.! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:01'!
ensureOpen
        outputFile ifNil: [
                outputFile := CrLfFileStream new open: (SmalltalkImage current imageName,'.log') forWrite: true.
        ] ifNotNil: [
                outputFile ensureOpen.
                outputFile setToEnd.
        ].
        doNotInterupt ifNil: [ doNotInterupt := Semaphore forMutualExclusion ].! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 11/12/2005 09:11'!
reset
        outputFile := nil.! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:12'!
show: aMessage
        self ensureOpen.
        doNotInterupt critical: [
                outputFile nextPutAll: (Time now asString). "Probably better done using Streams..."
                outputFile nextPutAll: ' ',aMessage.
                (aMessage includes: (Character cr)) ifFalse: [
                        outputFile nextPut: Character cr. ].
        ]
! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:03'!
stackTrace
        | sender |
        self ensureOpen.
        doNotInterupt critical: [
                self show: 'Stack trace follows --------------'.
                sender := thisContext sender.
                [ sender isNil ] whileFalse: [
                        sender printOn: outputFile.
                        outputFile cr.
                        sender := sender sender.
                ].
        ]
! !


!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/21/2006 22:55'!
doesNotUnderstand: m
        " doesNotUnderstand gets called on every message without a method. Every message thus. "
        | rv |
        " If you get a doesNotUnderstand in the line below, look further down the stack.
         Also, try calling proxyReset on your replicated object. "
        "numCurrentInvokes := numCurrentInvokes + 1.
        (numCurrentInvokes > 10) ifTrue: [ RemoteException new signal: 'MessageCapture possibly in recursive loop.' ]. "

        m lookupClass: nil.
        Logger show: 'MessageCapture got message: <<', (m asString), '>>'.
        receiver ifNil: [RemoteException new signal: 'MessageCapture has no receiver.'].

        [ rv := receiver acceptFromProxy: self message: m ]
                ifError: [ :e :r |
                        "numCurrentInvokes := numCurrentInvokes - 1."
                        Logger show: 'MessageCapture got error: ', (e asString).].

        " ??? (rv isKindOf: Exception) ifTrue: [RemoteException new signal: (rv asString) ]."
        "numCurrentInvokes := numCurrentInvokes - 1.
        ((numCurrentInvokes == 0) and: [proxyDestroySemaphore isNil not]) ifTrue: [proxyDestroySemaphore signal]."
        ^ rv.
! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 11/9/2003 13:26'!
isDSO
        ^ true.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 2/1/2005 16:54'!
myRepAlg
        "Return my local replication algorithm instance (if I'm a replicated object)"
        ^ self proxyReceiver.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 21:25'!
proxyDestroy
        " Actually do the destruction "
        | tgt |
        tgt := target.

        " Wait until all the invocations have completed. "
        "Logger show: 'MessageCapture waiting... numCurrentInvokes=', numCurrentInvokes asString.
        [numCurrentInvokes == 0] whileFalse: [ proxyDestroySemaphore wait. ]. "

        target := nil.
        receiver := nil.
        Logger show: 'MessageCapture proxyDoDestroy from a : <<',(self class name),'>> to a <<', (tgt class name), '>>'.

        tgt class == MessageCapture
                ifTrue: [ self error: 'MessageCapture shouldn''t need to become another MessageCapture.' ]
                ifFalse: [self becomeForward: tgt].! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:28'!
proxyDestroySemaphore
        ^ proxyDestroySemaphore.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/3/2003 20:23'!
proxyIsProxy
        " A sure way to detect whether a class is being proxied. "
        ^ true.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:29'!
proxynumCurrentInvokes
        ^ numCurrentInvokes.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/4/2003 16:33'!
proxyReceiver
        ^ receiver! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:02'!
proxyReceiver: r
        receiver := r.
        receiver youAreMyReceiver: self.

        " Use this kind of like an initialize method too... "
        numCurrentInvokes := 0.
        proxyDestroySemaphore := Semaphore new.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:28'!
proxyReset
        " Should only be called in dire circumstances. E.g. from a debugger. "
        numCurrentInvokes := 0.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/3/2003 21:19'!
proxyTarget
        ^ target.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/21/2006 23:11'!
proxyTarget: aTarget
        "Set the proxy target. This is the object that used to be where this proxy is now."
        Logger show: 'MessageCapture targetting a ', (aTarget class name).
        (MessageCapture == aTarget class) ifTrue: [1 halt: 'bad'.].

        target ifNotNil: [ Logger show: 'MessageCapture Error: Proxy in use.'. ].
        "target assert: [target isDSO not]."
        target := aTarget.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/15/2006 22:05'!
inspect
        "Create and schedule an Inspector in which the user can examine the receiver's variables."

        MessageCaptureInspector openOn: self withEvalPane: true! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/15/2006 21:12'!
inspectorClass
        ^ MessageCaptureInspector.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/14/2006 09:06'!
isKindOf: aClass
        " Called by the debugger. Pretend that I'm a MessageCapture. "
        self class == aClass ifTrue: [^true].
        (self class inheritsFrom: aClass) ifTrue: [^true].
        ^ false.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
longPrintString
        ^ 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printOn: s
        s nextPutAll: 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printString
        "If you want to get really fancy, you can also ask the receiver to add something."
        ^ 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printStringLimitedTo: limit
        "Answer a String whose characters are a description of the receiver.
        If you want to print without a character limit, use fullPrintString."
        ^ 'a MessageCapture'.! !


!MessageCapture class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/21/2006 23:09'!
interceptFrom: anObject forwardTo: aReceivingObject
        " Install message capture on that object. This replaces anObject with a MessageCapture instance. "
        | aProxy |
       
        anObject isDSO ifTrue: [^anObject].

        "First we check to see if it's actually a valid object."
        (Array
                with: true
                with: false
                with: nil
                with: 1)
                do: [:i | (anObject isKindOf: i class)
                                ifTrue: [self halt]].
        (anObject isKindOf: Symbol)
                ifTrue: [self halt: 'bad idea.'].
        (anObject isKindOf: Metaclass)
                ifTrue: [self halt: 'tut tut!! Don''t install message capture on classes!!'].
        "(anObject isKindOf: ReplicationAlgorithm)
                ifTrue: [Logger show: 'Installing MessageCapture on a RepAlg...?']."
        (Smalltalk == anObject)
                ifTrue: [self halt: 'Proceed to seriously screw up your system.'].
               
        Logger show: 'Installing message capture on a ', anObject class asString.

        aProxy := self new.
        anObject become: aProxy.
        "Now keep in mind that magic has happened: anObject is now the proxy, aProxy is now anObject."
        anObject proxyTarget: aProxy.
        anObject proxyReceiver: aReceivingObject.
        ^ anObject! !

!MessageCapture class methodsFor: 'as yet unclassified' stamp: 'mvdg 10/8/2004 15:26'!
panic
        MessageCapture allInstances do: [ :m | m proxyDestroy ].! !


!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:15'!
inspectBasic
        self error: 'No can do.'.! !

!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 18:29'!
selection
        "The receiver has a list of variables of its inspected object.
        One of these is selected. Answer the value of the selected variable."
        | |
        selectionIndex = 0 ifTrue: [^ ''].
        selectionIndex = 1 ifTrue: [^ 'A ', object class name].
        selectionIndex = 2 ifTrue: [^ 'Look them up yourself, lazy bugger.'].
        " I need to be very careful about which methods I call. "
        selectionIndex = 3 ifTrue: [^ object proxyTarget ].
        selectionIndex = 4 ifTrue: [^ object proxyReceiver ].
        selectionIndex = 5 ifTrue: [^ object proxyDestroySemaphore ].
        selectionIndex = 6 ifTrue: [^ object proxynumCurrentInvokes ].
        ^ 'I don''t know.'.
! !

!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:54'!
viewerForValue
        self error: 'Don''t know how.'.! !


!MessageCaptureInspector class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 22:01'!
openAsMorphOn: anObject
        ^ self openAsMorphOn: anObject withLabel: ('A ', anObject class name asString).! !

!MessageCaptureInspector class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:59'!
openOn: anObject withEvalPane: withEval
        "Create and schedule an instance of me on the model, anInspector. "

        ^ self openOn: anObject withEvalPane: withEval withLabel: ('A ', anObject class name).! !


!RemoteException methodsFor: 'as yet unclassified' stamp: 'mvdg 2/4/2006 21:12'!
defaultAction
        ^ UnhandledError signalForException: self! !


!ProtoObject reorganize!
('testing' ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isInMemory isNil pointsTo:)
('comparing' identityHash == ~~)
('system primitives' become: cannotInterpret: doesNotUnderstand: nextInstance nextObject)
('objects from disk' rehash)
('debugging' doOnlyOnce: flag: rearmOneShot)
('initialize-release' initialize)
('apply primitives' tryNamedPrimitive tryNamedPrimitive: tryNamedPrimitive:with: tryNamedPrimitive:with:with: tryNamedPrimitive:with:with:with: tryNamedPrimitive:with:with:with:with: tryNamedPrimitive:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with:with: tryPrimitive:withArgs:)
('should be in Squeak' becomeForward:)
!

On 6/21/06, Michael van der Gulik <[hidden email]> wrote:

> I've got this really difficult bug.

I'll say; when you subclass ProtoObject, it's easy to forget about
some vital message that's usually handled in Object.

> When I execute the following, Squeak crashes:

> Future doing: [ByteStream].

What's a ByteStream? Do you mean ByteString?

You can debug the debugger to find where it crashes. Inspect the
debugger's model, then debug what happens when you send it #send.
That's how I found that the debugger chokes for the first time when a
MessageCapture is sent #class. If I fix that, it chokes for the second
time when it gets #instVarAt:. I'm sure there are more after that, but
I'll let you find them.

Cheers!

--Tom Phoenix

Hi Tom.

Attached is a change set with actually lets you use the debugger :-).
Remember to use this on a disposable image; the image won't be usable
after running this.

Run "Future doing: [ByteString]" to crash the image.

Tom Phoenix wrote:
> On 6/21/06, Michael van der Gulik <[hidden email]> wrote:
>
>> I've got this really difficult bug.
>
> I'll say; when you subclass ProtoObject, it's easy to forget about
> some vital message that's usually handled in Object.

Oh, I'm quite used to working with ProtoObject now. I've been capturing
messages for a couple of years now and doing crazy things with them.

>> When I execute the following, Squeak crashes:
>
>> Future doing: [ByteStream].
>
> What's a ByteStream? Do you mean ByteString?

Ahh... yea. One of those :o).

> You can debug the debugger to find where it crashes. Inspect the
> debugger's model, then debug what happens when you send it #send.
> That's how I found that the debugger chokes for the first time when a
> MessageCapture is sent #class. If I fix that, it chokes for the second
> time when it gets #instVarAt:. I'm sure there are more after that, but
> I'll let you find them.

Yea, I forgot to include all this stuff in the previous change set.

I have a forbidding feeling that the answer will lie in the virtual
machine implementation. Current I'm just trying to get
InterpreterSimulator working (from VMMaker-tpr-58), but that doesn't
seem to run. I've fixed the first few bugs, but then it wants to coerce
a Symbol (acting as a function pointer) to a long for inclusion in a
method cache...!?

Mikevdg.



'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 22 June 2006 at 9:02:53 pm'!
ProtoObject subclass: #MessageCapture
        instanceVariableNames: 'target receiver proxyDestroySemaphore numCurrentInvokes'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!MessageCapture commentStamp: 'mikevdg 8/18/2003 10:18' prior: 0!
I intercept and forward messages going to another object.

To install me on an object:

Proxy interceptFrom: aTargetObject forwardTo: aReceivingObject

The receiving object can be any object, but must implement an "acceptFromProxy: theProxy message: aMessage" method.

Instance variables:
        target: the object I am capturing messages to.
        receiver: the object which is going to get those messages.

Don't forget about the return value from Intercepted messages!!

TODO: many methods are passed through to the target; this is not the desired behaviour.
TODO: there shouldn't be a target. Not all algorithms need it.!

Object subclass: #Future
        instanceVariableNames: 'semaphore messageCapture'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!Future commentStamp: 'mvdg 6/5/2006 19:59' prior: 0!
A future is an object which can be assigned as a return value, but doesn't become that value until that value has been computed by something else in the system. So it is a "future" in terms of a "future value". It lets code fork off a computation thread but still immediately return a value.

This class is actually only a manager. The actual object which will become: the value is a MessageCapture.!

Object subclass: #Logger
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!Logger commentStamp: 'mvdg 11/12/2005 08:50' prior: 0!
I just write log messages to a file. See my class methods.

This class is a quick hack and needs to be replaced with something more substantial.!

Logger class
        instanceVariableNames: 'outputFile doNotInterupt'!
Inspector subclass: #MessageCaptureInspector
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!
Exception subclass: #RemoteException
        instanceVariableNames: ''
        classVariableNames: ''
        poolDictionaries: ''
        category: 'DPON-kernel'!

!RemoteException commentStamp: 'mvdg 11/12/2005 08:23' prior: 0!
Currently used only in the MessageCapture class. !


!ProtoObject methodsFor: 'should be in Squeak' stamp: 'mvdg 6/21/2006 23:19'!
becomeForward: otherObject
        "Primitive. All variables in the entire system that used to point
        to the receiver now point to the argument.
        Fails if either argument is a SmallInteger."

        (Array with: self)
                elementsForwardIdentityTo:
                        (Array with: otherObject)! !

!ProtoObject methodsFor: 'should be in Squeak' stamp: 'mvdg 6/22/2006 20:56'!
instVarAt: index
        "Primitive. Answer a fixed variable in an object. The numbering of the
        variables corresponds to the named instance variables. Fail if the index
        is not an Integer or is not the index of a fixed variable. Essential. See
        Object documentation whatIsAPrimitive."

        <primitive: 73>
        "Access beyond fixed variables."
        ^self basicAt: index - self class instSize ! !

!ProtoObject methodsFor: 'should be in Squeak' stamp: 'mvdg 6/22/2006 20:56'!
instVarAt: anInteger put: anObject
        "Primitive. Store a value into a fixed variable in the receiver. The
        numbering of the variables corresponds to the named instance variables.
        Fail if the index is not an Integer or is not the index of a fixed variable.
        Answer the value stored as the result. Using this message violates the
        principle that each object has sovereign control over the storing of
        values into its instance variables. Essential. See Object documentation
        whatIsAPrimitive."

        <primitive: 74>
        "Access beyond fixed fields"
        ^self basicAt: anInteger - self class instSize put: anObject! !


!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/22/2006 21:00'!
class
        "Primitive. Answer the object which is the receiver's class. Essential. See
        Object documentation whatIsAPrimitive."

        <primitive: 111>
        self primitiveFailed! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/21/2006 22:55'!
doesNotUnderstand: m
        " doesNotUnderstand gets called on every message without a method. Every message thus. "
        | rv |
        " If you get a doesNotUnderstand in the line below, look further down the stack.
         Also, try calling proxyReset on your replicated object. "
        "numCurrentInvokes := numCurrentInvokes + 1.
        (numCurrentInvokes > 10) ifTrue: [ RemoteException new signal: 'MessageCapture possibly in recursive loop.' ]. "

        m lookupClass: nil.
        Logger show: 'MessageCapture got message: <<', (m asString), '>>'.
        receiver ifNil: [RemoteException new signal: 'MessageCapture has no receiver.'].

        [ rv := receiver acceptFromProxy: self message: m ]
                ifError: [ :e :r |
                        "numCurrentInvokes := numCurrentInvokes - 1."
                        Logger show: 'MessageCapture got error: ', (e asString).].

        " ??? (rv isKindOf: Exception) ifTrue: [RemoteException new signal: (rv asString) ]."
        "numCurrentInvokes := numCurrentInvokes - 1.
        ((numCurrentInvokes == 0) and: [proxyDestroySemaphore isNil not]) ifTrue: [proxyDestroySemaphore signal]."
        ^ rv.
! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 11/9/2003 13:26'!
isDSO
        ^ true.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 2/1/2005 16:54'!
myRepAlg
        "Return my local replication algorithm instance (if I'm a replicated object)"
        ^ self proxyReceiver.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 21:25'!
proxyDestroy
        " Actually do the destruction "
        | tgt |
        tgt := target.

        " Wait until all the invocations have completed. "
        "Logger show: 'MessageCapture waiting... numCurrentInvokes=', numCurrentInvokes asString.
        [numCurrentInvokes == 0] whileFalse: [ proxyDestroySemaphore wait. ]. "

        target := nil.
        receiver := nil.
        Logger show: 'MessageCapture proxyDoDestroy from a : <<',(self class name),'>> to a <<', (tgt class name), '>>'.

        tgt class == MessageCapture
                ifTrue: [ self error: 'MessageCapture shouldn''t need to become another MessageCapture.' ]
                ifFalse: [self becomeForward: tgt].! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:28'!
proxyDestroySemaphore
        ^ proxyDestroySemaphore.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/3/2003 20:23'!
proxyIsProxy
        " A sure way to detect whether a class is being proxied. "
        ^ true.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:29'!
proxynumCurrentInvokes
        ^ numCurrentInvokes.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/4/2003 16:33'!
proxyReceiver
        ^ receiver! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:02'!
proxyReceiver: r
        receiver := r.
        receiver youAreMyReceiver: self.

        " Use this kind of like an initialize method too... "
        numCurrentInvokes := 0.
        proxyDestroySemaphore := Semaphore new.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/18/2006 18:28'!
proxyReset
        " Should only be called in dire circumstances. E.g. from a debugger. "
        numCurrentInvokes := 0.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mikevdg 7/3/2003 21:19'!
proxyTarget
        ^ target.! !

!MessageCapture methodsFor: 'proxy' stamp: 'mvdg 6/21/2006 23:11'!
proxyTarget: aTarget
        "Set the proxy target. This is the object that used to be where this proxy is now."
        Logger show: 'MessageCapture targetting a ', (aTarget class name).
        (MessageCapture == aTarget class) ifTrue: [1 halt: 'bad'.].

        target ifNotNil: [ Logger show: 'MessageCapture Error: Proxy in use.'. ].
        "target assert: [target isDSO not]."
        target := aTarget.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/22/2006 21:00'!
basicAt: index
        "Primitive. Assumes receiver is indexable. Answer the value of an
        indexable element in the receiver. Fail if the argument index is not an
        Integer or is out of bounds. Essential. Do not override in a subclass. See
        Object documentation whatIsAPrimitive."

        <primitive: 60>
        index isInteger ifTrue: [self errorSubscriptBounds: index].
        index isNumber
                ifTrue: [^self basicAt: index asInteger]
                ifFalse: [self errorNonIntegerIndex]! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/22/2006 21:01'!
basicAt: index put: value
        "Primitive. Assumes receiver is indexable. Store the second argument
        value in the indexable element of the receiver indicated by index. Fail
        if the index is not an Integer or is out of bounds. Or fail if the value is
        not of the right type for this kind of collection. Answer the value that
        was stored. Essential. Do not override in a subclass. See Object
        documentation whatIsAPrimitive."

        <primitive: 61>
        index isInteger
                ifTrue: [(index >= 1 and: [index <= self size])
                                        ifTrue: [self errorImproperStore]
                                        ifFalse: [self errorSubscriptBounds: index]].
        index isNumber
                ifTrue: [^self basicAt: index asInteger put: value]
                ifFalse: [self errorNonIntegerIndex]! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/15/2006 22:05'!
inspect
        "Create and schedule an Inspector in which the user can examine the receiver's variables."

        MessageCaptureInspector openOn: self withEvalPane: true! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/15/2006 21:12'!
inspectorClass
        ^ MessageCaptureInspector.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/14/2006 09:06'!
isKindOf: aClass
        " Called by the debugger. Pretend that I'm a MessageCapture. "
        self class == aClass ifTrue: [^true].
        (self class inheritsFrom: aClass) ifTrue: [^true].
        ^ false.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
longPrintString
        ^ 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printOn: s
        s nextPutAll: 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printString
        "If you want to get really fancy, you can also ask the receiver to add something."
        ^ 'a MessageCapture'.! !

!MessageCapture methodsFor: 'object functionality' stamp: 'mvdg 6/18/2006 18:33'!
printStringLimitedTo: limit
        "Answer a String whose characters are a description of the receiver.
        If you want to print without a character limit, use fullPrintString."
        ^ 'a MessageCapture'.! !


!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:33'!
acceptFromProxy: p message: m
        " Make the calling process wait. "
        Logger show: 'Future got: ', (m selector).
        semaphore wait.
        Logger show: 'Future doing: ', (m selector), 'on a ', (self class name).
        ^ messageCapture perform: (m selector) withArguments: (m arguments).
! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/21/2006 23:16'!
doing: aBlock
        | |
        messageCapture := MessageCapture new.
        messageCapture proxyReceiver: self.

        [ | target |
                target := aBlock value. " <--- This is the main part of the Future "
                messageCapture proxyTarget: target.
                Logger show: 'Future resolving to a ', (target class name).
                (ByteString == target) ifTrue: [self halt: 'about to crash.'].
          messageCapture proxyDestroy.
                Logger show: 'Future resolved to a ', (messageCapture class name asString).
          [semaphore isSignaled] whileFalse: [ semaphore signal ].
        ] fork.

        ^ messageCapture.! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:29'!
initialize
        semaphore := Semaphore new.
! !

!Future methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:56'!
youAreMyReceiver: bob! !


!Future class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 17:27'!
doing: aBlock
        ^ self new doing: aBlock.! !


!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 11/12/2005 09:00'!
close
        outputFile close.! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:01'!
ensureOpen
        outputFile ifNil: [
                outputFile := CrLfFileStream new open: (SmalltalkImage current imageName,'.log') forWrite: true.
        ] ifNotNil: [
                outputFile ensureOpen.
                outputFile setToEnd.
        ].
        doNotInterupt ifNil: [ doNotInterupt := Semaphore forMutualExclusion ].! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 11/12/2005 09:11'!
reset
        outputFile := nil.! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:12'!
show: aMessage
        self ensureOpen.
        doNotInterupt critical: [
                outputFile nextPutAll: (Time now asString). "Probably better done using Streams..."
                outputFile nextPutAll: ' ',aMessage.
                (aMessage includes: (Character cr)) ifFalse: [
                        outputFile nextPut: Character cr. ].
        ]
! !

!Logger class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/14/2006 09:03'!
stackTrace
        | sender |
        self ensureOpen.
        doNotInterupt critical: [
                self show: 'Stack trace follows --------------'.
                sender := thisContext sender.
                [ sender isNil ] whileFalse: [
                        sender printOn: outputFile.
                        outputFile cr.
                        sender := sender sender.
                ].
        ]
! !


!MessageCapture class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/21/2006 23:09'!
interceptFrom: anObject forwardTo: aReceivingObject
        " Install message capture on that object. This replaces anObject with a MessageCapture instance. "
        | aProxy |
       
        anObject isDSO ifTrue: [^anObject].

        "First we check to see if it's actually a valid object."
        (Array
                with: true
                with: false
                with: nil
                with: 1)
                do: [:i | (anObject isKindOf: i class)
                                ifTrue: [self halt]].
        (anObject isKindOf: Symbol)
                ifTrue: [self halt: 'bad idea.'].
        (anObject isKindOf: Metaclass)
                ifTrue: [self halt: 'tut tut!! Don''t install message capture on classes!!'].
        "(anObject isKindOf: ReplicationAlgorithm)
                ifTrue: [Logger show: 'Installing MessageCapture on a RepAlg...?']."
        (Smalltalk == anObject)
                ifTrue: [self halt: 'Proceed to seriously screw up your system.'].
               
        Logger show: 'Installing message capture on a ', anObject class asString.

        aProxy := self new.
        anObject become: aProxy.
        "Now keep in mind that magic has happened: anObject is now the proxy, aProxy is now anObject."
        anObject proxyTarget: aProxy.
        anObject proxyReceiver: aReceivingObject.
        ^ anObject! !

!MessageCapture class methodsFor: 'as yet unclassified' stamp: 'mvdg 10/8/2004 15:26'!
panic
        MessageCapture allInstances do: [ :m | m proxyDestroy ].! !


!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:15'!
inspectBasic
        self error: 'No can do.'.! !

!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/18/2006 18:29'!
selection
        "The receiver has a list of variables of its inspected object.
        One of these is selected. Answer the value of the selected variable."
        | |
        selectionIndex = 0 ifTrue: [^ ''].
        selectionIndex = 1 ifTrue: [^ 'A ', object class name].
        selectionIndex = 2 ifTrue: [^ 'Look them up yourself, lazy bugger.'].
        " I need to be very careful about which methods I call. "
        selectionIndex = 3 ifTrue: [^ object proxyTarget ].
        selectionIndex = 4 ifTrue: [^ object proxyReceiver ].
        selectionIndex = 5 ifTrue: [^ object proxyDestroySemaphore ].
        selectionIndex = 6 ifTrue: [^ object proxynumCurrentInvokes ].
        ^ 'I don''t know.'.
! !

!MessageCaptureInspector methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:54'!
viewerForValue
        self error: 'Don''t know how.'.! !


!MessageCaptureInspector class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 22:01'!
openAsMorphOn: anObject
        ^ self openAsMorphOn: anObject withLabel: ('A ', anObject class name asString).! !

!MessageCaptureInspector class methodsFor: 'as yet unclassified' stamp: 'mvdg 6/15/2006 21:59'!
openOn: anObject withEvalPane: withEval
        "Create and schedule an instance of me on the model, anInspector. "

        ^ self openOn: anObject withEvalPane: withEval withLabel: ('A ', anObject class name).! !


!RemoteException methodsFor: 'as yet unclassified' stamp: 'mvdg 2/4/2006 21:12'!
defaultAction
        ^ UnhandledError signalForException: self! !

Object removeSelector: #instVarAt:!
Object removeSelector: #instVarAt:put:!

!ProtoObject reorganize!
('testing' ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isInMemory isNil pointsTo:)
('comparing' identityHash == ~~)
('system primitives' become: cannotInterpret: doesNotUnderstand: nextInstance nextObject)
('objects from disk' rehash)
('debugging' doOnlyOnce: flag: rearmOneShot)
('initialize-release' initialize)
('apply primitives' tryNamedPrimitive tryNamedPrimitive: tryNamedPrimitive:with: tryNamedPrimitive:with:with: tryNamedPrimitive:with:with:with: tryNamedPrimitive:with:with:with:with: tryNamedPrimitive:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with: tryNamedPrimitive:with:with:with:with:with:with:with: tryPrimitive:withArgs:)
('should be in Squeak' becomeForward: instVarAt: instVarAt:put:)
!

On 6/22/06, Michael van der Gulik <[hidden email]> wrote:

> Attached is a change set with actually lets you use the debugger :-).

Thanks. This gave me a better idea about what you were trying to do, I think.

> Run "Future doing: [ByteString]" to crash the image.

Does it have to be ByteString? That's an important class in the
system. It seems to be an arbitrary choice, since it only shows up in
your halt code.

As I understand the operation of #becomeForward:, you're
instantaneously turning your MessageCapture instance into ByteString.
But the identity hash of your instance should stay the same, in case
it's in a dictionary, say. That means that the identity hash of
ByteString changes to become the hash of your object, even though that
can break any dictionaries that *it* was in.

So it would probably break even if you didn't use such an important
class as ByteString.

I'm not sure of the proper way to deal with identity hash invariance
when using #becomeForward:. We're into some serious magic here.
Object>>becomeForward:copyHash: seems to have been implemented to deal
with this sort of thing; though there may be further pitfalls.

Maybe a subclass of ProtoObject and wizardly uses of #become: isn't
the technology you need to use. Have I understood correctly what
you're trying to do? It seems to me that you want an object that is a
placeholder today and the real value tomorrow. That's probably
possible without much magic. But you must ensure that a client doesn't
send messages to the placeholder before it becomes the real value. I
don't see any good way to do that without asking the client to do
something active, such as using a Semaphore, or sending the
placeholder a signal. The trouble I see is that there's no way to tell
when a message to the placeholder is "really" destined for the real
value.

Here's some brainstorming....

  "A client wants to do something while a calculation completes"
  nilNowValLater := Future doing: [ 49 sqrt ].
  nilNowValLater inspect. "It's nil, maybe still"
  self doSomething.
  [ nilNowValLater isNil ] whileTrue. "Bad: Busy wait"
  nilNowValLater inspect. "Now it's 7"

The busy wait is undesirable, since we tie up the processor precisely
when we want it to devote time to the other process. We could put in a
Delay, but let's try a different way.

  stat := Future doing: [ 49 sqrt ].
  stat inspect. "It's an instance of Future"
  self doSomething.
  stat inspect. "It's still an instance of Future"
  stat wait. "stat updates, waiting if needed"
  stat inspect. "Now it's 7"

Now there's no busy wait. In this scheme, Future gives a status object
that can (presumably) be interrogated about the ongoing process, i.e,
whether it's complete or still running. And the status object doesn't
auto-convert; you have to send it #wait. (Because 7 won't necessarily
respond correctly to #wait, at least.) But why do this with a
magically-updating value, since it doesn't even auto-convert? Subtract
the magic and you get this:

  stat := Future doing: [ 49 sqrt ].
  stat inspect. "It's an instance of Future"
  self doSomething.
  stat isDone ifFalse: [ self doSomethingMore ].
  stat result inspect. "gives 7"

Under this metaphor, an instance of Future is the status of the
request, and you have to ask it for the result. Ask whenever you'd
like, but you may have to wait for the answer, if it's not ready yet.
Nothing magically updates, so I don't have to deal with any new
concepts. And it allows code like this:

  "Open an inspector as soon as the network request has returned a value."
  stat := Future doing: [ networkRequest value ].
  stat whenDoneDo: [:result | result inspect ].

  "If time runs out, return a failureToken"
  stat afterTimeoutSeconds: 300 terminateAndDo: [ stat return: self
failureToken ].

  "Another way to handle time-out: cancel the inspection"
  stat afterTimeoutSeconds: 300 terminateAndDo: [ stat abort ].

This seems like a fairly clean and flexible model that would be
relatively easy to implement. Would something like that work for you?

Hope this helps!

--Tom Phoenix

Tom Phoenix wrote:
I believe that you may have hit the nail on the head. I'm still trying
to work out exactly how the hashes do and should work. Many thanks! That
would explain why Smalltalk the SystemDictionary got all confused in my
earlier attempts.

As with the rest of your email; I'll have to read it tomorrow (no time).
You are right in that using ProtoObject is a bit over the top. Also, my
implementation is probably too slow; #become: in Squeak is a slow
operation and I'm using it a bit too much.

Mikevdg.

Hi Tom (and others)

Tom Phoenix wrote:

>> Run "Future doing: [ByteString]" to crash the image.
>
>
> Does it have to be ByteString? That's an important class in the
> system. It seems to be an arbitrary choice, since it only shows up in
> your halt code.

It was arbitrary; it was the only case I tried because it was the one
that I originally found to crash the image.

> As I understand the operation of #becomeForward:, you're
> instantaneously turning your MessageCapture instance into ByteString.
> But the identity hash of your instance should stay the same, in case
> it's in a dictionary, say. That means that the identity hash of
> ByteString changes to become the hash of your object, even though that
> can break any dictionaries that *it* was in.

I consider that a bug in becomeForward:. I've just done some
experimentation:

a := Object new.
b := Object new.
a hash   414
b hash   1169
a becomeForward: b copyHash: true.
a hash  414
b hash  414  "b's hash just got clobbered"

a := Object new.
b := Object new.
a hash  966
b hash  1534
a becomeForward: b copyHash: false.
a hash  1534  "IMO this should be the default."
b hash  1534

a := Object new.
b := Object new.
a hash  2248
b hash  2955
a becomeForward: b.
a hash  2248
b hash  2248  "b's hash just got clobbered"

So it seems by default that #becomeForward: copys the hash by default.

In my opinion, this is very broken. I use becomeForward:, assuming that
every reference to "a" really does become a reference to "b" and that
"b" won't suddenly have any unexpected state changes (ESPECIALLY a
change in hash!).

My code shouldn't break (when it's bug free :-) ) because if "a" gets
included in any dictionaries, a dictionary implementation will send the
#hash message, which will wait on the semaphore in doesNotUnderstand: in
"a" until "a" has becomeForwarded to "b". The #hash message should then
return with the correct hash.

I assume, of course, that becomeForward: will also change any references
in MethodContexts correctly.

> Maybe a subclass of ProtoObject and wizardly uses of #become: isn't
> the technology you need to use. Have I understood correctly what
> you're trying to do? It seems to me that you want an object that is a
> placeholder today and the real value tomorrow.

Yup. It's called a "future" :-). If I remember correctly, its a pattern
used for concurrent applications, although evidently not a simple one to
implement.


> That's probably
> possible without much magic. But you must ensure that a client doesn't
> send messages to the placeholder before it becomes the real value. I
> don't see any good way to do that without asking the client to do
> something active, such as using a Semaphore, or sending the
> placeholder a signal. The trouble I see is that there's no way to tell
> when a message to the placeholder is "really" destined for the real
> value.

I agree that a better and more robust solution would not involve using
ProtoObjects. Infact, an even better solution would be to look at the
bigger picture and try not to use Futures at all.

A semaphore would be better here.

>  stat := Future doing: [ 49 sqrt ].
>  stat inspect. "It's an instance of Future"
>  self doSomething.
>  stat isDone ifFalse: [ self doSomethingMore ].
>  stat result inspect. "gives 7"

This is a better way of doing things.

Potentially; in either case it is certainly a very useful concept. I'm
going to have to refactor my code anyway, so I'll see if I can get rid
of my Futures altogether.

> Hope this helps!

Mentioning the hash stuff certainly did! Many thanks for that.

Mikevdg.