"

 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:#Behavior

       instanceVariableNames:'superclass otherSuperclasses

			      selectorArray methodArray

			      instSize flags'

       classVariableNames:'SubclassInfo'

       poolDictionaries:''

       category:'Kernel-Classes'

!

Behavior comment:'

COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.34 1995-05-01 21:28:04 claus Exp $

'!

!Behavior 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/Behavior.st,v 1.34 1995-05-01 21:28:04 claus Exp $

"

!

documentation

"

    Every class in the system inherits from Behavior (via Class, ClassDescription);

    so here is where most of the class messages end up being implemented.

    (to answer a FAQ: 'Point basicNew' will be done here :-)

    Beginners should keep in mind, that all classes are instances of subclasses

    of Behavior, therefore you will find the above mentioned 'basicNew:' method 

    under the 'instance'-methods of Behavior - NOT under the class methods 

    ('Behavior new' will create and return a new class, while sending 'new' to 

    any instance of Behavior (i.e. any class) will return an instance of that class).

    Behavior provides minimum support for all classes - additional stuff is

    found in ClassDescription and Class. Behaviors provides all mechanisms needed

    to create instances, and send messages to those. However, Behavior does not provide 

    all the (symbolic) information needed to compile methods for a class or to get

    useful information in inspectors.

    In contrast to other ST implementations, the methods have been separated

    from the selectors (there is no Dictionary, but two separate Arrays)

    - this avoids the need for knowledge about Dictionaries in the runtime library (VM)

    (lookup and search in these is seldom anyway, so the added benefit from using a 

     hashed dictionary is almost void).

    Instance variables:

	superclass        <Class>           the receivers superclass

	otherSuperclasses <Array of Class>  experimental: other superclasses

	selectorArray     <Array of Symbol> the selectors for which inst-methods are defined here

	methodArray       <Array of Method> the inst-methods corresponding to the selectors

	instSize          <SmallInteger>    the number of instance variables

	flags             <SmallInteger>    special flag bits coded in a number

    flag bits (see stc.h):

    NOTICE: layout known by compiler and runtime system; be careful when changing

"

! !

!Behavior class methodsFor:'queries'!

isBuiltInClass

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

    ^ true

! !

!Behavior class methodsFor:'creating new classes'!

new

    "creates and return a new class"

    |newClass|

    newClass := self basicNew.

    newClass setSuperclass:Object

		 selectors:(Array new:0)

		   methods:(Array new:0)

		  instSize:0

		     flags:0.

    ^ newClass

! !

!Behavior class methodsFor:'private '!

subclassInfo

    |d b|

    SubclassInfo notNil ifTrue:[^ SubclassInfo].

    d := IdentityDictionary new.

    Smalltalk allClassesDo:[:aClass |

	|superCls|

	aClass isMeta not ifTrue:[

	    superCls := aClass superclass.

	    superCls notNil ifTrue:[

		(d includesKey: superCls) ifFalse:[

		    d at:superCls put:(Set with:aClass).

		] ifTrue:[

		    (d at:superCls ) add:aClass

		]

	    ]

	].

    ].

    SubclassInfo := d.

    ^ d

    "

     Class subclassInfo

    "

!

flushSubclassInfo

    SubclassInfo := nil.

    "

     Class flushSubclassInfo

    "

! !

!Behavior methodsFor:'initialization'!

initialize

    "to catch initialize for classes which do not"

    ^ self

!

postAutoload

    "for autoloaded classes, gives them a second chance"

    ^ self

!

reinitialize

    "to catch reinitialize for classes which do not"

    ^ self

! !

!Behavior methodsFor:'copying'!

deepCopy

    "return a deep copy of the receiver

     - return the receiver here - time will show if this is ok"

    ^ self

!

deepCopyUsing:aDictionary

    "return a deep copy of the receiver

     - return the receiver here - time will show if this is ok"

    ^ self

!

simpleDeepCopy

    "return a deep copy of the receiver

     - return the receiver here - time will show if this is ok"

    ^ self

! !

!Behavior methodsFor:'creating an instance of myself'!

uninitializedNew

    "create an instance of myself with uninitialized contents.

     For all classes except ByteArray, this is the same as new."

    ^ self basicNew

!

uninitializedNew:anInteger

    "create an instance of myself with uninitialized contents.

     For all classes except ByteArray, this is the same as new."

    ^ self basicNew:anInteger

!

niceBasicNew:anInteger

    "same as basicNew:anInteger, but tries to avoid long pauses

     due to garbage collection. This method checks to see if

     allocation is possible without a pause, and does a background

     incremental garbage collect first if there is not enough memory

     available at the moment for fast allocation. 

     This is useful in low-priority background processes which like to 

     avoid disturbing any higher priority foreground process while allocating

     big amounts of memory. Of course, using this method only makes

     sense for big or huge objects (say > 200k).

     EXPERIMENTAL: this is a non-standard interface and should only 

     be used for special applications. There is no guarantee, that this

     method will be available in future ST/X releases."

    |size|

    size := self sizeOfInst:anInteger.

    (ObjectMemory checkForFastNew:size) ifFalse:[

	"

	 incrementally collect garbage

	"

	ObjectMemory incrementalGC.

    ].

    ^ self basicNew:anInteger

!

new

    "return an instance of myself without indexed variables"

    ^ self basicNew

!

new:anInteger

    "return an instance of myself with anInteger indexed variables"

    ^ self basicNew:anInteger

!

basicNew

    "return an instance of myself without indexed variables.

     If the receiver-class has indexed instvars, the new object will have

     a basicSize of zero - 

     i.e. 'aClass basicNew' is equivalent to 'aClass basicNew:0'.

     ** Do not redefine this method in any class **"

%{  /* NOCONTEXT */

    OBJ new();

    REGISTER OBJ newobj;

    REGISTER char *nextPtr;

    unsigned int instsize;

    REGISTER unsigned int nInstVars;

    /*

     * the following ugly code is nothing more than a new() followed

     * by a nilling of the new instance.

     * Unrolled for a bit more speed since this is one of the central object 

     * allocation methods in the system

     */

    nInstVars = _intVal(_INST(instSize));

    instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);

    newobj = (OBJ) newNextPtr;

    nextPtr = ((char *)newobj) + instsize;

    /*

     * dont argue about the goto and the arrangement below - it saves 

     * an extra nil-compare and branch in the common case ...

     * (i.e. if no GC is needed, we fall through without a branch)

     */

    if (nextPtr < newEndPtr) {

	_objPtr(newobj)->o_size = instsize;

	/* o_allFlags(newobj) = 0;              */

	/* _objPtr(newobj)->o_space = newSpace; */

	o_setAllFlags(newobj, newSpace);

#ifdef ALIGN4

	newNextPtr = nextPtr;

#else

	if (instsize & (ALIGN-1)) {

	    newNextPtr = (char *)newobj + (instsize & ~(ALIGN-1)) + ALIGN;

	} else {

	    newNextPtr = nextPtr;

	}

#endif

ok:

	_InstPtr(newobj)->o_class = self;

#ifndef PRE_16_03_95

	__STORE(newobj, self);

#endif

	if (nInstVars) {

#if defined(FAST_OBJECT_MEMSET4)

	    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);

#else

	    REGISTER OBJ *op;

	    op = _InstPtr(newobj)->i_instvars;

# if !defined(NEGATIVE_ADDRESSES)

	    /*

	     * knowing that nil is 0

	     */

#  if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)

	    if (nInstVars > 8) {

		*op++ = nil;    /* for alignment */

		nInstVars--;

		while (nInstVars >= 8) {

		    *(double *)op = 0.0;

		    ((double *)op)[1] = 0.0;

		    ((double *)op)[2] = 0.0;

		    ((double *)op)[3] = 0.0;

		    op += 8;

		    nInstVars -= 8;

		}

	    }

	    while (nInstVars != 0) {

		*op++ = 0;

		nInstVars--;

	    }

#  else

#   if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)

	    if (nInstVars > 8) {

		*op++ = nil;    /* for alignment */

		nInstVars--;

		while (nInstVars >= 8) {

		    *(long long *)op = 0;

		    ((long long *)op)[1] = 0;

		    ((long long *)op)[2] = 0;

		    ((long long *)op)[3] = 0;

		    op += 8;

		    nInstVars -= 8;

		}

	    }

	    while (nInstVars != 0) {

		*op++ = 0;

		nInstVars--;

	    }

#   else

#    if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)

	    while (nInstVars >= 8) {

		*op = nil;

		*(op+1) = nil;

		*(op+2) = nil;

		*(op+3) = nil;

		*(op+4) = nil;

		*(op+5) = nil;

		*(op+6) = nil;

		*(op+7) = nil;

		op += 8;

		nInstVars -= 8;

	    }

	    while (nInstVars != 0) {

		*op++ = nil;

		nInstVars--;

	    }

#    else

#     if defined(FAST_MEMSET)

	    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);

#     else

	    do {

		*op++ = nil;

		nInstVars--;

	    } while (nInstVars != 0);

#     endif

#    endif

#   endif

#  endif

# else /* nil could be ~~ 0 */

	    while (nInstVars >= 8) {

		*op = nil;

		*(op+1) = nil;

		*(op+2) = nil;

		*(op+3) = nil;

		*(op+4) = nil;

		*(op+5) = nil;

		*(op+6) = nil;

		*(op+7) = nil;

		op += 8;

		nInstVars -= 8;

	    }

	    while (nInstVars != 0) {

		*op++ = nil;

		nInstVars--;

	    }

# endif

#endif

	}

	RETURN ( newobj );

    }

    /*

     * the slow case - a GC will occur

     */

    PROTECT_CONTEXT

    newobj = new(instsize, SENDER);

    UNPROTECT_CONTEXT

    if (newobj != nil) goto ok;

%}

.

    "

     memory allocation failed.

     When we arrive here, there was no memory, even after

     a garbage collect. 

     This means, that the VM wanted to get some more memory from the 

     Operatingsystem, which was not kind enough to give it.

     Bad luck - you should increase the swap space on your machine.

    "

    ^ ObjectMemory allocationFailureSignal raise.

!

basicNew:anInteger

    "return an instance of myself with anInteger indexed variables.

     If the receiver-class has no indexed instvars, this is only allowed

     if the argument, anInteger is zero.

     ** Do not redefine this method in any class **"

%{  /* NOCONTEXT */

    OBJ newobj;

    unsigned INT instsize, nInstVars;

    INT nindexedinstvars;

    unsigned INT flags;

#if ! defined(FAST_ARRAY_MEMSET) || defined(NEGATIVE_ADDRESSES)

    REGISTER char *cp;

    short *sp;

    long *lp;

#endif

    REGISTER OBJ *op;

    float *fp;

    double *dp;

    extern OBJ new();

    if (__isSmallInteger(anInteger)) {

	nindexedinstvars = _intVal(anInteger);

	if (nindexedinstvars >= 0) {

	    nInstVars = _intVal(_INST(instSize));

	    flags = _intVal(_INST(flags)) & ARRAYMASK;

	    switch (flags) {

		case BYTEARRAY:

		    instsize = OHDR_SIZE + nindexedinstvars;

		    if (nInstVars == 0) {

			if (_CanDoQuickNew(instsize)) {

			    /*

			     * the most common case

			     */

			    _qCheckedNew(newobj, instsize);

			    _InstPtr(newobj)->o_class = self;

#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)

			    memset(_InstPtr(newobj)->i_instvars, 0, nindexedinstvars);

#else

			    cp = (char *)_InstPtr(newobj)->i_instvars;

			    while (nindexedinstvars >= sizeof(long)) {

				*(long *)cp = 0;

				cp += sizeof(long);

				nindexedinstvars -= sizeof(long);

			    }

			    while (nindexedinstvars--)

				*cp++ = '\0';

#endif

			    RETURN ( newobj );

			}

		    } else {

			instsize += __OBJS2BYTES__(nInstVars);

		    }

		    PROTECT_CONTEXT

		    _qNew(newobj, instsize, SENDER);

		    UNPROTECT_CONTEXT

		    if (newobj == nil) {

			break;

		    }

		    _InstPtr(newobj)->o_class = self;

#ifndef PRE_16_03_95

		    __STORE(newobj, self);

#endif

#if defined(FAST_ARRAY_MEMSET) && ! defined(NEGATIVE_ADDRESSES)

		    /*

		     * knowing that nil is 0

		     */

		    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);

#else