<div dir="ltr"><div>Hi Eliot,</div><div><br></div><div>I happened to notice that in 
StackInterpreter>>methodReturnString: (from your previous commit 
VMMaker.oscog-eem.253), you effectively replaced <br></div><div><br></div><div>
self pop: argumentCount+1 thenPush: (objectMemory stringForCString: aCString). <br></div><div><br></div><div>with</div><div><br></div><div>
self pop: argumentCount+1 thenPush: (self stringForCString: aCString). <br></div><div><br></div><div>I don't know much about that code, but I assume this was a copy and paste error.</div><div><br></div><div>Best,</div><div>Florin<br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Mon, Aug 26, 2019 at 5:47 PM <<a href="mailto:commits@source.squeak.org">commits@source.squeak.org</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"> <br>
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:<br>
<a href="http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2540.mcz" rel="noreferrer" target="_blank">http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2540.mcz</a><br>
<br>
==================== Summary ====================<br>
<br>
Name: VMMaker.oscog-nice.2540<br>
Author: nice<br>
Time: 21 August 2019, 7:57:54.88068 pm<br>
UUID: 4771da98-01f0-5141-b321-59c001f8390e<br>
Ancestors: VMMaker.oscog-nice.2539, VMMaker.oscog-eem.2537<br>
<br>
Partial fix - Part 3 - for bug <a href="https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/417" rel="noreferrer" target="_blank">https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/417</a><br>
<br>
Remove the restriction about (SmallInteger asFloat exactness) from Spur64 loadFloatOrIntFrom:<br>
<br>
Replace it with the solution described in bug report<br>
<br>
if ( (double) si == sf ) return si <= (int64) sf;<br>
else return (double) si <= sf;<br>
<br>
Also merge VMMaker.oscog-eem.2537 because we need to regenerate cointerp.c<br>
<br>
THIS NEEDS TO BE REVIEWED<br>
I get unstable behavior of elementary GUI<br>
(scroll bars, splitters, etc...)<br>
or thing like (ColorValue veryveryLightGray hue) failing randomly...<br>
It depends on a test span = 0.0 where span is SmallInteger 0<br>
<br>
=============== Diff against VMMaker.oscog-nice.2539 ===============<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatEqual (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatEqual<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue:<br>
+                                       ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: rcvr asInteger = intArg]<br>
+                               ifFalse: [self pop: 2 thenPushBool: false]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: rcvr = arg]]!<br>
-               [self pop: 2 thenPushBool: rcvr = arg]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatGreaterOrEqual (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatGreaterOrEqual<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue:<br>
+                                       ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: rcvr asInteger >= intArg]<br>
+                               ifFalse: [self pop: 2 thenPushBool: rcvr >= arg]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: rcvr >= arg]]!<br>
-               [self pop: 2 thenPushBool: rcvr >= arg]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatGreaterThan (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatGreaterThan<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue:<br>
+                                       ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: rcvr asInteger > intArg]<br>
+                               ifFalse: [self pop: 2 thenPushBool: rcvr > arg]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: rcvr > arg]]!<br>
-               [self pop: 2 thenPushBool: rcvr > arg]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatLessOrEqual (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatLessOrEqual<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue:<br>
+                                       ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: rcvr asInteger <= intArg]<br>
+                               ifFalse: [self pop: 2 thenPushBool: rcvr <= arg]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: rcvr <= arg]]!<br>
-               [self pop: 2 thenPushBool: rcvr <= arg]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatLessThan (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatLessThan<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue:<br>
+                                       ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: rcvr asInteger < intArg]<br>
+                               ifFalse: [self pop: 2 thenPushBool: rcvr < arg]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: rcvr < arg]]!<br>
-               [self pop: 2 thenPushBool: rcvr < arg]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatNotEqual (in category 'arithmetic float primitives') -----<br>
  primitiveSmallFloatNotEqual<br>
        <option: #Spur64BitMemoryManager><br>
+       | rcvr arg intArg |<br>
-       | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory smallFloatValueOf: (self stackValue: 1).<br>
        arg := objectMemory loadFloatOrIntFrom: self stackTop.<br>
        self successful ifTrue:<br>
+               [self cppIf: objectMemory wordSize > 4<br>
+                       ifTrue: [((self isIntegerObject: self stackTop) and: [rcvr = arg])<br>
+                               ifTrue: ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                       intArg := self integerValueOf: self stackTop.<br>
+                                       self pop: 2 thenPushBool: (rcvr asInteger = intArg) not]<br>
+                               ifFalse: [self pop: 2 thenPushBool: true]]<br>
+                       ifFalse: [self pop: 2 thenPushBool: (rcvr = arg) not]]!<br>
-               [self pop: 2 thenPushBool: (rcvr = arg) not]!<br>
<br>
Item was changed:<br>
  ----- Method: InterpreterProxy>>methodReturnString: (in category 'stack access') -----<br>
  methodReturnString: aCString<br>
+       "Attempt to answer a ByteString for a given C string as the result of a primitive."<br>
-       "Sets the return value for a method."<br>
-       "THIS IS DUBIOUS!!  CONSIDER REMOVING IT!!  RIGHT NOW IT IS NOT SENT."<br>
        <var: 'aCString' type: #'char *'><br>
+       aCString<br>
+               ifNil: [primFailCode := PrimErrOperationFailed]<br>
+               ifNotNil:<br>
+                       [(self stringForCString: aCString)<br>
+                               ifNil: [primFailCode := PrimErrNoMemory]<br>
+                               ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].<br>
-       (self stringForCString: aCString)<br>
-               ifNil: [primFailCode := PrimErrNoMemory]<br>
-               ifNotNil: [:result| self pop: argumentCount+1 thenPush: result].<br>
        ^0!<br>
<br>
Item was changed:<br>
  ----- Method: Spur64BitMemoryManager>>loadFloatOrIntFrom: (in category 'interpreter access') -----<br>
  loadFloatOrIntFrom: floatOrIntOop<br>
        "If floatOrInt is an integer, then convert it to a C double float and return it.<br>
         If it is a Float, then load its value and return it.<br>
         Otherwise fail -- ie return with primErrorCode non-zero."<br>
<br>
        <inline: true><br>
        <returnTypeC: #double><br>
+       | result tagBits |<br>
-       | result tagBits shift |<br>
        <var: #result type: #double><br>
<br>
        (tagBits := floatOrIntOop bitAnd: self tagMask) ~= 0<br>
                ifTrue:<br>
                        [tagBits = self smallFloatTag ifTrue:<br>
                                [^self smallFloatValueOf: floatOrIntOop].<br>
+                        tagBits = self smallIntegerTag ifTrue:<br>
-                        (tagBits = self smallIntegerTag<br>
-                         and: [shift := 64 - self numTagBits - self smallFloatMantissaBits.<br>
-                               (self cCode: [floatOrIntOop << shift]<br>
-                                               inSmalltalk: [floatOrIntOop << shift bitAnd: 1 << 64 - 1]) >>> shift = floatOrIntOop]) ifTrue:<br>
                                [^(self integerValueOf: floatOrIntOop) asFloat]]<br>
                ifFalse:<br>
                        [(self classIndexOf: floatOrIntOop) = ClassFloatCompactIndex ifTrue:<br>
                                [self cCode: '' inSmalltalk: [result := Float new: 2].<br>
                                 self fetchFloatAt: floatOrIntOop + self baseHeaderSize into: result.<br>
                                 ^result]].<br>
        coInterpreter primitiveFail.<br>
        ^0.0!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>methodReturnString: (in category 'plugin primitive support') -----<br>
  methodReturnString: aCString<br>
+       "Attempt to answer a ByteString for a given C string as the result of a primitive."<br>
-       "Sets the return value for a method."<br>
        <var: 'aCString' type: #'char *'><br>
+       aCString<br>
+               ifNil: [primFailCode := PrimErrOperationFailed]<br>
+               ifNotNil:<br>
+                       [(self stringForCString: aCString)<br>
+                               ifNil: [primFailCode := PrimErrNoMemory]<br>
+                               ifNotNil: [:result| self pop: argumentCount+1 thenPush: result]].<br>
-       self pop: argumentCount+1 thenPush: (objectMemory stringForCString: aCString).<br>
        ^0!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>primitiveFloatEqual:toArg: (in category 'comparison float primitives') -----<br>
  primitiveFloatEqual: rcvrOop toArg: argOop<br>
        | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.<br>
        arg := objectMemory loadFloatOrIntFrom: argOop.<br>
+       self cppIf: objectMemory wordSize > 4<br>
+               ifTrue: [rcvr = arg<br>
+                       ifTrue:<br>
+                               [(self isIntegerObject: argOop)<br>
+                                       ifTrue:<br>
+                                               ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                               ^ rcvr asInteger = (self integerValueOf: argOop)]<br>
+                                       ifFalse: [(self isIntegerObject: rcvrOop)<br>
+                                               ifTrue:<br>
+                                                       ["Same when used from bytecodePrim...<br>
+                                                       note that rcvr and arg cannot be both integer (case is already handled)"<br>
+                                                       ^ (self integerValueOf: rcvrOop) = arg asInteger]]]].<br>
        ^rcvr = arg!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>primitiveFloatGreater:thanArg: (in category 'comparison float primitives') -----<br>
  primitiveFloatGreater: rcvrOop thanArg: argOop<br>
        | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.<br>
        arg := objectMemory loadFloatOrIntFrom: argOop.<br>
+       self cppIf: objectMemory wordSize > 4<br>
+               ifTrue: [rcvr = arg<br>
+                       ifTrue:<br>
+                               [(self isIntegerObject: argOop)<br>
+                                       ifTrue:<br>
+                                               ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                               ^ rcvr asInteger > (self integerValueOf: argOop)]<br>
+                                       ifFalse: [(self isIntegerObject: rcvrOop)<br>
+                                               ifTrue:<br>
+                                                       ["Same when used from bytecodePrim...<br>
+                                                       note that rcvr and arg cannot be both integer (case is already handled)"<br>
+                                                       ^ (self integerValueOf: rcvrOop) > arg asInteger]]]].<br>
        ^rcvr > arg!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>primitiveFloatGreaterOrEqual:toArg: (in category 'comparison float primitives') -----<br>
  primitiveFloatGreaterOrEqual: rcvrOop toArg: argOop<br>
        | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.<br>
        arg := objectMemory loadFloatOrIntFrom: argOop.<br>
+       self cppIf: objectMemory wordSize > 4<br>
+               ifTrue: [rcvr = arg<br>
+                       ifTrue:<br>
+                               [(self isIntegerObject: argOop)<br>
+                                       ifTrue:<br>
+                                               ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                               ^ rcvr asInteger >= (self integerValueOf: argOop)]<br>
+                                       ifFalse: [(self isIntegerObject: rcvrOop)<br>
+                                               ifTrue:<br>
+                                                       ["Same when used from bytecodePrim...<br>
+                                                       note that rcvr and arg cannot be both integer (case is already handled)"<br>
+                                                       ^ (self integerValueOf: rcvrOop) >= arg asInteger]]]].<br>
        ^rcvr >= arg!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>primitiveFloatLess:thanArg: (in category 'comparison float primitives') -----<br>
  primitiveFloatLess: rcvrOop thanArg: argOop<br>
        | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.<br>
        arg := objectMemory loadFloatOrIntFrom: argOop.<br>
+       self cppIf: objectMemory wordSize > 4<br>
+               ifTrue: [rcvr = arg<br>
+                       ifTrue:<br>
+                               [(self isIntegerObject: argOop)<br>
+                                       ifTrue:<br>
+                                               ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                               ^ rcvr asInteger < (self integerValueOf: argOop)]<br>
+                                       ifFalse: [(self isIntegerObject: rcvrOop)<br>
+                                               ifTrue:<br>
+                                                       ["Same when used from bytecodePrim...<br>
+                                                       note that rcvr and arg cannot be both integer (case is already handled)"<br>
+                                                       ^ (self integerValueOf: rcvrOop) < arg asInteger]]]].<br>
        ^rcvr < arg!<br>
<br>
Item was changed:<br>
  ----- Method: StackInterpreter>>primitiveFloatLessOrEqual:toArg: (in category 'comparison float primitives') -----<br>
  primitiveFloatLessOrEqual: rcvrOop toArg: argOop<br>
        | rcvr arg |<br>
        <var: #rcvr type: #double><br>
        <var: #arg type: #double><br>
<br>
        rcvr := objectMemory loadFloatOrIntFrom: rcvrOop.<br>
        arg := objectMemory loadFloatOrIntFrom: argOop.<br>
+       self cppIf: objectMemory wordSize > 4<br>
+               ifTrue: [rcvr = arg<br>
+                       ifTrue:<br>
+                               [(self isIntegerObject: argOop)<br>
+                                       ifTrue:<br>
+                                               ["Resolve case of ambiguity so as to have comparison of exact values"<br>
+                                               ^ rcvr asInteger <= (self integerValueOf: argOop)]<br>
+                                       ifFalse: [(self isIntegerObject: rcvrOop)<br>
+                                               ifTrue:<br>
+                                                       ["Same when used from bytecodePrim...<br>
+                                                       note that rcvr and arg cannot be both integer (case is already handled)"<br>
+                                                       ^ (self integerValueOf: rcvrOop) <= arg asInteger]]]].<br>
        ^rcvr <= arg!<br>
<br>
</blockquote></div>