Integer.st
author claus
Mon, 10 Oct 1994 01:29:28 +0100
changeset 159 514c749165c3
parent 132 ab2cfccd218c
child 202 40ca7cc6fb9c
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.
"

Number subclass:#Integer
       instanceVariableNames:''
       classVariableNames:'DefaultDisplayRadix'
       poolDictionaries:''
       category:'Magnitude-Numbers'
!

Integer comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.16 1994-10-10 00:26:19 claus Exp $
'!

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

version
"
$Header: /cvs/stx/stx/libbasic/Integer.st,v 1.16 1994-10-10 00:26:19 claus Exp $
"
!

documentation
"
    abstract superclass for all integer numbers.
    See details in concrete subclasses LargeInteger and SmallInteger.
"
! !

!Integer class methodsFor:'constants'!

zero
    "return the neutral element for addition"

    ^ 0
!

unity
    "return the neutral element for multiplication"

    ^ 1
! !

!Integer class methodsFor:'instance creation'!

new:numberOfBytes neg:negative
    "for ST-80 compatibility:
     Return an empty Integer (uninitialized value) with space for
     numberOfBytes bytes (= digitLength). The additional argument
     negative specifies if the result should be a negative number.
     The digits can be stored byte-wise into the result, using digitAt:put:"

    ^ (LargeInteger basicNew numberOfDigits:numberOfBytes) 
		sign:(negative ifTrue:[-1] ifFalse:[1])
! !

!Integer class methodsFor:'misc'!

displayRadix:aNumber
    "being tired of always sending #printStringRadix: in the inspectors,
     this allows you to change the default print radix for the displayString
     method."

    DefaultDisplayRadix := aNumber

    "
     Integer displayRadix:16. 123456 inspect
     Integer displayRadix:10. 123456 inspect
    "
! !

!Integer methodsFor:'arithmetic'!

quo:aNumber
    "Return the integer quotient of dividing the receiver by aNumber with
     truncation towards zero. For Integers this is same as //"

    ^ self // aNumber

! !

!Integer methodsFor:'double dispatching'!

sumFromFraction:aFraction
    "sent when a fraction does not know how to add the recevier, an integer"

    |d|

    d := aFraction denominator.
    ^ (Fraction numerator:(aFraction numerator + (self * d))
	      denominator:d) reduced
!

differenceFromFraction:aFraction
    "sent when a fraction does not know how to subtract the recevier, an integer"

    |d|

    d := aFraction denominator.
    ^ (Fraction numerator:(aFraction numerator - (self * d))
	      denominator:d) reduced
!

productFromFraction:aFraction
    "sent when a fraction does not know how to multiply the recevier, an integer"

    ^ (Fraction numerator:(self * aFraction numerator)
	      denominator:aFraction denominator) reduced
!

quotientFromFraction:aFraction
    "sent when a fraction does not know how to divide the recevier, an integer"

    ^ (Fraction numerator:aFraction numerator
	      denominator:(self * aFraction denominator)) reduced
! !

!Integer methodsFor:'bit operators'!

bitAnd:anInteger
    "return the bitwise-and of the receiver and the argument, anInteger"

    |result n byte|

    n := (anInteger digitLength) min:(self digitLength).
    result := self class basicNew numberOfDigits:n.

    1 to:n do:[:index |
	byte := (anInteger digitAt:index) bitAnd:(self digitAt:index).
	result digitAt:index put:byte.
    ].
    byte == 0 ifTrue:[
	^ result normalize
    ].
    ^ result
!

bitOr:anInteger
    "return the bitwise-or of the receiver and the argument, anInteger"

    |result n byte|

    n := (anInteger digitLength) max:(self digitLength).
    result := self class basicNew numberOfDigits:n.

    1 to:n do:[:index |
	byte := (anInteger digitAt:index) bitOr:(self digitAt:index).
	result digitAt:index put:byte.
    ].
    byte == 0 ifTrue:[
	^ result normalize
    ].
    ^ result
!

bitXor:anInteger
    "return the bitwise-or of the receiver and the argument, anInteger"

    |result n byte|

    n := (anInteger digitLength) max:(self digitLength).
    result := self class basicNew numberOfDigits:n.

    1 to:n do:[:index |
	byte := (anInteger digitAt:index) bitXor:(self digitAt:index).
	result digitAt:index put:byte.
    ].
    byte == 0 ifTrue:[
	^ result normalize
    ].
    ^ result
!

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

    |byteNr highByte|

    byteNr := self digitLength.
    highByte := self digitAt:byteNr.
    ^ (byteNr - 1) * 8 + highByte highBit

    "
     1 highBit                  
     (1 bitShift:1) highBit     
     (1 bitShift:30) highBit    
     (1 bitShift:31) highBit    
     (1 bitShift:32) highBit    
     (1 bitShift:33) highBit    
     (1 bitShift:64) highBit     
     (1 bitShift:1000) highBit   
     ((1 bitShift:64)-1) highBit  
    "
!

bitAt:index
    "return the value of the index's bit (index starts at 1).
     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)"

    |i "{Class: SmallInteger}"|

    i := index - 1.
    ^ (self digitAt:(i // 8 + 1)) bitAt:(i \\ 8 + 1)

    "
     1 bitAt:1                  
     (1 bitShift:30) bitAt:30    
     (1 bitShift:30) bitAt:31    
     (1 bitShift:30) bitAt:32    
     (1 bitShift:31) bitAt:31    
     (1 bitShift:31) bitAt:32    
     (1 bitShift:31) bitAt:33    
     (1 bitShift:32) bitAt:32    
     (1 bitShift:32) bitAt:33    
     (1 bitShift:32) bitAt:34    
     (1 bitShift:64) bitAt:64     
     (1 bitShift:64) bitAt:65     
     (1 bitShift:64) bitAt:66     
     (1 bitShift:1000) bitAt:1000   
     (1 bitShift:1000) bitAt:1001  
     (1 bitShift:1000) bitAt:1002 
     (1 bitShift:1000) bitAt:2000  
    "
!

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)"

    |result 
     prev       "{ Class: SmallInteger }"
     next       "{ Class: SmallInteger }"
     byte       "{ Class: SmallInteger }"
     bitShift   "{ Class: SmallInteger }"
     revShift   "{ Class: SmallInteger }"
     digitShift "{ Class: SmallInteger }"
     n          "{ Class: SmallInteger }" 
     nn         "{ Class: SmallInteger }"|

    shiftCount > 0 ifTrue:[
	"left shift"

	digitShift := shiftCount // 8.
	bitShift := shiftCount \\ 8.
	n := self digitLength.

	"
	 modulu 8 shifts can be done faster ...
	"
	bitShift == 0 ifTrue:[
	    result := self class basicNew numberOfDigits:n + digitShift.
	    result sign:self sign.
	    result digits replaceFrom:(digitShift + 1) with:self digits.
	    "
	     no normalize needed, since receiver was already normalized
	    "
	    ^ result
	].

	"
	 less-than-8 shifts can be done faster ...
	"
	digitShift == 0 ifTrue:[
	    n := n + 1.
	    result := self class basicNew numberOfDigits:n.
	    result sign:self sign.
	    prev := 0.
	    1 to:n-1 do:[:index |
		byte := self digitAt:index.
		byte := (byte bitShift:bitShift) bitOr:prev.
		result digitAt:index put:(byte bitAnd:16rFF).
		prev := byte bitShift:-8.
	    ].
	    result digitAt:n put:prev.
	    "
	     might have stored a 0-byte ...
	    "
	    prev == 0 ifTrue:[
		^ result normalize
	    ].
	    ^ result.
	].

	"
	 slow case ...
	"
	n := n + digitShift + 1.
	result := self class basicNew numberOfDigits:n.
	result sign:self sign.

	byte := ((self digitAt:1) bitShift:bitShift) bitAnd:16rFF.
	result digitAt:(digitShift + 1) put:byte.
	revShift := -8 + bitShift.
	2 to:(self digitLength) do:[:index |
	    byte := (self digitAt:index) bitShift:bitShift.
	    byte := byte bitOr:((self digitAt:index-1) bitShift:revShift).
	    byte := byte bitAnd:16rFF.
	    result digitAt:(index + digitShift) put:byte
	].
	"
	 might have stored a 0-byte ...
	"
	byte == 0 ifTrue:[
	    ^ result normalize
	].
	^ result
    ].

    shiftCount < 0 ifTrue:[
	"right shift"

	digitShift := shiftCount negated // 8.
	bitShift := shiftCount negated \\ 8.
	n := self digitLength.

	digitShift >= n ifTrue:[
	    ^ 0
	].

	"
	 modulu 8 shifts can be done faster ...
	"
	bitShift == 0 ifTrue:[
	    n := n-digitShift.
	    result := self class basicNew numberOfDigits:n.
	    result sign:self sign.
	    result digits replaceFrom:1 with:self digits startingAt:(digitShift + 1) .
	    n <= 4 ifTrue:[
		^ result normalize
	    ].
	    ^ result
	].

	"
	 less-than-8 shifts can be done faster ...
	"
	digitShift == 0 ifTrue:[
	    result := self class basicNew numberOfDigits:n.
	    result sign:self sign.
	    prev := 0.
	    bitShift := bitShift negated.
	    revShift := 8 + bitShift.
	    n to:1 by:-1 do:[:index |
		byte := self digitAt:index.
		next := (byte bitShift:revShift) bitAnd:16rFF.
		byte := (byte bitShift:bitShift) bitOr:prev.
		result digitAt:index put:(byte bitAnd:16rFF).
		prev := next.
	    ].
	    (n <= 5) ifTrue:[
		^ result normalize
	    ].
	    ^ result
	].

	"
	 slow case ...
	"
	nn := n-digitShift.
	result := self class basicNew numberOfDigits:nn.
	result sign:self sign.

	prev := 0.
	bitShift := bitShift negated.
	revShift := 8 + bitShift.
	n to:(1 + digitShift) by:-1 do:[:index |
	    byte := self digitAt:index.
	    next := (byte bitShift:revShift) bitAnd:16rFF.
	    byte := (byte bitShift:bitShift) bitOr:prev.
	    result digitAt:(index - digitShift) put:byte.
	    prev := next.
	].
	"the last stored byte ..."
	^ result normalize
    ].

    ^ self "no shift"
! !

!Integer methodsFor:'truncation & rounding'!

ceiling
    "I am my ceiling"

    ^ self
!

floor
    "I am my floor"

    ^ self
!

rounded
    "return the receiver rounded toward the next Integer -
     for integers this is self"

    ^ self
!

truncated
    "return the receiver truncated towards zero - 
     for integers this is self"

    ^ self
!

normalize
    "this is ST/X's name for ST-80's compressed.
     ST/X may be changed for full compatibility."

    ^ self
!

compressed
    "this is ST-80's name for ST/X's normalize.
     ST/X may be changed for full compatibility."

    ^ self
! !

!Integer methodsFor:'queries'!

digitLength
    "return the number of bytes needed for the binary representation
     of the receiver"

    ^ (self log:256) ceiling asInteger
!

digitAt:n
    "return the n-th byte of the binary representation.
     This is a very stupid implementation, and should be redefined in
     concrete subclasses."

    |num count|

    num := self.
    count := n.
    [count > 1] whileTrue:[
	num := num // 256.
	count := count - 1
    ].
    ^ num \\ 256

    "
     16r44332211 digitAt:1     
     16r44332211 digitAt:2    
     16r44332211 digitAt:3     
     16r44332211 digitAt:4     
     16r44332211 digitAt:5     
     16r00332211 digitAt:4     
     16r00332211 digitAt:5     
    "
!

isInteger
    "return true, if the receiver is some kind of integer number"

    ^ true
! !

!Integer methodsFor:'misc math'!

factorial
    "return 1*2*3...*self"

    (self > 2) ifTrue:[
	^ self * (self - 1) factorial
    ].
    ^ self
!

gcd:anInteger
    "return the greatest common divisor (Euclid's algorithm)"

    |ttt selfInteger temp|

    ttt := anInteger.
    selfInteger := self.
    [ttt ~~ 0] whileTrue:[
	temp := selfInteger \\ ttt.
	selfInteger := ttt.
	ttt := temp
    ].
    ^ selfInteger

    "
     65 gcd:15
     3 gcd:15
     132 gcd:55
    "
!

lcm:anInteger
    "return the least common multiple (using gcd:)"

    ^ (self * anInteger) abs // (self gcd: anInteger)

    "
     65 lcm:15
     3 lcm:15
    "
!

fib
    "dont use this method if you need fibionacci numbers -
     this method is for benchmarking purposes only.
     (use fastFib instead and dont ever try 60 fib ...)"

    (self > 1) ifTrue:[
	^ (self - 1) fib + (self - 2) fib
    ].
    ^ 1

    "
     Transcript showCr:(Time millisecondsToRun:[30 fib])
    "
!

fastFib
    "this method just to show how a changed algorithm can
     change things much more drastic than tuning ...
     (compare 30 fib with 30 fastFib / dont even try 60 fib)"

    ^ self fibUsingCache:(OrderedCollection new)

    "
     Transcript showCr:(Time millisecondsToRun:[30 fastFib]) 
     Transcript showCr:(Time millisecondsToRun:[60 fastFib])
     Transcript showCr:(Time millisecondsToRun:[200 fastFib])
    "
!

fibUsingCache:fibCache
    "actual fastfib worker; keep track of already computed fib
     numbers in fibCache, which is passed around. Take value from
     the cache if already present. Doing so, the double recursive
     fib actually becomes a single recursive algorithm."

    |fib|

    self <= 1 ifTrue:[^ 1].

    fibCache size >= self ifTrue:[
	^ fibCache at:self
    ].
    fib := ((self - 2) fibUsingCache:fibCache) + ((self - 1) fibUsingCache:fibCache).

    fibCache grow:self.
    fibCache at:self put:fib.
    ^ fib
!

acker:n
    "return the value of acker(self, n)"

    (self == 0) ifTrue:[^ n + 1].
    (n == 0) ifTrue:[^ (self - 1) acker: 1].
    ^ (self - 1) acker:(self acker:(n - 1))

    "
     3 acker:2  
    "
! !

!Integer methodsFor:'coercing and converting'!

asFraction
    "return a Fraction with same value as receiver"

    ^ Fraction numerator:self denominator:1
!

asInteger
    "return the receiver truncated towards zero - 
     for integers this is self"

    ^ self
! !

!Integer methodsFor:'printing & storing'!

printOn:aStream
    "append a printed description of the receiver to aStream"

    aStream nextPutAll:(self printStringRadix:10)
!

printString
    "return a string representation of the receiver"

    ^ self printStringRadix:10
!

displayString
    "return a string for displaying in a view (as in inspector).
     The output radix is usually 10, but can be changed by setting
     DefaultDisplayRadix (see Integer>>displayRadix:)"

    (DefaultDisplayRadix isNil or:[DefaultDisplayRadix == 10]) ifTrue:[
	^ self printString
    ].
    ^ self radixPrintStringRadix:DefaultDisplayRadix

    "
     Integer displayRadix:16. 12345 
     Integer displayRadix:2.  12345 
     Integer displayRadix:10. 12345
    "
!

radixPrintStringRadix:aRadix
    "return a string representation of the receiver in the specified
     radix; prepend XXr to the string"

    ^ (aRadix printString) , 'r', (self printStringRadix:aRadix)

    "
     31 radixPrintStringRadix:2
     31 radixPrintStringRadix:3
     31 radixPrintStringRadix:36
    "
!

printStringRadix:aRadix
    "return a string representation of the receiver in the specified
     radix (without the initial XXr)"

    |num s "rx leftPart"|

    (aRadix between:2 and:36) ifFalse:[
	self error:'invalid radix'.
	^ self printStringRadix:10
    ].

    (self = 0) ifTrue:[^ '0'].
    (self < 0) ifTrue:[
	^ '-' , (self negated printStringRadix:aRadix)
    ].

    "
     claus: changed it from a recursive algorithm;
     (it used to trigger stack-overflow exceptions when printing
      3000 factorial ...)
    "
"/    leftPart := self // aRadix.
"/    (leftPart ~= 0) ifTrue:[
"/        ^ (leftPart printStringRadix:aRadix) copyWith:(Character digitValue:(self \\ aRadix))
"/    ].
"/    ^ (Character digitValue:self) asString

    num := self.
    s := (Character digitValue:(num \\ aRadix)) asString.
    num := num // aRadix.
    [num ~= 0] whileTrue:[
	s := (Character digitValue:(num \\ aRadix)) asString , s.
	num := num // aRadix.
    ].
    ^ s
!

printStringRadix:aRadix size:sz fill:fillCharacter
    "return a string representation of the receiver in the specified
     radix. The string is padded on the left with fillCharacter to make
     its size as specified in sz."

    |s|

    s := self printStringRadix:aRadix.
    s size < sz ifTrue:[
	s := ((String new:(sz - s size)) atAllPut:fillCharacter) , s
    ].
    ^ s

    "
     1024 printStringRadix:16 size:4 fill:$0
     1024 printStringRadix:2 size:16 fill:$.
     1024 printStringRadix:16 size:8 fill:(Character space)
    "
! !

!Integer class methodsFor:'instance creation'!

readFrom:aStream radix:radix
    "return the next unsigned Integer from the (character-)stream aStream 
     in radix; (assumes that the initial XXr has already been read).
     No whitespace-skipping is done.
     Returns 0 if no number available"

    |nextChar value|

    nextChar := aStream peek.
    value := 0.
    [nextChar notNil and:[nextChar isDigitRadix:radix]] whileTrue:[
	value := value * radix + nextChar digitValue.
	nextChar := aStream nextPeek
    ].
    ^ value

    "
     Integer readFrom:(ReadStream on:'12345') radix:10  
     Integer readFrom:(ReadStream on:'FFFF') radix:16  
     Integer readFrom:(ReadStream on:'1010') radix:2   
    "
!

readFrom:aStream
    "return the next Integer from the (character-)stream aStream,
     handling initial XXr for arbitrary radix numbers and initial
     sign.
     Also, all initial whitespace is skipped.
     Q: If the string does not represent a valid integer number,
	should nil be returned, or an error be raised (see Object>>readFrom:)
     A: for now, return nil.   
	This may be changed, once the ANSI spec defines this."

    |nextChar value negative|

    nextChar := aStream skipSeparators.
    (nextChar == $-) ifTrue:[
	negative := true.
	nextChar := aStream nextPeek
    ] ifFalse:[
	negative := false
    ].
    nextChar isDigit ifFalse:[ 
	"
	 the string does not represent an integer
	"
	^ nil
"
	^ self error:'expected Integer'.
"
    ].
    value := self readFrom:aStream radix:10.
    nextChar := aStream peek.
    ((nextChar == $r) or:[ nextChar == $R]) ifTrue:[
	"-xxr<number> is invalid; should be xxr-<val>"

	negative ifTrue:[
	    'invalid (negative) radix ignored' errorPrintNL.
	    negative := false
	].
	aStream next.
	value := self readFrom:aStream radix:value
    ].
    negative ifTrue:[
	^ value negated
    ].
    ^ value

    "
     Integer readFrom:(ReadStream on:'12345')  
     Integer readFrom:(ReadStream on:'16rFFFF')  
     Integer readFrom:(ReadStream on:'12345.1234')  
     Integer readFrom:(ReadStream on:'foo')

     Object errorSignal handle:[:ex | ex returnWith:0] 
			    do:[Integer readFrom:(ReadStream on:'foo')]    
    "
! !

!Integer methodsFor:'benchmarking'!

sieve
    "sieve the primes self times"

    |num i k prime count flags time|

    num := 8191.
    flags := Array new:num.

    Transcript show:'Sieve running ...'.
    Transcript cr.

    time := Time millisecondsToRun:[
	self timesRepeat:[
	    count := 0.
	    flags atAllPut:1.
	    i := 1.
	    num timesRepeat:[
		(flags at:i) == 1 ifTrue:[
		    prime := i + i + 3.
		    k := i + prime.
		    [k <= num] whileTrue:[
			flags at:k put:0.
			k := k + prime
		    ].
		    count := count + 1
		].
		i := i + 1
	    ].
	].
    ].
    Transcript show:'Sieve in Smalltalk: '.
    Transcript show:self printString. 
    Transcript showCr:' iteration(s).'.
    Transcript show:'found '. 
    Transcript show:count printString. 
    Transcript showCr:' primes.' .
    Transcript show:'time per run: '. 
    Transcript show:(time / self) printString. 
    Transcript showCr:' ms.'

    "1 sieve"
!

sieveWithIntegers
    "sieve the primes self times"

    |num        "<SmallInteger>"
     i          "<SmallInteger>"
     k          "<SmallInteger>"
     prime      "<SmallInteger>"
     count      "<SmallInteger>"
     flags time|

    num := 8191.
    flags := Array new:num.

    Transcript show:'Sieve running ...'.
    Transcript cr.

    time := Time millisecondsToRun:[
	self timesRepeat:[
	    count := 0.
	    flags atAllPut:1.
	    i := 1.
	    num timesRepeat:[
		(flags at:i) == 1 ifTrue:[
		    prime := i + i + 3.
		    k := i + prime.
		    [k <= num] whileTrue:[
			flags at:k put:0.
			k := k + prime
		    ].
		    count := count + 1
		].
		i := i + 1
	    ].
	].
    ].
    Transcript show:'Sieve in Smalltalk: '.
    Transcript show:self printString. 
    Transcript showCr:' iteration(s).'.
    Transcript show:'found '. 
    Transcript show:count printString. 
    Transcript showCr:' primes.' .
    Transcript show:'time per run: '. 
    Transcript show:(time / self) printString. 
    Transcript showCr:' ms.'

    "1 sieveWithIntegers"
!

recur1:num
    "actual recursion method for recur1"

    (num = 0) ifTrue:[^ self].
    self recur1:(num - 1).
    ^ self recur1:(num - 1)
!

recur1
    "lots of recursion for testing send with arg"

    |t|

    t := Time millisecondsToRun:[
	1 recur1:15
    ].
    Transcript showCr:(t printString)

    "1 recur1"
!

doRecur2
    "lots of recursion for testing send without arg"

    (self > 0) ifTrue:[
	(self - 1) doRecur2.
	^ (self - 1) doRecur2
    ]
!

recur2
    "lots of recursion for testing send without arg"

    |t|

    t := Time millisecondsToRun:[
	15 doRecur2
    ].
    Transcript showCr:(t printString)

    "1 recur2"
!

blockEvaluation
    "evaluating a simple block"

    |t|

    t := Time millisecondsToRun:[
	|b|

	b := [99].
	1000000 timesRepeat:[b value]
    ].
    Transcript showCr:(t printString)

    "1 blockEvaluation"
!

countDown
    "count down - notice, that index is a method var"

    |t index|

    t := Time millisecondsToRun:[
	index := 100000.
	[index > 0] whileTrue:[
	    index := index - 1
	].
    ].
    Transcript showCr:(t printString)

    "1 countDown"
!

countDown2
    "count down - notice, that index is a block var"

    |t|

    t := Time millisecondsToRun:[
	|index|

	index := 100000.
	[index > 0] whileTrue:[
	    index := index - 1
	].
    ].
    Transcript showCr:(t printString)

    "1 countDown2"
!

noopSelf
    ^ self
!

noopNil
    ^ nil
!

noopTrue
    ^ true
!

send
    "lots of dummy message sends.
     About half of the time is spent in block evaluation 
     (timesRepeat is not inlined), another half in the send itself."

    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    self noopSelf
	].
    ].
    Transcript showCr:(t printString)

    "1000000 send"
!

send2
    "lots of dummy message sends. This tests the speed of a ^self method.
     Almost all time is spent in the send (since timesRepeat is inlined here)."

    |t|

    t := Time millisecondsToRun:[
	1000000 timesRepeat:[
	    self noopSelf
	].
    ].
    Transcript showCr:(t printString)

    "1 send2"
!

send3
    "lots of dummy message sends. This tests the speed of a ^nil method.
     Almost all time is spent in the send (since timesRepeat is inlined here)."

    |t|

    t := Time millisecondsToRun:[
	1000000 timesRepeat:[
	    self noopNil
	].
    ].
    Transcript showCr:(t printString)

    "1 send3"
!

send4
    "lots of dummy message sends. This tests the speed of a ^true method.
     Almost all time is spent in the send (since timesRepeat is inlined here)."

    |t|

    t := Time millisecondsToRun:[
	1000000 timesRepeat:[
	    self noopTrue
	].
    ].
    Transcript showCr:(t printString)

    "1 send4"
!

instAccess1
    "check simple send & instvar access time.
     About half of the time is spent in block evaluation 
     (timesRepeat is not inlined), another half in the send itself."

    |t|

    t := Time millisecondsToRun:[
	|a|

	a := 1->2.
	self timesRepeat:[a key].
    ].
    Transcript showCr:(t printString)

    "1000000 instAccess1"
!

instAccess2
    "check simple send & instvar access time.
     This tests the speed of a ^instVar method.
     Almost all time is spent in the send (since timesRepeat is inlined here)."

    |t|

    t := Time millisecondsToRun:[
	|a|

	a := 1->2.
	1000000 timesRepeat:[a key].
    ].
    Transcript showCr:(t printString)

    "1 instAccess2"
!

memory
    "lots of memory allocation 
     (GC benchmark; allocates, nils & collects about 200Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ....
     Here a block evaluation is performed, but its time is only
     a very small fraction compared to allocation & gc-time."

    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    Array new:500
	].
    ].
    Transcript showCr:(t printString)

    "100000 * 500 * (4 bytes/object) -> 200000000"
    "100000 memory"
!

memory2
    "lots of memory allocation
     (GC benchmark; allocates, nils & collects about 200Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ...
     Since timesRepeat-block is inlined here, all time is spent in
     allocation & gc."

    |t|

    t := Time millisecondsToRun:[
	100000 timesRepeat:[
	    Array new:500
	].
    ].
    Transcript showCr:(t printString)

    "1 memory2"
!

benchArithmetic
    "arithmetic speed bench 
     (actually, this is a GC, and block evaluation benchmark.
      it allocates & collects about 40Mb during its run).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |p n m t|

    n := 3.0.
    m := 5.5.

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    p := 5 / n + m
	]
    ].
    Transcript showCr:(t printString)

    "creates 2 new floats (about 20bytes each) per iteration"
    "1000000 benchArithmetic"
!

benchArithmetic2
    "arithmetic speed bench (comp.lang.smalltalk)
     (actually, this is a GC benchmark, 
      it allocates & collects about 20Mb during its run).
     Since timesRepeat-block is inlined, all time is spent in
     float-addition, allocation and gc. Compare the time with
     the benchNew/benchBasicNew times.
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |t|

    t := Time millisecondsToRun:[
	|x|
	x := 0.0.
	1000000 timesRepeat:[x := x + 1.0]
    ].
    Transcript showCr:(t printString)

    "creates 1 new float (about 20bytes) per iteration"
    "1 benchArithmetic2"
!

benchArithmetic3
    "arithmetic speed bench
     (actually, this is a GC, and block evaluation benchmark.
      it allocates & collects about 20Mb during its run;
      compare the time to benchBasicNew-time).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |t|

    t := Time millisecondsToRun:[
	|x|
	x := 0.0.
	self timesRepeat:[x := x + 1.0]
    ].
    Transcript showCr:(t printString)

    "creates 1 new float (about 20bytes) per iteration"
    "1000000 benchArithmetic3"
!

benchArithmetic4
    "arithmetic speed bench
     currently, the compiler does not use the Float-hint, except that an
     added float-check is done in the store operation. Newer versions of
     stc will show much better performance here."

    |t|

    t := Time millisecondsToRun:[
	|x "{ Class: Float }" |
	x := 0.0.
	1000000 timesRepeat:[x := x + 1.0]
    ].
    Transcript showCr:(t printString)

    "creates 1 new float (about 20bytes) per iteration"
    "1 benchArithmetic3"
!

benchNew
    "instance creation speed bench 
     (GC benchmark; allocating & collecting about 12Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    Object new
	]
    ].
    Transcript showCr:(t printString)

    "1000000 benchNew"
!

benchBasicNew
    "instance creation speed bench 
     (GC benchmark; allocating & collecting about 12Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    Object basicNew
	]
    ].
    Transcript showCr:(t printString)

    "1000000 benchBasicNew"
!

benchArrayBasicNew
    "instance creation speed bench 
     (GC benchmark; allocating & collecting about 12Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."


    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    Array basicNew
	]
    ].
    Transcript showCr:(t printString)

    "1000000 benchArrayBasicNew"
!

benchArrayNew
    "instance creation speed bench 
     (GC benchmark; allocating & collecting about 12Mb).
     Run this benchmark a few times - its outcome depends on 
     newSpace fill-grade & cache patterns ..."

    |t|

    t := Time millisecondsToRun:[
	self timesRepeat:[
	    Array new
	]
    ].
    Transcript showCr:(t printString)

    "1000000 benchArrayNew"
!

benchSetCreation
    "benchmark set grow (from comp.lang.smalltalk).
     The loop is inlined, but access to the set is via the
     method local (s), which is outside the time-block."

    |s t|

    s := Set new.
    t := Time millisecondsToRun:[
	1 to:4500 do:[:i | s add:i]
    ].

    Transcript showCr:(t printString)

    "1 benchSetCreation"
!

benchSetCreation2
    "benchmark set grow (from comp.lang.smalltalk).
     This is slightly faster than benchSetCreation, since access to
     the set is via a block local variable (s)."

    |t|

    t := Time millisecondsToRun:[
	|s|
	s := Set new.
	1 to:4500 do:[:i | s add:i]
    ].

    Transcript showCr:(t printString)

    "1 benchSetCreation2"
!

benchSetCreation3
    "benchmark set grow (from comp.lang.smalltalk).
     Compare the time with benchSetCreation2 - the set is preallocated,
     thus no growing is needed in the loop."

    |t|

    t := Time millisecondsToRun:[
	|s|
	s := Set new:4500.
	1 to:4500 do:[:i | s add:i]
    ].

    Transcript showCr:(t printString)

    "1 benchSetCreation3"
!

loopTimes
    "runs the self low-level loop benchmarks"

    Transcript show:'fastSumTo:  '; showCr:(Time millisecondsToRun:[1 fastSumTo]).
    Transcript show:'nextedLoop: '; showCr:(Time millisecondsToRun:[1 nestedLoop]).
    Transcript show:'atAllput:   '; showCr:(Time millisecondsToRun:[1 atAllPut]).
    Transcript show:'sumAll:     '; showCr:(Time millisecondsToRun:[1 sumAll]).
    Transcript show:'sumTo:      '; showCr:(Time millisecondsToRun:[1 sumTo]).

    "1 loopTimes"
!

sumTo
    |val|

    100 timesRepeat:[
	val := 0.
	1 to:10000 do:[:i |
	    val := val + i
	]
    ].
    "Transcript showCr:(Time millisecondsToRun:[1 sumTo])"
!

fastSumTo
    |val i|

    100 timesRepeat:[
	val := 0.
	i := 1.
	[i <= 10000] whileTrue:[
	    val := val + i.
	    i := i + 1
	].
    ].
    "Transcript showCr:(Time millisecondsToRun:[1 fastSumTo])"
!

nestedLoop
    |i|

    100 timesRepeat:[
	i := 0.
	1 to:100 do:[:l1 |
	    1 to:100 do:[:l2 |
		i := i + 1
	    ]
	]
    ]
    "Transcript showCr:(Time millisecondsToRun:[1 nestedLoop])"
!

atAllPut
    |vec t|

    vec := Array new:100000.
    t := Time millisecondsToRun:[
	1 to:100000 do:[:i |
	    vec at:i put:7
	]
    ].
    ^ t

    "Transcript showCr:(1 atAllPut)"
!

sumAll 
    |vec t s|

    vec := Array new:100000.
    1 to:100000 do:[:i |
	vec at:i put:7
    ].
    s := 0.
    t := Time millisecondsToRun:[
	1 to:100000 do:[:i |
	    s := s + (vec at:i)
	]
    ].
    ^ t

    "Transcript showCr:(1 sumAll)"
! !