"
COPYRIGHT (c) 1988 by Claus Gittinger
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
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#Object
instanceVariableNames:''
classVariableNames:'ErrorSignal HaltSignal
MessageNotUnderstoodSignal UserInterruptSignal
RecursionInterruptSignal ExceptionInterruptSignal
SubscriptOutOfBoundsSignal NonIntegerIndexSignal
NotFoundSignal KeyNotFoundSignal ElementOutOfBoundsSignal
InformationSignal PrimitiveFailureSignal
DeepCopyErrorSignal
AbortSignal
ErrorRecursion Dependencies'
poolDictionaries:''
category:'Kernel-Objects'
!
Object comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Object.st,v 1.23 1994-10-10 00:27:00 claus Exp $
'!
!Object class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1988 by Claus Gittinger
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
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libbasic/Object.st,v 1.23 1994-10-10 00:27:00 claus Exp $
"
!
documentation
"
Object is the superclass of all other classes. Protocol common to
every object is defined here.
Also some utility stuff (like notify) and error handling is implemented here.
Object has no instance variables (and may not get any added). One reason is, that
UndefinedObject and SmallInteger are also inheriting from Object - these two cannot have instance
variables (due to their implementation). The other reason is that the runtime system
(VM) knows about the layout of some built-in classes (think of Class, Method, Block
and also Integer or Float). If you where allowed to add instance variables to Object,
the VM had to be recompiled (and also rewritten in some places).
Class variables:
ErrorSignal <Signal> Signal raised for error/error: messages
also, parent of all other signals.
HaltSignal <Signal> Signal raised for halt/halt: messages
MessageNotUnderstoodSignal Signals raised for various error conditions
UserInterruptSignal
RecursionInterruptSignal
ExceptionInterruptSignal
SubscriptOutOfBoundsSignal
NonIntegerIndexSignal
NotFoundSignal
KeyNotFoundSignal
ElementOutOfBoundsSignal
InformationSignal
DeepCopyErrorSignal
AbortSignal <Signal> Signal raised by debugger, to abort a computation
BUT, the debugger will only raise it if it is handled.
By handling the abortSignal, you can control where the
debuggers abort-function resumes execution in case of
an error.
ErrorRecursion <Boolean> controls behavior when recursive errors occur (i.e.
an error while handling an error).
Dependencies <Dictionary> keeps track of object dependencies
"
! !
!Object class methodsFor:'initialization'!
initialize
"called only once - initialize signals"
ErrorSignal isNil ifTrue:[
ErrorSignal := (Signal new) mayProceed:true.
ErrorSignal nameClass:self message:#errorSignal.
ErrorSignal notifierString:'error encountered'.
HaltSignal := ErrorSignal newSignalMayProceed:true.
HaltSignal nameClass:self message:#haltSignal.
HaltSignal notifierString:'halt encountered'.
MessageNotUnderstoodSignal := ErrorSignal newSignalMayProceed:true.
MessageNotUnderstoodSignal nameClass:self message:#messageNotUnderstoodSignal.
MessageNotUnderstoodSignal notifierString:'message not understood'.
PrimitiveFailureSignal := ErrorSignal newSignalMayProceed:true.
PrimitiveFailureSignal nameClass:self message:#primitiveFailureSignal.
PrimitiveFailureSignal notifierString:'primitive failed'.
UserInterruptSignal := ErrorSignal newSignalMayProceed:true.
UserInterruptSignal nameClass:self message:#userInterruptSignal.
UserInterruptSignal notifierString:'user Interrupt'.
RecursionInterruptSignal := ErrorSignal newSignalMayProceed:false.
RecursionInterruptSignal nameClass:self message:#recursionInterruptSignal.
RecursionInterruptSignal notifierString:'recursion limit reached'.
ExceptionInterruptSignal := ErrorSignal newSignalMayProceed:true.
ExceptionInterruptSignal nameClass:self message:#exceptionInterruptSignal.
ExceptionInterruptSignal notifierString:'exception Interrupt'.
SubscriptOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
SubscriptOutOfBoundsSignal nameClass:self message:#subscriptOutOfBoundsSignal.
SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds'.
ElementOutOfBoundsSignal := ErrorSignal newSignalMayProceed:false.
ElementOutOfBoundsSignal nameClass:self message:#elementOutOfBoundsSignal.
ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.
NotFoundSignal := ErrorSignal newSignalMayProceed:true.
NotFoundSignal nameClass:self message:#notFoundSignal.
NotFoundSignal notifierString:'no such element'.
KeyNotFoundSignal := ErrorSignal newSignalMayProceed:true.
KeyNotFoundSignal nameClass:self message:#keyNotFoundSignal.
KeyNotFoundSignal notifierString:'no such key'.
NonIntegerIndexSignal := ErrorSignal newSignalMayProceed:false.
NonIntegerIndexSignal nameClass:self message:#nonIntegerIndexSignal.
NonIntegerIndexSignal notifierString:'index must be integer'.
InformationSignal := ErrorSignal newSignalMayProceed:true.
InformationSignal nameClass:self message:#informationSignal.
InformationSignal notifierString:'information'.
DeepCopyErrorSignal := ErrorSignal newSignalMayProceed:true.
DeepCopyErrorSignal nameClass:self message:#deepCopyErrorSignal.
DeepCopyErrorSignal notifierString:'object cannot be deepCopy-ed'.
"
AbortSignal is not a child of ErrorSignal -
this would complicate abort from within a signal handler
"
AbortSignal := Signal new mayProceed:true.
AbortSignal nameClass:self message:#abortSignal.
AbortSignal notifierString:'unhandled abort signal'.
Dependencies isNil ifTrue:[
Dependencies := WeakIdentityDictionary new.
]
]
"Object initialize"
! !
!Object class methodsFor:'signal access'!
errorSignal
"return the signal used for error/error: - handling"
^ ErrorSignal
!
haltSignal
"return the signal used for halt/halt: - handling"
^ HaltSignal
!
messageNotUnderstoodSignal
"return the signal used for doesNotUnderstand: - error handling"
^ MessageNotUnderstoodSignal
!
privateMethodSignal
"return the signal used for privateMethod - error handling"
^ MessageNotUnderstoodSignal
!
primitiveFailureSignal
"return the signal used for primitiveFailed - error handling"
^ PrimitiveFailureSignal
!
userInterruptSignal
"return the signal used for ^C interrupts handling"
^ UserInterruptSignal
!
recursionInterruptSignal
"return the signal used for recursion overflow error handling"
^ RecursionInterruptSignal
!
exceptionInterruptSignal
"return the signal used for exception (display errors) error handling"
^ ExceptionInterruptSignal
!
subscriptOutOfBoundsSignal
"return the signal used for subscript error reporting.
(this signal is used for example when an array is accessed with an
index less than 1 or greater than the array size)"
^ SubscriptOutOfBoundsSignal
!
elementOutOfBoundsSignal
"return the signal used for element error reporting
(this signal is used for example when a value not in 0..255 is to
be put into a bytearray)"
^ ElementOutOfBoundsSignal
!
nonIntegerIndexSignal
"return the signal used for bad subscript error reporting"
^ NonIntegerIndexSignal
!
notFoundSignal
"return the signal used for element not found error reporting"
^ NotFoundSignal
!
keyNotFoundSignal
"return the signal used for no such key error reporting"
^ KeyNotFoundSignal
!
informationSignal
"return the signal used for informations"
^ InformationSignal
!
deepCopyErrorSignal
"return the signal raised when a deepcopy is asked for
an object which cannot do this (for example, BlockClosures
or Contexts)."
^ DeepCopyErrorSignal
!
abortSignal
"return the signal used to abort user actions. This signal is only
raised if cought (by the debugger), and will lead way out of the
currently active doIt/printIt or inspectIt. (also some others use
this for a save abort)"
^ AbortSignal
! !
!Object class methodsFor:'queries'!
isBuiltInClass
"return true, if this class is known by the run-time-system,
i.e. you cannot add/remove instance variables without recompiling
the VM."
^ self == Object
! !
!Object methodsFor:'initialization'!
initialize
"just to ignore initialize to objects which do not need it"
^ self
! !
!Object methodsFor:'cleanup'!
lowSpaceCleanup
"ignored here - redefined in some classes to
cleanup in low-memory situations"
^ self
! !
!Object methodsFor:'system primitives'!
become:anotherObject
"make all references to the receiver become references to anotherObject
and vice-versa. This may be an expensive (i.e. slow) operation,
since in the worst case, the whole memory has to be searched for
references to the two objects (although the primitive tries hard to
limit the search, for acceptable performance in most cases).
In general, using become: should be avoided if possible, since it may
produce many strange effects (think of hashing in Sets).
This method fails, if the receiver or the argument is a SmallInteger
or nil, or is a context of a living method (i.e. one that has not already
returned).
(notice that become: is not used heavily by the system
- the Collection-classes have been rewritten to not use it.)"
%{
if (__primBecome(self, anotherObject COMMA_CON))
RETURN ( self );
%}
.
self primitiveFailed
!
becomeNil
"make all references to the receiver become nil - effectively getting
rid of the receiver. This can be a very dangerous operation - be warned.
The receiver may not be a SmallInteger or a context of a living method."
%{
if (__primBecomeNil(self COMMA_CON ))
RETURN ( nil );
%}
.
self primitiveFailed
!
changeClassTo:otherClass
"changes the class of the receiver to the argument, otherClass.
This is only allowed (possible), if the receivers class and the argument
have the same structure (i.e. number of named instance variables and
type of indexed instance variables).
If the structures do not match, or any of the original class or new class
is UndefinedObject or a Smallinteger, a primitive error is triggered."
|myClass ok|
"check for UndefinedObject/SmallInteger receiver or newClass"
%{
if (_isNonNilObject(self)
&& _isNonNilObject(otherClass)
&& (otherClass != UndefinedObject)
&& (otherClass != SmallInteger)) {
ok = true;
} else {
ok = false;
}
%}.
ok ifTrue:[
ok := false.
myClass := self class.
myClass flags == otherClass flags ifTrue:[
myClass instSize == otherClass instSize ifTrue:[
"same instance layout and types: its ok to do it"
ok := true.
] ifFalse:[
myClass isPointers ifTrue:[
myClass isVariable ifTrue:[
ok := true
]
]
]
] ifFalse:[
myClass isPointers ifTrue:[
"if newClass is a variable class, with instSize <= my instsize,
we can do it (effectively mapping additional instvars into the
variable part) - usefulness is questionable, though"
otherClass isPointers ifTrue:[
otherClass isVariable ifTrue:[
otherClass instSize <= (myClass instSize + self basicSize)
ifTrue:[
ok := true
]
] ifFalse:[
otherClass instSize == (myClass instSize + self basicSize)
ifTrue:[
ok := true
]
]
] ifFalse:[
"it does not make sense to convert pointers to bytes ..."
]
] ifFalse:[
"does it make sense, to convert bits ?"
"could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
]
]
].
ok ifTrue:[
"now, change the receivers class ..."
%{
_qClass(self) = otherClass;
__STORE(self, otherClass);
RETURN ( self );
%}.
].
self primitiveFailed
!
changeClassToThatOf:anObject
"changes the class of the receiver to that of the argument, anObject.
This is only allowed (possible), if the receivers class and the arguments
class have the same structure (i.e. number of named instance variables and
type of indexed instance variables). If the structures do not match, or any
of the objects is nil or a Smallinteger, a primitive error is triggered."
self changeClassTo:(anObject class)
! !
!Object methodsFor:'queries'!
size
"return the number of the receivers indexed instance variables;
this method may be redefined in subclasses"
^ self basicSize
!
basicSize
"return the number of the receivers indexed instance variables,
0 if it has none.
This method should NOT be redefined in any subclass"
%{ /* NOCONTEXT */
register int nbytes;
register OBJ myClass;
/*
* notice the missing test for self being a nonNilObject -
* this can be done since basicSize is defined both in UndefinedObject
* and SmallInteger
*/
myClass = _qClass(self);
nbytes = _qSize(self)
- OHDR_SIZE
- __OBJS2BYTES__(_intVal(_ClassInstPtr(myClass)->c_ninstvars));
switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
case BYTEARRAY:
RETURN ( _MKSMALLINT(nbytes / sizeof(char)) );
case WORDARRAY:
RETURN ( _MKSMALLINT(nbytes / sizeof(short)) );
case LONGARRAY:
RETURN ( _MKSMALLINT(nbytes / sizeof(long)) );
case FLOATARRAY:
RETURN ( _MKSMALLINT(nbytes / sizeof(float)) );
case DOUBLEARRAY:
#ifdef NEED_DOUBLE_ALIGN
/*
* care for filler
*/
nbytes -= sizeof(FILLTYPE);
#endif
RETURN ( _MKSMALLINT(nbytes / sizeof(double)) );
case WKPOINTERARRAY:
case POINTERARRAY:
RETURN ( _MKSMALLINT(__BYTES2OBJS__(nbytes)) );
}
%}
.
^ 0
!
isVariable
"return true if the receiver has indexed instance variables,
false otherwise."
^ self class isVariable
!
isFixedSize
"return true if the receiver cannot grow - this will vanish once things
like Array and String learn how to grow ..."
^ true
!
class
"return the receivers class"
%{ /* NOCONTEXT */
RETURN ( _Class(self) );
%}
!
species
"return a class which is similar to (or the same as) the receivers class.
This is used to create an appropriate object when creating derived
copies in the collection classes (sometimes redefined)."
^ self class
!
yourself
"return the receiver - used for cascades to return self at the end"
^ self
!
isBehavior
"return true, if the receiver is some kind of class (i.e. behavior);
false is returned here - the method is redefined in Behavior."
^ false
!
isClass
"return true, if the receiver is some kind of class (real class,
not just behavior);
false is returned here - the method is redefined in Class."
^ false
!
isMeta
"return true, if the receiver is some kind of metaclass;
false is returned here - the method is redefined in Metaclass."
^ false
!
isBlock
"return true, if the receiver is some kind of block;
false returned here - the method is redefined in Block."
^ false
!
isContext
"return true, if the receiver is some kind of context;
false returned here - the method is redefined in Context."
^ false
!
isStream
"return true, if the receiver is some kind of stream;
false is returned here - the method is redefined in Stream."
^ false
!
isFileStream
"return true, if the receiver is some kind of fileStream;
false is returned here - the method is redefined in FileStream."
^false
!
isSequenceableCollection
"return true, if the receiver is some kind of sequenceable collection;
false is returned here - the method is redefined in SequenceableCollection."
^ false
!
isColor
"return true, if the receiver is some kind of color;
false is returned here - the method is redefined in Color."
^ false
!
isString
"return true, if the receiver is some kind of string;
false is returned here - the method is redefined in String."
^ false
!
isCharacter
"return true, if the receiver is some kind of character;
false is returned here - the method is redefined in Character."
^ false
!
isNumber
"return true, if the receiver is some kind of number;
false is returned here - the method is redefined in Number."
^ false
!
isInteger
"return true, if the receiver is some kind of integer number;
false is returned here - the method is redefined in Integer."
^ false
!
isPoint
"return true, if the receiver is some kind of point;
false is returned here - the method is redefined in Point."
^ false
!
isRectangle
"return true, if the receiver is some kind of rectangle;
false is returned here - the method is redefined in Rectangle."
^ false
!
isLiteral
"return true, if the receiver can be represented as a constant in ST syntax;
false is returned here - the method is redefined in some classes."
^ false
!
isMemberOf:aClass
"return true, if the receiver is an instance of aClass, false otherwise.
Advice: use of this to check objects for certain attributes/protocoll should
be avoided; it limits the reusability of your classes by limiting use
to instances of a certain class.
Use check-methods to check an object for a certain attributes/protocol
(such as respondsTo: or isNumber);
or check via #respondsTo: if a it understands your message."
^ (self class) == aClass
!
isKindOf:aClass
"return true, if the receiver is an instance of aClass or one of its
subclasses, false otherwise.
Advice: use of this to check objects for certain attributes/protocoll should
be avoided; it limits the reusability of your classes by limiting use
to instances of certain classes and fences you into a specific inheritance
hierarchy.
Use check-methods to check an object for a certain attributes/protocol
(such as isXXXX, respondsTo: or isNumber)"
%{ /* NOCONTEXT */
register OBJ thisClass;
thisClass = _Class(self);
while (thisClass != nil) {
if (thisClass == aClass) {
RETURN ( true );
}
thisClass = _ClassInstPtr(thisClass)->c_superclass;
}
%}
.
"/
"/ the above code is equivalent to:
"/
"/ thisClass := self class.
"/ [thisClass notNil] whileTrue:[
"/ thisClass == aClass ifTrue:[^ true].
"/ thisClass := thisClass superclass
"/ ]
"/
^ false
!
respondsTo:aSelector
"return true, if the receiver implements a method with selector equal
to aSelector; i.e. if there is a method for aSelector in either the
receivers class or one of its superclasses.
Notice, that this does not imply, that such a message can be sent without
an error being raised. For example, an implementation could send
#shouldNotImplement or #subclassResponsibility."
"
should we go via the cache, or search (by class) ?
The first is faster, most of the time; while the latter fills
the cache with useless data if this is sent in a loop over all objects.
For now, use the cache ...
"
%{ /* NOCONTEXT */
extern OBJ lookup();
if (lookup(_Class(self), aSelector) == nil) {
RETURN ( false );
}
RETURN ( true );
%}
.
"
^ self class canUnderstand:aSelector
"
"'aString' respondsTo:#+"
"'aString' respondsTo:#,"
"'aString' respondsTo:#collect:"
!
respondsToArithmetic
"return true, if the receiver responds to arithmetic messages.
false is returned here - the method is redefined in ArithmeticValue."
^ false
!
references:anObject
"return true, if the receiver refers to the argument, anObject.
- for debugging only"
|myClass
numInst "{ Class: SmallInteger }" |
myClass := self class.
"check the class"
(myClass == anObject) ifTrue:[^ true].
"check the instance variables"
numInst := myClass instSize.
1 to:numInst do:[:i |
((self instVarAt:i) == anObject) ifTrue:[^ true]
].
"check the indexed variables"
myClass isVariable ifTrue:[
numInst := myClass basicSize.
1 to:numInst do:[:i |
((self basicAt:i) == anObject) ifTrue:[^ true]
]
].
^ false
!
allOwners
"return a collection of all objects referencing the receiver"
^ ObjectMemory whoReferences:self
! !
!Object methodsFor:'misc'!
-> anObject
"return an association with the receiver as key and
the argument as value"
^ Association key:self value:anObject
! !
!Object methodsFor:'evaluation'!
value
"this allows every object to be used where blocks are typically used.
Time will show, if this is a good idea or leads to sloppy programming
style ... (idea borrowed from the Self language).
WARNING: dont 'optimize' away ifXXX: blocks - the compilers will
only generate inline code for the if, if the argument(s) are blocks.
It will work, but run slower instead."
^ self
"
#(1 2 3 4) indexOf:5 ifAbsent:0
"
! !
!Object methodsFor:'copying'!
copy
"return a copy of the receiver - defaults to shallowcopy here.
Notice, that copy does not copy dependents."
^ self shallowCopy postCopyFrom:self
!
shallowCopyForFinalization
"this is used to aquire a copy to be used for finalization -
(the copy will get a dispose-notification; see the documentation in the Registry class)
This method can be redefined for more efficient copying - especially for large objects."
^ self shallowCopy
!
shallowCopy
"return a copy of the object with shared subobjects (a shallow copy)
i.e. the copy shares referenced instvars with its original."
|myClass aCopy
sz "{ Class: SmallInteger }" |
myClass := self class.
myClass isVariable ifTrue:[
sz := self basicSize.
aCopy := myClass basicNew:sz.
"copy the indexed variables"
1 to:sz do:[:i |
aCopy basicAt:i put:(self basicAt:i)
]
] ifFalse:[
aCopy := myClass basicNew
].
"copy the instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
aCopy instVarAt:i put:(self instVarAt:i)
].
^ aCopy
!
postCopy
"this is for compatibility with ST-80 code, which uses postCopy for
cleanup after copying, while ST/X passes the original in postCopyFrom:
(see there)"
^ self
!
postCopyFrom:original
"sent to a freshly deep-copied object to give it a chance to adjust things.
(a font could flush its device-handle for example).
Notice, that for Sets/Dicts etc. a rehash is not needed, since the deepCopy
will have the same hash key as the receiver (as long as ST/X provides the
setHash: functionality)."
"for ST-80 compatibility, we try postCopy here ..."
^ self postCopy
!
deepCopy
"return a copy of the object with all subobjects also copied.
This method DOES handle cycles/self-refs; however the receivers
class is not copied (to avoid the 'total' copy).
Notice, that copy does not copy dependents."
^ self deepCopyUsing:(IdentityDictionary new)
!
deepCopyError
"raise a signal, that deepCopy is not allowed for this object"
^ DeepCopyErrorSignal raise
!
deepCopyUsing:aDictionary
"a helper for deepCopy; return a copy of the object with
all subobjects also copied. If the to-be-copied object is in the dictionary,
use the value found there. The class of the receiver is not copied.
This method DOES handle cycles/self references."
|myClass aCopy
sz "{ Class: SmallInteger }"
iOrig iCopy|
myClass := self class.
myClass isVariable ifTrue:[
sz := self basicSize.
aCopy := myClass basicNew:sz.
] ifFalse:[
sz := 0.
aCopy := myClass basicNew
].
aCopy setHashFrom:self.
aDictionary at:self put:aCopy.
sz ~~ 0 ifTrue:[
self class isBits ifTrue:[
"block-copy indexed instvars"
aCopy replaceFrom:1 to:sz with:self startingAt:1
] ifFalse:[
"individual deep copy the indexed variables"
1 to:sz do:[:i |
iOrig := self basicAt:i.
iOrig notNil ifTrue:[
(aDictionary includesKey:iOrig) ifTrue:[
iCopy := aDictionary at:iOrig
] ifFalse:[
iCopy := iOrig deepCopyUsing:aDictionary.
].
aCopy basicAt:i put:iCopy
]
]
]
].
"copy the instance variables"
sz := myClass instSize.
sz ~~ 0 ifTrue:[
1 to:sz do:[:i |
iOrig := self instVarAt:i.
iOrig notNil ifTrue:[
(aDictionary includesKey:iOrig) ifTrue:[
iCopy := aDictionary at:iOrig
] ifFalse:[
iCopy := iOrig deepCopyUsing:aDictionary.
].
aCopy instVarAt:i put:iCopy
]
].
].
^ aCopy
!
simpleDeepCopy
"return a copy of the object with all subobjects also copied.
This method does NOT handle cycles - but is included to allow this
slightly faster copy in situations where it is known that
no recursive references occur (LargeIntegers for example).
NOTICE: you will run into trouble, when trying this with recursive
objects (usually recursionInterrupt or memory-alert).
This method corresponds to the 'traditional' deepCopy found in
the Blue book."
|myClass aCopy
sz "{ Class: SmallInteger }" |
myClass := self class.
myClass isVariable ifTrue:[
sz := self basicSize.
aCopy := myClass basicNew:sz.
"copy the indexed variables"
1 to:sz do:[:i |
aCopy basicAt:i put:((self basicAt:i) simpleDeepCopy)
]
] ifFalse:[
aCopy := myClass basicNew
].
"copy the instance variables"
sz := myClass instSize.
1 to:sz do:[:i |
aCopy instVarAt:i put:((self instVarAt:i) simpleDeepCopy)
].
^ aCopy
"a bad example (but ST/X should survive ...)"
"
|a|
a := Array new:3.
a at:3 put:a.
a simpleDeepCopy
"
!
setHashFrom:anObject
"set my identity-hash key to be the same as anObjects hash key.
This is an ST/X speciality, which is NOT available in other (especially OT based)
Smalltalks, and may not be available in future ST/X versions.
DO NEVER use this for normal application code."
%{ /* NOCONTEXT */
REGISTER unsigned h;
if (_isNonNilObject(self) && _isNonNilObject(anObject)) {
h = _GET_HASH(anObject);
_SET_HASH(self, h);
RETURN (self);
}
%}
.
self primitiveFailed "neither receiver not arg may be nil or SmallInteger"
! !
!Object methodsFor:'comparing'!
== anObject
"return true, if the receiver and the arg are the same object"
%{ /* NOCONTEXT */
RETURN ( (self == anObject) ? true : false );
%}
!
~~ anObject
"return true, if the receiver and the arg are not the same object"
%{ /* NOCONTEXT */
RETURN ( (self == anObject) ? false : true );
%}
!
= anObject
"return true, if the receiver and the arg have the same structure"
^ self == anObject
!
~= anObject
"return true, if the receiver and the arg do not have the same structure"
^ (self = anObject) not
!
isNil
"return true, if the receiver is nil"
^ false
!
notNil
"return true, if the receiver is not nil"
^ true
!
hash
"return an Integer useful as a hash key for the receiver.
This hash should return same values for objects with same
contents (i.e. use this to hash on structure)"
^ self identityHash
!
identityHash
"return an Integer useful as a hash key for the receiver.
This hash should return same values for the same object (i.e. use
this to hash on identity of objects).
We cannot use the Objects address (as other smalltalks do) since
no object-table exists and the hashval must not change when objects
are moved by the collector. Therefore we assign each object a unique
Id in the object header itself as its hashed upon.
(luckily we have 12 bits spare to do this - unluckily its only 12 bits).
Time will show, if 12 bits are enough; if not, another entry in the
object header will be needed, adding 4 bytes to every object. Alternatively,
hashed-upon objects could add an instvar containing the hash value."
%{ /* NOCONTEXT */
REGISTER unsigned v1, v2;
static unsigned nextHash = 0;
OBJ cls;
if (_isNonNilObject(self)) {
v1 = _GET_HASH(self);
if (v1 == 0) {
v1 = nextHash++;
if (v1 == 0)
v1 = nextHash++;
_SET_HASH(self, v1);
}
#ifdef NOTDEF
/*
* this is no good - a class becoming another one or
* if an object changes its class, hashkey would change.
* changing hashkeys has bad effects on IdentityDictionary and
* IdentitySet (and others as well).
*/
cls = _qClass(self);
v2 = _GET_HASH(cls);
if (v2 == 0) {
v2 = nextHash++;
if (v2 == 0)
v2 = nextHash++;
_SET_HASH(cls, v2);
}
RETURN ( _MKSMALLINT((v2<<12) | v1) );
#endif
RETURN ( _MKSMALLINT(v1 << 8) );
}
%}
.
self subclassResponsibility "must be defined in UndefinedObject and SmallInteger"
! !
!Object methodsFor:'interrupt handling'!
internalError:msg
"this is triggered, when system hits some bad error,
such as corrupted class, corrupted method/selector array
etc. (for example, if you set an objects class to a small-
integer, nil etc).
Its not guaranteed, that the system is in a working condition once
this error occurred ...."
^ self error:msg
!
userInterrupt
"user (^c) interrupt - enter debugger"
UserInterruptSignal raise
!
ioInterrupt
"I/O (SIGIO/SIGPOLL) interrupt and no handler - enter debugger"
self error:'I/O Interrupt - but no handler'
!
childSignalInterrupt
"death of a child process (unix process) - do nothing"
^ self
!
spyInterrupt
"spy interrupt and no handler - enter debugger"
self error:'spy Interrupt - but no handler'
!
timerInterrupt
"timer interrupt and no handler - enter debugger"
self error:'timer Interrupt - but no handler'
!
errorInterrupt
"x-error interrupt"
self error:('Display error: ' , Display lastError)
!
memoryInterrupt
"out-of-memory interrupt and no handler - enter debugger"
self error:'almost out of memory'
!
fpExceptionInterrupt
"a floating point exception occured - this one
has to be handled differently since it comes asynchronous
on some machines. Also, errors from within primitive code
(or library functions such as GL) are sent via the Unix-signal
mechanism this way."
^ Float domainErrorSignal raise
!
signalInterrupt:signalNumber
"unix signal occured - some signals are handled as Smalltalk Exceptions (SIGPIPE),
others (SIGBUS) are rather fatal ..."
|box name here sig ignorable titles actions badContext|
"
special case - since SIGPIPE has an ST-signal associated
"
(signalNumber == 13) ifTrue:[
"SIGPIPE - write on a pipe with no one to read"
^ PipeStream brokenPipeSignal raise.
].
"if there has been an ST-signal installed, use it ..."
sig := OperatingSystem operatingSystemSignal:signalNumber.
sig notNil ifTrue:[
^ sig raise
].
"
... otherwise , bring up a box asking for what to do ...
"
name := OperatingSystem nameForSignal:signalNumber.
here := thisContext.
"
the context, in which the signal occurred:
"
badContext := here sender.
"
SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
since the system will retry the faulty instruction, which leads to
another signal - to avoid frustration, better not offer this option.
"
ignorable := (signalNumber ~~ OperatingSystem sigBUS)
and:[signalNumber ~~ OperatingSystem sigILL
and:[signalNumber ~~ OperatingSystem sigSEGV]].
ignorable ifFalse:[
here isRecursive ifTrue:[
'fatal: signal ' errorPrint. signalNumber errorPrintNL.
MiniDebugger enterWithMessage:'recursive signal'.
^ self
].
"
a hard signal - go into debugger immediately
"
Debugger enter:here withMessage:('Signal ', name).
badContext return.
^ nil.
].
"
ungrab - in case it happened in a box/popupview
otherwise display stays locked
"
ActiveGrab notNil ifTrue:[
Display ungrabPointer.
ActiveGrab := nil
].
OptionBox isNil ifTrue:[
"
a system without GUI ...
go into minidebugger (if there is one)
"
MiniDebugger isNil ifTrue:[
"
a system without debugging facilities
(i.e. a standalone system)
output a message and exit.
"
('exit due to Signal ' , name) errorPrintNL.
Smalltalk exit.
].
MiniDebugger enterWithMessage:'Signal cought (' , name, ')'.
^ self
].
box := OptionBox
title:'Signal cought (' , name, ')'
numberOfOptions:(ignorable ifTrue:[5] ifFalse:[4]).
titles := #('return' 'debug' 'dump' 'exit').
actions := Array
with:[badContext return]
with:[Debugger enter:here withMessage:('Signal ', name). ^nil]
with:[Smalltalk fatalAbort]
with:[Smalltalk exit].
ignorable ifTrue:[
titles := #('ignore') , titles.
actions := (Array with:[^ nil]) , actions.
].
box buttonTitles:titles.
box actions:actions.
box showAtPointer
!
recursionInterrupt
"recursion limit interrupt.
This interrupt is triggered, when a process stack grows above
its stackLimit - usually, this leads into the debugger, but
could be cought and the stackLimit increased in the handler."
thisContext isRecursive ifFalse:[
^ RecursionInterruptSignal raise
]
!
exceptionInterrupt
"exception interrupt - enter debugger"
self error:'exception Interrupt'
! !
!Object methodsFor:'error handling'!
subscriptBoundsError
"report error that some index is out of bounds.
(when accessing indexable collections)"
^ SubscriptOutOfBoundsSignal raise
!
subscriptBoundsError:anIndex
"report error that anIndex is out of bounds.
(when accessing indexable collections)"
^ SubscriptOutOfBoundsSignal raiseRequestWith:anIndex
!
indexNotInteger
"report error that index is not an Integer.
(when accessing collections indexed by an integer key)"
^ NonIntegerIndexSignal raise
!
errorNotFound
"report error that an element was not found in a collection"
^ NotFoundSignal raise
!
errorKeyNotFound
"report error that a key was not found in a collection"
^ KeyNotFoundSignal raise
!
elementBoundsError
"report error that badElement is out of bounds
(i.e. cannot be put into that collection)"
^ ElementOutOfBoundsSignal raise
!
elementNotInteger
"report error that object to be stored is not Integer.
(in collections that store integers only)"
^ ElementOutOfBoundsSignal raise
!
elementNotCharacter
"report error that object to be stored is no Character.
(usually when storing into Strings)"
^ ElementOutOfBoundsSignal raise
!
mustBeRectangle
"report an argument-not-rectangle-error"
^ self error:'argument must be a Rectangle'
!
mustBeString
"report an argument-not-string-error"
^ self error:'argument must be a String'
!
notIndexed
"report error that receiver has no indexed instance variables"
^ self error:'receiver has no indexed variables'
!
integerCheckError
"generated when a variable declared with an integer type gets a bad
value assigned"
^ self error:'bad assign of ' , self printString ,
' (' , self class name , ') to integer-typed variable'
!
typeCheckError
"generated when a variable declared with a type hint gets a bad
value assigned"
^ self error:'bad assign of ' , self printString ,
' (' , self class name , ') to typed variable'
!
primitiveFailed
"report error that primitive code failed"
^ PrimitiveFailureSignal raise
!
implementedBySubclass
"this is sent by ST/V code - its the same as #subclassResponsibility"
^ self subclassResponsibility
!
invalidMessage
"this is sent by ST/V code - its the same as #shouldNotImplement"
^ self shouldNotImplement
!
subclassResponsibility
"report error that this message should have been reimplemented in a
subclass"
^ self error:'method must be reimplemented in subclass'
!
shouldNotImplement
"report error that this message should not be implemented"
^ self error:'method not appropriate for this class'
!
halt
"enter debugger with halt-message"
^ HaltSignal raise.
!
halt:aString
"enter debugger with halt-message"
^ HaltSignal raiseRequestWith:#halt: errorString:aString
!
error
"report error that an error occured"
^ ErrorSignal raise
!
error:aString
"enter debugger with error-message aString"
^ ErrorSignal raiseRequestWith:#error: errorString: aString
!
doesNotUnderstand:aMessage
"this message is sent by the runtime system (VM) when
a message is not understood by some object (i.e. there
is no method for that selector). The original message has
been packed into aMessage (i.e. the receiver, selector and
any arguments) and the original receiver is then sent the
#doesNotUnderstand: message.
Here, we raise another signal which usually enters the debugger.
You can of course redefine #doesNotUnderstand: in your classes
to implement message delegation."
|sel errorString|
aMessage selector isNil ifTrue:[
"happens when things go mad, or a method has been
called by valueWithReceiver: with a wrong receiver"
sel := '(nil)'
] ifFalse:[
sel := aMessage selector
].
errorString := 'Message not understood: ' , sel.
"
this only happens, when YOU play around with my classvars ...
"
MessageNotUnderstoodSignal isNil ifTrue:[
^ self enterDebuggerWith:nil
message:'oops - MessageNotUnderstoodSignal is gone'.
].
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:errorString
!
appropriateDebugger:aMessage
"return an appropriate debugger to use.
If there is already a debugger active on the stack, and it is
the DebugView, return MiniDebugger (as a last chance) otherwise abort."
|context|
context := thisContext.
context := context sender.
[context notNil] whileTrue:[
((context receiver class == Debugger)
and:[context selector == aMessage]) ifTrue:[
"we are already in some Debugger"
(Debugger == MiniDebugger) ifTrue:[
"we are already in the MiniDebugger"
ErrorRecursion ifFalse:[
Smalltalk fatalAbort:'recursive error ...'
]
].
MiniDebugger isNil ifTrue:[
Smalltalk fatalAbort:'no debugger'
].
"ok, an error occured while in the graphical debugger;
lets try MiniDebugger"
^ MiniDebugger
].
context := context sender
].
"not within Debugger - no problem"
^ Debugger
!
enterDebuggerWith:anException message:aString
"enter debugger with error-message aString"
|debugger|
"
if there is no debugger, exit smalltalk
"
Debugger isNil ifTrue:[
'error: ' errorPrint. aString errorPrintNL.
Smalltalk fatalAbort:'no Debugger defined'
].
"
find an appropriate debugger to use
"
debugger := self appropriateDebugger:#enterWithMessage.
^ debugger enterWithMessage:aString.
! !
!Object methodsFor:'debugging'!
notify:aString
"launch a Notifier, telling user something"
DialogView isNil ifTrue:[
"
on systems without GUI, simply show
the message on the Transcript.
"
Transcript showCr:aString.
^ self
].
DialogView information:aString
"
nil notify:'hello there'
self notify:'hello there'
"
!
information:aString
"launch an InfoBox, telling user something"
self notify:aString
"
nil information:'hello there'
self information:'hello there'
"
!
warn:aString
"launch a WarningBox, telling user something"
DialogView isNil ifTrue:[
"
on systems without GUI, simply show
the message on the Transcript.
"
Transcript showCr:aString.
^ self
].
DialogView warn:aString
"
nil warn:'hello there'
self warn:'hello there'
"
!
confirm:aString
"launch a confirmer, which allows user to enter yes or no.
return true for yes, false for no"
DialogView isNil ifTrue:[
"
on systems without GUI, output a message
and return true (as if yes was answered)
Q: should we ask user by reading Stdin ?
"
Transcript showCr:aString.
^ true
].
^ DialogView confirm:aString
"
nil confirm:'hello'
self confirm:'hello'
"
!
basicInspect
"launch an inspector on the receiver.
this method should NOT be redefined in subclasses."
Inspector isNil ifTrue:[
"
for systems without GUI
"
Transcript showCr:'no Inspector'
] ifFalse:[
Inspector openOn:self
]
!
inspect
"launch an inspector on the receiver.
this method can be redefined in subclasses to start
special inspectors."
^ self basicInspect
! !
!Object methodsFor:'accessing'!
at:index
"return the indexed instance variable with index, anInteger;
this method can be redefined in subclasses."
^ self basicAt:index
!
basicAt:index
"return the indexed instance variable with index, anInteger.
Trigger an error if the receiver has no indexed instance variables.
This method should NOT be redefined in any subclass"
%{ /* NOCONTEXT */
register int nbytes, indx;
OBJ myClass;
register char *pFirst;
unsigned char *cp;
unsigned short *sp;
long *lp;
OBJ *op;
int nInstBytes, ninstvars;
extern OBJ _makeLarge();
/*
* notice the missing test for self being a nonNilObject -
* this can be done since basicAt: is defined both in UndefinedObject
* and SmallInteger
*/
if (_isSmallInteger(index)) {
myClass = _qClass(self);
indx = _intVal(index) - 1;
ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
nbytes = _qSize(self) - nInstBytes;
pFirst = (char *)(_InstPtr(self)) + nInstBytes;
switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
case BYTEARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
cp = (unsigned char *)pFirst + indx;
RETURN ( _MKSMALLINT(*cp & 0xFF) );
}
break;
case WORDARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
sp = (unsigned short *)pFirst + indx;
RETURN ( _MKSMALLINT(*sp & 0xFFFF) );
}
break;
case LONGARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
lp = (long *)pFirst + indx;
if ((*lp >= _MIN_INT) && (*lp <= _MAX_INT))
RETURN ( _MKSMALLINT(*lp) );
RETURN ( _makeLarge(*lp) );
}
break;
case FLOATARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
float *fp;
fp = (float *)pFirst + indx;
RETURN ( _MKFLOAT((double)(*fp)) COMMA_CON );
}
break;
case DOUBLEARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
double *dp;
#ifdef NEED_DOUBLE_ALIGN
/*
* care for filler
*/
pFirst += sizeof(FILLTYPE);
#endif
dp = (double *)pFirst + indx;
RETURN ( _MKFLOAT(*dp) COMMA_CON );
}
break;
case WKPOINTERARRAY:
case POINTERARRAY:
if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
op = (OBJ *)pFirst + indx;
RETURN ( *op );
}
break;
}
}
%}
.
index isInteger ifFalse:[
^ self indexNotInteger
].
^ self subscriptBoundsError:index
!
at:index put:anObject
"store the 2nd arg, anObject as indexed instvar with index, anInteger.
this method can be redefined in subclasses."
^ self basicAt:index put:anObject
!
basicAt:index put:anObject
"store the 2nd arg, anObject as indexed instvar with index, anInteger.
Trigger an error if the receiver has no indexed instance variables.
This method should NOT be redefined in any subclass"
%{ /* NOCONTEXT */
register int nbytes, indx;
OBJ myClass;
register char *pFirst;
char *cp;
short *sp;
long *lp;
OBJ *op;
int nInstBytes, ninstvars;
int val;
/* notice the missing test for self being a nonNilObject -
this can be done since basicAt: is defined both in UndefinedObject
and SmallInteger */
if (_isSmallInteger(index)) {
indx = _intVal(index) - 1;
myClass = _qClass(self);
ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
nInstBytes = OHDR_SIZE + __OBJS2BYTES__(ninstvars);
nbytes = _qSize(self) - nInstBytes;
pFirst = (char *)(_InstPtr(self)) + nInstBytes;
switch (_intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK) {
case BYTEARRAY:
if (_isSmallInteger(anObject)) {
val = _intVal(anObject);
if ((val >= 0) && (val <= 255)) {
if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {
cp = pFirst + indx;
*cp = val;
RETURN ( anObject );
}
}
}
break;
case WORDARRAY:
if (_isSmallInteger(anObject)) {
val = _intVal(anObject);
if ((val >= 0) && (val <= 0xFFFF)) {
if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {
sp = (short *)pFirst + indx;
*sp = val;
RETURN ( anObject );
}
}
}
break;
case LONGARRAY:
if (_isSmallInteger(anObject)) {
if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {
lp = (long *)pFirst + indx;
*lp = _intVal(anObject);
RETURN ( anObject );
}
}
/* XXX
* XXX must add possibility to put in a large number here
* XXX
*/
break;
case FLOATARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
float *fp;
fp = (float *)pFirst + indx;
if (__isFloat(anObject)) {
*fp = _floatVal(anObject);
RETURN ( anObject );
} else if (_isSmallInteger(anObject)) {
*fp = (float) _intVal(anObject);
RETURN ( anObject );
}
}
break;
case DOUBLEARRAY:
if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
double *dp;
#ifdef NEED_DOUBLE_ALIGN
/*
* care for filler
*/
pFirst += sizeof(FILLTYPE);
#endif
dp = (double *)pFirst + indx;
if (__isFloat(anObject)) {
*dp = _floatVal(anObject);
RETURN ( anObject );
} else if (_isSmallInteger(anObject)) {
*dp = (double) _intVal(anObject);
RETURN ( anObject );
}
}
break;
case WKPOINTERARRAY:
case POINTERARRAY:
if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {
op = (OBJ *)pFirst + indx;
*op = anObject;
__STORE(self, anObject);
RETURN ( anObject );
}
break;
default:
break;
}
}
%}
.
index isInteger ifFalse:[
"
the index should be an integer number
"
^ self indexNotInteger
].
(index between:1 and:self size) ifFalse:[
"
the index is less than 1 or greater than the size of the
recevier collection
"
^ self subscriptBoundsError:index
].
(self class isFloats) ifTrue:[
anObject isNumber ifTrue:[
^ self basicAt:index put:(anObject asFloat)
]
].
(self class isDoubles) ifTrue:[
anObject isNumber ifTrue:[
^ self basicAt:index put:(anObject asFloat)
]
].
anObject isInteger ifFalse:[
"
the object to put into the recevier collection
should be an integer number
"
^ self elementNotInteger
].
"
the object to put into the recevier collection
is not an instance of the expected element class
"
^ self elementBoundsError
!
instVarAt:index
"return a non-indexed instance variable;
peeking into an object this way is not very object oriented
- use with care (needed for copy, inspector etc.)"
%{ /* NOCONTEXT */
OBJ myClass;
int idx, ninstvars;
if (_isSmallInteger(index)) {
myClass = _Class(self);
ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
idx = _intVal(index) - 1;
if ((idx >= 0) && (idx < ninstvars)) {
RETURN ( _InstPtr(self)->i_instvars[idx] );
}
}
%}
.
index isInteger ifFalse:[
^ self indexNotInteger
].
^ self subscriptBoundsError:index
!
instVarAt:index put:value
"change a non-indexed instance variable;
peeking into an object this way is not very object oriented
- use with care (needed for copy, inspector etc.)"
%{ /* NOCONTEXT */
OBJ myClass;
int idx, ninstvars;
if (_isSmallInteger(index)) {
myClass = _Class(self);
ninstvars = _intVal(_ClassInstPtr(myClass)->c_ninstvars);
idx = _intVal(index) - 1;
if ((idx >= 0) && (idx < ninstvars)) {
_InstPtr(self)->i_instvars[idx] = value;
__STORE(self, value);
RETURN ( value );
}
}
%}
.
index isInteger ifFalse:[
^ self indexNotInteger
].
^ self subscriptBoundsError:index
! !
!Object methodsFor:'dependents access'!
dependents
"return a Collection of dependents - nil if there is none.
The default implementation here uses a global Dictionary to store
dependents - some classes (Model) redefine this for better performance."
^ Dependencies at:self ifAbsent:[nil]
!
dependents:aCollection
"set the collection of dependents.
The default implementation here uses a global Dictionary to store
dependents - some classes (Model) redefine this for better performance."
(aCollection isNil or:[aCollection isEmpty]) ifTrue:[
Dependencies removeKey:self ifAbsent:[]
] ifFalse:[
Dependencies at:self put:aCollection
]
!
dependentsDo:aBlock
"evaluate aBlock for all of my dependents"
|deps|
deps := self dependents.
deps notNil ifTrue:[
deps do:aBlock
]
!
addDependent:anObject
"make the argument, anObject be a dependent of the receiver"
|deps|
deps := self dependents.
deps isNil ifTrue:[
self dependents:(WeakIdentitySet with:anObject)
] ifFalse:[
deps add:anObject
]
!
removeDependent:anObject
"make the argument, anObject be independent of the receiver"
|deps|
deps := self dependents.
deps notNil ifTrue:[
deps remove:anObject ifAbsent:[].
deps isEmpty ifTrue:[
self dependents:nil
]
]
!
release
"remove all dependencies from the receiver"
self dependents:nil
! !
!Object methodsFor:'change and update'!
changeRequest
"the receiver wants to change - check if all dependents
grant the request, and return true if so"
self dependentsDo:[:dependent |
dependent updateRequest ifFalse:[^ false].
].
^ true
!
changeRequest:aParameter
"the receiver wants to change - check if all dependents
grant the request, and return true if so"
self dependentsDo:[:dependent |
(dependent updateRequest:aParameter) ifFalse:[^ false].
].
^ true
!
changeRequestFrom:anObject
"the receiver wants to change - check if all dependents
except anObject grant the request, and return true if so"
self dependentsDo:[:dependent |
dependent == anObject ifFalse:[
(dependent updateRequest) ifFalse:[^ false].
]
].
^ true
!
changed
"notify all dependents that the receiver has changed.
Each dependent gets a '#update:'-message with the original
receiver as argument."
self changed:nil
!
changed:aParameter
"notify all dependents that the receiver has changed somehow.
Each dependent gets a '#update:'-message with aParameter
as argument."
self changed:aParameter with:nil
!
changed:aParameter with:anArgument
"notify all dependents that the receiver has changed somehow.
Each dependent gets a '#update:with:from:'-message, with aParameter
and anArgument as arguments."
self dependentsDo:[:dependent |
dependent update:aParameter with:anArgument from:self
]
!
broadcast:aSelectorSymbol
"send a message with selector aSelectorSymbol to all my dependents"
self dependentsDo:[:dependent |
dependent perform:aSelectorSymbol
]
!
broadcast:aSelectorSymbol with:anArgument
"send a message with selector aSelectorSymbol with an additional
argument anArgument to all my dependents."
self dependentsDo:[:dependent |
dependent perform:aSelectorSymbol with:anArgument
]
!
update:aParameter
"the message is sent to a dependent, when one of the objects
on whom the receiver depends, has changed. The argument aParameter
is either the changed object or the argument to the #changed: message.
Default behavior here is to do nothing"
^ self
!
update:aParameter with:anArgument
"dependent is notified of some change -
Default is to try update:"
^ self update:aParameter
!
update:aParameter with:anArgument from:sender
"dependent is notified of some change -
Default is to try update:with:"
^ self update:aParameter with:anArgument
!
updateRequest
"return true, if an update request is granted.
Default here is to grant updates - may be used
to lock updates if someone is making other changes
from within an update"
^ true
!
updateRequest:aSymbol
"return true, if an update request is granted.
Default here a simple updateRequest"
^ self updateRequest
! !
!Object methodsFor:'secure message sending'!
askFor:aSelector
"try to send the receiver the message, aSelector.
If it does not understand it, return false. Otherwise
the real value returned.
Useful to send messages such as: 'isColor' to unknown
receivers."
^ self perform:aSelector ifNotUnderstood:[false]
"
1 askFor:#isColor
"
!
perform:aSelector ifNotUnderstood:exceptionBlock
"try to send message aSelector to the receiver.
If its understood, return the methods returned value,
otherwise return the value of the exceptionBlock"
|val|
MessageNotUnderstoodSignal handle:[:ex |
^ exceptionBlock value
] do:[
val := self perform:aSelector
].
^ val
"
1.2345 perform:#foo ifNotUnderstood:['sorry']
"
!
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
"try to send message aSelector to the receiver.
If its understood, return the methods returned value,
otherwise return the value of the exceptionBlock"
|val|
MessageNotUnderstoodSignal handle:[:ex |
^ exceptionBlock value
] do:[
val := self perform:aSelector with:argument
].
^ val
"
|unknown|
unknown := 1.
(unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
unknown := 'high there'.
(unknown perform:#+ with:2 ifNotUnderstood:['sorry']) printNewline.
"
! !
!Object methodsFor:'message sending'!
perform:aSelector
"send the message aSelector to the receiver"
%{ /* NOCONTEXT */
#define PRE_2_11
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC0;
struct inlineCache lilc = _DUMMYILC0;
#else
static struct inlineCache ilc = _DUMMYILC0;
struct inlineCache lilc;
#endif
static OBJ lastSelector = nil;
#if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
#ifdef PRE_2_11
if (aSelector != lastSelector) {
ilc.ilc_func = _SEND0;
lastSelector = aSelector;
}
#else
lilc = ilc;
#endif
#if defined(xxTHIS_CONTEXT)
# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
# else
lilc.ilc_lineNo = __pilc->ilc_lineNo;
# endif
#endif
#ifdef PRE_2_11
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc) );
#else
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc) );
#endif
%}
!
perform:aSelector with:anObject
"send the one-arg-message aSelector to the receiver"
%{ /* NOCONTEXT */
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC1;
struct inlineCache lilc = _DUMMYILC1;
static OBJ lastSelector = nil;
# if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
# endif
if (aSelector != lastSelector) {
ilc.ilc_func = _SEND1;
lastSelector = aSelector;
}
ilc.ilc_lineNo = __pilc->ilc_lineNo;
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, anObject) );
#else
static struct inlineCache ilc = _DUMMYILC1;
struct inlineCache lilc;
# if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
# endif
lilc = ilc;
lilc.ilc_lineNo = __pilc->ilc_lineNo;
RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, anObject) );
#endif
%}
!
perform:aSelector with:firstObject with:secondObject
"send the two-arg-message aSelector to the receiver"
%{ /* NOCONTEXT */
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC2;
struct inlineCache lilc = _DUMMYILC2;
#else
static struct inlineCache ilc = _DUMMYILC2;
struct inlineCache lilc;
#endif
static OBJ lastSelector = nil;
#if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
#ifdef PRE_2_11
if (aSelector != lastSelector) {
ilc.ilc_func = _SEND2;
lastSelector = aSelector;
}
#else
lilc = ilc;
#endif
#if defined(xxTHIS_CONTEXT)
# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
# else
lilc.ilc_lineNo = __pilc->ilc_lineNo;
# endif
#endif
# ifdef PRE_2_11
RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject));
# else
RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, firstObject, secondObject));
# endif
%}
!
perform:aSelector with:firstObject with:secondObject with:thirdObject
"send the three-arg-message aSelector to the receiver"
%{ /* NOCONTEXT */
#ifdef PRE_2_11
static struct inlineCache ilc = _ILC3;
struct inlineCache lilc = _DUMMYILC3;
#else
static struct inlineCache ilc = _DUMMYILC3;
struct inlineCache lilc;
#endif
static OBJ lastSelector = nil;
#if defined(THIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
#endif
#ifdef PRE_2_11
if (aSelector != lastSelector) {
ilc.ilc_func = _SEND3;
lastSelector = aSelector;
}
#else
lilc = ilc;
#endif
#if defined(xxTHIS_CONTEXT)
# ifdef PRE_2_11
ilc.ilc_lineNo = __pilc->ilc_lineNo;
# else
lilc.ilc_lineNo = __pilc->ilc_lineNo;
# endif
#endif
# ifdef PRE_2_11
RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject, thirdObject));
# else
RETURN ((*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &lilc, firstObject, secondObject, thirdObject));
# endif
%}
!
perform:aSelector withArguments:argArray
"send the message aSelector with all args taken from argArray
to the receiver."
|numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
numberOfArgs := argArray size.
%{
extern OBJ Array;
REGISTER OBJ *argP;
int nargs, i;
static OBJ last0 = nil; static struct inlineCache ilc0 = _ILC0;
static OBJ last1 = nil; static struct inlineCache ilc1 = _ILC1;
static OBJ last2 = nil; static struct inlineCache ilc2 = _ILC2;
static OBJ last3 = nil; static struct inlineCache ilc3 = _ILC3;
static OBJ last4 = nil; static struct inlineCache ilc4 = _ILC4;
static OBJ last5 = nil; static struct inlineCache ilc5 = _ILC5;
static OBJ last6 = nil; static struct inlineCache ilc6 = _ILC6;
static OBJ last7 = nil; static struct inlineCache ilc7 = _ILC7;
static OBJ last8 = nil; static struct inlineCache ilc8 = _ILC8;
static OBJ last9 = nil; static struct inlineCache ilc9 = _ILC9;
static OBJ last10 = nil; static struct inlineCache ilc10 = _ILC10;
static OBJ last11 = nil; static struct inlineCache ilc11 = _ILC11;
static OBJ last12 = nil; static struct inlineCache ilc12 = _ILC12;
static OBJ last13 = nil; static struct inlineCache ilc13 = _ILC13;
static OBJ last14 = nil; static struct inlineCache ilc14 = _ILC14;
static OBJ last15 = nil; static struct inlineCache ilc15 = _ILC15;
#if defined(xxxTHIS_CONTEXT)
/*
* must set lineno in sender by hand here ... (because of NOCONTEXT)
*/
_ContextInstPtr(__sender)->c_lineno = __pilc->ilc_lineNo;
#endif
if (_isSmallInteger(numberOfArgs)) {
nargs = _intVal(numberOfArgs);
if (nargs == 0) {
if (aSelector != last0) {
ilc0.ilc_func = _SEND0;
last0 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc0.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ((*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0));
}
if (__isArray(argArray)) {
argP = _ArrayInstPtr(argArray)->a_element;
} else {
argP = (OBJ *)(&a1);
for (i=1; i <= nargs; i++) {
*argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
}
}
switch (nargs) {
case 1:
if (aSelector != last1) {
ilc1.ilc_func = _SEND1;
last1 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc1.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, argP[0]));
case 2:
if (aSelector != last2) {
ilc2.ilc_func = _SEND2;
last2 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc2.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2,
argP[0], argP[1]));
case 3:
if (aSelector != last3) {
ilc3.ilc_func = _SEND3;
last3 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc3.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3,
argP[0], argP[1], argP[2]));
case 4:
if (aSelector != last4) {
ilc4.ilc_func = _SEND4;
last4 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc4.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4,
argP[0], argP[1], argP[2], argP[3]));
case 5:
if (aSelector != last5) {
ilc5.ilc_func = _SEND5;
last5 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc5.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5,
argP[0], argP[1], argP[2], argP[3], argP[4]));
case 6:
if (aSelector != last6) {
ilc6.ilc_func = _SEND6;
last6 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc6.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5]));
case 7:
if (aSelector != last7) {
ilc7.ilc_func = _SEND7;
last7 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc7.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6]));
case 8:
if (aSelector != last8) {
ilc8.ilc_func = _SEND8;
last8 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc8.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7]));
case 9:
if (aSelector != last9) {
ilc9.ilc_func = _SEND9;
last9 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc9.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8]));
case 10:
if (aSelector != last10) {
ilc10.ilc_func = _SEND10;
last10 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc10.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9]));
case 11:
if (aSelector != last11) {
ilc11.ilc_func = _SEND11;
last11 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc11.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10]));
case 12:
if (aSelector != last12) {
ilc12.ilc_func = _SEND12;
last12 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc12.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10], argP[11]));
case 13:
if (aSelector != last13) {
ilc13.ilc_func = _SEND13;
last13 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc13.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc13.ilc_func)(self, aSelector, CON_COMMA nil, &ilc13,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10], argP[11], argP[12]));
case 14:
if (aSelector != last14) {
ilc14.ilc_func = _SEND14;
last14 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc14.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc14.ilc_func)(self, aSelector, CON_COMMA nil, &ilc14,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10], argP[11], argP[12], argP[13]));
case 15:
if (aSelector != last15) {
ilc15.ilc_func = _SEND15;
last15 = aSelector;
}
#ifdef xxTHIS_CONTEXT
ilc15.ilc_lineNo = __pilc->ilc_lineNo;
#endif
RETURN ( (*ilc15.ilc_func)(self, aSelector, CON_COMMA nil, &ilc15,
argP[0], argP[1], argP[2], argP[3], argP[4],
argP[5], argP[6], argP[7], argP[8], argP[9],
argP[10], argP[11], argP[12], argP[13],
argP[14]));
}
}
%}
.
^ self primitiveFailed
!
perform:aSelector inClass:aClass withArguments:argArray
"send the message aSelector with all args taken from argArray
to the receiver as a super-send message.
This is actually more flexible than the normal super-send, since it allows
to execute a method in ANY superclass of the receiver (not just the
immediate superclass).
Thus, it is (theoretically) possible to do
'5 perform:#< inClass:Magnitude withArguments:#(6)'
and evaluate Magnitudes compare method even if there was one in Number.
This method is used by the interpreter to evaluate super sends
and could be used for very special behavior (language extension ?).
WARNING: this is an ST/X feature - probably not found in other smalltalks."
|numberOfArgs a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15|
"
check, if aClass is really a superclass of the receiver
"
(self class isSubclassOf:aClass) ifFalse:[
self error:'class argument is not a superclass of the receiver'.
^ nil
].
numberOfArgs := argArray size.
%{
extern OBJ Array;
REGISTER OBJ *argP;
int nargs, i;
static struct inlineCache ilc0 = _DUMMYILC0;
static struct inlineCache ilc1 = _DUMMYILC1;
static struct inlineCache ilc2 = _DUMMYILC2;
static struct inlineCache ilc3 = _DUMMYILC3;
static struct inlineCache ilc4 = _DUMMYILC4;
static struct inlineCache ilc5 = _DUMMYILC5;
static struct inlineCache ilc6 = _DUMMYILC6;
static struct inlineCache ilc7 = _DUMMYILC7;
static struct inlineCache ilc8 = _DUMMYILC8;
static struct inlineCache ilc9 = _DUMMYILC9;
static struct inlineCache ilc10 = _DUMMYILC10;
static struct inlineCache ilc11 = _DUMMYILC11;
static struct inlineCache ilc12 = _DUMMYILC12;
static struct inlineCache ilc13 = _DUMMYILC13;
static struct inlineCache ilc14 = _DUMMYILC14;
static struct inlineCache ilc15 = _DUMMYILC15;
if (_isSmallInteger(numberOfArgs)) {
nargs = _intVal(numberOfArgs);
if (nargs == 0) {
RETURN (_SEND0(self, aSelector, CON_COMMA aClass, &ilc0));
}
argP = (OBJ *)(&a1);
if (_Class(argArray) == Array) {
for (i=0; i < nargs; i++) {
*argP++ = _ArrayInstPtr(argArray)->a_element[i];
}
} else {
for (i=1; i <= nargs; i++) {
*argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
}
}
switch (nargs) {
case 1:
RETURN ( _SEND1(self, aSelector, CON_COMMA aClass, &ilc1, a1));
case 2:
RETURN ( _SEND2(self, aSelector, CON_COMMA aClass, &ilc2, a1, a2));
case 3:
RETURN ( _SEND3(self, aSelector, CON_COMMA aClass, &ilc3, a1, a2, a3));
case 4:
RETURN ( _SEND4(self, aSelector, CON_COMMA aClass, &ilc4, a1, a2, a3, a4));
case 5:
RETURN ( _SEND5(self, aSelector, CON_COMMA aClass, &ilc5,
a1, a2, a3, a4, a5));
case 6:
RETURN ( _SEND6(self, aSelector, CON_COMMA aClass, &ilc6,
a1, a2, a3, a4, a5, a6));
case 7:
RETURN ( _SEND7(self, aSelector, CON_COMMA aClass, &ilc7,
a1, a2, a3, a4, a5, a6, a7));
case 8:
RETURN ( _SEND8(self, aSelector, CON_COMMA aClass, &ilc8,
a1, a2, a3, a4, a5, a6, a7, a8));
case 9:
RETURN ( _SEND9(self, aSelector, CON_COMMA aClass, &ilc9,
a1, a2, a3, a4, a5, a6, a7, a8, a9));
case 10:
RETURN ( _SEND10(self, aSelector, CON_COMMA aClass, &ilc10,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10));
case 11:
RETURN ( _SEND11(self, aSelector, CON_COMMA aClass, &ilc11,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11));
case 12:
RETURN ( _SEND12(self, aSelector, CON_COMMA aClass, &ilc12,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12));
case 13:
RETURN ( _SEND13(self, aSelector, CON_COMMA aClass, &ilc13,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
a13));
case 14:
RETURN ( _SEND14(self, aSelector, CON_COMMA aClass, &ilc14,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
a13, a14));
case 15:
RETURN ( _SEND15(self, aSelector, CON_COMMA aClass, &ilc15,
a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
a13, a14, a15));
}
}
%}
.
^ self primitiveFailed
! !
!Object methodsFor:'binary storage'!
storeBinaryOn:aStream
"Writes a description of the receiver onto aStream, in a way that allows
the object's structure to be reconstructed from the stream's contents"
BinaryOutputManager store:self on:aStream
!
hasSpecialBinaryRepresentation
"return true, if the receiver has a special binary representation;
default here is false, but can be redefined in class which provide
their own storeBinary/readBinary methods"
^ false
!
readBinaryContentsFrom:stream manager:manager
"reconstruct the receivers instance variables by reading a binary
binary representation from stream.
This is a general implementation walking over instances loading
each recursively using manager.
Notice, that the bit-instances (bytes, words etc.) have already been
read by the class.
Can be redefined in subclasses (see String, SmallInteger etc)."
|size "{ Class: SmallInteger }"|
size := self class instSize.
1 to:size do:[:i |
self instVarAt:i put:(manager nextObject)
].
size := self basicSize.
size ~~ 0 ifTrue:[
self class isPointers ifTrue:[
1 to:size do:[:i |
self basicAt:i put:(manager nextObject)
]
]
]
!
storeBinaryDefinitionOn: stream manager: manager
"append a binary representation of the receiver onto stream.
This method first stores the class, then the body, which is done
in a separate method to allow redefinition of the bodies format.
Can be redefined in subclasses (see String, SmallInteger etc)."
manager putIdOf:(self class) on:stream.
self storeBinaryDefinitionBodyOn:stream manager:manager
!
storeBinaryDefinitionBodyOn: stream manager: manager
"append a binary representation of the receivers body onto stream.
This is a general implementation walking over instances storing
each recursively as an ID using manager.
Can be redefined in subclasses."
|basicSize "{ Class: SmallInteger }"
instSize "{ Class: SmallInteger }"|
instSize := self class instSize.
self class isPointers ifTrue:[
stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
self class isVariable ifTrue:[
stream nextNumber:3 put:(basicSize := self basicSize)
] ifFalse:[
basicSize := 0
].
1 to:instSize do:[:i |
manager putIdOf:(self instVarAt:i) on:stream
].
1 to:basicSize do:[:i |
manager putIdOf:(self basicAt:i) on: stream
]
] ifFalse: [
stream nextNumber:4 put:(basicSize := self basicSize).
self class isBytes ifTrue:[
1 to:basicSize do:[:i |
stream nextPut:(self basicAt:i)
]
] ifFalse:[
self class isWords ifTrue:[
1 to:basicSize do:[:i |
stream nextNumber:2 put: (self basicAt: i)
]
] ifFalse:[
self class isLongs ifTrue:[
1 to:basicSize do:[:i |
stream nextNumber:4 put: (self basicAt: i)
]
] ifFalse:[
self class isFloats ifTrue:[
"could do it in one big write on machines which use IEEE floats ..."
1 to:basicSize do:[:i |
Float storeBinaryIEEESingle:(self basicAt:i) on:stream
]
] ifFalse:[
self class isDoubles ifTrue:[
"could do it in one big write on machines which use IEEE doubles ..."
1 to:basicSize do:[:i |
Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
]
] ifFalse:[
1 to:basicSize do:[:i |
manager putIdOf:(self basicAt:i) on: stream
]
]
]
]
]
].
"dont forget the instvars"
1 to:instSize do:[:i |
manager putIdOf:(self instVarAt:i) on:stream
].
]
!
storeBinaryOn:stream manager:manager
"append a binary representation of the receiver onto stream."
manager putIdOf:self on:stream
! !
!Object methodsFor:'printing & storing'!
className
"return the classname of the receivers class"
^ self class name
"1 className"
"1 class className" "this may change ..."
"$a className"
"$a class className" "this may change ..."
!
classNameWithArticle
"return a string consisting of classname preceeded by an article.
(dont expect me to write national variants for this ... :-)
If you have special preferences, redefine it ..."
|classname|
classname := self className.
^ classname article , ' ' , classname
"1 classNameWithArticle"
"(1->2) classNameWithArticle"
"XWorkstation basicNew classNameWithArticle"
!
printOn:aStream
"print the receiver on the argument-stream.
The default here is to output the receivers class name.
BUT: this method is heavily redefined for objects which
can print prettier."
aStream nextPutAll:self classNameWithArticle
!
print
"print the receiver on the standard output stream"
self printOn:Stdout
!
printNewline
"print the receiver followed by a cr on the standard output stream"
self printOn:Stdout.
Stdout cr
!
printNL
"print the receiver followed by a cr on the standard output stream
- for GNU Smalltalk compatibility"
^ self printNewline
!
errorPrint
"print the receiver on the standard error stream."
self printOn:Stderr
!
errorPrintNewline
"print the receiver followed by a cr on the standard error stream"
self printOn:Stderr.
Stderr cr
!
errorPrintNL
"print the receiver followed by a cr on the standard error stream"
^ self errorPrintNewline
!
printString
"return a string for printing the receiver.
Since we now use printOn: as the basic print mechanism,
we have to create a stream and print into it."
|s|
s := WriteStream on:(String new:30).
self printOn:s.
^ s contents
!
printStringPaddedTo:size with:padCharacter
"return a printed representation of the receiver,
padded with padCharacter up to size"
^ (self printString) paddedTo:size with:padCharacter
"123 printStringPaddedTo:10 with:$."
"123 printStringPaddedTo:10 with:$*"
!
printStringPaddedTo:size
"return a printed representation of the receiver,
padded with spaces up to size"
^ self printStringPaddedTo:size with:(Character space)
"123 printStringPaddedTo:10"
!
printStringZeroPaddedTo:size
"return a printed representation of the receiver,
padded with zero characters up to size.
Usually used with float numbers."
^ self printStringPaddedTo:size with:$0
"123.0 printStringZeroPaddedTo:10"
!
printStringLeftPaddedTo:size with:padCharacter
"return my printString as a right-adjusted string of length size;
characters on the left are filled with padCharacter."
^ (self printString) leftPaddedTo:size with:padCharacter
"123 printStringLeftPaddedTo:10 with:$."
"1 printStringLeftPaddedTo:10 with:$."
"(Float pi) printStringLeftPaddedTo:20 with:$*"
!
printStringLeftPaddedTo:size
"return my printString as a right-adjusted string of length size;
characters on the left are filled with spaces."
^ self printStringLeftPaddedTo:size with:(Character space)
"10 printStringLeftPaddedTo:10"
"1 printStringLeftPaddedTo:10"
!
printOn:aStream paddedTo:size with:padCharacter
"print the receiver on aStream, padding with padCharacter up to size"
aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
"123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr"
"123 printOn:Transcript paddedTo:10 with:$. . Transcript cr"
!
printOn:aStream zeroPaddedTo:size
"print the receiver on aStream, padding with zeros up to size.
Usually used with float numbers."
self printOn:aStream paddedTo:size with:$0.
"123.0 printOn:Transcript zeroPaddedTo:10"
!
printOn:aStream paddedTo:size
"print the receiver on aStream, padding with spaces up to size."
self printOn:aStream paddedTo:size with:(Character space)
"123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr"
!
printOn:aStream leftPaddedTo:size with:padCharacter
"print the receiver on aStream, padding with padCharacters up to size.
padding is done on the left."
aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
"123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr"
"123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr"
!
printOn:aStream leftPaddedTo:size
"print the receiver on aStream, padding with spaces up to size.
padding is done on the left."
self printOn:aStream leftPaddedTo:size with:(Character space)
"123 printOn:Transcript leftPaddedTo:10. Transcript cr"
"123 printOn:Transcript leftPaddedTo:2. Transcript cr"
!
printStringRightAdjustLen:size
"obsolete - just a name confusion.
This method will go away ..."
^ self printStringLeftPaddedTo:size
!
printRightAdjustLen:size
"obsolete - just a name confusion.
This method will go away ..."
(self printStringLeftPaddedTo:size) printOn:Stdout
!
displayString
"return a string used when displaying the receiver in a view;
for example an Inspector. This is usually the same as printString,
but sometimes redefined for better look."
^ self printString
!
storeOn:aStream
"store the receiver on aStream; i.e. print an expression which will
reconstruct the receiver"
|myClass hasSemi sz "{ Class: SmallInteger }" |
thisContext isRecursive ifTrue:[
Transcript showCr:'Error: storeString of self referencing object.'.
aStream nextPutAll:'#("recursive")'.
^ self
].
myClass := self class.
aStream nextPut:$(.
aStream nextPutAll:self class name.
hasSemi := false.
myClass isVariable ifTrue:[
aStream nextPutAll:' basicNew:'.
self basicSize printOn:aStream
] ifFalse:[
aStream nextPutAll:' basicNew'
].
sz := myClass instSize.
1 to:sz do:[:i |
aStream nextPutAll:' instVarAt:'.
i printOn:aStream.
aStream nextPutAll:' put:'.
(self instVarAt:i) storeOn:aStream.
aStream nextPut:$;.
hasSemi := true
].
myClass isVariable ifTrue:[
sz := self basicSize.
1 to:sz do:[:i |
aStream nextPutAll:' basicAt:'.
i printOn:aStream.
aStream nextPutAll:' put:'.
(self basicAt:i) storeOn:aStream.
aStream nextPut:$;.
hasSemi := true
]
].
hasSemi ifTrue:[
aStream nextPutAll:' yourself'
].
aStream nextPut:$).
!
storeString
"return a string representing an expression to reconstruct the receiver"
|s|
s := WriteStream on:(String new:50).
self storeOn:s.
^ s contents
!
store
"store the receiver on standard output.
this method is useless, but included for compatibility."
self storeOn:Stdout
!
storeNl
"store the receiver on standard output; append a newline.
this method is useless, but included for compatibility."
self store.
Character nl print
! !