The Trunk: Kernel-ar.348.mcz

Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.348.mcz

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

Name: Kernel-ar.348
Author: ar
Time: 28 December 2009, 1:35:01 am
UUID: 9537d1a1-5ef5-c941-b4a6-601d0aa6ad76
Ancestors: Kernel-dtl.347

NanoTrait preparations: Vector all traits dependencies through a protocol in ClassDescription so that we can have alternative trait versions be the default. Provide CompiledMethod>>methodHome to ask for the original place a particular method was defined (methodHome == methodClass for all 'normal' methods). Additional guards for Berne trait idiosynchracies (updateOrganizationSelector: etc) that simply do not apply for alternative traits.

=============== Diff against Kernel-dtl.347 ===============

Item was added:
+ ----- Method: Behavior>>removeSelector: (in category 'adding/removing methods') -----
+ removeSelector: aSelector
+ "Assuming that the argument, selector (a Symbol), is a message selector
+ in my method dictionary, remove it and its method.
+
+ If the method to remove will be replaced by a method from my trait composition,
+ the current method does not have to be removed because we mark it as non-local.
+ If it is not identical to the actual method from the trait it will be replaced automatically
+ by #noteChangedSelectors:.
+
+ This is useful to avoid bootstrapping problems when moving methods to a trait
+ (e.g., from TPureBehavior to TMethodDictionaryBehavior). Manual moving (implementing
+ the method in the trait and then remove it from the class) does not work if the methods
+ themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or
+ addTraitSelector:withMethod:)"
+
+ | changeFromLocalToTraitMethod |
+
+ "-- support for alternative trait implementation --"
+ (self traitComposition isKindOf: TraitComposition)
+ ifFalse:[^self basicRemoveSelector: aSelector].
+
+ changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector)
+ and: [self hasTraitComposition]
+ and: [self traitComposition includesMethod: aSelector].
+
+ changeFromLocalToTraitMethod
+ ifFalse: [self basicRemoveSelector: aSelector]
+ ifTrue: [self ensureLocalSelectors].
+ self deregisterLocalSelector: aSelector.
+ self noteChangedSelectors: (Array with: aSelector)
+
+ !

Item was changed:
  ----- Method: Class>>hasTraitComposition (in category 'accessing') -----
  hasTraitComposition
+ ^traitComposition notNil and:[traitComposition isEmpty not]!
- ^traitComposition notNil!

Item was added:
+ ----- Method: AdditionalMethodState>>methodHome (in category 'accessing') -----
+ methodHome
+ "The behavior (trait/class) this method was originally defined in.
+ The methodClass in AdditionalMethodState but subclasses
+ (TraitMethodState) may know differently"
+ ^method methodClass!

Item was added:
+ ----- Method: ClassDescription>>fileOutInitializerOn: (in category 'fileIn/Out') -----
+ fileOutInitializerOn: aStream
+ "If the receiver has initialization, file it out. Backstop for subclasses."!

Item was added:
+ ----- Method: Behavior>>basicRemoveSelector: (in category 'adding/removing methods') -----
+ basicRemoveSelector: selector
+ "Assuming that the argument, selector (a Symbol), is a message selector
+ in my method dictionary, remove it and its method. Returns the old method
+ if found, nil otherwise."
+
+ | oldMethod |
+ oldMethod := self methodDict at: selector ifAbsent: [^ nil].
+ self methodDict removeKey: selector.
+
+ "Now flush Squeak's method cache, either by selector or by method"
+ oldMethod flushCache.
+ selector flushCache.
+ ^oldMethod!

Item was changed:
  ----- Method: Metaclass>>hasTraitComposition (in category 'accessing') -----
  hasTraitComposition
+ ^traitComposition notNil and:[traitComposition isEmpty not]!
- ^traitComposition notNil!

Item was added:
+ ----- Method: ClassDescription class>>allTraitsDo: (in category 'traits') -----
+ allTraitsDo: aBlock
+ "Evaluate aBlock with all the instance and class traits present in the system"
+ TraitImpl ifNotNil:[TraitImpl allTraitsDo: aBlock].!

Item was changed:
  ----- Method: Metaclass>>definition (in category 'fileIn/Out') -----
  definition
  "Refer to the comment in ClassDescription|definition."
 
+ ^ String streamContents:[:strm |
+ strm print: self.
+ self traitComposition isEmpty ifFalse:[
+ strm crtab; nextPutAll: 'uses: '; nextPutAll: self traitComposition asString.
+ ].
+ strm
- ^ String streamContents:
- [:strm |
- strm print: self;
  crtab;
  nextPutAll: 'instanceVariableNames: ';
  store: self instanceVariablesString]!

Item was added:
+ ----- Method: ClassDescription>>fileOutOn:moveSource:toFile:initializing: (in category 'fileIn/Out') -----
+ fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex initializing: aBool
+ "File out the receiver. Backstop for subclasses."
+ ^self fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex!

Item was added:
+ ----- Method: ClassDescription>>removeSelector: (in category 'accessing method dictionary') -----
+ removeSelector: selector
+ "Remove the message whose selector is given from the method
+ dictionary of the receiver, if it is there. Answer nil otherwise."
+
+ | priorMethod priorProtocol |
+ priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil].
+ priorProtocol := self whichCategoryIncludesSelector: selector.
+
+ "-- support for alternative trait implementation --"
+ (self traitComposition isKindOf: TraitComposition) ifFalse:[
+ SystemChangeNotifier uniqueInstance doSilently: [
+ self organization removeElement: selector].
+ ].
+
+ super removeSelector: selector.
+ (self traitComposition isKindOf: TraitComposition) ifTrue:[
+ SystemChangeNotifier uniqueInstance doSilently: [self updateOrganizationSelector: selector oldCategory: priorProtocol newCategory: nil].
+ ].
+ SystemChangeNotifier uniqueInstance
+ methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self.!

Item was added:
+ ----- Method: ClassDescription class>>traitImpl: (in category 'traits') -----
+ traitImpl: aTraitClass
+ "Make the given trait class the default implementor of traits"
+ TraitImpl := aTraitClass.!

Item was changed:
  ----- Method: Metaclass>>traitComposition (in category 'accessing') -----
  traitComposition
+ "Vector the creation through ClassDescription to support alternative traits"
+ ^traitComposition ifNil: [traitComposition := ClassDescription newTraitComposition].!
- traitComposition ifNil: [traitComposition := TraitComposition new].
- ^traitComposition!

Item was added:
+ ----- Method: ClassDescription class>>newTraitNamed:uses:category: (in category 'traits') -----
+ newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString
+ "Creates a new trait. If no current trait implementation
+ is installed, raise an error."
+ ^TraitImpl
+ ifNil:[self error: 'Traits are not installed']
+ ifNotNil:[TraitImpl newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString]!

Item was added:
+ ----- Method: ClassDescription class>>traitImpl (in category 'traits') -----
+ traitImpl
+ "Answer the default implementor of traits"
+ ^TraitImpl!

Item was added:
+ ----- Method: ClassDescription>>updateOrganizationSelector:oldCategory:newCategory: (in category 'organization updating') -----
+ updateOrganizationSelector: aSymbol oldCategory: oldCategoryOrNil newCategory: newCategoryOrNil
+ | currentCategory effectiveCategory sel changedCategories composition |
+ changedCategories := IdentitySet new.
+ composition := self hasTraitComposition
+ ifTrue: [self traitComposition]
+ ifFalse: [TraitComposition new].
+
+ "-- support for alternative trait implementation --"
+ (composition isKindOf: TraitComposition) ifFalse:[^self].
+
+ (composition methodDescriptionsForSelector: aSymbol) do: [:each |
+ sel := each selector.
+ (self includesLocalSelector: sel) ifFalse: [
+ currentCategory := self organization categoryOfElement: sel.
+ effectiveCategory := each effectiveMethodCategoryCurrent: currentCategory new: newCategoryOrNil.
+ effectiveCategory isNil ifTrue: [
+ currentCategory ifNotNil: [changedCategories add: currentCategory].
+ self organization removeElement: sel.
+ ] ifFalse: [
+ ((currentCategory isNil or: [currentCategory == ClassOrganizer ambiguous or: [currentCategory == oldCategoryOrNil]]) and: [currentCategory ~~ effectiveCategory]) ifTrue: [
+ currentCategory ifNotNil: [changedCategories add: currentCategory].
+ self organization
+ classify: sel
+ under: effectiveCategory
+ suppressIfDefault: false]]]].
+ ^ changedCategories!

Item was added:
+ ----- Method: CompiledMethod>>methodHome (in category 'accessing') -----
+ methodHome
+ "The behavior (trait/class) this method was originally defined in.
+ Can be different from methodClass if the method was recompiled."
+ ^self properties methodHome!

Item was added:
+ ----- Method: ClassDescription class>>newTraitTemplateIn: (in category 'traits') -----
+ newTraitTemplateIn: categoryString
+ ^TraitImpl ifNil:[''] ifNotNil:[TraitImpl newTemplateIn: categoryString].!

Item was changed:
  ----- Method: Class>>traitComposition (in category 'accessing') -----
  traitComposition
+ "Vector the creation through ClassDescription to support alternative traits"
+ ^traitComposition ifNil: [traitComposition := ClassDescription newTraitComposition].!
- traitComposition ifNil: [traitComposition := TraitComposition new].
- ^traitComposition!

Item was changed:
  ----- Method: ClassDescription>>fileOutCategory:on:moveSource:toFile: (in category 'fileIn/Out') -----
  fileOutCategory: aSymbol on: aFileStream moveSource: moveSource toFile: fileIndex
  "File a description of the receiver's category, aString, onto aFileStream. If
  moveSource, is true, then set the method source pointer to the new file position.
  Note when this method is called with moveSource=true, it is condensing the
  .sources file, and should only write one preamble per method category."
 
  | selectors |
 
  aFileStream cr.
  selectors := (aSymbol asString = ClassOrganizer allCategory)
  ifTrue: [ self organization allMethodSelectors ]
  ifFalse: [ self organization listAtCategoryNamed: aSymbol ].
 
+ selectors := selectors select: [:each | (self includesLocalSelector: each)].
- selectors := selectors select: [:each |
- (self includesLocalSelector: each) or: [(self methodDict at: each) sendsToSuper]].
 
  "Overridden to preserve author stamps in sources file regardless"
  selectors do: [:sel |
  self printMethodChunk: sel
  withPreamble: true
  on: aFileStream
  moveSource: moveSource
  toFile: fileIndex].
  ^ self!

Item was added:
+ ----- Method: ClassDescription class>>newTraitComposition (in category 'traits') -----
+ newTraitComposition
+ "Answer a new trait composition. If no current trait implementation
+ is installed, return an empty array"
+ ^TraitImpl ifNil:[#()] ifNotNil:[TraitImpl newTraitComposition].!