[squeak-dev] Squeak 4.5: Kernel-cwp.844.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Apr 10 21:07:05 UTC 2015
Tobias Pape uploaded a new version of Kernel to project Squeak 4.5:
http://source.squeak.org/squeak45/Kernel-cwp.844.mcz
==================== Summary ====================
Name: Kernel-cwp.844
Author: cwp
Time: 22 March 2014, 7:57:39.797 pm
UUID: f4f1b55b-db99-4fae-9a9b-3fcdcc0a6716
Ancestors: Kernel-cwp.840, Kernel-nice.843
merge
=============== Diff against Kernel-dtl.836 ===============
Item was changed:
----- Method: ClassBuilder>>superclass:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: newSuper
subclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class."
| env |
+ env := CurrentEnvironment signal ifNil: [newSuper environment].
- env := EnvironmentRequest signal ifNil: [newSuper environment].
^self
name: t
inEnvironment: env
subclassOf: newSuper
type: newSuper typeOfClass
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was changed:
----- Method: ClassBuilder>>superclass:variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
variableByteSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class in which the subclass is to
have indexable byte-sized nonpointer variables."
| oldClassOrNil actualType env |
(aClass instSize > 0)
ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
(aClass isVariable and: [aClass isWords])
ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
(aClass isVariable and: [aClass isPointers])
ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
oldClassOrNil := aClass environment at: t ifAbsent:[nil].
actualType := (oldClassOrNil notNil
and: [oldClassOrNil typeOfClass == #compiledMethod])
ifTrue: [#compiledMethod]
ifFalse: [#bytes].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
- env := EnvironmentRequest signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: actualType
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was changed:
----- Method: ClassBuilder>>superclass:variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
variableSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class in which the subclass is to
have indexable pointer variables."
| env |
aClass isBits ifTrue:
[^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
- env := EnvironmentRequest signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #variable
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was changed:
----- Method: ClassBuilder>>superclass:variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
variableWordSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class in which the subclass is to
have indexable word-sized nonpointer variables."
| env |
(aClass instSize > 0)
ifTrue: [^self error: 'cannot make a word subclass of a class with named fields'].
(aClass isVariable and: [aClass isBytes])
ifTrue: [^self error: 'cannot make a word subclass of a class with byte fields'].
(aClass isVariable and: [aClass isPointers])
ifTrue: [^self error: 'cannot make a word subclass of a class with pointer fields'].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
- env := EnvironmentRequest signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #words
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was changed:
----- Method: ClassBuilder>>superclass:weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') -----
superclass: aClass
weakSubclass: t instanceVariableNames: f
classVariableNames: d poolDictionaries: s category: cat
"This is the standard initialization message for creating a new class as a
subclass of an existing class (the receiver) in which the subclass is to
have weak indexable pointer variables."
| env |
aClass isBits
ifTrue: [^self error: 'cannot make a pointer subclass of a class with non-pointer fields'].
+ env := CurrentEnvironment signal ifNil: [aClass environment].
- env := EnvironmentRequest signal ifNil: [aClass environment].
^self
name: t
inEnvironment: env
subclassOf: aClass
type: #weak
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
Item was added:
+ ----- Method: ExtendedNumberParser>>exponentLetters (in category 'accessing') -----
+ exponentLetters
+ "Allow uppercase exponent letter."
+
+ ^'edqEDQ'!
Item was changed:
----- Method: Float>>absPrintOn:base:digitCount: (in category 'printing') -----
absPrintOn: aStream base: base digitCount: digitCount
"Print me in the given base, using digitCount significant figures."
| fuzz x exp q fBase scale logScale xi |
self isInfinite ifTrue: [^ aStream nextPutAll: 'Inf'].
fBase := base asFloat.
"x is myself normalized to [1.0, fBase), exp is my exponent"
+ exp := self floorLog: fBase.
- exp :=
- self < 1.0
- ifTrue: [self reciprocalFloorLog: fBase]
- ifFalse: [self floorLog: fBase].
scale := 1.0.
logScale := 0.
[(x := fBase raisedTo: (exp + logScale)) = 0]
whileTrue:
[scale := scale * fBase.
logScale := logScale + 1].
x := self * scale / x.
fuzz := fBase raisedTo: 1 - digitCount.
"round the last digit to be printed"
x := 0.5 * fuzz + x.
x >= fBase
ifTrue:
["check if rounding has unnormalized x"
x := x / fBase.
exp := exp + 1].
(exp < 6 and: [exp > -4])
ifTrue:
["decimal notation"
q := 0.
exp < 0 ifTrue: [1 to: 1 - exp do: [:i | aStream nextPut: ('0.0000'
at: i)]]]
ifFalse:
["scientific notation"
q := exp.
exp := 0].
[x >= fuzz]
whileTrue:
["use fuzz to track significance"
xi := x asInteger.
aStream nextPut: (Character digitValue: xi).
x := x - xi asFloat * fBase.
fuzz := fuzz * fBase.
exp := exp - 1.
exp = -1 ifTrue: [aStream nextPut: $.]].
[exp >= -1]
whileTrue:
[aStream nextPut: $0.
exp := exp - 1.
exp = -1 ifTrue: [aStream nextPut: $.]].
q ~= 0
ifTrue:
[aStream nextPut: $e.
q printOn: aStream]!
Item was changed:
----- Method: Float>>predecessor (in category 'truncation and round off') -----
predecessor
| ulp |
self isFinite ifFalse: [
(self isNaN or: [self negative]) ifTrue: [^self].
^Float fmax].
- self = 0.0 ifTrue: [^Float fmin negated].
ulp := self ulp.
^self - (0.5 * ulp) = self
ifTrue: [self - ulp]
ifFalse: [self - (0.5 * ulp)]!
Item was changed:
----- Method: Float>>successor (in category 'truncation and round off') -----
successor
| ulp |
self isFinite ifFalse: [
(self isNaN or: [self positive]) ifTrue: [^self].
^Float fmax negated].
- self = 0.0 ifTrue: [^Float fmin].
ulp := self ulp.
^self + (0.5 * ulp) = self
+ ifTrue: [self * -1.0 - ulp * -1.0 "This trick is for obtaining a negativeZero"]
- ifTrue: [self + ulp]
ifFalse: [self + (0.5 * ulp)]!
Item was changed:
----- Method: Integer>>nthRoot: (in category 'mathematical functions') -----
nthRoot: aPositiveInteger
"Answer the nth root of the receiver.
+ Answer an Integer if root is exactly this Integer, else answer the Float nearest the exact root."
- See #nthRootAlt: for an alternative implementation."
+ | guess p |
- | selfAsFloat floatResult guess delta higher lower raised |
- selfAsFloat := self asFloat.
+ guess := self nthRootRounded: aPositiveInteger.
+ (guess raisedTo: aPositiveInteger) = self
- "If we can't do Float arithmetic because we are too big, then look for an exact answer in exact arithmetic"
- selfAsFloat isInfinite ifTrue: [
- guess := self nthRootTruncated: aPositiveInteger.
- (guess raisedToInteger: aPositiveInteger) = self
- ifTrue: [ ^ guess ].
- "Nothing else can be done. No exact answer means answer must be a Float.
- Answer the best we have."
- ^guess asFloat ].
-
- floatResult := selfAsFloat nthRoot: aPositiveInteger.
- guess := floatResult rounded.
-
- "If got an exact answer, answer it."
- raised := guess raisedToInteger: aPositiveInteger.
- raised = self
ifTrue: [ ^ guess ].
+ p := Float precision - guess highBitOfMagnitude.
+ p < 0 ifTrue: [ ^ guess asFloat ].
- "In this case, maybe it failed because we are such a big integer that the Float
- method gets inexact, even if we are a whole square number.
- Note 1(jmv): This algorithm is faster than #nthRootTruncated: for big n (aPositiveInteger)
- but fails if self asFloat isInfinite.
- Note 2(jmv): The algorithms I found for computing the nthRoot would havily use
- very large fractions. I wrote this one, that doesn't create fractions."
- selfAsFloat abs >= (Float maxExactInteger asFloat raisedToInteger: aPositiveInteger)
- ifTrue: [
- raised > self
- ifTrue: [
- higher := guess.
- delta := floatResult predecessor - floatResult.
- [
- floatResult := floatResult + delta.
- lower := floatResult rounded.
- (lower raisedToInteger: aPositiveInteger) > self ] whileTrue: [
- delta := delta * 2.
- higher := lower ] ]
- ifFalse: [
- lower := guess.
- delta := floatResult successor - floatResult.
- [
- floatResult := floatResult + delta.
- higher := floatResult rounded.
- (higher raisedToInteger: aPositiveInteger) < self ] whileTrue: [
- delta := delta * 2.
- lower := higher ]].
- [ higher - lower > 1 ] whileTrue: [
- guess := lower + higher // 2.
- raised := guess raisedToInteger: aPositiveInteger.
- raised = self
- ifTrue: [
- ^ guess ].
- raised > self
- ifTrue: [ higher := guess ]
- ifFalse: [ lower := guess ]]].
+ guess := self << (p * aPositiveInteger) nthRootRounded: aPositiveInteger.
+ ^(guess / (1 << p)) asFloat!
- "We need an approximate result"
- ^floatResult!
Item was added:
+ ----- Method: Integer>>nthRootRounded: (in category 'mathematical functions') -----
+ nthRootRounded: aPositiveInteger
+ "Answer the integer nearest the nth root of the receiver."
+ | guess |
+ self = 0 ifTrue: [^0].
+ self negative
+ ifTrue:
+ [aPositiveInteger even ifTrue: [ ArithmeticError signal: 'Negative numbers don''t have even roots.' ].
+ ^(self negated nthRootRounded: aPositiveInteger) negated].
+ guess := self nthRootTruncated: aPositiveInteger.
+ ^self * 2 > ((guess + 1 raisedTo: aPositiveInteger) + (guess raisedTo: aPositiveInteger))
+ ifTrue: [guess + 1]
+ ifFalse: [guess]!
Item was removed:
- ----- Method: LargePositiveInteger>>sqrtFloor (in category 'mathematical functions') -----
- sqrtFloor
- "Return the integer part of the square root of self"
-
- | powerOfTwo |
- (powerOfTwo := self lowBit - 1 // 2) > 1
- ifFalse: [^super sqrtFloor].
- ^(self bitShift: -2 * powerOfTwo) sqrtFloor bitShift: powerOfTwo!
Item was removed:
- ----- Method: ScaledDecimal>>// (in category 'arithmetic') -----
- // operand
- "Answer the integer quotient after dividing the receiver by operand
- with truncation towards negative infinity."
- ^ fraction // operand!
Item was changed:
----- Method: ScaledDecimal>>integerPart (in category 'truncation and round off') -----
integerPart
+ "Answer the integer part of the receiver."
- "Answer the fractional part of the receiver."
^ ScaledDecimal newFromNumber: fraction integerPart scale: scale!
More information about the Squeak-dev
mailing list
|