[squeak-dev] The Trunk: Kernel-ar.420.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Mar 6 04:56:37 UTC 2010


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

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

Name: Kernel-ar.420
Author: ar
Time: 5 March 2010, 8:55:49.922 pm
UUID: a8de6a84-8494-b34e-bfaa-eef854ed79e6
Ancestors: Kernel-ar.419

Avoid dictionary protocol in Smalltalk.

=============== Diff against Kernel-ar.419 ===============

Item was changed:
  ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') -----
  name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
  	"Define a new class in the given environment.
  	If unsafe is true do not run any validation checks.
  	This facility is provided to implement important system changes."
  	| oldClass instVars classVars copyOfOldClass newClass |
   
  	environ := env.
  	instVars := Scanner new scanFieldNames: instVarString.
  	classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].
  
  	"Validate the proposed name"
  	unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]].
  	oldClass := env at: className ifAbsent:[nil].
  	oldClass isBehavior 
  		ifFalse: [oldClass := nil]  "Already checked in #validateClassName:"
  		ifTrue: [
  			copyOfOldClass := oldClass copy.
  			copyOfOldClass superclass addSubclass: copyOfOldClass].
  	
  	
  	[ | newCategory needNew force organization oldCategory |
  	unsafe ifFalse:[
  		"Run validation checks so we know that we have a good chance for recompilation"
  		(self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
  		(self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
  		(self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
  		(self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].
  
  	"See if we need a new subclass"
  	needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass.
  	needNew == nil ifTrue:[^nil]. "some error"
  
  	(needNew and:[unsafe not]) ifTrue:[
  		"Make sure we don't redefine any dangerous classes"
  		(self tooDangerousClasses includes: oldClass name) ifTrue:[
  			self error: oldClass name, ' cannot be changed'.
  		].
  		"Check if the receiver should not be redefined"
  		(oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[
  			self notify: oldClass name asText allBold, 
  						' should not be redefined. \Proceed to store over it.' withCRs]].
  
  	needNew ifTrue:[
  		"Create the new class"
  		newClass := self 
  			newSubclassOf: newSuper 
  			type: type 
  			instanceVariables: instVars
  			from: oldClass.
  		newClass == nil ifTrue:[^nil]. "Some error"
  		newClass setName: className.
  	] ifFalse:[
  		"Reuse the old class"
  		newClass := oldClass.
  	].
  
  	"Install the class variables and pool dictionaries... "
  	force := (newClass declare: classVarString) | (newClass sharing: poolString).
  
  	"... classify ..."
  	newCategory := category asSymbol.
  	organization := environ ifNotNil:[environ organization].
  	oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol].
  	organization classify: newClass name under: newCategory.
  	newClass environment: environ.
  
  	"... recompile ..."
  	newClass := self recompile: force from: oldClass to: newClass mutate: false.
  
  	"... export if not yet done ..."
  	(environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[
  		[environ at: newClass name put: newClass]
  			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
+ 		environ flushClassNameCache.
- 		Smalltalk flushClassNameCache.
  	].
  
  
  	newClass doneCompiling.
  	"... notify interested clients ..."
  	oldClass isNil ifTrue: [
  		SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory.
  		^ newClass].
  	newCategory ~= oldCategory 
  		ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category]
  		ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.].
  ] ensure: 
  		[copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass].
  		Behavior flushObsoleteSubclasses.
  		].
  	^newClass!

Item was changed:
  ----- Method: Object>>hasHaltCount (in category 'debugging-haltOnce') -----
  hasHaltCount
+ 	^self class environment
- 	^Smalltalk
  				includesKey: #HaltCount!

Item was changed:
  ----- Method: CompiledMethod>>hasReportableSlip (in category 'testing') -----
  hasReportableSlip
  	"Answer whether the receiver contains anything that should be brought 
  	to the attention of the author when filing out. Customize the lists here 
  	to suit your preferences. If slips do not get reported in spite of your 
  	best efforts here, make certain that the Preference 'checkForSlips' is set 
  	to true."
  	#(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent  #haltOnce #haltOnce: #haltIf: )
  		do: [:aLit | (self hasLiteral: aLit)
  				ifTrue: [^ true]].
  	#(#Transcript #AA #BB #CC #DD #EE )
  		do: [:aSymbol |
  			| assoc |
+ 			(assoc := Smalltalk globals
- 			(assoc := Smalltalk
  						associationAt: aSymbol
  						ifAbsent: [])
  				ifNotNil: [(self hasLiteral: assoc)
  						ifTrue: [^ true]]].
  	^ false!

Item was changed:
  ----- Method: ClassBuilder class>>cleanupClassHierarchyFor: (in category 'cleanup obsolete classes') -----
  cleanupClassHierarchyFor: aClassDescription
  	
  	| myName mySuperclass |
  	mySuperclass := aClassDescription superclass.
  	(self isReallyObsolete: aClassDescription) ifTrue: [
  		
  		"Remove class >>>from SystemDictionary if it is obsolete"
  		myName := aClassDescription name asString.
+ 		Smalltalk globals keys do: [:each | 
- 		Smalltalk keys do: [:each | 
  			(each asString = myName and: [(Smalltalk at: each) == aClassDescription])
+ 				ifTrue: [Smalltalk globals removeKey: each]].
- 				ifTrue: [Smalltalk removeKey: each]].
  
  		"Make class officially obsolete if it is not"
  		(aClassDescription name asString beginsWith: 'AnObsolete')
  			ifFalse: [aClassDescription obsolete].
  
  		aClassDescription isObsolete 
  			ifFalse: [self error: 'Something wrong!!'].
  
  		"Add class to obsoleteSubclasses of its superclass"
  		mySuperclass
  			ifNil: [self error: 'Obsolete subclasses of nil cannot be stored'].
  		(mySuperclass obsoleteSubclasses includes: aClassDescription)
  			ifFalse: [mySuperclass addObsoleteSubclass: aClassDescription].
  	] ifFalse:[
  		"check if superclass has aClassDescription in its obsolete subclasses"
  		mySuperclass ifNil:[mySuperclass := Class]. "nil subclasses"
  		mySuperclass removeObsoleteSubclass: aClassDescription.
  	].
  	"And remove its obsolete subclasses if not actual superclass"
  	aClassDescription obsoleteSubclasses do:[:obs|
  		obs superclass == aClassDescription ifFalse:[
  			aClassDescription removeObsoleteSubclass: obs]].
  !

Item was changed:
  ----- Method: Object>>removeHaltCount (in category 'debugging-haltOnce') -----
  removeHaltCount
+ 	(self class environment includesKey: #HaltCount) ifTrue: [
+ 		self class environment removeKey: #HaltCount]!
- 	(Smalltalk includesKey: #HaltCount) ifTrue: [
- 		Smalltalk removeKey: #HaltCount]!

Item was changed:
  ----- Method: Class>>binding (in category 'compiling') -----
  binding
  	"Answer a binding for the receiver, sharing if possible"
  	| binding |
+ 	binding := self environment associationAt: name ifAbsent: [nil -> self].
- 	binding := Smalltalk associationAt: name ifAbsent: [nil -> self].
  	^binding value == self ifTrue:[binding] ifFalse:[nil -> self].!




More information about the Squeak-dev mailing list