"

 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.

"

nil subclass:#Object

	instanceVariableNames:''

	classVariableNames:'ErrorSignal HaltSignal MessageNotUnderstoodSignal

		UserInterruptSignal RecursionInterruptSignal

		ExceptionInterruptSignal SubscriptOutOfBoundsSignal

		NonIntegerIndexSignal NotFoundSignal KeyNotFoundSignal

		ElementOutOfBoundsSignal UserNotificationSignal InformationSignal

		WarningSignal PrimitiveFailureSignal DeepCopyErrorSignal

		AbortSignal ErrorRecursion Dependencies InfoPrinting

		ActivityNotificationSignal'

	poolDictionaries:''

	category:'Kernel-Objects'

!

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

"

!

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

	WarningSignal

	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 := (Signal new) newSignalMayProceed:true.

	UserInterruptSignal nameClass:self message:#userInterruptSignal.

	UserInterruptSignal notifierString:'user Interrupt'.

"/        RecursionInterruptSignal := ErrorSignal newSignalMayProceed:false.

	RecursionInterruptSignal := (Signal new) mayProceed:true.

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

	UserNotificationSignal := QuerySignal new newSignalMayProceed:true.

	UserNotificationSignal nameClass:self message:#userNotificationSignal.

	UserNotificationSignal notifierString:'user notifiaction'.

	InformationSignal := UserNotificationSignal newSignalMayProceed:true.

	InformationSignal nameClass:self message:#informationSignal.

	InformationSignal notifierString:'information'.

	WarningSignal := UserNotificationSignal newSignalMayProceed:true.

	WarningSignal nameClass:self message:#warnungSignal.

	WarningSignal notifierString:'warning'.

	ActivityNotificationSignal := UserNotificationSignal newSignalMayProceed:true.

	ActivityNotificationSignal nameClass:self message:#activityNotificationSignal.

	ActivityNotificationSignal notifierString:'activity'.

	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.

	]

    ].

    InfoPrinting := true

    "Object initialize"

    "Modified: 23.12.1995 / 12:45:57 / cg"

! !

!Object class methodsFor:'Signal constants'!

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

!

activityNotificationSignal

    "return the signal used for activity notifications.

     A handler for this signal gets all #activityNotification: sends"

    ^ ActivityNotificationSignal

!

deepCopyErrorSignal 

    "return the signal raised when a deepcopy is asked for

     an object which cannot do this (for example, BlockClosures

     or Contexts)."

    ^ DeepCopyErrorSignal

!

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

!

errorSignal

    "return the signal used for error/error: - handling"

    ^ ErrorSignal

!

exceptionInterruptSignal

    "return the signal used for exception (display errors) error handling"

    ^ ExceptionInterruptSignal

!

haltSignal

    "return the signal used for halt/halt: - handling"

    ^ HaltSignal

!

informationSignal 

    "return the signal used for informations. 

     A handler for this signal gets all #information: sends"

    ^ InformationSignal

!

keyNotFoundSignal 

    "return the signal used for no such key error reporting"

    ^ KeyNotFoundSignal

!

messageNotUnderstoodSignal

    "return the signal used for doesNotUnderstand: - error handling"

    ^ MessageNotUnderstoodSignal

!

nonIntegerIndexSignal 

    "return the signal used for bad subscript error reporting"

    ^ NonIntegerIndexSignal

!

notFoundSignal 

    "return the signal used for no element found error reporting"

    ^ NotFoundSignal

!

primitiveFailureSignal

    "return the signal used for primitiveFailed - error handling"

    ^ PrimitiveFailureSignal

!

privateMethodSignal

    "return the signal used for privateMethod - error handling"

    ^ MessageNotUnderstoodSignal

!

recursionInterruptSignal 

    "return the signal used for recursion overflow error handling"

    ^ RecursionInterruptSignal

!

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

!

userInterruptSignal

    "return the signal used for ^C interrupts handling"

    ^ UserInterruptSignal

!

userNotificationSignal

    "the parent signal used with information and warnings.

     Handling this allows handling of both information- and warning notifications."

    ^ UserNotificationSignal

!

warningSignal 

    "return the signal used for warnings.

     A handler for this signal gets all #warn: sends"

    ^ WarningSignal

! !

!Object class methodsFor:'info messages'!

infoPrinting

    "return the flag which controls information messages."

    ^ InfoPrinting

!

infoPrinting:aBoolean

    "{ Pragma: +optSpace }"

    "turn on/off printing of information messages.

     If the argument, aBoolean is false, infoPrint will not output

     messages. The default is true."

    InfoPrinting := aBoolean

! !

!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:'accessing'!

at:index

    "return the indexed instance variable with index, anInteger;

     this method can be redefined in subclasses."

    ^ self basicAt: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

    "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, flags; */

    REGISTER int n;

    /*

     * 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;

	n /* nInstVars */ = __intVal(_ClassInstPtr(myClass)->c_ninstvars);

	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);

	nbytes = __qSize(self) - n /* nInstBytes */;

	pFirst = (char *)(_InstPtr(self)) + n /* nInstBytes */;

	/* 

	 * replaced switch by open-coded if; this is slightly faster 

	 * since it avoids the range check and also handles the most common case first

	 */

	n = __intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK;

	if ((n == POINTERARRAY) || (n == WKPOINTERARRAY)) {

	    if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {

		op = (OBJ *)pFirst + indx;

		RETURN ( *op );

	    }

	} else if (n == BYTEARRAY) {

	    if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {

		cp = (unsigned char *)pFirst + indx;

		RETURN ( __MKSMALLINT(*cp & 0xFF) );

	    }

	} else if (n == FLOATARRAY) {

	    if ((indx >= 0) && (indx < (nbytes / sizeof(float)))) {

		float *fp;

		fp = (float *)pFirst + indx;

		RETURN ( _MKFLOAT((double)(*fp)) COMMA_CON );

	    }

	} else if (n == 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 );

	    }

	} else if (n == LONGARRAY) {

	    if ((indx >= 0) && (indx < (nbytes / sizeof(long)))) {

		lp = (long *)pFirst + indx;

		if ((*lp >= _MIN_INT) && (*lp <= _MAX_INT))

		    RETURN ( __MKSMALLINT(*lp) );

		RETURN ( __MKLARGEINT(*lp) );

	    }

	} else if (n == WORDARRAY) {

	    if ((indx >= 0) && (indx < (nbytes / sizeof(short)))) {

		sp = (unsigned short *)pFirst + indx;

		RETURN ( __MKSMALLINT(*sp & 0xFFFF) );

	    }

	}

    }

%}

.

    index isInteger ifFalse:[

	^ self indexNotInteger

    ].

    ^ self subscriptBoundsError:index

!

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, flags; */

    REGISTER int n;

    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);

	n /* ninstvars */ = __intVal(_ClassInstPtr(myClass)->c_ninstvars);

	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);

	nbytes = __qSize(self) - n /* nInstBytes */;

	pFirst = (char *)(_InstPtr(self)) + n /* nInstBytes */;

	n = __intVal(_ClassInstPtr(myClass)->c_flags) & ARRAYMASK;

	if ((n == POINTERARRAY) || (n == WKPOINTERARRAY)) {

	    if ((indx >= 0) && (indx < (__BYTES2OBJS__(nbytes)))) {

		op = (OBJ *)pFirst + indx;

		*op = anObject;

		__STORE(self, anObject);

		RETURN ( anObject );

	    }

	} else if (n == BYTEARRAY) {

	    if (__isSmallInteger(anObject)) {

		val = __intVal(anObject);

		if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {

		    if ((indx >= 0) && (indx < (nbytes / sizeof(char)))) {

			cp = pFirst + indx;

			*cp = val;

			RETURN ( anObject );

		    }

		}

	    }

	} else if (n == FLOATARRAY) {