"
 COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Class subclass:#Metaclass
       instanceVariableNames:''
       classVariableNames:''
       poolDictionaries:''
       category:'Kernel-Classes'
!

Metaclass comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.15 1994-10-10 00:26:39 claus Exp $
'!

!Metaclass class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.15 1994-10-10 00:26:39 claus Exp $
"
!

documentation
"
    every classes class is a subclass of Metaclass.
    Metaclass provides support for creating new (sub)classes and/or 
    changing the definition of an already existing class.
"
! !

!Metaclass methodsFor:'creating classes'!

name:newName inEnvironment:aSystemDictionary
	     subclassOf:aClass
	     instanceVariableNames:stringOfInstVarNames
	     variable:variableBoolean
	     words:wordsBoolean
	     pointers:pointersBoolean
	     classVariableNames:stringOfClassVarNames
	     poolDictionaries:stringOfPoolNames
	     category:categoryString
	     comment:commentString
	     changed:changed

    "this is the main workhorse for installing new classes - special care
     has to be taken, when changing an existing classes definition. In this
     case, some or all of the methods and subclasses methods have to be
     recompiled.
     Also, the old class(es) are still kept (but not accessable as a global),
     to allow existing instances some life. 
     This might change in the future.
    "

    |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|

    "NOTICE:
     this method is too complex and should be splitted into managable pieces ...
     I dont like it anymore :-) 
     (However, its a good test for the compilers ability to handle big, complex methods ;-)
    "

    newName = aClass name ifTrue:[
	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).
	^ oldClass
    ].

    nInstVars := stringOfInstVarNames countWords.
    nameString := newName asString.
    classSymbol := newName asSymbol.
    newComment := commentString.

    "look, if it already exists as a class"
    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
	].

	"
	 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 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 only)

install anyway ?' withCRs)
		ifFalse:[
		    ^ nil
		]
	].

	"let user confirm, if any instvarname is no good"
	(stringOfInstVarNames asCollectionOfWords 
		  inject:true
		    into:[:okSoFar :word |
			     okSoFar and:[word first isLowercase]
			 ]

	) ifFalse:[
	    (self confirm:'instance variable names should start with a lowercase letter
(by convention only)

install anyway ?' withCRs)
	    ifFalse:[
		^ nil
	    ]
	].

	"let user confirm, if any classvarname is no good"
	(stringOfClassVarNames asCollectionOfWords 
		  inject:true
		    into:[:okSoFar :word |
			     okSoFar and:[word first isUppercase]
			 ]

	) ifFalse:[
	    (self confirm:'class variable names should start with an uppercase letter
(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 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 := 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   
		]
	    ]
	].
    ].
    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 ...
	    "

	    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
     (also for autoloaded classes)
    "
    (oldClass isNil or:[oldClass isLoaded not]) ifTrue:[
	oldClass isNil ifTrue:[
	    self addChangeRecordForClass:newClass.
	].

	commentString notNil ifTrue:[
	    newClass comment:commentString
	].

	aSystemDictionary at:classSymbol put:newClass.
	aSystemDictionary changed:#newClass with:newClass.
	^ 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.

    "
     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 setComment:newComment.        "writes a change-chunk"
		  oldClass changed:#comment with:oldClass comment.
		  self addChangeRecordForClassComment:oldClass.
	      ]. 

	      (oldClassVars = newClassVars) ifTrue:[
		"
		 really no change (just comment and/or category)
		"
		anyChange := false.

		oldClass instanceVariableString:(newClass instanceVariableString).
		oldClass setClassVariableString:(newClass classVariableString).

		oldClass category ~= categoryString ifTrue:[
		    oldClass category:categoryString. 
		    self addChangeRecordForClass:newClass.
		    "notify change of organization"
		    aSystemDictionary changed
		].
		"notify change of class"
"/                oldClass changed.
		^ oldClass
	      ].

	      "
	       when we arrive here, class variables have changed
	      "
	      oldClass category ~= categoryString ifTrue:[
		  "notify change of organization"
		  oldClass category:categoryString. 
		  "notify change of organization"
		  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
		  ]
	      ].
	      newClassVars do:[:nm |
		  (oldClassVars includes:nm) ifFalse:[
		      changeSet1 add:nm
		  ]
	      ].

	      "
	       recompile all methods accessing set of changed classvars
	       here and also in all subclasses ...
	      "

	      "
	       dont update change file for the recompilation
	      "
	      upd := Class updateChanges:false.
	      [
" "
		  Transcript showCr:'recompiling class & inst methods accessing ' , changeSet1 printString.
		  Transcript endEntry.
" "
		  oldClass withAllSubclasses do:[:aClass |
		      aClass class recompileMethodsAccessingAny:changeSet1.
		      aClass recompileMethodsAccessingAny:changeSet1.
		  ].
	      ] valueNowOrOnUnwindDo:[
		  Class updateChanges:upd.
	      ].

	      "notify change of class"
	      self addChangeRecordForClass:oldClass.
	      oldClass changed:#definition.

	      ^ oldClass
	    ]
	  ]
	]
      ]
    ].

    "
     here we enter the darkness of mordor ...
     since instance variable layout and/or inheritance has changed.
    "

    (newComment ~= oldClass comment) ifTrue:[
	newClass comment:newComment
    ].

    superClassChange := oldClass superclass ~~ newClass superclass.

    "
     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.

    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.
	 )
	"

	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
				orSuper:true.
	newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidMethod).
    ] 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
		]
	    ].
	].

	classVarChange ifTrue:[
	    "
	     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:(Metaclass compiledMethodAt:#invalidMethod).
	] ifFalse:[
	    "
	     class methods still work
	    "
	    self copyMethodsFrom:(oldClass class) for:newMetaclass
	].
    ].

    "
     care for instance methods ...
    "
    changeSet2 := Set new.

    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
	"

	"
	 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
	    ] ifTrue:[
		(a value ~~ (newOffsets at:k)) ifTrue:[
		    changeSet2 add:k
		]
	    ]
	].
	newOffsets associationsDo:[:a |
	    |k|

	    k := a key.
	    (oldOffsets includesKey:k) ifFalse:[
		changeSet2 add:k
	    ] ifTrue:[
		(a value ~~ (oldOffsets at:k)) ifTrue:[
		    changeSet2 add:k
		]
	    ]
	].

	"
	 merge in the changed 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
				orSuper:true.
	newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidMethod).

    ] ifFalse:[
	"
	 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.
" "
		self copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:changeSet1.
		newClass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidMethod).
	    ]
	] 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)
		"
" "
		Transcript showCr:'copying methods ...'.
		Transcript endEntry.
" "
		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].

" "
		Transcript showCr:'recompiling instance methods accessing ' , addedNames printString ,  '...'.
		Transcript endEntry.
" "
		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].

		"
		 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
			]
		    ]
		].
		newOffsets associationsDo:[:a |
		    |k|

		    k := a key.
		    (oldOffsets includesKey:k) ifFalse:[
			changeSet2 add:k
		    ] ifTrue:[
			(a value ~~ (oldOffsets at:k)) ifTrue:[
			    changeSet2 add:k
			]
		    ]
		].
		"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:(Metaclass compiledMethodAt:#invalidMethod).
	    ].
	].
    ].

    "
     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 (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 enough ...
     QUESTION: is this a good idea ?
    "

    newClass dependents:(oldClass dependents).
    newClass changed.

    "just to make certain ... - tell dependents of oldClass, that something changed
     (systemBrowsers will react on this, and update their views)"
    oldClass changed:#definition with:newClass.

    ObjectMemory flushCaches.

    ^ newClass
!

new
    "create & return a new metaclass (a classes class)"

    |newClass|

    newClass := self basicNew.
    newClass setSuperclass:(Object class)
		 selectors:(Array new:0)
		   methods:(Array new:0)
		  instSize:0
		     flags:(Behavior flagNotIndexed).
    newClass setComment:(self comment) category:(self category).
    ^ newClass
! !

!Metaclass methodsFor:'class instance variables'!

instanceVariableNames:aString
    "changing / adding class-inst vars -
     this actually creates a new metaclass and class."

    |newClass newMetaclass nClassInstVars oldClass 
     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 restructure things ... currently way too complex.
    "

    oldVars := self instanceVariableString.
    aString = oldVars ifTrue:[
"
	Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
"
	^ self
    ].

    oldNames := oldVars asCollectionOfWords.
    newNames := aString asCollectionOfWords.

    oldNames = newNames ifTrue:[
"
	Transcript showCr:'no real change'.
"
	"no real change (just formatting)"
	self instanceVariableString:aString.
	^ self
    ]. 

    "
     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)

install anyway ?' withCRs)
	    ifFalse:[
		^ nil
	    ]
	]
    ].

    nClassInstVars := newNames size.

"
    Transcript showCr:'create new class/metaclass'.
"

    "create the new metaclass"
    newMetaclass := Metaclass new.
    newMetaclass setSuperclass:superclass.
    newMetaclass instSize:(superclass instSize + nClassInstVars).
    (nClassInstVars ~~ 0) ifTrue:[
	newMetaclass instanceVariableString:aString
    ].
    newMetaclass flags:(Behavior flagNotIndexed).
    newMetaclass setName:name.
    newMetaclass classVariableString:classvars.
    newMetaclass category:category.
    newMetaclass setComment:comment.

    "find the class which is my sole instance"

    t := Smalltalk allClasses select:[:element | element class == self].
    (t size ~~ 1) ifTrue:[
	self error:'oops - I should have exactly one instance'.
	^ nil
    ].
    oldClass := t anElement.

    "create a new class"
    newClass := newMetaclass new.
    newClass setSuperclass:(oldClass superclass).
    newClass instSize:(oldClass instSize).
    newClass flags:(oldClass flags).
    newClass setName:(oldClass name).
    newClass instanceVariableString:(oldClass instanceVariableString).
    newClass classVariableString:(oldClass classVariableString).
    newClass setComment:(oldClass comment).
    newClass category:(oldClass category).

    offset := 0. oldOffsets := Dictionary new.
    oldNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
    offset := 0. newOffsets := Dictionary new.
    newNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
    changeSet := Set new.

    oldOffsets associationsDo:[:a |
	|k|

	k := a key.
	(newOffsets includesKey:k) ifFalse:[
	    changeSet add:k
	] ifTrue:[
	    (a value ~~ (newOffsets at:k)) ifTrue:[
		changeSet add:k
	    ]
	]
    ].
    newOffsets associationsDo:[:a |
	|k|

	k := a key.
	(oldOffsets includesKey:k) ifFalse:[
	    changeSet add:k
	] ifTrue:[
	    (a value ~~ (oldOffsets at:k)) ifTrue:[
		changeSet add:k
	    ]
	]
    ].

    ((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 ' , addedNames printString ,  '...'.
	Transcript endEntry.
"
	"recompile class-methods"
	newMetaclass recompileMethodsAccessingAny:addedNames.
    ] ifFalse:[
"
	Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
	Transcript endEntry.
"
	"recompile class-methods"
	self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
	newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidMethod).

	self copyMethodsFrom:oldClass for:newClass.
    ].

    delta := newNames size - oldNames size.

    "
     get list of all subclasses - do before superclass is changed
    "
    allSubclasses := oldClass allSubclasses.
    allSubclasses := allSubclasses asSortedCollection:[:a :b |
				b isSubclassOf:a
		     ].

    oldToNew := IdentityDictionary new.

    "create a new class tree, based on new version"

    allSubclasses do:[:aSubclass |
	oldSuper := aSubclass superclass.
	oldSubMeta := aSubclass class.

	newSubMeta := Metaclass new.
	oldSuper == oldClass ifTrue:[
	    newSubMeta setSuperclass:newMetaclass.
	] ifFalse:[
	    newSubMeta setSuperclass:(oldToNew at:oldSuper) class.
	].
	newSubMeta instSize:(oldSubMeta instSize + delta).
	newSubMeta flags:(oldSubMeta flags).
	newSubMeta setName:(oldSubMeta name).
	newSubMeta classVariableString:(oldSubMeta classVariableString).
	newSubMeta setComment:(oldSubMeta comment).
	newSubMeta category:(oldSubMeta category).

	newSub := newSubMeta new.
	oldSuper == oldClass ifTrue:[
	    newSub setSuperclass:newClass.
	] ifFalse:[
	    newSub setSuperclass:(oldToNew at:oldSuper).
	].
	newSub setSelectorArray:(aSubclass selectorArray).
	newSub setMethodArray:(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
	"

	allSubclasses do:[:aClass |
	    aClass class recompileMethodsAccessingAny:changeSet.
	]
    ] ifFalse:[
	"
	 have to recompile all class methods accessing class instvars
	"

	allSubclasses do:[:aClass |
	    |classInstVars|

	    classInstVars := aClass class allInstVarNames.
	    aClass class recompileMethodsAccessingAny:classInstVars.
	]
    ].

    self addChangeRecordForClassInstvars:newClass.

    "install all new classes"

    Smalltalk at:(oldClass name asSymbol) put:newClass.
    ObjectMemory flushCachesFor:oldClass.
    allSubclasses do:[:aClass |
	Smalltalk at:(oldToNew at:aClass) name asSymbol put:(oldToNew at:aClass).
	ObjectMemory flushCachesFor:aClass.
    ].

    "tell dependents ..."

    oldClass changed.
    self changed.

    ^ newMetaclass
! !

!Metaclass methodsFor:'queries'!

isMeta
    "return true, if the receiver is some kind of metaclass;
     true is returned here. Redefines isMeta in Object"

    ^ 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
    "copy all methods from oldClass to newClass.
     This is used for class-methods when a class has changed, but metaclass is 
     unaffected (i.e. classVars/inheritance have not changed) so there is no need
     to recompile the class methods."

    newClass selectors:(oldClass selectorArray copy) 
	       methods:(oldClass methodArray copy)
!

copyInvalidatedMethodsFrom:oldClass for:newClass
    "copy all methods from oldClass to newClass and change their code
     to a trap method reporting an error.
     This is used when a class has been changed its layout or inheritance,
     for all methods; before recompilation is attempted.
     This allows us to keep the source while trapping uncompilable (due to
     now undefined instvars) methods. Compilation of these methods will show
     an error on the transcript and lead to the debugger once called."

    |trap trapCode trapByteCode newMethod oldMethodArray newMethodArray|

    trap := Metaclass compiledMethodAt:#invalidMethod.
    trapCode := trap code.
    trapByteCode := trap byteCode.

    oldMethodArray := oldClass methodArray.
    newMethodArray := Array new:(oldMethodArray size).
    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.
	newMethodArray at:i put:newMethod
    ]
!

copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:setOfNames
    "copy all methods from oldClass to newClass. Those methods accessing
     a variable in setOfNames will be copied as invalid method, leading to
     a trap when its executed. This is used when a class has changed its
     layout for all methods which are affected by the change."

    self copyInvalidatedMethodsFrom:oldClass 
				for:newClass 
		       accessingAny:setOfNames 
			    orSuper:false 
!

copyInvalidatedMethodsFrom:oldClass for:newClass accessingAny:setOfNames orSuper:superBoolean
    "copy all methods from oldClass to newClass. 
     Those methods accessing a variable in setOfNames will be copied as invalid method, 
     leading to a trap when its executed. If superBoolean is true, this is also done
     for methods accessing super.  This is used when a class has changed its
     layout for all methods which are affected by the change."

    |trap trapCode trapByteCode p oldMethod newMethod oldMethodArray newMethodArray|

    trap := Metaclass compiledMethodAt:#invalidMethod.
    trapCode := trap code.
    trapByteCode := trap byteCode.

    oldMethodArray := oldClass methodArray.
    newMethodArray := Array new:(oldMethodArray size).
    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])
	 or:[superBoolean and:[p usesSuper]]]) ifTrue:[
	    newMethod := oldMethod copy.
	    newMethod code:trapCode.
	    newMethod literals:nil.
	    newMethod byteCode:trapByteCode
	] ifFalse:[
	    newMethod := oldMethod.
	].
	newMethodArray at:i put:newMethod
    ]
!

anyInvalidatedMethodsIn:aClass
    "return true, if aClass has any invalidated methods in it"

    |trap trapCode trapByteCode|

    trap := Metaclass compiledMethodAt:#invalidMethod.
    trapCode := trap code.
    trapByteCode := trap byteCode.

    aClass methodArray do:[:aMethod |
	trapCode notNil ifTrue:[
	    (aMethod code == trapCode) ifTrue:[^ true]
	].
	trapByteCode notNil ifTrue:[
	    (aMethod byteCode == trapByteCode) ifTrue:[^ true]
	]
    ].
    ^ false
! !