--- a/SmallInteger.st Fri Aug 05 03:03:07 1994 +0200
+++ b/SmallInteger.st Fri Aug 05 03:03:10 1994 +0200
@@ -20,6 +20,8 @@
SmallInteger comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.15 1994-08-05 01:02:35 claus Exp $
'!
!SmallInteger class methodsFor:'documentation'!
@@ -40,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.14 1994-06-02 16:22:08 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.15 1994-08-05 01:02:35 claus Exp $
"
!
@@ -587,26 +589,43 @@
unsigned INT productLow, productHi;
int negative;
-# define lowBits(foo) (foo & 0xFFFF)
-# define hiBits(foo) (foo >> 16)
+# define lowBits(foo) ((foo) & 0xFFFF)
+# define hiBits(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(NOTDEF) && defined(__GNUC__) && (__GNUC__ >= 2)
- /*
- * commented, since long-long arithmetic seems to
- * be buggy in some implementations ...
- * (took me a while to find this out :-(
- */
+#if defined(_LONGLONG)
{
long long product;
- product = myValue * otherValue;
+ 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;
@@ -634,71 +653,75 @@
"rm" ((unsigned long)(otherValue)));
# else
{
- unsigned INT pHH, pHL, pLH, pLL;
- unsigned INT low1, low2, hi1, hi2;
- unsigned INT t;
+ 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 = lowBits(myValue);
- hi1 = hiBits(myValue);
- low2 = lowBits(otherValue);
- hi2 = hiBits(otherValue);
+ /* 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 = lowBits(myValue);
+ hi1 = hiBits(myValue);
+ low2 = lowBits(otherValue);
+ hi2 = hiBits(otherValue);
- pLH = low1 * hi2;
- pHL = hi1 * low2;
- pLL = low1 * low2;
+ 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)) );
+ /*
+ * the common case ...
+ */
+ if ((pHL == 0)
+ && (pLH == 0)
+ && ((pLL & 0xC0000000) == 0)) {
+ if (negative) {
+ RETURN ( _MKSMALLINT(- ((INT)pLL)) );
+ }
+ RETURN ( _MKSMALLINT((INT)pLL) );
}
- RETURN ( _MKSMALLINT((INT)pLL) );
- }
- pHH = hi1 * hi2;
+ pHH = hi1 * hi2;
- /*
- * pHH |--------|--------|
- * pLH |--------|--------|
- * pHL |--------|--------|
- * pLL |--------|--------|
- */
+ /*
+ * pHH |--------|--------|
+ * pLH |--------|--------|
+ * pHL |--------|--------|
+ * pLL |--------|--------|
+ */
- t = lowBits(pLH) + lowBits(pHL) + hiBits(pLL);
- productLow = (t << 16) + lowBits(pLL);
- productHi = pHH + hiBits(t) + hiBits(pHL) + hiBits(pLH);
+ t = lowBits(pLH) + lowBits(pHL) + hiBits(pLL);
+ productLow = (t << 16) + lowBits(pLL);
+ productHi = pHH + hiBits(t) + hiBits(pHL) + hiBits(pLH);
}
-
# endif
# endif
-
if (productHi == 0) {
- if (productLow < _MAX_INT) {
- if (negative) {
+ if (negative) {
+ if (productLow <= -(_MIN_INT)) {
RETURN ( _MKSMALLINT(-((INT)productLow)) );
+ }
+ } else {
+ if (productLow <= _MAX_INT) {
+ RETURN ( _MKSMALLINT(productLow) );
}
- RETURN ( _MKSMALLINT(productLow) );
}
}
+#endif
+
{
- extern OBJ LargeInteger, _sign_value16_value16_value16_value16_;
+ extern OBJ LargeInteger,
+ _sign_value16_value16_value16_value16_;
static struct inlineCache val = _ILC5;
OBJ aLarge;
aLarge = (*val.ilc_func)(LargeInteger,
- @symbol(sign:value16:value16:value16:value16:),
- CON_COMMA nil, &val,
+ @symbol(sign:value16:value16:value16:value16:),
+ CON_COMMA nil, &val,
negative ? _MKSMALLINT(-1) : _MKSMALLINT(1),
_MKSMALLINT(lowBits(productLow)),
_MKSMALLINT(hiBits(productLow)),
@@ -706,7 +729,6 @@
_MKSMALLINT(hiBits(productHi)) );
RETURN(aLarge);
}
-#endif
} else if ((aNumber != nil) && (_qClass(aNumber) == Float)) {
OBJ newFloat;
double val;
@@ -737,9 +759,10 @@
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.
+ 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 :-)
*/
@@ -943,7 +966,10 @@
!SmallInteger methodsFor:'bit operators'!
bitAt:index
- "return the value of the index's bit (index starts at 1)"
+ "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|
@@ -1053,7 +1079,9 @@
bitShift:shiftCount
"return the value of the receiver shifted by shiftCount bits;
leftShift if shiftCount > 0; rightShift otherwise.
- This method is (currently) not handling largeInteger overflow"
+ 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 */
@@ -1063,32 +1091,66 @@
count = _intVal(shiftCount);
bits = _intVal(self);
if (count > 0) {
- /*
- * check for overflow
- */
- if (count < (N_INT_BITS-1)) {
- if (! (bits >> (N_INT_BITS - 1 - count))) {
+#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 LargeInteger,
+ _sign_value16_value16_value16_value16_;
+ static struct inlineCache val = _ILC5;
+ OBJ aLarge;
+
+ aLarge = (*val.ilc_func)(LargeInteger,
+ @symbol(sign:value16:value16:value16:value16:),
+ CON_COMMA nil, &val,
+ _MKSMALLINT(1),
+ _MKSMALLINT(lowBits(result)),
+ _MKSMALLINT(hiBits(result)),
+ _MKSMALLINT(lowBits(result >> 32)),
+ _MKSMALLINT(hiBits(result >> 32)) );
+ RETURN(aLarge);
+ }
+ }
+#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 */
- }
+ }
+ /*
+ * so, there is an overflow ...
+ * handle it as largeInteger
+ */
+ /* FALL THROUGH */
+ }
+#endif
} else {
- /*
- * right shifts cannot overflow
- */
+ /*
+ * 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
+ ^ (LargeInteger value:self) bitShift:shiftCount
].
^ self bitShift:(shiftCount coerce:1)
!
@@ -1389,8 +1451,8 @@
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock,
- @symbol(value:),
- CON_COMMA nil, &blockVal,
+ @symbol(value:),
+ CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
tmp++;
}
@@ -1490,8 +1552,8 @@
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock,
- @symbol(value:),
- CON_COMMA nil, &blockVal,
+ @symbol(value:),
+ CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
tmp += step;
}
@@ -1500,8 +1562,8 @@
if (InterruptPending != nil) interrupt(CONARG);
(*blockVal.ilc_func)(aBlock,
- @symbol(value:),
- CON_COMMA nil, &blockVal,
+ @symbol(value:),
+ CON_COMMA nil, &blockVal,
_MKSMALLINT(tmp));
tmp += step;
}
@@ -1585,12 +1647,14 @@
#ifdef THISCONTEXT_IN_REGISTER
OBJ sav = __thisContext;
#endif
+ int sz;
sprintf(buffer, "%d", _intVal(self));
#ifdef THISCONTEXT_IN_REGISTER
__thisContext = sav;
#endif
- _qNew(newString, sizeof(struct stringheader) + strlen(buffer) + 1, SENDER);
+ sz = sizeof(struct stringheader) + strlen(buffer) + 1;
+ _qNew(newString, sz, SENDER);
_InstPtr(newString)->o_class = String;
strcpy(_stringVal(newString), buffer);
RETURN (newString);
@@ -1612,6 +1676,7 @@
char *format = (char *)0;
char buffer[30];
OBJ newString;
+ int sz;
if (_isSmallInteger(radix)) {
switch (_intVal(radix)) {
@@ -1635,7 +1700,8 @@
#ifdef THISCONTEXT_IN_REGISTER
__thisContext = sav;
#endif
- _qNew(newString, sizeof(struct stringheader) + strlen(buffer) + 1, SENDER);
+ sz = sizeof(struct stringheader) + strlen(buffer) + 1;
+ _qNew(newString, sz, SENDER);
_InstPtr(newString)->o_class = String;
strcpy(_stringVal(newString), buffer);
RETURN (newString);