"

 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

                           SystemNotifier SystemWarningBox SystemInfoBox SystemConfirmer'

       poolDictionaries:''

       category:'Kernel-Objects'

!

Object comment:'

COPYRIGHT (c) 1988 by Claus Gittinger

              All Rights Reserved

'!

"these will become classVariables soon ..."

Smalltalk at:#ErrorRecursion put:false!

Smalltalk at:#Dependencies put:nil!

!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

"

"

!

documentation

"

   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.

   Object has no instance variables (and may not get any added). One reason is, that

   UndefinedObject and SmallIntegers are also object - these two cannot have instance

   variables (due to their implementation).

   Class variables:

        ErrorSignal     <Signal>        Signal raised for error/error: messages

        HaltSignal      <Signal>        Signal raised for halt/halt: messages

        MessageNotUnderstoodSignal      Signals raised for various error conditions

        UserInterruptSignal

        RecursionInterruptSignal 

        ExceptionInterruptSignal

        SubscriptOutOfBoundsSignal 

        NonIntegerIndexSignal

        NotFoundSignal 

        KeyNotFoundSignal 

        ElementOutOfBoundsSignal

        InformationSignal

        AbortSignal      <Signal>       Signal raised by debugger, to abort a computation

                                        BUT, only raised if handled.

        SystemNotifier                  cached Notifier used in notify:

        SystemWarningBox                cached WarningBox used in warn:

        SystemInfoBox                   cached InfoBox used in information:

        SystemConfirmer                 cached YesNoBox used in confirm:

"

! !

!Object class methodsFor:'initialization'!

initialize

    "called only once - initialize signals"

    ErrorSignal isNil ifTrue:[

        ErrorSignal := (Signal new) mayProceed:true.

        ErrorSignal notifierString:'error encountered'.

        HaltSignal := (Signal new) mayProceed:true.

        HaltSignal notifierString:'halt encountered'.

        MessageNotUnderstoodSignal := (Signal new) mayProceed:true.

        MessageNotUnderstoodSignal notifierString:'message not understood'.

        "EXPERIMENTAL"

        PrivateMethodSignal := (Signal new) mayProceed:true.

        PrivateMethodSignal notifierString:'attempt to execute private method'.

        PrimitiveFailureSignal := (Signal new) mayProceed:true.

        PrimitiveFailureSignal notifierString:'primitive failed'.

        UserInterruptSignal := (Signal new) mayProceed:true.

        UserInterruptSignal notifierString:'user Interrupt'.

        RecursionInterruptSignal := (Signal new) mayProceed:false.

        RecursionInterruptSignal notifierString:'recursion limit reached'.

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

        AbortSignal := (Signal new) mayProceed:true.

        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

!

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