VM Maker: VMMaker.oscog-nice.2723.mcz

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

VM Maker: VMMaker.oscog-nice.2723.mcz

commits-2
 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.2723
Author: nice
Time: 10 March 2020, 12:26:31.04183 am
UUID: c1319382-406c-43a7-9f55-2b48c4007d80
Ancestors: VMMaker.oscog-eem.2722

Fix the right shift: dont convert to usqInt a type longer than usqInt

=============== Diff against VMMaker.oscog-eem.2722 ===============

Item was changed:
  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
  generateBitShift: msgNode on: aStream indent: level
  "Generate the C code for this message onto the given stream."
 
+ | arg shift rightShift |
+ (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
- | arg rcvr shift |
- arg := msgNode args first.
- rcvr := msgNode receiver.
- (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
  ifTrue: "bit shift amount is a constant"
+ [aStream nextPut: $(.
- [aStream nextPutAll: '((usqInt) '.
- self emitCExpression: rcvr on: aStream.
  shift < 0
+ ifTrue:
+ [rightShift := TSendNode new
+ setSelector: #>>
+ receiver: msgNode receiver
+ arguments: {TConstantNode new setValue: shift negated}.
+ self generateShiftRight: rightShift on: aStream indent: level]
+ ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
- ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
- ifFalse: [aStream nextPutAll: ' << '; print: shift].
  aStream nextPut: $)]
  ifFalse: "bit shift amount is an expression"
+ [rightShift := TSendNode new
+ setSelector: #>>
+ receiver: msgNode receiver
+ arguments: {TSendNode new
+ setSelector: #negated
+ receiver: arg
+ arguments: #()}.
+ aStream nextPutAll: '(('.
+ self emitCExpression: arg on: aStream.
+ aStream nextPutAll: ' < 0) ? ('.
+ self generateShiftRight: rightShift on: aStream indent: level.
+ aStream nextPutAll: ') : ('.
+ self generateShiftLeft: msgNode on: aStream indent: level.
- [aStream nextPutAll: '(('.
- self emitCExpression: arg on: aStream indent: level.
- aStream nextPutAll: ' < 0) ? ((usqInt) '.
- self emitCExpression: rcvr on: aStream indent: level.
- aStream nextPutAll: ' >> -'.
- self emitCExpression: arg on: aStream indent: level.
- aStream nextPutAll: ') : ((usqInt) '.
- self emitCExpression: rcvr on: aStream indent: level.
- aStream nextPutAll: ' << '.
- self emitCExpression: arg on: aStream indent: level.
  aStream nextPutAll: '))']!

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
  generateShiftRight: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream.
+ Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
- "Generate the C code for this message onto the given stream."
 
+ | type typeIsUnsigned mustCastToUnsigned unsignedType |
+ type := self typeFor: msgNode receiver in: currentMethod.
+ typeIsUnsigned := type first = $u.
+ mustCastToUnsigned := typeIsUnsigned not or:
+ ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
+ (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+ "If not unsigned cast it to unsigned."
+ mustCastToUnsigned
- | type |
- "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
- (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
  ifTrue:
+ ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
+ unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
+ ifTrue: [#usqInt]
+ ifFalse: [self unsignedTypeForIntegralType: type].
+ aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
- ["If not unsigned cast it to unsigned."
- type first ~= $u ifTrue:
- [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
  self emitCExpression: msgNode receiver on: aStream indent: level.
+ aStream nextPutAll: '))']
- type first ~= $u ifTrue:
- [aStream nextPut: $)]]
  ifFalse:
+ [aStream nextPutAll: '('.
- [aStream nextPutAll: '((usqInt) '.
  self emitCExpression: msgNode receiver on: aStream indent: level.
  aStream nextPut: $)].
  aStream nextPutAll: ' >> '.
  self emitCExpression: msgNode args first on: aStream indent: level!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
  generateSignedBitShift: msgNode on: aStream indent: level
  "Generate the C code for this message onto the given stream."
 
+ | arg shift rightShift |
- | cast type arg shift |
- "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
- cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
- ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
- ifFalse: ['(signed)'].
  (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
  ifTrue: "bit shift amount is a constant"
+ [aStream nextPut: $(.
- [aStream nextPut: $(; nextPutAll: cast.
- self emitCExpression: msgNode receiver on: aStream.
  shift < 0
+ ifTrue:
+ [rightShift := TSendNode new
+ setSelector: #>>
+ receiver: msgNode receiver
+ arguments: {TConstantNode new setValue: shift negated}.
+ self generateSignedShiftRight: rightShift on: aStream indent: level]
+ ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
- ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
- ifFalse: [aStream nextPutAll: ' << '; print: shift].
  aStream nextPut: $)]
  ifFalse: "bit shift amount is an expression"
+ [rightShift := TSendNode new
+ setSelector: #>>
+ receiver: msgNode receiver
+ arguments: {TSendNode new
+ setSelector: #negated
+ receiver: arg
+ arguments: #()}.
+ aStream nextPutAll: '(('.
- [aStream nextPutAll: '(('.
  self emitCExpression: arg on: aStream.
+ aStream nextPutAll: ' < 0) ? ('.
+ self generateSignedShiftRight: rightShift on: aStream indent: level.
+ aStream nextPutAll: ') : ('.
+ self generateShiftLeft: msgNode on: aStream indent: level.
- aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' >> -'.
- self emitCExpression: arg on: aStream.
- aStream nextPutAll: ') : ('; nextPutAll: cast.
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ' << '.
- self emitCExpression: arg on: aStream.
  aStream nextPutAll: '))']!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
  generateSignedShiftRight: msgNode on: aStream indent: level
  "Generate the C code for >>> onto the given stream."
 
+ | type typeIsUnsigned mustCastToSigned signedType |
+ type := self typeFor: msgNode receiver in: currentMethod.
+ typeIsUnsigned := type first = $u.
+ mustCastToSigned := typeIsUnsigned or:
+ ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
+ (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+ mustCastToSigned
- (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
  ifTrue:
+ ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
+ signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
+ ifTrue: [#usqInt]
+ ifFalse: [self signedTypeForIntegralType: type].
+ aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
+ self emitCExpression: msgNode receiver on: aStream indent: level.
+ aStream nextPutAll: '))']
- [aStream nextPutAll: '((sqLong) ']
  ifFalse:
+ [aStream nextPutAll: '('.
+ self emitCExpression: msgNode receiver on: aStream indent: level.
+ aStream nextPut: $)].
+ aStream nextPutAll: ' >> '.
- [aStream nextPutAll: '((sqInt) '].
- self emitCExpression: msgNode receiver on: aStream.
- aStream nextPutAll: ') >> '.
  self emitCExpression: msgNode args first on: aStream!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-nice.2723.mcz

Nicolas Cellier
 
Just a side note: I'm currently using the Spur64 VM generated from this VMMaker version.
Whoever changes the generator likes to live dangerously and eat own dog food.
I ran all 6.0 tests, no crash, no new failure.

Le mar. 10 mars 2020 à 00:28, <[hidden email]> a écrit :
 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.2723
Author: nice
Time: 10 March 2020, 12:26:31.04183 am
UUID: c1319382-406c-43a7-9f55-2b48c4007d80
Ancestors: VMMaker.oscog-eem.2722

Fix the right shift: dont convert to usqInt a type longer than usqInt

=============== Diff against VMMaker.oscog-eem.2722 ===============

Item was changed:
  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
  generateBitShift: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

+       | arg shift rightShift |
+       (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
-       | arg rcvr shift |
-       arg := msgNode args first.
-       rcvr := msgNode receiver.
-       (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
                ifTrue: "bit shift amount is a constant"
+                       [aStream nextPut: $(.
-                       [aStream nextPutAll: '((usqInt) '.
-                       self emitCExpression: rcvr on: aStream.
                        shift < 0
+                               ifTrue:
+                                       [rightShift := TSendNode new
+                                               setSelector: #>>
+                                               receiver: msgNode receiver
+                                               arguments: {TConstantNode new setValue: shift negated}.
+                                       self generateShiftRight: rightShift on: aStream indent: level]
+                               ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
-                               ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
-                               ifFalse: [aStream nextPutAll: ' << '; print: shift].
                        aStream nextPut: $)]
                ifFalse: "bit shift amount is an expression"
+                       [rightShift := TSendNode new
+                                               setSelector: #>>
+                                               receiver: msgNode receiver
+                                               arguments: {TSendNode new
+                                                       setSelector: #negated
+                                                       receiver: arg
+                                                       arguments: #()}.
+                       aStream nextPutAll: '(('.
+                       self emitCExpression: arg on: aStream.
+                       aStream nextPutAll: ' < 0) ? ('.
+                       self generateShiftRight: rightShift on: aStream indent: level.
+                       aStream nextPutAll: ') : ('.
+                       self generateShiftLeft: msgNode on: aStream indent: level.
-                       [aStream nextPutAll: '(('.
-                       self emitCExpression: arg on: aStream indent: level.
-                       aStream nextPutAll: ' < 0) ? ((usqInt) '.
-                       self emitCExpression: rcvr on: aStream indent: level.
-                       aStream nextPutAll: ' >> -'.
-                       self emitCExpression: arg on: aStream indent: level.
-                       aStream nextPutAll: ') : ((usqInt) '.
-                       self emitCExpression: rcvr on: aStream indent: level.
-                       aStream nextPutAll: ' << '.
-                       self emitCExpression: arg on: aStream indent: level.
                        aStream nextPutAll: '))']!

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
  generateShiftRight: msgNode on: aStream indent: level
+       "Generate the C code for this message onto the given stream.
+       Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
-       "Generate the C code for this message onto the given stream."

+       | type typeIsUnsigned mustCastToUnsigned unsignedType |
+       type := self typeFor: msgNode receiver in: currentMethod.
+       typeIsUnsigned := type first = $u.
+       mustCastToUnsigned := typeIsUnsigned not or:
+               ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
+               (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+       "If not unsigned cast it to unsigned."
+       mustCastToUnsigned
-       | type |
-       "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
-       (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
                ifTrue:
+                       ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
+                       unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
+                               ifTrue: [#usqInt]
+                               ifFalse: [self unsignedTypeForIntegralType: type].
+                        aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
-                       ["If not unsigned cast it to unsigned."
-                        type first ~= $u ifTrue:
-                               [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
                         self emitCExpression: msgNode receiver on: aStream indent: level.
+                        aStream nextPutAll: '))']
-                        type first ~= $u ifTrue:
-                               [aStream nextPut: $)]]
                ifFalse:
+                       [aStream nextPutAll: '('.
-                       [aStream nextPutAll: '((usqInt) '.
                         self emitCExpression: msgNode receiver on: aStream indent: level.
                         aStream nextPut: $)].
        aStream nextPutAll: ' >> '.
        self emitCExpression: msgNode args first on: aStream indent: level!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
  generateSignedBitShift: msgNode on: aStream indent: level
        "Generate the C code for this message onto the given stream."

+       | arg shift rightShift |
-       | cast type arg shift |
-       "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
-       cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
-                               ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
-                               ifFalse: ['(signed)'].
        (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
                ifTrue: "bit shift amount is a constant"
+                       [aStream nextPut: $(.
-                       [aStream nextPut: $(; nextPutAll: cast.
-                       self emitCExpression: msgNode receiver on: aStream.
                        shift < 0
+                               ifTrue:
+                                       [rightShift := TSendNode new
+                                               setSelector: #>>
+                                               receiver: msgNode receiver
+                                               arguments: {TConstantNode new setValue: shift negated}.
+                                       self generateSignedShiftRight: rightShift on: aStream indent: level]
+                               ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
-                               ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
-                               ifFalse: [aStream nextPutAll: ' << '; print: shift].
                        aStream nextPut: $)]
                ifFalse: "bit shift amount is an expression"
+                       [rightShift := TSendNode new
+                                               setSelector: #>>
+                                               receiver: msgNode receiver
+                                               arguments: {TSendNode new
+                                                       setSelector: #negated
+                                                       receiver: arg
+                                                       arguments: #()}.
+                       aStream nextPutAll: '(('.
-                       [aStream nextPutAll: '(('.
                        self emitCExpression: arg on: aStream.
+                       aStream nextPutAll: ' < 0) ? ('.
+                       self generateSignedShiftRight: rightShift on: aStream indent: level.
+                       aStream nextPutAll: ') : ('.
+                       self generateShiftLeft: msgNode on: aStream indent: level.
-                       aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
-                       self emitCExpression: msgNode receiver on: aStream.
-                       aStream nextPutAll: ' >> -'.
-                       self emitCExpression: arg on: aStream.
-                       aStream nextPutAll: ') : ('; nextPutAll: cast.
-                       self emitCExpression: msgNode receiver on: aStream.
-                       aStream nextPutAll: ' << '.
-                       self emitCExpression: arg on: aStream.
                        aStream nextPutAll: '))']!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
  generateSignedShiftRight: msgNode on: aStream indent: level
        "Generate the C code for >>> onto the given stream."

+       | type typeIsUnsigned mustCastToSigned signedType |
+       type := self typeFor: msgNode receiver in: currentMethod.
+       typeIsUnsigned := type first = $u.
+       mustCastToSigned := typeIsUnsigned or:
+               ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
+               (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+       mustCastToSigned
-       (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
                ifTrue:
+                       ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
+                       signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
+                               ifTrue: [#usqInt]
+                               ifFalse: [self signedTypeForIntegralType: type].
+                        aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
+                        self emitCExpression: msgNode receiver on: aStream indent: level.
+                        aStream nextPutAll: '))']
-                       [aStream nextPutAll: '((sqLong) ']
                ifFalse:
+                       [aStream nextPutAll: '('.
+                        self emitCExpression: msgNode receiver on: aStream indent: level.
+                        aStream nextPut: $)].
+       aStream nextPutAll: ' >> '.
-                       [aStream nextPutAll: '((sqInt) '].
-       self emitCExpression: msgNode receiver on: aStream.
-       aStream nextPutAll: ') >> '.
        self emitCExpression: msgNode args first on: aStream!

Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-nice.2723.mcz

Levente Uzonyi
In reply to this post by commits-2
 
Hi Nicolas,

Thanks for the fix. It works.
I wonder why is it necessary to cast to usqInt. Is it just to ensure
unsignedness?


Levente

On Mon, 9 Mar 2020, [hidden email] wrote:

>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.2723
> Author: nice
> Time: 10 March 2020, 12:26:31.04183 am
> UUID: c1319382-406c-43a7-9f55-2b48c4007d80
> Ancestors: VMMaker.oscog-eem.2722
>
> Fix the right shift: dont convert to usqInt a type longer than usqInt
>
> =============== Diff against VMMaker.oscog-eem.2722 ===============
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
>  generateBitShift: msgNode on: aStream indent: level
>   "Generate the C code for this message onto the given stream."
>
> + | arg shift rightShift |
> + (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
> - | arg rcvr shift |
> - arg := msgNode args first.
> - rcvr := msgNode receiver.
> - (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
>   ifTrue: "bit shift amount is a constant"
> + [aStream nextPut: $(.
> - [aStream nextPutAll: '((usqInt) '.
> - self emitCExpression: rcvr on: aStream.
>   shift < 0
> + ifTrue:
> + [rightShift := TSendNode new
> + setSelector: #>>
> + receiver: msgNode receiver
> + arguments: {TConstantNode new setValue: shift negated}.
> + self generateShiftRight: rightShift on: aStream indent: level]
> + ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> - ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> - ifFalse: [aStream nextPutAll: ' << '; print: shift].
>   aStream nextPut: $)]
>   ifFalse: "bit shift amount is an expression"
> + [rightShift := TSendNode new
> + setSelector: #>>
> + receiver: msgNode receiver
> + arguments: {TSendNode new
> + setSelector: #negated
> + receiver: arg
> + arguments: #()}.
> + aStream nextPutAll: '(('.
> + self emitCExpression: arg on: aStream.
> + aStream nextPutAll: ' < 0) ? ('.
> + self generateShiftRight: rightShift on: aStream indent: level.
> + aStream nextPutAll: ') : ('.
> + self generateShiftLeft: msgNode on: aStream indent: level.
> - [aStream nextPutAll: '(('.
> - self emitCExpression: arg on: aStream indent: level.
> - aStream nextPutAll: ' < 0) ? ((usqInt) '.
> - self emitCExpression: rcvr on: aStream indent: level.
> - aStream nextPutAll: ' >> -'.
> - self emitCExpression: arg on: aStream indent: level.
> - aStream nextPutAll: ') : ((usqInt) '.
> - self emitCExpression: rcvr on: aStream indent: level.
> - aStream nextPutAll: ' << '.
> - self emitCExpression: arg on: aStream indent: level.
>   aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
>  generateShiftRight: msgNode on: aStream indent: level
> + "Generate the C code for this message onto the given stream.
> + Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
> - "Generate the C code for this message onto the given stream."
>
> + | type typeIsUnsigned mustCastToUnsigned unsignedType |
> + type := self typeFor: msgNode receiver in: currentMethod.
> + typeIsUnsigned := type first = $u.
> + mustCastToUnsigned := typeIsUnsigned not or:
> + ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> + (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> + "If not unsigned cast it to unsigned."
> + mustCastToUnsigned
> - | type |
> - "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> - (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
>   ifTrue:
> + ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> + unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> + ifTrue: [#usqInt]
> + ifFalse: [self unsignedTypeForIntegralType: type].
> + aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
> - ["If not unsigned cast it to unsigned."
> - type first ~= $u ifTrue:
> - [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
>   self emitCExpression: msgNode receiver on: aStream indent: level.
> + aStream nextPutAll: '))']
> - type first ~= $u ifTrue:
> - [aStream nextPut: $)]]
>   ifFalse:
> + [aStream nextPutAll: '('.
> - [aStream nextPutAll: '((usqInt) '.
>   self emitCExpression: msgNode receiver on: aStream indent: level.
>   aStream nextPut: $)].
>   aStream nextPutAll: ' >> '.
>   self emitCExpression: msgNode args first on: aStream indent: level!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
>  generateSignedBitShift: msgNode on: aStream indent: level
>   "Generate the C code for this message onto the given stream."
>
> + | arg shift rightShift |
> - | cast type arg shift |
> - "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
> - cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
> - ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
> - ifFalse: ['(signed)'].
>   (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
>   ifTrue: "bit shift amount is a constant"
> + [aStream nextPut: $(.
> - [aStream nextPut: $(; nextPutAll: cast.
> - self emitCExpression: msgNode receiver on: aStream.
>   shift < 0
> + ifTrue:
> + [rightShift := TSendNode new
> + setSelector: #>>
> + receiver: msgNode receiver
> + arguments: {TConstantNode new setValue: shift negated}.
> + self generateSignedShiftRight: rightShift on: aStream indent: level]
> + ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> - ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> - ifFalse: [aStream nextPutAll: ' << '; print: shift].
>   aStream nextPut: $)]
>   ifFalse: "bit shift amount is an expression"
> + [rightShift := TSendNode new
> + setSelector: #>>
> + receiver: msgNode receiver
> + arguments: {TSendNode new
> + setSelector: #negated
> + receiver: arg
> + arguments: #()}.
> + aStream nextPutAll: '(('.
> - [aStream nextPutAll: '(('.
>   self emitCExpression: arg on: aStream.
> + aStream nextPutAll: ' < 0) ? ('.
> + self generateSignedShiftRight: rightShift on: aStream indent: level.
> + aStream nextPutAll: ') : ('.
> + self generateShiftLeft: msgNode on: aStream indent: level.
> - aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
> - self emitCExpression: msgNode receiver on: aStream.
> - aStream nextPutAll: ' >> -'.
> - self emitCExpression: arg on: aStream.
> - aStream nextPutAll: ') : ('; nextPutAll: cast.
> - self emitCExpression: msgNode receiver on: aStream.
> - aStream nextPutAll: ' << '.
> - self emitCExpression: arg on: aStream.
>   aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
>  generateSignedShiftRight: msgNode on: aStream indent: level
>   "Generate the C code for >>> onto the given stream."
>
> + | type typeIsUnsigned mustCastToSigned signedType |
> + type := self typeFor: msgNode receiver in: currentMethod.
> + typeIsUnsigned := type first = $u.
> + mustCastToSigned := typeIsUnsigned or:
> + ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> + (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> + mustCastToSigned
> - (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
>   ifTrue:
> + ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> + signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> + ifTrue: [#usqInt]
> + ifFalse: [self signedTypeForIntegralType: type].
> + aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
> + self emitCExpression: msgNode receiver on: aStream indent: level.
> + aStream nextPutAll: '))']
> - [aStream nextPutAll: '((sqLong) ']
>   ifFalse:
> + [aStream nextPutAll: '('.
> + self emitCExpression: msgNode receiver on: aStream indent: level.
> + aStream nextPut: $)].
> + aStream nextPutAll: ' >> '.
> - [aStream nextPutAll: '((sqInt) '].
> - self emitCExpression: msgNode receiver on: aStream.
> - aStream nextPutAll: ') >> '.
>   self emitCExpression: msgNode args first on: aStream!
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-nice.2723.mcz

Nicolas Cellier
 
Hi Levente,
for some reason, early VM writers were looking for a Logical Right Shift (not propagating the sign bit).
So that's how bitShift: (then >>) were historically translated - no matter how weird or contradictory to VM simulation it can be.
I guess that it is of greatest interest for generating BitBlt operations (Simulation works ok because WordArray are like unsigned).

Eliot had to later introduce >>> for Arithmetic Right Shift and signedBitShift: too, because we sometimes need those operations too.
That makes one more surprise because we now have the exact opposite of Java semantics for >> and >>> !

We have another similar surprising behavior with translation of // and \\ which are translated into C operations equivalent  to quo: and rem:

These hackish choices are unfortunate, but very difficult to change now without hiccups...

Le mar. 10 mars 2020 à 21:55, Levente Uzonyi <[hidden email]> a écrit :
 
Hi Nicolas,

Thanks for the fix. It works.
I wonder why is it necessary to cast to usqInt. Is it just to ensure
unsignedness?


Levente

On Mon, 9 Mar 2020, [hidden email] wrote:

>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.2723
> Author: nice
> Time: 10 March 2020, 12:26:31.04183 am
> UUID: c1319382-406c-43a7-9f55-2b48c4007d80
> Ancestors: VMMaker.oscog-eem.2722
>
> Fix the right shift: dont convert to usqInt a type longer than usqInt
>
> =============== Diff against VMMaker.oscog-eem.2722 ===============
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
>  generateBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> +     (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
> -     | arg rcvr shift |
> -     arg := msgNode args first.
> -     rcvr := msgNode receiver.
> -     (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPutAll: '((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> +                     self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     [aStream nextPutAll: '(('.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ') : ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream indent: level.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
>  generateShiftRight: msgNode on: aStream indent: level
> +     "Generate the C code for this message onto the given stream.
> +     Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
> -     "Generate the C code for this message onto the given stream."
>
> +     | type typeIsUnsigned mustCastToUnsigned unsignedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToUnsigned := typeIsUnsigned not or:
> +             ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     "If not unsigned cast it to unsigned."
> +     mustCastToUnsigned
> -     | type |
> -     "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self unsignedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
> -                     ["If not unsigned cast it to unsigned."
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPut: $)]]
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> -                     [aStream nextPutAll: '((usqInt) '.
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
>                        aStream nextPut: $)].
>       aStream nextPutAll: ' >> '.
>       self emitCExpression: msgNode args first on: aStream indent: level!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
>  generateSignedBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> -     | cast type arg shift |
> -     "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
> -     cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
> -                             ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
> -                             ifFalse: ['(signed)'].
>       (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPut: $(; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateSignedShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> -                     [aStream nextPutAll: '(('.
>                       self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateSignedShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream.
> -                     aStream nextPutAll: ') : ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
>  generateSignedShiftRight: msgNode on: aStream indent: level
>       "Generate the C code for >>> onto the given stream."
>
> +     | type typeIsUnsigned mustCastToSigned signedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToSigned := typeIsUnsigned or:
> +             ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     mustCastToSigned
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self signedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                     [aStream nextPutAll: '((sqLong) ']
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPut: $)].
> +     aStream nextPutAll: ' >> '.
> -                     [aStream nextPutAll: '((sqInt) '].
> -     self emitCExpression: msgNode receiver on: aStream.
> -     aStream nextPutAll: ') >> '.
>       self emitCExpression: msgNode args first on: aStream!
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-nice.2723.mcz

Nicolas Cellier
 
Also note that in the interim, I have crippled BitBlt with <unsigned int> type hints. It's not the most lightWeight or beautiful thing.
But this was necessary for making sure the plugin was 64bit compatible (being sure of exact semantic of generated code), and also for making it a tiny bit more optimized.
So the need for Logical Right Shift might have disappeared (too many senders to be sure!)... On the other hand, we rarely need to shift negative values (we dot it mostly for SmallInteger -> C integer, but it's done thru specialized code generation hooks).

Le mar. 10 mars 2020 à 22:14, Nicolas Cellier <[hidden email]> a écrit :
Hi Levente,
for some reason, early VM writers were looking for a Logical Right Shift (not propagating the sign bit).
So that's how bitShift: (then >>) were historically translated - no matter how weird or contradictory to VM simulation it can be.
I guess that it is of greatest interest for generating BitBlt operations (Simulation works ok because WordArray are like unsigned).

Eliot had to later introduce >>> for Arithmetic Right Shift and signedBitShift: too, because we sometimes need those operations too.
That makes one more surprise because we now have the exact opposite of Java semantics for >> and >>> !

We have another similar surprising behavior with translation of // and \\ which are translated into C operations equivalent  to quo: and rem:

These hackish choices are unfortunate, but very difficult to change now without hiccups...

Le mar. 10 mars 2020 à 21:55, Levente Uzonyi <[hidden email]> a écrit :
 
Hi Nicolas,

Thanks for the fix. It works.
I wonder why is it necessary to cast to usqInt. Is it just to ensure
unsignedness?


Levente

On Mon, 9 Mar 2020, [hidden email] wrote:

>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.2723
> Author: nice
> Time: 10 March 2020, 12:26:31.04183 am
> UUID: c1319382-406c-43a7-9f55-2b48c4007d80
> Ancestors: VMMaker.oscog-eem.2722
>
> Fix the right shift: dont convert to usqInt a type longer than usqInt
>
> =============== Diff against VMMaker.oscog-eem.2722 ===============
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
>  generateBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> +     (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
> -     | arg rcvr shift |
> -     arg := msgNode args first.
> -     rcvr := msgNode receiver.
> -     (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPutAll: '((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> +                     self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     [aStream nextPutAll: '(('.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ') : ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream indent: level.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
>  generateShiftRight: msgNode on: aStream indent: level
> +     "Generate the C code for this message onto the given stream.
> +     Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
> -     "Generate the C code for this message onto the given stream."
>
> +     | type typeIsUnsigned mustCastToUnsigned unsignedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToUnsigned := typeIsUnsigned not or:
> +             ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     "If not unsigned cast it to unsigned."
> +     mustCastToUnsigned
> -     | type |
> -     "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self unsignedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
> -                     ["If not unsigned cast it to unsigned."
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPut: $)]]
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> -                     [aStream nextPutAll: '((usqInt) '.
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
>                        aStream nextPut: $)].
>       aStream nextPutAll: ' >> '.
>       self emitCExpression: msgNode args first on: aStream indent: level!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
>  generateSignedBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> -     | cast type arg shift |
> -     "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
> -     cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
> -                             ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
> -                             ifFalse: ['(signed)'].
>       (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPut: $(; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateSignedShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> -                     [aStream nextPutAll: '(('.
>                       self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateSignedShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream.
> -                     aStream nextPutAll: ') : ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
>  generateSignedShiftRight: msgNode on: aStream indent: level
>       "Generate the C code for >>> onto the given stream."
>
> +     | type typeIsUnsigned mustCastToSigned signedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToSigned := typeIsUnsigned or:
> +             ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     mustCastToSigned
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self signedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                     [aStream nextPutAll: '((sqLong) ']
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPut: $)].
> +     aStream nextPutAll: ' >> '.
> -                     [aStream nextPutAll: '((sqInt) '].
> -     self emitCExpression: msgNode receiver on: aStream.
> -     aStream nextPutAll: ') >> '.
>       self emitCExpression: msgNode args first on: aStream!
Reply | Threaded
Open this post in threaded view
|

Re: VM Maker: VMMaker.oscog-nice.2723.mcz

Eliot Miranda-2
In reply to this post by Nicolas Cellier
 
Hi Nicolas,

On Tue, Mar 10, 2020 at 2:15 PM Nicolas Cellier <[hidden email]> wrote:
 
Hi Levente,
for some reason, early VM writers were looking for a Logical Right Shift (not propagating the sign bit).
So that's how bitShift: (then >>) were historically translated - no matter how weird or contradictory to VM simulation it can be.
I guess that it is of greatest interest for generating BitBlt operations (Simulation works ok because WordArray are like unsigned).

That's right.  For graphics one wants logical right shifts.  Also some times convenient for bit field extractions in object headers, etc.  If one is extracting a field that includes the MSB (sign bit) then a logical shift yields the result without needing to mask.
 

Eliot had to later introduce >>> for Arithmetic Right Shift and signedBitShift: too, because we sometimes need those operations too.
That makes one more surprise because we now have the exact opposite of Java semantics for >> and >>> !

:-)
 
We have another similar surprising behavior with translation of // and \\ which are translated into C operations equivalent  to quo: and rem: 

These hackish choices are unfortunate, but very difficult to change now without hiccups...

+1 ish.  The important thing is to get the VM to work and spending lots of time making sure the C is beautiful (rather than just debuggable) is taking time away from more productive tasks.  We really are treating C as an assembler and for that the recent introduction of undefined behavior for may operations that were perfectly well defined on 32-bit 2's compliment machines was a PITA ;-)
 
Le mar. 10 mars 2020 à 21:55, Levente Uzonyi <[hidden email]> a écrit :
 
Hi Nicolas,

Thanks for the fix. It works.
I wonder why is it necessary to cast to usqInt. Is it just to ensure
unsignedness?


Levente

On Mon, 9 Mar 2020, [hidden email] wrote:

>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2723.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.2723
> Author: nice
> Time: 10 March 2020, 12:26:31.04183 am
> UUID: c1319382-406c-43a7-9f55-2b48c4007d80
> Ancestors: VMMaker.oscog-eem.2722
>
> Fix the right shift: dont convert to usqInt a type longer than usqInt
>
> =============== Diff against VMMaker.oscog-eem.2722 ===============
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateBitShift:on:indent: (in category 'C translation') -----
>  generateBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> +     (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
> -     | arg rcvr shift |
> -     arg := msgNode args first.
> -     rcvr := msgNode receiver.
> -     (self isConstantNode: arg valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPutAll: '((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> +                     self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     [aStream nextPutAll: '(('.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream indent: level.
> -                     aStream nextPutAll: ') : ((usqInt) '.
> -                     self emitCExpression: rcvr on: aStream indent: level.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream indent: level.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
>  generateShiftRight: msgNode on: aStream indent: level
> +     "Generate the C code for this message onto the given stream.
> +     Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
> -     "Generate the C code for this message onto the given stream."
>
> +     | type typeIsUnsigned mustCastToUnsigned unsignedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToUnsigned := typeIsUnsigned not or:
> +             ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     "If not unsigned cast it to unsigned."
> +     mustCastToUnsigned
> -     | type |
> -     "If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self unsignedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
> -                     ["If not unsigned cast it to unsigned."
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                      type first ~= $u ifTrue:
> -                             [aStream nextPut: $)]]
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> -                     [aStream nextPutAll: '((usqInt) '.
>                        self emitCExpression: msgNode receiver on: aStream indent: level.
>                        aStream nextPut: $)].
>       aStream nextPutAll: ' >> '.
>       self emitCExpression: msgNode args first on: aStream indent: level!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedBitShift:on:indent: (in category 'C translation') -----
>  generateSignedBitShift: msgNode on: aStream indent: level
>       "Generate the C code for this message onto the given stream."
>
> +     | arg shift rightShift |
> -     | cast type arg shift |
> -     "since ``signed'' is a synonym for ``signed int'' do not cast 64-bit values to signed if at all possible."
> -     cast := (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
> -                             ifTrue: ['(', (type first = $u ifTrue: [type allButFirst: (type second = $n ifTrue: [2] ifFalse: [1])] ifFalse: [type]), ')']
> -                             ifFalse: ['(signed)'].
>       (self isConstantNode: (arg := msgNode args first) valueInto: [:shiftValue| shift := shiftValue])
>               ifTrue: "bit shift amount is a constant"
> +                     [aStream nextPut: $(.
> -                     [aStream nextPut: $(; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
>                       shift < 0
> +                             ifTrue:
> +                                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TConstantNode new setValue: shift negated}.
> +                                     self generateSignedShiftRight: rightShift on: aStream indent: level]
> +                             ifFalse: [self generateShiftLeft: msgNode on: aStream indent: level].
> -                             ifTrue: [aStream nextPutAll: ' >> '; print: shift negated]
> -                             ifFalse: [aStream nextPutAll: ' << '; print: shift].
>                       aStream nextPut: $)]
>               ifFalse: "bit shift amount is an expression"
> +                     [rightShift := TSendNode new
> +                                             setSelector: #>>
> +                                             receiver: msgNode receiver
> +                                             arguments: {TSendNode new
> +                                                     setSelector: #negated
> +                                                     receiver: arg
> +                                                     arguments: #()}.
> +                     aStream nextPutAll: '(('.
> -                     [aStream nextPutAll: '(('.
>                       self emitCExpression: arg on: aStream.
> +                     aStream nextPutAll: ' < 0) ? ('.
> +                     self generateSignedShiftRight: rightShift on: aStream indent: level.
> +                     aStream nextPutAll: ') : ('.
> +                     self generateShiftLeft: msgNode on: aStream indent: level.
> -                     aStream nextPutAll: ' < 0) ? ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' >> -'.
> -                     self emitCExpression: arg on: aStream.
> -                     aStream nextPutAll: ') : ('; nextPutAll: cast.
> -                     self emitCExpression: msgNode receiver on: aStream.
> -                     aStream nextPutAll: ' << '.
> -                     self emitCExpression: arg on: aStream.
>                       aStream nextPutAll: '))']!
>
> Item was changed:
>  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
>  generateSignedShiftRight: msgNode on: aStream indent: level
>       "Generate the C code for >>> onto the given stream."
>
> +     | type typeIsUnsigned mustCastToSigned signedType |
> +     type := self typeFor: msgNode receiver in: currentMethod.
> +     typeIsUnsigned := type first = $u.
> +     mustCastToSigned := typeIsUnsigned or:
> +             ["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
> +             (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
> +     mustCastToSigned
> -     (self is64BitIntegralVariable: msgNode receiver typeInto: [:t|])
>               ifTrue:
> +                     ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
> +                     signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
> +                             ifTrue: [#usqInt]
> +                             ifFalse: [self signedTypeForIntegralType: type].
> +                      aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPutAll: '))']
> -                     [aStream nextPutAll: '((sqLong) ']
>               ifFalse:
> +                     [aStream nextPutAll: '('.
> +                      self emitCExpression: msgNode receiver on: aStream indent: level.
> +                      aStream nextPut: $)].
> +     aStream nextPutAll: ' >> '.
> -                     [aStream nextPutAll: '((sqInt) '].
> -     self emitCExpression: msgNode receiver on: aStream.
> -     aStream nextPutAll: ') >> '.
>       self emitCExpression: msgNode args first on: aStream!


--
_,,,^..^,,,_
best, Eliot