[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