Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
8 messages Options
Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Eliot Miranda-2


On Thu, Sep 15, 2011 at 9:45 AM, Mariano Martinez Peck <[hidden email]> wrote:
Ok, I understand. But

On Thu, Sep 15, 2011 at 6:05 PM, Henrik Sperre Johansen <[hidden email]> wrote:
On 15.09.2011 17:27, Mariano Martinez Peck wrote:
Hi guys. I am having a problem with the integration of issue 4538: http://code.google.com/p/pharo/issues/detail?id=4538

I am serializing CompiledMethods with Fuel and then I materialize them. To test they are correct, I use #=
So far it was working correctly, but now for the materialized method it says they are not equal. The problem is that #= is failing in

(self sameLiteralsAs: aCompiledMethod)

And inside that method, it is failing because     (literal1 == literal2 or: [ literal1 literalEqual: literal2 ])
answers false.

So... why literal1 literalEqual: literal2 answers false?  from what I can say, having that selector: "literalEqual", then both MUST be equal, because they are.
The problem is that it was added:

Association >> literalEqual: otherLiteral
    "Answer true if the receiver and otherLiteral represent the same literal.
    Variable bindings are literally equals only if identical.
    This is how variable sharing works, by preserving identity and changing only the value."
    ^self == otherLiteral


So....I am not sure I agree with this change.

Any idea how can we deal with this problem?

Cheers

--
Mariano
http://marianopeck.wordpress.com

The change is correct, here's an example:

Create a global:
Global := 1

Create a method:
   foo
    ^Global

Serialize method, deserialize

Change value of global:
Global := 5.

foo should return 5, not 1.
Unless it's actually the same association as in the SystemDictionary, this will not be true.


I understand that. In fact, in Fuel we use exactly the same association of SystemDictionary for globals. Look this test example:

testGlobalVariableMethod

    | materializedCompiledMethod |
    Smalltalk globals at: #TestGlobalVariableMethod2 put: false.
    (self class compileSilently: 'globalVariableForTestingMethod
    Transcript name.
    ^ GlobalVariableForTesting.').

    materializedCompiledMethod := self materializedCompiledMethod: (self class >> #globalVariableForTestingMethod).
    Smalltalk globals at: #GlobalVariableForTesting put: true.
    self assert:  (materializedCompiledMethod valueWithReceiver: self arguments: #()).



BUT, it doesn't mean that Association is always used for globals. CompiledMethod equality is failing because of the last literal, the one that maps class name (symbol) and point to the real class. So...when I materialize, both CMs have non-identical associations for the last literal, but equal.

As Henrik says the last literals are ideally #== to each other.  However, no Squeak dialect makes any attempt to keep the class0side associations equal. Look at a class-side method and you'll see it's last literal is nil->SomeClass class.  Now since this association doesn't exist in Smalltalk (unlike last literals on the instance side) the compiler merely creates distinct ones for each class-side method.

Personally I don't think one can defend the position where method equality is different for instance-side or class-side methods so there must be some solutions:

1. special case comparison of the last literal (the methodClass literal), comparing keys and insisting that the keys be #== and the values be #== (can't just define it as keys #== since all similar class-side methods will be equal irrespective of their actual class).

2. special case comparison of the last literal (the methodClass literal), insisting only that the class of the literal be the same if it isVariableBinding.

3. make the compile unique class-side methodClass literals.  i.e. if a class already has a class-side method then the compiler or method dictionary insertion code must find that existing association and reuse it

Other ideas?
 
>From my point of view, that literal, the last one does not need to be identical to assume 2 CMs are equal. They just need to be equal.



--
best,
Eliot



Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Nicolas Cellier
2011/9/15 Eliot Miranda <[hidden email]>:

>
>
> On Thu, Sep 15, 2011 at 9:45 AM, Mariano Martinez Peck
> <[hidden email]> wrote:
>>
>> Ok, I understand. But
>>
>> On Thu, Sep 15, 2011 at 6:05 PM, Henrik Sperre Johansen
>> <[hidden email]> wrote:
>>>
>>> On 15.09.2011 17:27, Mariano Martinez Peck wrote:
>>>
>>> Hi guys. I am having a problem with the integration of issue 4538:
>>> http://code.google.com/p/pharo/issues/detail?id=4538
>>>
>>> I am serializing CompiledMethods with Fuel and then I materialize them.
>>> To test they are correct, I use #=
>>> So far it was working correctly, but now for the materialized method it
>>> says they are not equal. The problem is that #= is failing in
>>>
>>> (self sameLiteralsAs: aCompiledMethod)
>>>
>>> And inside that method, it is failing because     (literal1 == literal2
>>> or: [ literal1 literalEqual: literal2 ])
>>> answers false.
>>>
>>> So... why literal1 literalEqual: literal2 answers false?  from what I can
>>> say, having that selector: "literalEqual", then both MUST be equal, because
>>> they are.
>>> The problem is that it was added:
>>>
>>> Association >> literalEqual: otherLiteral
>>>     "Answer true if the receiver and otherLiteral represent the same
>>> literal.
>>>     Variable bindings are literally equals only if identical.
>>>     This is how variable sharing works, by preserving identity and
>>> changing only the value."
>>>     ^self == otherLiteral
>>>
>>>
>>> So....I am not sure I agree with this change.
>>>
>>> Any idea how can we deal with this problem?
>>>
>>> Cheers
>>>
>>> --
>>> Mariano
>>> http://marianopeck.wordpress.com
>>>
>>> The change is correct, here's an example:
>>>
>>> Create a global:
>>> Global := 1
>>>
>>> Create a method:
>>>    foo
>>>     ^Global
>>>
>>> Serialize method, deserialize
>>>
>>> Change value of global:
>>> Global := 5.
>>>
>>> foo should return 5, not 1.
>>> Unless it's actually the same association as in the SystemDictionary,
>>> this will not be true.
>>>
>>
>> I understand that. In fact, in Fuel we use exactly the same association of
>> SystemDictionary for globals. Look this test example:
>>
>> testGlobalVariableMethod
>>
>>     | materializedCompiledMethod |
>>     Smalltalk globals at: #TestGlobalVariableMethod2 put: false.
>>     (self class compileSilently: 'globalVariableForTestingMethod
>>     Transcript name.
>>     ^ GlobalVariableForTesting.').
>>
>>     materializedCompiledMethod := self materializedCompiledMethod: (self
>> class >> #globalVariableForTestingMethod).
>>     Smalltalk globals at: #GlobalVariableForTesting put: true.
>>     self assert:  (materializedCompiledMethod valueWithReceiver: self
>> arguments: #()).
>>
>>
>>
>> BUT, it doesn't mean that Association is always used for globals.
>> CompiledMethod equality is failing because of the last literal, the one that
>> maps class name (symbol) and point to the real class. So...when I
>> materialize, both CMs have non-identical associations for the last literal,
>> but equal.
>
> As Henrik says the last literals are ideally #== to each other.  However, no
> Squeak dialect makes any attempt to keep the class0side associations equal.
> Look at a class-side method and you'll see it's last literal is
> nil->SomeClass class.  Now since this association doesn't exist in Smalltalk
> (unlike last literals on the instance side) the compiler merely creates
> distinct ones for each class-side method.
> Personally I don't think one can defend the position where method equality
> is different for instance-side or class-side methods so there must be some
> solutions:

Hmm, good catch.
A metaclass is never accessed by dictionary lookup, but only by
sending #class to a class, so there is no point in maintaining a
unique Association.
(otherwise, we could maintain such Association in inst. var. thisClass).
Having a nil key is a clear indication that lookup is pointless.

The question is why having an association at all in the CompiledMethod ?
For handling super sends ?
I think a simple reference to the class would be enough.
IMHO, the purpose was to simplify implementation.

And I don't think the example of Henrik is worth :
Lets just change it a bit:

Object subclass: #SuperFoo.!
Object subclass: #Bar.!
SuperFoo subclass: #Foo.!

SuperFoo compile: 'bar ^1'.
Foo compile: 'bar
   ^super bar *2'.
foo := Foo new.
Smalltalk at: #Foo put: Bar.
^foo bar

Could you predict the result (will it try to invoke super Bar bar) ?
Yes, since the last association is shared, we just broke (foo
class>>bar) for no reason...

Nicolas

> 1. special case comparison of the last literal (the methodClass literal),
> comparing keys and insisting that the keys be #== and the values be #==
> (can't just define it as keys #== since all similar class-side methods will
> be equal irrespective of their actual class).
> 2. special case comparison of the last literal (the methodClass literal),
> insisting only that the class of the literal be the same if it
> isVariableBinding.
> 3. make the compile unique class-side methodClass literals.  i.e. if a class
> already has a class-side method then the compiler or method dictionary
> insertion code must find that existing association and reuse it
> Other ideas?
>
>>
>> >From my point of view, that literal, the last one does not need to be
>> identical to assume 2 CMs are equal. They just need to be equal.
>>
>>
>> --
>> Mariano
>> http://marianopeck.wordpress.com
>>
>
>
>
> --
> best,
> Eliot
>
>
>
>

Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Eliot Miranda-2


On Thu, Sep 15, 2011 at 1:00 PM, Nicolas Cellier <[hidden email]> wrote:
2011/9/15 Eliot Miranda <[hidden email]>:
>
>
> On Thu, Sep 15, 2011 at 9:45 AM, Mariano Martinez Peck
> <[hidden email]> wrote:
>>
>> Ok, I understand. But
>>
>> On Thu, Sep 15, 2011 at 6:05 PM, Henrik Sperre Johansen
>> <[hidden email]> wrote:
>>>
>>> On 15.09.2011 17:27, Mariano Martinez Peck wrote:
>>>
>>> Hi guys. I am having a problem with the integration of issue 4538:
>>> http://code.google.com/p/pharo/issues/detail?id=4538
>>>
>>> I am serializing CompiledMethods with Fuel and then I materialize them.
>>> To test they are correct, I use #=
>>> So far it was working correctly, but now for the materialized method it
>>> says they are not equal. The problem is that #= is failing in
>>>
>>> (self sameLiteralsAs: aCompiledMethod)
>>>
>>> And inside that method, it is failing because     (literal1 == literal2
>>> or: [ literal1 literalEqual: literal2 ])
>>> answers false.
>>>
>>> So... why literal1 literalEqual: literal2 answers false?  from what I can
>>> say, having that selector: "literalEqual", then both MUST be equal, because
>>> they are.
>>> The problem is that it was added:
>>>
>>> Association >> literalEqual: otherLiteral
>>>     "Answer true if the receiver and otherLiteral represent the same
>>> literal.
>>>     Variable bindings are literally equals only if identical.
>>>     This is how variable sharing works, by preserving identity and
>>> changing only the value."
>>>     ^self == otherLiteral
>>>
>>>
>>> So....I am not sure I agree with this change.
>>>
>>> Any idea how can we deal with this problem?
>>>
>>> Cheers
>>>
>>> --
>>> Mariano
>>> http://marianopeck.wordpress.com
>>>
>>> The change is correct, here's an example:
>>>
>>> Create a global:
>>> Global := 1
>>>
>>> Create a method:
>>>    foo
>>>     ^Global
>>>
>>> Serialize method, deserialize
>>>
>>> Change value of global:
>>> Global := 5.
>>>
>>> foo should return 5, not 1.
>>> Unless it's actually the same association as in the SystemDictionary,
>>> this will not be true.
>>>
>>
>> I understand that. In fact, in Fuel we use exactly the same association of
>> SystemDictionary for globals. Look this test example:
>>
>> testGlobalVariableMethod
>>
>>     | materializedCompiledMethod |
>>     Smalltalk globals at: #TestGlobalVariableMethod2 put: false.
>>     (self class compileSilently: 'globalVariableForTestingMethod
>>     Transcript name.
>>     ^ GlobalVariableForTesting.').
>>
>>     materializedCompiledMethod := self materializedCompiledMethod: (self
>> class >> #globalVariableForTestingMethod).
>>     Smalltalk globals at: #GlobalVariableForTesting put: true.
>>     self assert:  (materializedCompiledMethod valueWithReceiver: self
>> arguments: #()).
>>
>>
>>
>> BUT, it doesn't mean that Association is always used for globals.
>> CompiledMethod equality is failing because of the last literal, the one that
>> maps class name (symbol) and point to the real class. So...when I
>> materialize, both CMs have non-identical associations for the last literal,
>> but equal.
>
> As Henrik says the last literals are ideally #== to each other.  However, no
> Squeak dialect makes any attempt to keep the class0side associations equal.
> Look at a class-side method and you'll see it's last literal is
> nil->SomeClass class.  Now since this association doesn't exist in Smalltalk
> (unlike last literals on the instance side) the compiler merely creates
> distinct ones for each class-side method.
> Personally I don't think one can defend the position where method equality
> is different for instance-side or class-side methods so there must be some
> solutions:

Hmm, good catch.
A metaclass is never accessed by dictionary lookup, but only by
sending #class to a class, so there is no point in maintaining a
unique Association.
(otherwise, we could maintain such Association in inst. var. thisClass).
Having a nil key is a clear indication that lookup is pointless.

The question is why having an association at all in the CompiledMethod ?
For handling super sends ?

Yes, but two reasons.  One is super sends and the other is being able to answer the methodClass (e.g. for CompiledMethod>>printOn: and for the debugger).  One doesn't need to use an association, but one can't change that without changing al the VMs /and/ changing the ClassBuilder so that when it becomes a class on class redefinition the methodsa are updated.  Indeed VisualWorks does exactly this.

In any case, the super send implementation in the VM means we can't change this overnight :)

 
I think a simple reference to the class would be enough.
IMHO, the purpose was to simplify implementation.

And I don't think the example of Henrik is worth :
Lets just change it a bit:

Object subclass: #SuperFoo.!
Object subclass: #Bar.!
SuperFoo subclass: #Foo.!

SuperFoo compile: 'bar ^1'.
Foo compile: 'bar
  ^super bar *2'.
foo := Foo new.
Smalltalk at: #Foo put: Bar.
^foo bar

Could you predict the result (will it try to invoke super Bar bar) ?
Yes, since the last association is shared, we just broke (foo
class>>bar) for no reason...

Right.  But Rube Goldberg machines work like Rube Goldberg machines.  Tis the nature of the beast.  Doctors say "don't do that", and in Smalltalk we should say "what did you expect"? :)  Being able to change the system is worth the cost of it behaving contrary to common-sense.  Just like the physical world :)


Nicolas

> 1. special case comparison of the last literal (the methodClass literal),
> comparing keys and insisting that the keys be #== and the values be #==
> (can't just define it as keys #== since all similar class-side methods will
> be equal irrespective of their actual class).
> 2. special case comparison of the last literal (the methodClass literal),
> insisting only that the class of the literal be the same if it
> isVariableBinding.
> 3. make the compile unique class-side methodClass literals.  i.e. if a class
> already has a class-side method then the compiler or method dictionary
> insertion code must find that existing association and reuse it
> Other ideas?
>
>>
>> >From my point of view, that literal, the last one does not need to be
>> identical to assume 2 CMs are equal. They just need to be equal.
>>
>>
>> --
>> Mariano
>> http://marianopeck.wordpress.com
>>
>
>
>
> --
> best,
> Eliot
>
>
>
>




--
best,
Eliot



Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Nicolas Cellier
In reply to this post by Nicolas Cellier
2011/9/15 Nicolas Cellier <[hidden email]>:

> 2011/9/15 Eliot Miranda <[hidden email]>:
>>
>>
>> On Thu, Sep 15, 2011 at 9:45 AM, Mariano Martinez Peck
>> <[hidden email]> wrote:
>>>
>>> Ok, I understand. But
>>>
>>> On Thu, Sep 15, 2011 at 6:05 PM, Henrik Sperre Johansen
>>> <[hidden email]> wrote:
>>>>
>>>> On 15.09.2011 17:27, Mariano Martinez Peck wrote:
>>>>
>>>> Hi guys. I am having a problem with the integration of issue 4538:
>>>> http://code.google.com/p/pharo/issues/detail?id=4538
>>>>
>>>> I am serializing CompiledMethods with Fuel and then I materialize them.
>>>> To test they are correct, I use #=
>>>> So far it was working correctly, but now for the materialized method it
>>>> says they are not equal. The problem is that #= is failing in
>>>>
>>>> (self sameLiteralsAs: aCompiledMethod)
>>>>
>>>> And inside that method, it is failing because     (literal1 == literal2
>>>> or: [ literal1 literalEqual: literal2 ])
>>>> answers false.
>>>>
>>>> So... why literal1 literalEqual: literal2 answers false?  from what I can
>>>> say, having that selector: "literalEqual", then both MUST be equal, because
>>>> they are.
>>>> The problem is that it was added:
>>>>
>>>> Association >> literalEqual: otherLiteral
>>>>     "Answer true if the receiver and otherLiteral represent the same
>>>> literal.
>>>>     Variable bindings are literally equals only if identical.
>>>>     This is how variable sharing works, by preserving identity and
>>>> changing only the value."
>>>>     ^self == otherLiteral
>>>>
>>>>
>>>> So....I am not sure I agree with this change.
>>>>
>>>> Any idea how can we deal with this problem?
>>>>
>>>> Cheers
>>>>
>>>> --
>>>> Mariano
>>>> http://marianopeck.wordpress.com
>>>>
>>>> The change is correct, here's an example:
>>>>
>>>> Create a global:
>>>> Global := 1
>>>>
>>>> Create a method:
>>>>    foo
>>>>     ^Global
>>>>
>>>> Serialize method, deserialize
>>>>
>>>> Change value of global:
>>>> Global := 5.
>>>>
>>>> foo should return 5, not 1.
>>>> Unless it's actually the same association as in the SystemDictionary,
>>>> this will not be true.
>>>>
>>>
>>> I understand that. In fact, in Fuel we use exactly the same association of
>>> SystemDictionary for globals. Look this test example:
>>>
>>> testGlobalVariableMethod
>>>
>>>     | materializedCompiledMethod |
>>>     Smalltalk globals at: #TestGlobalVariableMethod2 put: false.
>>>     (self class compileSilently: 'globalVariableForTestingMethod
>>>     Transcript name.
>>>     ^ GlobalVariableForTesting.').
>>>
>>>     materializedCompiledMethod := self materializedCompiledMethod: (self
>>> class >> #globalVariableForTestingMethod).
>>>     Smalltalk globals at: #GlobalVariableForTesting put: true.
>>>     self assert:  (materializedCompiledMethod valueWithReceiver: self
>>> arguments: #()).
>>>
>>>
>>>
>>> BUT, it doesn't mean that Association is always used for globals.
>>> CompiledMethod equality is failing because of the last literal, the one that
>>> maps class name (symbol) and point to the real class. So...when I
>>> materialize, both CMs have non-identical associations for the last literal,
>>> but equal.
>>
>> As Henrik says the last literals are ideally #== to each other.  However, no
>> Squeak dialect makes any attempt to keep the class0side associations equal.
>> Look at a class-side method and you'll see it's last literal is
>> nil->SomeClass class.  Now since this association doesn't exist in Smalltalk
>> (unlike last literals on the instance side) the compiler merely creates
>> distinct ones for each class-side method.
>> Personally I don't think one can defend the position where method equality
>> is different for instance-side or class-side methods so there must be some
>> solutions:
>
> Hmm, good catch.
> A metaclass is never accessed by dictionary lookup, but only by
> sending #class to a class, so there is no point in maintaining a
> unique Association.
> (otherwise, we could maintain such Association in inst. var. thisClass).
> Having a nil key is a clear indication that lookup is pointless.
>
> The question is why having an association at all in the CompiledMethod ?
> For handling super sends ?
> I think a simple reference to the class would be enough.
> IMHO, the purpose was to simplify implementation.
>
> And I don't think the example of Henrik is worth :
> Lets just change it a bit:
>
> Object subclass: #SuperFoo.!
> Object subclass: #Bar.!
> SuperFoo subclass: #Foo.!
>
> SuperFoo compile: 'bar ^1'.
> Foo compile: 'bar
>   ^super bar *2'.
> foo := Foo new.
> Smalltalk at: #Foo put: Bar.
> ^foo bar
>
> Could you predict the result (will it try to invoke super Bar bar) ?
> Yes, since the last association is shared, we just broke (foo
> class>>bar) for no reason...
>
> Nicolas
>

And thanks, I just discovered this new super power of invoking the
exact super method I want (eventually not even in my hierarchy) by
just temporarily changing a value in a dictionary.
But Eliot is right, it's too bad the super power does not work on class side ;)
Let's exploit the weakness

Object subclass: #SuperScrewer instanceVariableNames: 'sucker'.
SuperScrewer subclass: #Screwer.
Object subclass: #SuperGump.
SuperGump subclass: #Gump.
SuperScrewer compile: 'screwMyImage ^sucker := #gump'.
SuperGump compile: 'screwMyImage ^#huh'.
Gump compile: 'screwMyImage ^super screwMyImage'.
goofy := Gump new.
Smalltalk at: #Gump put: Screwer.
^goofy screwMyImage

Beware, if the image survive, don't save it, it might be really screwed

>> 1. special case comparison of the last literal (the methodClass literal),
>> comparing keys and insisting that the keys be #== and the values be #==
>> (can't just define it as keys #== since all similar class-side methods will
>> be equal irrespective of their actual class).
>> 2. special case comparison of the last literal (the methodClass literal),
>> insisting only that the class of the literal be the same if it
>> isVariableBinding.
>> 3. make the compile unique class-side methodClass literals.  i.e. if a class
>> already has a class-side method then the compiler or method dictionary
>> insertion code must find that existing association and reuse it
>> Other ideas?
>>
>>>
>>> >From my point of view, that literal, the last one does not need to be
>>> identical to assume 2 CMs are equal. They just need to be equal.
>>>
>>>
>>> --
>>> Mariano
>>> http://marianopeck.wordpress.com
>>>
>>
>>
>>
>> --
>> best,
>> Eliot
>>
>>
>>
>>
>

Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Mariano Martinez Peck
In reply to this post by Eliot Miranda-2



BUT, it doesn't mean that Association is always used for globals. CompiledMethod equality is failing because of the last literal, the one that maps class name (symbol) and point to the real class. So...when I materialize, both CMs have non-identical associations for the last literal, but equal.

As Henrik says the last literals are ideally #== to each other.  However, no Squeak dialect makes any attempt to keep the class0side associations equal. Look at a class-side method and you'll see it's last literal is nil->SomeClass class.  Now since this association doesn't exist in Smalltalk (unlike last literals on the instance side) the compiler merely creates distinct ones for each class-side method.


Thanks Eliot for that point. In fact, I have just checked and you are right. The tests that are failing for me is those where class side methods are involded. In this case, the last literal of the original CM and the materialized, gives false in #literalEqual:   hence,  originalCM = materializedCM is false :(

 

Personally I don't think one can defend the position where method equality is different for instance-side or class-side methods so there must be some solutions:

1. special case comparison of the last literal (the methodClass literal), comparing keys and insisting that the keys be #== and the values be #== (can't just define it as keys #== since all similar class-side methods will be equal irrespective of their actual class).


This one seems the easier and fixes my problem :)

sameLiteralsAs: method
    "Compare my literals to those of method. This is needed to compare compiled methods."

    | numLits literal1 literal2 |
    (numLits := self numLiterals) ~= method numLiterals
        ifTrue: [ ^ false ].
    "The last literal requires special checking instead of using #literalEqual:"
    1 to: numLits - 1 do: [ :index |
        literal1 := self literalAt: index.
        literal2 := method literalAt: index.
        (literal1 == literal2 or: [ literal1 literalEqual: literal2 ])
            ifFalse: [
                (index = 1 and: [ #(117 120) includes: self primitive ])
                    ifTrue: [
                        literal1 isArray
                            ifTrue: [
                                (literal2 isArray and: [ literal1 allButLast = literal2 allButLast ])
                                    ifFalse: [ self halt. ^ false ] ]
                            ifFalse: [
                                "ExternalLibraryFunction"
                                (literal1 analogousCodeTo: literal2)
                                    ifFalse: [ self halt. ^ false ] ] ]
                    ifFalse: [
                        index = (numLits - 1)
                            ifTrue: [
                                "properties"
                                (self properties analogousCodeTo: method properties)
                                    ifFalse: [ self halt. ^ false ] ]
                            ifFalse: [ self halt. ^ false ] ] ] ].
    literal1 := self literalAt: numLits.
    literal2 := method literalAt: numLits.
    ^ ((literal1 key == literal2 key) and: [literal1 value == literal2 value]).


 
2. special case comparison of the last literal (the methodClass literal), insisting only that the class of the literal be the same if it isVariableBinding.

3. make the compile unique class-side methodClass literals.  i.e. if a class already has a class-side method then the compiler or method dictionary insertion code must find that existing association and reuse it

Other ideas?
 
>From my point of view, that literal, the last one does not need to be identical to assume 2 CMs are equal. They just need to be equal.



--
best,
Eliot







--
Mariano
http://marianopeck.wordpress.com



Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] [squeak-dev] Re: Issue 4538 and CompiledMethod equality

Eliot Miranda-2


On Fri, Sep 16, 2011 at 12:08 PM, Nicolas Cellier <[hidden email]> wrote:
2011/9/16 Nicolas Cellier <[hidden email]>:
> 2011/9/16 Mariano Martinez Peck <[hidden email]>:
>> I don't really know. I have implemented what Eliot say in the first option
>> and it is working for me.
>> Do you (Henry/Lukas/Nicolas/Eliot) agree to have this first solution and
>> then improve it if necessary ?
>>
>> thanks
>>
>
> I agree on Mariano/Eliot solution. It is a good pragmatic short term workaround.
> In the long term, I wish I can say goodbye to my new super power, it's
> a too dangerous power.
> So I wish the VM would change (along with ClassBuilder and Tools).

Yes, I agree.  It just takes time to get there.
 
>
> Nicolas
>

Or maybe after reading:

   literal1 := self literalAt: numLits.
   literal2 := method literalAt: numLits.
   ^ (literal1 == literal2) or: [literal1 key isNil == literal2 key
isNil and: [literal1 value == literal2 value]].

I we are sure that the last literal is always an Association

If it's not then one is playing fast and loose with the system.  But if the method doesn't contain a super send then as far as the VM is concerned it doesn't need an association, and that might be the case with, for example, shared inst var accessors in Newspeak.  So instead of assuming its an association write it something like

    ^literal1 class == literal2 class
     and: [literal1 isVariableBinding
                ifTrue: [literal1 key = literal2 key and: [literal1 value = literal2 value]]
                ifFalse: [literal1 = literal2]]


Nicolas

>> On Fri, Sep 16, 2011 at 8:12 PM, Stéphane Ducasse
>> <[hidden email]> wrote:
>>>
>>> Mariano
>>>
>>> So should we intgerate a fix?
>>>
>>> Stef
>>>
>>> On Sep 15, 2011, at 11:27 PM, Mariano Martinez Peck wrote:
>>>
>>> >
>>> >
>>> >
>>> > BUT, it doesn't mean that Association is always used for globals.
>>> > CompiledMethod equality is failing because of the last literal, the one that
>>> > maps class name (symbol) and point to the real class. So...when I
>>> > materialize, both CMs have non-identical associations for the last literal,
>>> > but equal.
>>> >
>>> > As Henrik says the last literals are ideally #== to each other.
>>> >  However, no Squeak dialect makes any attempt to keep the class0side
>>> > associations equal. Look at a class-side method and you'll see it's last
>>> > literal is nil->SomeClass class.  Now since this association doesn't exist
>>> > in Smalltalk (unlike last literals on the instance side) the compiler merely
>>> > creates distinct ones for each class-side method.
>>> >
>>> >
>>> > Thanks Eliot for that point. In fact, I have just checked and you are
>>> > right. The tests that are failing for me is those where class side methods
>>> > are involded. In this case, the last literal of the original CM and the
>>> > materialized, gives false in #literalEqual:   hence,  originalCM =
>>> > materializedCM is false :(
>>> >
>>> >
>>> >
>>> > Personally I don't think one can defend the position where method
>>> > equality is different for instance-side or class-side methods so there must
>>> > be some solutions:
>>> >
>>> > 1. special case comparison of the last literal (the methodClass
>>> > literal), comparing keys and insisting that the keys be #== and the values
>>> > be #== (can't just define it as keys #== since all similar class-side
>>> > methods will be equal irrespective of their actual class).
>>> >
>>> >
>>> > This one seems the easier and fixes my problem :)
>>> >
>>> > sameLiteralsAs: method
>>> >     "Compare my literals to those of method. This is needed to compare
>>> > compiled methods."
>>> >
>>> >     | numLits literal1 literal2 |
>>> >     (numLits := self numLiterals) ~= method numLiterals
>>> >         ifTrue: [ ^ false ].
>>> >     "The last literal requires special checking instead of using
>>> > #literalEqual:"
>>> >     1 to: numLits - 1 do: [ :index |
>>> >         literal1 := self literalAt: index.
>>> >         literal2 := method literalAt: index.
>>> >         (literal1 == literal2 or: [ literal1 literalEqual: literal2 ])
>>> >             ifFalse: [
>>> >                 (index = 1 and: [ #(117 120) includes: self primitive ])
>>> >                     ifTrue: [
>>> >                         literal1 isArray
>>> >                             ifTrue: [
>>> >                                 (literal2 isArray and: [ literal1
>>> > allButLast = literal2 allButLast ])
>>> >                                     ifFalse: [ self halt. ^ false ] ]
>>> >                             ifFalse: [
>>> >                                 "ExternalLibraryFunction"
>>> >                                 (literal1 analogousCodeTo: literal2)
>>> >                                     ifFalse: [ self halt. ^ false ] ] ]
>>> >                     ifFalse: [
>>> >                         index = (numLits - 1)
>>> >                             ifTrue: [
>>> >                                 "properties"
>>> >                                 (self properties analogousCodeTo: method
>>> > properties)
>>> >                                     ifFalse: [ self halt. ^ false ] ]
>>> >                             ifFalse: [ self halt. ^ false ] ] ] ].
>>> >     literal1 := self literalAt: numLits.
>>> >     literal2 := method literalAt: numLits.
>>> >     ^ ((literal1 key == literal2 key) and: [literal1 value == literal2
>>> > value]).
>>> >
>>> >
>>> >
>>> > 2. special case comparison of the last literal (the methodClass
>>> > literal), insisting only that the class of the literal be the same if it
>>> > isVariableBinding.
>>> >
>>> > 3. make the compile unique class-side methodClass literals.  i.e. if a
>>> > class already has a class-side method then the compiler or method dictionary
>>> > insertion code must find that existing association and reuse it
>>> >
>>> > Other ideas?
>>> >
>>> > >From my point of view, that literal, the last one does not need to be
>>> > identical to assume 2 CMs are equal. They just need to be equal.
>>> >
>>> >
>>> > --
>>> > Mariano
>>> > http://marianopeck.wordpress.com
>>> >
>>> >
>>> >
>>> >
>>> > --
>>> > best,
>>> > Eliot
>>> >
>>> >
>>> >
>>> >
>>> >
>>> >
>>> >
>>> > --
>>> > Mariano
>>> > http://marianopeck.wordpress.com
>>> >
>>>
>>>
>>
>>
>>
>> --
>> Mariano
>> http://marianopeck.wordpress.com
>>
>>
>




--
best,
Eliot



Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Henrik Sperre Johansen
In reply to this post by Nicolas Cellier
Nicolas Cellier wrote
And I don't think the example of Henrik is worth :
Lets just change it a bit:

Object subclass: #SuperFoo.!
Object subclass: #Bar.!
SuperFoo subclass: #Foo.!

SuperFoo compile: 'bar ^1'.
Foo compile: 'bar
   ^super bar *2'.
foo := Foo new.
Smalltalk at: #Foo put: Bar.
^foo bar

Could you predict the result (will it try to invoke super Bar bar) ?
Yes, since the last association is shared, we just broke (foo
class>>bar) for no reason...

Nicolas
Didn't see this untill now...
I have to disagree with "for no reason", we broke it for a very particular reason; the user specifically replaced Foo with Bar.

TBH, I'd rather the system do what I tell it to do, rather than not because it is too important for the system to allow me to jeopardize it. My buddy Dave agrees.
Reply | Threaded
Open this post in threaded view
|

Re: [Pharo-project] Issue 4538 and CompiledMethod equality

Nicolas Cellier
2011/9/19 Henrik Sperre Johansen <[hidden email]>:

>
> Nicolas Cellier wrote:
>>
>> And I don't think the example of Henrik is worth :
>> Lets just change it a bit:
>>
>> Object subclass: #SuperFoo.!
>> Object subclass: #Bar.!
>> SuperFoo subclass: #Foo.!
>>
>> SuperFoo compile: 'bar ^1'.
>> Foo compile: 'bar
>>    ^super bar *2'.
>> foo := Foo new.
>> Smalltalk at: #Foo put: Bar.
>> ^foo bar
>>
>> Could you predict the result (will it try to invoke super Bar bar) ?
>> Yes, since the last association is shared, we just broke (foo
>> class>>bar) *for no reason*...
>>
>> Nicolas
>>
> Didn't see this untill now...
> I have to disagree with "for no reason", we broke it for a very /particular/
> reason; the user specifically replaced Foo with Bar.
>
> TBH, I'd rather the system do what I tell it to do, rather than not because
> it is too important for the system to allow me to jeopardize it. My buddy
> Dave agrees.
>

But if you replace Foo with Bar without mutating Foo allInstances,
then you're asking for trouble.
See my second example with Gump.

To me, changing an entry in a SystemDictionary shouldn't modify
existing class Foo, its instances, and their behavior.

Nicolas

> --
> View this message in context: http://forum.world.st/Re-Pharo-project-Issue-4538-and-CompiledMethod-equality-tp3816284p3823249.html
> Sent from the Squeak - Dev mailing list archive at Nabble.com.
>
>