--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ArithVal.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,613 @@
+"
+ COPYRIGHT (c) 1993 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.
+"
+
+Magnitude subclass:#ArithmeticValue
+       instanceVariableNames:''
+       classVariableNames:'DivisionByZeroSignal DomainErrorSignal
+                           OverflowSignal UnderflowSignal
+			   AnyArithmeticSignal'
+       poolDictionaries:''
+       category:'Magnitude-Numbers'
+!
+
+ArithmeticValue comment:'
+
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+ArithmeticValue is an abstract superclass for all things responding to
+arithmetic messages. It was inserted into the hierarchy, to allow things
+like matrices, functions etc. share the arithmetic methods defined here.
+
+(In the old hierarchy these had to be Numbers to do that 
+ - which is not quite correct)
+
+%W% %E%
+'!
+
+!ArithmeticValue class methodsFor:'initialization' !
+
+initialize
+    "setup the signals"
+
+    DomainErrorSignal := (Signal new) mayProceed:false.
+    DomainErrorSignal notifierString:'domain error'.
+
+    DivisionByZeroSignal := (Signal new) mayProceed:false.
+    DivisionByZeroSignal notifierString:'division by zero'.
+
+    OverflowSignal := (Signal new) mayProceed:false.
+    OverflowSignal notifierString:'overflow'.
+
+    UnderflowSignal := (Signal new) mayProceed:false.
+    UnderflowSignal notifierString:'underflow'.
+
+    AnyArithmeticSignal := SignalSet with:DomainErrorSignal
+				     with:DivisionByZeroSignal
+				     with:OverflowSignal
+				     with:UnderflowSignal.
+! !
+
+!ArithmeticValue class methodsFor:'signal access' !
+
+domainErrorSignal
+    "return the signal which is raised on math errors
+     (such as log of 0 etc.)"
+
+    ^ DomainErrorSignal
+!
+
+divisionByZeroSignal
+    "return the signal which is raised on division by zero"
+
+    ^ DivisionByZeroSignal
+!
+
+overflowSignal
+    "return the signal which is raised on overflow conditions (in floats)"
+
+    ^ OverflowSignal
+!
+
+underflowSignal
+    "return the signal which is raised on underflow conditions (in floats)"
+
+    ^ UnderflowSignal
+!
+
+anyArithmeticSignal
+    "return a signalSet with all possible arithmetic signals"
+
+    ^ AnyArithmeticSignal
+! !
+
+!ArithmeticValue methodsFor:'converting' !
+
+degreesToRadians
+    "interpreting the receiver as radians, return the degrees"
+
+    ^ self asFloat degreesToRadians
+!
+
+radiansToDegrees
+    "interpreting the receiver as degrees, return the radians"
+
+    ^ self asFloat radiansToDegrees
+!
+
+asInteger
+    "return an integer with same value - might truncate"
+
+    ^ self truncated
+!
+
+asFloat
+    "return a float with same value"
+
+   ^ self subclassResponsibility
+!
+
+asFraction
+    "return a fraction with same value"
+
+   ^ self subclassResponsibility
+!
+
+coerce:aNumber
+    "convert aNumber into an instance of the receivers class and return it."
+
+    ^ self subclassResponsibility
+!
+
+generality
+    "return a number giving the receivers generality, that number is
+     used to convert one of the arguments in a mixed expression. 
+     The generality has to be defined in subclasses,
+     such that gen(a) > gen(b) iff, conversion of b into a's class 
+     does not cut precision. For example, Integer has 40, Float has 80,
+     meaning that if we convert a Float to an Integer, some precision may
+     be lost. The generality is used by ArithmeticValue>>retry:cuercing:"
+      
+    ^ self subclassResponsibility
+!
+
+retry:aSymbol coercing:aNumber
+    "arithmetic represented by the binary operator, aSymbol,
+    could not be performed with the receiver and the argument, aNumber, 
+    because of the differences in representation.  
+    Coerce either the receiver or the argument, depending on which has higher 
+    generality, and try again.  
+    If the operation is compare for same value (=), return false if
+    the argument is not a Number. 
+    If the generalities are the same, create an error message, since this
+    means that a subclass has not been fully implemented."
+
+    |myGenerality otherGenerality|
+
+    (aSymbol == #=) ifTrue:[
+        (aNumber respondsTo:#generality) ifFalse:[^ false]
+    ] ifFalse:[
+        (aNumber respondsTo:#generality) ifFalse:[
+            self error:'retry:coercing: argument is not a number'.
+            ^ self
+        ]
+    ].
+    myGenerality := self generality.
+    otherGenerality := aNumber generality.
+    (myGenerality > otherGenerality) ifTrue:[
+        ^ self perform:aSymbol with:(self coerce:aNumber)
+    ].
+    (myGenerality < otherGenerality) ifTrue:[
+        ^ (aNumber coerce:self) perform:aSymbol with:aNumber
+    ].
+    self error:'retry:coercing: oops - same generality'
+! !
+
+!ArithmeticValue methodsFor:'queries' !
+
+respondsToArithmetic
+    "return true, if the receiver responds to arithmetic messages"
+
+    ^ true
+! !
+
+!ArithmeticValue methodsFor:'arithmetic' !
+
++ something
+    "return the sum of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+- something
+    "return the difference of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+* something
+    "return the product of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+/ something
+    "return the quotient of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+// something
+    "return the integer quotient of the receiver and the argument"
+
+    ^ (self / something) floor
+!
+
+\\ something
+    "return the integer modulu of the receiver and the argument"
+
+    ^ self - ((self // something) * something)
+!
+
+quo:something
+    "Return the integer quotient of dividing the receiver by the argument
+     with truncation towards zero."
+
+    ^ (self / something) truncated
+!
+
+rem:something
+    "Return the integer remainder of dividing the receiver by the argument
+     with truncation towards zero.
+     The remainder has the same sign as the receiver."
+
+    ^ self - ((self quo:something) * something)
+!
+
+abs
+    "return the absolute value of the receiver"
+
+    (self negative) ifTrue:[^ self negated].
+    ^ self
+!
+
+negated
+    "return the receiver negated"
+
+    ^ self class zero - self
+!
+
+reciprocal
+    "return the receivers reciprocal"
+
+    ^ self class unity / self
+! !
+
+!ArithmeticValue methodsFor:'comparing'!
+
+>= something
+    "return true, if the argument is less or equal than the receiver"
+
+    ^ (self < something) not
+!
+
+> something
+    "return true, if the argument is less than the receiver"
+
+    ^ something < self
+!
+
+<= something
+    "return true, if the argument is greater or equal than the receiver"
+
+    ^ (something < self) not
+!
+
+< something
+    "return true, if the argument is greater than the receiver"
+
+    ^ self subclassResponsibility
+!
+
+compare:arg ifLess:lessBlock ifEqual:equalBlock ifGreater:greaterBlock
+    "three-way compare - thanks to Self for this idea.
+     Can be redefined in subclasses to do it with a single comparison if
+     comparison is expensive."
+
+    self < arg ifTrue:[
+        ^ lessBlock value
+    ].
+    self = arg ifTrue:[
+        ^ equalBlock value
+    ].
+    ^ greaterBlock value
+! !
+
+!ArithmeticValue methodsFor:'truncation and rounding'!
+
+ceiling
+    "return the integer nearest the receiver towards positive infinity."
+
+    |anInteger|
+
+    anInteger := self // 1.       "truncates towards negative infinity"
+    anInteger = self ifTrue:[^ anInteger].
+    ^ anInteger + 1
+!
+
+floor
+    "return the receiver truncated towards negative infinity"
+
+    ^ self // 1
+!
+
+truncated
+    "return the receiver truncated towards zero"
+
+    ^ self floor asInteger
+!
+
+truncateTo:aNumber
+    "return the receiver truncated to multiples of aNumber"
+
+    ^ ((self / aNumber) floor * aNumber) asInteger
+!
+
+rounded
+    "return the integer nearest the receiver"
+
+    ^ (self + 0.5) floor asInteger
+!
+
+roundTo:aNumber
+    "return the receiver rounded to multiples of aNumber"
+
+    ^ (self / aNumber) rounded * aNumber
+! !
+
+!ArithmeticValue methodsFor:'double dispatching'!
+
+sumFromInteger:anInteger
+    "the receiver does not know how to add an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#+ coercing:self
+!
+
+sumFromFloat:aFloat
+    "the receiver does not know how to add a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#+ coercing:self
+!
+
+sumFromFraction:aFraction
+    "the receiver does not know how to add a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#+ coercing:self
+!
+
+differenceFromInteger:anInteger
+    "the receiver does not know how to subtract from an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#- coercing:self
+!
+
+differenceFromFloat:aFloat
+    "the receiver does not know how to subtract from a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#- coercing:self
+!
+
+differenceFromFraction:aFraction
+    "the receiver does not know how to subtract from a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#- coercing:self
+!
+
+productFromInteger:anInteger
+    "the receiver does not know how to multiply an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#* coercing:self
+!
+
+productFromFloat:aFloat
+    "the receiver does not know how to multiply a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#* coercing:self
+!
+
+productFromFraction:aFraction
+    "the receiver does not know how to multiply a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#* coercing:self
+!
+
+quotientFromInteger:anInteger
+    "the receiver does not know how to divide an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#/ coercing:self
+!
+
+quotientFromFloat:aFloat
+    "the receiver does not know how to divide a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#/ coercing:self
+!
+
+quotientFromFraction:aFraction
+    "the receiver does not know how to divide a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#/ coercing:self
+!
+
+lessFromInteger:anInteger
+    "the receiver does not know how to compare to an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#< coercing:self
+!
+
+lessFromFloat:aFloat
+    "the receiver does not know how to compare to a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#< coercing:self
+!
+
+lessFromFraction:aFraction
+    "the receiver does not know how to compare to a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#< coercing:self
+! !
+
+!ArithmeticValue methodsFor:'misc math'!
+
+squared
+    "return receiver * receiver"
+
+    ^ self * self
+!
+
+exp
+    "return e ^ receiver"
+
+    ^ self asFloat exp
+!
+
+ln
+    "return the natural logarithm of the receiver"
+
+    ^ self asFloat ln
+!
+
+log
+    "return log base 10 of the receiver"
+
+    ^ self log:10
+!
+
+log:aNumber
+    "return log base aNumber of the receiver"
+
+    ^ self ln / aNumber ln
+!
+
+sqrt
+    "return the square root of the receiver"
+
+    ^ self asFloat sqrt
+!
+
+floorLog:radix
+    "return the logarithm truncated as an integer"
+
+    ^ (self log:radix) floor
+!
+
+raisedTo:aNumber
+    "return the receiver raised to aNumber"
+
+    aNumber = 0 ifTrue:[^ 1].
+    aNumber = 1 ifTrue:[^ self].
+    aNumber isInteger ifTrue:[
+        ^ self raisedToInteger:aNumber
+    ].
+    ^ self asFloat raisedTo:aNumber
+!
+
+raisedToInteger:anInteger
+    "return the receiver raised to anInteger"
+
+    |count result|
+
+    result := self coerce:1.
+    count := anInteger abs.
+    count timesRepeat:[result := result * self].
+    (anInteger < 0) ifTrue:[
+        ^ 1 / result
+    ].
+    ^ result
+! !
+
+!ArithmeticValue methodsFor:'trigonometric'!
+
+sin
+    "return the sine of the receiver (interpreted as radians)"
+
+    ^ self asFloat sin
+!
+
+cos
+    "return the cosine of the receiver (interpreted as radians)"
+
+    ^ self asFloat cos
+!
+
+tan
+    "return the tangens of the receiver (interpreted as radians)"
+
+    ^ self asFloat tan
+!
+
+arcCos
+    "return the arccosine of the receiver (in radians)"
+
+    ^ self asFloat arcCos
+!
+
+arcSin
+    "return the arcsine of the receiver (in radians)"
+
+    ^ self asFloat arcSin
+!
+
+arcTan
+    "return the arctangens of the receiver (in radians)"
+
+    ^ self asFloat arcTan
+! !
+
+!ArithmeticValue methodsFor:'error handling'!
+
+divideByZeroError
+    "report a division by zero error"
+
+    DivisionByZeroSignal raise
+    "self error:'division by zero'"
+! !
+
+!ArithmeticValue methodsFor:'testing'!
+
+negative
+    "return true, if the receiver is < 0"
+
+    " this would lead to infinite recursion ...
+    ^ (self < 0)
+    "
+    ^ self subclassResponsibility
+!
+
+positive
+    "return true, if the receiver is >= 0"
+
+    ^ self negative not
+!
+
+strictlyPositive
+    "return true, if the receiver is > 0"
+
+    ^ (self > 0)
+!
+
+sign
+    "return the sign of the receiver"
+
+    (self < 0) ifTrue:[^ -1].
+    (self > 0) ifTrue:[^ 1].
+    ^ 0
+!
+
+even
+    "return true if the receiver is divisible by 2"
+
+    ^ self truncated asInteger even
+!
+
+odd
+    "return true if the receiver is not divisible by 2"
+
+    ^ self even not
+!
+
+denominator
+    "return the denominator of the receiver"
+
+    ^ 1
+!
+
+numerator
+    "return the numerator of the receiver."
+
+    ^ self
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ArithmeticValue.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,613 @@
+"
+ COPYRIGHT (c) 1993 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.
+"
+
+Magnitude subclass:#ArithmeticValue
+       instanceVariableNames:''
+       classVariableNames:'DivisionByZeroSignal DomainErrorSignal
+                           OverflowSignal UnderflowSignal
+			   AnyArithmeticSignal'
+       poolDictionaries:''
+       category:'Magnitude-Numbers'
+!
+
+ArithmeticValue comment:'
+
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+ArithmeticValue is an abstract superclass for all things responding to
+arithmetic messages. It was inserted into the hierarchy, to allow things
+like matrices, functions etc. share the arithmetic methods defined here.
+
+(In the old hierarchy these had to be Numbers to do that 
+ - which is not quite correct)
+
+%W% %E%
+'!
+
+!ArithmeticValue class methodsFor:'initialization' !
+
+initialize
+    "setup the signals"
+
+    DomainErrorSignal := (Signal new) mayProceed:false.
+    DomainErrorSignal notifierString:'domain error'.
+
+    DivisionByZeroSignal := (Signal new) mayProceed:false.
+    DivisionByZeroSignal notifierString:'division by zero'.
+
+    OverflowSignal := (Signal new) mayProceed:false.
+    OverflowSignal notifierString:'overflow'.
+
+    UnderflowSignal := (Signal new) mayProceed:false.
+    UnderflowSignal notifierString:'underflow'.
+
+    AnyArithmeticSignal := SignalSet with:DomainErrorSignal
+				     with:DivisionByZeroSignal
+				     with:OverflowSignal
+				     with:UnderflowSignal.
+! !
+
+!ArithmeticValue class methodsFor:'signal access' !
+
+domainErrorSignal
+    "return the signal which is raised on math errors
+     (such as log of 0 etc.)"
+
+    ^ DomainErrorSignal
+!
+
+divisionByZeroSignal
+    "return the signal which is raised on division by zero"
+
+    ^ DivisionByZeroSignal
+!
+
+overflowSignal
+    "return the signal which is raised on overflow conditions (in floats)"
+
+    ^ OverflowSignal
+!
+
+underflowSignal
+    "return the signal which is raised on underflow conditions (in floats)"
+
+    ^ UnderflowSignal
+!
+
+anyArithmeticSignal
+    "return a signalSet with all possible arithmetic signals"
+
+    ^ AnyArithmeticSignal
+! !
+
+!ArithmeticValue methodsFor:'converting' !
+
+degreesToRadians
+    "interpreting the receiver as radians, return the degrees"
+
+    ^ self asFloat degreesToRadians
+!
+
+radiansToDegrees
+    "interpreting the receiver as degrees, return the radians"
+
+    ^ self asFloat radiansToDegrees
+!
+
+asInteger
+    "return an integer with same value - might truncate"
+
+    ^ self truncated
+!
+
+asFloat
+    "return a float with same value"
+
+   ^ self subclassResponsibility
+!
+
+asFraction
+    "return a fraction with same value"
+
+   ^ self subclassResponsibility
+!
+
+coerce:aNumber
+    "convert aNumber into an instance of the receivers class and return it."
+
+    ^ self subclassResponsibility
+!
+
+generality
+    "return a number giving the receivers generality, that number is
+     used to convert one of the arguments in a mixed expression. 
+     The generality has to be defined in subclasses,
+     such that gen(a) > gen(b) iff, conversion of b into a's class 
+     does not cut precision. For example, Integer has 40, Float has 80,
+     meaning that if we convert a Float to an Integer, some precision may
+     be lost. The generality is used by ArithmeticValue>>retry:cuercing:"
+      
+    ^ self subclassResponsibility
+!
+
+retry:aSymbol coercing:aNumber
+    "arithmetic represented by the binary operator, aSymbol,
+    could not be performed with the receiver and the argument, aNumber, 
+    because of the differences in representation.  
+    Coerce either the receiver or the argument, depending on which has higher 
+    generality, and try again.  
+    If the operation is compare for same value (=), return false if
+    the argument is not a Number. 
+    If the generalities are the same, create an error message, since this
+    means that a subclass has not been fully implemented."
+
+    |myGenerality otherGenerality|
+
+    (aSymbol == #=) ifTrue:[
+        (aNumber respondsTo:#generality) ifFalse:[^ false]
+    ] ifFalse:[
+        (aNumber respondsTo:#generality) ifFalse:[
+            self error:'retry:coercing: argument is not a number'.
+            ^ self
+        ]
+    ].
+    myGenerality := self generality.
+    otherGenerality := aNumber generality.
+    (myGenerality > otherGenerality) ifTrue:[
+        ^ self perform:aSymbol with:(self coerce:aNumber)
+    ].
+    (myGenerality < otherGenerality) ifTrue:[
+        ^ (aNumber coerce:self) perform:aSymbol with:aNumber
+    ].
+    self error:'retry:coercing: oops - same generality'
+! !
+
+!ArithmeticValue methodsFor:'queries' !
+
+respondsToArithmetic
+    "return true, if the receiver responds to arithmetic messages"
+
+    ^ true
+! !
+
+!ArithmeticValue methodsFor:'arithmetic' !
+
++ something
+    "return the sum of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+- something
+    "return the difference of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+* something
+    "return the product of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+/ something
+    "return the quotient of the receiver and the argument"
+
+    ^ self subclassResponsibility
+!
+
+// something
+    "return the integer quotient of the receiver and the argument"
+
+    ^ (self / something) floor
+!
+
+\\ something
+    "return the integer modulu of the receiver and the argument"
+
+    ^ self - ((self // something) * something)
+!
+
+quo:something
+    "Return the integer quotient of dividing the receiver by the argument
+     with truncation towards zero."
+
+    ^ (self / something) truncated
+!
+
+rem:something
+    "Return the integer remainder of dividing the receiver by the argument
+     with truncation towards zero.
+     The remainder has the same sign as the receiver."
+
+    ^ self - ((self quo:something) * something)
+!
+
+abs
+    "return the absolute value of the receiver"
+
+    (self negative) ifTrue:[^ self negated].
+    ^ self
+!
+
+negated
+    "return the receiver negated"
+
+    ^ self class zero - self
+!
+
+reciprocal
+    "return the receivers reciprocal"
+
+    ^ self class unity / self
+! !
+
+!ArithmeticValue methodsFor:'comparing'!
+
+>= something
+    "return true, if the argument is less or equal than the receiver"
+
+    ^ (self < something) not
+!
+
+> something
+    "return true, if the argument is less than the receiver"
+
+    ^ something < self
+!
+
+<= something
+    "return true, if the argument is greater or equal than the receiver"
+
+    ^ (something < self) not
+!
+
+< something
+    "return true, if the argument is greater than the receiver"
+
+    ^ self subclassResponsibility
+!
+
+compare:arg ifLess:lessBlock ifEqual:equalBlock ifGreater:greaterBlock
+    "three-way compare - thanks to Self for this idea.
+     Can be redefined in subclasses to do it with a single comparison if
+     comparison is expensive."
+
+    self < arg ifTrue:[
+        ^ lessBlock value
+    ].
+    self = arg ifTrue:[
+        ^ equalBlock value
+    ].
+    ^ greaterBlock value
+! !
+
+!ArithmeticValue methodsFor:'truncation and rounding'!
+
+ceiling
+    "return the integer nearest the receiver towards positive infinity."
+
+    |anInteger|
+
+    anInteger := self // 1.       "truncates towards negative infinity"
+    anInteger = self ifTrue:[^ anInteger].
+    ^ anInteger + 1
+!
+
+floor
+    "return the receiver truncated towards negative infinity"
+
+    ^ self // 1
+!
+
+truncated
+    "return the receiver truncated towards zero"
+
+    ^ self floor asInteger
+!
+
+truncateTo:aNumber
+    "return the receiver truncated to multiples of aNumber"
+
+    ^ ((self / aNumber) floor * aNumber) asInteger
+!
+
+rounded
+    "return the integer nearest the receiver"
+
+    ^ (self + 0.5) floor asInteger
+!
+
+roundTo:aNumber
+    "return the receiver rounded to multiples of aNumber"
+
+    ^ (self / aNumber) rounded * aNumber
+! !
+
+!ArithmeticValue methodsFor:'double dispatching'!
+
+sumFromInteger:anInteger
+    "the receiver does not know how to add an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#+ coercing:self
+!
+
+sumFromFloat:aFloat
+    "the receiver does not know how to add a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#+ coercing:self
+!
+
+sumFromFraction:aFraction
+    "the receiver does not know how to add a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#+ coercing:self
+!
+
+differenceFromInteger:anInteger
+    "the receiver does not know how to subtract from an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#- coercing:self
+!
+
+differenceFromFloat:aFloat
+    "the receiver does not know how to subtract from a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#- coercing:self
+!
+
+differenceFromFraction:aFraction
+    "the receiver does not know how to subtract from a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#- coercing:self
+!
+
+productFromInteger:anInteger
+    "the receiver does not know how to multiply an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#* coercing:self
+!
+
+productFromFloat:aFloat
+    "the receiver does not know how to multiply a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#* coercing:self
+!
+
+productFromFraction:aFraction
+    "the receiver does not know how to multiply a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#* coercing:self
+!
+
+quotientFromInteger:anInteger
+    "the receiver does not know how to divide an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#/ coercing:self
+!
+
+quotientFromFloat:aFloat
+    "the receiver does not know how to divide a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#/ coercing:self
+!
+
+quotientFromFraction:aFraction
+    "the receiver does not know how to divide a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#/ coercing:self
+!
+
+lessFromInteger:anInteger
+    "the receiver does not know how to compare to an integer -
+     retry the operation by coercing to higher generality"
+
+    ^ anInteger retry:#< coercing:self
+!
+
+lessFromFloat:aFloat
+    "the receiver does not know how to compare to a float -
+     retry the operation by coercing to higher generality"
+
+    ^ aFloat retry:#< coercing:self
+!
+
+lessFromFraction:aFraction
+    "the receiver does not know how to compare to a fraction -
+     retry the operation by coercing to higher generality"
+
+    ^ aFraction retry:#< coercing:self
+! !
+
+!ArithmeticValue methodsFor:'misc math'!
+
+squared
+    "return receiver * receiver"
+
+    ^ self * self
+!
+
+exp
+    "return e ^ receiver"
+
+    ^ self asFloat exp
+!
+
+ln
+    "return the natural logarithm of the receiver"
+
+    ^ self asFloat ln
+!
+
+log
+    "return log base 10 of the receiver"
+
+    ^ self log:10
+!
+
+log:aNumber
+    "return log base aNumber of the receiver"
+
+    ^ self ln / aNumber ln
+!
+
+sqrt
+    "return the square root of the receiver"
+
+    ^ self asFloat sqrt
+!
+
+floorLog:radix
+    "return the logarithm truncated as an integer"
+
+    ^ (self log:radix) floor
+!
+
+raisedTo:aNumber
+    "return the receiver raised to aNumber"
+
+    aNumber = 0 ifTrue:[^ 1].
+    aNumber = 1 ifTrue:[^ self].
+    aNumber isInteger ifTrue:[
+        ^ self raisedToInteger:aNumber
+    ].
+    ^ self asFloat raisedTo:aNumber
+!
+
+raisedToInteger:anInteger
+    "return the receiver raised to anInteger"
+
+    |count result|
+
+    result := self coerce:1.
+    count := anInteger abs.
+    count timesRepeat:[result := result * self].
+    (anInteger < 0) ifTrue:[
+        ^ 1 / result
+    ].
+    ^ result
+! !
+
+!ArithmeticValue methodsFor:'trigonometric'!
+
+sin
+    "return the sine of the receiver (interpreted as radians)"
+
+    ^ self asFloat sin
+!
+
+cos
+    "return the cosine of the receiver (interpreted as radians)"
+
+    ^ self asFloat cos
+!
+
+tan
+    "return the tangens of the receiver (interpreted as radians)"
+
+    ^ self asFloat tan
+!
+
+arcCos
+    "return the arccosine of the receiver (in radians)"
+
+    ^ self asFloat arcCos
+!
+
+arcSin
+    "return the arcsine of the receiver (in radians)"
+
+    ^ self asFloat arcSin
+!
+
+arcTan
+    "return the arctangens of the receiver (in radians)"
+
+    ^ self asFloat arcTan
+! !
+
+!ArithmeticValue methodsFor:'error handling'!
+
+divideByZeroError
+    "report a division by zero error"
+
+    DivisionByZeroSignal raise
+    "self error:'division by zero'"
+! !
+
+!ArithmeticValue methodsFor:'testing'!
+
+negative
+    "return true, if the receiver is < 0"
+
+    " this would lead to infinite recursion ...
+    ^ (self < 0)
+    "
+    ^ self subclassResponsibility
+!
+
+positive
+    "return true, if the receiver is >= 0"
+
+    ^ self negative not
+!
+
+strictlyPositive
+    "return true, if the receiver is > 0"
+
+    ^ (self > 0)
+!
+
+sign
+    "return the sign of the receiver"
+
+    (self < 0) ifTrue:[^ -1].
+    (self > 0) ifTrue:[^ 1].
+    ^ 0
+!
+
+even
+    "return true if the receiver is divisible by 2"
+
+    ^ self truncated asInteger even
+!
+
+odd
+    "return true if the receiver is not divisible by 2"
+
+    ^ self even not
+!
+
+denominator
+    "return the denominator of the receiver"
+
+    ^ 1
+!
+
+numerator
+    "return the numerator of the receiver."
+
+    ^ self
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ArrColl.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,181 @@
+"
+ COPYRIGHT (c) 1989-92 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.
+"
+
+SequenceableCollection subclass:#ArrayedCollection
+       instanceVariableNames:''
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Abstract'
+!
+
+ArrayedCollection comment:'
+
+COPYRIGHT (c) 1989-92 by Claus Gittinger
+             All Rights Reserved
+
+ArrayedCollections are collections where the elements can be accessed via an integer index.
+
+%W% %E%
+written spring 89 by claus
+'!
+
+!ArrayedCollection class methodsFor:'instance creation'!
+
+with:element
+    "return a new SequenceableCollection with one element:anObject"
+
+    |newCollection|
+
+    newCollection := self new:1.
+    newCollection at:1 put:element.
+    ^newCollection
+!
+
+with:first with:second
+    "return a new SequenceableCollection with two elements"
+
+    |newCollection|
+
+    newCollection := self new:2.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    ^newCollection
+!
+
+with:first with:second with:third
+    "return a new SequenceableCollection with three elements"
+
+    |newCollection|
+
+    newCollection := self new:3.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    newCollection at:3 put:third.
+    ^newCollection
+!
+
+with:first with:second with:third with:forth
+    "return a new SequenceableCollection with four elements"
+
+    |newCollection|
+
+    newCollection := self new:4.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    newCollection at:3 put:third.
+    newCollection at:4 put:forth.
+    ^newCollection
+!
+
+with:one with:two with:three with:four with:five
+    "return a new SequenceableCollection with five elements"
+
+    |newCollection|
+
+    newCollection := self new:5.
+    newCollection at:1 put:one.
+    newCollection at:2 put:two.
+    newCollection at:3 put:three.
+    newCollection at:4 put:four.
+    newCollection at:5 put:five.
+    ^newCollection
+!
+
+withAll:aCollection
+    "return a new Collection with all elements taken from the argument,
+     aCollection"
+
+    |newCollection newSize
+     index "{ Class: SmallInteger }" |
+
+    newSize := aCollection size.
+    newCollection := self new:newSize.
+    (aCollection isKindOf:SequenceableCollection) ifTrue:[
+        "aCollection has indexed elements"
+        newCollection replaceFrom:1 to:newSize with:aCollection startingAt:1
+    ] ifFalse:[
+        "must enumerate the elements"
+        index := 1.
+        aCollection do:[:element |
+            newCollection at:index put:element.
+            index := index + 1
+        ]
+    ].
+    ^ newCollection
+! !
+
+!ArrayedCollection methodsFor:'error handling'!
+
+indexMustBeInteger
+    "report an error that index must be Integer"
+
+    ^ self error:'index must be integer'
+!
+
+indexOutOfRange:theIndex
+    "report an error that index is out of range"
+
+    ^ self error:'index is out of range'
+!
+
+fixedSizeError
+    "report an error that size of the collection cannot be changed"
+
+    ^ self error:'cannot change size'
+! !
+
+!ArrayedCollection methodsFor:'accessing'!
+
+size
+    "return the ArrayedCollections size - redefined since SequenceableCollection
+     does it in a slow way"
+
+    ^ self basicSize
+!
+
+at:index
+    "return the index's element of the collection"
+
+    ^ self basicAt:index
+!
+
+at:index put:anObject
+    "put the argument as index's element into the collection"
+
+    ^ self basicAt:index put:anObject
+! !
+
+!ArrayedCollection methodsFor:'storing'!
+
+storeOn:aStream
+    "output a printed representation (which can be re-read)
+     onto the argument aStream"
+
+    |index "{ Class: SmallInteger }"|
+
+    aStream nextPutAll:'('.
+    aStream nextPutAll:self class name.
+    aStream nextPutAll:' new:'.
+    self size printOn:aStream.
+    aStream nextPutAll:')'.
+    index := 1.
+    self do:[:element |
+        aStream nextPutAll:' at:'.
+        index printOn:aStream.
+        aStream nextPutAll:' put:'.
+        element storeOn:aStream.
+        aStream nextPut:$;.
+        index := index + 1
+    ].
+    index > 1 ifTrue:[aStream nextPutAll:' yourself'].
+    aStream nextPut:$)
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Array.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,626 @@
+"
+ COPYRIGHT (c) 1989-92 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.
+"
+
+ArrayedCollection variableSubclass:#Array
+       instanceVariableNames:''
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Indexed'
+!
+
+Array comment:'
+
+COPYRIGHT (c) 1989-92 by Claus Gittinger
+              All Rights Reserved
+
+Arrays store general objects; the size is fixed, so add/remove is not
+allowed. Access to the elements is via an Integer index. Since Arrays
+are used very often in the system, some methods have been tuned by
+reimplementation as primitive.
+
+%W% %E%
+
+written spring 89 by claus
+'!
+
+!Array methodsFor:'resizing'!
+
+grow:newSize
+    (newSize ~~ self size) ifTrue:[
+        self fixedSizeError
+    ]
+! !
+
+!Array methodsFor:'accessing'!
+
+size
+    "return the number of indexed elements in the receiver"
+
+%{  /* NOCONTEXT */
+
+    RETURN ( _MKSMALLINT(_arraySize(self) - _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars) ));
+%}
+!
+
+at:index
+    "return the indexed instance variable with index, anInteger
+     - added here for speed"
+
+%{  /* NOCONTEXT */
+
+    REGISTER int indx;
+    REGISTER int nIndex;
+
+    if (_isSmallInteger(index)) {
+        indx = _intVal(index) - 1;
+	if (indx >= 0) {
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+            if (indx < nIndex) {
+                RETURN ( _InstPtr(self)->i_instvars[indx] );
+            }
+        }
+    }
+%}
+.
+    ^ super at:index
+!
+
+at:index put:anObject
+    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
+     - added here for speed"
+
+%{  /* NOCONTEXT */
+
+    REGISTER int indx;
+    REGISTER int nIndex;
+
+    if (_isSmallInteger(index)) {
+        indx = _intVal(index) - 1;
+        if (indx >= 0) {
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            indx += _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+            if (indx < nIndex) {
+                _InstPtr(self)->i_instvars[indx] = anObject;
+                __STORE(self, anObject);
+                RETURN ( anObject );
+            }
+        }
+    }
+%}
+.
+    ^ super at:index put:anObject
+! !
+
+!Array methodsFor:'copying'!
+
+copyWith:something
+    "reimplemented for speed if receiver is an Array"
+%{
+    OBJ nObj;
+    int mySize;
+    int i, nIndex;
+    OBJ *op;
+    extern int newSpace;
+
+    if (_qClass(self) == Array) {
+        mySize = _qSize(self);
+        _qAlignedNew(nObj, mySize + sizeof(OBJ), __context);
+        _InstPtr(nObj)->o_class = Array;
+
+	nIndex = (mySize - OHDR_SIZE) / sizeof(OBJ);
+        /* created object is usually in newspace */
+        if (_qSpace(nObj) == newSpace) {
+            /* dont care for store */
+#ifdef bcopy4
+	    bcopy4(_ArrayInstPtr(self)->a_element, _ArrayInstPtr(nObj)->a_element, nIndex);
+#else
+            bcopy(_ArrayInstPtr(self)->a_element, _ArrayInstPtr(nObj)->a_element, mySize - OHDR_SIZE);
+#endif
+            _ArrayInstPtr(nObj)->a_element[nIndex] = something;
+        } else {
+            /* must take care of stores ... */
+            op = _ArrayInstPtr(self)->a_element;
+            for (i=0; i<nIndex; i++) {
+                _ArrayInstPtr(nObj)->a_element[i] = *op;
+               __STORE(nObj, *op);
+               op++;
+            }
+            _ArrayInstPtr(nObj)->a_element[i] = something;
+            __STORE(nObj, something);
+	}
+        RETURN ( nObj );
+    }
+%}
+.
+    ^ super copyWith:something
+! !
+
+!Array methodsFor:'filling & replacing'!
+
+from:index1 to:index2 put:anObject
+    "reimplemented for speed if receiver is an Array"
+
+%{  /* NOCONTEXT */
+
+    REGISTER int index;
+    int nIndex;
+    int endIndex;
+    REGISTER OBJ *dst;
+
+    if ((_qClass(self) == Array)
+     && _isSmallInteger(index1)
+     && _isSmallInteger(index2)) {
+        index = _intVal(index1) - 1;
+        if (index >= 0) {
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            endIndex = _intVal(index2) - 1;
+            if (endIndex < nIndex) {
+                dst = &(_InstPtr(self)->i_instvars[index]);
+#ifdef memset4
+                memset4(dst, anObject, (endIndex-index+1));
+                __STORE(self, anObject);
+#else
+                if ((INT)anObject == 0) {
+                    memset(dst, 0, (endIndex-index+1) * sizeof(OBJ));
+                } else {
+                    for (; index <= endIndex; index++) {
+                        *dst++ = anObject;
+                    }
+                    __STORE(self, anObject);
+                }
+#endif
+                RETURN ( self );
+            }
+        }
+    }
+%}
+.
+    ^ super from:index1 to:index2 put:anObject
+!
+
+replaceFrom:start to:stop with:aCollection startingAt:repStart
+    "reimplemented for speed if both receiver and aCollection are Arrays"
+
+%{  /* NOCONTEXT */
+
+    int nIndex, repNIndex;
+    int startIndex, stopIndex;
+    REGISTER OBJ *src;
+    REGISTER OBJ *dst;
+    int repStopIndex;
+    REGISTER int repStartIndex;
+    REGISTER OBJ t;
+    REGISTER int count;
+    extern int newSpace;
+
+    if ((_qClass(self) == Array)
+     && (_Class(aCollection) == Array)
+     && _isSmallInteger(start)
+     && _isSmallInteger(stop)
+     && _isSmallInteger(repStart)) {
+        startIndex = _intVal(start) - 1;
+        if (startIndex >= 0) {
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            stopIndex = _intVal(stop) - 1;
+            count = stopIndex - startIndex + 1;
+            if ((count > 0) && (stopIndex < nIndex)) {
+                repStartIndex = _intVal(repStart) - 1;
+                if (repStartIndex >= 0) {
+                    repNIndex = (_qSize(aCollection) - OHDR_SIZE) / sizeof(OBJ);
+                    repStopIndex = repStartIndex + (stopIndex - startIndex);
+                    if (repStopIndex < repNIndex) {
+                        src = &(_InstPtr(aCollection)->i_instvars[repStartIndex]);
+                        dst = &(_InstPtr(self)->i_instvars[startIndex]);
+                        if (aCollection == self) {
+                            /* no need to check stores */
+                            /* take care of overlapping copy */
+                            if (src < dst) {
+                                /* must do a reverse copy */
+                                src += count;
+                                dst += count;
+                                while (count-- > 0) {
+                                    *--dst = *--src;
+                                }
+                                RETURN ( self );
+                            }
+#ifdef bcopy4
+			    bcopy4(src, dst, count);
+#else
+# ifdef FAST_MEMCPY
+                            bcopy(src, dst, count*sizeof(OBJ));
+# else
+			    while (count >= 4) {
+				MOVE4LONGS(src, dst);
+				count -= 4;
+			    }
+                            while (count--) {
+                                *dst++ = *src++;
+                            }
+# endif
+#endif
+                        } else {
+                            /*
+			     * no need for store-check, if dst is in newspace
+                             */
+                            if (_qSpace(self) == newSpace) {
+#ifdef bcopy4
+				bcopy4(src, dst, count);
+#else
+# ifdef FAST_MEMCPY
+                                bcopy(src, dst, count*sizeof(OBJ));
+# else
+			        while (count >= 4) {
+				    MOVE4LONGS(src, dst);
+				    count -= 4;
+			        }
+                                while (count--) {
+                                    *dst++ = *src++;
+                                }
+# endif
+#endif
+                            } else {
+                                while (count-- > 0) {
+                                    t = *src++;
+                                    *dst++ = t;
+                                    __STORE(self, t);
+                                }
+                            }
+                        }
+                        RETURN ( self );
+                    }
+                }
+            }
+        }
+    }
+%}
+.
+    ^ super replaceFrom:start to:stop with:aCollection startingAt:repStart
+! !
+
+!Array methodsFor:'testing'!
+
+includes:anObject
+    "return true, if the argument, anObject is contained in the array
+     - reimplemented for speed"
+
+    |element|
+
+%{  /* NOCONTEXT */
+
+    REGISTER int index;
+    REGISTER OBJ o;
+    int nIndex;
+
+    nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+    index = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+
+    /* quick check using == */
+    o = anObject;
+    while (index < nIndex) {
+        if (_InstPtr(self)->i_instvars[index++] == o) {
+            RETURN ( true );
+	}
+    }
+    if (o == nil) {
+	RETURN ( false );
+    }
+%}
+.
+%{
+    REGISTER int index;
+    int nIndex;
+    extern OBJ __eq;
+    static struct inlineCache eq = _ILC1;
+
+    nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+    index = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+
+    /* slow check using = */
+
+    while (index < nIndex) {
+        element = _InstPtr(self)->i_instvars[index++];
+	if (element != nil) {
+#ifdef PASS_ARG_REF
+            if ((*eq.ilc_func)(anObject,__eq, CON_COMMA nil,&eq,&element)==true)
+#else
+            if ((*eq.ilc_func)(anObject,__eq, CON_COMMA nil,&eq,element)==true)
+#endif
+	    {
+                RETURN ( true );
+	    }
+	}
+    }
+%}
+.
+    ^ false
+!
+
+indexOf:anElement startingAt:start
+    "search the array for anElement; return index if found, 0 otherwise
+     - reimplemented for speed"
+
+    |element|
+%{
+    REGISTER int index;
+    int nIndex, nInsts;
+    extern OBJ __eq;
+    static struct inlineCache eq = _ILC1;
+
+    if (_isSmallInteger(start)) {
+        index = _intVal(start) - 1;
+        if (index >= 0) {
+            nInsts = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+            index += nInsts;
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+	    if (anElement != nil) {
+                while (index < nIndex) {
+                    element = _InstPtr(self)->i_instvars[index++];
+		    if (element != nil) {
+                        if ((element == anElement) 
+#ifdef PASS_ARG_REF
+                         || ((*eq.ilc_func)(anElement,__eq, CON_COMMA nil,&eq,&element)
+#else
+                         || ((*eq.ilc_func)(anElement,__eq, CON_COMMA nil,&eq,element)
+#endif
+                                                                            == true)) {
+                            RETURN ( _MKSMALLINT(index - nInsts) );
+                        }
+                    }
+                }
+	    } else {
+		/* search for nil */
+                while (index < nIndex) {
+                    if (_InstPtr(self)->i_instvars[index++] == nil) {
+                        RETURN ( _MKSMALLINT(index - nInsts) );
+                    }
+                }
+            }
+        }
+    }
+%}
+.
+    ^ 0
+!
+
+identityIndexOf:anElement startingAt:start
+    "search the array for anElement; return index if found, 0 otherwise
+     - reimplemented for speed"
+
+%{  /* NOCONTEXT */
+
+    REGISTER int index;
+    REGISTER OBJ el;
+    REGISTER OBJ *op;
+    REGISTER int nIndex;
+    int nInsts;
+
+    if (_isSmallInteger(start)) {
+        index = _intVal(start) - 1;
+        if (index >= 0) {
+            nInsts = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+            index += nInsts;
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            el = anElement;
+            op = & (_InstPtr(self)->i_instvars[index]);
+            while (index++ < nIndex) {
+                if (*op++ == el) {
+                    RETURN ( _MKSMALLINT(index - nInsts) );
+                }
+            }
+	    RETURN ( _MKSMALLINT(0) );
+        }
+    }
+%}
+.
+    ^ super identityIndexOf:anElement startingAt:start
+! !
+
+!Array methodsFor:'enumeration'!
+
+do:aBlock
+    "evaluate the argument, aBlock for each element in the collection.
+     - reimplemented for speed"
+
+    |home element|
+%{
+    REGISTER OBJFUNC codeVal;
+    REGISTER int index;
+    int nIndex;
+    extern OBJ _value_, Block;
+    static struct inlineCache val = _ILC1;
+
+    index = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+    nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+    if (_isBlock(aBlock)
+     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+     && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+        home = _BlockInstPtr(aBlock)->b_home;
+        for (; index < nIndex; index++) {
+	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+            element = _InstPtr(self)->i_instvars[index];
+#ifdef PASS_ARG_REF
+            (*codeVal)(home, CON_COMMA  &element);
+#else
+            (*codeVal)(home, CON_COMMA  element);
+#endif
+        } 
+    } else {
+        for (; index < nIndex; index++) {
+	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+            element = _InstPtr(self)->i_instvars[index];
+#ifdef PASS_ARG_REF
+            (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, &element);
+#else
+            (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, element);
+#endif
+        } 
+    }
+%}
+.
+    ^ self
+!
+
+reverseDo:aBlock
+    "evaluate the argument, aBlock for each element in the collection in reverse order.
+     - reimplemented for speed"
+
+    |home element|
+%{
+    REGISTER OBJFUNC codeVal;
+    REGISTER int index;
+    int nIndex, endIndex;
+    extern OBJ _value_, Block;
+    static struct inlineCache val = _ILC1;
+
+    endIndex = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+    nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+    if (_isBlock(aBlock)
+     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+     && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+        home = _BlockInstPtr(aBlock)->b_home;
+        for (index=nIndex-1; index >= endIndex; index--) {
+	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+            element = _InstPtr(self)->i_instvars[index];
+#ifdef PASS_ARG_REF
+            (*codeVal)(home, CON_COMMA  &element);
+#else
+            (*codeVal)(home, CON_COMMA  element);
+#endif
+        } 
+    } else {
+        for (index=nIndex=1; index >= endIndex; index--) {
+	    if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+            element = _InstPtr(self)->i_instvars[index];
+#ifdef PASS_ARG_REF
+            (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, &element);
+#else
+            (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, element);
+#endif
+        } 
+    }
+%}
+.
+    ^ self
+!
+
+from:start to:stop do:aBlock
+    "evaluate the argument, aBlock for the elements starting at index start
+     up to (and including) stop in the collection.
+     - reimplemented for speed"
+
+    |home element|
+%{
+    REGISTER OBJFUNC codeVal;
+    REGISTER int index;
+    int nIndex, nInsts;
+    extern OBJ _value_, Block;
+    static struct inlineCache val = _ILC1;
+    int indexLow, indexHigh;
+
+    if (_isSmallInteger(start) && _isSmallInteger(stop)) {
+        indexLow = _intVal(start);
+        if (indexLow > 0) {
+            indexHigh = _intVal(stop);
+            nInsts = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+            indexLow += nInsts;
+            indexHigh += nInsts;
+            nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+            if (indexHigh <= nIndex) {
+                indexLow--;
+                indexHigh--;
+                if (_isBlock(aBlock)
+                 && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+                 && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+                    home = _BlockInstPtr(aBlock)->b_home;
+                    for (index=indexLow; index <= indexHigh; index++) {
+	    	        if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+#ifdef PASS_ARG_REF
+                        element = _InstPtr(self)->i_instvars[index];
+                        (*codeVal)(home, CON_COMMA  &element);
+#else
+                        (*codeVal)(home, CON_COMMA  _InstPtr(self)->i_instvars[index]);
+#endif
+                    } 
+                } else {
+                    for (index=indexLow; index <= indexHigh; index++) {
+	    	        if (InterruptPending != nil) interruptL(__LINE__ COMMA_CON);
+
+                        element = _InstPtr(self)->i_instvars[index];
+#ifdef PASS_ARG_REF
+                        (*val.ilc_func)
+                            (aBlock, _value_, CON_COMMA  nil, &val, &element);
+#else
+                        (*val.ilc_func)
+                            (aBlock, _value_, CON_COMMA  nil, &val, element);
+#endif
+                    } 
+                }
+                RETURN ( self );
+            }
+        }
+    }
+%}
+.
+    ^ super from:start to:stop do:aBlock
+!
+
+nonNilElementsDo:aBlock
+    "evaluate the argument, aBlock for each non-nil element"
+
+    |home element|
+%{
+    REGISTER OBJFUNC codeVal;
+    REGISTER int index;
+    int nIndex;
+    extern OBJ _value_, Block;
+    static struct inlineCache val = _ILC1;
+
+    index = _intVal(_ClassInstPtr(_qClass(self))->c_ninstvars);
+    nIndex = (_qSize(self) - OHDR_SIZE) / sizeof(OBJ);
+    if (_isBlock(aBlock)
+     && ((codeVal = _BlockInstPtr(aBlock)->b_code) != (OBJFUNC)nil)
+     && (_BlockInstPtr(aBlock)->b_nargs == _MKSMALLINT(1))) {
+        home = _BlockInstPtr(aBlock)->b_home;
+        for (; index < nIndex; index++) {
+	    if (InterruptPending != nil) interrupt(CONARG);
+
+            element = _InstPtr(self)->i_instvars[index];
+	    if (element != nil)
+#ifdef PASS_ARG_REF
+                (*codeVal)(home, CON_COMMA  &element);
+#else
+                (*codeVal)(home, CON_COMMA  element);
+#endif
+        } 
+    } else {
+        for (; index < nIndex; index++) {
+	    if (InterruptPending != nil) interrupt(CONARG);
+
+            element = _InstPtr(self)->i_instvars[index];
+	    if (element != nil)
+#ifdef PASS_ARG_REF
+                (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, &element);
+#else
+                (*val.ilc_func)(aBlock, _value_, CON_COMMA  nil, &val, element);
+#endif
+        } 
+    }
+%}
+.
+    ^ self
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ArrayedCollection.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,181 @@
+"
+ COPYRIGHT (c) 1989-92 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.
+"
+
+SequenceableCollection subclass:#ArrayedCollection
+       instanceVariableNames:''
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Abstract'
+!
+
+ArrayedCollection comment:'
+
+COPYRIGHT (c) 1989-92 by Claus Gittinger
+             All Rights Reserved
+
+ArrayedCollections are collections where the elements can be accessed via an integer index.
+
+%W% %E%
+written spring 89 by claus
+'!
+
+!ArrayedCollection class methodsFor:'instance creation'!
+
+with:element
+    "return a new SequenceableCollection with one element:anObject"
+
+    |newCollection|
+
+    newCollection := self new:1.
+    newCollection at:1 put:element.
+    ^newCollection
+!
+
+with:first with:second
+    "return a new SequenceableCollection with two elements"
+
+    |newCollection|
+
+    newCollection := self new:2.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    ^newCollection
+!
+
+with:first with:second with:third
+    "return a new SequenceableCollection with three elements"
+
+    |newCollection|
+
+    newCollection := self new:3.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    newCollection at:3 put:third.
+    ^newCollection
+!
+
+with:first with:second with:third with:forth
+    "return a new SequenceableCollection with four elements"
+
+    |newCollection|
+
+    newCollection := self new:4.
+    newCollection at:1 put:first.
+    newCollection at:2 put:second.
+    newCollection at:3 put:third.
+    newCollection at:4 put:forth.
+    ^newCollection
+!
+
+with:one with:two with:three with:four with:five
+    "return a new SequenceableCollection with five elements"
+
+    |newCollection|
+
+    newCollection := self new:5.
+    newCollection at:1 put:one.
+    newCollection at:2 put:two.
+    newCollection at:3 put:three.
+    newCollection at:4 put:four.
+    newCollection at:5 put:five.
+    ^newCollection
+!
+
+withAll:aCollection
+    "return a new Collection with all elements taken from the argument,
+     aCollection"
+
+    |newCollection newSize
+     index "{ Class: SmallInteger }" |
+
+    newSize := aCollection size.
+    newCollection := self new:newSize.
+    (aCollection isKindOf:SequenceableCollection) ifTrue:[
+        "aCollection has indexed elements"
+        newCollection replaceFrom:1 to:newSize with:aCollection startingAt:1
+    ] ifFalse:[
+        "must enumerate the elements"
+        index := 1.
+        aCollection do:[:element |
+            newCollection at:index put:element.
+            index := index + 1
+        ]
+    ].
+    ^ newCollection
+! !
+
+!ArrayedCollection methodsFor:'error handling'!
+
+indexMustBeInteger
+    "report an error that index must be Integer"
+
+    ^ self error:'index must be integer'
+!
+
+indexOutOfRange:theIndex
+    "report an error that index is out of range"
+
+    ^ self error:'index is out of range'
+!
+
+fixedSizeError
+    "report an error that size of the collection cannot be changed"
+
+    ^ self error:'cannot change size'
+! !
+
+!ArrayedCollection methodsFor:'accessing'!
+
+size
+    "return the ArrayedCollections size - redefined since SequenceableCollection
+     does it in a slow way"
+
+    ^ self basicSize
+!
+
+at:index
+    "return the index's element of the collection"
+
+    ^ self basicAt:index
+!
+
+at:index put:anObject
+    "put the argument as index's element into the collection"
+
+    ^ self basicAt:index put:anObject
+! !
+
+!ArrayedCollection methodsFor:'storing'!
+
+storeOn:aStream
+    "output a printed representation (which can be re-read)
+     onto the argument aStream"
+
+    |index "{ Class: SmallInteger }"|
+
+    aStream nextPutAll:'('.
+    aStream nextPutAll:self class name.
+    aStream nextPutAll:' new:'.
+    self size printOn:aStream.
+    aStream nextPutAll:')'.
+    index := 1.
+    self do:[:element |
+        aStream nextPutAll:' at:'.
+        index printOn:aStream.
+        aStream nextPutAll:' put:'.
+        element storeOn:aStream.
+        aStream nextPut:$;.
+        index := index + 1
+    ].
+    index > 1 ifTrue:[aStream nextPutAll:' yourself'].
+    aStream nextPut:$)
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Assoc.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,112 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Object subclass:#Association
+       instanceVariableNames:'key value'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Support'
+!
+
+Association comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+              All Rights Reserved
+
+Associations are a key-value pair; they are the elements of Dictionaries -
+storing value under the key. By itself, an Association is not very
+useful.
+
+Instance variables:
+
+key             <Object>        the key
+value           <Object>        the value
+
+%W% %E%
+'!
+
+!Association class methodsFor:'instance creation'!
+
+key:aKey
+    "return a new Association."
+
+    ^ self basicNew key:aKey
+!
+
+key:aKey value:aValue
+    "return a new Association"
+
+    ^ self basicNew key:aKey value:aValue
+! !
+
+!Association methodsFor:'accessing'!
+
+key
+    "return the key of the association"
+
+    ^ key
+!
+
+key:anObject
+    "set the key of the receiver to be anObject.
+     Return the receiver"
+
+    key := anObject
+!
+
+value
+    "return the value of the association"
+
+    ^ value
+!
+
+value:anObject
+    "set the value of the receiver to be anObject.
+     Return the receiver"
+
+    value := anObject
+!
+
+key:aKey value:aValue
+    "set both the key and value of the receiver.
+     Return the receiver"
+
+    key := aKey.
+    value := aValue
+! !
+
+!Association methodsFor:'comparing'!
+
+= anAssociation
+    (anAssociation isKindOf:Association) ifTrue:[
+        (anAssociation key = key) ifTrue:[
+            ^ anAssociation value = value
+        ]
+    ].
+    ^ false
+! !
+
+!Association methodsFor:'printing & storing'!
+
+printString
+    "return a string containing a printable representation
+     of the receiver"
+
+    ^ key printString , '->' , value printString
+!
+
+displayString
+    "return a string containing a printable representation
+     of the receiver for displaying"
+
+    ^ key displayString , '->' , value displayString
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Association.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,112 @@
+"
+ COPYRIGHT (c) 1989-93 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.
+"
+
+Object subclass:#Association
+       instanceVariableNames:'key value'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Support'
+!
+
+Association comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+              All Rights Reserved
+
+Associations are a key-value pair; they are the elements of Dictionaries -
+storing value under the key. By itself, an Association is not very
+useful.
+
+Instance variables:
+
+key             <Object>        the key
+value           <Object>        the value
+
+%W% %E%
+'!
+
+!Association class methodsFor:'instance creation'!
+
+key:aKey
+    "return a new Association."
+
+    ^ self basicNew key:aKey
+!
+
+key:aKey value:aValue
+    "return a new Association"
+
+    ^ self basicNew key:aKey value:aValue
+! !
+
+!Association methodsFor:'accessing'!
+
+key
+    "return the key of the association"
+
+    ^ key
+!
+
+key:anObject
+    "set the key of the receiver to be anObject.
+     Return the receiver"
+
+    key := anObject
+!
+
+value
+    "return the value of the association"
+
+    ^ value
+!
+
+value:anObject
+    "set the value of the receiver to be anObject.
+     Return the receiver"
+
+    value := anObject
+!
+
+key:aKey value:aValue
+    "set both the key and value of the receiver.
+     Return the receiver"
+
+    key := aKey.
+    value := aValue
+! !
+
+!Association methodsFor:'comparing'!
+
+= anAssociation
+    (anAssociation isKindOf:Association) ifTrue:[
+        (anAssociation key = key) ifTrue:[
+            ^ anAssociation value = value
+        ]
+    ].
+    ^ false
+! !
+
+!Association methodsFor:'printing & storing'!
+
+printString
+    "return a string containing a printable representation
+     of the receiver"
+
+    ^ key printString , '->' , value printString
+!
+
+displayString
+    "return a string containing a printable representation
+     of the receiver for displaying"
+
+    ^ key displayString , '->' , value displayString
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Autoload.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,121 @@
+"
+ COPYRIGHT (c) 1991-93 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.
+"
+
+Object subclass:#Autoload
+       instanceVariableNames:''
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Classes'
+!
+
+Autoload comment:'
+
+COPYRIGHT (c) 1991-93 by Claus Gittinger
+              All Rights Reserved
+
+In memory limited systems (as my 8Mb 386 is) all seldom-used classes are made
+subclasses of this class. Autoload catches all messages and
+files-In the corresponding code when first used. Then the cought message
+is resent to the (now existing) class.
+
+%W% %E%
+written fall 91 by claus
+'!
+
+!Autoload class methodsFor:'loading'!
+
+autoload
+    "use this to force loading
+     - it is defined a noop in all non-autoloading clases"
+
+    |mySelf myName mySym newClass|
+
+    mySelf := self.
+    myName := self name.
+    mySym := myName asSymbol.
+
+    "remove myself - to avoid recompilation"
+    Smalltalk at:mySym put:nil.
+
+    "load"
+    Transcript showCr:('autoloading ', myName , ' ...').
+
+    Smalltalk fileInClass:myName.
+
+    "did it work ?"
+    newClass := Smalltalk at:mySym.
+    Smalltalk at:mySym put:mySelf.   "will be undone by become:"
+
+    newClass isNil ifTrue:[
+        "no - reinstall myself"
+        self warn:('autoload of ' , myName , ' failed').
+        ^ nil
+    ].
+
+    "wow - it did"
+
+    self become:newClass.
+    ^ self
+! !
+
+!Autoload class methodsFor:'message catching'!
+
+doesNotUnderstand:aMessage
+    "cought a message; load class and retry"
+
+    |newClass|
+
+    newClass := self autoload.
+    newClass notNil ifTrue:[
+        ^ newClass perform:(aMessage selector)
+             withArguments:(aMessage arguments)
+    ].
+    super doesNotUnderstand:aMessage
+!
+
+new
+    "catch new"
+
+    ^ self doesNotUnderstand:(Message selector:#new)
+!
+
+basicNew
+    "catch basicNew"
+
+    ^ self doesNotUnderstand:(Message selector:#basicew)
+!
+
+new:arg
+    "catch new:"
+
+    ^ self doesNotUnderstand:(Message selector:#new: with:arg)
+!
+
+basicNew:arg
+    "catch basicNew:"
+
+    ^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)
+!
+
+subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5
+    |newClass|
+
+    (self == Autoload) ifTrue:[
+        ^ super subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5
+    ].
+    newClass := self autoload.
+    newClass notNil ifTrue:[
+        ^ newClass perform:(thisContext selector)
+             withArguments:(thisContext args)
+    ].
+    ^ nil
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/BContext.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,106 @@
+"
+ COPYRIGHT (c) 1993 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.
+"
+
+Context subclass:#BlockContext
+       instanceVariableNames:''  "do not add instvars here"
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Methods'
+!
+
+BlockContext comment:'
+
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+BlockContexts represent the stack context objects of blocks. The layout is the same
+as for other contexts - this class has been added to avoid a flag in an instance variable.
+(has become necessary with cheap blocks, which have no home).
+
+Warning: layout and size known by compiler and runtime system - do not change.
+
+%W% %E%
+'!
+
+!BlockContext methodsFor:'accessing'!
+
+isBlockContext
+    "return true, iff the receiver is a BlockContext, false otherwise"
+
+    ^ true
+!
+
+methodHome
+    "return the method-home for block contexts"
+
+    |con h|
+
+    home isNil ifTrue:[^ nil]. "XXX will change soon"
+    home isContext ifFalse:[^ nil]. "copying blocks have no method home"
+
+    con := self.
+    h := home.
+    [h notNil] whileTrue:[
+        con := h.
+        h := con home
+    ].
+    ^ con
+!
+
+home
+    "return the immediate home of the receiver.
+     normally this is the methodcontext, where the block was created,
+     for nested block contexts, this is the surrounding blocks context."
+
+    home isContext ifFalse:[^ nil]. "copying blocks have no home"
+    ^ home
+!
+
+selector
+    "return the selector of the context - which is one of the value
+     selectors"
+
+    |nargs|
+
+    nargs := self nargs.
+    (nargs == 0) ifTrue:[^ #value].
+    (nargs == 1) ifTrue:[^ #value:].
+    (nargs == 2) ifTrue:[^ #value:value:].
+    (nargs == 3) ifTrue:[^ #value:value:value:].
+    (nargs == 4) ifTrue:[^ #value:value:value:value:].
+    (nargs == 5) ifTrue:[^ #value:value:value:value:value:].
+    ^ nil
+! !
+
+!BlockContext methodsFor:'printing'!
+
+receiverPrintString
+    home isNil ifTrue:[
+	^ '[] optimized'
+    ].
+    home isContext ifFalse:[
+	"a copying block"
+
+	"receiverClassName := home selfValue class name."
+	^ '[] optimized'
+    ].
+
+    ^ '[] in ' , receiver class name , '-' , self methodHome selector
+!
+
+printReceiver
+    self receiverPrintString print
+!
+    
+printString
+    ^ self receiverPrintString , ' ' , self selector printString
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Bag.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,144 @@
+"
+ COPYRIGHT (c) 1991-93 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.
+"
+
+Collection subclass:#Bag
+       instanceVariableNames:'contents'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Collections-Unordered'
+!
+
+Bag comment:'
+
+COPYRIGHT (c) 1991-93 by Claus Gittinger
+              All Rights Reserved
+
+Bag implements collections whose elements are unordered and have no
+external keys. Elements may occur more than once.
+
+Instance variables:
+
+contents        <Dictionary>        for each element, the number of occurrences
+
+%W% %E%
+written jun 91 by claus
+'!
+
+!Bag class methodsFor:'instance creation'!
+
+new
+    "return a new empty Bag"
+
+    ^ super new initContents
+!
+
+new:size
+    "return a new empty Bag with initial space for size elements"
+
+    ^ super new initContents:size
+! !
+
+!Bag methodsFor:'private'!
+
+initContents
+    "set the contents to be an empty Dictionary"
+
+    contents := Dictionary new
+!
+
+initContents:size
+    "set the contents to be an empty Dictionary with initial size"
+
+    contents := Dictionary new:size
+! !
+
+!Bag methodsFor:'accessing'!
+
+at:index
+    "report an error: at: is not allowed for Bags"
+
+    ^ self errorNotKeyed
+!
+
+at:index put:anObject
+    "report an error: at:put: is not allowed for Bags"
+
+    ^ self errorNotKeyed
+! !
+
+!Bag methodsFor:'testing'!
+
+size
+    "return the number of bag elements"
+
+    |count|
+
+    count := 0.
+    contents do:[:element | count := count + element].
+    ^ count
+!
+
+occurrencesOf:anObject
+    "return how many times anObject is in the receiver"
+
+    ^ contents at:anObject ifAbsent:[0]
+!
+
+includes:anObject
+    "return true, if anObject is in the receiver"
+
+    ^ contents includesKey:anObject
+! !
+
+!Bag methodsFor:'adding & removing'!
+
+add:anObject
+    "add the argument, anObject to the receiver"
+
+    ^ self add:anObject withOccurences:1
+!
+
+add:newObject withOccurences:anInteger
+    "add the argument, anObject anInteger times to the receiver"
+
+    contents at:newObject
+            put:(self occurrencesOf:newObject) + anInteger.
+    ^ newObject
+!
+
+remove:oldObject ifAbsent:anExceptionBlock
+    "Remove oldObject from the collection and return it
+     - if it was not present, return the value of the exceptionBlock."
+
+    |count|
+
+    count := self occurrencesOf:oldObject.
+    (count == 0) ifTrue:[^ anExceptionBlock value].
+    (count == 1) ifTrue:[
+        contents removeKey:oldObject
+    ] ifFalse:[ 
+        contents at:oldObject put:(count - 1)
+    ].
+    ^ oldObject
+! !
+
+!Bag methodsFor:'enumerating'!
+
+do:aBlock
+    "Perform the block for all members in the collection."
+
+    contents associationsDo:[:assoc |
+        assoc value timesRepeat:[
+            aBlock value:(assoc key)
+        ]
+    ]
+! !

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Behavior.st	Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,733 @@
+"
+ COPYRIGHT (c) 1988-93 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.
+"
+
+Object subclass:#Behavior
+       instanceVariableNames:'superclass selectors methods
+                              instSize flags'
+       classVariableNames:''
+       poolDictionaries:''
+       category:'Kernel-Classes'
+!
+
+Behavior comment:'
+
+COPYRIGHT (c) 1988-93 by Claus Gittinger
+              All Rights Reserved
+
+this class provides minimum support for all classes - additional stuff is
+found in Class; Behaviors stuff has been extracted to make generation of
+compact binaries possible.
+(these do not need all of the functionality in Class)
+
+Instance variables:
+
+superclass  <Class>           the classes superclass
+selectors   <Array>           the selectors for which inst-methods are defined here
+methods     <Array>           the inst-methods corresponding to the selectors
+instSize    <SmallInteger>    the number of instance variables
+flags       <SmallInteger>    special flag bits coded in a number
+
+NOTICE: layout known by compiler and runtime system; be careful when changing
+
+%W% %E%
+written Dec 88 by claus
+'!
+
+!Behavior class methodsFor:'creating new classes'!
+
+new
+    "creates and return a new class"
+
+    |newClass|
+
+    newClass := self basicNew.
+    newClass setSuperclass:Object
+                 selectors:(Array new:0)
+                   methods:(Array new:0)
+                  instSize:0
+                     flags:0.
+    ^ newClass
+! !
+
+!Behavior methodsFor:'initialization'!
+
+initialize
+    "to catch initialize for classes which do not"
+
+    ^ self
+!
+
+reinitialize
+    "to catch reinitialize for classes which do not"
+
+    ^ self
+! !
+
+!Behavior methodsFor:'creating an instance of myself'!
+
+uninitializedNew
+    "same as new"
+
+    ^ self basicNew
+!
+
+uninitializedNew:anInteger
+    "same as new:anInteger"
+
+    ^ self basicNew:anInteger
+!
+
+new
+    "return an instance of myself without indexed variables"
+
+    ^ self basicNew
+!
+
+new:anInteger
+    "return an instance of myself with anInteger indexed variables"
+
+    ^ self basicNew:anInteger
+!
+
+basicNew
+    "return an instance of myself without indexed variables
+     If the receiver-class has indexed instvars, the new object will have
+     a basicSize of zero.
+     ** Do not redefine this method in any class **"
+
+%{  /* NOCONTEXT */
+
+    extern char *newNextPtr, *newEndPtr;
+    OBJ newobj;
+    int instsize;
+    REGISTER int nInstVars;
+#if !defined(memset4)
+# if !defined(FAST_MEMSET) || defined(NEGATIVE_ADDRESSES)
+    REGISTER OBJ *op;
+# endif
+#endif
+
+    nInstVars = _intVal(_INST(instSize));
+    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
+    PROTECT(self);
+    _qAlignedNew(newobj, instsize, SENDER);
+    UNPROTECT(self);
+    _InstPtr(newobj)->o_class = self;
+
+    if (nInstVars) {
+#if defined(memset4)
+        memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
+#else
+# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+        /*
+         * knowing that nil is 0
+         */
+        memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# else
+        op = _InstPtr(newobj)->i_instvars;
+        do {
+            *op++ = nil;
+        } while (--nInstVars);
+# endif
+#endif
+    }
+    RETURN ( newobj );
+%}
+!
+
+basicNew:anInteger
+    "return an instance of myself with anInteger indexed variables.
+     If the receiver-class has no indexed instvars, this is only allowed
+     if the argument, anInteger is zero.
+     ** Do not redefine this method in any class **"
+
+%{  /* NOCONTEXT */
+
+    OBJ newobj;
+    INT instsize, nInstVars, nindexedinstvars;
+    INT flags;
+#if ! defined(FAST_MEMSET) || defined(NEGATIVE_ADDRESSES)
+    REGISTER char *cp;
+    short *sp;
+    long *lp;
+#endif
+    REGISTER OBJ *op;
+    float *fp;
+    double *dp;
+    extern OBJ new();
+
+    if (_isSmallInteger(anInteger)) {
+        nindexedinstvars = _intVal(anInteger);
+        if (nindexedinstvars >= 0) {
+            nInstVars = _intVal(_INST(instSize));
+            flags = _intVal(_INST(flags)) & ARRAYMASK;
+            switch (flags) {
+                case BYTEARRAY:
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(char);
+		    PROTECT(self);
+                    _qNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+#if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+                    /*
+                     * knowing that nil is 0
+                     */
+                    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+#else
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+                    cp = (char *)op;
+                    while (nindexedinstvars >= sizeof(long)) {
+                        *(long *)cp = 0;
+			cp += sizeof(long);
+			nindexedinstvars -= sizeof(long);
+		    }
+                    while (nindexedinstvars--)
+                        *cp++ = '\0';
+#endif
+                    RETURN ( newobj );
+                    break;
+
+                case WORDARRAY:
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(short);
+		    PROTECT(self);
+                    _qNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+#if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+                    /*
+                     * knowing that nil is 0
+                     */
+                    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+#else
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+                    sp = (short *)op;
+                    while (nindexedinstvars--)
+                        *sp++ = 0;
+#endif
+                    RETURN ( newobj );
+                    break;
+
+               case LONGARRAY:
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(long);
+		    PROTECT(self);
+                    _qNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+#if defined(memset4) && ! defined(NEGATIVE_ADDRESSES)
+                    /*
+                     * knowing that nil is 0
+                     */
+                    memset4(_InstPtr(newobj)->i_instvars, 0, nInstVars + nindexedinstvars);
+#else
+# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+                    /*
+                     * knowing that nil is 0
+                     */
+                    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# else
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+                    lp = (long *)op;
+                    while (nindexedinstvars--)
+                        *lp++ = 0;
+# endif
+#endif
+                    RETURN ( newobj );
+                    break;
+
+               case FLOATARRAY:
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(float);
+		    PROTECT(self);
+                    _qNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+                    fp = (float *)op;
+                    while (nindexedinstvars--)
+                        *fp++ = 0.0;
+                    RETURN ( newobj );
+                    break;
+
+               case DOUBLEARRAY:
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(double);
+		    PROTECT(self);
+                    _qNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+                    dp = (double *)op;
+                    while (nindexedinstvars--)
+                        *dp++ = 0.0;
+                    RETURN ( newobj );
+                    break;
+
+                case WKPOINTERARRAY:
+                case POINTERARRAY:
+                    nInstVars += nindexedinstvars;
+                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
+		    PROTECT(self);
+                    _qAlignedNew(newobj, instsize, SENDER);
+		    UNPROTECT(self);
+                    _InstPtr(newobj)->o_class = self;
+#if defined(memset4)
+                    memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
+#else
+# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+                    /*
+                     * knowing that nil is 0
+                     */
+                    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# else
+                    op = _InstPtr(newobj)->i_instvars;
+                    while (nInstVars--)
+                        *op++ = nil;
+# endif
+#endif
+                    RETURN ( newobj );
+                    break;
+
+                default:
+                    /*
+                     * new:n for non-variable classes only allowed if
+                     * n == 0
+                     */
+                    if (nindexedinstvars == 0) {
+                        instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
+		        PROTECT(self);
+                        _qAlignedNew(newobj, instsize, SENDER);
+		        UNPROTECT(self);
+                        _InstPtr(newobj)->o_class = self;
+                        if (nInstVars) {
+#if defined(memset4)
+                            memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
+#else
+# if defined(FAST_MEMSET) && ! defined(NEGATIVE_ADDRESSES)
+                            /*
+                             * knowing that nil is 0
+                             */
+                            memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+# else
+                            op = _InstPtr(newobj)->i_instvars;
+                            do {
+                                *op++ = nil;
+                            } while (--nInstVars);
+# endif
+#endif
+                        }
+                        RETURN ( newobj );
+                    }
+                    break;
+            }
+        }
+    }
+%}
+.
+    (anInteger isMemberOf:SmallInteger) ifFalse:[
+        self error:'argument to new: must be Integer'
+    ] ifTrue:[
+        (anInteger >= 0) ifTrue:[
+            "sorry but this class has no indexed instvars - need 'new' "
+            self error:'not indexed - cannot create with new:'
+        ] ifFalse:[
+            self error:'bad argument'
+        ]
+    ]
+! !
+
+!Behavior methodsFor:'accessing'!
+
+superclass
+    "return the receivers superclass"
+
+    ^ superclass
+!
+
+selectors
+    "return the receivers selector array"
+
+    ^ selectors
+!
+
+methods
+    "return the receivers method array"
+
+    ^ methods
+!
+
+methodDictionary
+    "return the receivers method dictionary - since no dictionary is
+     used (for now) just return the method array"
+
+    ^ methods
+!
+
+instSize
+    "return the number of instance variables of the receiver"
+
+    ^ instSize
+!
+
+flags
+    "return the receivers flag bits"
+
+    ^ flags
+!
+
+isVariable
+    "return true, if instances have indexed instance variables"
+
+    "this used to be defined as:
+        ^ (flags bitAnd:16r0F) ~~ 0
+     but then, changes in stc.h would not affect us here. Therefore:"
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? true : false ); 
+%}
+!
+
+isFixed
+    "return true, if instances do not have indexed instance variables"
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    RETURN ( (_intVal(_INST(flags)) & ARRAYMASK) ? false : true ); 
+%}
+!
+
+isBits
+    "return true, if instances have indexed byte or short instance variables.
+     Ignore long, float and double arrays, since classes using isBits are probably
+     not prepared to handle them correctly."
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    REGISTER int flags;
+
+    RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == BYTEARRAY)
+	     || (flags == WORDARRAY)) ? true : false ); 
+%}
+!
+
+isBytes
+    "return true, if instances have indexed byte instance variables"
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == BYTEARRAY) ? true : false ); 
+%}
+!
+
+isWords
+    "return true, if instances have indexed short instance variables"
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == WORDARRAY) ? true : false ); 
+%}
+!
+
+isLongs
+    "return true, if instances have indexed long instance variables"
+
+%{  /* NOCONTEXT */
+    /* this is defined as a primitive to get defines from stc.h */
+
+    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == LONGARRAY) ? true : false ); 
+%}
+!
+
+isFloats
+    "return true, if instances have indexed float instance variables"
+
+%{  /* NOCONTEXT */
+    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == FLOATARRAY) ? true : false ); 
+%}
+!
+
+isDoubles
+    "return true, if instances have indexed double instance variables"
+
+%{  /* NOCONTEXT */
+    RETURN ( ((_intVal(_INST(flags)) & ARRAYMASK) == DOUBLEARRAY) ? true : false ); 
+%}
+!
+
+isPointers
+    "return true, if instances have pointer instance variables"
+
+    "question: should we ignore WeakPointers ?"
+%{  /* NOCONTEXT */
+    REGISTER int flags;
+
+    RETURN ( (((flags = (_intVal(_INST(flags)) & ARRAYMASK)) == POINTERARRAY)
+	     || (flags == WKPOINTERARRAY)) ? true : false ); 
+%}
+! !
+
+!Behavior methodsFor:'queries'!
+
+isBehavior
+    "return true, if the receiver describing another objecs behavior
+     i.e. is a class."
+
+    ^ true
+!
+
+hasMultipleSuperclasses
+    "NO multiple inheritance in this system"
+
+    ^ false
+!
+
+superclasses
+    "return a collection of the receivers immediate superclasses
+     - since we have NO multiple inheritance, there is only one"
+
+    ^ Array with:superclass
+!
+
+allSuperclasses
+    "return a collection of the receivers accumulated superclasses"
+
+    |aCollection theSuperClass|
+
+    theSuperClass := superclass.
+    theSuperClass notNil ifTrue:[
+        aCollection := OrderedCollection new.
+        [theSuperClass notNil] whileTrue:[
+            aCollection add:theSuperClass.
+            theSuperClass := theSuperClass superclass
+        ]
+    ].
+    ^ aCollection
+!
+
+withAllSuperclasses
+    "return a collection containing the receiver and all
+     of the receivers accumulated superclasses"
+
+    |aCollection theSuperClass|
+
+    aCollection := OrderedCollection with:self.
+    theSuperClass := superclass.
+    [theSuperClass notNil] whileTrue:[
+        aCollection add:theSuperClass.
+        theSuperClass := theSuperClass superclass
+    ].
+    ^ aCollection
+!
+
+subclasses
+    "return a collection of the direct subclasses of the receiver"
+
+    |newColl|
+
+    newColl := OrderedCollection new.
+    self subclassesDo:[:aClass |
+        newColl add:aClass
+    ].
+    ^ newColl
+!
+
+allSubclasses
+    "return a collection of all subclasses (direct AND indirect) of
+     the receiver"
+
+    |newColl|
+
+    newColl := OrderedCollection new.
+    self allSubclassesDo:[:aClass |
+        newColl add:aClass
+    ].
+    ^ newColl
+!
+
+withAllSubclasses
+    "return a collection containing the receiver and 
+     all subclasses (direct AND indirect) of the receiver"
+
+    |newColl|
+
+    newColl := OrderedCollection with:self.
+    self allSubclassesDo:[:aClass |
+        newColl add:aClass
+    ].
+    ^ newColl
+!
+
+isSubclassOf:aClass
+    "return true, if I am a subclass of the argument, aClass"
+
+    |theClass|
+    theClass := superclass.
+    [theClass notNil] whileTrue:[
+        (theClass == aClass) ifTrue:[^ true].
+        theClass := theClass superclass
+    ].
+    ^ false
+!
+
+allInstances
+    "return a collection of all my instances"
+
+    |coll|
+
+    coll := OrderedCollection new.
+    ObjectMemory allObjectsDo:[:anObject |
+        (anObject class == self) ifTrue:[
+            coll add:anObject
+        ]
+    ].
+    ^ coll asArray
+!
+
+instanceCount
+    "return the number of instances of myself"
+
+    |count|
+
+    count := 0.
+    ObjectMemory allObjectsDo:[:anObject |
+        (anObject class == self) ifTrue:[
+            count := count + 1
+        ]
+    ].
+    ^ count
+! !
+
+!Behavior methodsFor:'private accessing'!
+
+setSuperclass:sup selectors:sels methods:m instSize:i flags:f
+    "set some inst vars (private use only)"
+
+    superclass := sup.
+    selectors := sels.
+    methods := m.
+    instSize := i.
+    flags := f
+!
+
+setSuperclass:aClass
+    "set the superclass of the receiver"
+
+    superclass := aClass
+!
+
+instSize:aNumber
+    "set the instance size"
+
+    instSize := aNumber
+!
+
+flags:aNumber
+    "set the flags"
+
+    flags := aNumber
+!
+
+setSelectors:anArray
+    "set the selector array of the receiver"
+
+    selectors := anArray
+!
+
+setMethodDictionary:anArray
+    "set the method array of the receiver"
+
+    methods := anArray
+!
+
+superclass:aClass
+    "set the superclass"
+
+    "must flush caches since lookup chain changes"
+    ObjectMemory flushCaches.
+    superclass := aClass
+!
+
+selectors:selectorArray methods:methodArray
+    "set both selector array and method array of the receiver,
+     and flush caches"
+
+    ObjectMemory flushCaches.
+    selectors := selectorArray.
+    methods := methodArray
+! !
+
+!Behavior methodsFor:'enumeration'!
+
+allInstancesDo:aBlock
+    "evaluate a block for all of my instances"
+
+    ObjectMemory allObjectsDo:[:anObject |
+        (anObject class == self) ifTrue:[
+            aBlock value:anObject
+        ]
+    ]
+!
+
+subclassesDo:aBlock
+    "evaluate the argument, aBlock for all immediate subclasses"
+
+    Smalltalk allClassesDo:[:aClass |
+        (aClass superclass == self) ifTrue:[
+            aBlock value:aClass
+        ]
+    ]
+!
+
+allSubclassesDo:aBlock
+    "evaluate a block for all of my subclasses"
+
+    Smalltalk allClassesDo:[:aClass |
+        (aClass isSubclassOf:self) ifTrue:[
+            aBlock value:aClass
+        ]
+    ]
+!
+
+allSubclassesInOrderDo:aBlock
+    "evaluate a block for all of my subclasses where superclasses come
+     first"
+
+    self subclassesDo:[:aClass |
+        aBlock value:aClass.
+        aClass allSubclassesInOrderDo:aBlock
+    ]
+!
+
+allSuperclassesDo:aBlock
+    "evaluate a block for all of my superclasses"
+
+    |theClass|
+
+    theClass := superclass.
+    [theClass notNil] whileTrue:[
+        aBlock value:theClass.
+        theClass := theClass superclass
+    ]
+! !