SmallInteger.st
changeset 357 82091a50055d
parent 329 f14fc5ac11b7
child 369 730e0f5d2404
--- a/SmallInteger.st	Wed May 24 14:44:58 1995 +0200
+++ b/SmallInteger.st	Tue Jun 06 05:56:11 1995 +0200
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1988 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.28 1995-05-01 21:39:04 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.29 1995-06-06 03:55:33 claus Exp $
 '!
 
 !SmallInteger class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.28 1995-05-01 21:39:04 claus Exp $
+$Header: /cvs/stx/stx/libbasic/SmallInteger.st,v 1.29 1995-06-06 03:55:33 claus Exp $
 "
 !
 
@@ -1237,41 +1237,64 @@
 
 %{  /* NOCONTEXT */
 
-    INT val;
+    REGISTER INT val;
+    INT idx;
 
     if (__isSmallInteger(index)) {
 	val = _intVal(self);
 	if (val < 0)
 	    val = -val;
-	switch (_intVal(index)) {
+	switch (idx = _intVal(index)) {
 	    case 1:
-		RETURN ( _MKSMALLINT( val & 0xFF) );
+		break;
 	    case 2:
-		RETURN ( _MKSMALLINT( (val >> 8) & 0xFF) );
+		val = (val >> 8);
+		break;
 	    case 3:
-		RETURN ( _MKSMALLINT( (val >> 16) & 0xFF) );
+		val = (val >> 16);
+		break;
 	    case 4:
-		RETURN ( _MKSMALLINT( (val >> 24) & 0xFF) );
+		val = (val >> 24);
+		break;
 #ifdef alpha
 	    case 5:
-		RETURN ( _MKSMALLINT( (val >> 32) & 0xFF) );
+		val = (val >> 32);
+		break;
 	    case 6:
-		RETURN ( _MKSMALLINT( (val >> 40) & 0xFF) );
+		val = (val >> 40);
+		break;
 	    case 7:
-		RETURN ( _MKSMALLINT( (val >> 48) & 0xFF) );
+		val = (val >> 48);
+		break;
 	    case 8:
-		RETURN ( _MKSMALLINT( (val >> 56) & 0xFF) );
+		val = (val >> 56);
+		break;
 #endif
+	    default:
+		if (idx < 1)
+		    goto bad;   /* sorry */
+		val = 0;
+		break;
 	}
+	RETURN ( _MKSMALLINT( val & 0xFF) );
     }
+  bad: ;
 %}.
     index > 0 ifFalse:[
-	self primitiveFailed
+	"
+	 index less than 1 - not allowed
+	"
+	^ self primitiveFailed
     ].
     ^ 0
 
-    "(16r12345678 digitAt:1) printStringRadix:16"
-    "(16r12345678 digitAt:3) printStringRadix:16"
+    "
+     (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
+    "
 ! !
 
 !SmallInteger methodsFor:'misc math'!
@@ -1318,7 +1341,9 @@
 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"
+     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'
@@ -1357,13 +1382,6 @@
     OBJ newFloat;
 
     _qMKFLOAT(newFloat, (double)_intVal(self), SENDER);
-/*
-    _qNew(newFloat, sizeof(struct floatstruct), SENDER);
-    if (newFloat != nil) {
-	_InstPtr(newFloat)->o_class = Float;
-	_FloatInstPtr(newFloat)->f_floatvalue = _intVal(self);
-    }
-*/
     RETURN ( newFloat );
 %}
 !
@@ -1383,21 +1401,77 @@
 !SmallInteger methodsFor:'iteration'!
 
 timesRepeat:aBlock
-    "evaluate the argument, aBlock self times"
+    "evaluate the argument, aBlock self times.
+     Reimplemented as primitive for speed"
 
-    |count "{ Class: SmallInteger }" |
+    |home|
+%{
+    REGISTER INT tmp;
+    REGISTER OBJFUNC code;
+    extern OBJ Block;
+    static struct inlineCache blockVal = __ILC0(0);
+    REGISTER OBJ rHome;
 
-    count := self.
-    [count > 0] whileTrue:[
-	aBlock value.
-	count := count - 1
-    ]
+    tmp = __intVal(self);
+    if (tmp > 0) {
+	if (__isBlockLike(aBlock)
+	 && ((code = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+	 && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(0))) {
+#ifdef NEW_BLOCK_CALL
+	    do {
+		if (InterruptPending != nil) interrupt(CONARG);
+		(*code)(aBlock COMMA_CON);
+	    } while(--tmp);
+#else /* old BLOCK_CALL */
+	    /*
+	     * 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
+		 */
+		do {
+		    if (InterruptPending != nil) interrupt(CONARG);
+		    (*code)(rHome COMMA_CON);
+		} while(--tmp);
+	    } else {
+		do {
+		    if (InterruptPending != nil) interrupt(CONARG);
+		    (*code)(home COMMA_CON);
+		} while(--tmp);
+	    }
+#endif /* NEW_BLOCK_CALL */
+	} else {
+	    /*
+	     * arg is something else - call it with value"
+	     */
+	    do {
+		if (InterruptPending != nil) interrupt(CONARG);
+
+		(*blockVal.ilc_func)(aBlock, 
+				     @symbol(value), 
+				     CON_COMMA nil, &blockVal);
+	    } while(--tmp);
+	}
+    }
+%}
+
+"/    |count "{ Class: SmallInteger }" |
+"/
+"/    count := self.
+"/    [count > 0] whileTrue:[
+"/        aBlock value.
+"/        count := count - 1
+"/    ]
 !
 
 to:stop do:aBlock
     "evaluate aBlock for every integer between (and including) the receiver
      and the argument, stop.
-     Reimplemented for speed"
+     Reimplemented as primitive for speed"
 
     |home|
 %{
@@ -1470,7 +1544,7 @@
 !
 
 to:stop by:incr do:aBlock
-    "reimplemented for speed"
+    "reimplemented as primitive for speed"
 
     |home|
 %{