"
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:'printOut'!
printHierarchyAnswerIndentOn:aStream
"print my class hierarchy on aStream - return indent
recursively calls itself to print superclass and use returned indent
for my description - used in the browser"
|indent nm|
indent := 0.
(superclass notNil) ifTrue:[
indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
].
aStream spaces:indent.
nm := self printNameInHierarchy.
aStream nextPutAll:nm; nextPutAll:' ('.
self printInstVarNamesOn:aStream indent:(indent + nm size + 2).
aStream nextPutLine:')'.
^ indent
"Created: 22.3.1997 / 14:11:29 / cg"
"Modified: 22.3.1997 / 14:15:42 / cg"
!
printHierarchyOn:aStream
"print my class hierarchy on aStream"
self printHierarchyAnswerIndentOn:aStream
"Created: 22.3.1997 / 14:11:13 / cg"
!
printInstVarNamesOn:aStream indent:indent
"print the instance variable names indented and breaking at line end"
self printNameArray:(self instVarNames) on:aStream indent:indent
"Created: 22.3.1997 / 14:12:00 / cg"
!
printNameArray:anArray on:aStream indent:indent
"print an array of strings separated by spaces; when the stream
defines a lineLength, break when this limit is reached; indent
every line; used to printOut instance variable names"
|thisName nextName arraySize lenMax pos mustBreak line spaces|
arraySize := anArray size.
arraySize ~~ 0 ifTrue:[
pos := indent.
lenMax := aStream lineLength.
thisName := anArray at:1.
line := ''.
1 to:arraySize do:[:index |
line := line , thisName.
pos := pos + thisName size.
(index == arraySize) ifFalse:[
nextName := anArray at:(index + 1).
mustBreak := false.
(lenMax > 0) ifTrue:[
((pos + nextName size) > lenMax) ifTrue:[
mustBreak := true
]
].
mustBreak ifTrue:[
aStream nextPutLine:line withTabs.
spaces isNil ifTrue:[
spaces := String new:indent
].
line := spaces.
pos := indent
] ifFalse:[
line := line , ' '.
pos := pos + 1
].
thisName := nextName
]
].
aStream nextPutAll:line withTabs
]
"Modified: 9.11.1996 / 00:12:06 / cg"
"Created: 22.3.1997 / 14:12:12 / cg"
!
printNameInHierarchy
"return my name as printed in the hierarchy"
^ self name
"Created: 22.3.1997 / 14:15:36 / cg"
! !
!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. Warning: this does not write a change record."
|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.43 1997-04-01 16:04:28 ca Exp $'
! !