hg/stx-libbasic: comparison Metaclass.st

equal deleted inserted replaced

-:e52341804063
+:59faa75185ba
 COPYRIGHT (c) 1988 by Claus Gittinger
 All Rights Reserved
 every class-class is a subclass of Metaclass
-- this adds support for creating new subclasses or changing the definition
+Metaclass provides support for creating new (sub)classes and/or
-of an already existing class.
+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'!
 name:newName inEnvironment:aSystemDictionary
 |newClass newMetaclass nInstVars nameString classSymbol oldClass
 allSubclasses classVarChange instVarChange superClassChange newComment
 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'.
 ^ nil
 ].
 nameString := newName asString.
 classSymbol := newName asSymbol.
 newComment := commentString.
 "look, if it already exists as a class"
-(aSystemDictionary includesKey:classSymbol) ifTrue:[
+oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
-oldClass := aSystemDictionary at:classSymbol.
+oldClass isBehavior ifFalse:[
-(oldClass isBehavior not or:[oldClass name ~= newName]) ifTrue:[
+oldClass := nil.
-oldClass := nil.
+] ifTrue:[
-] ifFalse:[
+oldClass superclass notNil ifTrue:[
-oldClass allSuperclasses do:[:aClass |
+oldClass allSuperclasses do:[:cls |
-aClass name = newName ifTrue:[
+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
-]
+].
-].
+"
-"I dont like the confirmers below - we need a notifying: argument, to give
+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
+]
+]
+]
+]
+].
+"
+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:[
 ^ nil
 ]
 "create the metaclass first"
 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:[
-newClass flags:(newFlags bitOr:superFlags). "keep the special bits around"
+oldClass isBuiltInClass ifTrue:[
+"
-newClass setName:nameString.
+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))
+]
+].
+newClass flags:(newFlags bitOr:superFlags). "preserve  inherited special bits"
 (nInstVars ~~ 0) ifTrue:[
 newClass instanceVariableString:stringOfInstVarNames
 ].
 oldClass notNil ifTrue:[
 "setting first will make new class clear obsolete classvars"
 newClass setClassVariableString:(oldClass classVariableString)
 ].
 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"
+"
+when we arrive here, class variables have changed
-(newComment ~= oldClass comment) ifTrue:[
+"
-oldClass comment:newComment.        "already writes change-chunk"
-].
 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:[
 changeSet1 add: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"
+"
+"
+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.
-oldClass withAllSubclasses do:[:aClass |
+Transcript endEntry.
-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.
 oldClass changed.
 ]
 ]
 ]
 ].
-"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
 ].
 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)
 and:[(oldInstVars = newInstVars)
 and:[newComment = oldClass comment]]]]) ifFalse:[
 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 |
 (newClassVars includes:nm) ifFalse:[
 changeSet1 add:nm
 changeSet1 add:nm
 ]
 ].
 ].
-" "
-Transcript showCr:'recompiling class methods accessing ' , changeSet1 printString.
-" "
 classVarChange ifTrue:[
-"must recompile class-methods"
+"
+must recompile some 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,
-"no, if number of instvars is the same, only the changed ones ..."
+we can limit the set of recompiled instance methods to those methods,
+which refer to an instvar with a different inst-index
-"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|
 k := a key.
 (newOffsets includesKey:k) ifFalse:[
 changeSet2 add:k
 ]
 ]
 ].
+"
+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:[
-((oldInstVars size == 0)
+"
-or:[newInstVars startsWith:oldInstVars]) ifTrue:[
+only new inst variable(s) has/have been added -
-"new variable(s) has/have been added - old methods still work"
+old methods still work (the existing inst-indices are still valid)
+"
-Transcript showCr:'copying methods ...'.
+" "
-self copyMethodsFrom:oldClass for:newClass.
+Transcript showCr:'copying methods ...'.
+Transcript endEntry.
-"but have to recompile methods accessing stuff now defined
+" "
-(it might have been a global before ...)"
+self copyMethodsFrom:oldClass for:newClass.
-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 ...)
-" "
+"
-Transcript showCr:'recompiling instance methods accessing ' , addedNames printString ,  '...'.
+addedNames := newInstVars select:[:nm | (oldInstVars includes:nm) not].
-" "
+"merge in class variables"
-newClass recompileMethodsAccessingAny:addedNames.
+changeSet1 do:[:nm | addedNames add:nm].
-] ifFalse:[
-"find set of changed instvars"
+" "
+Transcript showCr:'recompiling instance methods accessing ' , addedNames printString ,  '...'.
-offset := 0. oldOffsets := Dictionary new.
+Transcript endEntry.
-oldInstVars do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
+" "
-offset := 0. newOffsets := Dictionary new.
+newClass recompileMethodsAccessingAny:addedNames.
-newInstVars do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+] ifFalse:[
+"
-oldOffsets associationsDo:[:a |
+collect the instvar-indices in the old and new class
-|k|
+"
+offset := 0. oldOffsets := Dictionary new.
-k := a key.
+oldInstVars do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
-(newOffsets includesKey:k) ifFalse:[
+offset := 0. newOffsets := Dictionary new.
+newInstVars do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+"
+the changeset consists of instance variables,
+whith a different position
+"
+oldOffsets associationsDo:[:a |
+|k|
+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].
-" "
-Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
-" "
-self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
-newClass recompileInvalidatedMethods.
 ].
+"merge in class variables"
+changeSet1 do:[:nm | changeSet2 add:nm].
+" "
+Transcript showCr:'recompiling instance methods accessing ' , changeSet2 printString , ' ...'.
+Transcript endEntry.
+" "
+self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet2.
+newClass recompileInvalidatedMethods.
 ].
 ].
 ].
-"get list of all subclasses - do before superclass is changed"
+"
+WOW, everything done for this class
+what about subclasses ?
+"
+"
+get list of all subclasses - do this before superclass is changed
+"
+"no longer needed"
+"
 allSubclasses := oldClass allSubclasses.
+"
-"update superclass of immediate subclasses - this forces recompilation if needed"
+"
-"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
 ]
 ] valueNowOrOnUnwindDo:[
 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
 !
 new
 "create & return a new metaclass (a classes class)"
 allSubclasses t oldVars
 oldNames newNames addedNames
 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:[
 "
 Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
 "no real change (just formatting)"
 self instanceVariableString:aString.
 ^ 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 |
 okSoFar and:[word first isUppercase]
 ])
 ifTrue:[
 "was ok before"
 (newNames inject:true
 into:[:okSoFar :word |
 okSoFar and:[word first isUppercase]
 ])
 ifFalse:[
 (self confirm:'class instance variable names should start with an uppercase letter
 (by convention only)
 ((oldNames size == 0)
 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.
 "but have to recompile methods accessing stuff now defined
 (it might have been a global before ...)"
 addedNames := newNames select:[:nm | (oldNames includes:nm) not].
 "
-Transcript showCr:'recompiling methods accessing ' ,
+Transcript showCr:'recompiling methods accessing ' , addedNames printString ,  '...'.
-addedNames printString ,  '...'.
+Transcript endEntry.
 "
 "recompile class-methods"
 newMetaclass recompileMethodsAccessingAny:addedNames.
 ] ifFalse:[
 "
-Transcript showCr:'recompiling methods accessing ' ,
+Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
-changeSet printString , ' ...'.
+Transcript endEntry.
 "
 "recompile class-methods"
 self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
 newMetaclass recompileInvalidatedMethods.
 self copyMethodsFrom:oldClass for:newClass.
 ].
 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
 ].
 oldSuper == oldClass ifTrue:[
 newSub setSuperclass:newClass.
 ] ifFalse:[
 newSub setSuperclass:(oldToNew at:oldSuper).
 ].
-newSub setSelectors:(aSubclass selectors).
+newSub setSelectors:(aSubclass selectorArray).
-newSub setMethodDictionary:(aSubclass methodDictionary).
+newSub setMethodDictionary:(aSubclass methodArray).
 newSub setName:(aSubclass name).
 newSub classVariableString:(aSubclass classVariableString).
 newSub setComment:(aSubclass comment).
 newSub category:(aSubclass category).
 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|
 classInstVars := aClass class allInstVarNames.
 allSubclasses do:[:aClass |
 Smalltalk at:(oldToNew at:aClass) name asSymbol put:(oldToNew at:aClass).
 ObjectMemory flushCachesFor:aClass.
 ].
-"tell dependents of class ..."
+"tell dependents ..."
 oldClass changed.
 self changed.
 ^ newMetaclass
 ! !
 !Metaclass methodsFor:'queries'!
 ^ true
 ! !
 !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
 "when a class has been changed, copy all old methods into the new class
 - changing code to a trap method giving an error message;
 this allows us to keep the source while trapping uncompilable (due to
 now undefined instvars) methods"
 |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.
 newMethod literals:nil.
 newMethod byteCode:trapByteCode.
 a variable in setOfNames will be copied as invalid method, leading to
 a trap when its executed."
 |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.
 (p isNil or:[p usedVars notNil and:[p usedVars includesAny:setOfNames]]) ifTrue:[
 newMethod := oldMethod copy.
 anyInvalidatedMethodsIn:aClass
 "return true, if aClass has any invalidated methods in it"
 |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]
 ].
 trapByteCode notNil ifTrue:[
 (aMethod byteCode == trapByteCode) ifTrue:[^ true]

changeset 68	59faa75185ba
parent 49	f1c2d75f2eb6
child 77	6c38ca59927f