added support for signedWord and signedLong indexable classes.
authorClaus Gittinger <cg@exept.de>
Tue, 02 Jul 1996 20:31:37 +0200
changeset 1514 4ac06d3251a8
parent 1513 a4b4c4ce039c
child 1515 49a8587fcc8f
added support for signedWord and signedLong indexable classes.
Behavior.st
Class.st
--- 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!