# HG changeset patch # User Claus Gittinger # Date 836332297 -7200 # Node ID 4ac06d3251a8dbad1c5859bc9ce4ed29a3fae1f3 # Parent a4b4c4ce039c1059d81f06422e08824288863934 added support for signedWord and signedLong indexable classes. diff -r a4b4c4ce039c -r 4ac06d3251a8 Behavior.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! diff -r a4b4c4ce039c -r 4ac06d3251a8 Class.st --- 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!