--- a/Smalltalk.st Mon Oct 10 01:29:01 1994 +0100
+++ b/Smalltalk.st Mon Oct 10 01:29:28 1994 +0100
@@ -1,6 +1,6 @@
"
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
@@ -13,20 +13,20 @@
Object subclass:#Smalltalk
instanceVariableNames:''
classVariableNames:'ExitBlocks CachedClasses SystemPath
- StartupClass StartupSelector StartupArguments
- CachedAbbreviations
- SilentLoading Initializing
- StandAlone
- LogDoits'
+ StartupClass StartupSelector StartupArguments
+ CachedAbbreviations
+ SilentLoading Initializing
+ StandAlone
+ 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 $
'!
"
@@ -42,7 +42,7 @@
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
@@ -55,7 +55,7 @@
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 $
"
!
@@ -72,29 +72,29 @@
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
- left. Not currently used.
+ ExitBlocks <Collection> blocks to evaluate before system is
+ 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
- (right after VM initialization)
- StartupSelector <Symbol> message sent to StartupClass
+ StartupClass <Class> class, which gets initial message
+ (right after VM initialization)
+ StartupSelector <Symbol> message sent to StartupClass
- CachedAbbreviations
- <Dictionary> className to filename mappings
+ CachedAbbreviations
+ <Dictionary> className to filename mappings
- SilentLoading <Boolean> suppresses messages during fileIn and in compiler
- (can be set to true from a customized main)
+ SilentLoading <Boolean> suppresses messages during fileIn and in compiler
+ (can be set to true from a customized main)
- LogDoits <Boolean> if true, doits are also logged in the changes
- file. Default is false, since the changes file
- may become huge ...
+ LogDoits <Boolean> if true, doits are also logged in the changes
+ file. Default is false, since the changes file
+ may become huge ...
"
! !
@@ -151,7 +151,7 @@
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 $
"
!
@@ -164,7 +164,7 @@
RETURN ( _MKSTRING(VERSIONDATE_STRING COMMA_SND) );
#endif
%}.
- ^ '3-aug-1994'
+ ^ '23-aug-1994'
"
Smalltalk versionDate
@@ -205,12 +205,12 @@
Resource-stuff."
(Language == #german) ifTrue:[
- ^ 'Willkommen bei SmallTalk/X version '
- , self versionString , ' vom ' , self versionDate
+ ^ 'Willkommen bei SmallTalk/X version '
+ , self versionString , ' vom ' , self versionDate
].
(Language == #french) ifTrue:[
- ^ 'Bienvenue a SmallTalk/X version '
- , self versionString , ' de ' , self versionDate
+ ^ 'Bienvenue a SmallTalk/X version '
+ , self versionString , ' de ' , self versionDate
].
^ 'Hello World - here is SmallTalk/X version '
, self versionString , ' of ' , self versionDate
@@ -255,7 +255,7 @@
must init display here - some classes (Color, Form) need it during initialize
"
Workstation notNil ifTrue:[
- Workstation initialize
+ Workstation initialize
].
"
@@ -267,25 +267,28 @@
Debugger := MiniDebugger.
Compiler := ByteCodeCompiler.
Compiler isNil ifTrue:[
- "
- ByteCodeCompiler is not in the system (i.e. has not been linked in)
- this allows at least immediate evaluations for runtime systems without compiler
- NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
- "
- Compiler := Parser
+ "
+ ByteCodeCompiler is not in the system (i.e. has not been linked in)
+ this allows at least immediate evaluations for runtime systems without compiler
+ NOTICE: a parser is always needed, otherwise we cannot read resource files etc.
+ "
+ Compiler := Parser
].
"
- now finally initialize all classes
+ now, finally, initialize all leftover classes
"
+"/ Object allSubclassesInOrderDo:[:aClass |
self allBehaviorsDo:[:aClass |
- "
- avoid never-ending story ...
- "
- (aClass ~~ Smalltalk) ifTrue:[
- aClass initialize
- ]
+ "
+ avoid never-ending story ...
+ "
+ (aClass ~~ Smalltalk) ifTrue:[
+"/ 'init ' print. aClass name printNL.
+ aClass initialize
+ ]
].
+
"
now we can enable the graphical debugger/inspector
"
@@ -310,23 +313,23 @@
extract Language and LanguageTerritory from LANG variable.
the language and territory must not be abbreviated,
valid is for example: english_usa
- english
- german
- german_austria
+ english
+ german
+ german_austria
"
envString := OperatingSystem getEnvironment:'LANG'.
envString notNil ifTrue:[
- i := envString indexOf:$_.
- (i == 0) ifTrue:[
- langString := envString.
- terrString := envString
- ] ifFalse:[
- langString := envString copyTo:(i - 1).
- terrString := envString copyFrom:(i + 1)
- ].
- Language := langString asSymbol.
- LanguageTerritory := terrString asSymbol
+ i := envString indexOf:$_.
+ (i == 0) ifTrue:[
+ langString := envString.
+ terrString := envString
+ ] ifFalse:[
+ langString := envString copyTo:(i - 1).
+ terrString := envString copyFrom:(i + 1)
+ ].
+ Language := langString asSymbol.
+ LanguageTerritory := terrString asSymbol
].
"
@@ -336,12 +339,12 @@
"
envString := OperatingSystem getEnvironment:'VIEW3D'.
envString notNil ifTrue:[
- firstChar := (envString at:1) asLowercase.
- (firstChar == $t) ifTrue:[
- Smalltalk at:#View3D put:true
- ] ifFalse: [
- Smalltalk at:#View3D put:false
- ]
+ firstChar := (envString at:1) asLowercase.
+ (firstChar == $t) ifTrue:[
+ Smalltalk at:#View3D put:true
+ ] ifFalse: [
+ Smalltalk at:#View3D put:false
+ ]
]
"Smalltalk initGlobalsFromEnvironment"
!
@@ -354,13 +357,13 @@
"redefine debug-tools, if view-classes exist"
Display notNil ifTrue:[
- InspectorView notNil ifTrue:[
- Inspector := InspectorView
- ].
- DebugView notNil ifTrue:[
- Debugger := DebugView
- ].
- Display initialize
+ InspectorView notNil ifTrue:[
+ Inspector := InspectorView
+ ].
+ DebugView notNil ifTrue:[
+ Debugger := DebugView
+ ].
+ Display initialize
]
"Smalltalk initStandardTools"
!
@@ -394,19 +397,19 @@
initSystemPath
"setup path where system files are searched for.
the default path is set to:
- .
- ..
- $HOME (if defined)
- $HOME/.smalltalk (if defined & existing)
- $SMALLTALK_LIBDIR (if defined & existing)
- /usr/local/lib/smalltalk (if existing)
- /usr/lib/smalltalk (if existing)
+ .
+ ..
+ $HOME (if defined)
+ $HOME/.smalltalk (if defined & existing)
+ $SMALLTALK_LIBDIR (if defined & existing)
+ /usr/local/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'.
- or:
- Smalltalk systemPath addLast:'/fee/foe/foo'.
+ Smalltalk systemPath addFirst:'/foo/bar/baz'.
+ or:
+ Smalltalk systemPath addLast:'/fee/foe/foo'.
"
|p homePath|
@@ -422,17 +425,17 @@
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'
].
"
@@ -448,7 +451,7 @@
|idx|
Initializing := true.
- Processor := ProcessorScheduler new.
+"/ Processor := ProcessorScheduler new.
"
while reading patches- and rc-file, do not add things into change-file
@@ -463,29 +466,31 @@
"
idx := Arguments indexOf:'-e'.
idx ~~ 0 ifTrue:[
- self fileIn:(Arguments at:idx + 1).
- self exit
+ self fileIn:(Arguments at:idx + 1).
+ self exit
].
(self fileIn:((Arguments at:1) , '.rc')) ifFalse:[
- "no .rc file where executable is; try default smalltalk.rc"
- self fileIn:'smalltalk.rc'
+ "no .rc file where executable is; try default 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 copyrightString).
- Transcript cr.
+ Transcript showCr:(self hello).
+ Transcript showCr:(self copyrightString).
+ Transcript cr.
- DemoMode ifTrue:[
- Transcript showCr:'*** Restricted use: ***'.
- Transcript showCr:'*** This program may be used for education only. ***'.
- Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE ***'.
- Transcript showCr:'*** for more details. ***'.
- Transcript cr.
- ].
+ DemoMode ifTrue:[
+ Transcript showCr:'*** Restricted use: ***'.
+ Transcript showCr:'*** This program may be used for education only. ***'.
+ Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE ***'.
+ Transcript showCr:'*** for more details. ***'.
+ Transcript cr.
+ ].
].
Initializing := false.
@@ -500,18 +505,18 @@
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 startDispatch
- ]
+ ModalDisplay notNil ifTrue:[
+ ModalDisplay startDispatch
+ ]
" "
].
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
- StartupClass perform:StartupSelector withArguments:StartupArguments.
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
].
"
@@ -519,9 +524,9 @@
otherwise go into a read-eval-print loop
"
Display notNil ifTrue:[
- Processor dispatchLoop
+ Processor dispatchLoop
] ifFalse:[
- self readEvalPrint
+ self readEvalPrint
].
"done"
@@ -534,18 +539,18 @@
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
- be automatically be reopened (i.e. Sockets, Pipes) and so on.
+ (should be used to restart processes, reOpen Streams which cannot
+ 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"
@@ -564,7 +569,7 @@
"
Workstation notNil ifTrue:[
- Workstation reinitialize.
+ Workstation reinitialize.
].
ObjectMemory changed:#returnFromSnapshot.
@@ -582,45 +587,45 @@
if there is no Transcript, go to stderr
"
Transcript isNil ifTrue:[
- self initStandardStreams.
- Transcript := Stderr
+ self initStandardStreams.
+ Transcript := Stderr
].
(SilentLoading == true) ifFalse:[
- Transcript cr.
- Transcript showCr:('Smalltalk restarted from:' , ObjectMemory imageName).
- Transcript cr.
+ Transcript cr.
+ Transcript showCr:('Smalltalk restarted from:' , ObjectMemory imageName).
+ Transcript cr.
- DemoMode ifTrue:[
- Transcript showCr:'*** Restricted use: ***'.
- Transcript showCr:'*** This program may be used for education only. ***'.
- Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE ***'.
- Transcript showCr:'*** for more details. ***'.
- Transcript cr.
- ].
+ DemoMode ifTrue:[
+ Transcript showCr:'*** Restricted use: ***'.
+ Transcript showCr:'*** This program may be used for education only. ***'.
+ Transcript showCr:'*** Please read the files COPYRIGHT and LICENSE ***'.
+ Transcript showCr:'*** for more details. ***'.
+ Transcript cr.
+ ].
].
"
give user a chance to re-customize things
"
(Arguments includes:'-faststart') ifFalse:[
- Class updateChanges:false.
- (self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
- "no _r.rc file where executable is; try default smalltalk_r.rc"
- self fileIn:'smalltalk_r.rc'
- ].
- Class updateChanges:true.
+ Class updateChanges:false.
+ (self fileIn:((Arguments at:1) , '_r.rc')) ifFalse:[
+ "no _r.rc file where executable is; try default smalltalk_r.rc"
+ self fileIn:'smalltalk_r.rc'
+ ].
+ Class updateChanges:true.
].
"
if there is a display, start its event dispatcher
"
Display notNil ifTrue:[
- Display startDispatch.
+ Display startDispatch.
" "
- ModalDisplay notNil ifTrue:[
- ModalDisplay startDispatch
- ]
+ ModalDisplay notNil ifTrue:[
+ ModalDisplay startDispatch
+ ]
" "
].
@@ -629,16 +634,16 @@
these two globals during snapshot ... or in main
"
(StartupClass notNil and:[StartupSelector notNil]) ifTrue:[
- "allow customization by reading an image specific rc-file"
- imageName := ObjectMemory imageName.
- imageName notNil ifTrue:[
- (imageName endsWith:'.img') ifTrue:[
- self fileIn:((imageName copyTo:(imageName size - 4)), '.rc')
- ] ifFalse:[
- self fileIn:(imageName , '.rc')
- ]
- ].
- StartupClass perform:StartupSelector withArguments:StartupArguments.
+ "allow customization by reading an image specific rc-file"
+ imageName := ObjectMemory imageName.
+ imageName notNil ifTrue:[
+ (imageName endsWith:'.img') ifTrue:[
+ self fileIn:((imageName copyTo:(imageName size - 4)), '.rc')
+ ] ifFalse:[
+ self fileIn:(imageName , '.rc')
+ ]
+ ].
+ StartupClass perform:StartupSelector withArguments:StartupArguments.
].
"
@@ -646,9 +651,9 @@
otherwise go into a read-eval-print loop
"
Display notNil ifTrue:[
- Processor dispatchLoop
+ Processor dispatchLoop
] ifFalse:[
- self readEvalPrint
+ self readEvalPrint
].
self exit
@@ -663,9 +668,9 @@
Stdin skipSeparators.
text := Stdin nextChunk.
[text notNil] whileTrue:[
- (Compiler evaluate:text) printNL.
- 'ST- ' print.
- text := Stdin nextChunk
+ (Compiler evaluate:text) printNL.
+ 'ST- ' print.
+ text := Stdin nextChunk
].
'' printNL
! !
@@ -721,7 +726,7 @@
the evaluation of aBlock."
(self includesKey:aKey) ifTrue:[
- ^ self at:aKey
+ ^ self at:aKey
].
^ aBlock value
@@ -768,7 +773,7 @@
"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"
@@ -817,9 +822,9 @@
(instead of the default InspectorView)."
DictionaryInspectorView isNil ifTrue:[
- super inspect
+ super inspect
] ifFalse:[
- DictionaryInspectorView openOn:self
+ DictionaryInspectorView openOn:self
]
! !
@@ -831,9 +836,9 @@
cleanup in stand alone applications."
ExitBlocks isNil ifTrue:[
- ExitBlocks := OrderedCollection with:aBlock
+ ExitBlocks := OrderedCollection with:aBlock
] ifFalse:[
- ExitBlocks add:aBlock
+ ExitBlocks add:aBlock
]
!
@@ -841,9 +846,9 @@
"finish Smalltalk system"
ExitBlocks notNil ifTrue:[
- ExitBlocks do:[:aBlock |
- aBlock value
- ]
+ ExitBlocks do:[:aBlock |
+ aBlock value
+ ]
].
OperatingSystem exit
@@ -893,7 +898,7 @@
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);
@@ -908,9 +913,9 @@
char *msg;
if (__isString(aMessage))
- msg = (char *) _stringVal(aMessage);
+ msg = (char *) _stringVal(aMessage);
else
- msg = "fatalAbort";
+ msg = "fatalAbort";
fatal0(__context, msg);
/* NEVER RETURNS */
@@ -937,17 +942,17 @@
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.
@@ -958,7 +963,7 @@
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
@@ -968,7 +973,7 @@
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
!
@@ -976,7 +981,7 @@
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
! !
@@ -1002,7 +1007,7 @@
in the Smalltalk dictionary"
self allKeysDo:[:aKey |
- aBlock value:(aKey -> (self at:aKey))
+ aBlock value:(aKey -> (self at:aKey))
]
"Smalltalk associationsDo:[:assoc | assoc printNL]"
@@ -1012,7 +1017,7 @@
"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)
]
!
@@ -1059,7 +1064,7 @@
must be reimplemented since Smalltalk is no real collection."
self do:[:o |
- (o == anObject) ifTrue:[^ true]
+ (o == anObject) ifTrue:[^ true]
].
^ false
!
@@ -1068,14 +1073,14 @@
"return a collection of all classes in the system"
CachedClasses isNil ifTrue:[
- CachedClasses := IdentitySet new:500.
- self do:[:anObject |
- anObject notNil ifTrue:[
- anObject isBehavior ifTrue:[
- CachedClasses add:anObject
- ]
- ]
- ]
+ CachedClasses := IdentitySet new:800.
+ self do:[:anObject |
+ anObject notNil ifTrue:[
+ anObject isBehavior ifTrue:[
+ CachedClasses add:anObject
+ ]
+ ]
+ ]
].
^ CachedClasses
@@ -1088,6 +1093,25 @@
^ 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'!
@@ -1121,12 +1145,12 @@
names := aClass classVariableString asCollectionOfWords.
names do:[:name |
- cSym := (oldSym , ':' , name) asSymbol.
- value := self at:cSym.
- self at:cSym put:nil.
- self removeKey:cSym.
- cSym := (newSym , ':' , name) asSymbol.
- self at:cSym put:value.
+ cSym := (oldSym , ':' , name) asSymbol.
+ value := self at:cSym.
+ self at:cSym put:nil.
+ self removeKey:cSym.
+ cSym := (newSym , ':' , name) asSymbol.
+ self at:cSym put:value.
].
aClass addChangeRecordForClassRename:oldName to:newName
@@ -1141,26 +1165,39 @@
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.
- self at:cSym asSymbol put:nil.
- self removeKey:cSym
+ cSym := (sym , ':' , name) asSymbol.
+ self at:cSym asSymbol put:nil.
+ self removeKey:cSym
].
"
actually could get along with less flushing
(entries for aClass and subclasses only)
aClass allSubclassesDo:[:aSubclass |
- ObjectMemory flushInlineCachesForClass:aSubclass.
- ObjectMemory flushMethodCacheFor:aSubclass
+ ObjectMemory flushInlineCachesForClass:aSubclass.
+ ObjectMemory flushMethodCacheFor:aSubclass
].
ObjectMemory flushInlineCachesForClass:aClass.
ObjectMemory flushMethodCacheFor:aClass
@@ -1168,7 +1205,7 @@
ObjectMemory flushInlineCaches.
ObjectMemory flushMethodCache.
- aClass addChangeRecordForClassRemove:oldName
+ aClass addChangeRecordForClassRemove:oldName.
! !
!Smalltalk class methodsFor:'browsing'!
@@ -1177,9 +1214,9 @@
"startup a changes browser"
ChangesBrowser notNil ifTrue:[
- ChangesBrowser open
+ ChangesBrowser open
] ifFalse:[
- self warn:'no ChangesBrowser built in'
+ self warn:'no ChangesBrowser built in'
]
"
@@ -1265,6 +1302,7 @@
"
Smalltalk systemPath
+ Smalltalk systemPath addLast:'someOtherDirectoryPath'
"
!
@@ -1278,15 +1316,15 @@
|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:
- (realName := dirName , '/' , aFileName))
- ifTrue: [^ realName]].
+ (OperatingSystem isReadable:
+ (realName := dirName , '/' , aFileName))
+ ifTrue: [^ realName]].
^ nil
!
@@ -1299,7 +1337,7 @@
aString := self getSystemFileName:aFileName.
aString notNil ifTrue:[
- ^ FileStream readonlyFileNamed:aString
+ ^ FileStream readonlyFileNamed:aString
].
^ nil
!
@@ -1313,25 +1351,25 @@
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:[
- line := aStream nextLine.
- line notNil ifTrue:[
- (line startsWith:'#') ifFalse:[
- (line countWords == 2) ifTrue:[
- index := line indexOfSeparatorStartingAt:1.
- (index ~~ 0) ifTrue:[
- thisName := line copyTo:(index - 1).
- abbrev := (line copyFrom:index) withoutSeparators.
- CachedAbbreviations at:thisName put:abbrev.
- ]
- ]
- ]
- ]
- ].
- aStream close
+ [aStream atEnd] whileFalse:[
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ (line startsWith:'#') ifFalse:[
+ (line countWords == 2) ifTrue:[
+ index := line indexOfSeparatorStartingAt:1.
+ (index ~~ 0) ifTrue:[
+ thisName := line copyTo:(index - 1).
+ abbrev := (line copyFrom:index) withoutSeparators.
+ CachedAbbreviations at:thisName put:abbrev.
+ ]
+ ]
+ ]
+ ]
+ ].
+ aStream close
]
!
@@ -1341,7 +1379,7 @@
to 14 chars)"
CachedAbbreviations isNil ifTrue:[
- self readAbbreviations
+ self readAbbreviations
].
^ CachedAbbreviations
@@ -1363,14 +1401,14 @@
" later ... - compiler should put the source file name into the class
Symbol hasInterned:aClassName ifTrue:[:sym |
- |class|
+ |class|
- (Smalltalk includesKey:sym) ifTrue:[
- class := Smalltalk at:sym.
- class isClass ifTrue:[
- abbrev := class classFileName.
- ]
- ]
+ (Smalltalk includesKey:sym) ifTrue:[
+ class := Smalltalk at:sym.
+ class isClass ifTrue:[
+ abbrev := class classFileName.
+ ]
+ ]
].
"
@@ -1382,8 +1420,8 @@
"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"
- self error:'cant find short for ' , fileName , ' in abbreviation file'
+ "this will only be triggered on sys5.3 type systems"
+ self error:'cant find short for ' , fileName , ' in abbreviation file'
].
^ fileName
!
@@ -1428,7 +1466,7 @@
((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
@@ -1449,7 +1487,7 @@
"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|
@@ -1458,9 +1496,9 @@
"
upd := Class updateChanges:false.
[
- self fileIn:'changes'
+ self fileIn:'changes'
] valueNowOrOnUnwindDo:[
- Class updateChanges:upd
+ Class updateChanges:upd
]
"
@@ -1478,58 +1516,72 @@
upd := Class updateChanges:false.
[
- "
- first, look for a loader-driver file (in fileIn/xxx.ld)
- "
- (self fileIn:('fileIn/' , aClassName , '.ld'))
- ifFalse:[
- shortName := self fileNameForClass:aClassName.
- "
- try abbreviated driver-file (in fileIn/xxx.ld)
- "
- (self fileIn:('fileIn/' , shortName , '.ld'))
- ifFalse:[
- "
- then, if dynamic linking is available, look for a shared binary in binary/xxx.o
- "
- ObjectFileLoader notNil ifTrue:[
- nm := 'binary/' , aClassName.
- (self fileInClassObject:aClassName from:(nm , '.so'))
- ifFalse:[
- (self fileInClassObject:aClassName from:(nm , '.o'))
- ifFalse:[
- nm := 'binary/' , shortName.
- (self fileInClassObject:aClassName from:(nm , '.so'))
- ifFalse:[
- ok := self fileInClassObject:aClassName from:(nm , '.o')
- ].
- ].
- ].
- ].
+ "
+ first, look for a loader-driver file (in fileIn/xxx.ld)
+ "
+ (self fileIn:('fileIn/' , aClassName , '.ld'))
+ ifFalse:[
+ shortName := self fileNameForClass:aClassName.
+ "
+ try abbreviated driver-file (in fileIn/xxx.ld)
+ "
+ (self fileIn:('fileIn/' , shortName , '.ld'))
+ ifFalse:[
+ "
+ then, if dynamic linking is available, look for a shared binary in binary/xxx.o
+ "
+ ObjectFileLoader notNil ifTrue:[
+ nm := 'binary/' , aClassName.
+ (self fileInClassObject:aClassName from:(nm , '.so'))
+ ifFalse:[
+ (self fileInClassObject:aClassName from:(nm , '.o'))
+ ifFalse:[
+ nm := 'binary/' , shortName.
+ (self fileInClassObject:aClassName from:(nm , '.so'))
+ ifFalse:[
+ ok := self fileInClassObject:aClassName from:(nm , '.o')
+ ].
+ ].
+ ].
+ ].
- "
- if that did not work, look for an st-source file ...
- "
- ok ifFalse:[
- (self fileIn:(aClassName , '.st'))
- ifFalse:[
- (self fileIn:(shortName , '.st'))
- ifFalse:[
- "
- ... and in the standard source-directory
- "
- (self fileIn:('source/' , aClassName , '.st'))
- ifFalse:[
- ok := self fileIn:('source/' , shortName , '.st')
- ]
- ]
- ]
- ]
- ].
- ]
+ "
+ if that did not work, look for an st-source file ...
+ "
+ ok ifFalse:[
+ (self fileIn:(aClassName , '.st'))
+ ifFalse:[
+ (self fileIn:(shortName , '.st'))
+ ifFalse:[
+ "
+ ... and in the standard source-directory
+ "
+ (self fileIn:('source/' , aClassName , '.st'))
+ ifFalse:[
+ 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'!
@@ -1539,21 +1591,21 @@
pools := Set new.
self associationsDo:[:assoc |
- assoc value == self ifFalse:[
- assoc value isClass ifTrue:[
- assoc value addGlobalsTo:globalDictionary manager:manager.
- pools addAll:assoc value sharedPools
- ] ifFalse:[
- globalDictionary at:assoc put:self
- ].
- assoc value isNil ifFalse:[
- globalDictionary at:assoc value put:self
- ]
- ]
+ assoc value == self ifFalse:[
+ assoc value isClass ifTrue:[
+ assoc value addGlobalsTo:globalDictionary manager:manager.
+ pools addAll:assoc value sharedPools
+ ] ifFalse:[
+ globalDictionary at:assoc put:self
+ ].
+ assoc value isNil ifFalse:[
+ globalDictionary at:assoc value put:self
+ ]
+ ]
].
pools do:[:poolDictionary|
- poolDictionary addGlobalsTo:globalDictionary manager:manager
+ poolDictionary addGlobalsTo:globalDictionary manager:manager
]
!
@@ -1561,9 +1613,9 @@
|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]