hg/stx-libbasic: comparison Smalltalk.st

equal deleted inserted replaced

-:be947d4e7fb2
+:514c749165c3
 "
 COPYRIGHT (c) 1988 by Claus Gittinger
-All Rights Reserved
+	      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
 "
 Object subclass:#Smalltalk
 instanceVariableNames:''
 classVariableNames:'ExitBlocks CachedClasses SystemPath
-StartupClass StartupSelector StartupArguments
+			   StartupClass StartupSelector StartupArguments
-CachedAbbreviations
+			   CachedAbbreviations
-SilentLoading Initializing
+			   SilentLoading Initializing
-StandAlone
+			   StandAlone
-LogDoits'
+			   LogDoits'
 poolDictionaries:''
 category:'System-Support'
 !
 Smalltalk comment:'
 COPYRIGHT (c) 1988 by Claus Gittinger
-All Rights Reserved
+	     All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.21 1994-08-23 23:11:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.22 1994-10-10 00:28:32 claus Exp $
 '!
 "
 dont depend on these being global - they will become
 class variables of some class ...
 !Smalltalk class methodsFor:'documentation'!
 copyright
 "
 COPYRIGHT (c) 1988 by Claus Gittinger
-All Rights Reserved
+	      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
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.21 1994-08-23 23:11:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.22 1994-10-10 00:28:32 claus Exp $
 "
 !
 documentation
 "
 (due to the need to be able to access globals from c-code as well).
 However, it provides the known enumeration protocol.
 It may change to become a subclass of collection at some time ...
 Instance variables:
-none - all handling is done in the VM
+					none - all handling is done in the VM
 Class variables:
-ExitBlocks      <Collection>    blocks to evaluate before system is
+	ExitBlocks      <Collection>    blocks to evaluate before system is
-left. Not currently used.
+					left. Not currently used.
-CachedClasses   <Collection>    known classes (cached for faster enumeration)
+	CachedClasses   <Collection>    known classes (cached for faster enumeration)
-SystemPath      <Collection>    path to search for system files (sources, bitmaps etc)
+	SystemPath      <Collection>    path to search for system files (sources, bitmaps etc)
-StartupClass    <Class>         class, which gets initial message
+	StartupClass    <Class>         class, which gets initial message
-(right after VM initialization)
+					(right after VM initialization)
-StartupSelector <Symbol>        message sent to StartupClass
+	StartupSelector <Symbol>        message sent to StartupClass
-CachedAbbreviations
+	CachedAbbreviations
-<Dictionary>    className to filename mappings
+			<Dictionary>    className to filename mappings
-SilentLoading   <Boolean>       suppresses messages during fileIn and in compiler
+	SilentLoading   <Boolean>       suppresses messages during fileIn and in compiler
-(can be set to true from a customized main)
+					(can be set to true from a customized main)
-LogDoits        <Boolean>       if true, doits are also logged in the changes
+	LogDoits        <Boolean>       if true, doits are also logged in the changes
-file. Default is false, since the changes file
+					file. Default is false, since the changes file
-may become huge ...
+					may become huge ...
 "
 ! !
 !Smalltalk class methodsFor:'time-versions'!
 "
 Smalltalk versionString
 "
 "
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.21 1994-08-23 23:11:28 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.22 1994-10-10 00:28:32 claus Exp $
 "
 !
 versionDate
 "return the version date - thats the date when the smalltalk
 %{
 #ifdef VERSIONDATE_STRING
 RETURN ( _MKSTRING(VERSIONDATE_STRING COMMA_SND) );
 #endif
 %}.
-^ '3-aug-1994'
+^ '23-aug-1994'
 "
 Smalltalk versionDate
 "
 !
 "stupid: this should come from a resource file ...
 but I dont use it here, to allow mini-systems without
 Resource-stuff."
 (Language == #german) ifTrue:[
-^ 'Willkommen bei SmallTalk/X version '
+	^ 'Willkommen bei SmallTalk/X version '
-, self versionString , ' vom ' , self versionDate
+	  , self versionString , ' vom ' , self versionDate
 ].
 (Language == #french) ifTrue:[
-^ 'Bienvenue a SmallTalk/X version '
+	^ 'Bienvenue a SmallTalk/X version '
-, self versionString , ' de ' , self versionDate
+	  , self versionString , ' de ' , self versionDate
 ].
 ^ 'Hello World - here is SmallTalk/X version '
 , self versionString , ' of ' , self versionDate
 "
 "
 must init display here - some classes (Color, Form) need it during initialize
 "
 Workstation notNil ifTrue:[
-Workstation initialize
+	Workstation initialize
 ].
 "
 define low-level debugging tools - graphical classes are not prepared yet
 to handle things ...
 "
 Inspector := MiniInspector.
 Debugger := MiniDebugger.
 Compiler := ByteCodeCompiler.
 Compiler isNil ifTrue:[
-"
+	"
-ByteCodeCompiler is not in the system (i.e. has not been linked in)
+	 ByteCodeCompiler is not in the system (i.e. has not been linked in)
-this allows at least immediate evaluations for runtime systems without compiler
+	 this allows at least immediate evaluations for runtime systems without compiler
-NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
+	 NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
-"
+	"
-Compiler := Parser
+	Compiler := Parser
 ].
 "
-now finally initialize all classes
+now, finally, initialize all leftover classes
 "
+"/    Object allSubclassesInOrderDo:[:aClass |
 self allBehaviorsDo:[:aClass |
-"
+	"
-avoid never-ending story ...
+	 avoid never-ending story ...
-"
+	"
-(aClass ~~ Smalltalk) ifTrue:[
+	(aClass ~~ Smalltalk) ifTrue:[
-aClass initialize
+"/ 'init ' print. aClass name printNL.
-]
+	    aClass initialize
-].
+	]
+].
 "
 now we can enable the graphical debugger/inspector
 "
 self initStandardTools.
 self initInterrupts.
 "
 extract Language and LanguageTerritory from LANG variable.
 the language and territory must not be abbreviated,
 valid is for example: english_usa
-english
+			   english
-german
+			   german
-german_austria
+			   german_austria
 "
 envString := OperatingSystem getEnvironment:'LANG'.
 envString notNil ifTrue:[
-i := envString indexOf:$_.
+	i := envString indexOf:$_.
-(i == 0) ifTrue:[
+	(i == 0) ifTrue:[
-langString := envString.
+	    langString := envString.
-terrString := envString
+	    terrString := envString
-] ifFalse:[
+	] ifFalse:[
-langString := envString copyTo:(i - 1).
+	    langString := envString copyTo:(i - 1).
-terrString := envString copyFrom:(i + 1)
+	    terrString := envString copyFrom:(i + 1)
-].
+	].
-Language := langString asSymbol.
+	Language := langString asSymbol.
-LanguageTerritory := terrString asSymbol
+	LanguageTerritory := terrString asSymbol
 ].
 "
 this too is a leftover - once all refs to View3D
 are removed, this will vanish ...
 (please use: View>>defaultStyle:)
 "
 envString := OperatingSystem getEnvironment:'VIEW3D'.
 envString notNil ifTrue:[
-firstChar := (envString at:1) asLowercase.
+	firstChar := (envString at:1) asLowercase.
-(firstChar == $t) ifTrue:[
+	(firstChar == $t) ifTrue:[
-Smalltalk at:#View3D put:true
+	    Smalltalk at:#View3D put:true
-] ifFalse: [
+	] ifFalse: [
-Smalltalk at:#View3D put:false
+	    Smalltalk at:#View3D put:false
-]
+	]
 ]
 "Smalltalk initGlobalsFromEnvironment"
 !
 initStandardTools
 they will redefine Inspector and Debugger for graphical interfaces"
 "redefine debug-tools, if view-classes exist"
 Display notNil ifTrue:[
-InspectorView notNil ifTrue:[
+	InspectorView notNil ifTrue:[
-Inspector := InspectorView
+	    Inspector := InspectorView
-].
+	].
-DebugView notNil ifTrue:[
+	DebugView notNil ifTrue:[
-Debugger := DebugView
+	    Debugger := DebugView
-].
+	].
-Display initialize
+	Display initialize
 ]
 "Smalltalk initStandardTools"
 !
 initStandardStreams
 !
 initSystemPath
 "setup path where system files are searched for.
 the default path is set to:
-.
+	    .
-..
+	    ..
-$HOME                    (if defined)
+	    $HOME                    (if defined)
-$HOME/.smalltalk         (if defined & existing)
+	    $HOME/.smalltalk         (if defined & existing)
-$SMALLTALK_LIBDIR        (if defined & existing)
+	    $SMALLTALK_LIBDIR        (if defined & existing)
-/usr/local/lib/smalltalk (if existing)
+	    /usr/local/lib/smalltalk (if existing)
-/usr/lib/smalltalk       (if existing)
+	    /usr/lib/smalltalk       (if existing)
 of course, it is possible to add entries from the 'smalltalk.rc'
 startup file; add expressions such as:
-Smalltalk systemPath addFirst:'/foo/bar/baz'.
+	    Smalltalk systemPath addFirst:'/foo/bar/baz'.
-or:
+	or:
-Smalltalk systemPath addLast:'/fee/foe/foo'.
+	    Smalltalk systemPath addLast:'/fee/foe/foo'.
 "
 |p homePath|
 homePath := OperatingSystem getHomeDirectory.
 SystemPath := OrderedCollection new.
 SystemPath add:'.'.
 SystemPath add:'..'.
 SystemPath add:homePath.
 (OperatingSystem isDirectory:(p := homePath , '/.smalltalk')) ifTrue:[
-SystemPath add:p
+	SystemPath add:p
 ].
 p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
 p notNil ifTrue:[
-SystemPath add:p
+	SystemPath add:p
 ].
 (OperatingSystem isDirectory:'/usr/local/lib/smalltalk') ifTrue:[
-SystemPath add:'/usr/local/lib/smalltalk'
+	SystemPath add:'/usr/local/lib/smalltalk'
 ].
 (OperatingSystem isDirectory:'/usr/lib/smalltalk') ifTrue:[
-SystemPath add:'/usr/lib/smalltalk'
+	SystemPath add:'/usr/lib/smalltalk'
 ].
 "
 Smalltalk initSystemPath
 Smalltalk systemPath
 and start dispatching; otherwise go into a read-eval-print loop"
 |idx|
 Initializing := true.
-Processor := ProcessorScheduler new.
+"/    Processor := ProcessorScheduler new.
 "
 while reading patches- and rc-file, do not add things into change-file
 "
 Class updateChanges:false.
 look for a '-e filename' argument - this will force evaluation of
 filename only, no standard startup
 "
 idx := Arguments indexOf:'-e'.
 idx ~~ 0 ifTrue:[
-self fileIn:(Arguments at:idx + 1).
+	self fileIn:(Arguments at:idx + 1).
-self exit
+	self exit
 ].
 (self fileIn:((Arguments at:1) , '.rc')) ifFalse:[
-"no .rc file where executable is; try default smalltalk.rc"
+	"no .rc file where executable is; try default smalltalk.rc"
-self fileIn:'smalltalk.rc'
+	(self fileIn:'smalltalk.rc') ifFalse:[
+	    Transcript showCr:'no startup rc-file found'
+	]
 ].
 Class updateChanges:true.
 (SilentLoading == true) ifFalse:[   "i.e. undefined counts as false"
-Transcript showCr:(self hello).
+	Transcript showCr:(self hello).
-Transcript showCr:(self copyrightString).
+	Transcript showCr:(self copyrightString).
-Transcript cr.
+	Transcript cr.
-DemoMode ifTrue:[
+	DemoMode ifTrue:[
-Transcript showCr:'*** Restricted use:                              ***'.
+	    Transcript showCr:'*** Restricted use:                              ***'.
-Transcript showCr:'*** This program may be used for education only. ***'.
+	    Transcript showCr:'*** This program may be used for education only. ***'.
-Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
+	    Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
-Transcript showCr:'*** for more details.                            ***'.
+	    Transcript showCr:'*** for more details.                            ***'.
-Transcript cr.
+	    Transcript cr.
-].
+	].
 ].
 Initializing := false.
 "
 "
 if there is a display, start its event dispatcher
 "
 Display notNil ifTrue:[
-Display startDispatch.
+	Display startDispatch.
-"this is a leftover - will vanish"
+	"this is a leftover - will vanish"
 " "
-ModalDisplay notNil ifTrue:[
+	ModalDisplay notNil ifTrue:[
-ModalDisplay startDispatch
+	    ModalDisplay startDispatch
-]
+	]
 " "
 ].
 (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
-StartupClass perform:StartupSelector withArguments:StartupArguments.
+	StartupClass perform:StartupSelector withArguments:StartupArguments.
 ].
 "
 if view-classes exist, start dispatching;
 otherwise go into a read-eval-print loop
 "
 Display notNil ifTrue:[
-Processor dispatchLoop
+	Processor dispatchLoop
 ] ifFalse:[
-self readEvalPrint
+	self readEvalPrint
 ].
 "done"
 self exit
 restart
 "startup after an image has been loaded;
 there are three change-notifications made to dependents of ObjectMemory,
 which allow a stepwise re-init: #earlyRestart, #restarted and #returnFromSnapshot.
 #earlyRestart is send first, nothing has been setup yet.
-(should be used to flush all device dependent entries)
+		   (should be used to flush all device dependent entries)
 #restarted is send right after.
-(should be used to recreate external resources (fds, bitmaps etc)
+		   (should be used to recreate external resources (fds, bitmaps etc)
 #returnFromSnapshot is sent last
-(should be used to restart processes, reOpen Streams which cannot
+		   (should be used to restart processes, reOpen Streams which cannot
-be automatically be reopened (i.e. Sockets, Pipes) and so on.
+		    be automatically be reopened (i.e. Sockets, Pipes) and so on.
 "
 |deb insp imageName|
 Initializing := true.
-Processor reInitialize.
+Processor reinitialize.
 "temporary switch back to dumb interface -
 to handle errors while view-stuff is not yet reinitialized"
 insp := Inspector.
 some must be reinitialized before ...
 - sorry, but order is important
 "
 Workstation notNil ifTrue:[
-Workstation reinitialize.
+	Workstation reinitialize.
 ].
 ObjectMemory changed:#returnFromSnapshot.
 OperatingSystem enableUserInterrupts.
 "
 if there is no Transcript, go to stderr
 "
 Transcript isNil ifTrue:[
-self initStandardStreams.
+	self initStandardStreams.
-Transcript := Stderr
+	Transcript := Stderr
 ].
 (SilentLoading == true) ifFalse:[
-Transcript cr.
+	Transcript cr.
-Transcript showCr:('Smalltalk restarted from:' , ObjectMemory imageName).
+	Transcript showCr:('Smalltalk restarted from:' , ObjectMemory imageName).
-Transcript cr.
+	Transcript cr.
-DemoMode ifTrue:[
+	DemoMode ifTrue:[
-Transcript showCr:'*** Restricted use:                              ***'.
+	    Transcript showCr:'*** Restricted use:                              ***'.
-Transcript showCr:'*** This program may be used for education only. ***'.
+	    Transcript showCr:'*** This program may be used for education only. ***'.
-Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
+	    Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE  ***'.
-Transcript showCr:'*** for more details.                            ***'.
+	    Transcript showCr:'*** for more details.                            ***'.
-Transcript cr.
+	    Transcript cr.
-].
+	].
 ].
 "
 give user a chance to re-customize things
 "
 (Arguments includes:'-faststart') ifFalse:[
-Class updateChanges:false.
+	Class updateChanges:false.
-(self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
+	(self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
-"no _r.rc file where executable is; try default smalltalk_r.rc"
+	    "no _r.rc file where executable is; try default smalltalk_r.rc"
-self fileIn:'smalltalk_r.rc'
+	    self fileIn:'smalltalk_r.rc'
-].
+	].
-Class updateChanges:true.
+	Class updateChanges:true.
 ].
 "
 if there is a display, start its event dispatcher
 "
 Display notNil ifTrue:[
-Display startDispatch.
+	Display startDispatch.
 " "
-ModalDisplay notNil ifTrue:[
+	ModalDisplay notNil ifTrue:[
-ModalDisplay startDispatch
+	    ModalDisplay startDispatch
-]
+	]
 " "
 ].
 "
 this allows firing an application by defining
 these two globals during snapshot ... or in main
 "
 (StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
-"allow customization by reading an image specific rc-file"
+	"allow customization by reading an image specific rc-file"
-imageName := ObjectMemory imageName.
+	imageName := ObjectMemory imageName.
-imageName notNil ifTrue:[
+	imageName notNil ifTrue:[
-(imageName endsWith:'.img') ifTrue:[
+	    (imageName endsWith:'.img') ifTrue:[
-self fileIn:((imageName copyTo:(imageName size - 4)), '.rc')
+		self fileIn:((imageName copyTo:(imageName size - 4)), '.rc')
-] ifFalse:[
+	    ] ifFalse:[
-self fileIn:(imageName , '.rc')
+		self fileIn:(imageName , '.rc')
-]
+	    ]
-].
+	].
-StartupClass perform:StartupSelector withArguments:StartupArguments.
+	StartupClass perform:StartupSelector withArguments:StartupArguments.
 ].
 "
 if view-classes exist, start dispatching;
 otherwise go into a read-eval-print loop
 "
 Display notNil ifTrue:[
-Processor dispatchLoop
+	Processor dispatchLoop
 ] ifFalse:[
-self readEvalPrint
+	self readEvalPrint
 ].
 self exit
 !
 'ST- ' print.
 Stdin skipSeparators.
 text := Stdin nextChunk.
 [text notNil] whileTrue:[
-(Compiler evaluate:text) printNL.
+	(Compiler evaluate:text) printNL.
-'ST- ' print.
+	'ST- ' print.
-text := Stdin nextChunk
+	text := Stdin nextChunk
 ].
 '' printNL
 ! !
 !Smalltalk class methodsFor:'startup'!
 "retrieve the value stored at aKey.
 If there is nothing stored under this key, return the value of
 the evaluation of aBlock."
 (self includesKey:aKey) ifTrue:[
-^ self at:aKey
+	^ self at:aKey
 ].
 ^ aBlock value
 "
 Smalltalk at:#fooBar                      <- leads to an error
 keyAtValue:anObject
 "return the symbol under which anObject is stored - or nil"
 self allKeysDo:[:aKey |
-(self at:aKey) == anObject ifTrue:[^ aKey]
+	(self at:aKey) == anObject ifTrue:[^ aKey]
 ]
 "Smalltalk keyAtValue:Object"
 !
 inspect
 "redefined to launch a DictionaryInspector on the receiver
 (instead of the default InspectorView)."
 DictionaryInspectorView isNil ifTrue:[
-super inspect
+	super inspect
 ] ifFalse:[
-DictionaryInspectorView openOn:self
+	DictionaryInspectorView openOn:self
 ]
 ! !
 !Smalltalk class methodsFor:'misc stuff'!
 "add a block to be executed when Smalltalk finishes.
 This feature is currently not used anywhere - but could be useful for
 cleanup in stand alone applications."
 ExitBlocks isNil ifTrue:[
-ExitBlocks := OrderedCollection with:aBlock
+	ExitBlocks := OrderedCollection with:aBlock
 ] ifFalse:[
-ExitBlocks add:aBlock
+	ExitBlocks add:aBlock
 ]
 !
 exit
 "finish Smalltalk system"
 ExitBlocks notNil ifTrue:[
-ExitBlocks do:[:aBlock |
+	ExitBlocks do:[:aBlock |
-aBlock value
+	    aBlock value
-]
+	]
 ].
 OperatingSystem exit
 "Smalltalk exit"
 !
 !
 printStackBacktrace
 "print a stack backtrace - then continue.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 %{
 printStack(__context);
 %}
 "Smalltalk printStackBacktrace"
 %{
 char *msg;
 if (__isString(aMessage))
-msg = (char *) _stringVal(aMessage);
+	msg = (char *) _stringVal(aMessage);
 else
-msg = "fatalAbort";
+	msg = "fatalAbort";
 fatal0(__context, msg);
 /* NEVER RETURNS */
 %}
 !
 !
 statistic
 "print some statistic data.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 %{  /* NOCONTEXT */
-statistic();
+__STATISTIC__();
 %}
 !
 debugOn
 "turns some tracing on.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 "LookupTrace := true.   "
 MessageTrace := true.
 "AllocTrace := true.     "
 ObjectMemory flushInlineCaches
 !
 debugOff
 "turns tracing off.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 LookupTrace := nil.
 MessageTrace := nil
 ". AllocTrace := nil     "
 !
 executionDebugOn
 "turns tracing of interpreter on.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 ExecutionTrace := true
 !
 executionDebugOff
 "turns tracing of interpreter off.
 WARNING: this method is for debugging only
-it may be removed without notice"
+	      it may be removed without notice"
 ExecutionTrace := nil
 ! !
 !Smalltalk class methodsFor:'enumeration'!
 associationsDo:aBlock
 "evaluate the argument, aBlock for all key/value pairs
 in the Smalltalk dictionary"
 self allKeysDo:[:aKey |
-aBlock value:(aKey -> (self at:aKey))
+	aBlock value:(aKey -> (self at:aKey))
 ]
 "Smalltalk associationsDo:[:assoc | assoc printNL]"
 !
 keysAndValuesDo:aBlock
 "evaluate the two-arg block, aBlock for all keys and values"
 self allKeysDo:[:aKey |
-aBlock value:aKey value:(self at:aKey)
+	aBlock value:aKey value:(self at:aKey)
 ]
 !
 allBehaviorsDo:aBlock
 "evaluate the argument, aBlock for all classes in the system"
 references:anObject
 "return true, if I refer to the argument, anObject
 must be reimplemented since Smalltalk is no real collection."
 self do:[:o |
-(o == anObject) ifTrue:[^ true]
+	(o == anObject) ifTrue:[^ true]
 ].
 ^ false
 !
 allClasses
 "return a collection of all classes in the system"
 CachedClasses isNil ifTrue:[
-CachedClasses := IdentitySet new:500.
+	CachedClasses := IdentitySet new:800.
-self do:[:anObject |
+	self do:[:anObject |
-anObject notNil ifTrue:[
+	    anObject notNil ifTrue:[
-anObject isBehavior ifTrue:[
+		anObject isBehavior ifTrue:[
-CachedClasses add:anObject
+		    CachedClasses add:anObject
-]
+		]
-]
+	    ]
-]
+	]
 ].
 ^ CachedClasses
 "Smalltalk allClasses"
 !
 "return a collection of all classNames in the system"
 ^ self allClasses collect:[:aClass | aClass name]
 "Smalltalk classNames"
+!
+classNamed:aString
+"return the class with name aString, or nil if absent"
+|cls|
+"be careful, to not invent new symbols ..."
+aString knownAsSymbol ifTrue:[
+	cls := self at:(aString asSymbol) ifAbsent:[^ nil].
+	cls isBehavior ifTrue:[^ cls]
+].
+^ nil
+"
+Smalltalk classNamed:'Object'
+Smalltalk classNamed:'fooBar'
+Smalltalk classNamed:'true'
+"
 ! !
 !Smalltalk class methodsFor:'class management'!
 renameClass:aClass to:newName
 "rename class variables"
 names := aClass classVariableString asCollectionOfWords.
 names do:[:name |
-cSym := (oldSym , ':' , name) asSymbol.
+	cSym := (oldSym , ':' , name) asSymbol.
-value := self at:cSym.
+	value := self at:cSym.
-self at:cSym put:nil.
+	self at:cSym put:nil.
-self removeKey:cSym.
+	self removeKey:cSym.
-cSym := (newSym , ':' , name) asSymbol.
+	cSym := (newSym , ':' , name) asSymbol.
-self at:cSym put:value.
+	self at:cSym put:value.
 ].
 aClass addChangeRecordForClassRename:oldName to:newName
 !
 |sym cSym names oldName|
 oldName := aClass name.
 sym := oldName asSymbol.
-((self at:sym) == aClass) ifFalse:[ ^ self].
+((self at:sym) == aClass) ifFalse:[
+	"check other name ..."
+	(self includes:aClass) ifFalse:[
+	    'no such class' errorPrintNL.
+	    ^ self
+	].
+	"the class has changed its name - without telling me ...
+	 what should be done in this case ?"
+	'class ' errorPrint. oldName errorPrint.
+	' has changed its name' errorPrintNL.
+	^ self
+].
 self at:sym put:nil. "nil it out for compiled accesses"
 self removeKey:sym.
+aClass category:#removed.
 "remove class variables"
 names := aClass classVariableString asCollectionOfWords.
 names do:[:name |
-cSym := (sym , ':' , name) asSymbol.
+	cSym := (sym , ':' , name) asSymbol.
-self at:cSym asSymbol put:nil.
+	self at:cSym asSymbol put:nil.
-self removeKey:cSym
+	self removeKey:cSym
 ].
 "
 actually could get along with less flushing
 (entries for aClass and subclasses only)
 aClass allSubclassesDo:[:aSubclass |
-ObjectMemory flushInlineCachesForClass:aSubclass.
+	ObjectMemory flushInlineCachesForClass:aSubclass.
-ObjectMemory flushMethodCacheFor:aSubclass
+	ObjectMemory flushMethodCacheFor:aSubclass
 ].
 ObjectMemory flushInlineCachesForClass:aClass.
 ObjectMemory flushMethodCacheFor:aClass
 "
 ObjectMemory flushInlineCaches.
 ObjectMemory flushMethodCache.
-aClass addChangeRecordForClassRemove:oldName
+aClass addChangeRecordForClassRemove:oldName.
 ! !
 !Smalltalk class methodsFor:'browsing'!
 browseChanges
 "startup a changes browser"
 ChangesBrowser notNil ifTrue:[
-ChangesBrowser open
+	ChangesBrowser open
 ] ifFalse:[
-self warn:'no ChangesBrowser built in'
+	self warn:'no ChangesBrowser built in'
 ]
 "
 Smalltalk browseChanges
 "
 ^ SystemPath
 "
 Smalltalk systemPath
+Smalltalk systemPath addLast:'someOtherDirectoryPath'
 "
 !
 getSystemFileName:aFileName
 "search aFileName in some standard places;
 "credits for this method go to Markus ...."
 |realName|
 (aFileName startsWith:'/') ifTrue:[
-"dont use path for absolute file names"
+	"dont use path for absolute file names"
-^ aFileName
+	^ aFileName
 ].
 SystemPath do:[:dirName |
-(OperatingSystem isReadable:
+	(OperatingSystem isReadable:
-(realName := dirName , '/' , aFileName))
+	    (realName := dirName , '/' , aFileName))
-ifTrue: [^ realName]].
+	      ifTrue: [^ realName]].
 ^ nil
 !
 systemFileStreamFor:aFileName
 "search aFileName in some standard places;
 |aString|
 aString := self getSystemFileName:aFileName.
 aString notNil ifTrue:[
-^ FileStream readonlyFileNamed:aString
+	^ FileStream readonlyFileNamed:aString
 ].
 ^ nil
 !
 readAbbreviations
 |aStream line index thisName abbrev|
 CachedAbbreviations := Dictionary new.
 aStream := self systemFileStreamFor:'abbrev.stc'.
 aStream isNil ifTrue:[
-aStream := self systemFileStreamFor:'include/abbrev.stc'.
+	aStream := self systemFileStreamFor:'include/abbrev.stc'.
 ].
 aStream notNil ifTrue:[
-[aStream atEnd] whileFalse:[
+	[aStream atEnd] whileFalse:[
-line := aStream nextLine.
+	    line := aStream nextLine.
-line notNil ifTrue:[
+	    line notNil ifTrue:[
-(line startsWith:'#') ifFalse:[
+		(line startsWith:'#') ifFalse:[
-(line countWords == 2) ifTrue:[
+		    (line countWords == 2) ifTrue:[
-index := line indexOfSeparatorStartingAt:1.
+			index := line indexOfSeparatorStartingAt:1.
-(index ~~ 0) ifTrue:[
+			(index ~~ 0) ifTrue:[
-thisName := line copyTo:(index - 1).
+			    thisName := line copyTo:(index - 1).
-abbrev := (line copyFrom:index) withoutSeparators.
+			    abbrev := (line copyFrom:index) withoutSeparators.
-CachedAbbreviations at:thisName put:abbrev.
+			    CachedAbbreviations at:thisName put:abbrev.
-]
+			]
-]
+		    ]
-]
+		]
-]
+	    ]
-].
+	].
-aStream close
+	aStream close
 ]
 !
 abbreviations
 "return a dictionary containing the classname-to-filename
 mappings. (needed for sys5.3 users, where filenames are limited
 to 14 chars)"
 CachedAbbreviations isNil ifTrue:[
-self readAbbreviations
+	self readAbbreviations
 ].
 ^ CachedAbbreviations
 "flush with:
 "first look, if the class exists and has a fileName"
 " later ... - compiler should put the source file name into the class
 Symbol hasInterned:aClassName ifTrue:[:sym |
-|class|
+	|class|
-(Smalltalk includesKey:sym) ifTrue:[
+	(Smalltalk includesKey:sym) ifTrue:[
-class := Smalltalk at:sym.
+	    class := Smalltalk at:sym.
-class isClass ifTrue:[
+	    class isClass ifTrue:[
-abbrev := class classFileName.
+		abbrev := class classFileName.
-]
+	    ]
-]
+	]
 ].
 "
 "look for abbreviation"
 abbrev notNil ifTrue:[^ abbrev].
 "no abbreviation found - if its a short name, take it"
 OperatingSystem maxFileNameLength < (fileName size + 3) ifTrue:[
-"this will only be triggered on sys5.3 type systems"
+	"this will only be triggered on sys5.3 type systems"
-self error:'cant find short for ' , fileName , ' in abbreviation file'
+	self error:'cant find short for ' , fileName , ' in abbreviation file'
 ].
 ^ fileName
 !
 classNameForFile:aFileName
 an object or shared object ?
 "
 ((aFileName endsWith:'.o')
 or:[(aFileName endsWith:'.obj')
 or:[aFileName endsWith:'.so']]) ifTrue:[
-ObjectFileLoader isNil ifTrue:[^ false].
+	ObjectFileLoader isNil ifTrue:[^ false].
 	path := self getSystemFileName:aFileName.
 	path isNil ifTrue:[^ false].
 	^ ObjectFileLoader loadObjectFile:aFileName
 ].
 fileInChanges
 "read in the last changes file - bringing the system to the state it
 had when left the last time.
 WARNING: this method is rubbish: it should only read things after the
-last '**snapshot**' - entry."
+	      last '**snapshot**' - entry."
 |upd|
 "
 tell Class to NOT update the changes file now ...
 "
 upd := Class updateChanges:false.
 [
-self fileIn:'changes'
+	self fileIn:'changes'
 ] valueNowOrOnUnwindDo:[
-Class updateChanges:upd
+	Class updateChanges:upd
 ]
 "
 Smalltalk fileInChanges
 "
 |shortName newClass upd ok nm|
 upd := Class updateChanges:false.
 [
-"
+	"
-first, look for a loader-driver file (in fileIn/xxx.ld)
+	 first, look for a loader-driver file (in fileIn/xxx.ld)
-"
+	"
-(self fileIn:('fileIn/' , aClassName , '.ld'))
+	(self fileIn:('fileIn/' , aClassName , '.ld'))
-ifFalse:[
+	ifFalse:[
-shortName := self fileNameForClass:aClassName.
+	    shortName := self fileNameForClass:aClassName.
-"
+	    "
-try abbreviated driver-file (in fileIn/xxx.ld)
+	     try abbreviated driver-file (in fileIn/xxx.ld)
-"
+	    "
-(self fileIn:('fileIn/' , shortName , '.ld'))
+	    (self fileIn:('fileIn/' , shortName , '.ld'))
-ifFalse:[
+	    ifFalse:[
-"
+		"
-then, if dynamic linking is available, look for a shared binary in binary/xxx.o
+		 then, if dynamic linking is available, look for a shared binary in binary/xxx.o
-"
+		"
-ObjectFileLoader notNil ifTrue:[
+		ObjectFileLoader notNil ifTrue:[
-nm := 'binary/' , aClassName.
+		    nm := 'binary/' , aClassName.
-(self fileInClassObject:aClassName from:(nm , '.so'))
+		    (self fileInClassObject:aClassName from:(nm , '.so'))
-ifFalse:[
+		    ifFalse:[
-(self fileInClassObject:aClassName from:(nm , '.o'))
+			(self fileInClassObject:aClassName from:(nm , '.o'))
-ifFalse:[
+			ifFalse:[
-nm := 'binary/' , shortName.
+			    nm := 'binary/' , shortName.
-(self fileInClassObject:aClassName from:(nm , '.so'))
+			    (self fileInClassObject:aClassName from:(nm , '.so'))
-ifFalse:[
+			    ifFalse:[
-ok := self fileInClassObject:aClassName from:(nm , '.o')
+				ok := self fileInClassObject:aClassName from:(nm , '.o')
-].
+			    ].
-].
+			].
-].
+		    ].
-].
+		].
-"
+		"
-if that did not work, look for an st-source file ...
+		 if that did not work, look for an st-source file ...
-"
+		"
-ok ifFalse:[
+		ok ifFalse:[
-(self fileIn:(aClassName , '.st'))
+		    (self fileIn:(aClassName , '.st'))
-ifFalse:[
+		    ifFalse:[
-(self fileIn:(shortName , '.st'))
+			(self fileIn:(shortName , '.st'))
-ifFalse:[
+			ifFalse:[
-"
+			    "
-... and in the standard source-directory
+			     ... and in the standard source-directory
-"
+			    "
-(self fileIn:('source/' , aClassName , '.st'))
+			    (self fileIn:('source/' , aClassName , '.st'))
-ifFalse:[
+			    ifFalse:[
-ok := self fileIn:('source/' , shortName , '.st')
+				ok := self fileIn:('source/' , shortName , '.st')
-]
+			    ]
-]
+			]
-]
+		    ]
-]
+		]
-].
+	    ].
-]
+	]
 ] valueNowOrOnUnwindDo:[Class updateChanges:upd].
 newClass := self at:(aClassName asSymbol).
 newClass notNil ifTrue:[newClass initialize]
+!
+silentFileIn:aFilename
+"same as fileIn:, but do not output 'compiled...'-messages on Transcript.
+Main use is during startup."
+|wasSilent|
+wasSilent := self silentLoading:true.
+[
+	self fileIn:aFilename
+] valueNowOrOnUnwindDo:[
+	self silentLoading:wasSilent
+]
 ! !
 !Smalltalk class methodsFor: 'binary storage'!
 addGlobalsTo: globalDictionary manager: manager
 |pools|
 pools := Set new.
 self associationsDo:[:assoc |
-assoc value == self ifFalse:[
+	assoc value == self ifFalse:[
-assoc value isClass ifTrue:[
+	    assoc value isClass ifTrue:[
-assoc value addGlobalsTo:globalDictionary manager:manager.
+		assoc value addGlobalsTo:globalDictionary manager:manager.
-pools addAll:assoc value sharedPools
+		pools addAll:assoc value sharedPools
-] ifFalse:[
+	    ] ifFalse:[
-globalDictionary at:assoc put:self
+		globalDictionary at:assoc put:self
-].
+	    ].
-assoc value isNil ifFalse:[
+	    assoc value isNil ifFalse:[
-globalDictionary at:assoc value put:self
+		globalDictionary at:assoc value put:self
-]
+	    ]
-]
+	]
 ].
 pools do:[:poolDictionary|
-poolDictionary addGlobalsTo:globalDictionary manager:manager
+	poolDictionary addGlobalsTo:globalDictionary manager:manager
 ]
 !
 storeBinaryDefinitionOf: anObject on: stream manager: manager
 |string|
 anObject class == Association ifTrue:[
-string := 'Smalltalk associationAt: ', anObject key storeString
+	string := 'Smalltalk associationAt: ', anObject key storeString
 ] ifFalse: [
-string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
+	string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
 ].
 stream nextNumber:2 put:string size.
 string do:[:char | stream nextPut:char asciiValue]
 ! !

changeset 159	514c749165c3
parent 146	7c684e19ddc7
child 161	ed36169f354d