"

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

       instanceVariableNames:'superclass selectors methods

                              instSize flags'

       classVariableNames:''

       poolDictionaries:''

       category:'Kernel-Classes'

!

Behavior comment:'

COPYRIGHT (c) 1988-93 by Claus Gittinger

              All Rights Reserved

this class provides minimum support for all classes - additional stuff is

found in Class; Behaviors stuff has been extracted to make generation of

compact binaries possible.

(these do not need all of the functionality in Class)

Instance variables:

superclass  <Class>           the classes superclass

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

methods     <Array>           the inst-methods corresponding to the selectors

instSize    <SmallInteger>    the number of instance variables

flags       <SmallInteger>    special flag bits coded in a number

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

%W% %E%

written Dec 88 by claus

'!

!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 methodsFor:'initialization'!

initialize

    "to catch initialize for classes which do not"

    ^ self

!

reinitialize

    "to catch reinitialize for classes which do not"

    ^ self

! !

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

uninitializedNew

    "same as new"

    ^ self basicNew

!

uninitializedNew:anInteger

    "same as new:anInteger"

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

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

%{  /* NOCONTEXT */

    extern char *newNextPtr, *newEndPtr;

    OBJ newobj;

    int instsize;

    REGISTER int nInstVars;

#if !defined(memset4)

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

    REGISTER OBJ *op;

# endif

#endif

    nInstVars = _intVal(_INST(instSize));

    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);

    PROTECT(self);

    _qAlignedNew(newobj, instsize, SENDER);

    UNPROTECT(self);

    _InstPtr(newobj)->o_class = self;

    if (nInstVars) {

#if defined(memset4)

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

#else

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

        /*

         * knowing that nil is 0

         */

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

# else

        op = _InstPtr(newobj)->i_instvars;

        do {

            *op++ = nil;

        } while (--nInstVars);

# endif

#endif

    }

    RETURN ( newobj );

%}

!

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;

    INT instsize, nInstVars, nindexedinstvars;

    INT flags;

#if ! defined(FAST_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 + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(char);

		    PROTECT(self);

                    _qNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

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

                    /*

                     * knowing that nil is 0

                     */

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

#else

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

                    cp = (char *)op;

                    while (nindexedinstvars >= sizeof(long)) {

                        *(long *)cp = 0;

			cp += sizeof(long);

			nindexedinstvars -= sizeof(long);

		    }

                    while (nindexedinstvars--)

                        *cp++ = '\0';

#endif

                    RETURN ( newobj );

                    break;

                case WORDARRAY:

                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(short);

		    PROTECT(self);

                    _qNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

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

                    /*

                     * knowing that nil is 0

                     */

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

#else

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

                    sp = (short *)op;

                    while (nindexedinstvars--)

                        *sp++ = 0;

#endif

                    RETURN ( newobj );

                    break;

               case LONGARRAY:

                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(long);

		    PROTECT(self);

                    _qNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

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

                    /*

                     * knowing that nil is 0

                     */

                    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars + nindexedinstvars);

#else

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

                    /*

                     * knowing that nil is 0

                     */

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

# else

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

                    lp = (long *)op;

                    while (nindexedinstvars--)

                        *lp++ = 0;

# endif

#endif

                    RETURN ( newobj );

                    break;

               case FLOATARRAY:

                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(float);

		    PROTECT(self);

                    _qNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

                    fp = (float *)op;

                    while (nindexedinstvars--)

                        *fp++ = 0.0;

                    RETURN ( newobj );

                    break;

               case DOUBLEARRAY:

                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(double);

		    PROTECT(self);

                    _qNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

                    dp = (double *)op;

                    while (nindexedinstvars--)

                        *dp++ = 0.0;

                    RETURN ( newobj );

                    break;

                case WKPOINTERARRAY:

                case POINTERARRAY:

                    nInstVars += nindexedinstvars;

                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);

		    PROTECT(self);

                    _qAlignedNew(newobj, instsize, SENDER);

		    UNPROTECT(self);

                    _InstPtr(newobj)->o_class = self;

#if defined(memset4)

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

#else

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

                    /*

                     * knowing that nil is 0

                     */

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

# else

                    op = _InstPtr(newobj)->i_instvars;

                    while (nInstVars--)

                        *op++ = nil;

# endif

#endif

                    RETURN ( newobj );

                    break;

                default:

                    /*

                     * new:n for non-variable classes only allowed if

                     * n == 0

                     */

                    if (nindexedinstvars == 0) {

                        instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);

		        PROTECT(self);

                        _qAlignedNew(newobj, instsize, SENDER);

		        UNPROTECT(self);

                        _InstPtr(newobj)->o_class = self;

                        if (nInstVars) {

#if defined(memset4)

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

#else

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

                            /*

                             * knowing that nil is 0

                             */

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

# else

                            op = _InstPtr(newobj)->i_instvars;

                            do {

                                *op++ = nil;

                            } while (--nInstVars);

# endif

#endif

                        }

                        RETURN ( newobj );

                    }

                    break;

            }

        }

    }

%}

.

    (anInteger isMemberOf:SmallInteger) ifFalse:[

        self error:'argument to new: must be Integer'

    ] ifTrue:[

        (anInteger >= 0) ifTrue:[

            "sorry but this class has no indexed instvars - need 'new' "

            self error:'not indexed - cannot create with new:'

        ] ifFalse:[

            self error:'bad argument'

        ]

    ]

! !

!Behavior methodsFor:'accessing'!

superclass

    "return the receivers superclass"

    ^ superclass

!

selectors

    "return the receivers selector array"

    ^ selectors

!

methods

    "return the receivers method array"

    ^ methods

!

methodDictionary

    "return the receivers method dictionary - since no dictionary is

     used (for now) just return the method array"

    ^ methods

!

instSize

    "return the number of instance variables of the receiver"

    ^ instSize

!

flags

    "return the receivers flag bits"

    ^ flags

!

isVariable

    "return true, if instances have indexed instance variables"

    "this used to be defined as:

        ^ (flags bitAnd:16r0F) ~~ 0

     but then, changes in stc.h would not affect us here. Therefore:"

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false ); 

%}

!

isFixed

    "return true, if instances do not have indexed instance variables"

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true ); 

%}

!

isBits

    "return true, if instances have indexed byte or short instance variables.

     Ignore long, float and double arrays, since classes using isBits are probably

     not prepared to handle them correctly."

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    REGISTER int flags;

    RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)

	     || (flags == WORDARRAY)) ? true : false ); 

%}

!

isBytes

    "return true, if instances have indexed byte instance variables"

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false ); 

%}

!

isWords

    "return true, if instances have indexed short instance variables"

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false ); 

%}

!

isLongs

    "return true, if instances have indexed long instance variables"

%{  /* NOCONTEXT */

    /* this is defined as a primitive to get defines from stc.h */

    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false ); 

%}

!

isFloats

    "return true, if instances have indexed float instance variables"

%{  /* NOCONTEXT */

    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false ); 

%}

!

isDoubles

    "return true, if instances have indexed double instance variables"

%{  /* NOCONTEXT */

    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false ); 

%}

!

isPointers

    "return true, if instances have pointer instance variables"

    "question: should we ignore WeakPointers ?"

%{  /* NOCONTEXT */

    REGISTER int flags;

    RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == POINTERARRAY)

	     || (flags == WKPOINTERARRAY)) ? true : false ); 

%}

! !

!Behavior methodsFor:'queries'!

isBehavior

    "return true, if the receiver describing another objecs behavior

     i.e. is a class."

    ^ true

!

hasMultipleSuperclasses

    "NO multiple inheritance in this system"

    ^ false

!

superclasses

    "return a collection of the receivers immediate superclasses

     - since we have NO multiple inheritance, there is only one"

    ^ Array with:superclass

!

allSuperclasses

    "return a collection of the receivers accumulated superclasses"

    |aCollection theSuperClass|

    theSuperClass := superclass.

    theSuperClass notNil ifTrue:[

        aCollection := OrderedCollection new.

        [theSuperClass notNil] whileTrue:[

            aCollection add:theSuperClass.

            theSuperClass := theSuperClass superclass

        ]

    ].

    ^ aCollection

!

withAllSuperclasses