--- a/Signal.st Wed Mar 30 11:41:04 1994 +0200
+++ b/Signal.st Wed Mar 30 12:00:27 1994 +0200
@@ -11,7 +11,8 @@
"
Object subclass:#Signal
- instanceVariableNames:'mayProceed notifierString nameClass message'
+ instanceVariableNames:'mayProceed notifierString nameClass message
+ handlerBlock'
classVariableNames:'NoHandlerSignal'
poolDictionaries:''
category:'Kernel-Exceptions'
@@ -22,40 +23,65 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.7 1994-02-25 13:03:58 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Signal.st,v 1.8 1994-03-30 09:59:53 claus Exp $
'!
!Signal class methodsFor:'documentation'!
documentation
"
-Signal and Exception provide a framework for exception handling.
+ Signal and Exception provide a framework for exception handling.
-A Signal object is usually defined somewhere up in the calling chain
-and associated with some abnormal event. Many signals are also
-created at startup time and reused.
+ A Signal object is usually defined somewhere up in the calling chain
+ and associated with some abnormal event. Many signals are also
+ created at startup time and reused.
-When the event is raised (by Signal>>raise) the control will be either
-given to a debugger or - if a handler was defined - to the handler.
-The handler will get a description of what (and where) happened in an
-Exception object and decide how to react on the situation (i.e. proceed,
-return or restart).
+ When the event is raised (by Signal>>raise) the control will be either
+ given to a debugger or - if a handler was defined - to the handler.
+ The handler will get a description of what (and where) happened in an
+ Exception object and decide how to react on the situation (i.e. proceed,
+ return or restart).
+
+ There is also a companion class called SignalSet, which allows handling
+ multiple signals with one handler (for example all arithmetic signals).
+ And, finally there is a very special SignalSet which allows catching
+ any signal (SignalSet>>anySignal).
+
+ This Signal implementation has been modeled after what some PD
+ programs seem to expect - it may not be perfect currently
+ (especially, I dont know what nameClass and message are for).
-There is also a companion class called SignalSet, which allows handling
-multiple signals with one handler (for example all arithmetic signals).
-And, finally there is a very special SignalSet which allows catching
-any signal (SignalSet>>anySignal).
+ In addition to the nested catch & throw mechanism, signals can also be
+ used when no such scoping exists. To support this, signals can be assigned
+ a handlerBlock, which gets evaluated with the exception argument and the
+ raise-context, in case no handler was found.
+ If neither handler-context, nor handler block is defined, the emergencyHandler
+ (from Exception) is evaluated - this one will bring up a debugger by default.
+
+ HandlerBlock allows to globally catch UNIX signals at any time.
+
+ Part of the implementation is a left-over from old times when the resume/
+ restart things in context did not work properly. Now, with the handler-
+ and suspendedContext at hand, the exception can do it using other mechanisms.
+ This might be cleaned up ...
+
+ See samples in doc/coding.
-This Signal implementation has been modeled after what some PD
-programs seem to expect - it may not be perfect currently
-(especially, I dont know what nameClass and message are for).
+ Instance variables:
+
+ mayProceed <Boolean> hint for the debugger - program may proceed
+ (currently not honored by the debugger)
+
+ notifierString <String> eror message to be output
-Parts of the implementation is a left-over from old times when the resume/
-restart things in context did not work properly; now, with the handler-
-and suspendedContext at hand, the exception can do it using other mechanisms.
-This might be cleaned up ...
+ nameClass <???> I dont know what this is for
+ (included for ST-80 compatibility)
-See samples in doc/coding.
+ message <???> I dont know what this is for
+ (included for ST-80 compatibility)
+
+ handlerBlock <Block> if nonNil, a (2-arg) block to be evaluated
+ when no handler context is found.
"
! !
@@ -127,6 +153,12 @@
"return the notifier string"
^ notifierString
+!
+
+handlerBlock:aBlock
+ "set the handlerblock"
+
+ handlerBlock := aBlock
! !
!Signal methodsFor:'save evaluation'!
@@ -144,12 +176,16 @@
!
catch:aBlock
- "evaluate the argument, aBlock.
+ "evaluate the argument, aBlock; return false.
If the receiver-signal is raised during evaluation, abort
- the evaluation and return nil. This is the catch & throw
+ the evaluation and return true. This is the catch & throw
mechanism found in other languages."
- ^ self handle:[:ex | ex return] do:aBlock
+ |raiseOccurred|
+
+ raiseOccurred := false.
+ self handle:[:ex | raiseOccurred := true. ex return] do:aBlock.
+ ^ raiseOccurred
"
Object messageNotUnderstoodSignal catch:[
@@ -158,16 +194,47 @@
"
! !
+!Signal methodsFor:'queries'!
+
+isHandled
+ "return true, if there is a handler for the receiver signal.
+ Raising an unhandled signal will usually lead into the debugger,
+ but can be cought globally by setting Exceptions EmergencyHandler."
+
+ |con|
+
+ con := thisContext.
+ con := con sender.
+ [con notNil] whileTrue:[
+ (con selector == #handle:do:) ifTrue:[
+ "
+ is this is the Signal>>handle:do: context
+ or a SignalSet>>handle:do: context with self in it ?
+ "
+ ((con receiver == self)
+ or:[(con receiver isMemberOf:SignalSet) and:[con receiver includes:self]]) ifTrue:[
+ "found it"
+
+ ^ true
+ ].
+ ].
+ con := con sender
+ ].
+ ^ false
+! !
+
!Signal methodsFor:'raising'!
raise
"raise a signal - create an Exception object
and call the handler with this as argument.
- This could have been defined using 'raiseRequestWith:', but is not -
- to not add too many contexts to the backtrace (thus making things
- cleaner in the debugger-walkback eventually)"
+ The signals notifierString is used as errorString."
- |ex|
+ "This could have been defined using 'raiseRequestWith:',
+ but is not - to not add too many contexts to the backtrace
+ (thus making things cleaner in the debugger-walkback eventually)"
+
+ |ex block|
ex := Exception new
signal:self
@@ -178,19 +245,28 @@
ex resumeBlock:[:value | ^ value].
self evaluateHandlerWith:ex.
- "mmhh - no handler found call emergency"
- (Exception emergencyHandler) value:ex value:thisContext.
- ^ nil
+ "
+ finally,
+ take either handlerBlock or emergencyHandler ...
+ "
+ (block := handlerBlock) isNil ifTrue:[
+ block := Exception emergencyHandler
+ ].
+
+ "... and call it"
+ ^ block value:ex value:thisContext.
!
raiseRequestWith:aParameter
"raise a signal - create an Exception object with aParameter
- and call the handler with this as argument.
- This could have been defined using 'raiseRequestWith:errString:',
+ and call the handler with this as argument..
+ The signals notifierString is used as errorString."
+
+ "This could have been defined using 'raiseRequestWith:',
but is not - to not add too many contexts to the backtrace
(thus making things cleaner in the debugger-walkback eventually)"
- |ex|
+ |ex block|
ex := Exception new
signal:self
@@ -201,16 +277,24 @@
ex resumeBlock:[:value | ^ value].
self evaluateHandlerWith:ex.
- "mmhh - no handler found call emergency"
- (Exception emergencyHandler) value:ex value:thisContext.
- ^ nil
+ "
+ finally,
+ take either handlerBlock or emergencyHandler ...
+ "
+ (block := handlerBlock) isNil ifTrue:[
+ block := Exception emergencyHandler
+ ].
+
+ "... and call it"
+ ^ block value:ex value:thisContext.
!
raiseRequestWith:aParameter errorString:aString
"raise a signal - create an Exception object with aParameter
- and call the handler with this as argument."
+ and call the handler with this as argument..
+ The argument, aString is used as errorString."
- |ex|
+ |ex block|
ex := Exception new
signal:self
@@ -221,9 +305,16 @@
ex resumeBlock:[:value | ^ value].
self evaluateHandlerWith:ex.
- "mmhh - no handler found call emergency"
- (Exception emergencyHandler) value:ex value:thisContext.
- ^ nil
+ "
+ finally,
+ take either handlerBlock or emergencyHandler ...
+ "
+ (block := handlerBlock) isNil ifTrue:[
+ block := Exception emergencyHandler
+ ].
+
+ "... and call it"
+ ^ block value:ex value:thisContext.
! !
!Signal methodsFor:'private'!
@@ -231,8 +322,9 @@
evaluateHandlerWith:anException
"search through the context-calling chain for a 'handle:do:'-context
to the receiver or a SignalSet which includes the receiver.
- If one is found, take its 2nd argument (the handler) and evaluate
- it with the exception as argument."
+ If found, take its 2nd argument (the handler) and evaluate
+ it with the exception as argument.
+ If none found, just return."
|con|
@@ -243,14 +335,15 @@
].
[con notNil] whileTrue:[
- (con selector == #handle:do:) ifTrue:[
+ (con selector == #'handle:do:') ifTrue:[
"
if this is the Signal>>handle:do: context
or a SignalSet>>handle:do: context with self in it,
call the handler
"
((con receiver == self)
- or:[(con receiver isMemberOf:SignalSet) and:[con receiver includes:self]]) ifTrue:[
+ or:[(con receiver isMemberOf:SignalSet)
+ and:[con receiver includes:self]]) ifTrue:[
"call the handler"
anException handlerContext:con.
@@ -261,15 +354,18 @@
].
].
con := con sender
- ]
- "we arrive here, if either no handler was found, or none of the
- handlers did a return (i.e. every handler rejected or fell through)."
+ ].
+ "
+ we arrive here, if either no handler was found, or none of the
+ handlers did a return (i.e. every handler rejected or fell through).
+ "
!
doCallHandler:aHandler with:ex
"call the handler proper - needed an extra method
- to have a separate returnContext for the rejectBlock"
+ to have a separate returnContext for the rejectBlock.
+ (which is historical, and actually no longer needed)"
ex rejectBlock:[^ self]. "this will return on reject"
aHandler value:ex.
--- a/Smalltalk.st Wed Mar 30 11:41:04 1994 +0200
+++ b/Smalltalk.st Wed Mar 30 12:00:27 1994 +0200
@@ -14,7 +14,8 @@
instanceVariableNames:''
classVariableNames:'ExitBlocks CachedClasses SystemPath
StartupClass StartupSelector StartupArguments
- CachedAbbreviations'
+ CachedAbbreviations
+ SilentLoading Initializing'
poolDictionaries:''
category:'System-Support'
!
@@ -24,25 +25,55 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-This is one of the central classes in the system;
-it provides all system-startup, shutdown and maintenance support.
-Also global variables are kept here.
-
-As you will notice, this is NOT a Dictionary
- - my implementation of globals is totally different
- (due to the need to be able to access globals from c-code as well).
-
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.14 1994-02-25 13:05:29 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.15 1994-03-30 10:00:11 claus Exp $
'!
+"
+ dont depend on these being global - they will become
+ class variables of some class ...
+ Being global is a historical leftover ...
+"
Smalltalk at:#ErrorNumber put:nil!
Smalltalk at:#ErrorString put:nil!
Smalltalk at:#Language put:#english!
Smalltalk at:#LanguageTerritory put:#usa!
-Smalltalk at:#Initializing put:false!
-Smalltalk at:#SilentLoading put:false!
-Smalltalk at:#MemoryLimit put:nil!
-Smalltalk at:#SignalCatchBlock put:nil!
+
+!Smalltalk class methodsFor:'documentation'!
+
+documentation
+"
+ This is one of the central classes in the system;
+ it provides all system-startup, shutdown and maintenance support.
+ Also global variables are kept here.
+
+ As you will notice, this is NOT a Dictionary
+ - my implementation of globals is totally different
+ (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
+
+ Class variables:
+ ExitBlocks <Collection> blocks to evaluate before system is
+ left. Not currently used.
+
+ CachedClasses <Collection> known classes (cached for faster enumeration)
+
+ 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
+
+ CachedAbbreviations
+ <Dictionary> className to filename mappings
+
+ SilentLoading <Boolean> suppresses messages during fileIn and in compiler
+ (can be set to true from a customized main)
+"
+! !
!Smalltalk class methodsFor:'time-versions'!
@@ -57,7 +88,7 @@
minorVersion
"return the minor version number"
- ^ 9
+ ^ 10
"Smalltalk minorVersion"
!
@@ -85,7 +116,7 @@
versionDate
"return the version date"
- ^ '18-feb-1994'
+ ^ '31-mar-1994'
"Smalltalk versionDate"
!
@@ -101,6 +132,8 @@
hello
"return a greeting string"
+ "stupid: this should come from a resource file ..."
+
(Language == #german) ifTrue:[
^ 'Willkommen bei SmallTalk/X version '
, self version , ' vom ' , self versionDate
@@ -132,45 +165,57 @@
self initGlobalsFromEnvironment.
- "sorry - there are some, which MUST be initialized before ..
- reason: if any error happens during init, we need Signals, Stdout etc. to be there"
-
+ "
+ sorry - there are some, which MUST be initialized before ..
+ reason: if any error happens during init, we need Signals, Stdout etc. to be there
+ "
Object initialize.
ExternalStream initialize.
self initStandardStreams.
- "sorry, path must be set before ...
- reason: some classes need it during initialize (they might need resources, bitmaps etc)"
-
+ "
+ sorry, path must be set before ...
+ reason: some classes need it during initialize (they might need resources, bitmaps etc)
+ "
self initSystemPath.
- "must init display here - some classes (Color, Form) need it during initialize"
-
+ "
+ must init display here - some classes (Color, Form) need it during initialize
+ "
Workstation notNil ifTrue:[
Workstation initialize
].
- "define low-level debugging tools - graphical classes are not prepared yet
- to handle things ... - this will bring us into the MiniDebugger when an error occurs"
-
+ "
+ define low-level debugging tools - graphical classes are not prepared yet
+ to handle things ...
+ - this will bring us into the MiniDebugger when an error occurs
+ "
Inspector := MiniInspector.
Debugger := MiniDebugger.
Compiler := ByteCodeCompiler.
Compiler isNil ifTrue:[
- "this allows at least immediate evaluations for runtime systems without compiler"
+ "
+ 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 classes
+ "
self allBehaviorsDo:[:aClass |
- "avoid never-ending story ..."
+ "
+ avoid never-ending story ...
+ "
(aClass ~~ Smalltalk) ifTrue:[
aClass initialize
]
].
self initStandardTools.
- self initInterrupts
+ self initInterrupts.
"Smalltalk initialize"
!
@@ -180,12 +225,14 @@
|envString firstChar i langString terrString|
- "extract Language and LanguageTerritory from LANG variable.
+ "
+ 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"
+ german_austria
+ "
envString := OperatingSystem getEnvironment:'LANG'.
envString notNil ifTrue:[
@@ -201,6 +248,11 @@
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.
@@ -259,28 +311,37 @@
!
initSystemPath
- "setup path to search for system files.
+ "setup path where system files are searched for.
the default path is set to:
.
..
- $HOME
- $HOME/.smalltalk
- $SMALLTALK_LIBDIR
- /usr/local/lib/smalltalk
- /usr/lib/smalltalk
+ $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'.
"
- |p|
+ |p homePath|
+
+ homePath := OperatingSystem getHomeDirectory.
- "the path is set to search files first locally
- - this allows private stuff to override global stuff"
-
+ "
+ the path is set to search files first locally
+ - this allows private stuff to override global stuff
+ "
SystemPath := OrderedCollection new.
SystemPath add:'.'.
SystemPath add:'..'.
- SystemPath add:(OperatingSystem getHomeDirectory).
- (OperatingSystem isDirectory:(OperatingSystem getHomeDirectory , '/.smalltalk')) ifTrue:[
- SystemPath add:(OperatingSystem getHomeDirectory , '/.smalltalk')
+ SystemPath add:homePath.
+ (OperatingSystem isDirectory:(p := homePath , '/.smalltalk')) ifTrue:[
+ SystemPath add:p
].
p := OperatingSystem getEnvironment:'SMALLTALK_LIBDIR'.
p notNil ifTrue:[
@@ -306,15 +367,17 @@
Initializing := true.
Processor := ProcessorScheduler new.
- "read patches- and rc-file, do not add things into change-file"
-
+ "
+ while reading patches- and rc-file, do not add things into change-file
+ "
Class updateChanges:false.
self fileIn:'patches'.
- "look for a '-e filename' argument - this will force evaluation of
- filename only, no standard startup"
-
+ "
+ 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).
@@ -328,19 +391,22 @@
Class updateChanges:true.
- SilentLoading ifFalse:[
+ (SilentLoading == true) ifFalse:[ "i.e. undefined counts as false"
Transcript showCr:(self hello).
Transcript showCr:(self copyright).
- Transcript cr
+ 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 LINCENSE ***'.
+"/ Transcript showCr:'*** for more details. ***'.
+"/ Transcript cr.
+"/ ].
].
Initializing := false.
- "do not expect to get things fixed by setting it to false ... :-)"
- DemoMode ifTrue:[
- Transcript showCr:' *** Unlicensed demo mode with restrictions ***'
- ].
-
"let display install itself into Processors dispatch"
Display notNil ifTrue:[
Display startDispatch.
@@ -419,10 +485,18 @@
Transcript := Stderr
].
- Transcript cr.
- Transcript showCr:('Smalltalk restarted from:' , ImageName).
- DemoMode ifTrue:[
- Transcript showCr:' *** Unlicensed demo mode with restrictions ***'
+ (SilentLoading == true) ifFalse:[
+ Transcript cr.
+ Transcript showCr:('Smalltalk restarted from:' , 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 LINCENSE ***'.
+"/ Transcript showCr:'*** for more details. ***'.
+"/ Transcript cr.
+"/ ].
].
"
@@ -467,8 +541,6 @@
"main dispatching loop - exits with true for a bad exit (to restart),
false for real exit."
- Smalltalk at:#SignalCatchBlock put:[^ true].
-
"if view-classes exist, start dispatching;
otherwise go into a read-eval-print loop"
@@ -496,10 +568,43 @@
'' printNewline
! !
+!Smalltalk class methodsFor:'startup'!
+
+startupClass:aClass selector:aSymbol arguments:anArrayOrNil
+ "set the class, selector and arguments to be performed when smalltalk
+ starts. Setting those before saving a snapshot, will make the saved
+ image come up executing your application (instead of the normal mainloop)"
+
+ StartupClass := aClass.
+ StartupSelector := aSymbol.
+ StartupArguments := anArrayOrNil
+!
+
+startupClass
+ "return the class, that will get the start message when smalltalk
+ starts and its non-nil. Usually this is nil, but saving an image
+ with a non-nil StartupClass allows stand-alone applications"
+
+ ^ StartupClass
+!
+
+startupSelector
+ "return the selector, that will be sent to StartupClass"
+
+ ^ StartupSelector
+!
+
+startupArguments
+ "return the arguments passed to StartupClass"
+
+ ^ StartupArguments
+! !
+
!Smalltalk class methodsFor:'accessing'!
at:aKey
- "retrieve the value stored under aKey, a symbol"
+ "retrieve the value stored under aKey, a symbol
+ - return nil if not present"
%{ /* NOCONTEXT */
extern OBJ _GETGLOBAL();
@@ -620,7 +725,7 @@
cleanup in stand alone applications."
ExitBlocks isNil ifTrue:[
- ExitBlocks := Array with:aBlock
+ ExitBlocks := OrderedCollection with:aBlock
] ifFalse:[
ExitBlocks add:aBlock
]
@@ -634,47 +739,109 @@
aBlock value
]
].
-%{
- mainExit(0);
-%}
-.
OperatingSystem exit
"Smalltalk exit"
!
sleep:aDelay
- "wait for aDelay seconds"
+ "wait for aDelay seconds.
+ WARNING: this is historical leftover and will be removed"
OperatingSystem sleep:aDelay
! !
+!Smalltalk class methodsFor:'message control'!
+
+silentLoading:aBoolean
+ "allows access to the Silentloading class variable, which controls
+ messages from all kinds of system onto the transcript.
+ You can save a snapshot with this flag set to true, which makes
+ the image come up silent. Can also be set, to read in files unlogged."
+
+ |prev|
+
+ prev := SilentLoading.
+ SilentLoading := aBoolean.
+ ^ prev
+!
+
+silentLoading
+ "returns the Silentloading class variable."
+
+ ^ SilentLoading
+! !
+
!Smalltalk class methodsFor:'debugging'!
+debugBreakPoint
+ "call the dummy debug function, on which a breakpoint
+ can be put in adb, sdb, dbx or gdb.
+ This method will not be present in the future."
+%{
+ _PATCHUPCONTEXTS(__context);
+ debugBreakPoint();
+%}
+!
+
printStackBacktrace
- "print a stack backtrace"
+ "print a stack backtrace - then continue.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
%{
printStack(__context);
%}
+ "Smalltalk printStackBacktrace"
+!
+
+fatalAbort:aMessage
+ "report a fatal-error; print a stack backtrace and exit with core dump"
+
+%{
+ char *msg;
+
+ if (__isString(aMessage))
+ msg = _stringVal(aMessage);
+ else
+ msg = "fatalAbort";
+
+ fatal0(__context, msg);
+ /* NEVER RETURNS */
+%}
!
fatalAbort
- "abort program and dump core"
+ "report a fatal-error, print a stack backtrace and exit with core dump"
%{
- fatal0(__context, "abort");
+ fatal0(__context, "fatalAbort");
+ /* NEVER RETURNS */
+%}
+!
+
+exitWithCoreDump
+ "abort program and dump core"
+
+%{ /* NOCONTEXT */
+ abort();
+ /* NEVER RETURNS */
%}
!
statistic
- "print some statistic data"
-%{
+ "print some statistic data.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
+
+%{ /* NOCONTEXT */
statistic();
%}
!
debugOn
- "temporary - turns some tracing on"
+ "turns some tracing on.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
"LookupTrace := true. "
MessageTrace := true.
@@ -683,7 +850,9 @@
!
debugOff
- "temporary - turns tracing off"
+ "turns tracing off.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
LookupTrace := nil.
MessageTrace := nil
@@ -691,18 +860,22 @@
!
executionDebugOn
- "temporary - turns tracing of interpreter on"
+ "turns tracing of interpreter on.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
ExecutionTrace := true
!
executionDebugOff
- "temporary - turns tracing of interpreter off"
+ "turns tracing of interpreter off.
+ WARNING: this method is for debugging only
+ it may be removed without notice"
ExecutionTrace := nil
! !
-!Smalltalk class methodsFor:'looping'!
+!Smalltalk class methodsFor:'enumeration'!
do:aBlock
"evaluate the argument, aBlock for all values in the Smalltalk dictionary"
@@ -718,19 +891,6 @@
%}
!
-allBehaviorsDo:aBlock
- "evaluate the argument, aBlock for all classes in the system"
-
- self allClasses do:aBlock
-!
-
-allClassesDo:aBlock
- "evaluate the argument, aBlock for all classes in the system.
- Backward compatibility - use allBehaviorsDo: for ST-80 compatibility."
-
- ^ self allBehaviorsDo:aBlock
-!
-
associationsDo:aBlock
"evaluate the argument, aBlock for all key/value pairs
in the Smalltalk dictionary"
@@ -748,6 +908,19 @@
self allKeysDo:[:aKey |
aBlock value:aKey value:(self at:aKey)
]
+!
+
+allBehaviorsDo:aBlock
+ "evaluate the argument, aBlock for all classes in the system"
+
+ self allClasses do:aBlock
+!
+
+allClassesDo:aBlock
+ "evaluate the argument, aBlock for all classes in the system.
+ Backward compatibility - use allBehaviorsDo: for ST-80 compatibility."
+
+ ^ self allBehaviorsDo:aBlock
! !
!Smalltalk class methodsFor:'queries'!
@@ -755,7 +928,7 @@
numberOfGlobals
"return the number of global variables in the system"
- |tally|
+ |tally "{ Class: SmallInteger }" |
tally := 0.
self do:[:obj | tally := tally + 1].
@@ -777,7 +950,7 @@
references:anObject
"return true, if I refer to the argument, anObject
- must be reimplemented since Smalltalk is no real collection"
+ must be reimplemented since Smalltalk is no real collection."
self do:[:o |
(o == anObject) ifTrue:[^ true]
@@ -789,10 +962,10 @@
"return a collection of all classes in the system"
CachedClasses isNil ifTrue:[
- CachedClasses := IdentitySet new:400.
+ CachedClasses := IdentitySet new:500.
self do:[:anObject |
anObject notNil ifTrue:[
- (anObject isBehavior) ifTrue:[
+ anObject isBehavior ifTrue:[
CachedClasses add:anObject
]
]
@@ -807,47 +980,11 @@
"return a collection of all classNames in the system"
^ self allClasses collect:[:aClass | aClass name]
-!
-systemPath
- "return a collection of directorynames, where smalltalk
- looks for system files (usually in subdirs such as resources,
- bitmaps, source etc.)"
-
- ^ SystemPath
-!
-
-startupClass:aClass selector:aSymbol arguments:anArrayOrNil
- "set the class, selector and arguments to be performed when smalltalk
- starts. Setting those before saving a snapshot, will make the saved
- image come up executing your application (instead of the normal mainloop)"
-
- StartupClass := aClass.
- StartupSelector := aSymbol.
- StartupArguments := anArrayOrNil
-!
-
-startupClass
- "return the class, that will get the start message when smalltalk
- starts and its non-nil. Usually this is nil, but saving an image
- with a non-nil StartupClass allows stand-alone applications"
-
- ^ StartupClass
-!
-
-startupSelector
- "return the selector, that will be sent to StartupClass"
-
- ^ StartupSelector
-!
-
-startupArguments
- "return the arguments passed to StartupClass"
-
- ^ StartupArguments
+ "Smalltalk classNames"
! !
-!Smalltalk class methodsFor:'system management'!
+!Smalltalk class methodsFor:'class management'!
renameClass:aClass to:newName
"rename aClass to newName"
@@ -926,15 +1063,17 @@
ObjectMemory flushMethodCache.
aClass addChangeRecordForClassRemove:oldName
-!
+! !
+
+!Smalltalk class methodsFor:'browsing'!
browseChanges
"startup a changes browser"
- (self at:#ChangesBrowser) notNil ifTrue:[
+ ChangesBrowser notNil ifTrue:[
ChangesBrowser start
] ifFalse:[
- self error:'no ChangesBrowser'
+ self warn:'no ChangesBrowser built in'
]
"Smalltalk browseChanges "
@@ -962,6 +1101,53 @@
SystemBrowser browseAllCallsOn:aSelectorSymbol
" Smalltalk browseAllCallsOn:#at:put: "
+! !
+
+!Smalltalk class methodsFor:'system management'!
+
+systemPath
+ "return a collection of directorynames, where smalltalk
+ looks for system files
+ (usually in subdirs such as resources, bitmaps, source etc.)
+ see comment in Smalltalk>>initSystemPath."
+
+ ^ SystemPath
+!
+
+getSystemFileName:aFileName
+ "search aFileName in some standard places;
+ return the absolute filename or nil if none is found.
+ see comment in Smalltalk>>initSystemPath."
+
+ "credits for this method go to Markus ...."
+
+ |realName|
+
+ (aFileName startsWith:'/') ifTrue:[
+ "dont use path for absolute file names"
+
+ ^ aFileName
+ ].
+
+ SystemPath do:[:dirName |
+ (OperatingSystem isReadable:
+ (realName := dirName , '/' , aFileName))
+ ifTrue: [^ realName]].
+ ^ nil
+!
+
+systemFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ see comment in Smalltalk>>initSystemPath"
+
+ |aString|
+
+ aString := self getSystemFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ FileStream readonlyFileNamed:aString
+ ].
+ ^ nil
!
readAbbreviations
@@ -990,23 +1176,15 @@
]
!
-systemFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a fileStream or nil if not found"
-
- |aStream|
-
- (aFileName startsWith:'/') ifTrue:[
- "dont use path for absolute file names"
+abbreviations
+ "return a dictionary containing the classname-to-filename
+ mappings. (needed for sys5.3 users, where filenames are limited
+ to 14 chars)"
- ^ FileStream readonlyFileNamed:aFileName
+ CachedAbbreviations isNil ifTrue:[
+ self readAbbreviations
].
-
- SystemPath do:[:dirName |
- aStream := FileStream readonlyFileNamed:(dirName , '/' , aFileName).
- aStream notNil ifTrue:[^ aStream]
- ].
- ^ nil
+ ^ CachedAbbreviations
!
fileNameForClass:aClassName
@@ -1034,11 +1212,7 @@
"look for abbreviation"
- CachedAbbreviations isNil ifTrue:[
- self readAbbreviations
- ].
-
- abbrev := CachedAbbreviations at:fileName ifAbsent:[nil].
+ abbrev := self abbreviations at:fileName ifAbsent:[nil].
abbrev notNil ifTrue:[^ abbrev].
"no abbreviation found - if its a short name, take it"
@@ -1055,29 +1229,27 @@
or nil if no special translation applies. The given filename arg should
NOT include any suffix such as '.st'."
- CachedAbbreviations isNil ifTrue:[
- self readAbbreviations
- ].
-
- ^ CachedAbbreviations keyAtValue:aFileName ifAbsent:[aFileName].
+ ^ self abbreviations keyAtValue:aFileName ifAbsent:[aFileName].
"Smalltalk classNameForFile:'DrawObj'"
!
fileInClassObject:aClassName from:aFileName
- "read in the named object file - look for it in some standard places;
- return true if ok, false if failed"
-
- |aStream|
+ "read in the named object file and dynamic-link it into the system
+ - look for it in some standard places;
+ return true if ok, false if failed."
+ "
+ check if the dynamic loader class is in
+ "
ObjectFileLoader isNil ifTrue:[^ false].
- aStream := self systemFileStreamFor:aFileName.
- aStream isNil ifTrue:[^ false].
- aStream close.
+ (self getSystemFileName:aFileName) isNil ifTrue:[^ false].
^ (ObjectFileLoader loadClass:aClassName fromObjectFile:aFileName) notNil
- " Smalltalk fileInClassObject:'AbstractPath' from:'../goodies/Paths/AbstrPath.o' "
+ "
+ Smalltalk fileInClassObject:'AbstractPath' from:'../goodies/Paths/AbstrPath.o'
+ "
!
fileIn:aFileName
@@ -1097,11 +1269,15 @@
fileInChanges
"read in the last changes file - bringing the system to the state it
- had when left the last time"
+ had when left the last time.
+ WARNING: this method is rubbish: it should only read things after the
+ last '**snapshot**' - entry."
|upd|
- "tell Class to NOT update the changes file now ..."
+ "
+ tell Class to NOT update the changes file now ...
+ "
upd := Class updateChanges:false.
[self fileIn:'changes'] valueNowOrOnUnwindDo:[Class updateChanges:upd]
@@ -1110,13 +1286,21 @@
fileInClass:aClassName
"find a source/object file for aClassName and -if found - load it.
- search is in some standard places"
+ search is in some standard places trying driver, object and finally source.
+ The file is first searched for using the class name, then the abbreviated name."
|fName newClass upd ok|
upd := Class updateChanges:false.
[
+ "
+ first, look for a loader-driver file (in fileIn/...)
+ "
ok := self fileIn:('fileIn/' , aClassName , '.ld').
+
+ "
+ then, if dynamic linking is available, look for a shared binary/binary
+ "
ObjectFileLoader notNil ifTrue:[
ok ifFalse:[
ok := self fileInClassObject:aClassName from:('binary/' , aClassName, '.so').
@@ -1125,12 +1309,24 @@
ok := self fileInClassObject:aClassName from:('binary/' , aClassName, '.o').
].
].
+
+ "
+ if that did not work, look for an st-source file ...
+ "
ok ifFalse:[
ok := self fileIn:(aClassName , '.st')
].
+
+ "
+ ... and in the standard source-directory
+ "
ok ifFalse:[
ok := self fileIn:('source/' , aClassName , '.st')
].
+
+ "
+ nope - repeat with an abbreviated name
+ "
ok ifFalse:[
fName := self fileNameForClass:aClassName.
fName notNil ifTrue:[
@@ -1153,41 +1349,42 @@
]
] valueNowOrOnUnwindDo:[Class updateChanges:upd].
newClass := self at:(aClassName asSymbol).
- (newClass notNil and:[newClass implements:#initialize]) ifTrue:[newClass initialize]
+ newClass notNil ifTrue:[newClass initialize]
! !
!Smalltalk class methodsFor: 'binary storage'!
addGlobalsTo: globalDictionary manager: manager
- | pools |
- pools _ Set new.
- self associationsDo: [:assoc|
+ |pools|
+
+ 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 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
+ globalDictionary at:assoc value put:self
]
]
].
- pools do: [:poolDictionary|
- poolDictionary addGlobalsTo: globalDictionary manager: manager
+ pools do:[:poolDictionary|
+ poolDictionary addGlobalsTo:globalDictionary manager:manager
]
!
storeBinaryDefinitionOf: anObject on: stream manager: manager
- | string |
+ |string|
- anObject class == Association ifTrue: [
+ anObject class == Association ifTrue:[
string := 'Smalltalk associationAt: ', anObject key storeString
] ifFalse: [
string := 'Smalltalk at: ', (self keyAtValue: anObject) storeString
].
- stream nextNumber: 2 put: string size.
- string do: [:char| stream nextPut: char asciiValue]
+ stream nextNumber:2 put:string size.
+ string do:[:char | stream nextPut:char asciiValue]
! !