--- a/Autoload.st Mon Dec 11 18:36:01 1995 +0100
+++ b/Autoload.st Tue Dec 12 13:55:31 1995 +0100
@@ -122,7 +122,7 @@
myName := self name.
aStream nextPutAll:'"' ; nextPutAll:'Notice from Autoload:'; cr; cr;
- spaces:4; nextPutAll:myName , ' is not yet loaded.'; cr; cr.
+ spaces:4; nextPutAll:myName , ' is not yet loaded.'; cr; cr.
aStream nextPutAll:'to load, execute: '.
aStream cr; cr; spaces:4; nextPutAll:myName , ' autoload'; cr.
@@ -134,45 +134,45 @@
"
fileName := Smalltalk fileNameForClass:myName.
(ObjectFileLoader notNil and:[Smalltalk loadBinaries]) ifTrue:[
- (nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
- nm := nm , ' (a classLibrary, possibly including more classes)'
- ] ifFalse:[
- nm := Smalltalk getBinaryFileName:(fileName , '.so').
- nm isNil ifTrue:[
- nm := Smalltalk getBinaryFileName:(fileName , '.o')
- ].
- nm notNil ifTrue:[
- nm := nm , ' (a classBinary)'
- ]
- ].
+ (nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[
+ nm := nm , ' (a classLibrary, possibly including more classes)'
+ ] ifFalse:[
+ nm := Smalltalk getBinaryFileName:(fileName , '.so').
+ nm isNil ifTrue:[
+ nm := Smalltalk getBinaryFileName:(fileName , '.o')
+ ].
+ nm notNil ifTrue:[
+ nm := nm , ' (a classBinary)'
+ ]
+ ].
].
nm isNil ifTrue:[
- nm := Smalltalk getFileInFileName:(fileName , '.st').
- nm isNil ifTrue:[
- nm := Smalltalk getSourceFileName:(fileName , '.st').
- ].
+ nm := Smalltalk getFileInFileName:(fileName , '.st').
+ nm isNil ifTrue:[
+ nm := Smalltalk getSourceFileName:(fileName , '.st').
+ ].
].
nm notNil ifTrue:[
- aStream cr; nextPutAll:'When accessed, ' , myName , ' will automatically be loaded'; cr.
- aStream nextPutAll:'from: '; cr; spaces:4; nextPutAll:nm.
- nm asFilename isSymbolicLink ifTrue:[
- aStream cr; cr.
- aStream nextPutAll:'which is a link to: '; cr; spaces:4;
- nextPutAll:(nm asFilename linkInfo at:#path).
- ]
+ aStream cr; nextPutAll:'When accessed, ' , myName , ' will automatically be loaded'; cr.
+ aStream nextPutAll:'from: '; cr; spaces:4; nextPutAll:nm.
+ nm asFilename isSymbolicLink ifTrue:[
+ aStream cr; cr.
+ aStream nextPutAll:'which is a link to: '; cr; spaces:4;
+ nextPutAll:(nm asFilename linkInfo at:#path).
+ ]
] ifFalse:[
- aStream cr; nextPutAll:'There is currently no file to load ' , myName , ' from.'; cr; cr.
+ aStream cr; nextPutAll:'There is currently no file to load ' , myName , ' from.'; cr; cr.
- (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
- classFileName := Smalltalk fileNameForClass:myName.
- packageDir := Smalltalk sourceDirectoryNameOfClass:myName.
- ].
- (classFileName notNil and:[packageDir notNil]) ifTrue:[
- aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code
+ (mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[
+ classFileName := Smalltalk fileNameForClass:myName.
+ packageDir := Smalltalk sourceDirectoryNameOfClass:myName.
+ ].
+ (classFileName notNil and:[packageDir notNil]) ifTrue:[
+ aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code
from "' , classFileName , '.st" in the "' , packageDir , '" package.'.
- ] ifFalse:[
- aStream nextPutAll:'When accessed, an error will be reported.'.
- ]
+ ] ifFalse:[
+ aStream nextPutAll:'When accessed, an error will be reported.'.
+ ]
].
aStream cr; nextPutAll:'"'.
@@ -252,6 +252,7 @@
"wow - it worked. now the big trick ..."
+ newClass class setSoleInstance:self. "/ will be undone by become ...
self become:newClass.
LoadedClasses rehash.
self initialize. "/ thats the new class now
@@ -361,6 +362,6 @@
!Autoload class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.35 1995-12-09 23:28:48 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.36 1995-12-12 12:55:20 cg Exp $'
! !
Autoload initialize!
--- a/Metaclass.st Mon Dec 11 18:36:01 1995 +0100
+++ b/Metaclass.st Tue Dec 12 13:55:31 1995 +0100
@@ -115,9 +115,9 @@
oldVars := self instanceVariableString.
aString = oldVars ifTrue:[
"
- Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
+ Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
"
- ^ self
+ ^ self
].
oldNames := oldVars asCollectionOfWords.
@@ -125,11 +125,11 @@
oldNames = newNames ifTrue:[
"
- Transcript showCr:'no real change'.
+ Transcript showCr:'no real change'.
"
- "no real change (just formatting)"
- self setInstanceVariableString:aString.
- ^ self
+ "no real change (just formatting)"
+ self setInstanceVariableString:aString.
+ ^ self
].
"/ "
@@ -169,7 +169,7 @@
newMetaclass setSuperclass:superclass.
newMetaclass instSize:(superclass instSize + nClassInstVars).
(nClassInstVars ~~ 0) ifTrue:[
- newMetaclass setInstanceVariableString:aString
+ newMetaclass setInstanceVariableString:aString
].
"/ newMetaclass flags:(Behavior flagBehavior "flagNotIndexed").
newMetaclass setName:name.
@@ -181,8 +181,8 @@
t := Smalltalk allClasses select:[:element | element class == self].
(t size ~~ 1) ifTrue:[
- self error:'oops - I should have exactly one instance'.
- ^ nil
+ self error:'oops - I should have exactly one instance'.
+ ^ nil
].
oldClass := t anElement.
@@ -199,8 +199,8 @@
newClass setComment:(oldClass comment).
newClass category:(oldClass category).
(t := oldClass primitiveSpec) notNil ifTrue:[
- newClass primitiveSpec:t.
- newClass setClassFilename:(oldClass classFilename).
+ newClass primitiveSpec:t.
+ newClass setClassFilename:(oldClass classFilename).
].
"/ set the new classes package
@@ -216,73 +216,73 @@
changeSet := Set new.
((oldNames size == 0)
or:[newNames startsWith:oldNames]) ifTrue:[
- "new variable(s) has/have been added - old methods still work"
+ "new variable(s) has/have been added - old methods still work"
" "
- Transcript showCr:'copying methods ...'.
- Transcript endEntry.
+ Transcript showCr:'copying methods ...'.
+ Transcript endEntry.
" "
- self copyMethodsFrom:self for:newMetaclass.
- self copyMethodsFrom:oldClass for:newClass.
+ 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 ...)
- "
+ "
+ but have to recompile methods accessing stuff now defined
+ (it might have been a global before ...)
+ "
- addedNames := newNames select:[:nm | (oldNames includes:nm) not].
+ addedNames := newNames select:[:nm | (oldNames includes:nm) not].
" "
- Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
" "
- "recompile class-methods"
- newMetaclass recompileMethodsAccessingAny:addedNames.
+ "recompile class-methods"
+ newMetaclass recompileMethodsAccessingAny:addedNames.
] ifFalse:[
- "
- create the changeSet; thats the set of class instvar names
- which have changed their position or are new
- "
- 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].
+ "
+ create the changeSet; thats the set of class instvar names
+ which have changed their position or are new
+ "
+ 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].
- oldOffsets associationsDo:[:a |
- |k|
+ 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.
+ (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
- ]
- ]
- ].
+ k := a key.
+ (oldOffsets includesKey:k) ifFalse:[
+ changeSet add:k
+ ] ifTrue:[
+ (a value ~~ (oldOffsets at:k)) ifTrue:[
+ changeSet add:k
+ ]
+ ]
+ ].
" "
- Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
- Transcript endEntry.
+ Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
+ Transcript endEntry.
" "
- "
- recompile class-methods
- "
- self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
- newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+ "
+ recompile class-methods
+ "
+ self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
+ newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
- self copyMethodsFrom:oldClass for:newClass.
+ self copyMethodsFrom:oldClass for:newClass.
].
delta := newNames size - oldNames size.
@@ -292,8 +292,8 @@
"
allSubclasses := oldClass allSubclasses.
allSubclasses := allSubclasses asSortedCollection:[:a :b |
- b isSubclassOf:a
- ].
+ b isSubclassOf:a
+ ].
oldToNew := IdentityDictionary new.
@@ -301,82 +301,82 @@
create a new class tree, based on new version
"
allSubclasses do:[:aSubclass |
- oldSuper := aSubclass superclass.
- oldSubMeta := aSubclass class.
+ 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 setInstanceVariableString:(oldSubMeta instanceVariableString).
- newSubMeta classVariableString:(oldSubMeta classVariableString).
- newSubMeta setComment:(oldSubMeta comment).
- newSubMeta category:(oldSubMeta category).
+ 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 setInstanceVariableString:(oldSubMeta instanceVariableString).
+ 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).
+ 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.
+ oldToNew at:aSubclass put:newSub.
- aSubclass category:'obsolete'.
- aSubclass class category:'obsolete'.
+ 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
- "
+ "only have to recompile class methods accessing
+ class instvars from changeset
+ "
- allSubclasses do:[:oldSubclass |
- |newSubclass|
+ allSubclasses do:[:oldSubclass |
+ |newSubclass|
- newSubclass := oldToNew at:oldSubclass.
+ newSubclass := oldToNew at:oldSubclass.
Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , changeSet printString.
+ ' accessing any of ' , changeSet printString.
- newSubclass class recompileMethodsAccessingAny:changeSet.
- ]
+ newSubclass class recompileMethodsAccessingAny:changeSet.
+ ]
] ifFalse:[
- "
- have to recompile all class methods accessing class instvars
- "
- commonClassInstVars := oldClass class allInstVarNames.
- changeSet do:[:v |
- commonClassInstVars remove:v ifAbsent:[]
- ].
+ "
+ have to recompile all class methods accessing class instvars
+ "
+ commonClassInstVars := oldClass class allInstVarNames.
+ changeSet do:[:v |
+ commonClassInstVars remove:v ifAbsent:[]
+ ].
- allSubclasses do:[:oldSubclass |
- |newSubclass classInstVars|
+ allSubclasses do:[:oldSubclass |
+ |newSubclass classInstVars|
- newSubclass := oldToNew at:oldSubclass.
+ newSubclass := oldToNew at:oldSubclass.
- classInstVars := newSubclass class allInstVarNames asSet.
- classInstVars removeAll:commonClassInstVars.
- classInstVars addAll:changeSet.
+ classInstVars := newSubclass class allInstVarNames asSet.
+ classInstVars removeAll:commonClassInstVars.
+ classInstVars addAll:changeSet.
Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , classInstVars printString.
+ ' accessing any of ' , classInstVars printString.
- newSubclass class recompileMethodsAccessingAny:classInstVars.
- ]
+ newSubclass class recompileMethodsAccessingAny:classInstVars.
+ ]
].
self addChangeRecordForClassInstvars:newClass.
@@ -387,15 +387,15 @@
ObjectMemory flushCachesFor:oldClass.
allSubclasses do:[:oldClass |
- |newClass|
+ |newClass|
- newClass := oldToNew at:oldClass.
+ newClass := oldToNew at:oldClass.
"
Transcript showCr:'install ' , newClass name , '(' , newClass category , ')' ,
- ' as ' , newClass name.
+ ' as ' , newClass name.
"
- Smalltalk at:newClass name asSymbol put:newClass.
- ObjectMemory flushCachesFor:oldClass.
+ Smalltalk at:newClass name asSymbol put:newClass.
+ ObjectMemory flushCachesFor:oldClass.
].
"tell dependents ..."
@@ -420,16 +420,16 @@
!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
+ 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
@@ -460,14 +460,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.
@@ -478,73 +478,73 @@
"look, if it already exists as a class"
oldClass := aSystemDictionary at:classSymbol ifAbsent:[nil].
oldClass isBehavior 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
+ ]
+ ]
+ ]
+ ]
].
"
@@ -558,11 +558,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
+ ]
].
"create the metaclass first"
@@ -584,19 +584,19 @@
"/ but prefer the old package
oldClass notNil ifTrue:[
- t := oldClass package.
- newClass setBinaryRevision:(oldClass revision).
+ t := oldClass package.
+ newClass setBinaryRevision:(oldClass revision).
] 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.
].
"
@@ -607,55 +607,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.
@@ -664,30 +664,30 @@
(also for autoloaded classes)
"
(oldClass isNil or:[oldClass isLoaded not]) ifTrue:[
- oldClass isNil ifTrue:[
- self addChangeRecordForClass:newClass.
- ].
+ oldClass isNil ifTrue:[
+ self addChangeRecordForClass:newClass.
+ ].
- commentString notNil ifTrue:[
- newClass comment:commentString
- ].
+ commentString notNil ifTrue:[
+ newClass comment:commentString
+ ].
- aSystemDictionary at:classSymbol put:newClass.
+ 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 changed:#newClass with:newClass.
- ^ newClass
+ aSystemDictionary changed:#newClass with:newClass.
+ ^ newClass
].
@@ -710,95 +710,95 @@
"
(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.
- self addChangeRecordForClassComment:oldClass.
- ].
+ (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.
+ (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.
- self addChangeRecordForClass:newClass.
- "notify change of organization"
- aSystemDictionary changed:#organization
- ].
- "notify change of class"
+ oldClass category ~= categoryString ifTrue:[
+ oldClass category:categoryString.
+ self addChangeRecordForClass:newClass.
+ "notify change of organization"
+ 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.
- "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.
+ "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"
- self addChangeRecordForClass:oldClass.
- oldClass changed:#definition.
+ "notify change of class"
+ self addChangeRecordForClass:oldClass.
+ oldClass changed:#definition.
- ^ oldClass
- ]
- ]
- ]
+ ^ oldClass
+ ]
+ ]
+ ]
]
].
@@ -807,7 +807,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.
@@ -816,8 +816,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
].
"
@@ -830,7 +830,7 @@
and:[(oldClassVars = newClassVars)
and:[(oldInstVars = newInstVars)
and:[newComment = oldClass comment]]]]) ifFalse:[
- self addChangeRecordForClass:newClass.
+ self addChangeRecordForClass:newClass.
].
"
@@ -841,64 +841,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
+ ].
].
"
@@ -906,105 +906,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).
+ ].
+ ].
].
"
@@ -1018,13 +1018,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
+ ]
].
"
@@ -1039,8 +1039,8 @@
aSystemDictionary at:classSymbol put:newClass.
oldClass category ~= categoryString ifTrue:[
- "notify change of organization"
- aSystemDictionary changed:#organization
+ "notify change of organization"
+ aSystemDictionary changed:#organization
].
"
@@ -1089,6 +1089,12 @@
!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"
@@ -1348,5 +1354,5 @@
!Metaclass class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.40 1995-12-09 16:11:23 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.41 1995-12-12 12:55:31 cg Exp $'
! !