[squeak-dev] The Inbox: Collections-nice.891.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 2 17:41:43 UTC 2020


Nicolas Cellier uploaded a new version of Collections to project The Inbox:
http://source.squeak.org/inbox/Collections-nice.891.mcz

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

Name: Collections-nice.891
Author: nice
Time: 2 May 2020, 7:40:45.298967 pm
UUID: 08510be0-8293-6744-959d-c1d41bc13ae1
Ancestors: Collections-nice.890

Experimental - For discussion

Group some (most) non-pointers collections under an abstract FixedBitWifthArray.
I know, the name is hard to pronounce and thus ugly: it's opened to discussion.

This enables factorization of some methods, for example the trick for atAllPut:
Also notice that most methods are shared between FloatArray and Float64Array.

Introduce SignedByteArray and Long64Array.
These are the only two missing in the panoply.
The heterogeneity of names generally sucks, but we won't change the ByteArray nor WordArray, so probably neither the DoubleByte and DoubleWord Arrays, it follows a legacy-compatible logic.
But for the 32 and 16 bits signed versions, we already have IntegerArray and ShortIntegerArray... What a mess.

We could use better names in the abstract levels too: 
For example SignedIntegerArray instead of FixedBitWidthSignedIntegerArray.
Also we could let FloatArray be the abstract class rather than FixedBitWidthFloatArray.
It would be a factory for Float32Array so as to preserve backward compatiblity.

Note that Balloon ShortIntegerArray is currently word rather than doubleByte and should be mutated and moved into this collection. However, it's not easy to mutate because it has both a subclass and instances. We can handle that surgery later.

We can neither easily move ByteArray thru the hierarchy: it is protected because of the fear to break CompiledMethod. Another surgical operation, outside of this proof of concept.

One thing I don't know is the cost of extending intermediate hierachical levels with respect to lookup of message selector. Is it a problem?

While at it, document the internal format of ColorArray.
I hope it's consistent across VMs/platforms/endianness... If it's not, the comment SHALL tell so, that's the least I expect of serious software. I don't know why squeakers are so spare of comments...
Since those classes are good candidates for exchanging data with foreign functions, it's vital to have a minimum of documentation.

=============== Diff against Collections-nice.890 ===============

Item was changed:
+ FixedBitWidthArray 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:
+ FixedBitWidthUnsignedIntegerArray variableDoubleByteSubclass: #DoubleByteArray
- ArrayedCollection variableDoubleByteSubclass: #DoubleByteArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !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:
+ FixedBitWidthUnsignedIntegerArray variableDoubleWordSubclass: #DoubleWordArray
- ArrayedCollection variableDoubleWordSubclass: #DoubleWordArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !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:
+ ArrayedCollection subclass: #FixedBitWidthArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !FixedBitWidthArray commentStamp: 'nice 5/2/2020 18:58' prior: 0!
+ A FixedBitWidthArray is an abstract superclass for all arrays whose elements are not stored as pointer but as raw bits of fixed-width.
+ 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 (which translates as 1<<bitWidth-1).
+ 
+ The subclasses are free to re-interpret those bits as more specialized Objects and shall provide convenient #at: and #at:put: protocol for exchanging those objects rather than raw bit-encoding.
+ For example, there is support for Signed Integers of different width, IEEE 754 32bits and 64bits Float, 32 bits Colors, etc...
+ 
+ It is the subclass responsibility to encode those objects as raw bits (an Integer), and decode the raw bits (an Integer) as an object.
+ Note however that SpurVM supports conversion to/from signed integer.
+ 
+ The name of subclasses is historical and constrained by backward compatibility.!

Item was added:
+ ----- Method: FixedBitWidthArray>>atAllPut: (in category 'accessing') -----
+ atAllPut: anObject
+ 	self isEmpty ifTrue: [^self].
+ 	"Note: 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: FixedBitWidthArray>>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:
+ FixedBitWidthArray subclass: #FixedBitWidthFloatArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!

Item was added:
+ ----- Method: FixedBitWidthFloatArray>>* (in category 'arithmetic') -----
+ * anObject
+ 
+ 	^self shallowCopy *= anObject!

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

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

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

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

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

Item was added:
+ ----- Method: FixedBitWidthFloatArray>>/ (in category 'arithmetic') -----
+ / anObject
+ 
+ 	^self shallowCopy /= anObject!

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

Item was added:
+ ----- Method: FixedBitWidthFloatArray>>\\= (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 added:
+ ----- Method: FixedBitWidthFloatArray>>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 added:
+ ----- Method: FixedBitWidthFloatArray>>defaultElement (in category 'accessing') -----
+ defaultElement
+ 	"Return the default element of the receiver"
+ 	^0.0!

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

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

Item was added:
+ ----- Method: FixedBitWidthFloatArray>>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:
+ ----- Method: FixedBitWidthFloatArray>>squaredLength (in category 'accessing') -----
+ squaredLength
+ 	"Return the squared length of the receiver"
+ 	^self dot: self!

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

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

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

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

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

Item was added:
+ ----- Method: FixedBitWidthUnsignedIntegerArray>>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:
+ FixedBitWidthFloatArray variableDoubleWordSubclass: #Float64Array
- ArrayedCollection variableDoubleWordSubclass: #Float64Array
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !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>>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:
+ FixedBitWidthFloatArray variableWordSubclass: #FloatArray
- ArrayedCollection variableWordSubclass: #FloatArray
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Collections-Arrayed'!
  
  !FloatArray commentStamp: '<historical>' prior: 0!
  FloatArrays store 32bit IEEE floating point numbers.!

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

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

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

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

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

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

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

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

Item was removed:
- ----- 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 removed:
- ----- 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 added:
+ ----- Method: FloatArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 4!

Item was added:
+ ----- Method: FloatArray>>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 removed:
- ----- Method: FloatArray>>defaultElement (in category 'accessing') -----
- defaultElement
- 	"Return the default element of the receiver"
- 	^0.0!

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

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

Item was removed:
- ----- 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 removed:
- ----- Method: FloatArray>>squaredLength (in category 'accessing') -----
- squaredLength
- 	"Return the squared length of the receiver"
- 	^self dot: self!

Item was changed:
+ FixedBitWidthSignedIntegerArray 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>>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 added:
+ ----- Method: IntegerArray>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 4!

Item was added:
+ ----- Method: IntegerArray>>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 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:
+ FixedBitWidthSignedIntegerArray variableDoubleWordSubclass: #Long64Array
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !Long64Array commentStamp: 'nice 5/2/2020 15:44' prior: 0!
+ Long64Arrays store 64bit signed Integer values.
+ Negative values are stored as 2's complement.!

Item was added:
+ ----- Method: Long64Array>>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: Long64Array>>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: Long64Array>>byteSize (in category 'accessing') -----
+ byteSize
+ 	^self size * 8!

Item was added:
+ ----- Method: Long64Array>>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:
+ FixedBitWidthSignedIntegerArray variableByteSubclass: #SignedByteArray
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Collections-Arrayed'!
+ 
+ !SignedByteArray commentStamp: 'nice 5/2/2020 15:20' prior: 0!
+ IntegerArrays store 8bit signed Integer values.
+ 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 changed:
+ FixedBitWidthUnsignedIntegerArray 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 !



More information about the Squeak-dev mailing list