--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SmallInt.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,1362 @@
+"
+ COPYRIGHT (c) 1988-93 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.
+"
+
+Integer subclass:#SmallInteger
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Magnitude-Numbers'
+!
+
+SmallInteger comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+SmallIntegers are Integers in the range of +/- 2^30 (i.e. 31 bits).
+These are no real objects - they have no instances (not even storage !)
+and cannot be subclassed (sorry)
+
+The reason is to save both storage and runtime by not collecting
+SmallIntegers in the system. SmallInts are marked by having the TAG_INT
+bit set in contrast to Objects which have not. Since this knowledge is
+hardwired into the system (an there is no class-field stored with
+SmallIntegers) there can be no subclass of SmallInteger (sorry).
+'!
+
+!SmallInteger class methodsFor:'instance creation'!
+
+basicNew
+ "catch instance creation
+ - SmallIntegers cannot be created with new"
+
+ self error:'instances of SmallInteger cannot be created with new'
+!
+
+basicNew:size
+ "catch instance creation
+ - SmallIntegers cannot be created with new"
+
+ self error:'instances of SmallInteger cannot be created with new'
+! !
+
+!SmallInteger class methodsFor:'constants'!
+
+maxBits
+ "return the number of bits in instances of me"
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKSMALLINT(N_INT_BITS) );
+%}
+!
+
+maxBytes
+ "return the number of bytes in instances of me"
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKSMALLINT(N_INT_BITS / 8 + 1) );
+%}
+!
+
+minVal
+ "return the smallest Integer representable as SmallInteger"
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKSMALLINT(_MIN_INT) );
+%}
+!
+
+maxVal
+ "return the largest Integer representable as SmallInteger"
+
+%{ /* NOCONTEXT */
+ RETURN ( _MKSMALLINT(_MAX_INT) );
+%}
+! !
+
+!SmallInteger methodsFor:'error catching'!
+
+at:index
+ "catch indexed access - report an error
+ defined here since at: in Object ommits the SmallInteger check"
+
+ self notIndexed
+!
+
+basicAt:index
+ "catch indexed access - report an error
+ defined here since basicAt: in Object ommits the SmallInteger check"
+
+ self notIndexed
+!
+
+at:index put:anObject
+ "catch indexed access - report an error
+ defined here since at:put: in Object ommits the SmallInteger check"
+
+ self notIndexed
+!
+
+basicAt:index put:anObject
+ "catch indexed access - report an error
+ defined here since basicAt:put: in Object ommits the SmallInteger check"
+
+ self notIndexed
+!
+
+size
+ "return the number of indexed instvars - SmallIntegers have none
+ defined here since size in Object ommits the SmallInteger check"
+
+ ^ 0
+!
+
+basicSize
+ "return the number of indexed instvars - SmallIntegers have none
+ defined here since basicSize in Object ommits the SmallInteger check"
+
+ ^ 0
+! !
+
+!SmallInteger methodsFor:'copying'!
+
+shallowCopy
+ "return a shallow copy of myself
+ - reimplemented here since numbers are unique"
+
+ ^ self
+!
+
+deepCopy
+ "return a deep copy of myself
+ - reimplemented here since numbers are unique"
+
+ ^ self
+! !
+
+!SmallInteger methodsFor:'comparing'!
+
+= aNumber
+ "return true, if the arguments value is equal to mine"
+
+%{ /* NOCONTEXT */
+
+ if (aNumber == self) {
+ RETURN ( true );
+ }
+ if (! _isNonNilObject(aNumber)) {
+ RETURN ( false );
+ }
+
+ if (_qClass(aNumber) == Float) {
+ RETURN ( ((double)_intVal(self) == _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ aNumber respondsToArithmetic ifFalse:[^ false].
+ ^ self retry:#= coercing:aNumber
+!
+
+~= aNumber
+ "return true, if the arguments value is not equal to mine"
+
+%{ /* NOCONTEXT */
+
+ if (aNumber == self) {
+ RETURN ( false );
+ }
+ if (! _isNonNilObject(aNumber)) {
+ RETURN ( true );
+ }
+
+ if (_qClass(aNumber) == Float) {
+ RETURN ( ((double)_intVal(self) == _floatVal(aNumber)) ? false : true );
+ }
+%}
+.
+ aNumber respondsToArithmetic ifFalse:[^ true].
+ ^ self retry:#~= coercing:aNumber
+!
+
+< aNumber
+ "return true, if the argument is greater than the receiver"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) < _intVal(aNumber)) ? true : false );
+#else
+ /* tag bit does not change ordering */
+ RETURN ( ((INT)self < (INT)aNumber) ? true : false );
+#endif
+ }
+ if (_isFloat(aNumber)) {
+ RETURN ( ((double)_intVal(self) < _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ aNumber lessFromInteger:self
+ "^ self retry:#< coercing:aNumber"
+!
+
+> aNumber
+ "return true, if the argument is less than the receiver"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) > _intVal(aNumber)) ? true : false );
+#else
+ /* tag bit does not change ordering */
+ RETURN ( ((INT)self > (INT)aNumber) ? true : false );
+#endif
+ }
+ if (_isFloat(aNumber)) {
+ RETURN ( ((double)_intVal(self) > _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#> coercing:aNumber
+!
+
+>= aNumber
+ "return true, if the argument is less or equal"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) >= _intVal(aNumber)) ? true : false );
+#else
+ /* tag bit does not change ordering */
+ RETURN ( ((INT)self >= (INT)aNumber) ? true : false );
+#endif
+ }
+ if (_isFloat(aNumber)) {
+ RETURN ( ((double)_intVal(self) >= _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#>= coercing:aNumber
+!
+
+<= aNumber
+ "return true, if the argument is greater or equal"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) <= _intVal(aNumber)) ? true : false );
+#else
+ /* tag bit does not change ordering */
+ RETURN ( ((INT)self <= (INT)aNumber) ? true : false );
+#endif
+ }
+ if (_isFloat(aNumber)) {
+ RETURN ( ((double)_intVal(self) <= _floatVal(aNumber)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#<= coercing:aNumber
+!
+
+identityHash
+ "return an integer useful for hashing on identity"
+
+ self > 0 ifTrue:[
+ ^ self + 8192
+ ].
+ ^ self negated + 8192
+!
+
+min:aNumber
+ "return the receiver or the argument, whichever is smaller"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ if (_intVal(self) < _intVal(aNumber)) {
+#else
+ /* tag bit does not change ordering */
+ if ((INT)(self) < (INT)(aNumber)) {
+#endif
+ RETURN ( self );
+ }
+ RETURN ( aNumber );
+ }
+ if (_isFloat(aNumber)) {
+ if ( (double)_intVal(self) < _floatVal(aNumber) ) {
+ RETURN ( self );
+ }
+ RETURN ( aNumber );
+ }
+%}
+.
+ (self < aNumber) ifTrue:[^ self].
+ ^ aNumber
+!
+
+max:aNumber
+ "return the receiver or the argument, whichever is greater"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef POSITIVE_ADDRESSES
+ if (_intVal(self) > _intVal(aNumber)) {
+#else
+ /* tag bit does not change ordering */
+ if ((INT)(self) > (INT)(aNumber)) {
+#endif
+ RETURN ( self );
+ }
+ RETURN ( aNumber );
+ }
+ if (_isFloat(aNumber)) {
+ if ( (double)_intVal(self) > _floatVal(aNumber) ) {
+ RETURN ( self );
+ }
+ RETURN ( aNumber );
+ }
+%}
+.
+ (self > aNumber) ifTrue:[^ self].
+ ^ aNumber
+! !
+
+!SmallInteger methodsFor:'testing'!
+
+negative
+ "return true, if the receiver is less than zero
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) < 0) ? true : false );
+#else
+ /* tag bit does not change sign */
+ RETURN ( ((INT)(self) < 0) ? true : false );
+#endif
+%}
+!
+
+positive
+ "return true, if the receiver is not negative
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) >= 0) ? true : false );
+#else
+ /* tag bit does not change sign */
+ RETURN ( ((INT)(self) >= 0) ? true : false );
+#endif
+%}
+!
+
+strictlyPositive
+ "return true, if the receiver is greater than zero
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( (_intVal(self) > 0) ? true : false );
+#else
+ /* tag bit does not change sign */
+ RETURN ( ((INT)(self) > 0) ? true : false );
+#endif
+%}
+!
+
+sign
+ "return the sign of the receiver
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+ INT val = _intVal(self);
+
+ if (val < 0) {
+ RETURN ( _MKSMALLINT(-1) );
+ }
+ if (val > 0) {
+ RETURN ( _MKSMALLINT(1) );
+ }
+ RETURN ( _MKSMALLINT(0) );
+%}
+!
+
+between:min and:max
+ "return true if the receiver is less than or equal to the argument max
+ and greater than or equal to the argument min.
+ - reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(min) && _isSmallInteger(max)) {
+ REGISTER INT selfVal;
+
+ selfVal = _intVal(self);
+ if (selfVal < _intVal(min)) {
+ RETURN ( false );
+ }
+ if (selfVal > _intVal(max)) {
+ RETURN ( false );
+ }
+ RETURN ( true );
+ }
+%}
+.
+ (self < min) ifTrue:[^ false].
+ (self > max) ifTrue:[^ false].
+ ^ true
+!
+
+even
+ "return true, if the receiver is even"
+
+%{ /* NOCONTEXT */
+
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( ((INT)self & 1) ? false : true );
+#else
+ RETURN ( ((INT)self & ((INT)_MKSMALLINT(1) & ~TAG_INT)) ? false : true );
+#endif
+%}
+!
+
+odd
+ "return true, if the receiver is odd"
+
+%{ /* NOCONTEXT */
+
+#ifdef POSITIVE_ADDRESSES
+ RETURN ( ((INT)self & 1) ? true : false );
+#else
+ RETURN ( ((INT)self & ((INT)_MKSMALLINT(1) & ~TAG_INT)) ? true : false );
+#endif
+%}
+! !
+
+!SmallInteger methodsFor:'arithmetic'!
+
++ aNumber
+ "return the sum of the receivers value and the arguments value"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef _ADD_IO_IO
+ RETURN ( _ADD_IO_IO(self, aNumber) );
+#else
+ REGISTER INT sum;
+ extern OBJ _makeLarge();
+
+ sum = _intVal(self) + _intVal(aNumber);
+ if ((sum >= _MIN_INT) && (sum <= _MAX_INT)) {
+ RETURN ( _MKSMALLINT(sum) );
+ }
+ RETURN ( _makeLarge(sum) );
+#endif
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ extern char *newNextPtr, *newEndPtr;
+ OBJ newFloat;
+ double val;
+
+ val = _floatVal(aNumber);
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = (double)(_intVal(self)) + val;
+ RETURN ( newFloat );
+ }
+%}
+.
+ ^ aNumber sumFromInteger:self
+!
+
+- aNumber
+ "return the difference of the receivers value and the arguments value"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+#ifdef _SUB_IO_IO
+ RETURN ( _SUB_IO_IO(self, aNumber) );
+#else
+ REGISTER INT diff;
+ extern OBJ _makeLarge();
+
+ diff = _intVal(self) - _intVal(aNumber);
+ if ((diff >= _MIN_INT) && (diff <= _MAX_INT)) {
+ RETURN ( _MKSMALLINT(diff) );
+ }
+ RETURN ( _makeLarge(diff) );
+#endif
+ }
+ if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ extern char *newNextPtr, *newEndPtr;
+ OBJ newFloat;
+ double val;
+
+ val = _floatVal(aNumber);
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = (double)(_intVal(self)) - val;
+ RETURN ( newFloat );
+ }
+%}
+.
+ ^ aNumber differenceFromInteger:self
+!
+
+* aNumber
+ "return the product of the receivers value and the arguments value"
+
+ |aLarge|
+
+%{ /* NOCONTEXT */
+
+ REGISTER INT myValue, otherValue;
+ unsigned INT pHH, pHL, pLH, pLL;
+
+ if (_isSmallInteger(aNumber)) {
+ /* this is too slow:
+ * since most machines can do 32*32 to 64 bit multiply,
+ * (or at least 32*32 with Overflow check)
+ * its better to do it this way .. - need an assembler (inline) function here
+ */
+ myValue = _intVal(self);
+ if (myValue < 0) myValue = -myValue;
+ otherValue = _intVal(aNumber);
+ if (otherValue < 0) otherValue = -otherValue;
+#ifdef NOTDEF
+ if (! ((myValue & ~0x7FFF) || (otherValue & ~0x7FFF))) {
+#else
+ pHH = ((myValue >> 16) & 0xFFFF) * ((otherValue >> 16) & 0xFFFF);
+ pHL = ((myValue >> 16) & 0xFFFF) * (otherValue & 0xFFFF);
+ pLH = (myValue & 0xFFFF) * ((otherValue >> 16) & 0xFFFF);
+ pLL = (myValue & 0xFFFF) * (otherValue & 0xFFFF);
+ if (! (pHH || (pHL & 0xFFFFc000) || (pLH & 0xFFFFc000) || (pLL & 0xc0000000))) {
+#endif
+ RETURN ( _MKSMALLINT(_intVal(self) * _intVal(aNumber)) );
+ }
+ } else if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
+ extern char *newNextPtr, *newEndPtr;
+ OBJ newFloat;
+ double val;
+
+ val = _floatVal(aNumber);
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = (double)(_intVal(self)) * val;
+ RETURN ( newFloat );
+ }
+%}
+.
+%{
+ extern OBJ LargeInteger, __mu, _value_;
+ static struct inlineCache val = _ILC1;
+ static struct inlineCache mu = _ILC1;
+
+ if (_isSmallInteger(aNumber)) {
+ /*
+ * non overflow case has already been checked
+ */
+#ifdef PASS_ARG_REF
+ aLarge = (*val.ilc_func)(LargeInteger, _value_, CON_COMMA nil, &val, &self);
+ RETURN ( (*mu.ilc_func)(aLarge, __mu, CON_COMMA nil, &mu, &aNumber) );
+#else
+ aLarge = (*val.ilc_func)(LargeInteger, _value_, CON_COMMA nil, &val, self);
+ RETURN ( (*mu.ilc_func)(aLarge, __mu, CON_COMMA nil, &mu, aNumber) );
+#endif
+ }
+%}
+.
+ ^ aNumber productFromInteger:self
+!
+
+/ aNumber
+ "return the quotient of the receivers value and the arguments value"
+
+%{ /* NOCONTEXT */
+
+ INT me, t, val;
+ double dval;
+
+ if (_isSmallInteger(aNumber)) {
+ val = _intVal(aNumber);
+ if (val != 0) {
+ me = _intVal(self);
+ t = me / val;
+#ifdef GOOD_OPTIMIZER
+ if (me % val) {
+#else
+ /* this is stupid - all I want is to look for a remainder ...
+ but most compilers are too stupid and generate an extra mod instr.
+ for "if (me % val)" even if most div instructions also compute
+ the remainder.
+ therefore I use a multiplication which is faster than a modulu
+ on most machines
+ */
+ if ((t * val) == me) {
+#endif
+ RETURN ( _MKSMALLINT(t) );
+ }
+/*
+ * now disabled - Fractions work
+ *
+ RETURN ( _MKFLOAT((double)_intVal(self) / (double)val, __context) );
+*/
+ }
+ } else {
+ if (_isFloat(aNumber)) {
+ dval = _floatVal(aNumber);
+ if (dval != 0.0) {
+ me = _intVal(self);
+ RETURN ( _MKFLOAT((double)me / dval COMMA_CON) );
+ }
+ }
+ }
+%}
+.
+ aNumber isInteger ifTrue:[
+ aNumber = 0 ifTrue:[
+ DivisionByZeroSignal raise.
+ ^ self
+ ].
+ ^ Fraction numerator:self denominator:aNumber
+ ].
+ ^ aNumber quotientFromInteger:self
+!
+
+// anInteger
+ "return the integer part of the quotient of the receivers value
+ and the arguments value"
+
+%{ /* NOCONTEXT */
+ INT val;
+
+ if (_isSmallInteger(anInteger)) {
+ val = _intVal(anInteger);
+ if (val != 0) {
+ RETURN ( _MKSMALLINT(_intVal(self) / val) );
+ }
+ }
+%}
+.
+ (anInteger = 0) ifTrue:[
+ DivisionByZeroSignal raise.
+ ^ self
+ ].
+ ^ self retry:#// coercing:anInteger
+!
+
+\\ anInteger
+ "return the integer rest of the receivers value
+ divided by the arguments value"
+
+%{ /* NOCONTEXT */
+ INT mySelf, val;
+
+ if (_isSmallInteger(anInteger)) {
+ mySelf = _intVal(self);
+ if (mySelf < 0) mySelf = -mySelf;
+ val = _intVal(anInteger);
+ if (val != 0) {
+ if (val < 0) {
+ RETURN ( _MKSMALLINT(-(mySelf % -val)) );
+ }
+ RETURN ( _MKSMALLINT(mySelf % val) );
+ }
+ }
+%}
+.
+ (anInteger = 0) ifTrue:[
+ DivisionByZeroSignal raise.
+ ^ self
+ ].
+ ^ self retry:#\\ coercing:anInteger
+!
+
+abs
+ "return the absolute value of the receiver
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+ INT val = _intVal(self);
+
+ if (val != _MIN_INT) {
+ RETURN ( (val < 0) ? _MKSMALLINT(-val) : self );
+ }
+%}
+.
+ "only reached for minVal"
+ ^ self negated
+!
+
+negated
+ "return the negative value of the receiver
+ reimplemented here for speed"
+
+%{ /* NOCONTEXT */
+
+ INT val = _intVal(self);
+
+ if (val != _MIN_INT) {
+ RETURN ( _MKSMALLINT(- val) );
+ }
+%}
+.
+ ^ (LargeInteger value:(SmallInteger maxVal)) + 1
+! !
+
+!SmallInteger methodsFor:'modulu arithmetic'!
+
+times:aNumber
+ "return the product of the receiver and the argument as SmallInteger.
+ If the result overflows integer range the value modulu the SmallInteger
+ range is returned.
+ This is of course not always correct, but some code does a modulu anyway
+ and can therefore speed things up by not going through LargeIntegers."
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( _MKSMALLINT((_intVal(self) * _intVal(aNumber)) & 0x7FFFFFFF) );
+ }
+%}
+.
+ self primitiveFailed
+!
+
+plus:aNumber
+ "return the sum of the receiver and the argument as SmallInteger.
+ If the result overflows integer range, the value modulu the SmallInteger
+ range is returned.
+ This is of course not always correct, but some code does a modulu anyway
+ and can therefore speed things up by not going through LargeIntegers."
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(aNumber)) {
+ RETURN ( _MKSMALLINT((_intVal(self) + _intVal(aNumber)) & 0x7FFFFFFF) );
+ }
+%}
+.
+ self primitiveFailed
+! !
+
+!SmallInteger class methodsFor:'bit mask constants'!
+
+bitMaskFor:index
+ "return a bitmask for the index's bit (index starts at 1)"
+
+ (index between:1 and:SmallInteger maxBits) ifFalse:[
+ ^ self error:'index out of bounds'
+ ].
+ ^ 1 bitShift:(index - 1)
+! !
+
+!SmallInteger methodsFor:'bit operators'!
+
+bitAt:index
+ "return the value of the index's bit (index starts at 1)"
+
+ |mask|
+
+ (index between:1 and:SmallInteger maxBits) ifFalse:[
+ ^ self error:'index out of bounds'
+ ].
+ mask := 1 bitShift:(index - 1).
+ ((self bitAnd:mask) == 0) ifTrue:[^ 0].
+ ^ 1
+!
+
+allMask:anInteger
+ "True if all bits in anInteger are 1 in the receiver"
+
+ ^(self bitAnd:anInteger) == anInteger
+!
+
+anyMask:anInteger
+ "True if any 1 bits in anInteger are 1 in the receiver"
+
+ ^(self bitAnd:anInteger) ~~ 0
+!
+
+noMask:anInteger
+ "True if no 1 bits in anInteger are 1 in the receiver"
+
+ ^(self bitAnd:anInteger) == 0
+!
+
+highBit
+ "return the bitIndex of the highest bit set"
+
+%{ /* NOCONTEXT */
+
+ INT mask, index, bits;
+
+ bits = _intVal(self);
+ if (bits == 0) {
+ RETURN ( _MKSMALLINT(-1) );
+ }
+#ifdef alpha
+ mask = 0x2000000000000000;
+ index = 62;
+#else
+ mask = 0x20000000;
+ index = 30;
+#endif
+ while (index) {
+ if (bits & mask) break;
+ mask = mask >> 1;
+ index--;
+ }
+ RETURN ( _MKSMALLINT(index) );
+%}
+!
+
+lowBit
+ "return the bitIndex of the lowest bit set"
+%{ /* NOCONTEXT */
+
+ INT mask, index, bits;
+
+ bits = _intVal(self);
+ if (bits == 0) {
+ RETURN ( _MKSMALLINT(-1) );
+ }
+ mask = 1;
+ index = 1;
+#ifdef alpha
+ while (index != 63) {
+#else
+ while (index != 31) {
+#endif
+ if (bits & mask) {
+ RETURN ( _MKSMALLINT(index) );
+ }
+ mask = mask << 1;
+ index++;
+ }
+ RETURN ( _MKSMALLINT(-1) );
+ /* notreached */
+%}
+!
+
+bitShift:shiftCount
+ "return the value of the receiver shifted by shiftCount bits;
+ leftShift if shiftCount > 0; rightShift otherwise"
+
+%{ /* NOCONTEXT */
+
+ INT bits, count;
+
+ if (_isSmallInteger(shiftCount)) {
+ count = _intVal(shiftCount);
+ bits = _intVal(self);
+ if (count > 0) {
+ RETURN ( _MKSMALLINT(bits << count) );
+ }
+ if (count < 0) {
+ RETURN ( _MKSMALLINT(bits >> -count) );
+ }
+ RETURN (self );
+ }
+%}
+.
+ ^ self bitShift:(shiftCount coerce:1)
+!
+
+bitOr:anInteger
+ "return the bit-or of the receiver and the argument, anInteger"
+
+%{ /* NOCONTEXT */
+
+ /* oring the tags doesn't change it */
+ if (_isSmallInteger(anInteger)) {
+ RETURN ( ((OBJ) ((INT)self | (INT)anInteger)) );
+ }
+%}
+.
+ ^ self retry:#bitOr coercing:anInteger
+!
+
+bitAnd:anInteger
+ "return the bit-and of the receiver and the argument, anInteger"
+
+%{ /* NOCONTEXT */
+
+ /* anding the tags doesn't change it */
+ if (_isSmallInteger(anInteger)) {
+ RETURN ( ((OBJ) ((INT)self & (INT)anInteger)) );
+ }
+%}
+.
+ ^ self retry:#bitAnd coercing:anInteger
+!
+
+bitXor:anInteger
+ "return the bit-exclusive-or of the receiver and the argument, anInteger"
+
+%{ /* NOCONTEXT */
+
+ /* xoring the tags turns it off - or it in again */
+ if (_isSmallInteger(anInteger)) {
+ RETURN ( (OBJ)( ((INT)self ^ (INT)anInteger) | TAG_INT) );
+ }
+%}
+.
+ ^ self retry:#bitXor coercing:anInteger
+!
+
+bitInvert
+ "return the value of the receiver with all bits inverted"
+
+%{ /* NOCONTEXT */
+
+ /* invert anything except tag bits */
+ RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
+%}
+!
+
+bitTest:aMask
+ "return true, if any bit from aMask is set in the receiver"
+
+%{ /* NOCONTEXT */
+
+ /* and all bits except tag */
+ if (_isSmallInteger(aMask)) {
+ RETURN ( ((INT)self & ((INT)aMask & ~TAG_MASK)) ? true : false );
+ }
+%}
+.
+ ^ self retry:#bitTest coercing:aMask
+! !
+
+!SmallInteger methodsFor:'byte access'!
+
+digitLength
+ "return the number bytes used by this Integer"
+
+ ^ self abs highBit - 1 // 8 + 1
+!
+
+digitAt:index
+ "return 8 bits of value, starting at byte index"
+
+%{ /* NOCONTEXT */
+
+ INT val;
+
+ if (_isSmallInteger(index)) {
+ val = _intVal(self);
+ if (val < 0)
+ val = -val;
+ switch (_intVal(index)) {
+ case 1:
+ RETURN ( _MKSMALLINT( val & 0xFF) );
+ case 2:
+ RETURN ( _MKSMALLINT( (val >> 8) & 0xFF) );
+ case 3:
+ RETURN ( _MKSMALLINT( (val >> 16) & 0xFF) );
+ case 4:
+ RETURN ( _MKSMALLINT( (val >> 24) & 0xFF) );
+#ifdef alpha
+ case 5:
+ RETURN ( _MKSMALLINT( (val >> 32) & 0xFF) );
+ case 6:
+ RETURN ( _MKSMALLINT( (val >> 40) & 0xFF) );
+ case 7:
+ RETURN ( _MKSMALLINT( (val >> 48) & 0xFF) );
+ case 8:
+ RETURN ( _MKSMALLINT( (val >> 56) & 0xFF) );
+#endif
+ }
+ }
+%}
+.
+ self primitiveFailed
+! !
+
+!SmallInteger methodsFor:'misc math functions'!
+
+gcd:anInteger
+ "return the greatest common divisor (Euclid's algorithm).
+ This has been redefined here for more speed since due to the
+ use of gcd in Fraction code, it has become time-critical for
+ some code. (thanx to MessageTally)"
+
+%{ /* NOCONTEXT */
+
+ if (_isSmallInteger(anInteger)) {
+ INT orgArg, ttt, selfInt, temp;
+
+ ttt = orgArg = _intVal(anInteger);
+ if (ttt) {
+ selfInt = _intVal(self);
+ while (ttt != 0) {
+ temp = selfInt % ttt;
+ selfInt = ttt;
+ ttt = temp;
+ }
+ /*
+ * since its not defined in what the sign of
+ * a modulu result is when the arg is negative,
+ * change it explicitely here ...
+ */
+ if (orgArg < 0) {
+ /* result should be negative */
+ if (selfInt > 0) selfInt = -selfInt;
+ } else {
+ /* result should be positive */
+ if (selfInt < 0) selfInt = -selfInt;
+ }
+ RETURN ( _MKSMALLINT(selfInt) );
+ }
+ }
+%}
+.
+ ^ super gcd:anInteger
+!
+
+intlog10
+ "return the truncation of log10 of the receiver -
+ stupid implementation; used to find out the number of digits needed
+ to print a number/and for conversion to a LargeInteger"
+
+ self <= 0 ifTrue:[
+ self error:'logarithm of negative integer'
+ ].
+ self < 10 ifTrue:[^ 1].
+ self < 100 ifTrue:[^ 2].
+ self < 1000 ifTrue:[^ 3].
+ self < 10000 ifTrue:[^ 4].
+ self < 100000 ifTrue:[^ 5].
+ self < 1000000 ifTrue:[^ 6].
+ self < 10000000 ifTrue:[^ 7].
+ self < 100000000 ifTrue:[^ 8].
+ self < 1000000000 ifTrue:[^ 9].
+ ^ 10
+! !
+
+!SmallInteger methodsFor:'coercing and converting'!
+
+coerce:aNumber
+ ^ aNumber asInteger
+!
+
+generality
+ ^ 20
+!
+
+asFloat
+ "return a Float with same value as receiver"
+
+%{ /* NOCONTEXT */
+
+ OBJ newFloat;
+
+ _qAlignedNew(newFloat, sizeof(struct floatstruct), SENDER);
+ _InstPtr(newFloat)->o_class = Float;
+ _FloatInstPtr(newFloat)->f_floatvalue = _intVal(self);
+ RETURN ( newFloat );
+%}
+!
+
+asLargeInteger
+ "return a LargeInteger with same value as receiver"
+
+ ^ LargeInteger value:self
+!
+
+asCharacter
+ "Return self as an ascii character"
+
+ ^ Character value:self
+! !
+
+!SmallInteger methodsFor:'iterators'!
+
+timesRepeat:aBlock
+ "evaluate the argument, aBlock self times"
+
+ |count "{ Class: SmallInteger }" |
+
+ count := self.
+ [count > 0] whileTrue:[
+ aBlock value.
+ count := count - 1
+ ]
+!
+
+to:stop do:aBlock
+ "reimplemented for speed"
+
+ |home index|
+%{
+ REGISTER INT tmp;
+ INT final;
+ REGISTER OBJFUNC code;
+ extern OBJ Block, _value_;
+ static struct inlineCache blockVal = _ILC1;
+#ifdef UPDATE_WHOLE_STACK
+ REGISTER OBJ rHome;
+# undef home
+# define home rHome
+#endif
+
+ if (_isSmallInteger(stop)) {
+ tmp = _intVal(self);
+ final = _intVal(stop);
+ if (_isBlock(aBlock)
+ && ((code = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+ && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+ /*
+ * arg is a compiled block -
+ * directly call it without going through "Block-value"
+ */
+ home = _BlockInstPtr(aBlock)->b_home;
+ while (tmp <= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*code)(home, CON_COMMA &index);
+#else
+ (*code)(home, CON_COMMA index);
+#endif
+ tmp++;
+ }
+ } else {
+ /*
+ * arg is something else - call it with Block-value"
+ */
+ while (tmp <= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, &index);
+#else
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, index);
+#endif
+ tmp++;
+ }
+ }
+ RETURN ( self );
+ }
+%}
+.
+ ^super to:stop do:aBlock
+!
+
+to:stop by:incr do:aBlock
+ "reimplemented for speed"
+
+ |home index|
+%{
+ REGISTER INT tmp, step;
+ REGISTER INT final;
+ REGISTER OBJFUNC code;
+ extern OBJ Block, _value_;
+ static struct inlineCache blockVal = _ILC1;
+#ifdef UPDATE_WHOLE_STACK
+ REGISTER OBJ rHome;
+# undef home
+# define home rHome
+#endif
+
+ if (_isSmallInteger(incr)
+ && _isSmallInteger(stop)) {
+ tmp = _intVal(self);
+ final = _intVal(stop);
+ step = _intVal(incr);
+ if (_isBlock(aBlock)
+ && ((code = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+ && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+ /*
+ * arg is a compiled block -
+ * directly call it without going through "Block-value"
+ */
+ home = _BlockInstPtr(aBlock)->b_home;
+ if (step < 0) {
+ while (tmp >= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*code)(home, CON_COMMA &index);
+#else
+ (*code)(home, CON_COMMA index);
+#endif
+ tmp += step;
+ }
+ } else {
+ while (tmp <= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*code)(home, CON_COMMA &index);
+#else
+ (*code)(home, CON_COMMA index);
+#endif
+ tmp += step;
+ }
+ }
+ } else {
+ /*
+ * arg is something else - call it with Block-value"
+ */
+ if (step < 0) {
+ while (tmp >= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, &index);
+#else
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, index);
+#endif
+ tmp += step;
+ }
+ } else {
+ while (tmp <= final) {
+ if (InterruptPending != nil) interrupt(CONARG);
+
+ index = _MKSMALLINT(tmp);
+#ifdef PASS_ARG_REF
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, &index);
+#else
+ (*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal, index);
+#endif
+ tmp += step;
+ }
+ }
+ }
+ RETURN ( self );
+ }
+%}
+.
+ ^super to:stop do:aBlock
+! !
+
+!SmallInteger methodsFor:'printing & storing'!
+
+printString
+ "return my printstring (base 10)"
+
+%{ /* NOCONTEXT */
+
+ extern char *newNextPtr, *newEndPtr;
+ char buffer[30];
+ OBJ newString;
+#ifdef THIS_CONTEXT
+ OBJ sav = __thisContext;
+#endif
+
+ sprintf(buffer, "%d", _intVal(self));
+#ifdef THIS_CONTEXT
+ __thisContext = sav;
+#endif
+ _qNew(newString, sizeof(struct stringheader) + strlen(buffer) + 1, SENDER);
+ _InstPtr(newString)->o_class = String;
+ strcpy(_stringVal(newString), buffer);
+ RETURN (newString);
+%}
+!
+
+printStringRadix:radix
+ "return my printstring (base 10)"
+
+%{ /* NOCONTEXT */
+
+ extern char *newNextPtr, *newEndPtr;
+ char *format = (char *)0;
+ char buffer[30];
+ OBJ newString;
+
+ if (_isSmallInteger(radix)) {
+ switch (_intVal(radix)) {
+ case 10:
+ format = "%d";
+ break;
+ case 16:
+ format = "%x";
+ break;
+ case 8:
+ format = "%o";
+ break;
+ }
+ }
+
+ if (format) {
+#ifdef THIS_CONTEXT
+ OBJ sav = __thisContext;
+#endif
+ sprintf(buffer, format, _intVal(self));
+#ifdef THIS_CONTEXT
+ __thisContext = sav;
+#endif
+ _qNew(newString, sizeof(struct stringheader) + strlen(buffer) + 1, SENDER);
+ _InstPtr(newString)->o_class = String;
+ strcpy(_stringVal(newString), buffer);
+ RETURN (newString);
+ }
+%}
+.
+ ^ super printStringRadix:radix
+!
+
+printfPrintString:formatString
+ "non-portable, but sometimes useful.
+ return a printed representation of the receiver
+ as specified by formatString, which is defined by printf.
+ No checking for string overrun - must be shorter than 256 chars or else ..."
+
+%{ /* NOCONTEXT */
+
+ char buffer[256];
+
+ if (_isString(formatString)) {
+#ifdef THIS_CONTEXT
+ OBJ sav = __thisContext;
+#endif
+ sprintf(buffer, _stringVal(formatString), _intVal(self));
+#ifdef THIS_CONTEXT
+ __thisContext = sav;
+#endif
+ RETURN ( _MKSTRING(buffer COMMA_SND) );
+ }
+%}
+.
+ self primitiveFailed
+
+ "123 printfPrintString:'%%d -> %d'"
+ "123 printfPrintString:'%%6d -> %6d'"
+ "123 printfPrintString:'%%x -> %x'"
+ "123 printfPrintString:'%%4x -> %4x'"
+ "123 printfPrintString:'%%04x -> %04x'"
+! !