--- a/Smalltalk.st Fri Jul 31 00:39:29 1998 +0200
+++ b/Smalltalk.st Fri Jul 31 16:41:35 1998 +0200
@@ -874,21 +874,23 @@
and patching the classes methods to access the new variables."
|oldName oldSym newSym names oldCVSym newCVSym value oldNameToNewName
- oldNameSpace newNameSpace oldBaseName privateClasses|
+ oldNameSpace newNameSpace oldBaseName newBaseName privateClasses
+ oldBaseNameWithoutPrefix newBaseNameWithoutPrefix|
oldName := aClass name.
aClass isPrivate ifTrue:[
- oldNameSpace := aClass topOwningClass nameSpace.
+ oldNameSpace := aClass topOwningClass nameSpace.
] ifFalse:[
- oldNameSpace := aClass nameSpace.
+ oldNameSpace := aClass nameSpace.
].
oldBaseName := aClass nameWithoutNameSpacePrefix.
+ oldBaseNameWithoutPrefix := aClass nameWithoutPrefix.
oldSym := oldName asSymbol.
privateClasses := aClass privateClassesSorted.
((self at:oldSym) ~~ aClass) ifTrue:[
- 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
- ^ self
+ 'Smalltalk [warning]: rename failed - name is different from key' errorPrintCR.
+ ^ self
].
"/ rename the class
@@ -912,34 +914,35 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- oldCVSym := (oldSym , ':' , name) asSymbol.
- value := self at:oldCVSym.
- self at:oldCVSym put:nil.
-
- "/
- "/ see comment in #removeKey: on why we dont remove it it here
- "/
- "/ self removeKey:cSym.
-
- newCVSym := (newSym , ':' , name) asSymbol.
- self at:newCVSym put:value.
-
- oldNameToNewName at:oldCVSym put:newCVSym.
+ oldCVSym := (oldSym , ':' , name) asSymbol.
+ value := self at:oldCVSym.
+ self at:oldCVSym put:nil.
+
+ "/
+ "/ see comment in #removeKey: on why we dont remove it it here
+ "/
+ "/ self removeKey:cSym.
+
+ newCVSym := (newSym , ':' , name) asSymbol.
+ self at:newCVSym put:value.
+
+ oldNameToNewName at:oldCVSym put:newCVSym.
].
"/ patch methods literal arrays from oldCVname to newCVname
oldNameToNewName keysAndValuesDo:[:oldNameSym :newNameSym |
- aClass withAllSubclasses do:[:aSubClass |
- aSubClass class methodDictionary do:[:aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ].
- aSubClass methodDictionary do:[:aMethod |
- aMethod changeLiteral:oldNameSym to:newNameSym
- ]
- ].
-
- "/ and also in privateClasses ? ...
+ aClass withAllSubclasses do:[:aSubClass |
+ Transcript showCR:'changing global accesses from ''' , oldNameSym , ''' into ''' , newNameSym , ''' in class: ''' , aSubClass name , ''' ...'.
+ aSubClass class methodDictionary do:[:aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ].
+ aSubClass methodDictionary do:[:aMethod |
+ aMethod changeLiteral:oldNameSym to:newNameSym
+ ]
+ ].
+
+ "/ and also in privateClasses ? ...
"/ privateClasses size > 0 ifTrue:[
"/ privateClasses do:[:aPrivateClass |
@@ -958,57 +961,79 @@
aClass addChangeRecordForClassRename:oldSym to:newSym.
aClass isPrivate ifTrue:[
- newNameSpace := aClass topOwningClass nameSpace.
+ newNameSpace := aClass topOwningClass nameSpace.
] ifFalse:[
- newNameSpace := aClass nameSpace.
+ newNameSpace := aClass nameSpace.
].
privateClasses size > 0 ifTrue:[
- "/ must rename privateClasses as well
- privateClasses do:[:aPrivateClass |
- self renameClass:aPrivateClass
- to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
+ "/ must rename privateClasses as well
+ privateClasses do:[:aPrivateClass |
+ self renameClass:aPrivateClass
+ to:(newSym , '::' , aPrivateClass nameWithoutPrefix).
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
- Class class
- recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
- in:newNameSpace
- except:nil.
- ]
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldName , '::' , aPrivateClass nameWithoutPrefix , ''' ...'.
+ Class class
+ recompileGlobalAccessorsTo:(oldName , '::' , aPrivateClass nameWithoutPrefix) asSymbol
+ in:newNameSpace
+ except:nil.
+ ]
].
oldNameSpace ~~ newNameSpace ifTrue:[
- "/ all those referencing the class from the old nameSpace
- "/ must be recompiled ...
- "/ (to now access the global from smalltalk)
-
- oldNameSpace ~~ Smalltalk ifTrue:[
- Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
-
- Class class
- recompileGlobalAccessorsTo:oldName asSymbol
- in:oldNameSpace
- except:nil.
- ].
-
- "/ all referencing the class in the new namespace
- "/ as well; to now access the new class.
-
- (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
- Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
-
- Class class
- recompileGlobalAccessorsTo:oldBaseName asSymbol
- in:newNameSpace
- except:nil.
- ].
-
-
- ].
-
- "Created: 29.10.1995 / 19:58:32 / cg"
- "Modified: 18.6.1996 / 14:20:50 / stefan"
- "Modified: 5.6.1997 / 09:49:59 / cg"
+ "/ all those referencing the class from the old nameSpace
+ "/ must be recompiled ...
+ "/ (to now access the global from smalltalk)
+
+ oldNameSpace ~~ Smalltalk ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , oldNameSpace name , ''' accessing ''' , oldName , ''' ...'.
+
+ Class class
+ recompileGlobalAccessorsTo:oldName asSymbol
+ in:oldNameSpace
+ except:nil.
+ ].
+
+ "/ all referencing the class in the new namespace
+ "/ as well; to now access the new class.
+
+ (newNameSpace notNil and:[newNameSpace ~~ Smalltalk]) ifTrue:[
+ Transcript showCR:'recompiling methods in ''' , newNameSpace name , ''' accessing ''' , oldBaseName , ''' ...'.
+
+ Class class
+ recompileGlobalAccessorsTo:oldBaseName asSymbol
+ in:newNameSpace
+ except:nil.
+ ].
+ ] ifFalse:[
+ "/ all references to a global with my new name in my owning class
+ "/ must now be redirected to myself.
+
+ aClass isPrivate ifTrue:[
+ newBaseName := aClass nameWithoutNameSpacePrefix.
+ newBaseNameWithoutPrefix := aClass nameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , oldBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:oldBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:oldBaseName.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseNameWithoutPrefix , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseNameWithoutPrefix.
+
+ Transcript showCR:'recompiling methods accessing ''' , newBaseName , ''' in: ''' , aClass owningClass name , ''' ...'.
+ aClass owningClass recompileMethodsAccessingGlobal:newBaseName.
+ aClass owningClass class recompileMethodsAccessingGlobal:newBaseName.
+ ]
+ ]
+
+ "Created: / 29.10.1995 / 19:58:32 / cg"
+ "Modified: / 18.6.1996 / 14:20:50 / stefan"
+ "Modified: / 31.7.1998 / 15:46:34 / cg"
! !
!Smalltalk class methodsFor:'copying'!
@@ -1099,80 +1124,6 @@
__fatal0(__context, msg);
/* NEVER RETURNS */
%}
-!
-
-printPolyCaches
- "{ Pragma: +optSpace }"
-
- "dump poly caches.
- WARNING: this method is for debugging only
- it will be removed without notice"
-%{
- __dumpILCCaches();
-%}
-!
-
-printStackBacktrace
- "{ Pragma: +optSpace }"
-
- "print a stack backtrace - then continue.
- (You may turn off the stack print with debugPrinting:false)
- WARNING: this method is for debugging only
- it will be removed without notice"
-
-%{
- __printStack(__context);
-%}
- "Smalltalk printStackBacktrace"
-!
-
-printSymbols
- "{ Pragma: +optSpace }"
-
- "dump the internal symbol table.
- WARNING: this method is for debugging only
- it will be removed without notice"
-%{
-#ifdef DEBUG
- __dumpSymbols();
-#endif
-%}
-!
-
-sendTraceOff
- "{ Pragma: +optSpace }"
-
- "turns tracing of message sends off.
- WARNING: this method is for debugging only
- it may be removed without notice"
-
-%{ /* NOCONTEXT */
- __setMessageTrace__(0);
-%}
-!
-
-sendTraceOn
- "{ Pragma: +optSpace }"
-
- "turns tracing of message sends on.
- WARNING: this method is for debugging only
- it may be removed without notice"
-
-%{ /* NOCONTEXT */
- __setMessageTrace__(1);
-%}
-!
-
-statistic
- "{ Pragma: +optSpace }"
-
- "print some statistic data.
- WARNING: this method is for debugging only
- it may be removed without notice"
-
-%{ /* NOCONTEXT */
- __STATISTIC__();
-%}
! !
!Smalltalk class methodsFor:'enumerating'!
@@ -4275,5 +4226,5 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.294 1998-07-27 18:00:24 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.295 1998-07-31 14:41:35 cg Exp $'
! !