"

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

"

Behavior subclass:#ClassDescription

	instanceVariableNames:'name category instvars primitiveSpec signature'

	classVariableNames:''

	poolDictionaries:''

	category:'Kernel-Classes'

!

!ClassDescription class methodsFor:'documentation'!

copyright

"

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

"

    this class has been added for ST-80 compatibility only.

    All class stuff used to be in Behavior and Class - but, to be

    able to file in some PD code, it became nescessary to add C'Description

    in between it.

    ClassDescription adds some descriptive information to the basic

    Behavior class.

    Instance variables:

	name            <Symbol>            the classes name

	category        <String | Symbol>   the classes category

	instvars        <String>            the names of the instance variables

	primitiveSpec   <Array | nil>       describes primitiveIncludes, primitiveFunctions etc.

	signature       <SmallInteger>      the classes signature (used to detect obsolete

					    or changed classes with binaryStorage)

					    This is filled in lazy - i.e. upon the first signature query.

"

! !

!ClassDescription class methodsFor:'instance creation'!

new

    "creates and returns a new class.

     Redefined to give the new class at least some name info"

    |newClass|

    newClass := super new.

    newClass setName:('some' , self name).

    ^ newClass

! !

!ClassDescription class methodsFor:'queries'!

isBuiltInClass

    ^ self == ClassDescription class or:[self == ClassDescription]

    "Created: 15.4.1996 / 17:16:59 / cg"

! !

!ClassDescription methodsFor:'accessing'!

category

    "return the category of the class. 

     The returned value may be a string or symbol."

    ^ category

    "

     Point category                

     Dictionary category           

    "

!

category:aStringOrSymbol

    "set the category of the class to be the argument, aStringOrSymbol"

    aStringOrSymbol isNil ifTrue:[

	category := aStringOrSymbol

    ] ifFalse:[

	category := aStringOrSymbol asSymbol

    ]

!

instVarAtOffset:index

    "return the name of the instance variable at index"

    ^ self allInstanceVariableNames at:index

!

instVarNames

    "return a collection of the instance variable name-strings"

    instvars isNil ifTrue:[

	^ OrderedCollection new

    ].

    ^ instvars asCollectionOfWords

    "

     Point instVarNames  

    "

!

instVarOffsetOf:aVariableName

    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance

     variable. The returned number is 1..instSize for valid variable names, nil for

     illegal names."

    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil

!

instanceVariableOffsets

    "returns a dictionary containing the instance variable index

     for each instVar name"

    |dict index|

    index := 0. dict := Dictionary new.

    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].

    ^ dict

    "

     Point instanceVariableOffsets 

     GraphicsContext instanceVariableOffsets 

    "

!

instanceVariableString

    "return a string of the instance variable names"

    instvars isNil ifTrue:[^ ''].

    ^ instvars

    "

     Point instanceVariableString   

    "

!

name

    "return the name of the class. In the current implementation,

     this returns a string, but will be changed to Symbol soon."

    ^ name

!

organization

    "for ST80 compatibility; 

     read the documentation in ClassOrganizer for more info."

    ^ ClassOrganizer for:self

! !

!ClassDescription methodsFor:'printing & storing'!

displayString

    "return a string for display in inspectors"

    |nm more|

    category == #obsolete ifTrue:[

	"add obsolete - to make life easier ..."

	more := ' (obsolete)'

    ].

    category == #removed ifTrue:[

	"add removed - to make life easier ..."

	more := ' (removed)'

    ].

    nm := self name.

    more isNil ifTrue:[^ nm].

    ^ nm , more    

!

isObsolete 

    "return true, if the receiver is obsolete 

     (i.e. has been replaced by a different class or was removed, 

      but is still referenced by instanced)"

    ^ category == #obsolete or:[category == #removed]

! !

!ClassDescription methodsFor:'renaming'!

renameTo:newName

    "change the name of the class"

    |oldSym|

    oldSym := name asSymbol.

    self setName:newName.

    Smalltalk at:oldSym put:nil.

    Smalltalk removeKey:oldSym.             "26.jun 93"

    Smalltalk at:(newName asSymbol) put:self.

! !

!ClassDescription methodsFor:'signature checking'!

classinstSizeFromSignature:aSignature

    "for checking class compatibility: return some number based on 

     the classinstSize from a signature key (not always the real classinstsize)."

    ^ (aSignature bitShift:-7) bitAnd:7

!

instNameKeyFromSignature:aSignature

    "for checking class compatibility: return a number based on the

     names and order of the instance variables from a signature key."

    ^ (aSignature bitShift:-14) bitAnd:16rFFFF

    "

     Point instNameKeyFromSignature:Point signature.             

     Association instNameKeyFromSignature:Association signature.  

    "

!

instSizeFromSignature:aSignature

    "for checking class compatibility: return the some number based on

     the instSize from a signature key (not always the real instSize)."

    ^ aSignature bitAnd:16r7F

    "

     Class instSizeFromSignature:Point signature.     

     Class instSizeFromSignature:Association signature.   

     Class instSizeFromSignature:Dictionary signature.    

    "

!

instTypeFromSignature:aSignature

    "for checking class compatibility: return some number based on

     the instType (i.e. variableBytes/Pointers etc.) from a signature key."

    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)

    "

     Class instTypeFromSignature:Object signature.               

     Class instTypeFromSignature:Array signature.                

     Class instTypeFromSignature:String signature.               

     Class instTypeFromSignature:OrderedCollection signature.    

    "

!

signature

    "return a signature number - this number is useful for a quick

     check for changed classes, and is done in the binary-object loader, 

     and the dynamic class loader.

     Do NOT change the algorithm here - others may depend on it.

     Also, the algorithm may change - so never interpret the returned value

     (if at all, use the access #XXXFromSignature: methods)"

    |value   "{ Class: SmallInteger }"

     nameKey "{ Class: SmallInteger }" |

    signature notNil ifTrue:[^ signature].

    value := self flags bitAnd:(Class maskIndexType).

    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).

    value := (value bitShift:7) + (self instSize bitAnd:16r7F).

    nameKey := 0.

    self allInstVarNames do:[:name |

	nameKey := nameKey bitShift:1.

	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[

	    nameKey := nameKey bitXor:1.

	    nameKey := nameKey bitAnd:16rFFFF.

	].

	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.

    ].

    value := value + (nameKey bitShift:14).

    signature := value.

    ^ value

    "

     Array signature

     ByteArray signature

     View signature

    "

! !

!ClassDescription methodsFor:'special accessing'!

setInstanceVariableString:aString

    "set the classes instvarnames string - no recompilation

     or updates are done and no changeList records are written.

     This is NOT for general use."

    instvars := aString.

!

setName:aString

    "set the classes name - be careful, it will be still

     in the Smalltalk dictionary - under another key.

     This is NOT for general use - see renameTo:"

    name := aString

! !

!ClassDescription class methodsFor:'documentation'!

version

! !