"

 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

                           InterruptSignal'

       poolDictionaries:''

       category:'Kernel-Objects'

!

Object comment:'

COPYRIGHT (c) 1988 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.

'!

Smalltalk at:#ErrorRecursion put:false!

Smalltalk at:#ErrorActive put:false!

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'.

        UnhandledInterruptSignal := (Signal new) mayProceed:true.

        UnhandledInterruptSignal notifierString:'unhandled interrupt'.

        MessageNotUnderstoodSignal := (Signal new) mayProceed:true.

        MessageNotUnderstoodSignal notifierString:'message not understood'.

        UserInterruptSignal := (Signal new) mayProceed:true.

        UserInterruptSignal notifierString:'user Interrupt'.

        RecursionInterruptSignal := (Signal new) mayProceed:false.

        ExceptionInterruptSignal := (Signal new) mayProceed:true.

        ExceptionInterruptSignal notifierString:'exception Interrupt'.

        SubscriptOutOfBoundsSignal := (Signal new) mayProceed:false.

        SubscriptOutOfBoundsSignal notifierString:'subscript out of bounds'.

        ElementOutOfBoundsSignal := (Signal new) mayProceed:false.

        ElementOutOfBoundsSignal notifierString:'element not appropriate or out of bounds'.

        NotFoundSignal := (Signal new) mayProceed:true.

        NotFoundSignal notifierString:'no such element'.

        KeyNotFoundSignal := (Signal new) mayProceed:true.

        KeyNotFoundSignal notifierString:'no such key'.

        NonIntegerIndexSignal := (Signal new) mayProceed:false.

        NonIntegerIndexSignal notifierString:'index must be integer'.

        InformationSignal := (Signal new) mayProceed:true.

        InformationSignal notifierString:'information'.

        Dependencies isNil ifTrue:[

            Dependencies := WeakIdentityDictionary 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

!

unhandledInterruptSignal

    "return the signal used for unhandled interrupts"

    ^ UnhandledInterruptSignal

!

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

!

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

! !

!Object class methodsFor:'queries'!

isBuiltInClass

    "this class is known by the run-time-system"

    ^ 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. 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 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."

%{

    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 objects is nil or a smallinteger, a primitive error is triggered."

    |myClass|

    myClass := self class.

    myClass flags == otherClass flags ifTrue:[

        myClass instSize == otherClass instSize ifTrue:[

            "its ok to do it"

%{

            if (_isNonNilObject(self) 

             && _isNonNilObject(otherClass)

             && (otherClass != UndefinedObject)

             && (otherClass != SmallInteger)) {

                _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

     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

!

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, 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

!

isFileStream

    "return true, if the receiver is some kind of fileStream;

     false is returned here - the method is redefined in FileStream"

    ^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

!

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"