"
COPYRIGHT (c) 1988 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 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.9 1994-02-05 12:24:25 claus Exp $
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.
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 do 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) );
%}
"SmallInteger maxBits"
!
maxBytes
"return the number of bytes in instances of me"
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT(N_INT_BITS / 8 + 1) );
%}
"SmallInteger maxBytes"
!
minVal
"return the smallest Integer representable as SmallInteger"
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT(_MIN_INT) );
%}
"SmallInteger minVal"
!
maxVal
"return the largest Integer representable as SmallInteger"
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT(_MAX_INT) );
%}
"SmallInteger maxVal"
! !
!SmallInteger class methodsFor:'queries'!
isBuiltInClass
"this class is known by the run-time-system"
^ true
!
canBeSubclassed
"return true, if its allowed to create subclasses of the receiver.
Return nil here - since it is NOT possible for UndefinedObject"
^ false
! !
!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 smallintegers are unique"
^ self
!
simpleDeepCopy
"return a deep copy of myself
- reimplemented here since smallintegers are unique"
^ self
!
deepCopyUsing:aDictionary
"return a deep copy of myself
- reimplemented here since smallintegers are unique"
^ self
!
deepCopy
"return a deep copy of myself
- reimplemented here since smallintegers 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)) {
myValue = _intVal(self);
otherValue = _intVal(aNumber);
#if defined(NOTDEF) && defined(__GNUC__) && (__GNUC__ >= 2)
{
long long product;
product = myValue * otherValue;
if ((product >= (long long)_MIN_INT)
&& (product <= (long long)_MAX_INT)) {
RETURN ( _MKSMALLINT((int)product) );
}
}
#else
/* 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
*/
if (myValue < 0) myValue = -myValue;
if (otherValue < 0) otherValue = -otherValue;
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))) {
RETURN ( _MKSMALLINT(_intVal(self) * _intVal(aNumber)) );
}
#endif
} 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
*/
aLarge = (*val.ilc_func)(LargeInteger, _value_, CON_COMMA nil, &val, self);
RETURN ( (*mu.ilc_func)(aLarge, __mu, CON_COMMA nil, &mu, aNumber) );
}
%}
.
^ 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
!
// aNumber
"return the integer part of the quotient of the receivers value
and the arguments value"
%{ /* NOCONTEXT */
INT val;
if (_isSmallInteger(aNumber)) {
val = _intVal(aNumber);
if (val != 0) {
RETURN ( _MKSMALLINT(_intVal(self) / val) );
}
} else {
if (_isFraction(aNumber)) {
OBJ t;
INT num, den;
t = _FractionInstPtr(aNumber)->f_numerator;
if (_isSmallInteger(t)) {
num = _intVal(t);
t = _FractionInstPtr(aNumber)->f_denominator;
if (_isSmallInteger(t)) {
den = _intVal(t);
RETURN ( _MKSMALLINT(_intVal(self) * den / num ));
}
}
}
}
%}
.
(aNumber = 0) ifTrue:[
DivisionByZeroSignal raise.
^ self
].
^ self retry:#// coercing:aNumber
!
\\ aNumber
"return the integer rest of the receivers value
divided by the arguments value"
%{ /* NOCONTEXT */
INT mySelf, val;
if (_isSmallInteger(aNumber)) {
mySelf = _intVal(self);
if (mySelf < 0) mySelf = -mySelf;
val = _intVal(aNumber);
if (val != 0) {
if (val < 0) {
RETURN ( _MKSMALLINT(-(mySelf % -val)) );
}
RETURN ( _MKSMALLINT(mySelf % val) );
}
}
%}
.
(aNumber = 0) ifTrue:[
DivisionByZeroSignal raise.
^ self
].
^ self retry:#\\ coercing:aNumber
!
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 bitwise-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 bitwise-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 bitwise-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
"return aNumber converted into receivers type"
^ aNumber asInteger
!
generality
"return the generality value - see ArithmeticValue>>retry:coercing:"
^ 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;
REGISTER OBJ rHome;
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))) {
#ifdef NEW_BLOCK_CALL
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
tmp++;
}
#else
/*
* arg is a compiled block -
* directly call it without going through "Block-value"
*/
home = _BlockInstPtr(aBlock)->b_home;
rHome = home;
if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
/*
* home will not move - keep in in a register
*/
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
tmp++;
}
} else {
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(home, CON_COMMA _MKSMALLINT(tmp));
tmp++;
}
}
#endif
} else {
/*
* arg is something else - call it with Block-value"
*/
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
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;
REGISTER OBJ rHome;
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))) {
#ifdef NEW_BLOCK_CALL
if (step < 0) {
while (tmp >= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
} else {
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(aBlock, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
}
#else
/*
* arg is a compiled block -
* directly call it without going through "Block-value"
*/
home = _BlockInstPtr(aBlock)->b_home;
rHome = home;
if (step < 0) {
if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
/*
* home is on stack - will not move
*/
while (tmp >= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
} else {
while (tmp >= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(home, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
}
} else {
if ((rHome == nil) || (_qSpace(rHome) >= STACKSPACE)) {
/*
* home is on stack - will not move
*/
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(rHome, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
} else {
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*code)(home, CON_COMMA _MKSMALLINT(tmp));
tmp += step;
}
}
}
#endif
} else {
/*
* arg is something else - call it with Block-value"
*/
if (step < 0) {
while (tmp >= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
tmp += step;
}
} else {
while (tmp <= final) {
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock, _value_, CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
tmp += step;
}
}
}
RETURN ( self );
}
%}
.
^ super to:stop do:aBlock
! !
!SmallInteger class methodsFor:'binary storage'!
binaryDefinitionFrom: stream manager: manager
"read the binary representation as stored in storeBinaryOn:"
| value |
value := stream next bitAnd: 16r7F.
value > 16r3F ifTrue: [
value := value - 16r80
].
value := (value bitShift: 8) bitOr: stream next.
value := (value bitShift: 8) bitOr: stream next.
value := (value bitShift: 8) bitOr: stream next.
^ value
! !
!SmallInteger methodsFor:'binary storage'!
hasSpecialBinaryRepresentation
"return true, if the receiver has a special binary representation"
^ true
!
storeBinaryOn: stream manager: manager
"append a binary representation onto stream.
Redefined since SmallIntegers are stored as their value with the 32nd bit
set as a tag.
To make the binary file a bit more compact, zeros and single byte ints
are stored with a more compact representation (using special type-codes)."
self == 0 ifTrue:[
stream nextPut: manager codeForZero.
^ self
].
(self between:0 and:255) ifTrue:[
stream nextPut: manager codeForByteInteger.
stream nextPut: self.
^ self
].
stream nextPut: (((self bitShift: -24) bitAnd: 16rFF) bitOr: 16r80).
stream nextPut: ((self bitShift: -16) bitAnd: 16rFF).
stream nextPut: ((self bitShift: -8) bitAnd: 16rFF).
stream nextPut: (self bitAnd: 16rFF)
! !
!SmallInteger methodsFor:'printing & storing'!
printString
"return my printstring (base 10)"
%{ /* NOCONTEXT */
extern char *newNextPtr, *newEndPtr;
char buffer[30];
OBJ newString;
#ifdef THISCONTEXT_IN_REGISTER
OBJ sav = __thisContext;
#endif
sprintf(buffer, "%d", _intVal(self));
#ifdef THISCONTEXT_IN_REGISTER
__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 THISCONTEXT_IN_REGISTER
OBJ sav = __thisContext;
#endif
sprintf(buffer, format, _intVal(self));
#ifdef THISCONTEXT_IN_REGISTER
__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 ..."
%{ /* STACK: 400 */
char buffer[256];
if (_isString(formatString)) {
#ifdef THISCONTEXT_IN_REGISTER
OBJ sav = __thisContext;
#endif
sprintf(buffer, _stringVal(formatString), _intVal(self));
#ifdef THISCONTEXT_IN_REGISTER
__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'"
! !