"

 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 flags selectorArray methodArray

			      otherSuperclasses instSize'

       classVariableNames:'SubclassInfo'

       poolDictionaries:''

       category:'Kernel-Classes'

!

!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.52 1995-11-11 14:26:59 cg 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). 

    For ST-80 compatibility, this will be replaced by a single instance of

    MethodDictionary (which will NOT be a true dictionary, but an Array with

    alternating selector/method entries).

    To be prepared for this change, please do NOT directly use the methodArray 

    and selectorArray instVars.

    Instance variables:

	superclass        <Class>           the receivers superclass

	otherSuperclasses <Array of Class>  experimental: other superclasses

					    a hook for experimental multiple inheritance

					    implementations

	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

					    not for application use

    flag bits (see stc.h):

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

"

!

virtualMachineRelationship 

"

    NOTICE: 

	the stuff described below may not be available on other

	Smalltalk implementations; be aware that these error mechanisms

	are ST/X specials and applications using these (tricks) may

	not be portable to other systems.

    WARNING: 

	do not try the examples below on (some) other smalltalk systems;

	it has been reported, that some crash badly when doing this .... ;-)

    Instances of Behavior and subclasses (i.e. in sloppy words: classes)

    play a special role w.r.t. the VM. Only objects whose class-slot is marked

    as being behaviorLike (in the flag-instvar) are considered to be classLike

    and a message lookup will be done for it in the well known way.

    Thus, if an object has a class for which its class does NOT have

    this flag bit set, the VM will trigger an error on a message send.

    Why is this so:

    the above lets every object play the role of a class,

    which has been flagged as behaviorLike in its class's flag.

    Thus, you can create arbitrary new classLike objects and have the VM 

    play with them.

    This may offer the flexibility to create a totally different object scheme

    on top of ST/X (for example: Self like objects) where any object can play

    a classRole for another object.

    However, the VM trusts the isBehaviorLike flag - if it is set for some

    object, it expects the object selector and methodDictionaries to be found

    at the instance positions as defined here.

    (i.e. instanceVariables with contents and semantic corresponding to

	superclass flags selectorArray methodArray

     must be present and have the same instVar-index as here).

    The VM (and the system) may crash badly, if this is not the case.

    Since every class in the system derives from Behavior, the flag setting

    (and instance variable layout) is correct for all 'normal' classes.

    If you experiment by creating new behaviorLike objects, please take

    care of this flag. If you want to use the VM's lookup function, the

    instVars  'superclass', 'selectorArray' and 'methodArray' are required

    and have to be at the same instVar index.

    (we suggest, you subclass Behavior, to make certain)

    You do not have to care about the above details if you are a 'normal'

    ST-programmer, though.

    Examples (only of theoretical interrest):

	take away the behaviorLike-flag from a class.

	-> The instances will not understand any messages, since the VM will

	   not recognize its class as being a class ...

	|newMeta notRecognizedAsClass someInstance|

	newMeta := Metaclass new.

	newMeta flags:0.

	notRecognizedAsClass := newMeta new.

	someInstance := notRecognizedAsClass new.

	someInstance perform:#isNil

    Of course, this is an exception which can be handled ...:

    Example:

	|newMeta notRecognizedAsClass someInstance|

	newMeta := Metaclass new.

	newMeta flags:0.

	notRecognizedAsClass := newMeta new.

	someInstance := notRecognizedAsClass new.

	Object errorSignal handle:[:ex |

	    ex return

	] do:[

	    someInstance perform:#isNil

	]

    likewise, a doesNotUnderstand-notUnderstood can be handled:

    Example:

	|newMeta funnyClass someInstance|

	newMeta := Metaclass new.

	funnyClass := newMeta new.

	funnyClass setSuperclass:nil.

	someInstance := funnyClass new.

	Object errorSignal handle:[:ex |

	     ex return

	] do:[

	    someInstance perform:#isNil

	]

    more examples, which try to trick the VM ;-):

	badly playing around with a classes internals ...

	|newClass someInstance|

	newClass := Class new.

	newClass setSelectorArray:nil.

	someInstance := newClass new.

	someInstance inspect

	|newClass someInstance|

	newClass := Class new.

	newClass setSuperclass:nil.

	someInstance := newClass new.

	someInstance inspect

	|newClass someInstance|

	newClass := Class new.

	newClass setSuperclass:newClass.

	someInstance := newClass new.

	someInstance inspect

	|newClass someInstance|

	newClass := Class new.

	newClass setSuperclass:1.

	someInstance := newClass new.

	someInstance inspect

    Example:

	creating totally anonymous classes:

	|newClass someInstance|

	newClass := Class new.

	someInstance := newClass new.

	someInstance inspect

    Example:

	creating totally anonymous metaclasses:

	|newMeta newClass someInstance|

	newMeta := Metaclass new.

	newClass := newMeta new.

	someInstance := newClass new.

	someInstance inspect

    PS: if you experiment with new behaviorLike objects, you may want 

	to turn off the VM's debugPrintouts

	with: 

		'Smalltalk debugPrinting:false'

	and: 

		'Smalltalk infoPrinting:false'

"

! !

!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 behavior (which is like a class,

     but without the symbolic & name information).

     Not for normal applications.

     Sending the returned behavior the #new message gives you

     an instance if it.

     Notice: the returned class is given a superclass of Object;

     this allows for its new instances to be inspected and the like."

    |newClass|

    newClass := self basicNew.

    newClass setSuperclass:Object

		 selectors:#() "/ (Array new:0)

		   methods:#() "/ (Array new:0)

		  instSize:0

		     flags:(self flagBehavior).

    ^ newClass

    "

     Behavior new               <- a new behavior

     Behavior new new           <- an instance of it

     ClassDescription new       <- a new classDescription

     ClassDescription new new   <- an instance of it

     Class new                  <- a new class

     Class new new              <- an instance of it

     Metaclass new              <- a new metaclass

     Metaclass new new          <- an instance (i.e. a class) of it

     Metaclass new new new      <- an instance of this new class

    "

! !

!Behavior class methodsFor:'private '!

subclassInfo

    |d|

    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

    "initialize is sent to a class either during startup,

     (for all statically compiled-in classes) or after a class

     has been loaded into the system (either bytecodes or machinecode).

     The default action here is to do nothing."

    ^ self

!

postAutoload

    "postAutoload is sent to a class after it has been autoloaded.

     This gives it a chance to arrange for automatic unloading to be done

     after a while ...

     This is NOT sent to statically compiled in or explicitely filedIn

     classes.

     The default action here is to do nothing."

    ^ self

!

reinitialize

    "reinitialize is sent to a class when an image has been restarted.

     I.e. when the system is restarted.

     This gives classes a chance to flush any device dependent or otherwise

     obsolete data which may be a leftover from the previous live.

     The default action here is to do nothing."

    ^ self

!

deinitialize

    "deinitialize is sent to a class before it is physically unloaded.

     This is only done with classes which have been loaded in from a binary

     file. Classes may release any primitive memory or other stuff which is

     not visible to smalltalk (for example, release internal memory).

     The default action here is to do nothing."

    ^ 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:'instance creation'!

uninitializedNew

    "create an instance of myself with uninitialized contents.

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

    ^ self basicNew

!

uninitializedNew:anInteger

    "create an instance of myself with uninitialized contents.

     For all classes except ByteArray, this is the same as #basicNew:."

    ^ 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 */

    REGISTER OBJ newobj;

    REGISTER char *nextPtr;

    unsigned int instsize;

    REGISTER unsigned int nInstVars;

    extern OBJ __new();

    /*

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