--- a/Metaclass.st Thu Feb 29 16:45:18 1996 +0100
+++ b/Metaclass.st Thu Feb 29 17:23:55 1996 +0100
@@ -11,10 +11,10 @@
"
Class subclass:#Metaclass
- instanceVariableNames:'myClass'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames:'myClass'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
!Metaclass class methodsFor:'documentation'!
@@ -454,17 +454,17 @@
!
name:newName inEnvironment:aSystemDictionary
- subclassOf:aClass
- instanceVariableNames:stringOfInstVarNames
- variable:variableBoolean
- words:wordsBoolean
- pointers:pointersBoolean
- classVariableNames:stringOfClassVarNames
- poolDictionaries:stringOfPoolNames
- category:categoryString
- comment:commentString
- changed:changed
- classInstanceVariableNames:stringOfClassInstVarNames
+ subclassOf:aClass
+ instanceVariableNames:stringOfInstVarNames
+ variable:variableBoolean
+ words:wordsBoolean
+ pointers:pointersBoolean
+ classVariableNames:stringOfClassVarNames
+ poolDictionaries:stringOfPoolNames
+ category:categoryString
+ comment:commentString
+ changed:changed
+ classInstanceVariableNames:stringOfClassInstVarNames
"this is the main workhorse for installing new classes - special care
has to be taken, when changing an existing classes definition. In this
@@ -495,14 +495,14 @@
project := Project. "/ have to fetch this before, in case its autoloaded
newName = aClass name ifTrue:[
- self error:'trying to create circular class definition'.
- ^ nil
+ self error:'trying to create circular class definition'.
+ ^ nil
].
"check for invalid subclassing of UndefinedObject and SmallInteger"
aClass canBeSubclassed ifFalse:[
- self error:('it is not possible to subclass ' , aClass name).
- ^ nil
+ self error:('it is not possible to subclass ' , aClass name).
+ ^ nil
].
nInstVars := stringOfInstVarNames countWords.
@@ -512,76 +512,76 @@
"look, if it already exists as a class"
aSystemDictionary notNil ifTrue:[
- oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
+ oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
].
(oldClass isBehavior and:[oldClass isLoaded]) ifFalse:[
- oldClass := nil.
+ oldClass := nil.
] ifTrue:[
- oldClass name ~= classSymbol ifTrue:[
- (self confirm:(classSymbol , ' is an alias for ' , oldClass name , '\\continue ?') withCRs)
- ifFalse:[^ self].
- oldClass := nil
- ] ifFalse:[
- "/
- "/ some consisteny checks
- "/
- oldClass superclass notNil ifTrue:[
- oldClass allSuperclasses do:[:cls |
- cls name = nameString ifTrue:[
- self error:'trying to create circular class definition'.
- ^ nil
- ]
- ]
- ].
+ oldClass name ~= classSymbol ifTrue:[
+ (self confirm:(classSymbol , ' is an alias for ' , oldClass name , '\\continue ?') withCRs)
+ ifFalse:[^ self].
+ oldClass := nil
+ ] ifFalse:[
+ "/
+ "/ some consisteny checks
+ "/
+ oldClass superclass notNil ifTrue:[
+ oldClass allSuperclasses do:[:cls |
+ cls name = nameString ifTrue:[
+ self error:'trying to create circular class definition'.
+ ^ nil
+ ]
+ ]
+ ].
- aClass superclass notNil ifTrue:[
- aClass allSuperclasses do:[:cls |
- cls name = nameString ifTrue:[
- self error:'trying to create circular class definition'.
- ^ nil
- ]
- ].
- ].
+ aClass superclass notNil ifTrue:[
+ aClass allSuperclasses do:[:cls |
+ cls name = nameString ifTrue:[
+ self error:'trying to create circular class definition'.
+ ^ nil
+ ]
+ ].
+ ].
- newComment isNil ifTrue:[
- newComment := oldClass comment
- ].
+ newComment isNil ifTrue:[
+ newComment := oldClass comment
+ ].
- "
- warn, if it exists with different category and different instvars,
- and the existing is not an autoload class.
- Usually, this indicates that someone wants to create a new class with
- a name, which already exists (it happened a few times to myself, while
- I wanted to create a new class called ReturnNode ...).
- This will be much less of a problem, once multiple name spaces are
- implemented and classes can be put into separate packages.
- "
- oldClass isLoaded ifTrue:[
- oldClass category ~= categoryString ifTrue:[
- oldClass instanceVariableString asCollectionOfWords
- ~= stringOfInstVarNames asCollectionOfWords ifTrue:[
- (self confirm:'a class named ' , oldClass name ,
- ' already exists -\\create (i.e. change) anyway ?' withCRs)
- ifFalse:[
- ^ nil
- ]
- ]
- ]
- ].
+ "
+ warn, if it exists with different category and different instvars,
+ and the existing is not an autoload class.
+ Usually, this indicates that someone wants to create a new class with
+ a name, which already exists (it happened a few times to myself, while
+ I wanted to create a new class called ReturnNode ...).
+ This will be much less of a problem, once multiple name spaces are
+ implemented and classes can be put into separate packages.
+ "
+ oldClass isLoaded ifTrue:[
+ oldClass category ~= categoryString ifTrue:[
+ oldClass instanceVariableString asCollectionOfWords
+ ~= stringOfInstVarNames asCollectionOfWords ifTrue:[
+ (self confirm:'a class named ' , oldClass name ,
+ ' already exists -\\create (i.e. change) anyway ?' withCRs)
+ ifFalse:[
+ ^ nil
+ ]
+ ]
+ ]
+ ].
- "/
- "/ hints - warn, if creating a variableSubclass of a Set
- "/ (common error - containers in ST/X do not use variable-slots)
- "/
- ((variableBoolean == true) and:[pointersBoolean]) ifTrue:[
- (oldClass isKindOf:Set class) ifTrue:[
- (self confirm:'ST/X Set & Dictionary are not variable-classes\create anyway ?' withCRs)
- ifFalse:[
- ^ nil
- ]
- ]
- ]
- ]
+ "/
+ "/ hints - warn, if creating a variableSubclass of a Set
+ "/ (common error - containers in ST/X do not use variable-slots)
+ "/
+ ((variableBoolean == true) and:[pointersBoolean]) ifTrue:[
+ (oldClass isKindOf:Set class) ifTrue:[
+ (self confirm:'ST/X Set & Dictionary are not variable-classes\create anyway ?' withCRs)
+ ifFalse:[
+ ^ nil
+ ]
+ ]
+ ]
+ ]
].
"
@@ -595,11 +595,11 @@
(but thats how its defined in the book - maybe I will change anyway).
"
oldClass isNil ifTrue:[
- (self checkConventionsFor:newName
- instVarNames:stringOfInstVarNames
- classVarNames:stringOfClassVarNames) ifFalse:[
- ^ nil
- ]
+ (self checkConventionsFor:newName
+ instVarNames:stringOfInstVarNames
+ classVarNames:stringOfClassVarNames) ifFalse:[
+ ^ nil
+ ]
].
nClassInstVars := stringOfClassInstVarNames countWords.
@@ -624,19 +624,19 @@
"/ but prefer the old package
oldClass notNil ifTrue:[
- t := oldClass package.
- newClass setBinaryRevision:(oldClass revision).
+ t := oldClass package.
+ newClass setBinaryRevision:(oldClass binaryRevision).
] ifFalse:[
- project notNil ifTrue:[
- currentProject := project current.
- currentProject notNil ifTrue:[
- t := currentProject packageName.
- ]
- ].
+ project notNil ifTrue:[
+ currentProject := project current.
+ currentProject notNil ifTrue:[
+ t := currentProject packageName.
+ ]
+ ].
].
t notNil ifTrue:[
- newMetaclass package:t.
- newClass package:t.
+ newMetaclass package:t.
+ newClass package:t.
].
"
@@ -647,55 +647,55 @@
while ST/X also calls it with symbols such as #float, #double etc.
"
(variableBoolean == true) ifTrue:[
- pointersBoolean ifTrue:[
- newFlags := Behavior flagPointers
- ] ifFalse:[
- wordsBoolean ifTrue:[
- newFlags := Behavior flagWords
- ] ifFalse:[
- newFlags := Behavior flagBytes
- ]
- ]
+ pointersBoolean ifTrue:[
+ newFlags := Behavior flagPointers
+ ] ifFalse:[
+ wordsBoolean ifTrue:[
+ newFlags := Behavior flagWords
+ ] ifFalse:[
+ newFlags := Behavior flagBytes
+ ]
+ ]
] ifFalse:[
- (variableBoolean == #float) ifTrue:[
- newFlags := Behavior flagFloats
- ] ifFalse:[
- (variableBoolean == #double) ifTrue:[
- newFlags := Behavior flagDoubles
- ] ifFalse:[
- (variableBoolean == #long) ifTrue:[
- newFlags := Behavior flagLongs
- ] ifFalse:[
- newFlags := Behavior flagNotIndexed
- ]
- ]
- ].
+ (variableBoolean == #float) ifTrue:[
+ newFlags := Behavior flagFloats
+ ] ifFalse:[
+ (variableBoolean == #double) ifTrue:[
+ newFlags := Behavior flagDoubles
+ ] ifFalse:[
+ (variableBoolean == #long) ifTrue:[
+ newFlags := Behavior flagLongs
+ ] ifFalse:[
+ newFlags := Behavior flagNotIndexed
+ ]
+ ]
+ ].
].
superFlags := aClass flags bitAnd:(Behavior maskIndexType bitInvert). "preserve other bits"
oldClass notNil ifTrue:[
- oldClass isBuiltInClass ifTrue:[
- "
- special care when redefining Method, Block and other built-in classes,
- which might have other flag bits ...
- "
+ oldClass isBuiltInClass ifTrue:[
+ "
+ special care when redefining Method, Block and other built-in classes,
+ which might have other flag bits ...
+ "
- newFlags := newFlags bitOr:(oldClass flags bitAnd:(Behavior maskIndexType bitInvert))
- ]
+ newFlags := newFlags bitOr:(oldClass flags bitAnd:(Behavior maskIndexType bitInvert))
+ ]
].
newClass flags:(newFlags bitOr:superFlags). "preserve inherited special bits"
(nInstVars ~~ 0) ifTrue:[
- newClass setInstanceVariableString:stringOfInstVarNames
+ newClass setInstanceVariableString:stringOfInstVarNames
].
oldClass notNil ifTrue:[
- "
- setting first will make new class clear obsolete classvars
- "
- newClass setClassVariableString:(oldClass classVariableString).
- (t := oldClass primitiveSpec) notNil ifTrue:[
- newClass primitiveSpec:t.
- newClass setClassFilename:(oldClass classFilename).
- ]
+ "
+ setting first will make new class clear obsolete classvars
+ "
+ newClass setClassVariableString:(oldClass classVariableString).
+ (t := oldClass primitiveSpec) notNil ifTrue:[
+ newClass primitiveSpec:t.
+ newClass setClassFilename:(oldClass classFilename).
+ ]
].
newClass classVariableString:stringOfClassVarNames.
@@ -704,34 +704,34 @@
(also for autoloaded classes)
"
(oldClass isNil or:[oldClass isLoaded not]) ifTrue:[
- (oldClass isNil and:[changed]) ifTrue:[
- self addChangeRecordForClass:newClass.
- ].
+ (oldClass isNil and:[changed]) ifTrue:[
+ self addChangeRecordForClass:newClass.
+ ].
- commentString notNil ifTrue:[
- newClass comment:commentString
- ].
+ commentString notNil ifTrue:[
+ newClass comment:commentString
+ ].
- aSystemDictionary notNil ifTrue:[
- aSystemDictionary at:classSymbol put:newClass.
- ].
+ aSystemDictionary notNil ifTrue:[
+ aSystemDictionary at:classSymbol put:newClass.
+ ].
- oldClass isNil ifTrue:[
- project notNil ifTrue:[
- currentProject := project current.
- currentProject notNil ifTrue:[
- "
- new classes get the package assigned
- "
- newClass package:(currentProject packageName asSymbol)
- ]
- ].
- ].
+ oldClass isNil ifTrue:[
+ project notNil ifTrue:[
+ currentProject := project current.
+ currentProject notNil ifTrue:[
+ "
+ new classes get the package assigned
+ "
+ newClass package:(currentProject packageName asSymbol)
+ ]
+ ].
+ ].
- aSystemDictionary notNil ifTrue:[
- aSystemDictionary changed:#newClass with:newClass.
- ].
- ^ newClass
+ aSystemDictionary notNil ifTrue:[
+ aSystemDictionary changed:#newClass with:newClass.
+ ].
+ ^ newClass
].
@@ -754,105 +754,105 @@
"
(oldClass superclass == newClass superclass) ifTrue:[
(oldClass instSize == newClass instSize) ifTrue:[
- (oldClass flags == newClass flags) ifTrue:[
- (oldClass name = newClass name) ifTrue:[
- (oldInstVars = newInstVars) ifTrue:[
+ (oldClass flags == newClass flags) ifTrue:[
+ (oldClass name = newClass name) ifTrue:[
+ (oldInstVars = newInstVars) ifTrue:[
- (newComment ~= oldClass comment) ifTrue:[
- oldClass setComment:newComment. "writes a change-chunk"
- oldClass changed:#comment with:oldClass comment.
- changed ifTrue:[
- self addChangeRecordForClassComment:oldClass.
- ]
- ].
+ (newComment ~= oldClass comment) ifTrue:[
+ oldClass setComment:newComment. "writes a change-chunk"
+ oldClass changed:#comment with:oldClass comment.
+ changed ifTrue:[
+ self addChangeRecordForClassComment:oldClass.
+ ]
+ ].
- (oldClassVars = newClassVars) ifTrue:[
- "
- really no change (just comment and/or category)
- "
- anyChange := false.
+ (oldClassVars = newClassVars) ifTrue:[
+ "
+ really no change (just comment and/or category)
+ "
+ anyChange := false.
- oldClass setInstanceVariableString:(newClass instanceVariableString).
- oldClass setClassVariableString:(newClass classVariableString).
+ oldClass setInstanceVariableString:(newClass instanceVariableString).
+ oldClass setClassVariableString:(newClass classVariableString).
- oldClass category ~= categoryString ifTrue:[
- oldClass category:categoryString.
- changed ifTrue:[
- self addChangeRecordForClass:newClass.
- ].
- aSystemDictionary notNil ifTrue:[
- "notify change of category"
- aSystemDictionary changed:#organization
- ]
- ].
- "notify change of class"
+ oldClass category ~= categoryString ifTrue:[
+ oldClass category:categoryString.
+ changed ifTrue:[
+ self addChangeRecordForClass:newClass.
+ ].
+ aSystemDictionary notNil ifTrue:[
+ "notify change of category"
+ aSystemDictionary changed:#organization
+ ]
+ ].
+ "notify change of class"
"/ oldClass changed.
- ^ oldClass
- ].
+ ^ oldClass
+ ].
- "
- when we arrive here, class variables have changed
- "
- oldClass category ~= categoryString ifTrue:[
- "notify change of organization"
- oldClass category:categoryString.
- aSystemDictionary notNil ifTrue:[
- "notify change of organization"
- aSystemDictionary changed:#organization
- ].
- ].
+ "
+ when we arrive here, class variables have changed
+ "
+ oldClass category ~= categoryString ifTrue:[
+ "notify change of organization"
+ oldClass category:categoryString.
+ aSystemDictionary notNil ifTrue:[
+ "notify change of organization"
+ aSystemDictionary changed:#organization
+ ].
+ ].
- "
- set class variable string;
- this also updates the set of class variables
- by creating new / deleting obsolete ones.
- "
- oldClass classVariableString:stringOfClassVarNames.
+ "
+ set class variable string;
+ this also updates the set of class variables
+ by creating new / deleting obsolete ones.
+ "
+ oldClass classVariableString:stringOfClassVarNames.
- "
- get the set of changed class variables
- "
- changeSet1 := Set new.
- oldClassVars do:[:nm |
- (newClassVars includes:nm) ifFalse:[
- changeSet1 add:nm
- ]
- ].
- newClassVars do:[:nm |
- (oldClassVars includes:nm) ifFalse:[
- changeSet1 add:nm
- ]
- ].
+ "
+ get the set of changed class variables
+ "
+ changeSet1 := Set new.
+ oldClassVars do:[:nm |
+ (newClassVars includes:nm) ifFalse:[
+ changeSet1 add:nm
+ ]
+ ].
+ newClassVars do:[:nm |
+ (oldClassVars includes:nm) ifFalse:[
+ changeSet1 add:nm
+ ]
+ ].
- "
- recompile all methods accessing set of changed classvars
- here and also in all subclasses ...
- "
+ "
+ recompile all methods accessing set of changed classvars
+ here and also in all subclasses ...
+ "
- "
- dont update change file for the recompilation
- "
- Class withoutUpdatingChangesDo:[
+ "
+ dont update change file for the recompilation
+ "
+ Class withoutUpdatingChangesDo:[
" "
- Transcript showCr:'recompiling class & inst methods accessing ' , changeSet1 printString.
- Transcript endEntry.
+ Transcript showCr:'recompiling class & inst methods accessing ' , changeSet1 printString.
+ Transcript endEntry.
" "
- oldClass withAllSubclasses do:[:aClass |
- aClass class recompileMethodsAccessingAny:changeSet1.
- aClass recompileMethodsAccessingAny:changeSet1.
- ].
- ].
+ oldClass withAllSubclasses do:[:aClass |
+ aClass class recompileMethodsAccessingAny:changeSet1.
+ aClass recompileMethodsAccessingAny:changeSet1.
+ ].
+ ].
- "notify change of class"
- changed ifTrue:[
- self addChangeRecordForClass:oldClass.
- ].
- oldClass changed:#definition.
+ "notify change of class"
+ changed ifTrue:[
+ self addChangeRecordForClass:oldClass.
+ ].
+ oldClass changed:#definition.
- ^ oldClass
- ]
- ]
- ]
+ ^ oldClass
+ ]
+ ]
+ ]
]
].
@@ -861,7 +861,7 @@
since instance variable layout and/or inheritance has changed.
"
(newComment ~= oldClass comment) ifTrue:[
- newClass comment:newComment
+ newClass comment:newComment
].
superClassChange := oldClass superclass ~~ newClass superclass.
@@ -870,8 +870,8 @@
dont allow built-in classes to be modified this way
"
(oldClass notNil and:[oldClass isBuiltInClass and:[superClassChange]]) ifTrue:[
- self error:'the inheritance of this class is fixed - you cannot change it'.
- ^ oldClass
+ self error:'the inheritance of this class is fixed - you cannot change it'.
+ ^ oldClass
].
"
@@ -880,13 +880,13 @@
only log if this is not the case.
"
changed ifTrue:[
- (superClassChange
- and:[(oldClass superclass isNil or:[oldClass superclass name = newClass superclass name])
- and:[(oldClassVars = newClassVars)
- and:[(oldInstVars = newInstVars)
- and:[newComment = oldClass comment]]]]) ifFalse:[
- self addChangeRecordForClass:newClass.
- ]
+ (superClassChange
+ and:[(oldClass superclass isNil or:[oldClass superclass name = newClass superclass name])
+ and:[(oldClassVars = newClassVars)
+ and:[(oldInstVars = newInstVars)
+ and:[newComment = oldClass comment]]]]) ifFalse:[
+ self addChangeRecordForClass:newClass.
+ ]
].
"
@@ -897,64 +897,64 @@
classVarChange := false.
superClassChange ifTrue:[
- "
- superclass changed:
- must recompile all class methods accessing ANY classvar
- (
- actually, we could be less strict and handle the case where
- both the old and the new superclass have a common ancestor,
- and both have no new classvariables in between.
- This would speedup the case when a class is inserted into
- the inheritance chain.
- )
- "
+ "
+ superclass changed:
+ must recompile all class methods accessing ANY classvar
+ (
+ actually, we could be less strict and handle the case where
+ both the old and the new superclass have a common ancestor,
+ and both have no new classvariables in between.
+ This would speedup the case when a class is inserted into
+ the inheritance chain.
+ )
+ "
- oldClass allClassVarNames do:[:nm | changeSet1 add:nm].
- newClass allClassVarNames do:[:nm | changeSet1 add:nm].
+ oldClass allClassVarNames do:[:nm | changeSet1 add:nm].
+ newClass allClassVarNames do:[:nm | changeSet1 add:nm].
" "
- Transcript showCr:'recompiling class methods accessing any classvar'.
- Transcript endEntry.
+ Transcript showCr:'recompiling class methods accessing any classvar'.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:(oldClass class)
- for:newMetaclass
- accessingAny:changeSet1
- orSuper:true.
- newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ self copyInvalidatedMethodsFrom:(oldClass class)
+ for:newMetaclass
+ accessingAny:changeSet1
+ orSuper:true.
+ newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
] ifFalse:[
- "
- same superclass, find out which classvars have changed
- "
- classVarChange := oldClassVars ~= newClassVars.
- classVarChange ifTrue:[
- oldClassVars do:[:nm |
- (newClassVars includes:nm) ifFalse:[
- changeSet1 add:nm
- ]
- ].
- newClassVars do:[:nm |
- (oldClassVars includes:nm) ifFalse:[
- changeSet1 add:nm
- ]
- ].
- ].
+ "
+ same superclass, find out which classvars have changed
+ "
+ classVarChange := oldClassVars ~= newClassVars.
+ classVarChange ifTrue:[
+ oldClassVars do:[:nm |
+ (newClassVars includes:nm) ifFalse:[
+ changeSet1 add:nm
+ ]
+ ].
+ newClassVars do:[:nm |
+ (oldClassVars includes:nm) ifFalse:[
+ changeSet1 add:nm
+ ]
+ ].
+ ].
- classVarChange ifTrue:[
- "
- must recompile some class-methods
- "
+ classVarChange ifTrue:[
+ "
+ must recompile some class-methods
+ "
" "
- Transcript showCr:'recompiling class methods accessing ' , changeSet1 printString.
- Transcript endEntry.
+ Transcript showCr:'recompiling class methods accessing ' , changeSet1 printString.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:(oldClass class) for:newMetaclass accessingAny:changeSet1.
- newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
- ] ifFalse:[
- "
- class methods still work
- "
- self copyMethodsFrom:(oldClass class) for:newMetaclass
- ].
+ self copyInvalidatedMethodsFrom:(oldClass class) for:newMetaclass accessingAny:changeSet1.
+ newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ ] ifFalse:[
+ "
+ class methods still work
+ "
+ self copyMethodsFrom:(oldClass class) for:newMetaclass
+ ].
].
"
@@ -962,105 +962,105 @@
"
superClassChange ifTrue:[
- "superclass changed,
- must recompile all methods accessing any class or instvar.
- If number of instvars (i.e. the instances instSize) is the same,
- we can limit the set of recompiled instance methods to those methods,
- which refer to an instvar with a different inst-index
- "
+ "superclass changed,
+ must recompile all methods accessing any class or instvar.
+ If number of instvars (i.e. the instances instSize) is the same,
+ we can limit the set of recompiled instance methods to those methods,
+ which refer to an instvar with a different inst-index
+ "
- "
- the changeset consists of instance variables,
- with a different position
- "
- changeSet2 := self differentInstanceVariableOffsetsIn:oldClass and:newClass.
+ "
+ the changeset consists of instance variables,
+ with a different position
+ "
+ changeSet2 := self differentInstanceVariableOffsetsIn:oldClass and:newClass.
- "
- merge in the changed class variables
- "
- changeSet1 do:[:nm | changeSet2 add:nm].
+ "
+ merge in the changed class variables
+ "
+ changeSet1 do:[:nm | changeSet2 add:nm].
" "
- Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:oldClass
- for:newClass
- accessingAny:changeSet2
- orSuper:true.
- newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ self copyInvalidatedMethodsFrom:oldClass
+ for:newClass
+ accessingAny:changeSet2
+ orSuper:true.
+ newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
] ifFalse:[
- "
- same inheritance ...
- "
- instVarChange := oldInstVars ~= newInstVars.
- instVarChange ifFalse:[
- "
- same instance variables ...
- "
- classVarChange ifTrue:[
- "recompile all inst methods accessing changed classvars"
+ "
+ same inheritance ...
+ "
+ instVarChange := oldInstVars ~= newInstVars.
+ instVarChange ifFalse:[
+ "
+ same instance variables ...
+ "
+ classVarChange ifTrue:[
+ "recompile all inst methods accessing changed classvars"
" "
- Transcript showCr:'recompiling instance methods accessing ' , changeSet1 printString , ' ...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling instance methods accessing ' , changeSet1 printString , ' ...'.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet1.
- newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
- ]
- ] ifTrue:[
- "
- dont allow built-in classes to be modified
- "
- (oldClass notNil and:[oldClass isBuiltInClass and:[instVarChange]]) ifTrue:[
- self error:'the layout of this class is fixed - you cannot change it'.
- ^ oldClass
- ].
+ self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet1.
+ newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ ]
+ ] ifTrue:[
+ "
+ dont allow built-in classes to be modified
+ "
+ (oldClass notNil and:[oldClass isBuiltInClass and:[instVarChange]]) ifTrue:[
+ self error:'the layout of this class is fixed - you cannot change it'.
+ ^ oldClass
+ ].
- ((oldInstVars size == 0)
- or:[newInstVars startsWith:oldInstVars]) ifTrue:[
- "
- only new inst variable(s) has/have been added -
- old methods still work (the existing inst-indices are still valid)
- "
+ ((oldInstVars size == 0)
+ or:[newInstVars startsWith:oldInstVars]) ifTrue:[
+ "
+ only new inst variable(s) has/have been added -
+ old methods still work (the existing inst-indices are still valid)
+ "
" "
- Transcript showCr:'copying methods ...'.
- Transcript endEntry.
+ Transcript showCr:'copying methods ...'.
+ Transcript endEntry.
" "
- self copyMethodsFrom:oldClass for:newClass.
+ self copyMethodsFrom:oldClass for:newClass.
- "
- but: we have to recompile all methods accessing new instars
- (it might have been a classVar/global before ...)
- "
- addedNames := newInstVars select:[:nm | (oldInstVars includes:nm) not].
- "merge in class variables"
- changeSet1 do:[:nm | addedNames add:nm].
+ "
+ but: we have to recompile all methods accessing new instars
+ (it might have been a classVar/global before ...)
+ "
+ addedNames := newInstVars select:[:nm | (oldInstVars includes:nm) not].
+ "merge in class variables"
+ changeSet1 do:[:nm | addedNames add:nm].
" "
- Transcript showCr:'recompiling instance methods accessing ' , addedNames printString , '...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling instance methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
" "
- newClass recompileMethodsAccessingAny:addedNames.
- ] ifFalse:[
+ newClass recompileMethodsAccessingAny:addedNames.
+ ] ifFalse:[
- "
- the changeset consists of instance variables,
- with a different position
- "
- changeSet2 := self differentInstanceVariableOffsetsIn:oldClass and:newClass.
+ "
+ the changeset consists of instance variables,
+ with a different position
+ "
+ changeSet2 := self differentInstanceVariableOffsetsIn:oldClass and:newClass.
- "merge in the class variables"
- changeSet1 do:[:nm | changeSet2 add:nm].
+ "merge in the class variables"
+ changeSet1 do:[:nm | changeSet2 add:nm].
" "
- Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
- newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
- ].
- ].
+ self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
+ newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ ].
+ ].
].
"
@@ -1074,13 +1074,13 @@
(dont update change file for the subclass changes)
"
Class withoutUpdatingChangesDo:[
- oldClass subclassesDo:[:aClass |
+ oldClass subclassesDo:[:aClass |
" "
- Transcript showCr:'changing superclass of:' , aClass name.
- Transcript endEntry.
+ Transcript showCr:'changing superclass of:' , aClass name.
+ Transcript endEntry.
" "
- aClass superclass:newClass
- ]
+ aClass superclass:newClass
+ ]
].
"
@@ -1093,12 +1093,12 @@
and make the new class globally known
"
aSystemDictionary notNil ifTrue:[
- aSystemDictionary at:classSymbol put:newClass.
+ aSystemDictionary at:classSymbol put:newClass.
- oldClass category ~= categoryString ifTrue:[
- "notify change of organization"
- aSystemDictionary changed:#organization
- ].
+ oldClass category ~= categoryString ifTrue:[
+ "notify change of organization"
+ aSystemDictionary changed:#organization
+ ].
].
"
@@ -1147,12 +1147,6 @@
!Metaclass methodsFor:'private'!
-setSoleInstance:aClass
- myClass := aClass
-
- "Created: 12.12.1995 / 13:46:22 / cg"
-!
-
anyInvalidatedMethodsIn:aClass
"return true, if aClass has any invalidated methods in it"
@@ -1407,6 +1401,12 @@
Can also happen when Compiler/runtime system is broken."
self error:'invalid method - this method failed to compile when the class was changed'
+!
+
+setSoleInstance:aClass
+ myClass := aClass
+
+ "Created: 12.12.1995 / 13:46:22 / cg"
! !
!Metaclass methodsFor:'queries'!
@@ -1427,5 +1427,5 @@
!Metaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.48 1996-02-21 12:45:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.49 1996-02-29 16:23:55 ca Exp $'
! !