Posted by
commits-2 on
Oct 12, 2016; 7:04pm
URL: https://forum.world.st/The-Trunk-Kernel-eem-1045-mcz-tp4918766.html
Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.1045.mcz==================== Summary ====================
Name: Kernel-eem.1045
Author: eem
Time: 12 October 2016, 12:10:33.006651 pm
UUID: d91d38c6-bb5b-4fcd-a28b-1bdbc867a33e
Ancestors: Kernel-nice.1044
Add support for creating DoubleByte (isShorts) and DoubleWord (isLongs) variable classes.
=============== Diff against Kernel-nice.1044 ===============
Item was changed:
----- Method: Behavior>>isBytes (in category 'testing') -----
isBytes
+ "Answer whether the receiver's instances have indexed 8-bit integer instance variables.
- "Answer whether the receiver has 8-bit instance variables.
Above Cog Spur the class format is
<5 bits inst spec><16 bits inst size>
where the 5-bit inst spec is
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 = unused
7 = immediates (SmallInteger, Character)
8 = unused
9 = 64-bit indexable
10-11 = 32-bit indexable (Bitmap)
12-15 = 16-bit indexable
16-23 = 8-bit indexable
24-31 = compiled methods (CompiledMethod)"
^self instSpec >= 16!
Item was added:
+ ----- Method: Behavior>>isLongs (in category 'testing') -----
+ isLongs
+ "Answer whether the receiver's instances have indexed 64-bit integer instance variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec = 9!
Item was added:
+ ----- Method: Behavior>>isShorts (in category 'testing') -----
+ isShorts
+ "Answer whether the receiver's instances have indexed 16-bit integer instance variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec = 12!
Item was changed:
----- Method: Behavior>>isWords (in category 'testing') -----
isWords
+ "Answer whether the receiver's instances have indexed 32-bit integer instance variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec = 10!
- "Answer true if the receiver is made of 32-bit instance variables."
-
- ^self isBytes not!
Item was changed:
----- Method: Class>>variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
variableByteSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 8-bit byte-sized nonpointer variables."
+ ^ClassBuilder new
- have indexable byte-sized nonpointer variables."
- ^(ClassBuilder new)
superclass: self
variableByteSubclass: t
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
+ category: cat!
- category: cat
- !
Item was changed:
----- Method: Class>>variableByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
variableByteSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 8-bit byte-sized nonpointer variables."
- have indexable byte-sized nonpointer variables."
| newClass copyOfOldClass |
copyOfOldClass := self copy.
newClass := self
variableByteSubclass: t
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat.
newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
SystemChangeNotifier uniqueInstance
classDefinitionChangedFrom: copyOfOldClass to: newClass.
+ ^newClass!
- ^newClass
- !
Item was added:
+ ----- Method: Class>>variableDoubleByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ variableDoubleByteSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a
+ subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 16-bit double byte-sized nonpointer variables."
+ ^ClassBuilder new
+ superclass: self
+ variableDoubleByteSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: Class>>variableDoubleByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ variableDoubleByteSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a
+ subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 16-bit double byte-sized nonpointer variables."
+
+ | newClass copyOfOldClass |
+ copyOfOldClass := self copy.
+ newClass := self
+ variableDoubleByteSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat.
+
+ newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
+ SystemChangeNotifier uniqueInstance
+ classDefinitionChangedFrom: copyOfOldClass to: newClass.
+ ^newClass!
Item was added:
+ ----- Method: Class>>variableDoubleWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ variableDoubleWordSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a
+ subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 64-bit word-sized nonpointer variables."
+ ^ClassBuilder new
+ superclass: self
+ variableDoubleWordSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: Class>>variableDoubleWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
+ variableDoubleWordSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a
+ subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 64-bit word-sized nonpointer variables."
+
+ | newClass copyOfOldClass |
+ copyOfOldClass := self copy.
+ newClass := self
+ variableDoubleWordSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat.
+
+ newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
+ SystemChangeNotifier uniqueInstance
+ classDefinitionChangedFrom: copyOfOldClass to: newClass.
+ ^newClass!
Item was changed:
----- Method: Class>>variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
variableWordSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 32-bit word-sized nonpointer variables."
+ ^ClassBuilder new
- have indexable word-sized nonpointer variables."
- ^(ClassBuilder new)
superclass: self
variableWordSubclass: t
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
+ category: cat!
- category: cat
- !
Item was changed:
----- Method: Class>>variableWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') -----
variableWordSubclass: t uses: aTraitCompositionOrArray instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class (the receiver) in which the subclass is to
+ have indexable 32-bit word-sized nonpointer variables."
- have indexable word-sized nonpointer variables."
| newClass copyOfOldClass |
copyOfOldClass := self copy.
newClass := self
variableWordSubclass: t
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat.
newClass setTraitComposition: aTraitCompositionOrArray asTraitComposition.
SystemChangeNotifier uniqueInstance
classDefinitionChangedFrom: copyOfOldClass to: newClass.
+ ^newClass !
- ^newClass
- !
Item was changed:
----- Method: ClassBuilder>>superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
+ variableByteSubclass: t instanceVariableNames: f
- variableByteSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a subclass of an
+ existing class in which the subclass is to have indexable 8-bit byte-sized nonpointer variables."
- "This is the standard initialization message for creating a new class as a
- subclass of an existing class in which the subclass is to
- have indexable byte-sized nonpointer variables."
| oldClassOrNil actualType env |
+ aClass instSize > 0
- (aClass instSize > 0)
ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
+ (aClass isVariable and: [aClass isBytes not])
+ ifTrue: [^self error: 'cannot make an 8-bit byte subclass of a class with 16, 32 or 64 bit fields'].
- (aClass isVariable and: [aClass isWords])
- ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
(aClass isVariable and: [aClass isPointers])
ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
oldClassOrNil := aClass environment at: t ifAbsent:[nil].
actualType := (oldClassOrNil notNil
and: [oldClassOrNil typeOfClass == #compiledMethod])
ifTrue: [#compiledMethod]
ifFalse: [#bytes].
env := CurrentEnvironment signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: actualType
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was added:
+ ----- Method: ClassBuilder>>superclass:variableDoubleByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ variableDoubleByteSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a subclass of an
+ existing class in which the subclass is to have indexable 16-bit-sized nonpointer variables."
+ | oldClassOrNil env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
+ (aClass isVariable and: [aClass isShorts not])
+ ifTrue: [^self error: 'cannot make a 16-bit short subclass of a class with 8, 32 or 64 bit fields'].
+ (aClass isVariable and: [aClass isPointers])
+ ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
+ oldClassOrNil := aClass environment at: t ifAbsent:[nil].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #shorts
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: ClassBuilder>>superclass:variableDoubleWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
+ superclass: aClass
+ variableDoubleWordSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a subclass of an
+ existing class in which the subclass is to have indexable 16-bit-sized nonpointer variables."
+ | oldClassOrNil env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
+ (aClass isVariable and: [aClass isLongs not])
+ ifTrue: [^self error: 'cannot make a 64-bit long subclass of a class with 8, 16 or 32 bit fields'].
+ (aClass isVariable and: [aClass isPointers])
+ ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
+ oldClassOrNil := aClass environment at: t ifAbsent:[nil].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #longs
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was changed:
----- Method: ClassBuilder>>superclass:variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
variableWordSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new class as a subclass of an
+ existing class in which the subclass is to have indexable 32-bit word-sized nonpointer variables."
- "This is the standard initialization message for creating a new class as a
- subclass of an existing class in which the subclass is to
- have indexable word-sized nonpointer variables."
| env |
+ aClass instSize > 0
- (aClass instSize > 0)
ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
+ (aClass isVariable and: [aClass isWords not])
+ ifTrue: [^self error: 'cannot make a 32-bit word subclass of a class with 8, 16 or 64 bit fields'].
- (aClass isVariable and: [aClass isBytes])
- ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields'].
(aClass isVariable and: [aClass isPointers])
ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].
env := CurrentEnvironment signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #words
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!