added support for signedWord and signedLong indexable classes.
--- a/Behavior.st Tue Jul 02 10:21:24 1996 +0200
+++ b/Behavior.st Tue Jul 02 20:31:37 1996 +0200
@@ -442,6 +442,21 @@
"
!
+flagSignedLongs
+ "return the flag code for signed long-valued indexed instances (i.e. 4-byte).
+ You have to mask the flag value with indexMask when comparing
+ it with flagLongs."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __MKSMALLINT(SLONGARRAY) );
+%}
+ "
+ Behavior flagSignedLongs
+ "
+!
+
flagMethod
"return the flag code which marks Method-like instances.
You have to check this single bit in the flag value when
@@ -536,6 +551,52 @@
"
!
+flagSignedWords
+ "return the flag code for signed word-valued indexed instances (i.e. 2-byte).
+ You have to mask the flag value with indexMask when comparing
+ it with flagWords."
+
+%{ /* NOCONTEXT */
+ /* this is defined as a primitive to get defines from stc.h */
+
+ RETURN ( __MKSMALLINT(SWORDARRAY) );
+%}
+ "
+ Behavior flagSignedWords
+ "
+!
+
+flagForSymbolic:aSymbol
+ "return the flag code for indexed instances with aSymbolic type.
+ The argument may be one of #float, #double, #long, #word, #signedWord,
+ #signedLong or #byte."
+
+%{ /* NOCONTEXT */
+ if (aSymbol == @symbol(float)) {
+ RETURN ( __MKSMALLINT(FLOATARRAY) );
+ }
+ if (aSymbol == @symbol(double)) {
+ RETURN ( __MKSMALLINT(DOUBLEARRAY) );
+ }
+ if (aSymbol == @symbol(long)) {
+ RETURN ( __MKSMALLINT(LONGARRAY) );
+ }
+ if (aSymbol == @symbol(word)) {
+ RETURN ( __MKSMALLINT(WORDARRAY) );
+ }
+ if (aSymbol == @symbol(signedWord)) {
+ RETURN ( __MKSMALLINT(SWORDARRAY) );
+ }
+ if (aSymbol == @symbol(signedLong)) {
+ RETURN ( __MKSMALLINT(SLONGARRAY) );
+ }
+ if (aSymbol == @symbol(byte)) {
+ RETURN ( __MKSMALLINT(BYTEARRAY) );
+ }
+%}.
+ ^ 0 "/ not indexed
+!
+
maskIndexType
"return a mask to extract all index-type bits"
@@ -1630,6 +1691,7 @@
break;
case WORDARRAY:
+ case SWORDARRAY:
instsize = OHDR_SIZE +
__OBJS2BYTES__(nInstVars) +
nindexedinstvars * sizeof(short);
@@ -1659,6 +1721,7 @@
break;
case LONGARRAY:
+ case SLONGARRAY:
instsize = OHDR_SIZE +
__OBJS2BYTES__(nInstVars) +
nindexedinstvars * sizeof(long);
@@ -2787,17 +2850,23 @@
!
isLongs
- "return true, if instances have indexed long instance variables"
-
- "this could also be defined as:
- ^ (flags bitAnd:(Behavior maskIndexType)) == Behavior flagLongs
- "
+ "return true, if instances have indexed long instance variables (4 byte ints)"
+
%{ /* NOCONTEXT */
RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(LONGARRAY)) ? true : false );
%}
!
+isSignedLongs
+ "return true, if instances have indexed signed long instance variables (4 byte ints)"
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(SLONGARRAY)) ? true : false );
+%}
+!
+
isPointers
"return true, if instances have pointer instance variables
i.e. are either non-indexed or have indexed pointer variables"
@@ -2817,6 +2886,8 @@
case BYTEARRAY:
case WORDARRAY:
case LONGARRAY:
+ case SWORDARRAY:
+ case SLONGARRAY:
case FLOATARRAY:
case DOUBLEARRAY:
RETURN (false );
@@ -2879,6 +2950,15 @@
%}
!
+isSignedWords
+ "return true, if instances have indexed signed short instance variables"
+
+%{ /* NOCONTEXT */
+
+ RETURN ( (((INT)(__INST(flags)) & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(SWORDARRAY)) ? true : false );
+%}
+!
+
lookupMethodFor:aSelector
"return the method, which would be executed if aSelector was sent to
an instance of the receiver. I.e. the selector arrays of the receiver
@@ -2982,6 +3062,7 @@
break;
case WORDARRAY:
+ case SWORDARRAY:
nBytes += nIndex * sizeof(short);
if (nBytes & (ALIGN - 1)) {
nBytes = (nBytes & ~(ALIGN - 1)) + ALIGN;
@@ -2989,6 +3070,7 @@
break;
case LONGARRAY:
+ case SLONGARRAY:
nBytes += nIndex * sizeof(long);
break;
@@ -3181,6 +3263,6 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.80 1996-06-28 15:42:51 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.81 1996-07-02 18:30:51 cg Exp $'
! !
Behavior initialize!
--- a/Class.st Tue Jul 02 10:21:24 1996 +0200
+++ b/Class.st Tue Jul 02 20:31:37 1996 +0200
@@ -1775,7 +1775,15 @@
self isDoubles ifTrue:[
s := ' variableDoubleSubclass:#'
] ifFalse:[
- s := ' variableSubclass:#'
+ self isSignedWords ifTrue:[
+ s := ' variableSignedWordSubclass:#'
+ ] ifFalse:[
+ self isSignedLongs ifTrue:[
+ s := ' variableSignedLongSubclass:#'
+ ] ifFalse:[
+ s := ' variableSubclass:#'
+ ]
+ ]
]
]
]
@@ -3768,6 +3776,23 @@
poolDictionaries:s
category:cat
].
+ self isSignedWords ifTrue:[
+ ^ self
+ variableSignedWordSubclass:t
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ ].
+ self isSignedLongs ifTrue:[
+ ^ self
+ variableSignedLongSubclass:t
+ instanceVariableNames:f
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ ].
+
^ self
variableSubclass:t
instanceVariableNames:f
@@ -3932,11 +3957,63 @@
category:cat
comment:nil
changed:true
+!
+
+variableSignedWordSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s 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:t
+ inEnvironment:(Smalltalk currentNameSpace)
+ subclassOf:self
+ instanceVariableNames:f
+ variable:#signedWord
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:true
+!
+
+variableSignedLongSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s 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:t
+ inEnvironment:(Smalltalk currentNameSpace)
+ subclassOf:self
+ instanceVariableNames:f
+ variable:#signedLong
+ words:false
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:true
! !
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.161 1996-07-01 19:33:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.162 1996-07-02 18:31:37 cg Exp $'
! !
Class initialize!