--- a/Metaclass.st Wed Mar 16 10:40:51 1994 +0100
+++ b/Metaclass.st Wed Mar 30 11:38:21 1994 +0200
@@ -23,10 +23,10 @@
All Rights Reserved
every class-class is a subclass of Metaclass
-- this adds support for creating new subclasses or changing the definition
-of an already existing class.
+Metaclass provides support for creating new (sub)classes and/or
+changing the definition of an already existing class.
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.9 1994-02-05 12:21:45 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.10 1994-03-30 09:32:39 claus Exp $
'!
!Metaclass methodsFor:'creating classes'!
@@ -57,7 +57,10 @@
changeSet1 changeSet2 offset oldOffsets newOffsets addedNames
anyChange oldInstVars newInstVars oldClassVars newClassVars upd superFlags newFlags|
- "this method is too complex and should be splitted into managable pieces ..."
+ "NOTICE:
+ this method is too complex and should be splitted into managable pieces ...
+ I dont like it anymore :-)
+ "
newName = aClass name ifTrue:[
self error:'trying to create circular class definition'.
@@ -76,33 +79,72 @@
newComment := commentString.
"look, if it already exists as a class"
- (aSystemDictionary includesKey:classSymbol) ifTrue:[
- oldClass := aSystemDictionary at:classSymbol.
- (oldClass isBehavior not or:[oldClass name ~= newName]) ifTrue:[
- oldClass := nil.
- ] ifFalse:[
- oldClass allSuperclasses do:[:aClass |
- aClass name = newName ifTrue:[
+ oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
+ oldClass isBehavior ifFalse:[
+ oldClass := nil.
+ ] ifTrue:[
+ 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
]
].
+ ].
- 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
+ ]
+ ]
]
]
].
- "I dont like the confirmers below - we need a notifying: argument, to give
+ "
+ Check for some 'considered bad-style' things, like lower case names.
+ But only do these checks for new classes -
+ - thus, once confirmed, the warnings will not come again and again.
+
+ NOTICE:
+ I dont like the confirmers below - we need a notifying: argument, to give
the outer codeview a chance to highlight the error.
- (but thats how PP defined it in the book - maybe it will change anyway"
+ (but thats how its defined in the book - maybe I will change anyway).
+ "
oldClass isNil ifTrue:[
"let user confirm, if the classname is no good"
newName first isUppercase ifFalse:[
(self confirm:'classenames should start with an uppercase letter
-(by convention)
+(by convention only)
install anyway ?' withCRs)
ifFalse:[
@@ -149,47 +191,61 @@
newMetaclass := Metaclass new.
newMetaclass setSuperclass:(aClass class).
newMetaclass instSize:(aClass class instSize).
- newMetaclass flags:0. "not indexed"
newMetaclass setName:(nameString , 'class').
newMetaclass classVariableString:'' "stringOfClassVarNames".
newMetaclass setComment:newComment category:categoryString.
+ "the let the meta create the class"
newClass := newMetaclass new.
newClass setSuperclass:aClass.
newClass instSize:(aClass instSize + nInstVars).
+ newClass setName:nameString.
+ "
+ Allowing non-booleans as variableBoolean
+ is a hack for backward (ST-80) compatibility:
+
+ ST-80 code will pass true or false as variableBoolean,
+ while ST/X also calls it with symbols such as #float, #double etc.
+ "
(variableBoolean == true) ifTrue:[
pointersBoolean ifTrue:[
- newFlags := 4 "pointerarray"
+ newFlags := Behavior flagPointers
] ifFalse:[
wordsBoolean ifTrue:[
- newFlags := 2 "wordarray"
+ newFlags := Behavior flagWords
] ifFalse:[
- newFlags := 1 "bytearray"
+ newFlags := Behavior flagBytes
]
]
] ifFalse:[
- "this is a backward compatible hack"
-
(variableBoolean == #float) ifTrue:[
- newFlags := 6 "float array"
+ newFlags := Behavior flagFloats
] ifFalse:[
(variableBoolean == #double) ifTrue:[
- newFlags := 7 "double array"
+ newFlags := Behavior flagDoubles
] ifFalse:[
(variableBoolean == #long) ifTrue:[
- newFlags := 3 "long array"
+ newFlags := Behavior flagLongs
] ifFalse:[
- newFlags := 0
+ newFlags := Behavior flagNotIndexed
]
]
].
].
- superFlags := aClass flags bitAnd:16rFFFF0. "everything except indexed-spec"
+ 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 ...
+ "
- newClass flags:(newFlags bitOr:superFlags). "keep the special bits around"
+ newFlags := newFlags bitOr:(oldClass flags bitAnd:(Behavior maskIndexType bitInvert))
+ ]
+ ].
+ newClass flags:(newFlags bitOr:superFlags). "preserve inherited special bits"
- newClass setName:nameString.
(nInstVars ~~ 0) ifTrue:[
newClass instanceVariableString:stringOfInstVarNames
].
@@ -199,64 +255,89 @@
].
newClass classVariableString:stringOfClassVarNames.
+ "
+ for new classes, we are almost done here
+ "
oldClass isNil ifTrue:[
self addChangeRecordForClass:newClass.
commentString notNil ifTrue:[
newClass comment:commentString
].
+
aSystemDictionary at:classSymbol put:newClass.
- Smalltalk changed.
+ aSystemDictionary changed.
^ newClass
].
+ "
+ here comes the hard part - we are actually changing the
+ definition of an existing class ....
+ Try hard to get away WITHOUT recompiling, since it makes all
+ compiled code into interpreted ...
+ "
+
oldInstVars := oldClass instanceVariableString asCollectionOfWords.
newInstVars := newClass instanceVariableString asCollectionOfWords.
oldClassVars := oldClass classVariableString asCollectionOfWords.
newClassVars := newClass classVariableString asCollectionOfWords.
- "if only category/comment has changed, do not recompile .."
-
+ "
+ we are on the bright side of life, if the instance layout and
+ inheritance do not change.
+ In this case, we can go ahead and patch the class object.
+ "
(oldClass superclass == newClass superclass) ifTrue:[
(oldClass instSize == newClass instSize) ifTrue:[
(oldClass flags == newClass flags) ifTrue:[
(oldClass name = newClass name) ifTrue:[
(oldInstVars = newInstVars) ifTrue:[
+
+ (newComment ~= oldClass comment) ifTrue:[
+ oldClass comment:newComment. "writes a change-chunk"
+ ].
+
(oldClassVars = newClassVars) ifTrue:[
+ "
+ really no change (just comment and/or category)
+ "
anyChange := false.
-
oldClass instanceVariableString:(newClass instanceVariableString).
oldClass setClassVariableString:(newClass classVariableString).
- (newComment ~= oldClass comment) ifTrue:[
- oldClass comment:newComment. "already writes change-chunk"
- ].
oldClass category ~= categoryString ifTrue:[
"notify change of organization"
+
oldClass category:categoryString.
self addChangeRecordForClass:newClass.
- Smalltalk changed
+ aSystemDictionary changed
].
"notify change of class"
oldClass changed.
^ oldClass
].
- "when we arrive here, class variables have changed"
-
- (newComment ~= oldClass comment) ifTrue:[
- oldClass comment:newComment. "already writes change-chunk"
- ].
+ "
+ when we arrive here, class variables have changed
+ "
oldClass category ~= categoryString ifTrue:[
"notify change of organization"
oldClass category:categoryString.
- Smalltalk changed
+ aSystemDictionary changed
].
+ "
+ 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:[
@@ -269,19 +350,27 @@
]
].
- "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"
+ "
+ dont update change file for the recompilation
+ "
upd := Class updateChanges:false.
+ [
" "
- Transcript showCr:'recompiling class&inst methods accessing ' , changeSet1 printString.
+ 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.
+ ].
+ ] valueNowOrOnUnwindDo:[
+ Class updateChanges:upd.
].
- Class updateChanges:upd.
"notify change of class"
self addChangeRecordForClass:oldClass.
@@ -294,11 +383,15 @@
]
].
- "tell dependents of class ..."
+ "tell dependents ..."
+"OLD:
oldClass changed.
+"
- "catch special case, where superclass changed its layout and thus
- forced redefinition of this class - this will not be logged here"
+
+ "
+ here we enter the darkness of mordor ...
+ "
(newComment ~= oldClass comment) ifTrue:[
newClass comment:newComment
@@ -306,12 +399,19 @@
superClassChange := oldClass superclass ~~ newClass superclass.
- "dont allow built-in classes to be modified"
+ "
+ 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
].
+ "
+ catch special case, where superclass changed its layout and thus
+ forced redefinition of this class;
+ only log if this is not the case.
+ "
(superClassChange
and:[(oldClass superclass isNil or:[oldClass superclass name = newClass superclass name])
and:[(oldClassVars = newClassVars)
@@ -320,26 +420,39 @@
self addChangeRecordForClass:newClass.
].
+ "
+ care for class methods ...
+ "
changeSet1 := Set new.
- changeSet2 := Set new.
classVarChange := false.
superClassChange ifTrue:[
- "superclass changed,
- must recompile all class methods accessing any classvar"
+ "
+ 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].
" "
Transcript showCr:'recompiling class methods accessing any classvar'.
+ Transcript endEntry.
" "
self copyInvalidatedMethodsFrom:(oldClass class) for:newMetaclass accessingAny:changeSet1.
newMetaclass recompileInvalidatedMethods.
] ifFalse:[
- "same superclass, find out which classvars have changed"
-
+ "
+ same superclass, find out which classvars have changed
+ "
classVarChange := oldClassVars ~= newClassVars.
classVarChange ifTrue:[
oldClassVars do:[:nm |
@@ -354,32 +467,49 @@
].
].
-" "
- Transcript showCr:'recompiling class methods accessing ' , changeSet1 printString.
+ classVarChange ifTrue:[
+ "
+ must recompile some class-methods
+ "
" "
- classVarChange ifTrue:[
- "must recompile class-methods"
+ Transcript showCr:'recompiling class methods accessing ' , changeSet1 printString.
+ Transcript endEntry.
+" "
self copyInvalidatedMethodsFrom:(oldClass class) for:newMetaclass accessingAny:changeSet1.
newMetaclass recompileInvalidatedMethods.
] ifFalse:[
- "class methods still work"
+ "
+ class methods still work
+ "
self copyMethodsFrom:(oldClass class) for:newMetaclass
].
].
+ "
+ care for instance methods ...
+ "
+ changeSet2 := Set new.
+
superClassChange ifTrue:[
"superclass changed,
- must recompile all class methods accessing any class or instvar"
+ 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
+ "
- "no, if number of instvars is the same, only the changed ones ..."
-
- "find set of changed instvars"
-
+ "
+ collect the instvar-indices in the old and new class
+ "
offset := 0. oldOffsets := Dictionary new.
oldClass allInstVarNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
offset := 0. newOffsets := Dictionary new.
newClass allInstVarNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+ "
+ the changeset consists of instance variables,
+ whith a different position
+ "
oldOffsets associationsDo:[:a |
|k|
@@ -405,123 +535,144 @@
]
].
+ "
+ merge in the changed class variables
+ "
changeSet1 do:[:nm | changeSet2 add:nm].
+
" "
- Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , '
- ...'.
+ Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+ Transcript endEntry.
" "
self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
newClass recompileInvalidatedMethods.
-false ifTrue:[
- oldClass allClassVarNames do:[:nm | changeSet1 add:nm].
- newClass allClassVarNames do:[:nm | changeSet1 add:nm].
- oldClass allInstVarNames do:[:nm | changeSet1 add:nm].
- newClass allInstVarNames do:[:nm | changeSet1 add:nm].
-
-" "
- Transcript showCr:'recompiling instance methods accessing any class or instvar' .
-" "
- self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet1.
- newClass recompileInvalidatedMethods.
-]
] ifFalse:[
+ "
+ same inheritance ...
+ "
instVarChange := oldInstVars ~= newInstVars.
instVarChange ifFalse:[
+ "
+ same instance variables ...
+ "
classVarChange ifTrue:[
- "recompile all inst methods accessing classvars"
+ "recompile all inst methods accessing changed classvars"
" "
Transcript showCr:'recompiling instance methods accessing ' , changeSet1 printString , ' ...'.
+ Transcript endEntry.
" "
self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet1.
newClass recompileInvalidatedMethods.
]
] ifTrue:[
- instVarChange := (oldInstVars ~= newInstVars).
-
- "dont allow built-in classes to be modified"
+ "
+ 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
].
- instVarChange ifTrue:[
-
- ((oldInstVars size == 0)
- or:[newInstVars startsWith:oldInstVars]) ifTrue:[
- "new variable(s) has/have been added - old methods still work"
+ ((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.
+" "
+ self copyMethodsFrom:oldClass for:newClass.
- Transcript showCr:'copying methods ...'.
- self copyMethodsFrom:oldClass for:newClass.
-
- "but have to recompile methods accessing stuff now defined
- (it might have been a global before ...)"
-
- addedNames := newInstVars select:[:nm | (oldInstVars includes:nm) not].
- 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 showCr:'recompiling instance methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
" "
- newClass recompileMethodsAccessingAny:addedNames.
- ] ifFalse:[
- "find set of changed instvars"
-
- offset := 0. oldOffsets := Dictionary new.
- oldInstVars do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
- offset := 0. newOffsets := Dictionary new.
- newInstVars do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+ newClass recompileMethodsAccessingAny:addedNames.
+ ] ifFalse:[
+ "
+ collect the instvar-indices in the old and new class
+ "
+ offset := 0. oldOffsets := Dictionary new.
+ oldInstVars do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
+ offset := 0. newOffsets := Dictionary new.
+ newInstVars do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
- oldOffsets associationsDo:[:a |
- |k|
+ "
+ the changeset consists of instance variables,
+ whith a different position
+ "
+ oldOffsets associationsDo:[:a |
+ |k|
- k := a key.
- (newOffsets includesKey:k) ifFalse:[
+ k := a key.
+ (newOffsets includesKey:k) ifFalse:[
+ changeSet2 add:k
+ ] ifTrue:[
+ (a value ~~ (newOffsets at:k)) ifTrue:[
changeSet2 add:k
- ] ifTrue:[
- (a value ~~ (newOffsets at:k)) ifTrue:[
- changeSet2 add:k
- ]
]
- ].
- newOffsets associationsDo:[:a |
- |k|
+ ]
+ ].
+ newOffsets associationsDo:[:a |
+ |k|
- k := a key.
- (oldOffsets includesKey:k) ifFalse:[
+ k := a key.
+ (oldOffsets includesKey:k) ifFalse:[
+ changeSet2 add:k
+ ] ifTrue:[
+ (a value ~~ (oldOffsets at:k)) ifTrue:[
changeSet2 add:k
- ] ifTrue:[
- (a value ~~ (oldOffsets at:k)) ifTrue:[
- changeSet2 add:k
- ]
]
- ].
-
- changeSet1 do:[:nm | changeSet2 add:nm].
+ ]
+ ].
+ "merge in class variables"
+ changeSet1 do:[:nm | changeSet2 add:nm].
" "
- Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+ Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+ Transcript endEntry.
" "
- self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
- newClass recompileInvalidatedMethods.
-
- ].
+ self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
+ newClass recompileInvalidatedMethods.
].
].
].
- "get list of all subclasses - do before superclass is changed"
-
- allSubclasses := oldClass allSubclasses.
+ "
+ WOW, everything done for this class
+ what about subclasses ?
+ "
- "update superclass of immediate subclasses - this forces recompilation if needed"
+ "
+ get list of all subclasses - do this before superclass is changed
+ "
+"no longer needed"
+"
+ allSubclasses := oldClass allSubclasses.
+"
- "dont update change file for the subclass changes"
+ "
+ update superclass of immediate subclasses -
+ this forces recompilation (recursively) if needed
+ (dont update change file for the subclass changes)
+ "
upd := Class updateChanges:false.
[
oldClass subclassesDo:[:aClass |
" "
Transcript showCr:'changing superclass of:' , aClass name.
+ Transcript endEntry.
" "
aClass superclass:newClass
]
@@ -529,8 +680,37 @@
Class updateChanges:upd.
].
+ "
+ change category in oldClass - so we see immediately what it is ...
+ "
+ oldClass category:'obsolete'.
+ oldClass class category:'obsolete'.
+
+ "
+ and make the new class globally known
+ "
aSystemDictionary at:classSymbol put:newClass.
+
+ oldClass category ~= categoryString ifTrue:[
+ "notify change of organization"
+ aSystemDictionary changed
+ ].
+
+ "
+ Not becoming the old class creates some update problems;
+ the browsers must check carefully - a simple identity compare is
+ not enought ...
+ QUESTION: is this a good idea ?
+ "
+
+ newClass dependents:(oldClass dependents).
+ newClass changed.
+
+ "just to make certain ..."
+ oldClass changed.
+
ObjectMemory flushCaches.
+
^ newClass
!
@@ -561,8 +741,10 @@
oldOffsets newOffsets offset changeSet delta
oldToNew newSubMeta newSub oldSubMeta oldSuper|
- "cleanup needed here: extract common things with name:inEnvironment:...
- and structure things ... currently way too complex."
+ "
+ cleanup needed here: extract common things with name:inEnvironment:...
+ and restructure things ... currently way too complex.
+ "
oldVars := self instanceVariableString.
aString = oldVars ifTrue:[
@@ -584,15 +766,17 @@
^ self
].
- "let user confirm, if any name is no good (and was good before)"
+ "
+ let user confirm, if any name is no good (and was good before)
+ "
(oldNames inject:true
- into:[:okSoFar :word |
+ into:[:okSoFar :word |
okSoFar and:[word first isUppercase]
])
ifTrue:[
"was ok before"
(newNames inject:true
- into:[:okSoFar :word |
+ into:[:okSoFar :word |
okSoFar and:[word first isUppercase]
])
ifFalse:[
@@ -680,7 +864,10 @@
or:[newNames startsWith:oldNames]) ifTrue:[
"new variable(s) has/have been added - old methods still work"
+" "
Transcript showCr:'copying methods ...'.
+ Transcript endEntry.
+" "
self copyMethodsFrom:self for:newMetaclass.
self copyMethodsFrom:oldClass for:newClass.
@@ -689,15 +876,15 @@
addedNames := newNames select:[:nm | (oldNames includes:nm) not].
"
- Transcript showCr:'recompiling methods accessing ' ,
- addedNames printString , '...'.
+ Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
"
"recompile class-methods"
newMetaclass recompileMethodsAccessingAny:addedNames.
] ifFalse:[
"
- Transcript showCr:'recompiling methods accessing ' ,
- changeSet printString , ' ...'.
+ Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
+ Transcript endEntry.
"
"recompile class-methods"
self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
@@ -708,8 +895,9 @@
delta := newNames size - oldNames size.
- "get list of all subclasses - do before superclass is changed"
-
+ "
+ get list of all subclasses - do before superclass is changed
+ "
allSubclasses := oldClass allSubclasses.
allSubclasses := allSubclasses asSortedCollection:[:a :b |
b isSubclassOf:a
@@ -742,8 +930,8 @@
] ifFalse:[
newSub setSuperclass:(oldToNew at:oldSuper).
].
- newSub setSelectors:(aSubclass selectors).
- newSub setMethodDictionary:(aSubclass methodDictionary).
+ newSub setSelectors:(aSubclass selectorArray).
+ newSub setMethodDictionary:(aSubclass methodArray).
newSub setName:(aSubclass name).
newSub classVariableString:(aSubclass classVariableString).
newSub setComment:(aSubclass comment).
@@ -751,21 +939,28 @@
oldToNew at:aSubclass put:newSub.
+"
aSubclass setName:(aSubclass name , '-old').
aSubclass category:'obsolete classes'
+"
+ aSubclass category:'obsolete'.
+ aSubclass class category:'obsolete'.
].
"recompile what needs to be"
delta == 0 ifTrue:[
"only have to recompile class methods accessing
- class instvars from changeset"
+ class instvars from changeset
+ "
allSubclasses do:[:aClass |
aClass class recompileMethodsAccessingAny:changeSet.
]
] ifFalse:[
- "have to recompile all class methods accessing class instvars"
+ "
+ have to recompile all class methods accessing class instvars
+ "
allSubclasses do:[:aClass |
|classInstVars|
@@ -786,10 +981,11 @@
ObjectMemory flushCachesFor:aClass.
].
- "tell dependents of class ..."
+ "tell dependents ..."
oldClass changed.
self changed.
+
^ newMetaclass
! !
@@ -804,11 +1000,21 @@
!Metaclass methodsFor:'private'!
+invalidMethod
+ "When recompiling classes after a definition-change, all
+ uncompilable methods will be bound to this method here,
+ so that evaluating such an uncompilable method will trigger an error.
+ Can also happen when Compiler/runtime system is broken."
+
+ self error:'invalid method - this method failed to compile when the class was changed'
+!
+
copyMethodsFrom:oldClass for:newClass
"when a class has changed, but metaclass is unaffected (i.e. classVars
have not changed) there is no need to recompile them"
- newClass selectors:(oldClass selectors copy) methods:(oldClass methodDictionary copy)
+ newClass selectors:(oldClass selectorArray copy)
+ methods:(oldClass methodArray copy)
!
copyInvalidatedMethodsFrom:oldClass for:newClass
@@ -819,13 +1025,14 @@
|trap trapCode trapByteCode newMethod oldMethodArray newMethodArray|
- trap := Method compiledMethodAt:#invalidMethod.
+ trap := Metaclass compiledMethodAt:#invalidMethod.
trapCode := trap code.
trapByteCode := trap byteCode.
- oldMethodArray := oldClass methodDictionary.
+ oldMethodArray := oldClass methodArray.
newMethodArray := Array new:(oldMethodArray size).
- newClass selectors:(oldClass selectors copy) methods:newMethodArray.
+ newClass selectors:(oldClass selectorArray copy)
+ methods:newMethodArray.
1 to:oldMethodArray size do:[:i |
newMethod := (oldMethodArray at:i) copy.
newMethod code:trapCode.
@@ -842,13 +1049,14 @@
|trap trapCode trapByteCode p oldMethod newMethod oldMethodArray newMethodArray|
- trap := Method compiledMethodAt:#invalidMethod.
+ trap := Metaclass compiledMethodAt:#invalidMethod.
trapCode := trap code.
trapByteCode := trap byteCode.
- oldMethodArray := oldClass methodDictionary.
+ oldMethodArray := oldClass methodArray.
newMethodArray := Array new:(oldMethodArray size).
- newClass selectors:(oldClass selectors copy) methods:newMethodArray.
+ newClass selectors:(oldClass selectorArray copy)
+ methods:newMethodArray.
1 to:oldMethodArray size do:[:i |
oldMethod := oldMethodArray at:i.
p := Parser parseMethod:(oldMethod source) in:newClass.
@@ -869,11 +1077,11 @@
|trap trapCode trapByteCode|
- trap := Method compiledMethodAt:#invalidMethod.
+ trap := Metaclass compiledMethodAt:#invalidMethod.
trapCode := trap code.
trapByteCode := trap byteCode.
- aClass methodDictionary do:[:aMethod |
+ aClass methodArray do:[:aMethod |
trapCode notNil ifTrue:[
(aMethod code == trapCode) ifTrue:[^ true]
].