SmallInt.st
author Claus Gittinger <cg@exept.de>
Fri, 24 Jan 1997 17:24:04 +0100
changeset 2254 5e3cb9e7e682
parent 2216 e4fed6c622de
child 2430 cbbf16de1bd7
permissions -rw-r--r--
*** empty log message ***

"
 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 class methodsFor:'documentation'!

copyright
"
 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.
"
!

documentation
"
    SmallIntegers are Integers in the range of at least +/- 2^30 
    (i.e. 31 bits, which is not guaranteed; it could be more on 64 bit cpus).

    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 all other objects which do not. 
    Since this knowledge is hardwired into the system (and there is no 
    class-field stored with SmallIntegers) there can be no subclass of 
    SmallInteger (sorry).

    If you really need this kind of thing, create a subclass of Integer,
    with an instance variable holding the value.

    [author:]
	Claus Gittinger

    [see also:]
	Number
	Float Fraction FixedPoint
	LargeInteger
"
! !

!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:'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 class methodsFor:'constants'!

maxBits
    "return the number of bits in instances of me.
     For very special uses only - not constant across implementations"

%{  /* NOCONTEXT */
    RETURN ( __MKSMALLINT(N_INT_BITS) );
%}

    "SmallInteger maxBits"
!

maxBytes
    "return the number of bytes in instances of me.
     For very special uses only - not constant across implementations"

%{  /* NOCONTEXT */
    RETURN ( __MKSMALLINT(N_INT_BITS / 8 + 1) );
%}

    "SmallInteger maxBytes"
!

maxVal
    "return the largest Integer representable as SmallInteger.
     For very special uses only - not constant across implementations"

%{  /* NOCONTEXT */
    RETURN ( __MKSMALLINT(_MAX_INT) );
%}

    "SmallInteger maxVal"
!

minVal
    "return the smallest Integer representable as SmallInteger.
     For very special uses only - not constant across implementations"

%{  /* NOCONTEXT */
    RETURN ( __MKSMALLINT(_MIN_INT) );
%}

    "SmallInteger minVal"
! !

!SmallInteger class methodsFor:'queries'!

canBeSubclassed
    "return true, if its allowed to create subclasses of the receiver.
     Return nil here - since it is NOT possible for SmallInteger"

    ^ false
!

isBuiltInClass
    "return true if this class is known by the run-time-system.
     Here, true is returned."

    ^ true

    "Modified: 23.4.1996 / 16:00:33 / cg"
! !

!SmallInteger methodsFor:'arithmetic'!

* aNumber
    "return the product of the receivers value and the arguments value"

%{  /* NOCONTEXT */

    INT myValue, otherValue;
    unsigned INT productLow, productHi;
    int negative;

#   define low16Bits(foo)  ((foo) & 0xFFFF)
#   define hi16Bits(foo)   ((foo) >> 16)

    /*
     * can we use long long arithmetic ?
     */
#if defined(__GNUC__) && (__GNUC__ >= 2)
    /*
     * commented, since long-long arithmetic seems to
     * be buggy in some implementations (sparc) ...
     * (took me a while to find this out :-(
     */
# ifdef NOTDEF
#   define _LONGLONG
# endif
#endif

    if (__isSmallInteger(aNumber)) {
	myValue = __intVal(self);
	otherValue = __intVal(aNumber);

#if defined(_LONGLONG)
	{
	    long long product;

	    product = (long long)myValue * (long long)otherValue;
	    if ((product >= (long long)_MIN_INT) 
	     && (product <= (long long)_MAX_INT)) {
		RETURN ( __MKSMALLINT((int)product) );
	    }
	    if (product < 0) {
		negative = 1;
		product = -product;
	    } else {
		negative = 0;
	    }
	    productHi = product >> 32;
	    productLow = product & 0xFFFFFFFF;
	}
#else
	negative = 0;
	if (myValue < 0) {
	    negative = 1;
	    myValue = -myValue;
	}
	if (otherValue < 0) {
	    negative = (1 - negative);
	    otherValue = -otherValue;
	}

# if defined(__GNUC__) && defined(mc68k)
	asm ("mulu%.l %3,%1:%0"
		: "=d"  ((unsigned long)(productLow)),
		  "=d"  ((unsigned long)(productHi))
		: "%0"  ((unsigned long)(myValue)),
		  "dmi" ((unsigned long)(otherValue)));
# else
#  if defined (__GNUC__) && defined(i386)
	asm ("mull %3"
		: "=a"  ((unsigned long)(productLow)),
		  "=d"  ((unsigned long)(productHi))
		: "%0"  ((unsigned long)(myValue)),
		  "rm"  ((unsigned long)(otherValue)));
#  else
	{
	    unsigned INT pHH, pHL, pLH, pLL;
	    unsigned INT low1, low2, hi1, hi2;
	    unsigned INT t;

	    /* unsigned multiply myValue * otherValue -> productHi, productLow
	     *
	     * this is too slow:
	     * since most machines can do 32*32 to 64 bit multiply,
	     * (or at least 32*32 with Overflow check)
	     * - need more assembler (inline) functions here 
	     */
	    low1 = low16Bits(myValue);
	    hi1 = hi16Bits(myValue);
	    low2 = low16Bits(otherValue);
	    hi2 = hi16Bits(otherValue);

	    pLH = low1 * hi2;
	    pHL = hi1 * low2;
	    pLL = low1 * low2;
        
	    /*
	     * the common case ...
	     */
	    if ((pHL == 0)
	     && (pLH == 0)
	     && ((pLL & 0xC0000000) == 0)) {
		if (negative) {
		    RETURN ( __MKSMALLINT(- ((INT)pLL)) );
		}
		RETURN ( __MKSMALLINT((INT)pLL) );
	    }

	    pHH = hi1 * hi2;

	    /*
	     *   pHH |--------|--------|
	     *   pLH          |--------|--------|
	     *   pHL          |--------|--------|
	     *   pLL                   |--------|--------|
	     */

	    t = low16Bits(pLH) + low16Bits(pHL) + hi16Bits(pLL);
	    productLow = (t << 16) + low16Bits(pLL);
	    productHi = pHH + hi16Bits(t) + hi16Bits(pHL) + hi16Bits(pLH);
	}
#  endif
# endif
	if (productHi == 0) {
	    if (negative) {
		if (productLow <= -(_MIN_INT)) {
		    RETURN ( __MKSMALLINT(-((INT)productLow)) );
		}
	    } else {
		if (productLow <= _MAX_INT) {
		    RETURN ( __MKSMALLINT(productLow) );
		}
	    }
	}
#endif

	{
	    extern OBJ __MKLARGEINT64();

	    RETURN (__MKLARGEINT64(negative ? -1 : 1, productLow, productHi));
	}
    } else if (__isFloatLike(aNumber)) {
	OBJ newFloat;
	double val = (double)__intVal(self) * __floatVal(aNumber);

	__qMKFLOAT(newFloat, val);
	RETURN ( newFloat );
    }
%}
.
    ^ aNumber productFromInteger:self
!

+ 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;

	sum =  __intVal(self) + __intVal(aNumber);
	if ((sum >= _MIN_INT) && (sum <= _MAX_INT)) {
	    RETURN ( __MKSMALLINT(sum) );
	}
	RETURN ( __MKLARGEINT(sum) );
#endif
    }
    if (__isFloatLike(aNumber)) {
	OBJ newFloat;
	double val = (double)__intVal(self) + __floatVal(aNumber);

	__qMKFLOAT(newFloat, 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;

	diff =  __intVal(self) - __intVal(aNumber);
	if ((diff >= _MIN_INT) && (diff <= _MAX_INT)) {
	    RETURN ( __MKSMALLINT(diff) );
	}
	RETURN ( __MKLARGEINT(diff) );
#endif
    }
    if (__isFloatLike(aNumber)) {
	OBJ newFloat;
	double val = (double)__intVal(self) - __floatVal(aNumber);

	__qMKFLOAT(newFloat, val);
	RETURN ( newFloat );
    }
%}.
    ^ aNumber differenceFromInteger: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 modulu
	       instruction for "if (me % val)".
	       Even if most divide instructions already leave the remainder in
	       some register.
	       Therefore I use a multiplication which is faster than a modulu
	       on most machines. Hint to GNU people :-)
	    */
	    if ((t * val) == me) {
#endif
		RETURN ( __MKSMALLINT(t) );
	    }
	}
    } else {
	if (__isFloatLike(aNumber)) {
	    dval = __floatVal(aNumber);
	    if (dval != 0.0) {
		OBJ newFloat;
		double val = (double)__intVal(self) / dval;

		__qMKFLOAT(newFloat, val);
		RETURN ( newFloat );
	    }
	}
    }
%}.
    aNumber isInteger ifTrue:[
	aNumber == 0 ifTrue:[
	    ^ DivisionByZeroSignal raise.
	].
	^ Fraction numerator:self denominator:aNumber
    ].
    ^ aNumber quotientFromInteger:self

    "
     8 / 4
     9 / 4
     9 // 4
     9 quo:4

     -8 / 4
     -9 / 4
     -9 // 4
     -9 quo:4
    "
!

// aNumber
    "return the integer part of the quotient of the receivers value
     and the arguments value. The result is truncated toward negative infinity
     and negative, if the operands signs differ.
     Be careful with negative results: 9 // 4 = 2, 
     while -9 // 4 = -3. 
     See #quo: which returns -2 in the latter."

%{  /* NOCONTEXT */
    INT val, rslt;

    if (__isSmallInteger(aNumber)) {
	val = __intVal(aNumber);
	if (val != 0) {
	    rslt = __intVal(self) / val;
	    if (rslt < 0) {
		if (__intVal(self) % val)
		    rslt--;
	    }
	    RETURN ( __MKSMALLINT(rslt) );
	}
    } 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 retry:#// coercing:aNumber

    "
     9 // 4    => 2
     -9 // 4   => -3
     9 // -4   => -3
     -9 // -4  => 2

     9 quo:4   => 2
     -9 quo:4  => -2
     9 quo:-4  => -2
     -9 quo:-4 => 2
    "
!

\\ aNumber
    "return the integer rest of the receivers value
     divided by the arguments value.
     This is not always the same as the result as obtained from #rem:"

%{  /* 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 retry:#\\ coercing:aNumber

    "
     9 \\ 4
     -9 \\ 4
     9 rem:4
     -9 rem:4
    "
!

abs
    "return the absolute value of the receiver
     reimplemented here for speed"

%{  /* NOCONTEXT */

    INT val = __intVal(self);

    if (val >= 0) {
	RETURN (self);
    }
    if (val != _MIN_INT) {
	RETURN ( __MKSMALLINT(-val) );
    }
%}.
    "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) );
    }
%}.
    "only reached for minVal"
    ^ (LargeInteger value:(SmallInteger maxVal)) + 1
!

quo:aNumber
    "return the integer part of the quotient of the receivers value
     and the arguments value. The result is truncated towards zero
     and negative, if the operands signs differ.. 
     For positive results, this is the same as #//,
     for negative results, the remainder is ignored.
     I.e.: '9 // 4 = 2' and '-9 // 4 = -3'
     in contrast: '9 quo: 4 = 2' and '-9 quo: 4 = -2'"

%{  /* 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 retry:#quo: coercing:aNumber

    "
     9 // 4
     -9 // 4
     9 quo:4
     -9 quo:4
    "
! !

!SmallInteger methodsFor:'bit operators'!

allMask:anInteger
    "return true if all 1-bits in anInteger are also 1 in the receiver"

    ^ (self bitAnd:anInteger) == anInteger

    "2r00001111 allMask:2r00000001"
    "2r00001111 allMask:2r00011110"
    "2r00001111 allMask:2r00000000"
!

anyMask:anInteger
    "return true if any 1-bits in anInteger is also 1 in the receiver.
     (somewhat incorrect, if the mask is zero)"

    ^ (self bitAnd:anInteger) ~~ 0

    "2r00001111 anyMask:2r00000001"
    "2r00001111 anyMask:2r11110000"
!

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

    "(2r001010100 bitAnd:2r00001111) radixPrintStringRadix:2"
!

bitAt:index
    "return the value of the index's bit (index starts at 1).
     Notice: the result of bitAt: on negative receivers is not 
	     defined in the language standard (since the implementation
	     is free to choose any internal representation for integers)"

    |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
!

bitInvert
    "return the value of the receiver with all bits inverted"

%{  /* NOCONTEXT */

    /* invert anything except tag bits */
    RETURN ( ((OBJ) ((INT)self ^ ~TAG_MASK)) );
%}
!

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

    "(2r000000100 bitOr:2r00000011) radixPrintStringRadix:2"
!

bitShift32:shiftCount
    "return the value of the receiver shifted by shiftCount bits,
     but only within 32 bits, shifting into/out-of the sign bit.
     May be useful for communication interfaces, to create ST-numbers
     from a signed 32bit int value given as individual bytes."

%{  /* NOCONTEXT */

    INT bits, count;

    if (__isSmallInteger(shiftCount)) {
	count = __intVal(shiftCount);
	bits = __intVal(self);
	if (count > 0) {
	    bits = bits << count;
	} else {
	    bits = bits >> (-count);
	}
	RETURN (__MKINT(bits));
    }
%}.
    ^ self primitiveFailed

    "
     128 bitShift:24    
     128 bitShift32:24  
    "
!

bitShift:shiftCount
    "return the value of the receiver shifted by shiftCount bits;
     leftShift if shiftCount > 0; rightShift otherwise.
     Notice: the result of bitShift: on negative receivers is not 
	     defined in the language standard (since the implementation
	     is free to choose any internal representation for integers)"

%{  /* NOCONTEXT */

    INT bits, count;

    if (__isSmallInteger(shiftCount)) {
	count = __intVal(shiftCount);
	bits = __intVal(self);
	if (bits == 0) {
	    RETURN (self);
	}

	if (count > 0) {
#if defined(_LONGLONG)
	    unsigned long long result;

	    result = bits;
	    if (count <= N_INT_BITS) {
		result <<= count;
		if (result <= _MAX_INT) {
		    RETURN ( __MKSMALLINT(result) );
		}
		{
		    extern OBJ __MKLARGEINT64();

		    RETURN (__MKLARGEINT64(1, (int)(result >> 32), (int)(result & 0xFFFFFFFF)));
		}
	    }
#else
	    /*
	     * check for overflow
	     */
	    if (count < (N_INT_BITS-1)) {
		if (! (bits >> (N_INT_BITS - 1 - count))) {
		    RETURN ( __MKSMALLINT(bits << count) );
		}
		/*
		 * so, there is an overflow ...
		 * handle it as largeInteger
		 */
		/* FALL THROUGH */
	    }
#endif
	} else {
	    /*
	     * right shifts cannot overflow
	     */
	    if (count < 0) {
		/*
		 * some machines ignore shifts bigger than
		 * the number of bits in an int ...
		 */
		if (count < (-N_INT_BITS-1))
		    RETURN (__MKSMALLINT(0));
		RETURN ( __MKSMALLINT(bits >> -count) );
	    }
	    RETURN (self );
	}
    }
%}.
    (shiftCount isMemberOf:SmallInteger) ifTrue:[
	^ (LargeInteger value:self) bitShift:shiftCount
    ].
    ^ self bitShift:(shiftCount coerce:1)
!

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
!

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
!

highBit
    "return the bitIndex of the highest bit set. The returned bitIndex
     starts at 1 for the least significant bit. Returns -1 if no bit is 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) );
%}
    "2r000100 highBit"
    "2r010100 highBit"
    "2r000001 highBit"
    "0 highBit"
    "SmallInteger maxVal highBit"
!

lowBit
    "return the bitIndex of the lowest bit set. The returned bitIndex
     starts at 1 for the least significant bit. Returns -1 if no bit is 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) );
%}
    "2r000100 lowBit"
    "2r010010 lowBit"
    "2r100001 lowBit"
    "0 lowBit"
!

noMask:anInteger
    "return true if no 1-bit in anInteger is 1 in the receiver"

    ^ (self bitAnd:anInteger) == 0

    "2r00001111 noMask:2r00000001"
    "2r00001111 noMask:2r11110000"
! !

!SmallInteger methodsFor:'byte access'!

digitAt:index
    "return 8 bits of value, starting at byte index"

%{  /* NOCONTEXT */

    REGISTER INT val;
    INT idx;

    if (__isSmallInteger(index)) {
	val = __intVal(self);
	if (val < 0)
	    val = -val;
	switch (idx = __intVal(index)) {
	    case 1:
		break;
	    case 2:
		val = (val >> 8);
		break;
	    case 3:
		val = (val >> 16);
		break;
	    case 4:
		val = (val >> 24);
		break;
#ifdef alpha
	    case 5:
		val = (val >> 32);
		break;
	    case 6:
		val = (val >> 40);
		break;
	    case 7:
		val = (val >> 48);
		break;
	    case 8:
		val = (val >> 56);
		break;
#endif
	    default:
		if (idx < 1)
		    goto bad;   /* sorry */
		val = 0;
		break;
	}
	RETURN ( __MKSMALLINT( val & 0xFF) );
    }
  bad: ;
%}.
    index > 0 ifFalse:[
	"
	 index less than 1 - not allowed
	"
	^ self primitiveFailed
    ].
    ^ 0

    "
     (16r12345678 digitAt:1) printStringRadix:16
     (16r12345678 digitAt:3) printStringRadix:16
     (16r12345678 digitAt:15) printStringRadix:16
     (16r12345678 digitAt:0) printStringRadix:16
     (16r12345678 digitAt:-10) printStringRadix:16
    "
!

digitLength
    "return the number bytes used by this Integer"

    ^ self abs highBit - 1 // 8 + 1
! !

!SmallInteger methodsFor:'catching messages'!

basicAt:index
    "catch indexed access - report an error
     defined here since basicAt: 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
!

basicSize
    "return the number of indexed instvars - SmallIntegers have none.
     Defined here since basicSize in Object ommits the SmallInteger check."

    ^ 0
!

size
    "return the number of indexed instvars - SmallIntegers have none."

    ^ 0
! !

!SmallInteger methodsFor:'coercing and converting'!

asCharacter
    "Return a character with the receiver as ascii value"

    ^ Character value:self
!

asFloat
    "return a Float with same value as receiver"

%{  /* NOCONTEXT */

    OBJ newFloat;
    double dVal = (double)__intVal(self);

    __qMKFLOAT(newFloat, dVal);
    RETURN ( newFloat );
%}
!

asLargeInteger
    "return a LargeInteger with same value as receiver"

    ^ LargeInteger value:self
!

asShortFloat
    "return a ShortFloat with same value as receiver"

%{  /* NOCONTEXT */

    OBJ dummy = @global(ShortFloat);
    OBJ newFloat;
    float fVal = (float)__intVal(self);

    __qMKSFLOAT(newFloat, fVal);
    RETURN ( newFloat );
%}
!

coerce:aNumber
    "return aNumber converted into receivers type"

    ^ aNumber asInteger
!

generality
    "return the generality value - see ArithmeticValue>>retry:coercing:"

    ^ 20
!

signExtendedByteValue
    "return a smallInteger from sign-extending the 8'th bit.
     May be useful for communication interfaces"

%{  /* NOCONTEXT */
    int i = __intVal(self);

    if (i & 0x80) {
	i = i | 0x7FFFFF00;
    } else {
	i = i & 0x7F;
    }

    RETURN (__MKSMALLINT(i));
%}

    "
     16rFF signExtendedByteValue
     16r7F signExtendedByteValue
    "
!

signExtendedShortValue
    "return a smallInteger from sign-extending the 16'th bit.
     May be useful for communication interfaces"

%{  /* NOCONTEXT */
    int i = __intVal(self);

    if (i & 0x8000) {
	i = i | 0x7FFF0000;
    } else {
	i = i & 0x7FFF;
    }

    RETURN (__MKSMALLINT(i));
%}

    "
     16rFFFF signExtendedShortValue
     16r7FFF signExtendedShortValue
    "
! !

!SmallInteger methodsFor:'comparing'!

< 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 (__isFloatLike(aNumber)) {
	RETURN ( ((double)__intVal(self) < __floatVal(aNumber)) ? true : false );
    }
%}
.
    ^ aNumber lessFromInteger:self
    "^ 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 (__isFloatLike(aNumber)) {
	RETURN ( ((double)__intVal(self) <= __floatVal(aNumber)) ? true : false );
    }
%}
.
    ^ self retry:#<= coercing:aNumber
!

= aNumber
    "return true, if the arguments value is equal to mine"

%{  /* NOCONTEXT */

    if (aNumber == self) {
	RETURN ( true );
    }
    if (! __isNonNilObject(aNumber)) {
	/* a smallint or nil */
	RETURN ( false );
    }

    if (__isFloatLike(aNumber)) {
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? true : false );
    }
%}
.
    aNumber respondsToArithmetic ifFalse:[^ false].
    ^ 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 (__isFloatLike(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 (__isFloatLike(aNumber)) {
	RETURN ( ((double)__intVal(self) >= __floatVal(aNumber)) ? true : false );
    }
%}
.
    ^ self retry:#>= coercing:aNumber
!

hash
    "return an integer useful for hashing on value"

    self >= 0 ifTrue:[^ self].
    ^ self negated
!

identityHash
    "return an integer useful for hashing on identity"

     self >= 0 ifTrue:[^ self].
     ^ self negated

    "Modified: 11.11.1996 / 18:42:14 / cg"
!

max:aNumber
    "return the receiver or the argument, whichever is greater"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
#if TAG_INT == 1
	/* tag bit does not change ordering */
	if ((INT)(self) > (INT)(aNumber))
#else
	if (__intVal(self) > __intVal(aNumber))
#endif
	{
	    RETURN ( self );
	}
	RETURN ( aNumber );
    }
    if (__isFloatLike(aNumber)) {
	if ( (double)__intVal(self) > __floatVal(aNumber) ) {
	    RETURN ( self );
	}
	RETURN ( aNumber );
    }
%}.
    "/ fallback for non-smallInteger argument

    (self > aNumber) ifTrue:[^ self].
    ^ aNumber
!

min:aNumber
    "return the receiver or the argument, whichever is smaller"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aNumber)) {
#if TAG_INT == 1
	/* tag bit does not change ordering */
	if ((INT)(self) < (INT)(aNumber))
#else
	if (__intVal(self) < __intVal(aNumber))
#endif
	{
	    RETURN ( self );
	}
	RETURN ( aNumber );
    }
    if (__isFloatLike(aNumber)) {
	if ( (double)__intVal(self) < __floatVal(aNumber) ) {
	    RETURN ( self );
	}
	RETURN ( aNumber );
    }
%}.
    "/ fallback for non-smallInteger argument

    (self < aNumber) ifTrue:[^ self].
    ^ aNumber
!

~= aNumber
    "return true, if the arguments value is not equal to mine"

%{  /* NOCONTEXT */

    if (aNumber == self) {
	RETURN ( false );
    }
    if (! __isNonNilObject(aNumber)) {
	/* a smallint or nil */
	RETURN ( true );
    }

    if (__isFloatLike(aNumber)) {
	RETURN ( ((double)__intVal(self) == __floatVal(aNumber)) ? false : true );
    }
%}.
    aNumber respondsToArithmetic ifFalse:[^ true].
    ^ self retry:#~= coercing:aNumber
! !

!SmallInteger methodsFor:'copying'!

deepCopy
    "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
!

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
! !

!SmallInteger methodsFor:'iteration'!

timesRepeat:aBlock
    "evaluate the argument, aBlock self times.
     Reimplemented as primitive for speed"

%{
    REGISTER INT tmp;
    static struct inlineCache blockVal = __ILC0(0);

    tmp = __intVal(self);
    if (tmp > 0) {
	if (__isBlockLike(aBlock)
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(0))) {
	    {
		REGISTER OBJFUNC codeVal;

		/*
		 * specially tuned version for static compiled blocks, called with
		 * home on the stack (the most common case)
		 */
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {

#ifdef NEW_BLOCK_CALL

#                   define BLOCK_ARG  aBlock

#else

#                   define BLOCK_ARG  rHome
		    REGISTER OBJ rHome;
		    rHome = __BlockInstPtr(aBlock)->b_home;
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
#endif
		    {
#ifdef UNROLL_LOOPS
			if (0) {

			    interrupted0:
						__interruptL(@line); goto continue0;
			    interrupted1:
						__interruptL(@line); goto continue1;
			    interrupted2:
						__interruptL(@line); goto continue2;
			    interrupted3:
						__interruptL(@line); goto continue3;
			    interrupted4:
						__interruptL(@line); goto continue4;
			    interrupted5:
						__interruptL(@line); goto continue5;
			    interrupted6:
						__interruptL(@line); goto continue6;
			    interrupted7:
						__interruptL(@line); goto continue7;
			}

			/*
			 * you are not supposed to program like this - I know what I do
			 */
			while (tmp > 8) {
			    if (InterruptPending != nil) goto interrupted0;
	continue0:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted1;
	continue1:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted2;
	continue2:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted3;
	continue3:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted4;
	continue4:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted5;
	continue5:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted6;
	continue6:
			    (*codeVal)(BLOCK_ARG);
			    if (InterruptPending != nil) goto interrupted7;
	continue7:
			    (*codeVal)(BLOCK_ARG);
			    tmp -= 8;
			}
#endif /* UNROLL_LOOPS */
			do {
			    if (InterruptPending != nil) __interruptL(@line);
			    (*codeVal)(BLOCK_ARG);
			} while(--tmp);

			RETURN (self);
		    }
		}
	    }

#           undef BLOCK_ARG

#ifdef NEW_BLOCK_CALL
#           define BLOCK_ARG  aBlock
#           define IBLOCK_ARG nil
#else
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif

	    /*
	     * sorry - must check for the blocks code within the loops;
	     * it could be recompiled or flushed (in the interrupt)
	     */
	    do {
		REGISTER OBJFUNC codeVal;

		if (InterruptPending != nil) __interruptL(@line);

		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
		    /*
		     * arg is a compiled block with code -
		     * directly call it without going through Block>>value
		     */
		    (*codeVal)(BLOCK_ARG);
		} else {
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
			/*
			 * arg is a compiled block with bytecode -
			 * directly call interpreter without going through Block>>value
			 */
			__interpret(aBlock, 0, nil, IBLOCK_ARG, nil, nil);
		    } else {
			/*
			 * arg is something else - call it with #value
			 */
			(*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
		    }
		}
	    } while(--tmp);

#           undef BLOCK_ARG
#           undef IBLOCK_ARG

	    RETURN (self);
	}

	/*
	 * not a block-like thingy - call it with #value
	 */
	do {
	    if (InterruptPending != nil) __interruptL(@line);
	    (*blockVal.ilc_func)(aBlock, @symbol(value), nil, &blockVal);
	} while(--tmp);
	RETURN (self);
    }
%}

"/    |count "{ Class: SmallInteger }" |
"/
"/    count := self.
"/    [count > 0] whileTrue:[
"/        aBlock value.
"/        count := count - 1
"/    ]
!

to:stop by:incr do:aBlock
    "reimplemented as primitive for speed"

%{
    REGISTER INT tmp, step;
    REGISTER INT final;
    static struct inlineCache blockVal = __ILC1(0);

    if (__bothSmallInteger(incr, stop)) {
	tmp = __intVal(self);
	final = __intVal(stop);
	step = __intVal(incr);

	if (__isBlockLike(aBlock)
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
	    {
		REGISTER OBJFUNC codeVal;

		/*
		 * specially tuned version for static compiled blocks, called with
		 * home on the stack (the most common case)
		 */
                if (((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
                 && (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC)))) {

#ifdef NEW_BLOCK_CALL

#                   define BLOCK_ARG  aBlock

#else

#                   define BLOCK_ARG  rHome
		    REGISTER OBJ rHome;
		    rHome = __BlockInstPtr(aBlock)->b_home;
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 

#endif
		    {
			if (step < 0) {
			    if (step == -1) {
				while (tmp >= final) {
				    if (InterruptPending != nil) __interruptL(@line);
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    tmp--;
				}
			    } else {
				while (tmp >= final) {
				    if (InterruptPending != nil) __interruptL(@line);
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    tmp += step;
				}
			    }
			} else {
			    if (step == 1) {
				while (tmp <= final) {
				    if (InterruptPending != nil) __interruptL(@line);
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    tmp++;
				}
			    } else {
			        while (tmp <= final) {
				    if (InterruptPending != nil) __interruptL(@line);
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    tmp += step;
				}
			    }
			}
			RETURN (self);
		    }
		}
	    }

	    /*
	     * sorry - must check for the blocks code within the loops;
	     * it could be recompiled or flushed (in the interrupt)
	     */

#           undef BLOCK_ARG

#ifdef NEW_BLOCK_CALL
#           define BLOCK_ARG  aBlock
#           define IBLOCK_ARG nil
#else
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif

	    if (step < 0) {
		while (tmp >= final) {
		    REGISTER OBJFUNC codeVal;

		    if (InterruptPending != nil) __interruptL(@line);

		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
			/*
			 * arg is a compiled block with code -
			 * directly call it without going through Block>>value
			 */
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
		    } else {
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
			    /*
			     * arg is a compiled block with bytecode -
			     * directly call interpreter without going through Block>>value
			     */
#ifdef PASS_ARG_POINTER
			    {
				OBJ idx;

				idx = __MKSMALLINT(tmp);
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
			    }
#else
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
#endif

			} else {
			    /*
			     * arg is something else - call it with #value
			     */
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
			}
		    }
		    tmp += step;
		}
	    } else {
		while (tmp <= final) {
		    REGISTER OBJFUNC codeVal;

		    if (InterruptPending != nil) __interruptL(@line);

		    if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
			/*
			 * arg is a compiled block with code -
			 * directly call it without going through Block>>value
			 */
			(*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
		    } else {
			if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
			    /*
			     * arg is a compiled block with bytecode -
			     * directly call interpreter without going through Block>>value
			     */
#ifdef PASS_ARG_POINTER
			    {
				OBJ idx;

				idx = __MKSMALLINT(tmp);
				__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
			    }
#else
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
#endif

			} else {
			    /*
			     * arg is something else - call it with #value:
			     */
			    (*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
			}
		    }
		    tmp += step;
		}
	    }

#           undef BLOCK_ARG
#           undef IBLOCK_ARG

	} else {
	    /*
	     * arg is something else - call it with #value:
	     */
	    if (step < 0) {
		while (tmp >= final) {
		    if (InterruptPending != nil) __interruptL(@line);

		    (*blockVal.ilc_func)(aBlock, 
					 @symbol(value:), 
					 nil, &blockVal,
					 __MKSMALLINT(tmp));
		    tmp += step;
		}
	    } else {
		while (tmp <= final) {
		    if (InterruptPending != nil) __interruptL(@line);

		    (*blockVal.ilc_func)(aBlock, 
					 @symbol(value:), 
					 nil, &blockVal,
					 __MKSMALLINT(tmp));
		    tmp += step;
		}
	    }
	}
	RETURN ( self );
    }
%}.
    "/
    "/ arrive here if stop is not a smallInteger
    "/ pass on to super ...

    ^ super to:stop by:incr do:aBlock

    "
     1 to:10 by:3 do:[:i | i printNewline]
    "
!

to:stop do:aBlock
    "evaluate aBlock for every integer between (and including) the receiver
     and the argument, stop.
     Reimplemented as primitive for speed"

%{
    REGISTER INT tmp;
    INT final;
    static struct inlineCache blockVal = __ILC1(0);

    if (__isSmallInteger(stop)) {
	tmp = __intVal(self);
	final = __intVal(stop);

	if (__isBlockLike(aBlock)
	 && (__BlockInstPtr(aBlock)->b_nargs == __MKSMALLINT(1))) {
	    {
		/*
		 * specially tuned version for the most common case,
		 * where called with home on the stack
		 */
		REGISTER OBJFUNC codeVal;

                if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {

#ifdef NEW_BLOCK_CALL

#                   define BLOCK_ARG  aBlock

#else

#                   define BLOCK_ARG  rHome
		    REGISTER OBJ rHome;
		    rHome = __BlockInstPtr(aBlock)->b_home;
		    if ((rHome == nil) || (__qSpace(rHome) >= STACKSPACE)) 
#endif
		    {

			if (! ((INT)(__BlockInstPtr(aBlock)->b_flags) & __MASKSMALLINT(F_DYNAMIC))) {
			    /*
			     * static compiled blocks ...
			     */
#ifdef UNROLL_LOOPS
			    /*
			     * you are not supposed to program like this - I know what I do
			     */
			    int t8 = tmp+8;

			    for (;;) {
				if (0) {
				    /*
				     * no discussion about those gotos ...
				     * ... its better for your CPU's pipelines
				     * (if you dont understand why, just dont argue).
				     */
				    interrupted7:
						    __interruptL(@line); goto continue7;
				    interrupted6:
						    __interruptL(@line); goto continue6;
				    interrupted5:
						    __interruptL(@line); goto continue5;
				    interrupted4:
						    __interruptL(@line); goto continue4;
				    interrupted3:
						    __interruptL(@line); goto continue3;
				    interrupted2:
						    __interruptL(@line); goto continue2;
				    interrupted1:
						    __interruptL(@line); goto continue1;
				    interrupted0:
						    __interruptL(@line); goto continue0;
				}

				while (t8 <= final) {
				    t8 += 8;
				    if (InterruptPending != nil) goto interrupted0;
	continue0:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    if (InterruptPending != nil) goto interrupted1;
	continue1:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+1));
				    if (InterruptPending != nil) goto interrupted2;
	continue2:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+2));
				    if (InterruptPending != nil) goto interrupted3;
	continue3:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+3));
				    if (InterruptPending != nil) goto interrupted4;
	continue4:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+4));
				    if (InterruptPending != nil) goto interrupted5;
	continue5:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+5));
				    if (InterruptPending != nil) goto interrupted6;
	continue6:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+6));
				    if (InterruptPending != nil) goto interrupted7;
	continue7:
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp+7));
				    tmp += 8;
				}
#endif /* UNROLL_LOOPS */
				while (tmp <= final) {
				    if (InterruptPending != nil) __interruptL(@line);
				    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
				    tmp ++;
				}
				RETURN (self);
			    }
			}

			/*
			 * mhmh - seems to be a block with dynamic code
			 * must refetch, to allow dynamic recompilation or code flush.
			 */
			while (tmp <= final) {
			    if (InterruptPending != nil) __interruptL(@line);
			    if ((codeVal = __BlockInstPtr(aBlock)->b_code) == (OBJFUNC)nil) break;
			    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
			    tmp ++;
			}

			if (tmp > final) {
			    RETURN (self);
			}
		    }
		}
	    }

#           undef BLOCK_ARG

#ifdef NEW_BLOCK_CALL
#           define BLOCK_ARG  aBlock
#           define IBLOCK_ARG nil
#else
#           define BLOCK_ARG  (__BlockInstPtr(aBlock)->b_home)
#           define IBLOCK_ARG (__BlockInstPtr(aBlock)->b_home)
#endif

	    /*
	     * sorry - must check for the blocks code within the loops;
	     * it could be recompiled or flushed (in the interrupt)
	     */
	    while (tmp <= final) {
		REGISTER OBJFUNC codeVal;

		if (InterruptPending != nil) __interruptL(@line);

		if ((codeVal = __BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil) {
		    /*
		     * arg is a compiled block with code -
		     * directly call it without going through Block>>value
		     */
		    (*codeVal)(BLOCK_ARG, __MKSMALLINT(tmp));
		} else {
		    if (__BlockInstPtr(aBlock)->b_bytecodes != nil) {
			/*
			 * arg is a compiled block with bytecode -
			 * directly call interpreter without going through Block>>value
			 */
#ifdef PASS_ARG_POINTER
			{
			    OBJ idx;

			    idx = __MKSMALLINT(tmp);
			    __interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, &idx);
			}
#else
			__interpret(aBlock, 1, nil, IBLOCK_ARG, nil, nil, __MKSMALLINT(tmp));
#endif

		    } else {
			/*
			 * arg is something else - call it with #value:
			 */
			(*blockVal.ilc_func)(aBlock, @symbol(value:), nil, &blockVal, __MKSMALLINT(tmp));
		    }
		}
		tmp ++;
	    }
#           undef BLOCK_ARG
#           undef IBLOCK_ARG
	} else {
	    /*
	     * arg is something else - call it with #value:
	     */
	    while (tmp <= final) {
		if (InterruptPending != nil) __interruptL(@line);

		(*blockVal.ilc_func)(aBlock, 
					 @symbol(value:), 
					 nil, &blockVal,
					 __MKSMALLINT(tmp));
		tmp ++;
	    }
	}
	RETURN ( self );
    }
%}.

    "/
    "/ arrive here if stop is not a smallInteger
    "/ pass on to super ...
    "/
    ^ super to:stop do:aBlock

    "
     1 to:10 do:[:i | i printNewline]
    "
! !

!SmallInteger methodsFor:'misc math'!

divMod:aNumber
    "return an array filled with self // aNumber and
     self \\ aNumber.
     The result is only defined for positive receiver and
     argument."

%{  /* NOCONTEXT */
    INT val, div, mod, mySelf;

    if (__isSmallInteger(aNumber)) {
	val = __intVal(aNumber);
	if (val != 0) {
	    mySelf = __intVal(self);
	    div = mySelf / val;
	    mod = mySelf % val;

	    RETURN (__ARRAY_WITH2( __MKSMALLINT(div),
				   __MKSMALLINT(mod)));
	}
    }
%}.
    ^ super divMod:aNumber

    "
     10 // 3 

     10 \\ 3  

     10 divMod:3 
    "
!

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.
     Implemented that way, to allow for tiny systems without a Float class
     (i.e. without log)."

    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:'modulu arithmetic'!

plus:aNumber
    "return the sum of the receiver and the argument, as SmallInteger.
     The argument must be another SmallInteger.
     If the result overflows the smallInteger range, the value modulu the 
     smallInteger range is returned (i.e. the low bits of the sum).
     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
!

subtract:aNumber
    "return the difference of the receiver and the argument, as SmallInteger.
     The argument must be another SmallInteger.
     If the result overflows the smallInteger range, the value modulu the 
     smallInteger range is returned (i.e. the low bits of the sum).
     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
!

times:aNumber
    "return the product of the receiver and the argument, as SmallInteger.
     The argument must be another SmallInteger.
     If the result overflows the smallInteger range, the value modulu the 
     smallInteger range is returned (i.e. the low bits of the product).
     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 methodsFor:'printing & storing'!

printOn:aStream
    "append my printstring (base 10) to aStream."

    aStream nextPutAll:(self printString)
!

printOn:aStream base:radix
    "append my printstring in any number base to aStream.
     The radix argument should be between 2 and 36."

    aStream nextPutAll:(self printStringRadix:radix)
!

printString
    "return my printstring (base 10)"

    "since printf knows pretty good how to do this,
     here is an exception to the rule of basing printString
     upon the printOn: method."

%{  /* NOCONTEXT */

    char buffer[30];
    OBJ newString;
    /*
     * actually only needed on sparc: since thisContext is
     * in a global register, which gets destroyed by printf,
     * manually save it here - very stupid ...
     */
    __BEGIN_PROTECT_REGISTERS__

    sprintf(buffer, "%d", __intVal(self));

    __END_PROTECT_REGISTERS__

    newString = __MKSTRING(buffer COMMA_SND);
    if (newString != nil) {
	RETURN (newString);
    }
%}.
    ^ super printString
!

printStringRadix:radix
    "return my printstring (optimized for bases 16, 10 and 8)"

%{  /* NOCONTEXT */

    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) {
	/*
	 * actually only needed on sparc: since thisContext is
	 * in a global register, which gets destroyed by printf,
	 * manually save it here - very stupid ...
	 */
	__BEGIN_PROTECT_REGISTERS__

	sprintf(buffer, format, __intVal(self));

	__END_PROTECT_REGISTERS__

	newString = __MKSTRING(buffer COMMA_SND);
	if (newString != nil) {
	    RETURN (newString);
	}
    }
%}.
    "
     fall back for seldom used bases
    "
    ^ super printStringRadix:radix

    "123 printStringRadix:16"
    "123 printStringRadix:8"
    "123 printStringRadix:2"
    "123 printStringRadix:3"
    "123 printStringRadix:1"
!

printfPrintString:formatString
    "non-portable, but sometimes useful.
     return a printed representation of the receiver
     as specified by formatString, which is defined by the C-
     function 'printf'.
     No checking for string overrun - the resulting string 
     must be shorter than 256 chars or else ...
     This method is NONSTANDARD and may be removed without notice."

%{  /* STACK: 400 */

    char buffer[256];
    OBJ s;

    if (__isString(formatString)) {
	/*
	 * actually only needed on sparc: since thisContext is
	 * in a global register, which gets destroyed by printf,
	 * manually save it here - very stupid ...
	 */
	__BEGIN_PROTECT_REGISTERS__

	sprintf(buffer, __stringVal(formatString), __intVal(self));

	__END_PROTECT_REGISTERS__

	s = __MKSTRING(buffer COMMA_SND);
	if (s != nil) {
	    RETURN (s);
	}
    }
%}.
    self primitiveFailed

    "123 printfPrintString:'%%d -> %d'"
    "123 printfPrintString:'%%6d -> %6d'"
    "123 printfPrintString:'%%x -> %x'"
    "123 printfPrintString:'%%4x -> %4x'"
    "123 printfPrintString:'%%04x -> %04x'"
! !

!SmallInteger methodsFor:'private'!

sign:aNumber
    "private: for protocol completeness with LargeIntegers"

    |absVal|

    absVal := self abs.
    aNumber < 0 ifTrue:[
	^ absVal negated
    ].
    aNumber == 0 ifTrue:[^ 0].
    ^ absVal

    "
     -4 sign:-1   
     -4 sign:0    
     -4 sign:1    
     -4 sign:-1   
     -4 sign:0    
     -4 sign:1    
    "
! !

!SmallInteger methodsFor:'testing'!

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 (__bothSmallInteger(min, 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 */

    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? false : true );
%}
!

negative
    "return true, if the receiver is less than zero
     reimplemented here for speed"

%{  /* NOCONTEXT */

#if TAG_INT == 1
    /* tag bit does not change sign */
    RETURN ( ((INT)(self) < 0) ? true : false );
#else
    RETURN ( (__intVal(self) < 0) ? true : false );
#endif
%}
!

odd
    "return true, if the receiver is odd"

%{  /* NOCONTEXT */

    RETURN ( ((INT)self & (INT)__MASKSMALLINT(1)) ? true : false );
%}
!

positive
    "return true, if the receiver is not negative
     reimplemented here for speed"

%{  /* NOCONTEXT */

#if TAG_INT == 1
    /* tag bit does not change sign */
    RETURN ( ((INT)(self) >= 0) ? true : false );
#else
    RETURN ( (__intVal(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) );
%}
!

strictlyPositive
    "return true, if the receiver is greater than zero
     reimplemented here for speed"

%{  /* NOCONTEXT */

#if TAG_INT == 1
    /* tag bit does not change sign */
    RETURN ( ((INT)(self) > 0) ? true : false );
#else
    RETURN ( (__intVal(self) > 0) ? true : false );
#endif
%}
! !

!SmallInteger class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Attic/SmallInt.st,v 1.67 1997-01-24 16:23:39 cg Exp $'
! !