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

    [author:]
        Claus Gittinger

    [see also:]
	Behavior Class Metaclass
"
! !

!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
    "return true if this class is known by the run-time-system.
     Here, true is returned for myself, false for subclasses."

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

    "Created: 15.4.1996 / 17:16:59 / cg"
    "Modified: 23.4.1996 / 15:56:54 / cg"
! !

!ClassDescription methodsFor:'accessing'!

category
    "return the category of the class. 
     The returned value may be a string or symbol."

    |owner|

    (owner := self owningClass) notNil ifTrue:[^ owner category].
    ^ category

    "
     Point category                
     Dictionary category           
    "

    "Modified: 15.10.1996 / 21:20:01 / cg"
!

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'
    or:[category = '* obsolete *']) ifTrue:[
        "add obsolete - to make life easier ..."
        more := ' (obsolete)'
    ].
    (category = 'removed'
    or:[category = '* removed *']) ifTrue:[
        "add removed - to make life easier ..."
        more := ' (removed)'
    ].

    self isPrivate ifTrue:[
        nm := self nameWithoutPrefix.
        more := ' (private in ' , self owningClass name , ')'.
    ] ifFalse:[
        nm := self name.
    ].
    more isNil ifTrue:[^ nm].
    ^ nm , more

    "Modified: 15.10.1996 / 20:01:30 / cg"
!

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'
      or:[category = '* removed *'
      or:[category = '* obsolete *']]]

    "Modified: 10.9.1996 / 14:02:07 / cg"
! !

!ClassDescription methodsFor:'renaming'!

renameTo:newName
    "change the name of the class"

    |oldSym newSym|

    oldSym := name asSymbol.
    newSym := newName asSymbol.
    self setName:newSym.

    Smalltalk at:oldSym put:nil.
    Smalltalk removeKey:oldSym.             "26.jun 93"
    Smalltalk at:newSym put:self.

    "Modified: 18.7.1996 / 11:26:46 / cg"
! !

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

subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver).
     The subclass will have indexed variables if the receiving-class has."

    self isVariable ifFalse:[
        ^ self class
            name:nameSymbol  
            inEnvironment:(Class nameSpaceQuerySignal raise)
            subclassOf:self
            instanceVariableNames:instVarNameString
            variable:false
            words:true
            pointers:true
            classVariableNames:classVarString
            poolDictionaries:pool
            category:cat
            comment:nil
            changed:true 
    ].
    ^ self 
        perform:(self definitionSelector)
        withArguments:(Array with:nameSymbol 
                           with:instVarNameString 
                           with:classVarString
                           with:pool 
                           with:cat).

    "Modified: 8.3.1997 / 00:41:08 / cg"
!

subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat inEnvironment:aNameSpace
    "create a new class as a subclass of an existing class (the receiver).
     The subclass will have indexed variables if the receiving-class has."

    self isVariable ifTrue:[
        Class nameSpaceQuerySignal handle:[:ex |
            ex proceedWith:aNameSpace
        ] do:[
            ^ self
                subclass:nameSymbol 
                instanceVariableNames:instVarNameString 
                classVariableNames:classVarString 
                poolDictionaries:pool 
                category:cat 
        ].
    ].
    ^ self class
        name:nameSymbol  
        inEnvironment:aNameSpace
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:false
        words:true
        pointers:true
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 8.2.1997 / 19:41:44 / cg"
    "Modified: 8.2.1997 / 20:03:52 / cg"
!

variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable byte-sized nonpointer variables"

    self isVariable ifTrue:[
        self isBytes ifFalse:[
            ^ self error:
                'cannot make a variable byte subclass of a variable non-byte class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:18 / cg"
    "Modified: 6.11.1996 / 22:48:18 / cg"
!

variableDoubleSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat

    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable double-sized nonpointer variables"

    self isVariable ifTrue:[
        self isDoubles ifFalse:[
            ^ self error:
                'cannot make a variable double subclass of a variable non-double class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#double 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:21 / cg"
    "Modified: 6.11.1996 / 22:48:22 / cg"
!

variableFloatSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat

    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable float-sized nonpointer variables"

    self isVariable ifTrue:[
        self isFloats ifFalse:[
            ^ self error:
                'cannot make a variable float subclass of a variable non-float class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#float 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:24 / cg"
    "Modified: 6.11.1996 / 22:48:26 / cg"
!

variableLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable long-sized nonpointer variables"

    self isVariable ifTrue:[
        self isLongs ifFalse:[
            ^ self error:
                'cannot make a variable long subclass of a variable non-long class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#long 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:27 / cg"
    "Modified: 6.11.1996 / 22:48:29 / cg"
!

variableSignedLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable signed long-sized nonpointer variables"

    self isVariable ifTrue:[
        self isSignedLongs ifFalse:[
            ^ self error:
                'cannot make a variable signed long subclass of a variable non-long class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#signedLong
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:31 / cg"
    "Modified: 6.11.1996 / 22:48:32 / cg"
!

variableSignedWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable word-sized signed nonpointer variables"

    self isVariable ifTrue:[
        self isSignedWords ifFalse:[
            ^ self error:
                'cannot make a variable signed word subclass of a variable non-word class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#signedWord
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:34 / cg"
    "Modified: 6.11.1996 / 22:48:35 / cg"
!

variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable pointer variables"

    self isVariable ifTrue:[
        self isPointers ifFalse:[
            ^ self error:
                'cannot make a variable pointer subclass of a variable non-pointer class'
        ]
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:false
        pointers:true
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:37 / cg"
    "Modified: 6.11.1996 / 22:48:40 / cg"
!

variableWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool category:cat
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable word-sized nonpointer variables"

    self isVariable ifTrue:[
        self isWords ifFalse:[
            ^ self error:
                'cannot make a variable word subclass of a variable non-word class'
        ].
    ].

    ^ self class
        name:nameSymbol
        inEnvironment:(Class nameSpaceQuerySignal raise)
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:true
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:cat
        comment:nil
        changed:true

    "Created: 12.10.1996 / 19:18:40 / cg"
    "Modified: 6.11.1996 / 22:48:43 / cg"
! !

!ClassDescription methodsFor:'subclass creation - private classes'!

subclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver).
     The subclass will have indexed variables if the receiving-class has."

    |newClass|

    self isVariable ifFalse:[
        newClass := self class
            name:nameSymbol
            inEnvironment:aClass
            subclassOf:self
            instanceVariableNames:instVarNameString
            variable:false
            words:true
            pointers:true
            classVariableNames:classVarString
            poolDictionaries:pool
            category:(aClass category)
            comment:nil
            changed:true.
        ^ newClass
    ].
    self isBytes ifTrue:[
        ^ self
            variableByteSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isLongs ifTrue:[
        ^ self
            variableLongSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isFloats ifTrue:[
        ^ self
            variableFloatSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isDoubles ifTrue:[
        ^ self
            variableDoubleSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isWords ifTrue:[
        ^ self
            variableWordSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isSignedWords ifTrue:[
        ^ self
            variableSignedWordSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].
    self isSignedLongs ifTrue:[
        ^ self
            variableSignedLongSubclass:nameSymbol
            instanceVariableNames:instVarNameString
            classVariableNames:classVarString
            poolDictionaries:pool
            privateIn:aClass
    ].

    ^ self
        variableSubclass:nameSymbol
        instanceVariableNames:instVarNameString
        classVariableNames:classVarString
        poolDictionaries:pool
        privateIn:aClass

    "Created: 11.10.1996 / 16:30:53 / cg"
    "Modified: 5.11.1996 / 23:05:22 / cg"
!

variableByteSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable byte-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isBytes ifFalse:[
            ^ self error:
                'cannot make a variable byte subclass of a variable non-byte class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:31:27 / cg"
    "Modified: 14.10.1996 / 17:39:42 / cg"
!

variableDoubleSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 

    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable double-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isDoubles ifFalse:[
            ^ self error:
                'cannot make a variable double subclass of a variable non-double class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#double 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:32:23 / cg"
    "Modified: 14.10.1996 / 17:39:45 / cg"
!

variableFloatSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 

    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable float-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isFloats ifFalse:[
            ^ self error:
                'cannot make a variable float subclass of a variable non-float class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#float 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:32:37 / cg"
    "Modified: 14.10.1996 / 17:39:50 / cg"
!

variableLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable long-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isLongs ifFalse:[
            ^ self error:
                'cannot make a variable long subclass of a variable non-long class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#long 
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:32:48 / cg"
    "Modified: 14.10.1996 / 17:39:54 / cg"
!

variableSignedLongSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable signed long-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isSignedLongs ifFalse:[
            ^ self error:
                'cannot make a variable signed long subclass of a variable non-long class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#signedLong
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:46:30 / cg"
    "Modified: 14.10.1996 / 17:39:58 / cg"
!

variableSignedWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable word-sized signed nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isSignedWords ifFalse:[
            ^ self error:
                'cannot make a variable signed word subclass of a variable non-word class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:#signedWord
        words:false
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:46:44 / cg"
    "Modified: 14.10.1996 / 17:40:01 / cg"
!

variableSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable pointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isPointers ifFalse:[
            ^ self error:
                'cannot make a variable pointer subclass of a variable non-pointer class'
        ]
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:false
        pointers:true
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:54:33 / cg"
    "Modified: 14.10.1996 / 17:40:06 / cg"
!

variableWordSubclass:nameSymbol instanceVariableNames:instVarNameString classVariableNames:classVarString poolDictionaries:pool privateIn:aClass 
    "create a new class as a subclass of an existing class (the receiver) 
     in which the subclass has indexable word-sized nonpointer variables"

    |newClass|

    self isVariable ifTrue:[
        self isWords ifFalse:[
            ^ self error:
                'cannot make a variable word subclass of a variable non-word class'
        ].
    ].

    newClass := self class
        name:nameSymbol
        inEnvironment:aClass
        subclassOf:self
        instanceVariableNames:instVarNameString
        variable:true
        words:true
        pointers:false
        classVariableNames:classVarString
        poolDictionaries:pool
        category:(aClass category)
        comment:nil
        changed:true.

    ^ newClass

    "Created: 11.10.1996 / 16:54:48 / cg"
    "Modified: 14.10.1996 / 17:40:09 / cg"
! !

!ClassDescription class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ClassDescr.st,v 1.41 1997-03-07 23:42:10 cg Exp $'
! !