[squeak-dev] The Trunk: Kernel-cwp.727.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 2 00:02:28 UTC 2013


Colin Putney uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-cwp.727.mcz

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

Name: Kernel-cwp.727
Author: cwp
Time: 1 January 2013, 7:01:18.073 pm
UUID: 035cc801-2619-49a8-965e-b61a1eada4e3
Ancestors: Kernel-cwp.726

Environments bootstrap - stage 3

=============== Diff against Kernel-cwp.726 ===============

Item was changed:
  ----- Method: Class>>addClassVarName: (in category 'class variables') -----
  addClassVarName: aString 
  	"Add the argument, aString, as a class variable of the receiver.
  	Signal an error if the first character of aString is not capitalized,
  	or if it is already a variable named in the class."
  	| symbol oldState |
  	oldState := self copy.
  	aString first canBeGlobalVarInitial
  		ifFalse: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.'].
  	symbol := aString asSymbol.
  	self withAllSubclasses do: 
  		[:subclass | 
  		(self canFindWithoutEnvironment: symbol) ifTrue: [
  			(DuplicateVariableError new)
  				superclass: superclass; "fake!!!!!!"
  				variable: aString;
  				signal: aString, ' is already defined']].
  	classPool == nil ifTrue: [classPool := Dictionary new].
  	(classPool includesKey: symbol) ifFalse: 
  		["Pick up any refs in Undeclared"
+ 		classPool declare: symbol from: environment undeclared.
- 		classPool declare: symbol from: Undeclared.
  		SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldState to: self]!

Item was changed:
  ----- Method: Class>>bindingOf: (in category 'compiling') -----
  bindingOf: varName
+ 	^ self bindingOf: varName environment: self environment!
- 	"Answer the binding of some variable resolved in the scope of the receiver"
- 	| aSymbol binding |
- 	aSymbol := varName asSymbol.
- 
- 	"First look in classVar dictionary."
- 	binding := self classPool bindingOf: aSymbol.
- 	binding ifNotNil:[^binding].
- 
- 	"Next look in shared pools."
- 	self sharedPools do:[:pool | 
- 		binding := pool bindingOf: aSymbol.
- 		binding ifNotNil:[^binding].
- 	].
- 
- 	"Next look in declared environment."
- 	binding := self environment bindingOf: aSymbol.
- 	binding ifNotNil:[^binding].
- 
- 	"Finally look higher up the superclass chain and fail at the end."
- 	superclass == nil
- 		ifTrue: [^ nil]
- 		ifFalse: [^ superclass bindingOf: aSymbol].
- 
- !

Item was changed:
  ----- Method: Class>>category (in category 'organization') -----
  category
  	"Answer the system organization category for the receiver. First check whether the
  	category name stored in the ivar is still correct and only if this fails look it up
  	(latter is much more expensive)"
  
  	category ifNotNil: [ :symbol |
+ 		((self environment organization listAtCategoryNamed: symbol) includes: self name)
- 		((SystemOrganization listAtCategoryNamed: symbol) includes: self name)
  			ifTrue: [ ^symbol ] ].
+ 	category := self environment organization categoryOfElement: self name.
- 	category := SystemOrganization categoryOfElement: self name.
  	^category!

Item was changed:
  ----- Method: Class>>declare: (in category 'initialize-release') -----
  declare: varString 
  	"Declare class variables common to all instances. Answer whether 
  	recompilation is advisable."
  
  	| newVars conflicts |
  	
  	newVars := 
  		(Scanner new scanFieldNames: varString)
  			collect: [:x | x asSymbol].
  	newVars do:
  		[:var | var first canBeGlobalVarInitial
  			ifFalse: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']].
  	conflicts := false.
  	classPool == nil 
  		ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: 
  					[:var | self removeClassVarName: var]].
  	(newVars reject: [:var | self classPool includesKey: var])
  		do: [:var | "adding"
  			"check if new vars defined elsewhere"
  			(self canFindWithoutEnvironment: var) ifTrue: [
  					(DuplicateVariableError new)
  						superclass: superclass; "fake!!!!!!"
  						variable: var;
  						signal: var, ' is already defined'.
  					conflicts := true]].
  	newVars size > 0
  		ifTrue: 
  			[classPool := self classPool.
  			"in case it was nil"
+ 			newVars do: [:var | classPool declare: var from: environment undeclared]].
- 			newVars do: [:var | classPool declare: var from: Undeclared]].
  	^conflicts!

Item was changed:
  ----- Method: Class>>removeClassVarName: (in category 'class variables') -----
  removeClassVarName: aString 
  	"Remove the class variable whose name is the argument, aString, from 
  	the names defined in the receiver, a class. Create an error notification if 
  	aString is not a class variable or if it is still being used in the code of 
  	the class."
  
  	| aSymbol |
  	aSymbol := aString asSymbol.
  	(classPool includesKey: aSymbol)
  		ifFalse: [^self error: aString, ' is not a class variable'].
  	self withAllSubclasses do:[:subclass |
  		(Array with: subclass with: subclass class) do:[:classOrMeta |
  			(classOrMeta whichSelectorsReferTo: (classPool associationAt: aSymbol))
  				isEmpty ifFalse: [
  					InMidstOfFileinNotification signal ifTrue: [
  						Transcript cr; show: self name, ' (' , aString , ' is Undeclared) '.
+ 						^ environment undeclared declare: aSymbol from: classPool].
- 						^Undeclared declare: aSymbol from: classPool].
  					(self confirm: (aString,' is still used in code of class ', classOrMeta name,
  						'.\Is it okay to move it to Undeclared?') withCRs)
  						ifTrue:[^Undeclared declare: aSymbol from: classPool]
  						ifFalse:[^self]]]].
  	classPool removeKey: aSymbol.
  	classPool isEmpty ifTrue: [classPool := nil].
  !

Item was changed:
  ----- Method: Class>>rename: (in category 'class name') -----
  rename: aString 
  	"The new name of the receiver is the argument, aString."
  
  	| oldName newName |
  	(newName := aString asSymbol) = (oldName := self name)
  		ifTrue: [^ self].
  	(self environment includesKey: newName)
  		ifTrue: [^ self error: newName , ' already exists'].
+ 	(environment undeclared includesKey: newName)
- 	(Undeclared includesKey: newName)
  		ifTrue: [self inform: 'There are references to, ' , aString printString , '
  from Undeclared. Check them after this change.'].
  	name := newName.
  	self environment renameClass: self from: oldName!

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.
+ 		newClass environment: environ.
  	] 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 suppressIfDefault: true.
+ 	
- 	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.
  	].
  
  
  	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: ClassBuilder>>superclass:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
  superclass: newSuper
  	subclass: 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."
+ 	| env |
+ 	env := EnvironmentRequest signal ifNil: [newSuper environment].
  	^self 
  		name: t
+ 		inEnvironment: env
- 		inEnvironment: newSuper environment
  		subclassOf: newSuper
  		type: newSuper typeOfClass
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!

Item was changed:
  ----- Method: ClassBuilder>>superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
  superclass: aClass
  	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 byte-sized nonpointer variables."
+ 	| oldClassOrNil actualType env |
- 	| oldClassOrNil actualType |
  	(aClass instSize > 0)
  		ifTrue: [^self error: 'cannot make a byte subclass of a class with named 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 := EnvironmentRequest signal ifNil: [aClass environment].
  	^self 
  		name: t
+ 		inEnvironment: env
- 		inEnvironment: aClass environment
  		subclassOf: aClass
  		type: actualType
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!

Item was changed:
  ----- Method: ClassBuilder>>superclass:variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
  superclass: aClass
  	variableSubclass: 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 pointer variables."
+ 	
+ 	| env |
+ 	aClass isBits ifTrue: 
+ 		[^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
+ 	env := EnvironmentRequest signal ifNil: [aClass environment].
- 	aClass isBits 
- 		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
  	^self 
  		name: t
+ 		inEnvironment: env
- 		inEnvironment: aClass environment
  		subclassOf: aClass
  		type: #variable
  		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 word-sized nonpointer variables."
+ 	| env |
  	(aClass instSize > 0)
  		ifTrue: [^self error: 'cannot make a word subclass of a class with named 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 := EnvironmentRequest signal ifNil: [aClass environment].
- 
  	^self 
  		name: t
+ 		inEnvironment: env
- 		inEnvironment: aClass environment
  		subclassOf: aClass
  		type: #words
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!

Item was changed:
  ----- Method: ClassBuilder>>superclass:weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
  superclass: aClass
  	weakSubclass: 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 weak indexable pointer variables."
+ 	| env |
  	aClass isBits 
  		ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
+ 	env := EnvironmentRequest signal ifNil: [aClass environment].
  	^self 
  		name: t
+ 		inEnvironment: env
- 		inEnvironment: aClass environment
  		subclassOf: aClass
  		type: #weak
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!



More information about the Squeak-dev mailing list