[squeak-dev] The Trunk: Kernel-nice.567.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Apr 11 13:58:08 UTC 2011
Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.567.mcz
==================== Summary ====================
Name: Kernel-nice.567
Author: nice
Time: 11 April 2011, 3:57:48.516 pm
UUID: c28babcd-2f07-0f47-a7ae-9e9dfe2ed29b
Ancestors: Kernel-ar.566
Use #repeat instead of [true] whileTrue
=============== Diff against Kernel-ar.566 ===============
Item was changed:
----- Method: CompiledMethod>>abstractPCForConcretePC: (in category 'debugger support') -----
abstractPCForConcretePC: concretePC
"Answer the abstractPC matching concretePC."
| abstractPC scanner client |
self flag: 'belongs in DebuggerMethodMap?'.
abstractPC := 1.
scanner := InstructionStream on: self.
client := InstructionClient new.
[(scanner atEnd
or: [scanner pc >= concretePC]) ifTrue:
[^abstractPC].
abstractPC := abstractPC + 1.
+ scanner interpretNextInstructionFor: client] repeat!
- scanner interpretNextInstructionFor: client.
- true] whileTrue!
Item was changed:
----- Method: EventSensor>>eventTickler (in category 'private') -----
eventTickler
"Poll infrequently to make sure that the UI process is not been stuck.
If it has been stuck, then spin the event loop so that I can detect the
interrupt key."
| delay |
delay := Delay forMilliseconds: self class eventPollPeriod.
self lastEventPoll. "ensure not nil."
[| delta |
[ delay wait.
delta := Time millisecondClockValue - lastEventPoll.
(delta < 0
or: [delta > self class eventPollPeriod])
+ ifTrue:
+ ["force check on rollover"
+ self fetchMoreEvents]]
+ on: Error do: [:ex | ]] repeat.!
- ifTrue: ["force check on rollover"
- self fetchMoreEvents]] on: Error do: [:ex | ].
- true ] whileTrue.!
Item was changed:
----- Method: InputSensor>>userInterruptWatcher (in category 'user interrupts') -----
userInterruptWatcher
"Wait for user interrupts and open a notifier on the active process when one occurs."
+ [ InterruptSemaphore wait.
+ Display deferUpdates: false.
+ SoundService default shutDown.
+ Smalltalk handleUserInterrupt ] repeat!
- [true] whileTrue: [
- InterruptSemaphore wait.
- Display deferUpdates: false.
- SoundService default shutDown.
- Smalltalk handleUserInterrupt]
- !
Item was changed:
----- Method: Integer>>isProbablyPrimeWithK:andQ: (in category 'private') -----
isProbablyPrimeWithK: k andQ: q
"Algorithm P, probabilistic primality test, from
Knuth, Donald E. 'The Art of Computer Programming', Vol 2,
Third Edition, section 4.5.4, page 395, P1-P5 refer to Knuth description."
"P1"
| x j y |
x := (self - 2) atRandom + 1.
"P2"
j := 0.
y := x raisedToInteger: q modulo: self.
"P3"
+ [((j = 0 and: [y = 1]) or: [y = (self - 1)]) ifTrue: [^true].
+ (j > 0 and: [y = 1]) ifTrue: [^false].
+ "P5"
+ j := j + 1.
+ j < k
+ ifTrue: [y := y squared \\ self]
+ ifFalse:[^ false]] repeat!
- [(((j = 0) & (y = 1)) | (y = (self - 1))) ifTrue: [^true].
- ((j > 0) & (y = 1)) ifTrue: [^false]. "P5"
- true]
- whileTrue:
- [j := j + 1.
- (j < k) ifTrue: [y := y squared \\ self]
- ifFalse:[^ false]]!
Item was changed:
----- Method: MethodFinder>>testRandom (in category 'initialize') -----
testRandom
"verify that the methods allowed don't crash the system. Pick 3 or 4 from a mixed list of the fundamental types."
+ | objects other aa cnt take tuple fName sss |
+ objects := #(
+ (1 4 17 42) ($a $b $c $d) ('one' 'two' 'three' 'four')
+ (x + rect: new) ((a b 1 4) (c 1 5) ($a 3 d) ()) (4.5 0.0 3.2 100.3)
- | objects other aa cnt take tuple fName sss |
- objects := #((1 4 17 42) ($a $b $c $d) ('one' 'two' 'three' 'four')
- (x + rect: new) ((a b 1 4) (c 1 5) ($a 3 d) ()) (4.5 0.0 3.2 100.3)
).
+ objects := objects, {{true. false. true. false}. {Point. SmallInteger. Association. Array}.
+ {Point class. SmallInteger class. Association class. Array class}.
+ "{ 4 blocks }."
+ {Date today. '1 Jan 1950' asDate. '25 Aug 1987' asDate. '1 Jan 2000' asDate}.
+ {'15:16' asTime. '1:56' asTime. '4:01' asTime. '6:23' asTime}.
+ {Dictionary new. Dictionary new. Dictionary new. Dictionary new}.
+ {#(a b 1 4) asOrderedCollection. #(c 1 5) asOrderedCollection.
+ #($a 3 d) asOrderedCollection. #() asOrderedCollection}.
+ {3 -> true. 5.6 -> $a. #x -> 2. 'abcd' -> false}.
+ {9 @ 3 extent: 5 @ 4. 0 @ 0 extent: 45 @ 9. -3 @ -7 extent: 2 @ 2. 4 @ 4 extent: 16 @ 16}.
+ {Color red. Color blue. Color black. Color gray}}.
- objects := objects, {{true. false. true. false}. {Point. SmallInteger. Association. Array}.
- {Point class. SmallInteger class. Association class. Array class}.
- "{ 4 blocks }."
- {Date today. '1 Jan 1950' asDate. '25 Aug 1987' asDate. '1 Jan 2000' asDate}.
- {'15:16' asTime. '1:56' asTime. '4:01' asTime. '6:23' asTime}.
- {Dictionary new. Dictionary new. Dictionary new. Dictionary new}.
- {#(a b 1 4) asOrderedCollection. #(c 1 5) asOrderedCollection.
- #($a 3 d) asOrderedCollection. #() asOrderedCollection}.
- {3 -> true. 5.6 -> $a. #x -> 2. 'abcd' -> false}.
- {9 @ 3 extent: 5 @ 4. 0 @ 0 extent: 45 @ 9. -3 @ -7 extent: 2 @ 2. 4 @ 4 extent: 16 @ 16}.
- {Color red. Color blue. Color black. Color gray}}.
+ self test2: objects.
+ "rec+0, rec+1, rec+2, rec+3 need to be tested. "
+ fName := (FileDirectory default fileNamesMatching: '*.ran') first.
+ sss := fName splitInteger first.
+ (Collection classPool at: #RandomForPicking) seed: sss.
+ cnt := 0.
+
+ [take := #(3 4) atRandom.
- self test2: objects.
- "rec+0, rec+1, rec+2, rec+3 need to be tested. "
- fName := (FileDirectory default fileNamesMatching: '*.ran') first.
- sss := fName splitInteger first.
- (Collection classPool at: #RandomForPicking) seed: sss.
- cnt := 0.
- [take := #(3 4) atRandom.
tuple := (1 to: take) collect: [:ind | (objects atRandom) atRandom].
other := (1 to: take) collect: [:ind | (objects atRandom) atRandom].
self load: (aa := Array with: tuple with: 1 with: other with: 7).
+ ((cnt := cnt + 1) \\ 10 = 0) " | (cnt > Skip)" ifTrue:
+ [Transcript cr; show: cnt printString; tab; tab; show: aa first printString].
- ((cnt := cnt + 1) \\ 10 = 0) " | (cnt > Skip)" ifTrue: [
- Transcript cr; show: cnt printString; tab; tab; show: aa first printString].
cnt > (Smalltalk at: #StopHere) ifTrue: [self halt]. "stop just before crash"
+ cnt > (Smalltalk at: #Skip)
+ ifTrue:
+ ["skip this many at start"
+ self search: true.
+ self test2: aa first. self test2: (aa at: 3).
+ "self test2: objects"]] repeat.
- cnt > (Smalltalk at: #Skip) ifTrue: ["skip this many at start"
- self search: true.
- self test2: aa first. self test2: (aa at: 3).
- "self test2: objects"
- ].
- true] whileTrue.
!
More information about the Squeak-dev
mailing list
|