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

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

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

Name: VMMaker.oscog-nice.2661
Author: nice
Time: 13 January 2020, 10:46:06.526805 pm
UUID: ffc89dc8-2c44-4b53-ba7d-9124555e73b3
Ancestors: VMMaker.oscog-eem.2660

Remove some annoying Undefined Behavior.

When compiling the VM with Makefile.flags
CFLAGS,LDFLAGS,BFLAGS,DYFLAGS=
        -fsanitize=undefined \
we then get annoying undefined behavior warning, like:

../../spursrc/vm/gcc3x-cointerp.c:52198:33: runtime error: signed integer overflow: -1197416510 * 16807 cannot be represented in type 'int'
../../src/plugins/BitBltPlugin/BitBltPlugin.c:4390:34: runtime error: shift exponent 32 is too large for 32-bit type 'usqInt' (aka 'unsigned int')

Since we should not rely on UB, let's remove UB.
For hash, we simply use unsigned arithmetic (with the final bitAnd: this is strictly equivalent).
For BitBlt, we must avoid shifting by 32 positions (replace those trivial case of information fitting a single 32-bit word).

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

Item was changed:
  ----- Method: BitBltSimulation>>partitionedAND:to:nBits:nPartitions: (in category 'combination rules') -----
  partitionedAND: word1 to: word2 nBits: nBits nPartitions: nParts
  "AND word1 to word2 as nParts partitions of nBits each.
  Any field of word1 not all-ones is treated as all-zeroes.
  Used for erasing, eg, brush shapes prior to ORing in a color"
  | mask result |
  <returnTypeC: 'unsigned int'>
  <var: #word1 type: 'unsigned int'>
  <var: #word2 type: 'unsigned int'>
  <var: #result type: 'unsigned int'>
+ <var: #mask type: 'unsigned int'>
  mask := maskTable at: nBits.  "partition mask starts at the right"
  result := 0.
+ nBits = 32
+ ifTrue:
+ [word1 = mask ifTrue: [result := result bitOr: word2]]
+ ifFalse:
+ [1 to: nParts do:
+ [:i |
+ (word1 bitAnd: mask) = mask
+ ifTrue: [result := result bitOr: (word2 bitAnd: mask)].
+ mask := mask << nBits  "slide left to next partition"]].
+ ^ result!
- 1 to: nParts do:
- [:i |
- (word1 bitAnd: mask) = mask
- ifTrue: [result := result bitOr: (word2 bitAnd: mask)].
- mask := mask << nBits  "slide left to next partition"].
- ^ result
- !

Item was changed:
  ----- Method: BitBltSimulation>>partitionedMax:with:nBits:nPartitions: (in category 'combination rules') -----
  partitionedMax: word1 with: word2 nBits: nBits nPartitions: nParts
  "Max word1 to word2 as nParts partitions of nBits each"
  | mask result |
  "In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
  (this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
  words as unsigned int in those cases where comparisions are done (jmv)"
  <returnTypeC: 'unsigned int'>
  <var: #word1 type: 'unsigned int'>
  <var: #word2 type: 'unsigned int'>
  <var: #mask type: 'unsigned int'>
  <var: #result type: 'unsigned int'>
+ nBits = 32
+ ifTrue:
+ [result := word2 max: word1]
+ ifFalse:
+ [result := 0.
+ mask := maskTable at: nBits.  "partition mask starts at the right"
+ 1 to: nParts do:
+ [:i |
+ result := result bitOr: ((word2 bitAnd: mask) max: (word1 bitAnd: mask)).
+ mask := mask << nBits  "slide left to next partition"]].
- mask := maskTable at: nBits.  "partition mask starts at the right"
- result := 0.
- 1 to: nParts do:
- [:i |
- result := result bitOr: ((word2 bitAnd: mask) max: (word1 bitAnd: mask)).
- mask := mask << nBits  "slide left to next partition"].
  ^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>partitionedMin:with:nBits:nPartitions: (in category 'combination rules') -----
  partitionedMin: word1 with: word2 nBits: nBits nPartitions: nParts
  "Min word1 to word2 as nParts partitions of nBits each"
  | mask result |
  "In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
  (this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
  words as unsigned int in those cases where comparisions are done (jmv)"
  <returnTypeC: 'unsigned int'>
  <var: #word1 type: 'unsigned int'>
  <var: #word2 type: 'unsigned int'>
  <var: #mask type: 'unsigned int'>
  <var: #result type: 'unsigned int'>
+ nBits = 32
+ ifTrue:
+ [result := word2 min: word1]
+ ifFalse:
+ [result := 0.
+ mask := maskTable at: nBits.  "partition mask starts at the right"
+ 1 to: nParts do:
+ [:i |
+ result := result bitOr: ((word2 bitAnd: mask) min: (word1 bitAnd: mask)).
+ mask := mask << nBits  "slide left to next partition"]].
- mask := maskTable at: nBits.  "partition mask starts at the right"
- result := 0.
- 1 to: nParts do:
- [:i |
- result := result bitOr: ((word2 bitAnd: mask) min: (word1 bitAnd: mask)).
- mask := mask << nBits  "slide left to next partition"].
  ^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>partitionedSub:from:nBits:nPartitions: (in category 'combination rules') -----
  partitionedSub: word1 from: word2 nBits: nBits nPartitions: nParts
  "Subtract word1 from word2 as nParts partitions of nBits each.
  This is useful for packed pixels, or packed colors"
  | mask result p1 p2 |
  "In C, most arithmetic operations answer the same bit pattern regardless of the operands being signed or unsigned ints
  (this is due to the way 2's complement numbers work). However, comparisions might fail. Add the proper declaration of
  words as unsigned int in those cases where comparisions are done (jmv)"
  <returnTypeC: 'unsigned int'>
  <var: #word1 type: 'unsigned int'>
  <var: #word2 type: 'unsigned int'>
  <var: #p1 type: 'unsigned int'>
  <var: #p2 type: 'unsigned int'>
  <var: #mask type: 'unsigned int'>
  <var: #result type: 'unsigned int'>
+ nBits = 32
+ ifTrue:
+ [result := word1 < word2
+ ifTrue: [word2 - word1]
+ ifFalse: [word1 - word2]]
+ ifFalse:
+ [result := 0.
+ mask := maskTable at: nBits.  "partition mask starts at the right"
+ 1 to: nParts do:
+ [:i |
+ p1 := word1 bitAnd: mask.
+ p2 := word2 bitAnd: mask.
+ p1 < p2  "result is really abs value of thedifference"
+ ifTrue: [result := result bitOr: p2 - p1]
+ ifFalse: [result := result bitOr: p1 - p2].
+ mask := mask << nBits  "slide left to next partition"]].
- mask := maskTable at: nBits.  "partition mask starts at the right"
- result := 0.
- 1 to: nParts do:
- [:i |
- p1 := word1 bitAnd: mask.
- p2 := word2 bitAnd: mask.
- p1 < p2  "result is really abs value of thedifference"
- ifTrue: [result := result bitOr: p2 - p1]
- ifFalse: [result := result bitOr: p1 - p2].
- mask := mask << nBits  "slide left to next partition"].
  ^ result
  !

Item was changed:
  ----- Method: FloatArrayPlugin>>primitiveHashArray (in category 'access primitives') -----
  primitiveHashArray
 
  | rcvr rcvrPtr length result |
  <export: true>
+ <var: #rcvrPtr type: #'unsigned int *'>
+ <var: #result type: #'unsigned int'>
- <var: #rcvrPtr type: #'int *'>
  rcvr := interpreterProxy stackValue: 0.
  (interpreterProxy isWords: rcvr) ifFalse:
  [^interpreterProxy primitiveFail].
  length := interpreterProxy stSizeOf: rcvr.
+ rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'unsigned int *'.
- rcvrPtr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #'int *'.
  result := 0.
  0 to: length-1 do:[:i|
  result := result + (rcvrPtr at: i).
  ].
  interpreterProxy methodReturnInteger: (result bitAnd: 16r1FFFFFFF)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveHashMultiply (in category 'arithmetic integer primitives') -----
  primitiveHashMultiply
  "Implement 28-bit hashMultiply for SmallInteger and LargePositiveInteger receivers."
  | value |
  value := self stackTop.
  (objectMemory isIntegerObject: value)
  ifTrue: [value := objectMemory integerValueOf: value]
  ifFalse:
  [| ok |
  ok := objectMemory is: value instanceOf: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  ok ifFalse:
  [^self primitiveFailFor: PrimErrBadReceiver].
  value := objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: value)].
  self pop: 1
+ thenPush: (objectMemory integerObjectOf: ((self cCoerce: value to: #usqInt) * HashMultiplyConstant bitAnd: 16rFFFFFFF))!
- thenPush: (objectMemory integerObjectOf: (value * HashMultiplyConstant bitAnd: 16rFFFFFFF))!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
  lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory)
  in: aCCodeGenerator.
  self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
  in: aCCodeGenerator.
  aCCodeGenerator
+ var: #lastHash type: #usqInt;
  var: #freeListsMask type: #usqInt;
  var: #freeLists type: #'sqInt *';
  var: #objStackInvalidBecause type: #'char *';
  var: #unscannedEphemerons type: #SpurContiguousObjStack;
  var: #heapGrowthToSizeGCRatio type: #float;
  var: #heapSizeAtPreviousGC type: #usqInt;
  var: #totalFreeOldSpace type: #usqInt;
  var: #maxOldSpaceSize type: #usqInt.
  aCCodeGenerator
  var: #oldSpaceUsePriorToScavenge type: #sqLong.
  aCCodeGenerator
  var: #remapBuffer
  declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  aCCodeGenerator
  var: #extraRoots
  declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!

Item was changed:
  ----- Method: SpurMemoryManager>>newObjectHash (in category 'accessing') -----
  newObjectHash
  "Use a slight variation on D.H. Lehmer's linear congruential generator from 1951.
  See e.g. http://en.wikipedia.org/wiki/Linear_congruential_generator."
  | hash |
+ <var: #hash type: #usqInt>
  [lastHash := self cCode: [lastHash * 16807] "7 raisedTo: 5"
  inSmalltalk: [lastHash := lastHash * 16807 bitAnd: 16rFFFFFFFF].
  hash := lastHash + (lastHash >> 4). "adding the top bits gives much better spread.  See below:"
  (hash bitAnd: self identityHashHalfWordMask) = 0] whileTrue.
  ^hash
 
  "the standard algorithm doesn't vary well in the least significant bits:"
  "| r s n |
  r := 1.
  n := 256 * 256 * 256.
  s := Set new: n * 2.
  n timesRepeat:
  [s add: (r bitAnd: n - 1).
  r := r * 16807 bitAnd: 16rFFFFFFFF].
  { s size. s size / n asFloat. s includes: 0. r hex }
  => #(2097152 0.125 false '16r38000001')"
 
  "this can be improved by adding in shifted upper bits"
  "| r s n |
  r := 1.
  n := 256 * 256 * 256.
  s := Set new: n * 2.
  n timesRepeat:
  [s add: (r + (r bitShift: -8) bitAnd: n - 1).
  r := r * 16807 bitAnd: 16rFFFFFFFF].
  { s size. s size / n asFloat. s includes: 0. r hex }
  => #(10702109 0.637895405292511 false '16r38000001')"
 
 
  "but which shift is best?  Looks like -4:"
  "(-2 to: -15 by: -1) do:
  [:shift|
  | r s n |
  r := 1.
  n := 256 * 256 * 256.
  s := Set new: n * 2.
  n timesRepeat:
  [s add: (r + (r bitShift: shift) bitAnd: n - 1).
  r := r * 16807 bitAnd: 16rFFFFFFFF].
  Transcript cr; print: { shift. s size. s size / n asFloat. s includes: 0. r hex }; flush]
 
  #(-2 8388608 0.5 true '16r38000001')
  #(-3 8388608 0.5 false '16r38000001')
  #(-4 12582503 0.749975621700287 true '16r38000001')
  #(-5 11468379 0.6835686564445495 false '16r38000001')
  #(-6 11013442 0.656452298164368 true '16r38000001')
  #(-7 10804094 0.643974184989929 true '16r38000001')
  #(-8 10702109 0.637895405292511 false '16r38000001')
  #(-9 10703730 0.637992024421692 false '16r38000001')
  #(-10 7865201 0.468802511692047 false '16r38000001')
  #(-11 8444092 0.503307104110718 false '16r38000001')
  #(-12 10703317 0.6379674077034 true '16r38000001')
  #(-13 10701116 0.637836217880249 true '16r38000001')
  #(-14 10689443 0.637140452861786 true '16r38000001')
  #(-15 7853923 0.4681302905082702 true '16r38000001')"!