--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Object.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,1863 @@
+"
+ COPYRIGHT (c) 1988-93 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
+ SubscriptOutOfBoundSignal NonIntegerIndexSignal
+ InformationSignal'
+ poolDictionaries:''
+ category:'Kernel-Objects'
+!
+
+Object comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+Class Object is the superclass of all other classes. Protocol common to
+all objects is defined here.
+Also some utility stuff (like notify) and error handling is implemented here.
+
+%W% %E%
+'!
+
+Smalltalk at:#ErrorRecursion put:false!
+Smalltalk at:#ErrorActive put:false!
+Smalltalk at:#ErrorHandler put:nil!
+Smalltalk at:#Dependencies put:nil!
+Smalltalk at:#SystemNotifier put:nil!
+Smalltalk at:#SystemWarningBox put:nil!
+Smalltalk at:#SystemInfoBox put:nil!
+Smalltalk at:#SystemConfirmer put:nil!
+
+!Object class methodsFor:'initialization'!
+
+initialize
+ "called only once - initialize signals"
+
+ ErrorSignal isNil ifTrue:[
+ ErrorSignal := (Signal new) mayProceed:true.
+ ErrorSignal notifierString:'error'.
+
+ HaltSignal := (Signal new) mayProceed:true.
+ HaltSignal notifierString:'halt encountered'.
+
+ MessageNotUnderstoodSignal := (Signal new) mayProceed:true.
+ MessageNotUnderstoodSignal notifierString:'message not understood'.
+
+ UserInterruptSignal := (Signal new) mayProceed:true.
+ UserInterruptSignal notifierString:'user Interrupt'.
+
+ RecursionInterruptSignal := (Signal new) mayProceed:false.
+ RecursionInterruptSignal notifierString:'recursion interrupt'.
+
+ ExceptionInterruptSignal := (Signal new) mayProceed:true.
+ ExceptionInterruptSignal notifierString:'exception Interrupt'.
+
+ SubscriptOutOfBoundSignal := (Signal new) mayProceed:false.
+ SubscriptOutOfBoundSignal notifierString:'subscript out of bounds'.
+
+ NonIntegerIndexSignal := (Signal new) mayProceed:false.
+ NonIntegerIndexSignal notifierString:'index must be integer'.
+
+ InformationSignal := (Signal new) mayProceed:true.
+ InformationSignal notifierString:'information'.
+
+ Dependencies := IdentityDictionary new.
+ ]
+
+ "Object initialize"
+! !
+
+!Object class methodsFor:'signal access'!
+
+errorSignal
+ "return the signal used for error/error: - messages"
+
+ ^ ErrorSignal
+!
+
+haltSignal
+ "return the signal used for halt/halt: - messages"
+
+ ^ HaltSignal
+!
+
+messageNotUnderstoodSignal
+ "return the signal used for doesNotUnderstand: - messages"
+
+ ^ MessageNotUnderstoodSignal
+!
+
+userInterruptSignal
+ "return the signal used for ^C interrupts"
+
+ ^ UserInterruptSignal
+!
+
+recursionInterruptSignal
+ "return the signal used for recursion overflow reporting"
+
+ ^ RecursionInterruptSignal
+!
+
+exceptionInterruptSignal
+ "return the signal used for exception (display errors) reporting"
+
+ ^ ExceptionInterruptSignal
+!
+
+subscriptOutOfBoundSignal
+ "return the signal used for subscript error reporting"
+
+ ^ SubscriptOutOfBoundSignal
+!
+
+nonIntegerIndexSignal
+ "return the signal used for bad subscript error reporting"
+
+ ^ NonIntegerIndexSignal
+!
+
+informationSignal
+ "return the signal used for informations"
+
+ ^ InformationSignal
+! !
+
+!Object methodsFor:'initialization'!
+
+initialize
+ "just to ignore initialize to objects which do not need it"
+
+ ^ self
+! !
+
+!Object methodsFor:'instance creation'!
+
+readFromString:aString
+ "create an object from its printed representation"
+
+ ^ self readFrom:(ReadStream on:aString)
+!
+
+readFrom:aStream
+ "read an objects printed representation from the argument,
+ aStream and return it."
+
+ |newObject|
+ newObject := Compiler evaluate:aStream.
+ (newObject isKindOf:self) ifFalse:[
+ self error:('expected ' , self name)
+ ].
+ ^ newObject
+! !
+
+!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. In general, using become: should be
+ avoided if possible since it may produce many strange effects.
+ 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 by the system - the Collection classes have been rewritten
+ to not use it.)"
+%{
+ if (primBecome(self, anotherObject))
+ RETURN ( self );
+%}
+.
+ self primitiveFailed
+!
+
+address
+ "return the core address as an integer
+ - since objects may move around the returned value is invalid after the
+ next scavenge/collect, therefore use only for debugging."
+
+%{ /* NOCONTEXT */
+
+ if (! _isNonNilObject(self)) {
+ RETURN ( nil );
+ }
+ if ((_qSpace(self) != OLDSPACE) && (_qSpace(self) != STACKSPACE)) {
+ RETURN ( nil );
+ }
+ RETURN ( _MKSMALLINT( (int)self ) );
+%}
+! !
+
+!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
+ this method should NOT be redefined in any subclass"
+
+%{ /* NOCONTEXT */
+
+ register int nbytes;
+ register OBJ myClass;
+
+ /*
+ * notice the missing test for self beeing a nonNilObject -
+ * this can be done since basicSize is defined both in UndefinedObject
+ * and SmallInteger
+ */
+ myClass = _qClass(self);
+ nbytes = _qSize(self)
+ - OHDR_SIZE
+ - _intVal(_ClassInstPtr(myClass)->c_ninstvars) * sizeof(OBJ);
+
+ 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:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(double)) );
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ RETURN ( _MKSMALLINT(nbytes / sizeof(OBJ)) );
+ }
+%}
+.
+ ^ 0
+!
+
+objectSize
+ "return the size of the receiver in bytes - for debugging only"
+
+%{ /* NOCONTEXT */
+
+ RETURN ( _isNonNilObject(self) ? _MKSMALLINT(_qSize(self))
+ : _MKSMALLINT(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
+!
+
+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, iff the receiver is some kind of Block;
+ false returned here - the method is redefined in Block."
+
+ ^ false
+!
+
+isContext
+ "return true, iff 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
+!
+
+isInteger
+ "return true, if the receiver is some kind of integer number;
+ false is returned here - the method is redefined in Integer"
+
+ ^ false
+!
+
+respondsToArithmetic
+ "return true, if the receiver responds to arithmetic messages.
+ false is returned here - the method is redefined in ArithmeticValue"
+
+ ^ false
+!
+
+isMemberOf:aClass
+ "return true, if the receiver is an instance of aClass, false otherwise"
+
+ ^ (self class) == aClass
+!
+
+isKindOf:aClass
+ "return true, if the receiver is an instance of aClass or one of its
+ subclasses, false otherwise"
+
+%{ /* NOCONTEXT */
+
+ register OBJ thisClass;
+
+ thisClass = _Class(self);
+ while (thisClass != nil) {
+ if (thisClass == aClass) {
+ RETURN ( true );
+ }
+ thisClass = _ClassInstPtr(thisClass)->c_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"
+
+%{ /* NOCONTEXT */
+
+ extern OBJ lookup();
+
+ if (lookup(_Class(self), aSelector) == nil) {
+ RETURN ( false );
+ }
+ RETURN ( true );
+%}
+.
+ ^ self class canUnderstand:aSelector
+!
+
+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:'copying'!
+
+copy
+ "return a copy of the receiver - defaults to shallowcopy here"
+
+ ^ self shallowCopy
+!
+
+shallowCopy
+ "return a copy of the object with shared subobjects i.e. shallow copies
+ of its instance objects.
+ This method does NOT handle cycles"
+
+ |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
+!
+
+deepCopy
+ "return a copy of the object with all subobjects also copied.
+ This method does NOT handle cycles"
+
+ |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) deepCopy)
+ ]
+ ] ifFalse:[
+ aCopy := myClass basicNew
+ ].
+
+ "copy the instance variables"
+ sz := myClass instSize.
+ 1 to:sz do:[:i |
+ aCopy instVarAt:i put:((self instVarAt:i) deepCopy)
+ ].
+
+ ^ aCopy
+! !
+
+!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).
+ To expand the range a bit, these 12 hashBits are concatenated to the
+ receivers class hashBits, to form a 24bit hashvalue (which will not
+ help, if many objects of the same class are hashed upon ...)"
+
+%{ /* NOCONTEXT */
+
+ REGISTER int v1, v2;
+ static int nextHash = 0;
+ OBJ cls;
+
+ if (_isObject(self)) {
+ v1 = ((self->o_age & ~AGE_MASK) >> 5) << 8;
+ v1 |= (self->o_hashLow);
+ if (v1 == 0) {
+ v1 = nextHash++;
+ if (v1 == 0)
+ v1 = nextHash++;
+ self->o_hashLow = v1 & 0xFF;
+ self->o_age |= (v1 >> 8) << 5;
+ }
+
+ cls = _qClass(self);
+ v2 = ((cls->o_age & ~AGE_MASK) >> 5) << 8;
+ v2 |= (cls->o_hashLow);
+ if (v2 == 0) {
+ v2 = nextHash++;
+ if (v2 == 0)
+ v2 = nextHash++;
+ cls->o_hashLow = v2 & 0xFF;
+ cls->o_age |= (v2 >> 8) << 5;
+ }
+ RETURN ( _MKSMALLINT((v2<<12) | v1) );
+ }
+%}
+.
+ ^ 0
+! !
+
+!Object methodsFor:'interrupt handling'!
+
+userInterrupt
+ "user (^c) interrupt - enter debugger"
+
+ self error:'user Interrupt'
+!
+
+ioInterrupt
+ "io (SIGIO/SIGPOLL) interrupt and no handler - enter debugger"
+
+ self error:'user Interrupt'
+!
+
+spyInterrupt
+ "spy interrupt and no handler - enter debugger"
+
+ self error:'spy Interrupt'
+!
+
+timerInterrupt
+ "timer interrupt and no handler - enter debugger"
+
+ self error:'timer Interrupt'
+!
+
+errorInterrupt
+ "x-error interrupt and no handler - enter debugger"
+
+ self error:'error Interrupt:' , (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 they come asynchronous
+ on some machines"
+
+ self error:'a floating point exception occured'
+!
+
+signalInterrupt:signalNumber
+ "unix signal occured"
+
+ |box|
+
+ (Smalltalk at:#SignalCatchBlock) notNil ifTrue:[
+ box := OptionBox title:('Signal ' ,
+ signalNumber printString ,
+ ' cought')
+ numberOfOptions:5.
+
+ box buttonTitles:#('ignore' 'debug' 'restart' 'dump' 'exit').
+ box actions:(Array with:[^ nil]
+ with:[Debugger enterWithMessage:'Signal ', signalNumber printString. ^nil]
+ with:[SignalCatchBlock value. ^nil]
+ with:[Smalltalk fatalAbort]
+ with:[Smalltalk exit]).
+ box showAtPointer
+ ].
+
+ self error:('signal ' , signalNumber printString)
+!
+
+recursionInterrupt
+ "recursion limit interrupt - enter debugger"
+
+ self error:'recursion limit reached'
+!
+
+exceptionInterrupt
+ "exception interrupt - enter debugger"
+
+ self error:'exception Interrupt'
+! !
+
+!Object methodsFor:'error handling'!
+
+subscriptBoundsError:badIndex
+ "report error that badIndex is out of bounds"
+
+ SubscriptOutOfBoundSignal raise
+"
+ ^ self error:('index ' , badIndex printString , ' is out of bounds')
+"
+!
+
+indexNotInteger
+ "report error that index is not an Integer"
+
+ NonIntegerIndexSignal raise
+"
+ ^ self error:'index must be integer'
+"
+!
+
+elementNotInteger
+ "report error that object to be stored is no Integer"
+
+ ^ self error:'element must be an Integer'
+!
+
+elementNotCharacter
+ "report error that object to be stored is no Character"
+
+ ^ self error:'element must be a Character'
+!
+
+elementOutOfBounds
+ "report error that object to be stored is not valid"
+
+ ^ self error:'element out of bounds'
+!
+
+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'
+!
+
+typeCheckError
+ "generated when a variable declared with a type hint gets a bad
+ value assigned"
+
+ ^ self error:'bad assign to typed variable'
+!
+
+primitiveFailed
+ "report error that primitive code failed"
+
+ ^ self error:'primitive failed'
+!
+
+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'
+!
+
+error
+ "report error that an error occured"
+
+ ^ self error:'error encountered'
+!
+
+halt
+ "enter debugger with halt-message"
+
+ ^ self halt:'halt encountered'
+!
+
+fatalError:aMessage
+ "report a fatal-error; system dumps a backtrace and exits with core dump"
+%{
+ /*
+ * do not use any message calls here
+ * - since this might lead to infinite recursion ...
+ */
+ if (_isString(aMessage))
+ printf("%s\n", _stringVal(aMessage));
+ printStack(__context);
+ exit(1);
+%}
+!
+
+checkForRecursiveError
+ "helper for all error-methods; catch error while in Debugger.
+ If Debugger is DebugView, try switching to MiniDebugger (as
+ a last chance) otherwise abort.
+ There should not be an error in the debugger, this will only
+ happen if some classes has been changed badly."
+
+ ErrorActive ifTrue:[
+ (Debugger == MiniDebugger) ifTrue:[
+ ErrorRecursion ifFalse:[
+%{
+ printf("recursive error ...\n");
+ printStack(__context);
+ mainExit(0);
+%}
+ ]
+ ].
+ "set to MiniDebugger - and go on"
+ ^ MiniDebugger
+ ].
+ ^ Debugger
+!
+
+error:aString
+ "enter debugger with error-message aString;
+ if nonNil, the global ErrorHandler is informed instead -
+ this gives a chance for private error handling and error catching
+ within debugger"
+
+ |retVal debugger|
+
+ ErrorHandler notNil ifTrue:[
+ ^ ErrorHandler catch:#error: with:aString for:self
+ ].
+ Debugger isNil ifTrue:[
+ 'error: ' print. aString printNewline.
+ self fatalError:'no Debugger defined'
+ ].
+ debugger := self checkForRecursiveError.
+ ErrorActive := true.
+ retVal := debugger enterWithMessage:aString.
+ ErrorActive := false.
+ ^ retVal
+!
+
+doesNotUnderstand:aMessage
+ "enter debugger with does-not-understand-message;
+ if nonNil, the global ErrorHandler is informed instead -
+ this gives a chance for private error handling and error catching
+ within debugger"
+
+ |retVal debugger|
+
+ ErrorHandler notNil ifTrue:[
+ ^ ErrorHandler catch:#doesNotUnderstand: with:aMessage for:self
+ ].
+ Debugger isNil ifTrue:[
+ 'doesNotUnderstand:' print. aMessage selector printNewline.
+ self fatalError:'no Debugger defined'
+ ].
+ debugger := self checkForRecursiveError.
+ ErrorActive := true.
+ retVal := debugger enterWithMessage:(self class name ,
+ ' does not understand:' ,
+ aMessage printString).
+ ErrorActive := false.
+ ^ retVal
+!
+
+halt:aString
+ "enter debugger with halt-message;
+ the global ErrorHandler if nonNil is informed instead -
+ this gives a chance for private error handling and error catching
+ within debugger"
+
+ |retVal debugger|
+
+ ErrorHandler notNil ifTrue:[
+ ^ ErrorHandler catch:#halt: with:aString for:self
+ ].
+ Debugger isNil ifTrue:[
+ 'halt encountered:' print. aString printNewline.
+ self fatalError:'no Debugger defined'
+ ].
+ debugger := self checkForRecursiveError.
+ ErrorActive := true.
+ retVal := debugger enterWithMessage:aString.
+ ErrorActive := false.
+ ^ retVal
+! !
+
+!Object methodsFor:'debugging'!
+
+notify:aString
+ "launch a Notifier, telling user something"
+
+ SystemNotifier isNil ifTrue:[
+ Notifier isNil ifTrue:[
+ Transcript showCr:aString.
+ ^ self
+ ].
+ SystemNotifier := Notifier new
+ ].
+ SystemNotifier title:aString.
+ SystemNotifier showAtPointer
+!
+
+information:aString
+ "launch an InfoBox, telling user something"
+
+ SystemInfoBox isNil ifTrue:[
+ InfoBox isNil ifTrue:[
+ Transcript showCr:aString.
+ ^ self
+ ].
+ SystemInfoBox := InfoBox new
+ ].
+ SystemInfoBox title:aString.
+ SystemInfoBox showAtPointer
+!
+
+warn:aString
+ "launch a WarningBox, telling user something"
+
+ SystemWarningBox isNil ifTrue:[
+ WarningBox isNil ifTrue:[
+ Transcript showCr:aString.
+ ^ self
+ ].
+ SystemWarningBox := WarningBox new
+ ].
+ SystemWarningBox title:aString.
+ SystemWarningBox showAtPointer
+!
+
+confirm:aString
+ "launch a confirmer, which allows user to enter yes or no.
+ return true for yes, false for no"
+
+ SystemConfirmer isNil ifTrue:[
+ YesNoBox isNil ifTrue:[
+ Transcript show:'no YesNoBox. '.
+ Transcript showCr:aString.
+ ^ true
+ ].
+ SystemConfirmer := YesNoBox new
+ ].
+ SystemConfirmer title:aString.
+ SystemConfirmer yesAction:[^ true] noAction:[^ false].
+ SystemConfirmer showAtPointer
+!
+
+basicInspect
+ "launch an inspector on the receiver.
+ this method should NOT be redefined in subclasses."
+
+ Inspector isNil ifTrue:[
+ Transcript showCr:'no Inspector defined'
+ ] ifFalse:[
+ Inspector openOn:self
+ ]
+!
+
+inspect
+ "launch an inspector on the receiver.
+ this method can be redefined in subclasses."
+
+ ^ 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 beeing 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 + ninstvars * sizeof(OBJ);
+ 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;
+
+ dp = (double *)pFirst + indx;
+ RETURN ( _MKFLOAT(*dp) COMMA_CON );
+ }
+ break;
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(OBJ)))) {
+ op = (OBJ *)pFirst + indx;
+ RETURN ( *op );
+ }
+ break;
+ }
+ }
+%}
+.
+ (index isMemberOf:SmallInteger) ifTrue:[
+ ^ self subscriptBoundsError:index
+ ].
+ ^ self indexNotInteger
+!
+
+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 beeing a nonNilObject -
+ this an 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 + ninstvars * sizeof(OBJ);
+ 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 (_isFloat(anObject)) {
+ if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {
+ float *fp;
+
+ fp = (float *)pFirst + indx;
+ *fp = _floatVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ break;
+
+ case DOUBLEARRAY:
+ if (_isFloat(anObject)) {
+ if ((indx >= 0) && (indx < (nbytes / sizeof(double)))) {
+ double *dp;
+
+ dp = (double *)pFirst + indx;
+ *dp = _floatVal(anObject);
+ RETURN ( anObject );
+ }
+ }
+ break;
+
+ case WKPOINTERARRAY:
+ case POINTERARRAY:
+ if ((indx >= 0) && (indx < (nbytes / sizeof(OBJ)))) {
+ op = (OBJ *)pFirst + indx;
+ *op = anObject;
+ __STORE(self, anObject);
+ RETURN ( anObject );
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
+%}
+.
+ (index isMemberOf:SmallInteger) ifFalse:[
+ ^ self indexNotInteger
+ ].
+ (index between:1 and:self size) ifFalse:[
+ ^ self subscriptBoundsError:index
+ ].
+ ^ self elementNotInteger
+!
+
+instVarAt:index
+ "return a non-indexed instance variable;
+ this is not very object oriented - use with care (needed for inspector)"
+
+%{ /* 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;
+ this is not very object oriented - use with care (needed for inspector)"
+
+%{ /* 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:[]
+!
+
+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
+ ]
+!
+
+addDependent:anObject
+ "make the argument, anObject be a dependent of the receiver"
+
+ |deps|
+
+ deps := self dependents.
+ deps isNil ifTrue:[
+ deps := IdentitySet with:anObject.
+ self dependents:deps
+ ] 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'!
+
+changed
+ "notify all dependents that the receiver has changed.
+ Each dependent gets a '#update' message."
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:[:dependent |
+ dependent update:self
+ ]
+ ]
+!
+
+changed:aParameter
+ "notify all dependents that the receiver has changed somehow.
+ Each dependent gets a '#update:aParameter' message."
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:[:dependent |
+ dependent update:aParameter
+ ]
+ ]
+!
+
+changed:aParameter with:arguments
+ "notify all dependents that the receiver has changed somehow.
+ sending update:with: to each dependent with an additional arguments"
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:[:dependent |
+ dependent update:aParameter with:arguments
+ ]
+ ]
+!
+
+broadcast:aSymbol
+ "send the argument, aSelectorSymbol to all my dependents"
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:[:dependent |
+ dependent perform:aSymbol
+ ]
+ ]
+!
+
+broadcast:aSymbol with:anObject
+ "send the argument, aSelectorSymbol of a 1 argument message
+ to all my dependents with the second argument, anObject as argument"
+
+ |deps|
+
+ deps := self dependents.
+ deps notNil ifTrue:[
+ deps do:[:dependent |
+ dependent perform:aSymbol with:anObject
+ ]
+ ]
+!
+
+update:aParameter
+ "dependent is notified of some change -
+ Default behavior is to do nothing"
+
+ ^ self
+!
+
+update:aParameter with:anArgument
+ "dependent is notified of some change -
+ Default is to try simple update"
+
+ ^ self update:aParameter
+!
+
+update:aParameter with:anArgument from:sender
+ "dependent is notified of some change -
+ Default is to try simple update"
+
+ ^ self update:aParameter with:anArgument
+! !
+
+!Object methodsFor:'message sending'!
+
+perform:aSelector
+ "send the message aSelector to the receiver"
+
+%{ /* NOCONTEXT */
+
+ static struct inlineCache ilc = _ILC0;
+ static OBJ lastSelector = nil;
+
+#ifdef XXXTHIS_CONTEXT
+ /*
+ * must set lineno by hand here ...
+ */
+ if (_intVal(__pilc->ilc_lineNo) > 0)
+ _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
+#endif
+
+ if (aSelector != lastSelector) {
+ ilc.ilc_func = _SEND0;
+ lastSelector = aSelector;
+ }
+#ifdef THIS_CONTEXT
+ ilc.ilc_lineNo = __pilc->ilc_lineNo;
+#endif
+
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc) );
+%}
+!
+
+perform:aSelector with:anObject
+ "send the one-arg-message aSelector to the receiver"
+
+%{ /* NOCONTEXT */
+
+ static struct inlineCache ilc = _ILC1;
+ static OBJ lastSelector = nil;
+
+#ifdef XXXTHIS_CONTEXT
+ /*
+ * must set lineno by hand here ...
+ */
+ if (_intVal(__pilc->ilc_lineNo) > 0)
+ _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
+#endif
+ if (aSelector != lastSelector) {
+ ilc.ilc_func = _SEND1;
+ lastSelector = aSelector;
+ }
+#ifdef THIS_CONTEXT
+ ilc.ilc_lineNo = __pilc->ilc_lineNo;
+#endif
+
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, &anObject) );
+#else
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, anObject) );
+#endif
+%}
+!
+
+perform:aSelector with:firstObject with:secondObject
+ "send the two-arg-message aSelector to the receiver"
+
+%{ /* NOCONTEXT */
+
+ static struct inlineCache ilc = _ILC2;
+ static OBJ lastSelector = nil;
+
+#ifdef XXXTHIS_CONTEXT
+ /*
+ * must set lineno by hand here ...
+ */
+ if (_intVal(__pilc->ilc_lineNo) > 0)
+ _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
+#endif
+ if (aSelector != lastSelector) {
+ ilc.ilc_func = _SEND2;
+ lastSelector = aSelector;
+ }
+#ifdef THIS_CONTEXT
+ ilc.ilc_lineNo = __pilc->ilc_lineNo;
+#endif
+
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, &firstObject) );
+#else
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, firstObject, secondObject) );
+#endif
+%}
+!
+
+perform:aSelector with:firstObject with:secondObject with:thirdObject
+ "send the three-arg-message aSelector to the receiver"
+
+%{ /* NOCONTEXT */
+
+ static struct inlineCache ilc = _ILC3;
+ static OBJ lastSelector = nil;
+
+#ifdef XXXTHIS_CONTEXT
+ /*
+ * must set lineno by hand here ...
+ */
+ if (_intVal(__pilc->ilc_lineNo) > 0)
+ _ContextInstPtr(__thisContext)->c_lineno = __pilc->ilc_lineNo;
+#endif
+ if (aSelector != lastSelector) {
+ ilc.ilc_func = _SEND3;
+ lastSelector = aSelector;
+ }
+#ifdef THIS_CONTEXT
+ ilc.ilc_lineNo = __pilc->ilc_lineNo;
+#endif
+
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, &firstObject) );
+#else
+ RETURN ( (*ilc.ilc_func)(self, aSelector, CON_COMMA nil, &ilc, 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|
+
+ numberOfArgs := argArray size.
+%{
+ extern OBJ Array;
+ REGISTER OBJ *argP;
+ OBJ T;
+ 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;
+
+ if (_isSmallInteger(numberOfArgs)) {
+ nargs = _intVal(numberOfArgs);
+ if (nargs) {
+ 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++) {
+#ifdef PASS_ARG_REF
+ T = _MKSMALLINT(i);
+ *argP++ = _AT_(argArray, CON_COMMA &T);
+#else
+ *argP++ = _AT_(argArray, CON_COMMA _MKSMALLINT(i));
+#endif
+ }
+ }
+ }
+#ifdef XXXTHIS_CONTEXT
+ /*
+ * must set lineno by hand here ...
+ */
+ if (_intVal(__pilc->ilc_lineNo) > 0)
+ _ContextInstPtr(__context->c_sender)->c_lineno = __pilc->ilc_lineNo;
+#endif
+ switch (nargs) {
+ case 0:
+ if (aSelector != last0) {
+ ilc0.ilc_func = _SEND0;
+ last0 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0, &a1) );
+#else
+ RETURN ( (*ilc0.ilc_func)(self, aSelector, CON_COMMA nil, &ilc0, a1, a2) );
+#endif
+
+ case 1:
+ if (aSelector != last1) {
+ ilc1.ilc_func = _SEND1;
+ last1 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, &a1));
+#else
+ RETURN ( (*ilc1.ilc_func)(self, aSelector, CON_COMMA nil, &ilc1, a1, a2));
+#endif
+
+ case 2:
+ if (aSelector != last2) {
+ ilc2.ilc_func = _SEND2;
+ last2 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2, &a1));
+#else
+ RETURN ( (*ilc2.ilc_func)(self, aSelector, CON_COMMA nil, &ilc2, a1, a2));
+#endif
+
+ case 3:
+ if (aSelector != last3) {
+ ilc3.ilc_func = _SEND3;
+ last3 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3, &a1));
+#else
+ RETURN ( (*ilc3.ilc_func)(self, aSelector, CON_COMMA nil, &ilc3, a1, a2, a3));
+#endif
+
+ case 4:
+ if (aSelector != last4) {
+ ilc4.ilc_func = _SEND4;
+ last4 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4, &a1));
+#else
+ RETURN ( (*ilc4.ilc_func)(self, aSelector, CON_COMMA nil, &ilc4, a1, a2, a3, a4));
+#endif
+
+ case 5:
+ if (aSelector != last5) {
+ ilc5.ilc_func = _SEND5;
+ last5 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5, &a1));
+#else
+ RETURN ( (*ilc5.ilc_func)(self, aSelector, CON_COMMA nil, &ilc5, a1, a2, a3, a4, a5));
+#endif
+
+ case 6:
+ if (aSelector != last6) {
+ ilc6.ilc_func = _SEND6;
+ last6 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6, &a1));
+#else
+ RETURN ( (*ilc6.ilc_func)(self, aSelector, CON_COMMA nil, &ilc6, a1, a2, a3, a4, a5, a6));
+#endif
+
+ case 7:
+ if (aSelector != last7) {
+ ilc7.ilc_func = _SEND7;
+ last7 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7, &a1));
+#else
+ RETURN ( (*ilc7.ilc_func)(self, aSelector, CON_COMMA nil, &ilc7, a1, a2, a3, a4, a5, a6, a7));
+#endif
+
+ case 8:
+ if (aSelector != last8) {
+ ilc8.ilc_func = _SEND8;
+ last8 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8, &a1));
+#else
+ RETURN ( (*ilc8.ilc_func)(self, aSelector, CON_COMMA nil, &ilc8, a1, a2, a3, a4, a5, a6, a7, a8));
+#endif
+
+ case 9:
+ if (aSelector != last9) {
+ ilc9.ilc_func = _SEND9;
+ last9 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9, &a1));
+#else
+ RETURN ( (*ilc9.ilc_func)(self, aSelector, CON_COMMA nil, &ilc9, a1, a2, a3, a4, a5, a6, a7, a8, a9));
+#endif
+
+ case 10:
+ if (aSelector != last10) {
+ ilc10.ilc_func = _SEND10;
+ last10 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10, &a1));
+#else
+ RETURN ( (*ilc10.ilc_func)(self, aSelector, CON_COMMA nil, &ilc10, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10));
+#endif
+
+ case 11:
+ if (aSelector != last11) {
+ ilc11.ilc_func = _SEND11;
+ last11 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11, &a1));
+#else
+ RETURN ( (*ilc11.ilc_func)(self, aSelector, CON_COMMA nil, &ilc11, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11));
+#endif
+
+ case 12:
+ if (aSelector != last12) {
+ ilc12.ilc_func = _SEND12;
+ last12 = aSelector;
+ }
+#ifdef PASS_ARG_REF
+ RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12, &a1));
+#else
+ RETURN ( (*ilc12.ilc_func)(self, aSelector, CON_COMMA nil, &ilc12, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12));
+#endif
+ }
+ }
+%}
+.
+ ^ self primitiveFailed
+! !
+
+!Object methodsFor:'printing & storing'!
+
+className
+ "return the classname of the receivers class"
+
+ ^ self class name
+!
+
+classNameWithArticle
+ "return a string consisting of classname preceeded by an article"
+
+ |article classname firstChar|
+
+ classname := self className.
+ firstChar := (classname at:1) asLowercase.
+ (firstChar isVowel or:[firstChar == $x]) ifTrue:[
+ article := 'an '
+ ] ifFalse:[
+ article := 'a '
+ ].
+ ^ (article , classname)
+!
+
+printString
+ "return a string for printing the receiver.
+ Default printString is the classname preceeded by an article -
+ is redefined in many subclasses"
+
+ ^ self classNameWithArticle
+!
+
+print
+ "print the receiver on the standard output stream"
+
+ self printString print
+!
+
+printOn:aStream
+ "print the receiver on the argument-stream"
+
+ aStream nextPutAll:(self printString)
+!
+
+printStringRightAdjustLen:fieldSize
+ "return my printString as a right-adjusted string of length fieldSize"
+
+ |thePrintString len spaces|
+
+ thePrintString := self printString.
+ len := thePrintString size.
+ (len < fieldSize) ifTrue:[
+ spaces := String new:(fieldSize - len).
+ ^ spaces , thePrintString
+ ].
+ ^ thePrintString
+!
+
+printRightAdjustLen:fieldSize
+ "print the receiver right adjusted in a field of fieldSize
+ characters"
+
+ (self printStringRightAdjustLen:fieldSize) printOn:Stdout
+!
+
+printNL
+ "print the receiver followed by a cr
+ - for GNU Smalltalk compatibility"
+
+ ^ self printNewline
+!
+
+printNewline
+ "print the receiver followed by a cr"
+
+ self print.
+ Character nl print
+!
+
+displayString
+ "return a string used when displaying the receiver in a view,
+ for example an Inspector. This is usually the same as printString"
+
+ ^ self printString
+!
+
+storeString
+ "return a string representing an expression to reconstruct the receiver"
+
+ | stream myClass hasSemi
+ sz "{ Class: SmallInteger }" |
+
+ myClass := self class.
+ stream := WriteStream on:(String new).
+ stream nextPut:$(.
+ stream nextPutAll:self class name.
+ hasSemi := false.
+ myClass isVariable ifTrue:[
+ stream nextPutAll:' basicNew:'.
+ self basicSize printOn:stream
+ ] ifFalse:[
+ stream nextPutAll:' basicNew'
+ ].
+ sz := myClass instSize.
+ 1 to:sz do:[:i |
+ stream nextPutAll:' instVarAt:'.
+ i printOn:stream.
+ stream nextPutAll:' put:'.
+ (self instVarAt:i) storeOn:stream.
+ stream nextPut:$;.
+ hasSemi := true
+ ].
+ myClass isVariable ifTrue:[
+ sz := self basicSize.
+ 1 to:sz do:[:i |
+ stream nextPutAll:' basicAt:'.
+ i printOn:stream.
+ stream nextPutAll:' put:'.
+ (self basicAt:i) storeOn:stream.
+ stream nextPut:$;.
+ hasSemi := true
+ ]
+ ].
+ hasSemi ifTrue:[
+ stream nextPutAll:' yourself'
+ ].
+ stream nextPut:$).
+ ^ stream contents
+!
+
+storeOn:aStream
+ "store the receiver on aStream; i.e. print an expression which will
+ reconstruct the receiver"
+
+ aStream nextPutAll:(self storeString)
+!
+
+store
+ "store the receiver on standard output"
+
+ self storeOn:Stdout
+!
+
+storeNl
+ "store the receiver on standard output; append a newline"
+
+ self store.
+ Character nl print
+! !