[squeak-dev] The Trunk: Collections-nice.893.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 10 15:57:27 UTC 2020


Nicolas Cellier uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-nice.893.mcz

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

Name: Collections-nice.893
Author: nice
Time: 10 May 2020, 5:54:50.677168 pm
UUID: 9f481675-6ca8-4a79-af01-3e434e28b429
Ancestors: Collections-nice.892

Create an intermediate abstract level under ArrayedCollection named RawBitsArray for grouping non pointers Arrays and enabling better factorization of some features.

Rename FloatArray -> Float32Array (see preamble of this package) and let FloatArray be the abstract superclass of both Float32Array and Float64Array.

Note: let FloatArray be a factory for creating Float32Array for preserving backward compatibility.

Create asFloat32Array and let asFloatArray default to that.

Move some pre-existing ByteArray, DoubleByteArray, WordArray DoubleWordArray under this hierarchy. For ByteArray, this require some surgery (see postscript of this package).

Create similar SignedByteArray, SignedDoubleByteArray, SignedWordArray, SignedDoubleWordArray for signed integers.

=============== Diff against Collections-nice.892 ===============

Item was added:
+ (PackageInfo named: 'Collections') preamble: '"FloatArray is going to become the abstract class above Float32Array and Float64Array.
+ In order to avoid spurious instance migration or recompilation errors, this preamble is required."
+ 
+ FloatArray rename: #Float32Array.'!

Item was changed:
+ RawBitsArray variableWordSubclass: #ColorArray
- ArrayedCollection variableWordSubclass: #ColorArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
+ 
+ !ColorArray commentStamp: 'nice 5/2/2020 17:11' prior: 0!
+ A ColorArray is an array of colors encoded on 32-bits.
+ 
+ The encoding of colors follows the ARGB scheme.
+ See https://en.wikipedia.org/wiki/RGBA_color_model
+ 
+ The color is decomposed into 4 channels of 8 bits (4 bytes)
+ - the most significant byte A is alpha channel which governs transparency
+   0 means a completely transparent (invisible) color
+   255 means an opaque color.
+ - the second most significant byte R encodes the level of red
+   the lower, the darker and/or least saturated
+ - the third most significant byte G encodes the level of green
+ - the least significant byte B encodes the level of blue
+ 
+ Color white is encoded as 16rFFFFFFFF.
+ 	((ColorArray with: Color white) basicAt: 1) hex.
+ For historical reasons, notice that Color black is encoded as a very dark blue 16rFF000001 rather than 16rFF000000.
+ 	((ColorArray with: Color black) basicAt: 1) hex.
+ Other example of pure red, pure green and pure blue showing the bit position of those channels:
+ 	((ColorArray with: Color red) basicAt: 1) hex.
+ 	((ColorArray with: Color green) basicAt: 1) hex.
+ 	((ColorArray with: Color blue) basicAt: 1) hex.
+ Color transparent is encoded as zero on all channels:
+ 	((ColorArray with: Color transparent) basicAt: 1) hex.!

Item was changed:
+ UnsignedIntegerArray variableDoubleByteSubclass: #DoubleByteArray
- ArrayedCollection variableDoubleByteSubclass: #DoubleByteArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
+ !DoubleByteArray commentStamp: 'nice 5/10/2020 17:31' prior: 0!
+ A DoubleByteArrays store 16-bit unsigned Integer values in the range 0 to 65535.!
- !DoubleByteArray commentStamp: 'nice 10/20/2016 23:23' prior: 0!
- DoubleByteArrays store 16-bit unsigned Integer values.!

Item was removed:
- ----- Method: DoubleByteArray>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0!

Item was removed:
- ----- Method: DoubleByteArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
- replaceFrom: start to: stop with: replacement startingAt: repStart 
- 	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
- 	<primitive: 105>
- 	super replaceFrom: start to: stop with: replacement startingAt: repStart!

Item was changed:
+ UnsignedIntegerArray variableDoubleWordSubclass: #DoubleWordArray
- ArrayedCollection variableDoubleWordSubclass: #DoubleWordArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
+ !DoubleWordArray commentStamp: 'nice 5/10/2020 17:32' prior: 0!
+ A DoubleWordArrays store 64-bit unsigned Integer values.!
- !DoubleWordArray commentStamp: 'nice 9/20/2016 23:37' prior: 0!
- DoubleWordArrays store 64-bit unsigned Integer values.!

Item was removed:
- ----- Method: DoubleWordArray>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0!

Item was removed:
- ----- Method: DoubleWordArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
- replaceFrom: start to: stop with: replacement startingAt: repStart 
- 	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
- 	<primitive: 105>
- 	super replaceFrom: start to: stop with: replacement startingAt: repStart!

Item was added:
+ FloatArray variableWordSubclass: #Float32Array
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !Float32Array commentStamp: 'nice 5/10/2020 17:32' prior: 0!
+ A Float32Array store single precision IEEE 754 (32 bits) floating point numbers.!

Item was added:
+ ----- Method: Float32Array class>>fromFloat64Array: (in category 'instance creation') -----
+ fromFloat64Array: aFloat64Array
+ 	^(self new: aFloat64Array) copyFromFloat64Array: aFloat64Array!

Item was added:
+ ----- Method: Float32Array>>= (in category 'comparing') -----
+ = aFloatArray 
+ 	<primitive: 'primitiveEqual' module: 'FloatArrayPlugin'>
+ 	^super = aFloatArray!

Item was added:
+ ----- Method: Float32Array>>asFloat32Array (in category 'converting') -----
+ asFloat32Array
+ 	^self!

Item was added:
+ ----- Method: Float32Array>>asFloat64Array (in category 'converting') -----
+ asFloat64Array
+ 	^Float64Array fromFloatArray: self!

Item was added:
+ ----- Method: Float32Array>>at: (in category 'accessing') -----
+ at: index
+ 	<primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
+ 	^Float fromIEEE32Bit: (self basicAt: index)!

Item was added:
+ ----- Method: Float32Array>>at:put: (in category 'accessing') -----
+ at: index put: value
+ 	<primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
+ 	value isFloat 
+ 		ifTrue:[self basicAt: index put: value asIEEE32BitWord]
+ 		ifFalse:[self at: index put: value asFloat].
+ 	^value!

Item was added:
+ ----- Method: Float32Array>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 4!

Item was added:
+ ----- Method: Float32Array>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 4!

Item was added:
+ ----- Method: Float32Array>>copyFromFloat64Array: (in category 'initialize-release') -----
+ copyFromFloat64Array: aFloat64Array
+ 	"Destructively replace the elements of self with those of aFloat64Array"
+ 	<primitive: 'primitiveFromFloat64Array' module: 'Float64ArrayPlugin'>
+ 	self isOfSameSizeCheck: aFloat64Array.
+ 	1 to: self size do:[:i| self at: i put: (aFloat64Array at: i)].!

Item was added:
+ ----- Method: Float32Array>>dot: (in category 'arithmetic') -----
+ dot: aFloatVector
+ 	"Primitive. Return the dot product of the receiver and the argument.
+ 	Fail if the argument is not of the same size as the receiver."
+ 
+ 	| result |
+ 	<primitive: 'primitiveDotProduct' module: 'FloatArrayPlugin'>
+ 	self size = aFloatVector size ifFalse:[^self error:'Must be equal size'].
+ 	result := 0.0.
+ 	1 to: self size do:[:i|
+ 		result := result + ((self at: i) * (aFloatVector at: i)).
+ 	].
+ 	^result!

Item was added:
+ ----- Method: Float32Array>>hash (in category 'comparing') -----
+ hash
+ 	| result |
+ 	<primitive:'primitiveHashArray' module: 'FloatArrayPlugin'>
+ 	result := 0.
+ 	1 to: self size do:[:i| result := result + (self basicAt: i) ].
+ 	^result bitAnd: 16r1FFFFFFF!

Item was added:
+ ----- Method: Float32Array>>normalize (in category 'arithmetic') -----
+ normalize
+ 	"Unsafely normalize the receiver in-place (become a unit vector).
+  	 Div-by-Zero raised if len 0."
+ 	<primitive: 'primitiveNormalize' module: 'FloatArrayPlugin'>
+ 	self /= self length.!

Item was added:
+ ----- Method: Float32Array>>primAddArray: (in category 'primitives-plugin') -----
+ primAddArray: floatArray
+ 
+ 	<primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'>
+ 	self isOfSameSizeCheck: floatArray.
+ 	1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].!

Item was added:
+ ----- Method: Float32Array>>primAddScalar: (in category 'primitives-plugin') -----
+ primAddScalar: scalarValue
+ 
+ 	<primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'>
+ 	1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].!

Item was added:
+ ----- Method: Float32Array>>primDivArray: (in category 'primitives-plugin') -----
+ primDivArray: floatArray
+ 
+ 	<primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'>
+ 	self isOfSameSizeCheck: floatArray.
+ 	1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].!

Item was added:
+ ----- Method: Float32Array>>primDivScalar: (in category 'primitives-plugin') -----
+ primDivScalar: scalarValue
+ 
+ 	<primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'>
+ 	1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].!

Item was added:
+ ----- Method: Float32Array>>primMulArray: (in category 'primitives-plugin') -----
+ primMulArray: floatArray
+ 
+ 	<primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'>
+ 	self isOfSameSizeCheck: floatArray.
+ 	1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].!

Item was added:
+ ----- Method: Float32Array>>primMulScalar: (in category 'primitives-plugin') -----
+ primMulScalar: scalarValue
+ 
+ 	<primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'>
+ 	1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].!

Item was added:
+ ----- Method: Float32Array>>primSubArray: (in category 'primitives-plugin') -----
+ primSubArray: floatArray
+ 
+ 	<primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'>
+ 	self isOfSameSizeCheck: floatArray.
+ 	1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].!

Item was added:
+ ----- Method: Float32Array>>primSubScalar: (in category 'primitives-plugin') -----
+ primSubScalar: scalarValue
+ 
+ 	<primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'>
+ 	1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].!

Item was added:
+ ----- Method: Float32Array>>sum (in category 'primitives-plugin') -----
+ sum
+ 
+ 	<primitive: 'primitiveSum' module: 'FloatArrayPlugin'>
+ 	^ super sum!

Item was changed:
+ FloatArray variableDoubleWordSubclass: #Float64Array
- ArrayedCollection variableDoubleWordSubclass: #Float64Array
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
+ !Float64Array commentStamp: 'nice 5/10/2020 17:33' prior: 0!
+ A Float64Array store double precision IEEE 754 (64 bits) floating point numbers.!
- !Float64Array commentStamp: '<historical>' prior: 0!
- Float64Arrays store 64bit IEEE floating point numbers.!

Item was removed:
- ----- Method: Float64Array>>* (in category 'arithmetic') -----
- * anObject
- 
- 	^self shallowCopy *= anObject!

Item was removed:
- ----- Method: Float64Array>>*= (in category 'arithmetic') -----
- *= anObject
- 	^anObject isNumber
- 		ifTrue:[self primMulScalar: anObject asFloat]
- 		ifFalse:[self primMulArray: anObject]!

Item was removed:
- ----- Method: Float64Array>>+ (in category 'arithmetic') -----
- + anObject
- 
- 	^self shallowCopy += anObject!

Item was removed:
- ----- Method: Float64Array>>+= (in category 'arithmetic') -----
- += anObject
- 	^anObject isNumber
- 		ifTrue:[self primAddScalar: anObject asFloat]
- 		ifFalse:[self primAddArray: anObject]!

Item was removed:
- ----- Method: Float64Array>>- (in category 'arithmetic') -----
- - anObject
- 
- 	^self shallowCopy -= anObject!

Item was removed:
- ----- Method: Float64Array>>-= (in category 'arithmetic') -----
- -= anObject
- 	^anObject isNumber
- 		ifTrue:[self primSubScalar: anObject asFloat]
- 		ifFalse:[self primSubArray: anObject]!

Item was removed:
- ----- Method: Float64Array>>/ (in category 'arithmetic') -----
- / anObject
- 
- 	^self shallowCopy /= anObject!

Item was removed:
- ----- Method: Float64Array>>/= (in category 'arithmetic') -----
- /= anObject
- 	^anObject isNumber
- 		ifTrue:[self primDivScalar: anObject asFloat]
- 		ifFalse:[self primDivArray: anObject]!

Item was removed:
- ----- Method: Float64Array>>\\= (in category 'arithmetic') -----
- \\= other
- 
- 	other isNumber ifTrue: [
- 		1 to: self size do: [:i |
- 			self at: i put: (self at: i) \\ other
- 		].
- 		^ self.
- 	].
- 	1 to: (self size min: other size) do: [:i |
- 		self at: i put: (self at: i) \\ (other at: i).
- 	].
- 
- !

Item was removed:
- ----- Method: Float64Array>>adaptToNumber:andSend: (in category 'arithmetic') -----
- adaptToNumber: rcvr andSend: selector
- 	"If I am involved in arithmetic with a Number. If possible,
- 	convert it to a float and perform the (more efficient) primitive operation."
- 	selector == #+ ifTrue:[^self + rcvr].
- 	selector == #* ifTrue:[^self * rcvr].
- 	selector == #- ifTrue:[^self negated += rcvr].
- 	selector == #/ ifTrue:[
- 		"DO NOT USE TRIVIAL CODE
- 			^self reciprocal * rcvr
- 		BECAUSE OF GRADUAL UNDERFLOW
- 		self should: (1.0e-39 / (Float64Array with: 1.0e-39)) first < 2."
- 			^(self class new: self size withAll: rcvr) / self
- 		].
- 	^super adaptToNumber: rcvr andSend: selector!

Item was added:
+ ----- Method: Float64Array>>asFloat32Array (in category 'converting') -----
+ asFloat32Array
+ 	^Float32Array fromFloat64Array: self!

Item was removed:
- ----- Method: Float64Array>>asFloatArray (in category 'converting') -----
- asFloatArray
- 	^FloatArray fromFloat64Array: self!

Item was added:
+ ----- Method: Float64Array>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 8!

Item was added:
+ ----- Method: Float64Array>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 8!

Item was removed:
- ----- Method: Float64Array>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0.0!

Item was removed:
- ----- Method: Float64Array>>length (in category 'accessing') -----
- length
- 	"Return the length of the receiver"
- 	^self squaredLength sqrt!

Item was removed:
- ----- Method: Float64Array>>negated (in category 'arithmetic') -----
- negated
- 
- 	^self shallowCopy *= -1!

Item was removed:
- ----- Method: Float64Array>>replaceFrom:to:with:startingAt: (in category 'private') -----
- replaceFrom: start to: stop with: replacement startingAt: repStart 
- 	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
- 	<primitive: 105>
- 	super replaceFrom: start to: stop with: replacement startingAt: repStart!

Item was removed:
- ----- Method: Float64Array>>squaredLength (in category 'accessing') -----
- squaredLength
- 	"Return the squared length of the receiver"
- 	^self dot: self!

Item was changed:
+ RawBitsArray subclass: #FloatArray
- ArrayedCollection variableWordSubclass: #FloatArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
+ !FloatArray commentStamp: 'nice 5/10/2020 16:57' prior: 0!
+ FloatArray is an abstract class for representing arrays of floating point values of some given precision.
+ Subclasses notably provide support for IEEE 754 single precision (32bits) and double precision (64) floats.
+ !
- !FloatArray commentStamp: '<historical>' prior: 0!
- FloatArrays store 32bit IEEE floating point numbers.!

Item was added:
+ ----- Method: FloatArray class>>basicNew: (in category 'instance creation') -----
+ basicNew: anInteger
+ 	"For backward compatibility, create a 32bits FloatArray"
+ 	
+ 	self == FloatArray
+ 		ifTrue: [^Float32Array basicNew: anInteger].
+ 	^super basicNew: anInteger!

Item was removed:
- ----- Method: FloatArray class>>fromFloat64Array: (in category 'instance creation') -----
- fromFloat64Array: aFloat64Array
- 	^(self new: aFloat64Array) copyFromFloat64Array: aFloat64Array!

Item was changed:
  ----- Method: FloatArray>>* (in category 'arithmetic') -----
  * anObject
  
  	^self shallowCopy *= anObject!

Item was changed:
  ----- Method: FloatArray>>*= (in category 'arithmetic') -----
  *= anObject
  	^anObject isNumber
  		ifTrue:[self primMulScalar: anObject asFloat]
  		ifFalse:[self primMulArray: anObject]!

Item was changed:
  ----- Method: FloatArray>>+ (in category 'arithmetic') -----
  + anObject
  
  	^self shallowCopy += anObject!

Item was changed:
  ----- Method: FloatArray>>+= (in category 'arithmetic') -----
  += anObject
  	^anObject isNumber
  		ifTrue:[self primAddScalar: anObject asFloat]
  		ifFalse:[self primAddArray: anObject]!

Item was changed:
  ----- Method: FloatArray>>- (in category 'arithmetic') -----
  - anObject
  
  	^self shallowCopy -= anObject!

Item was changed:
  ----- Method: FloatArray>>-= (in category 'arithmetic') -----
  -= anObject
  	^anObject isNumber
  		ifTrue:[self primSubScalar: anObject asFloat]
  		ifFalse:[self primSubArray: anObject]!

Item was changed:
  ----- Method: FloatArray>>/ (in category 'arithmetic') -----
  / anObject
  
  	^self shallowCopy /= anObject!

Item was changed:
  ----- Method: FloatArray>>/= (in category 'arithmetic') -----
  /= anObject
  	^anObject isNumber
  		ifTrue:[self primDivScalar: anObject asFloat]
  		ifFalse:[self primDivArray: anObject]!

Item was removed:
- ----- Method: FloatArray>>= (in category 'comparing') -----
- = aFloatArray 
- 	<primitive: 'primitiveEqual' module: 'FloatArrayPlugin'>
- 	^super = aFloatArray!

Item was changed:
  ----- Method: FloatArray>>\\= (in category 'arithmetic') -----
  \\= other
  
  	other isNumber ifTrue: [
  		1 to: self size do: [:i |
  			self at: i put: (self at: i) \\ other
  		].
  		^ self.
  	].
  	1 to: (self size min: other size) do: [:i |
  		self at: i put: (self at: i) \\ (other at: i).
  	].
  
  !

Item was changed:
  ----- Method: FloatArray>>adaptToNumber:andSend: (in category 'arithmetic') -----
  adaptToNumber: rcvr andSend: selector
  	"If I am involved in arithmetic with a Number. If possible,
  	convert it to a float and perform the (more efficient) primitive operation."
  	selector == #+ ifTrue:[^self + rcvr].
  	selector == #* ifTrue:[^self * rcvr].
  	selector == #- ifTrue:[^self negated += rcvr].
  	selector == #/ ifTrue:[
  		"DO NOT USE TRIVIAL CODE
  			^self reciprocal * rcvr
  		BECAUSE OF GRADUAL UNDERFLOW
  		self should: (1.0e-39 / (FloatArray with: 1.0e-39)) first < 2."
  			^(self class new: self size withAll: rcvr) / self
  		].
  	^super adaptToNumber: rcvr andSend: selector!

Item was removed:
- ----- Method: FloatArray>>asFloat64Array (in category 'converting') -----
- asFloat64Array
- 	^Float64Array fromFloatArray: self!

Item was changed:
  ----- Method: FloatArray>>asFloatArray (in category 'converting') -----
  asFloatArray
  	^self!

Item was removed:
- ----- Method: FloatArray>>at: (in category 'accessing') -----
- at: index
- 	<primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
- 	^Float fromIEEE32Bit: (self basicAt: index)!

Item was removed:
- ----- Method: FloatArray>>at:put: (in category 'accessing') -----
- at: index put: value
- 	<primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
- 	value isFloat 
- 		ifTrue:[self basicAt: index put: value asIEEE32BitWord]
- 		ifFalse:[self at: index put: value asFloat].
- 	^value!

Item was removed:
- ----- Method: FloatArray>>copyFromFloat64Array: (in category 'initialize-release') -----
- copyFromFloat64Array: aFloat64Array
- 	"Destructively replace the elements of self with those of aFloat64Array"
- 	<primitive: 'primitiveFromFloat64Array' module: 'Float64ArrayPlugin'>
- 	self isOfSameSizeCheck: aFloat64Array.
- 	1 to: self size do:[:i| self at: i put: (aFloat64Array at: i)].!

Item was changed:
  ----- Method: FloatArray>>defaultElement (in category 'accessing') -----
  defaultElement
  	"Return the default element of the receiver"
  	^0.0!

Item was removed:
- ----- Method: FloatArray>>dot: (in category 'arithmetic') -----
- dot: aFloatVector
- 	"Primitive. Return the dot product of the receiver and the argument.
- 	Fail if the argument is not of the same size as the receiver."
- 
- 	| result |
- 	<primitive: 'primitiveDotProduct' module: 'FloatArrayPlugin'>
- 	self size = aFloatVector size ifFalse:[^self error:'Must be equal size'].
- 	result := 0.0.
- 	1 to: self size do:[:i|
- 		result := result + ((self at: i) * (aFloatVector at: i)).
- 	].
- 	^result!

Item was removed:
- ----- Method: FloatArray>>hash (in category 'comparing') -----
- hash
- 	| result |
- 	<primitive:'primitiveHashArray' module: 'FloatArrayPlugin'>
- 	result := 0.
- 	1 to: self size do:[:i| result := result + (self basicAt: i) ].
- 	^result bitAnd: 16r1FFFFFFF!

Item was changed:
  ----- Method: FloatArray>>length (in category 'accessing') -----
  length
  	"Return the length of the receiver"
  	^self squaredLength sqrt!

Item was changed:
  ----- Method: FloatArray>>negated (in category 'arithmetic') -----
  negated
  
  	^self shallowCopy *= -1!

Item was removed:
- ----- Method: FloatArray>>normalize (in category 'arithmetic') -----
- normalize
- 	"Unsafely normalize the receiver in-place (become a unit vector).
-  	 Div-by-Zero raised if len 0."
- 	<primitive: 'primitiveNormalize' module: 'FloatArrayPlugin'>
- 	self /= self length.!

Item was removed:
- ----- Method: FloatArray>>primAddArray: (in category 'primitives-plugin') -----
- primAddArray: floatArray
- 
- 	<primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'>
- 	self isOfSameSizeCheck: floatArray.
- 	1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].!

Item was removed:
- ----- Method: FloatArray>>primAddScalar: (in category 'primitives-plugin') -----
- primAddScalar: scalarValue
- 
- 	<primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'>
- 	1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].!

Item was removed:
- ----- Method: FloatArray>>primDivArray: (in category 'primitives-plugin') -----
- primDivArray: floatArray
- 
- 	<primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'>
- 	self isOfSameSizeCheck: floatArray.
- 	1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].!

Item was removed:
- ----- Method: FloatArray>>primDivScalar: (in category 'primitives-plugin') -----
- primDivScalar: scalarValue
- 
- 	<primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'>
- 	1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].!

Item was removed:
- ----- Method: FloatArray>>primMulArray: (in category 'primitives-plugin') -----
- primMulArray: floatArray
- 
- 	<primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'>
- 	self isOfSameSizeCheck: floatArray.
- 	1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].!

Item was removed:
- ----- Method: FloatArray>>primMulScalar: (in category 'primitives-plugin') -----
- primMulScalar: scalarValue
- 
- 	<primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'>
- 	1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].!

Item was removed:
- ----- Method: FloatArray>>primSubArray: (in category 'primitives-plugin') -----
- primSubArray: floatArray
- 
- 	<primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'>
- 	self isOfSameSizeCheck: floatArray.
- 	1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].!

Item was removed:
- ----- Method: FloatArray>>primSubScalar: (in category 'primitives-plugin') -----
- primSubScalar: scalarValue
- 
- 	<primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'>
- 	1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].!

Item was changed:
  ----- Method: FloatArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
  replaceFrom: start to: stop with: replacement startingAt: repStart 
  	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
  	<primitive: 105>
  	super replaceFrom: start to: stop with: replacement startingAt: repStart!

Item was changed:
  ----- Method: FloatArray>>squaredLength (in category 'accessing') -----
  squaredLength
  	"Return the squared length of the receiver"
  	^self dot: self!

Item was removed:
- ----- Method: FloatArray>>sum (in category 'primitives-plugin') -----
- sum
- 
- 	<primitive: 'primitiveSum' module: 'FloatArrayPlugin'>
- 	^ super sum!

Item was changed:
  ----- Method: FloatCollection class>>arrayType (in category 'private') -----
  arrayType
+ 	^ Float32Array!
- 	^ FloatArray!

Item was added:
+ ----- Method: FloatCollection>>asFloat32Array (in category 'converting') -----
+ asFloat32Array
+ 	"Optimized version"
+ 
+ 	^array copyFrom: firstIndex to: lastIndex!

Item was removed:
- ----- Method: FloatCollection>>asFloatArray (in category 'converting') -----
- asFloatArray
- 	"Optimized version"
- 
- 	^array copyFrom: firstIndex to: lastIndex!

Item was changed:
+ SignedWordArray variableWordSubclass: #IntegerArray
- ArrayedCollection variableWordSubclass: #IntegerArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !IntegerArray commentStamp: '<historical>' prior: 0!
  IntegerArrays store 32bit signed Integer values.
  Negative values are stored as 2's complement.!

Item was removed:
- ----- Method: IntegerArray>>at: (in category 'accessing') -----
- at: index
- 	| word |
- 	<primitive: 165>
- 	word := self basicAt: index.
- 	word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations"
- 	^word >= 16r80000000	"Negative?!!"
- 		ifTrue:["word - 16r100000000"
- 				(word bitInvert32 + 1) negated]
- 		ifFalse:[word]!

Item was removed:
- ----- Method: IntegerArray>>at:put: (in category 'accessing') -----
- at: index put: anInteger
- 	| word |
- 	<primitive: 166>
- 	anInteger < 0
- 		ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range'].
- 				"word := 16r100000000 + anInteger"
- 				word := (anInteger + 1) negated bitInvert32]
- 		ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
- 				word := anInteger].
- 	self  basicAt: index put: word.
- 	^anInteger!

Item was removed:
- ----- Method: IntegerArray>>atAllPut: (in category 'accessing') -----
- atAllPut: anInteger
- 	| word |
- 	anInteger < 0
- 		ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range'].
- 				"word := 16r100000000 + anInteger"
- 				word := (anInteger + 1) negated bitInvert32]
- 		ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
- 				word := anInteger].
- 	self primFill: word.!

Item was removed:
- ----- Method: IntegerArray>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0!

Item was removed:
- ----- Method: IntegerArray>>primFill: (in category 'private') -----
- primFill: aPositiveInteger
- 	"Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."
- 
- 	<primitive: 145>
- 	self errorImproperStore.!

Item was added:
+ ----- Method: Matrix>>asFloat32Array (in category 'converting') -----
+ asFloat32Array
+ 	^contents asFloat32Array!

Item was removed:
- ----- Method: Matrix>>asFloatArray (in category 'converting') -----
- asFloatArray
- 	^contents asFloatArray!

Item was added:
+ ArrayedCollection subclass: #RawBitsArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !RawBitsArray commentStamp: 'nice 5/10/2020 16:48' prior: 0!
+ RawBitsArray is an abstract superclass for all arrays whose elements are not stored as pointer but as raw bits of fixed-width.
+ See Behavior>>#isBits.
+ Currently, SpurVM supports arrays of elements with a bit-width of 8, 16, 32, or 64 bits.
+ When accessing a specific element with #basicAt: or #basicAt:put:, the bits are exchanged under the form of an unsigned Integer.
+ The range of such integer must be between 0 and 2**bitWidth-1.
+ 
+ The subclasses are free to re-interpret those bits as more specialized Objects.
+ Unless they represent unisgned Integers, they shall define at least two methods:
+ - #at:put: should take an object as argument and encode it into raw bits (an unsigned Integer no longer than expected bit-width)
+ - #at: should convert the raw bits into an Object
+ Note that SpurVM supports conversion to/from signed integer via primitives 165 and 166.
+ 
+ The name of subclasses is historical and constrained by backward compatibility.!

Item was added:
+ ----- Method: RawBitsArray>>atAllPut: (in category 'accessing') -----
+ atAllPut: anObject
+ 	self isEmpty ifTrue: [^self].
+ 	"Note: #primFill: (primitiveConstantFill) does only handle unsigned integer.
+ 	Let at:put: take care of properly encoding anObject as bits"
+ 	self at: 1 put: anObject.
+ 	self primFill: (self basicAt: 1)!

Item was added:
+ ----- Method: RawBitsArray>>primFill: (in category 'private') -----
+ primFill: aPositiveInteger
+ 	"Fill the receiver, an indexable bytes or words object, with the given positive integer.
+ 	The range of possible fill values is :
+ 	- [0..255] for byte arrays;
+ 	- [0..65535] for double byte arrays;
+ 	- [0..(2^32 - 1)] for word arrays;
+ 	- [0..(2^64 - 1)] for double word arrays."
+ 
+ 	<primitive: 145>
+ 	self errorImproperStore.!

Item was added:
+ ----- Method: SequenceableCollection>>asFloa32tArray (in category 'converting') -----
+ asFloa32tArray
+ 	"Answer a Float32Array whose elements are the elements of the receiver, in 
+ 	the same order."
+ 
+ 	| floatArray |
+ 	floatArray := Float32Array new: self size.
+ 	1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
+ 	^floatArray!

Item was added:
+ ----- Method: SequenceableCollection>>asFloat32Array (in category 'converting') -----
+ asFloat32Array
+ 	"Answer a Float32Array whose elements are the elements of the receiver, in 
+ 	the same order."
+ 
+ 	| floatArray |
+ 	floatArray := Float32Array new: self size.
+ 	1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
+ 	^floatArray!

Item was added:
+ ----- Method: SequenceableCollection>>asFloat64Array (in category 'converting') -----
+ asFloat64Array
+ 	"Answer a Float64Array whose elements are the elements of the receiver, in 
+ 	the same order."
+ 
+ 	| floatArray |
+ 	floatArray := Float64Array new: self size.
+ 	1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
+ 	^floatArray!

Item was changed:
  ----- Method: SequenceableCollection>>asFloatArray (in category 'converting') -----
  asFloatArray
+ 	"For backward compatibility, answer a 32 bits FloatArray"
- 	"Answer a FloatArray whose elements are the elements of the receiver, in 
- 	the same order."
  
+ 	^self asFloat32Array!
- 	| floatArray |
- 	floatArray := FloatArray new: self size.
- 	1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
- 	^floatArray!

Item was added:
+ SignedIntegerArray variableByteSubclass: #SignedByteArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedByteArray commentStamp: 'nice 5/10/2020 17:21' prior: 0!
+ A SignedByteArray store 8bit signed Integer values in the range -128 to 127.
+ Negative values are stored as 2's complement.!

Item was added:
+ ----- Method: SignedByteArray>>at: (in category 'accessing') -----
+ at: index
+ 	| word |
+ 	<primitive: 165>
+ 	word := self basicAt: index.
+ 	^word >= 16r80	"Negative?!!"
+ 		ifTrue:[16r100 - word]
+ 		ifFalse:[word]!

Item was added:
+ ----- Method: SignedByteArray>>at:put: (in category 'accessing') -----
+ at: index put: anInteger
+ 	| byte |
+ 	<primitive: 166>
+ 	anInteger < 0
+ 		ifTrue:
+ 			[anInteger < -16r80 ifTrue: [self error: anInteger asString , ' out of range'].
+ 			 byte := 16r100 + anInteger]
+ 		ifFalse:
+ 			[anInteger > 16r7F ifTrue: [self error: anInteger asString , ' out of range'].
+ 			 byte := anInteger].
+ 	self  basicAt: index put: byte.
+ 	^anInteger!

Item was added:
+ ----- Method: SignedByteArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size!

Item was added:
+ ----- Method: SignedByteArray>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 1!

Item was added:
+ SignedIntegerArray variableDoubleByteSubclass: #SignedDoubleByteArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedDoubleByteArray commentStamp: 'nice 5/10/2020 17:21' prior: 0!
+ A SignedDoubleByteArray store 16bit signed Integer values  in the range -32766 to 32765.
+ Negative values are stored as 2's complement.!

Item was added:
+ ----- Method: SignedDoubleByteArray>>at: (in category 'accessing') -----
+ at: index
+ 	| word |
+ 	<primitive: 165>
+ 	word := self basicAt: index.
+ 	^word >= 16r8000	"Negative?!!"
+ 		ifTrue:[16r10000 - word]
+ 		ifFalse:[word]!

Item was added:
+ ----- Method: SignedDoubleByteArray>>at:put: (in category 'accessing') -----
+ at: index put: anInteger
+ 	| byte |
+ 	<primitive: 166>
+ 	anInteger < 0
+ 		ifTrue:
+ 			[anInteger < -16r8000 ifTrue: [self error: anInteger asString , ' out of range'].
+ 			 byte := 16r10000 + anInteger]
+ 		ifFalse:
+ 			[anInteger > 16r7FFF ifTrue: [self error: anInteger asString , ' out of range'].
+ 			 byte := anInteger].
+ 	self  basicAt: index put: byte.
+ 	^anInteger!

Item was added:
+ ----- Method: SignedDoubleByteArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 2!

Item was added:
+ ----- Method: SignedDoubleByteArray>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 2!

Item was added:
+ SignedIntegerArray variableDoubleWordSubclass: #SignedDoubleWordArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedDoubleWordArray commentStamp: 'nice 5/10/2020 17:30' prior: 0!
+ A SignedDoubleWordArray store 64bit signed Integer values in the range (1<<63)negated (-9,223,372,036,854,775,808) to (1<<63-1) (9,223,372,036,854,775,807) - that is about 9 US-quintillon (10**3**(5+1)*9), or 9 british-trillion (10**6**3*9).
+ Negative values are stored as 2's complement.!

Item was added:
+ ----- Method: SignedDoubleWordArray>>at: (in category 'accessing') -----
+ at: index
+ 	| word64 |
+ 	<primitive: 165>
+ 	word64 := self basicAt: index.
+ 	word64 < SmallInteger maxVal ifTrue:[^word64]. "Avoid LargeInteger computations"
+ 	^word64 >= 16r8000000000000000	"Negative?!!"
+ 		ifTrue: ["word64 - 16r10000000000000000"
+ 			  (word64 bitInvert64 + 1) negated]
+ 		ifFalse: [word64]!

Item was added:
+ ----- Method: SignedDoubleWordArray>>at:put: (in category 'accessing') -----
+ at: index put: anInteger
+ 	| word64 |
+ 	<primitive: 166>
+ 	anInteger < 0
+ 		ifTrue:
+ 			[anInteger < -16r8000000000000000 ifTrue: [self error: anInteger asString , ' out of range'].
+ 			"word64 := 16r10000000000000000 + anInteger"
+ 			word64 := (anInteger + 1) negated bitInvert64]
+ 		ifFalse:
+ 			[anInteger > 16r7FFFFFFFFFFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
+ 			word64 := anInteger].
+ 	self  basicAt: index put: word64.
+ 	^anInteger!

Item was added:
+ ----- Method: SignedDoubleWordArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 8!

Item was added:
+ ----- Method: SignedDoubleWordArray>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 8!

Item was added:
+ RawBitsArray subclass: #SignedIntegerArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0!
+ SignedIntegerArray is an abstract class for all arrays of signed integer of fixed bit-width.!

Item was added:
+ ----- Method: SignedIntegerArray>>defaultElement (in category 'accessing') -----
+ defaultElement
+ 	"Return the default element of the receiver"
+ 	^0!

Item was added:
+ SignedIntegerArray variableWordSubclass: #SignedWordArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedWordArray commentStamp: 'nice 5/10/2020 17:22' prior: 0!
+ A SignedWordArray store 64bit signed Integer values in the range -16r80000000 (-2,147,483,648) to 16r7FFFFFFF (2,147,483,647)
+ Negative values are stored as 2's complement.!

Item was added:
+ ----- Method: SignedWordArray>>at: (in category 'accessing') -----
+ at: index
+ 	| word |
+ 	<primitive: 165>
+ 	word := self basicAt: index.
+ 	word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations"
+ 	^word >= 16r80000000	"Negative?!!"
+ 		ifTrue:["word - 16r100000000"
+ 				(word bitInvert32 + 1) negated]
+ 		ifFalse:[word]!

Item was added:
+ ----- Method: SignedWordArray>>at:put: (in category 'accessing') -----
+ at: index put: anInteger
+ 	| word |
+ 	<primitive: 166>
+ 	anInteger < 0
+ 		ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range'].
+ 				"word := 16r100000000 + anInteger"
+ 				word := (anInteger + 1) negated bitInvert32]
+ 		ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
+ 				word := anInteger].
+ 	self  basicAt: index put: word.
+ 	^anInteger!

Item was added:
+ ----- Method: SignedWordArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 4!

Item was added:
+ ----- Method: SignedWordArray>>bytesPerElement (in category 'accessing') -----
+ bytesPerElement
+ 	"Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
+ 	^ 4!

Item was added:
+ RawBitsArray subclass: #UnsignedIntegerArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !UnsignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0!
+ UnsignedIntegerArray is an abstract class for all arrays of unsigned integer of fixed bit-width.
+ 
+ !

Item was added:
+ ----- Method: UnsignedIntegerArray>>atAllPut: (in category 'accessing') -----
+ atAllPut: value
+ 	"Fill the receiver with the given value"
+ 
+ 	<primitive: 145>
+ 	super atAllPut: value!

Item was added:
+ ----- Method: UnsignedIntegerArray>>defaultElement (in category 'accessing') -----
+ defaultElement
+ 	"Return the default element of the receiver"
+ 	^0!

Item was added:
+ ----- Method: UnsignedIntegerArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
+ replaceFrom: start to: stop with: replacement startingAt: repStart 
+ 	<primitive: 105>
+ 	^super replaceFrom: start to: stop with: replacement startingAt: repStart !

Item was changed:
+ UnsignedIntegerArray variableWordSubclass: #WordArray
- ArrayedCollection variableWordSubclass: #WordArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !WordArray commentStamp: '<historical>' prior: 0!
  WordArrays store 32-bit unsigned Integer values.
  !

Item was removed:
- ----- Method: WordArray>>atAllPut: (in category 'accessing') -----
- atAllPut: value
- 	"Fill the receiver with the given value"
- 
- 	<primitive: 145>
- 	super atAllPut: value!

Item was removed:
- ----- Method: WordArray>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0!

Item was removed:
- ----- Method: WordArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
- replaceFrom: start to: stop with: replacement startingAt: repStart 
- 	<primitive: 105>
- 	^super replaceFrom: start to: stop with: replacement startingAt: repStart !

Item was changed:
+ (PackageInfo named: 'Collections') postscript: '"Gently move ByteArray down the hierarchy.
+ Since neither the format, nor the layout does change, there is no need to create a new class, nor to migrate the instances/subinstances.
+ ClassBuilder would do too much work and would prevent us to change such basic and dangerous classes (notably, CompiledCode is a subclass of ByteArray)."
- (PackageInfo named: 'Collections') postscript: '"below, add code to be run after the loading of this package"
  
+ ByteArray superclass removeSubclass: ByteArray.
+ ByteArray superclass: UnsignedIntegerArray.
+ ByteArray class superclass: UnsignedIntegerArray class.
+ UnsignedIntegerArray addSubclass: ByteArray.
+ '!
- "Make all Symbols read-only at the VM level"
- Symbol allSubInstancesDo: [:s| s beReadOnlyObject]'!




More information about the Squeak-dev mailing list