"

 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 selectors methods

                              instSize flags'

       classVariableNames:''

       poolDictionaries:''

       category:'Kernel-Classes'

!

Behavior comment:'

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

written Dec 88 by claus

'!

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

initialize

    "to catch initialize for classes which do not"

    ^ 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

    "same as new - only redefined in ByteArray"

    ^ self basicNew

!

uninitializedNew:anInteger

    "same as new:anInteger - only redefined in ByteArray"

    ^ 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 new();

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

    if (_CanDoQuickAlignedNew(instsize)) {

        _qCheckedAlignedNew(newobj, instsize);

        /* stupid: c-compilers should find this out themselfes ... */

        goto ok;

    } else {

        PROTECT_CONTEXT

        newobj = new(instsize, SENDER);

        UNPROTECT_CONTEXT

    }

    if (newobj != nil) {

ok:

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

    }

%}

.

    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;

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

            PROTECT_CONTEXT

            nInstVars = _intVal(_INST(instSize));

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

            switch (flags) {

                case BYTEARRAY:

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

                    _qNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                    _qNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                    _qAlignedNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                    _qNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                    _qNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                    _qAlignedNew(newobj, instsize, SENDER);

                    UNPROTECT_CONTEXT

                    if (newobj == nil) {

                        break;

                    }

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

                        _qAlignedNew(newobj, instsize, SENDER);

                        UNPROTECT_CONTEXT

                        if (newobj == nil) {

                            break;

                        }

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

            }

        }

    }

%}

.

    "arrive here if something went wrong ...

     figure out what"

    (anInteger isMemberOf:SmallInteger) ifFalse:[

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

    ] ifTrue:[

        (anInteger < 0) ifTrue:[

            self error:'bad (negative) argument to new'

        ] ifFalse:[

            self isVariable ifFalse:[

                self error:'class has no indexed instvars - cannot create with new:'

            ] ifTrue:[

                ObjectMemory allocationFailureSignal raise

            ]

        ]

    ]

!

readFrom:aStream

    "read an objects printed representation from the argument, aStream 

     and return it. 

     The read object must be a kind of myself 

     - to get any object, use 'Object readFrom:...',

       to get any number, use 'Number readFrom:...' and so on.

     This is the reverse operation to 'storeOn:'.

     Notice, that storeOn: does not handle circular references and

     multiple references to the same object - use storeBinary: for this."

    |newObject|

    newObject := Compiler evaluate:aStream.

    (newObject isKindOf:self) ifFalse:[

        self error:('expected ' , self name)

    ].

    ^ newObject

    "|s|

     s := WriteStream on:String new.

     #(1 2 3 4) storeOn:s.

     Object readFrom:(ReadStream on:s contents)  

    "

!

readFromString:aString

    "create an object from its printed representation

     (i.e. stored using storeOn: or storeString)"

    ^ self readFrom:(ReadStream on:aString)

! !

!Behavior methodsFor:'autoload check'!

isLoaded

    "return true, if the class has been loaded; 

     redefined in Autoload; see comment there"

    ^ true

!

autoload

    "force autoloading - do nothing here; 

     redefined in Autoload; see comment there"

    ^ self

! !

!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:"