[Vm-dev] Interpreter>>signed32BitValueOf: and signed64BitValueOf:
broken
Andreas Raab
andreas.raab at gmx.de
Fri Mar 21 06:52:31 UTC 2008
And of course, positive64BitIntegerFor: was broken, too (creating
non-normalized large integers). Sigh. Here is a full set of the fixed
versions.
Cheers,
- Andreas
Andreas Raab wrote:
>
>
>
> ------------------------------------------------------------------------
>
> Try the attached versions. They should be good - I tested with quite a
> range of inputs and outputs.
>
> Cheers,
> - Andreas
>
> John M McIntosh wrote:
>>
>> I've smacked into this in doing the gstreamer stuff last weekend.
>> Thankfully an sunit test case promptly failed for 64bit work
>> I didn't see an issue with 32bit signed, but likely didn't test.
>>
>> Attached below is a note I sent to Tim and my workaround, but he's
>> doing some personal business in the UK and I doubt he will address
>> anytime soon.
>> I put together a workaround, but if you can supply the entire
>> smalltalk method that would be helpful.
>>
>>
>> On Mar 19, 2008, at 8:44 PM, Andreas Raab wrote:
>>
>>> Hi -
>>>
>>> I just noticed hat Interpreter>>signed32BitValueOf: and
>>> signed64BitValueOf: are broken for edge cases. The following example
>>> will illustrate the problem:
>>>
>>> array := IntegerArray new: 1.
>>> array at: 1 put: 16rFFFFFFFF. "should fail but doesn't"
>>> array at: 1. "answers -1 incorrectly"
>>>
>>> array := IntegerArray new: 1.
>>> array at: 1 put: -16rFFFFFFFF. "should fail but doesn't"
>>> array at: 1. "answers 1 incorrectly"
>>>
>>> The problem is that both signed32BitValueOf: as well as
>>> signed64BitValueOf: do not test whether the high bit of the magnitude
>>> is set (which it mustn't to fit into a signed integer). The fix is
>>> trivial in both cases - basically all that's needed at the end of
>>> both functions is this:
>>>
>>> "Filter out values out of range for the signed interpretation such as
>>> 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
>>> 32 set). Since the sign is implicit in the class we require that the
>>> high bit of the magnitude is not set which is a simple test here"
>>> value < 0 ifTrue:[^self primitiveFail].
>>> negative
>>> ifTrue:[^0 - value]
>>> ifFalse:[^value]
>>>
>>> Cheers,
>>> - Andreas
>>
>>
>>
>>
>>
>>> Did we fix this? I'm sure I've smacked into this in doing the
>>> gstreamer stuff
>>>
>>> I have this below
>>> if you give it
>>> 0x00000000 FFFFFFFF
>>>
>>> the check = value >> 32;
>>> if (check == 0) {
>>> return signed32BitIntegerFor(integerValue);
>>> }
>>>
>>> returns zero because the 0xFFFFFFFF >> 32 is zero
>>> and then we're off to signed32BitIntegerFor
>>> however that is wrong.
>>>
>>>
>>> /* Return a Large Integer object for the given integer value */
>>>
>>> sqInt signed64BitIntegerFor(sqLong integerValue) {
>>> register struct foo * foo = &fum;
>>> sqLong value;
>>> sqInt newLargeInteger;
>>> sqInt largeClass;
>>> sqInt check;
>>> sqInt intValue;
>>> sqInt i;
>>>
>>> if (integerValue < 0) {
>>> largeClass = longAt((foo->specialObjectsOop + BaseHeaderSize)
>>> + (ClassLargeNegativeInteger << ShiftForWord));
>>> value = 0 - integerValue;
>>> } else {
>>> largeClass = longAt((foo->specialObjectsOop + BaseHeaderSize)
>>> + (ClassLargePositiveInteger << ShiftForWord));
>>> value = integerValue;
>>> }
>>> if ((sizeof(value)) == 4) {
>>> return signed32BitIntegerFor(integerValue);
>>> }
>>> check = value >> 32;
>>> if (check == 0) {
>>> return signed32BitIntegerFor(integerValue);
>>> }
>>> newLargeInteger = instantiateSmallClasssizeInBytes(largeClass,
>>> BaseHeaderSize + 8);
>>> for (i = 0; i <= 7; i += 1) {
>>> intValue = ( value >> (i * 8)) & 255;
>>> byteAtput((newLargeInteger + BaseHeaderSize) + i, intValue);
>>> }
>>> return newLargeInteger;
>>> }
>>>
>>>
>>>
>>>
>>> Begin forwarded message:
>>>
>>>> From: tim Rowledge <tim at rowledge.org>
>>>> Date: June 7, 2006 10:02:40 PM PDT (CA)
>>>> To: squeak vm <vm-dev at discuss.squeakfoundation.org>
>>>> Subject: Re: InterpreterProxy>>signed64BitIntegerFor: badly broken
>>>>
>>>>
>>>> On 7-Jun-06, at 6:58 PM, Andreas Raab wrote:
>>>>
>>>>> Hi Guys -
>>>>>
>>>>> I don't know if you ever used the above method but it's horribly,
>>>>> horribly broken. I wrote a little test primitive (see below) that
>>>>> simply used signed64BitIntegerFor(signed64BitValueOf(oop)) and then
>>>>> a loop like here:
>>>>>
>>>>> 0 to: 63 do:[:i|
>>>>> n := 1 bitShift: i.
>>>>> (self test64BitInt: n) = n ifFalse:[self halt: i].
>>>>> ].
>>>>>
>>>>> Starting from i = 31 Every. Last. Result. Is Wrong. Can you imagine?
>>>>>
>>>>> It gets even better, since it's broken in different ways: For i=31
>>>>> the result is negated, for everything beyound 31 the resulting
>>>>> large integer is non-normalized (and therefore not comparing
>>>>> correctly).
>>>>>
>>>>> Any ideas?
>>>>
>>>> Well for starters the signed64BitIntegerFor: code assumes an 8 byte
>>>> large integer no matter what the value being converted so that's
>>>> going to cause your non-normalized problem. I'm fairly sure you can
>>>> work out how to fix that bit quickly enough.
>>>>
>>>> I'm not absolutely sure(and I can't be bothered to look it up right
>>>> now) but wouldn't 1<<31 be a negative value when treated as a 32 bit
>>>> word? It looks to me as if signed32BitInteger might be the wrong
>>>> thing to use in signed64itInteger, with positive32BitInteger a bit
>>>> more plausible.
>>>>
>>>> I have vague memories of when this code was written, mostly of it
>>>> being related to long file pointers in OSs I wasn't running at that
>>>> time. Thus I would have relied upon testing by involved parties and
>>>> taken their word as to the viability of the code. I guess that once
>>>> again the value of good tests is demonstrated.
>>>>
>>>> tim
>>>> --
>>>> tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim
>>>> Strange OpCodes: VMB: Verify, then Make Bad
>>
>>
>> Workaround I had
>>
>>
>>
>> signed64BitIntegerForOVERRIDE: integerValue
>> "Answer a new String copied from a null-terminated C string.
>> Caution: This may invoke the garbage collector."
>> | checkUnsignedLong checkUnsignedLongMax |
>>
>> self var: 'integerValue' type: 'const sqLong'.
>> self var: 'integerValue' type: 'sqLong'.
>> self var: 'checkLong' type: 'sqLong'.
>> self var: 'checkUnsignedLong' type: 'unsigned long long'.
>> self var: 'checkUnsignedLongMax' type: 'unsigned long long'.
>> self var: 'value' type: 'sqLong'.
>> checkUnsignedLong := integerValue.
>> checkUnsignedLongMax := 16rFFFFFFFF.
>> checkUnsignedLong > checkUnsignedLongMax
>> ifFalse: [^interpreterProxy positive32BitIntegerFor:
>> checkUnsignedLong].
>>
>> ^interpreterProxy signed64BitIntegerFor: integerValue.
>>
>>
>>
>>
-------------- next part --------------
'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 20 March 2008 at 11:52:05 pm'!
"Change Set: SignedIntFixes
Date: 19 March 2008
Author: Andreas Raab
Fixes various issues with
* Interpreter>>signed32BitValueOf:
* Interpreter>>signed64BitValueOf:
* Interpreter>>signed64BitIntegerFor:
* Interpreter>>positive64BitIntegerFor:
which were incorrect to varying degrees."!
!Interpreter methodsFor: 'primitive support' stamp: 'ar 3/20/2008 23:01'!
positive64BitIntegerFor: integerValue
| newLargeInteger value highWord sz |
"Note - integerValue is interpreted as POSITIVE, eg, as the result of
Bitmap>at:, or integer>bitAnd:."
self var: 'integerValue' type: 'sqLong'.
(self sizeof: integerValue) = 4 ifTrue: [^self positive32BitIntegerFor: integerValue].
highWord := self cCode: 'integerValue >> 32'. "shift is coerced to usqInt otherwise"
highWord = 0
ifTrue:[sz := 4]
ifFalse:[
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
].
newLargeInteger := self instantiateClass: (self splObj: ClassLargePositiveInteger) indexableSize: sz.
0 to: sz-1 do: [:i |
value := self cCode: '(integerValue >> (i * 8)) & 255'.
self storeByte: i ofObject: newLargeInteger withValue: value].
^ newLargeInteger
! !
!Interpreter methodsFor: 'primitive support' stamp: 'ar 3/19/2008 20:45'!
signed32BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive ST integer or a four-byte LargeInteger."
| sz value largeClass negative |
self inline: false.
(self isIntegerObject: oop) ifTrue: [^self integerValueOf: oop].
largeClass := self fetchClassOf: oop.
largeClass = self classLargePositiveInteger
ifTrue:[negative := false]
ifFalse:[largeClass = self classLargeNegativeInteger
ifTrue:[negative := true]
ifFalse:[^self primitiveFail]].
sz := self lengthOf: oop.
sz = 4 ifFalse: [^ self primitiveFail].
value := (self fetchByte: 0 ofObject: oop) +
((self fetchByte: 1 ofObject: oop) << 8) +
((self fetchByte: 2 ofObject: oop) << 16) +
((self fetchByte: 3 ofObject: oop) << 24).
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
32 set). Since the sign is implicit in the class we require that the
high bit of the magnitude is not set which is a simple test here."
value < 0 ifTrue:[^self primitiveFail].
negative
ifTrue:[^0 - value]
ifFalse:[^value]! !
!Interpreter methodsFor: 'primitive support' stamp: 'ar 3/20/2008 23:01'!
signed64BitIntegerFor: integerValue
"Return a Large Integer object for the given integer value"
| newLargeInteger magnitude largeClass intValue highWord sz |
self inline: false.
self var: 'integerValue' type: 'sqLong'.
self var: 'magnitude' type: 'sqLong'.
self var: 'highWord' type: 'usqInt'.
integerValue < 0
ifTrue:[ largeClass := self classLargeNegativeInteger.
magnitude := 0 - integerValue]
ifFalse:[ largeClass := self classLargePositiveInteger.
magnitude := integerValue].
magnitude <= 16r7FFFFFFF ifTrue:[^self signed32BitIntegerFor: integerValue].
highWord := self cCode: 'magnitude >> 32'. "shift is coerced to usqInt otherwise"
highWord = 0
ifTrue:[sz := 4]
ifFalse:[
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
].
newLargeInteger := self instantiateClass: largeClass indexableSize: sz.
0 to: sz-1 do: [:i |
intValue := self cCode: '(magnitude >> (i * 8)) & 255'.
self storeByte: i ofObject: newLargeInteger withValue: intValue].
^ newLargeInteger! !
!Interpreter methodsFor: 'primitive support' stamp: 'ar 3/19/2008 23:35'!
signed64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive ST integer or a eight-byte LargeInteger."
| sz value largeClass negative szsqLong |
self inline: false.
self returnTypeC: 'sqLong'.
self var: 'value' type: 'sqLong'.
(self isIntegerObject: oop) ifTrue: [^self cCoerce: (self integerValueOf: oop) to: 'sqLong'].
largeClass := self fetchClassOf: oop.
largeClass = self classLargePositiveInteger
ifTrue:[negative := false]
ifFalse:[largeClass = self classLargeNegativeInteger
ifTrue:[negative := true]
ifFalse:[^self primitiveFail]].
szsqLong := self cCode: 'sizeof(sqLong)'.
sz := self lengthOf: oop.
sz > szsqLong
ifTrue: [^ self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (self fetchByte: i ofObject: oop) to: 'sqLong') << (i*8))].
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF... (negative w/ bit
64 set). Since the sign is implicit in the class we require that the
high bit of the magnitude is not set which is a simple test here."
value < 0 ifTrue:[^self primitiveFail].
negative
ifTrue:[^0 - value]
ifFalse:[^value]! !
More information about the Vm-dev
mailing list