Squeak-dev September 2009

squeak-dev@lists.squeakfoundation.org

119 participants
370 discussions

The Trunk: ST80-ar.51.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-ar.51.mcz ==================== Summary ==================== Name: ST80-ar.51 Author: ar Time: 4 September 2009, 12:16:11 pm UUID: 114c8a0a-6ee8-ec4a-9079-ef237be6ca53 Ancestors: ST80-ar.50 http://bugs.squeak.org/view.php?id=7321 Change Set: M7321_cleanup_offList_senders-nice Date: 19 April 2009 Author: nice #offList is OBSOLETED by AtomicProcessSuspend.1.cs Senders of #offList must be cleaned up =============== Diff against ST80-ar.50 =============== Item was changed: ----- Method: ControlManager>>interruptName:preemptedProcess: (in category 'scheduling') ----- interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller." | suspendingList newActiveController preemptedProcess | preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess]. + preemptedProcess suspend. - preemptedProcess == activeControllerProcess - ifFalse: [(suspendingList := preemptedProcess suspendingList) == nil - ifTrue: [preemptedProcess suspend] - ifFalse: [suspendingList remove: preemptedProcess. - preemptedProcess offList]]. (suspendingList := activeControllerProcess suspendingList) == nil ifTrue: [activeControllerProcess == Processor activeProcess ifTrue: [activeControllerProcess suspend]] ifFalse: [suspendingList remove: activeControllerProcess ifAbsent:[]. activeControllerProcess offList]. activeController ~~ nil ifTrue: [ "Carefully de-emphasis the current window." activeController view topView deEmphasizeForDebugger]. newActiveController := (Debugger openInterrupt: labelString onProcess: preemptedProcess) controller. newActiveController centerCursorInView. self activeController: newActiveController. !

1 0

The Trunk: System-ar.141.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ar.141.mcz ==================== Summary ==================== Name: System-ar.141 Author: ar Time: 4 September 2009, 12:14:07 pm UUID: 3c699bb1-c168-3b4f-9dd1-857805d75f22 Ancestors: System-ar.140 http://bugs.squeak.org/view.php?id=7321 Change Set: M7321_cleanup_offList_senders-nice Date: 19 April 2009 Author: nice #offList is OBSOLETED by AtomicProcessSuspend.1.cs Senders of #offList must be cleaned up =============== Diff against System-ar.140 =============== Item was changed: ----- Method: Project class>>interruptName:preemptedProcess: (in category 'utilities') ----- interruptName: labelString preemptedProcess: theInterruptedProcess "Create a Notifier on the active scheduling process with the given label." + | preemptedProcess projectProcess | - | preemptedProcess projectProcess suspendingList | Smalltalk isMorphic ifFalse: [^ ScheduledControllers interruptName: labelString]. ActiveHand ifNotNil:[ActiveHand interrupted]. + ActiveWorld _ World. "reinstall active globals" + ActiveHand _ World primaryHand. - ActiveWorld := World. "reinstall active globals" - ActiveHand := World primaryHand. ActiveHand interrupted. "make sure this one's interrupted too" + ActiveEvent _ nil. - ActiveEvent := nil. + projectProcess _ self uiProcess. "we still need the accessor for a while" + preemptedProcess _ theInterruptedProcess ifNil: [Processor preemptedProcess]. - projectProcess := self uiProcess. "we still need the accessor for a while" - preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess]. "Only debug preempted process if its priority is >= projectProcess' priority" preemptedProcess priority < projectProcess priority ifTrue:[ + projectProcess suspend. + preemptedProcess _ projectProcess. - (suspendingList := projectProcess suspendingList) == nil - ifTrue: [projectProcess == Processor activeProcess - ifTrue: [projectProcess suspend]] - ifFalse: [suspendingList remove: projectProcess ifAbsent: []. - projectProcess offList]. - preemptedProcess := projectProcess. ] ifFalse:[ preemptedProcess suspend offList. ]. Debugger openInterrupt: labelString onProcess: preemptedProcess !

1 0

The Trunk: System-ar.140.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ar.140.mcz ==================== Summary ==================== Name: System-ar.140 Author: ar Time: 4 September 2009, 12:10:59 pm UUID: f149b02b-e23d-fa48-b523-dfc2539b8878 Ancestors: System-ar.139 http://bugs.squeak.org/view.php?id=7301 Change Set: MessageTallyEnh-ar-jmv Date: 4 March 2009 Author: Andreas Raab Improve MessageTally to provide cross-process profiling. =============== Diff against System-ar.139 =============== Item was changed: ----- Method: MessageTally>>fullPrintOn:tallyExact:orThreshold: (in category 'printing') ----- fullPrintOn: aStream tallyExact: isExact orThreshold: perCent | threshold | + isExact ifFalse: [threshold _ (perCent asFloat / 100 * tally) rounded]. - isExact ifFalse: [threshold := (perCent asFloat / 100 * tally) rounded]. aStream nextPutAll: '**Tree**'; cr. + self rootPrintOn: aStream - self treePrintOn: aStream - tabs: OrderedCollection new - thisTab: '' total: tally totalTime: time tallyExact: isExact orThreshold: threshold. aStream nextPut: Character newPage; cr. aStream nextPutAll: '**Leaves**'; cr. self leavesPrintOn: aStream tallyExact: isExact orThreshold: threshold! Item was changed: ----- Method: MessageTally>>sonsOver: (in category 'comparing') ----- sonsOver: threshold | hereTally last sons | (receivers == nil or: [receivers size = 0]) ifTrue: [^#()]. + hereTally _ tally. + sons _ receivers select: "subtract subNode tallies for primitive hits here" - hereTally := tally. - sons := receivers select: "subtract subNode tallies for primitive hits here" [:son | + hereTally _ hereTally - son tally. - hereTally := hereTally - son tally. son tally > threshold]. hereTally > threshold ifTrue: + [last _ MessageTally new class: class method: method. + last process: process. - [last := MessageTally new class: class method: method. ^sons copyWith: (last primitives: hereTally)]. ^sons! Item was changed: ----- Method: MessageTally>>close (in category 'initialize-release') ----- close (Timer isMemberOf: Process) ifTrue: [Timer terminate]. + Timer := nil. - Timer := ObservedProcess := nil. class := method := tally := receivers := nil! Item was added: + ----- Method: MessageTally>>spyAllEvery:on: (in category 'initialize-release') ----- + spyAllEvery: millisecs on: aBlock + "Create a spy and spy on the given block at the specified rate." + "Spy all the system processes" + + | myDelay startTime time0 observedProcess | + (aBlock isBlock) + ifFalse: [self error: 'spy needs a block here']. + self class: aBlock receiver class method: aBlock method. + "set up the probe" + myDelay := Delay forMilliseconds: millisecs. + time0 := Time millisecondClockValue. + gcStats := SmalltalkImage current getVMParameters. + Timer := [ + [true] whileTrue: [ + startTime := Time millisecondClockValue. + myDelay wait. + observedProcess := Processor preemptedProcess. + self tally: observedProcess suspendedContext + in: (ShowProcesses ifTrue: [observedProcess]) + "tally can be > 1 if ran a long primitive" + by: (Time millisecondClockValue - startTime) // millisecs]. + nil] newProcess. + Timer priority: Processor timingPriority-1. + "activate the probe and evaluate the block" + Timer resume. + ^ aBlock ensure: [ + "Collect gc statistics" + SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | + gcStats at: idx put: (gcVal - (gcStats at: idx))]. + "cancel the probe and return the value" + Timer terminate. + time := Time millisecondClockValue - time0]! Item was changed: ----- Method: MessageTally>>tallyPath:by: (in category 'tallying') ----- tallyPath: context by: count | aMethod path | + aMethod :=context method. + + "Find the correct child (if there)" + receivers do: [ :oldTally | + oldTally method == aMethod ifTrue: [path := oldTally]]. + + "Add new child if needed" + path ifNil: [ + path := MessageTally new class: context receiver class method: aMethod. - aMethod := context method. - receivers do: - [:aMessageTally | - aMessageTally method == aMethod ifTrue: [path := aMessageTally]]. - path == nil ifTrue: - [path := MessageTally new class: context receiver class method: aMethod; - maxClassNameSize: maxClassNameSize; - maxClassPlusSelectorSize: maxClassPlusSelectorSize; - maxTabs: maxTabs. receivers := receivers copyWith: path]. + ^ path bumpBy: count! Item was changed: ----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') ----- spyEvery: millisecs on: aBlock "Create a spy and spy on the given block at the specified rate." + "Spy only on the active process (in which aBlock is run)" + | myDelay startTime time0 observedProcess | + (aBlock isMemberOf: BlockContext) + ifFalse: [self error: 'spy needs a block here']. + self class: aBlock receiver class method: aBlock method. - | myDelay startTime time0 | - aBlock isBlock - ifTrue: [self class: aBlock receiver class method: aBlock method] - ifFalse: [self class: aBlock class method: aBlock method]. "set up the probe" + observedProcess _ Processor activeProcess. - ObservedProcess := Processor activeProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. gcStats := SmalltalkImage current getVMParameters. + Timer := [ + [true] whileTrue: [ + startTime := Time millisecondClockValue. - Timer := - [[true] whileTrue: - [startTime := Time millisecondClockValue. myDelay wait. + self tally: Processor preemptedProcess suspendedContext + in: (ShowProcesses ifTrue: [ + observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]]) - self tally: ObservedProcess suspendedContext "tally can be > 1 if ran a long primitive" by: (Time millisecondClockValue - startTime) // millisecs]. nil] newProcess. + Timer priority: Processor timingPriority-1. - Timer priority: Processor userInterruptPriority. "activate the probe and evaluate the block" Timer resume. + ^ aBlock ensure: [ + "Collect gc statistics" + SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | + gcStats at: idx put: (gcVal - (gcStats at: idx))]. - ^ aBlock ensure: - ["Collect gc statistics" - SmalltalkImage current getVMParameters keysAndValuesDo: - [:idx :gcVal| gcStats at: idx put: (gcVal - (gcStats at: idx))]. "cancel the probe and return the value" Timer terminate. time := Time millisecondClockValue - time0]! Item was added: + ----- Method: MessageTally>>rootPrintOn:total:totalTime:tallyExact:orThreshold: (in category 'printing') ----- + rootPrintOn: aStream total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold + | sons groups p | + ShowProcesses ifFalse:[ + ^self treePrintOn: aStream + tabs: OrderedCollection new + thisTab: '' + total: total + totalTime: totalTime + tallyExact: isExact + orThreshold: threshold. + ]. + sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold]. + groups := sons groupBy:[:aTally| aTally process] having:[:g| true]. + groups do:[:g| + sons := g asSortedCollection. + p := g anyOne process. + "Do not show 'other processes' " + "Please keep consistency with #leavesInto:fromSender: + on showing them or not!!" + p ifNotNil: [ + aStream nextPutAll: '--------------------------------'; cr. + aStream nextPutAll: 'Process: ', (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr. + aStream nextPutAll: '--------------------------------'; cr. + (1 to: sons size) do:[:i | + (sons at: i) + treePrintOn: aStream + tabs: OrderedCollection new + thisTab: '' + total: total + totalTime: totalTime + tallyExact: isExact + orThreshold: threshold]]. + ].! Item was changed: ----- Method: MessageTally>>report: (in category 'reporting') ----- report: strm "Print a report, with cutoff percentage of each element of the tree + (leaves, roots, tree), on the stream, strm." - (leaves, roots, tree)=2, on the stream, strm." + self report: strm cutoff: 1! - self report: strm cutoff: 2! Item was changed: Magnitude subclass: #MessageTally + instanceVariableNames: 'class method process tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' + classVariableNames: 'DefaultPollPeriod ShowProcesses Timer' - instanceVariableNames: 'class method tally receivers senders time gcStats maxClassNameSize maxClassPlusSelectorSize maxTabs' - classVariableNames: 'DefaultPollPeriod ObservedProcess Timer' poolDictionaries: '' category: 'System-Tools'! !MessageTally commentStamp: 'nk 3/8/2004 12:43' prior: 0! My instances observe and report the amount of time spent in methods. NOTE: a higher-level user interface (combining the MessageTally result tree with a method browser) is available from TimeProfileBrowser. MessageTally provides two different strategies available for profiling: * spyOn: and friends use a high-priority Process to interrupt the block or process being spied on at periodic intervals. The interrupted call stack is then examined for caller information. * tallySends: and friends use the interpreter simulator to run the block, recording every method call. The two give you different results: * spyOn: gives you a view of where the time is being spent in your program, at least on a rough statistical level (assuming you've run the block for long enough and have a high enough poll rate). If you're trying to optimize your code, start here and optimize the methods where most of the time is being spent first. * tallySends: gives you accurate counts of how many times methods get called, and by exactly which route. If you're debugging, or trying to figure out if a given method is getting called too many times, this is your tool. You can change the printing format (that is, the whitespace and string compression) by using these instance methods: maxClassNameSize: maxClassPlusSelectorSize: maxTabs: You can change the default polling period (initially set to 1) by calling MessageTally defaultPollPeriod: numberOfMilliseconds Q: How do you interpret MessageTally>>tallySends A: The methods #tallySends and #spyOn: measure two very different quantities, but broken down in the same who-called-who format. #spyOn: is approximate, but more indicative of real time spent, whereas #tallySends is exact and a precise record of how many times each method got executed.! Item was changed: ----- Method: MessageTally>>= (in category 'comparing') ----- = aMessageTally self species == aMessageTally species ifFalse: [^ false]. + ^ aMessageTally method == method and:[aMessageTally process == process]! - ^ aMessageTally method == method! Item was changed: ----- Method: MessageTally class>>defaultMaxTabs (in category 'defaults') ----- defaultMaxTabs "Return the default number of tabs after which leading white space is compressed" + ^120! - ^40! Item was changed: ----- Method: MessageTally class>>spyOn: (in category 'spying') ----- + spyOn: aBlock + " + [1000 timesRepeat: [ + 100 timesRepeat: [120 factorial]. + (Delay forMilliseconds: 10) wait + ]] forkAt: 45 named: '45'. + MessageTally spyOn: [10000 timesRepeat: [1.23 printString]] + " - spyOn: aBlock "MessageTally spyOn: [100 timesRepeat: [3.14159 printString]]" | node result | + node _ self new. + result _ node spyEvery: self defaultPollPeriod on: aBlock. - node := self new. - result := node spyEvery: self defaultPollPeriod on: aBlock. (StringHolder new contents: (String streamContents: [:s | node report: s; close])) openLabel: 'Spy Results'. ^ result! Item was changed: ----- Method: MessageTally>>tally:by: (in category 'tallying') ----- tally: context by: count "Explicitly tally the specified context and its stack." + | sender | + + "Add to this node if appropriate" - | root | context method == method ifTrue: [^self bumpBy: count]. + + "No sender? Add new branch to the tree." + (sender := context home sender)ifNil: [ + ^ (self bumpBy: count) tallyPath: context by: count]. + + "Find the node for the sending context (or add it if necessary)" + ^ (self tally: sender by: count) tallyPath: context by: count! - (root := context home sender) == nil - ifTrue: [^ (self bumpBy: count) tallyPath: context by: count]. - ^ (self tally: root by: count) tallyPath: context by: count! Item was changed: ----- Method: MessageTally>>leavesInto:fromSender: (in category 'collecting leaves') ----- leavesInto: leafDict fromSender: senderTally | rcvrs | + rcvrs _ self sonsOver: 0. - rcvrs := self sonsOver: 0. rcvrs size = 0 ifTrue: [self into: leafDict fromSender: senderTally] + ifFalse: [ + + "Do not show 'other processes' " + "Please keep consistency with #rootPrintOn:total:totalTime:tallyExact:orThreshold: + on showing them or not!!" + rcvrs anyOne process ifNil: [^self]. + + rcvrs do: - ifFalse: [rcvrs do: [:node | node isPrimitives ifTrue: [node leavesInto: leafDict fromSender: senderTally] ifFalse: [node leavesInto: leafDict fromSender: self]]]! Item was added: + ----- Method: MessageTally class>>spyAllOn: (in category 'spying') ----- + spyAllOn: aBlock + "Spy on all the processes in the system + + [1000 timesRepeat: [3.14159 printString. Processor yield]] fork. + [1000 timesRepeat: [20 factorial. Processor yield]] fork. + [1000 timesRepeat: [20 factorial. Processor yield]] fork. + MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] + + " + | node result | + node := self new. + result := node spyAllEvery: self defaultPollPeriod on: aBlock. + (StringHolder new contents: (String streamContents: [:s | node report: s; close])) + openLabel: 'Spy Results'. + ^ result! Item was changed: ----- Method: MessageTally class>>spyOnProcess:forMilliseconds: (in category 'spying') ----- spyOnProcess: aProcess forMilliseconds: msecDuration + " + | p1 p2 | + p1 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. + p2 _ [100000 timesRepeat: [3.14159 printString. Processor yield]] fork. - "| p | - p := [100000 timesRepeat: [3.14159 printString]] fork. (Delay forMilliseconds: 100) wait. + MessageTally spyOnProcess: p1 forMilliseconds: 1000 + " - MessageTally spyOnProcess: p forMilliseconds: 1000" | node | node := self new. node spyEvery: self defaultPollPeriod onProcess: aProcess forMilliseconds: msecDuration. (StringHolder new contents: (String streamContents: [:s | node report: s; close])) openLabel: 'Spy Results'! Item was changed: ----- Method: MessageTally>>into:fromSender: (in category 'collecting leaves') ----- into: leafDict fromSender: senderTally | leafNode | + leafNode _ leafDict at: method - leafNode := leafDict at: method ifAbsent: [leafDict at: method + put: ((MessageTally new class: class method: method) + process: process)]. - put: (MessageTally new class: class method: method)]. leafNode bump: tally fromSender: senderTally! Item was added: + ----- Method: MessageTally>>tallyPath:in:by: (in category 'tallying') ----- + tallyPath: context in: aProcess by: count + | aMethod path | + aMethod := context method. + + "Find the correct child (if there)" + receivers do: [ :oldTally | + (oldTally method == aMethod and: [oldTally process == aProcess]) + ifTrue: [path := oldTally]]. + + "Add new child if needed" + path ifNil:[ + path := MessageTally new class: context receiver class method: aMethod; + process: aProcess; + maxClassNameSize: maxClassNameSize; + maxClassPlusSelectorSize: maxClassPlusSelectorSize; + maxTabs: maxTabs. + receivers := receivers copyWith: path]. + + ^ path bumpBy: count! Item was added: + ----- Method: MessageTally>>process: (in category 'private') ----- + process: aProcess + process := aProcess! Item was changed: ----- Method: MessageTally>>copyWithTally: (in category 'private') ----- copyWithTally: hitCount + ^ (MessageTally new class: class method: method) + process: process; + bump: hitCount! - ^ (MessageTally new class: class method: method) bump: hitCount! Item was added: + ----- Method: MessageTally class>>showProcesses (in category 'defaults') ----- + showProcesses + "Indicates whether to show each process separately or cumulatively. + For example, compare the spy results of the following with both values: + + [1000 timesRepeat: [3.14159 printString. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] + + " + <preference: 'Show Tally Processes' + category: 'debug' + description: 'When true, show individual processes in MessageTally' + type: #Boolean> + ^ShowProcesses! Item was added: + ----- Method: MessageTally class>>initialize (in category 'class initialization') ----- + initialize + "MessageTally initialize" + "By default, show each process separately" + ShowProcesses := true! Item was added: + ----- Method: MessageTally>>process (in category 'private') ----- + process + ^process! Item was added: + ----- Method: MessageTally class>>showProcesses: (in category 'defaults') ----- + showProcesses: aBool + "Indicates whether to show each process separately or cumulatively. + For example, compare the spy results of the following with both values: + + [1000 timesRepeat: [3.14159 printString. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + [1000 timesRepeat: [30 factorial. Processor yield]] fork. + MessageTally spyAllOn: [ (Delay forMilliseconds: 100) wait] + + " + ShowProcesses := aBool.! Item was added: + ----- Method: MessageTally>>tally:in:by: (in category 'tallying') ----- + tally: context in: aProcess by: count + "Explicitly tally the specified context and its stack." + | sender | + + "Add to this node if appropriate" + context method == method ifTrue: [^self bumpBy: count]. + + "No sender? Add new branch to the tree." + (sender := context home sender) ifNil: [ + ^ (self bumpBy: count) tallyPath: context in: aProcess by: count]. + + "Find the node for the sending context (or add it if necessary)" + ^ (self tally: sender in: aProcess by: count) tallyPath: context in: aProcess by: count! Item was changed: ----- Method: MessageTally>>spyEvery:onProcess:forMilliseconds: (in category 'initialize-release') ----- spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration "Create a spy and spy on the given process at the specified rate." + | myDelay startTime time0 endTime sem observedProcess | - | myDelay time0 endTime sem | (aProcess isKindOf: Process) ifFalse: [self error: 'spy needs a Process here']. self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method. "set up the probe" + observedProcess := aProcess. - ObservedProcess := aProcess. myDelay := Delay forMilliseconds: millisecs. time0 := Time millisecondClockValue. endTime := time0 + msecDuration. sem := Semaphore new. + gcStats := SmalltalkImage current getVMParameters. + Timer := [ + [ + startTime := Time millisecondClockValue. + myDelay wait. + self tally: Processor preemptedProcess suspendedContext + in: (ShowProcesses ifTrue: [ + observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil]]) + "tally can be > 1 if ran a long primitive" + by: (Time millisecondClockValue - startTime) // millisecs. + startTime < endTime + ] whileTrue. + sem signal. + ] newProcess. + Timer priority: Processor timingPriority-1. + "activate the probe and evaluate the block" + Timer resume. - gcStats := SmalltalkImage current getVMParameters. - Timer := [[| startTime | - startTime := Time millisecondClockValue. - myDelay wait. - self tally: ObservedProcess suspendedContext by: Time millisecondClockValue - startTime // millisecs. - startTime < endTime] whileTrue. - sem signal] - forkAt: (ObservedProcess priority + 1 min: Processor highestPriority). "activate the probe and wait for it to finish" sem wait. "Collect gc statistics" + SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal | + gcStats at: idx put: (gcVal - gcStats at: idx)]. - SmalltalkImage current getVMParameters keysAndValuesDo: - [:idx :gcVal| gcStats at: idx put: (gcVal - gcStats at: idx)]. time := Time millisecondClockValue - time0!

1 0

The Trunk: Kernel-ar.240.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.240.mcz ==================== Summary ==================== Name: Kernel-ar.240 Author: ar Time: 4 September 2009, 12:01:07 pm UUID: 099cbd0d-a7eb-0d49-952d-85f7b8391795 Ancestors: Kernel-ar.239 http://bugs.squeak.org/view.php?id=7321 (three more change sets at once since I can't wait three hours for the commits to complete) Change Set: SignalExceptionFix Date: 23 March 2009 Author: Andreas Raab A fix for Process>>signalException: which would not work properly for Process subclasses and should use atomic suspend if at all available. Change Set: ProcessTerminateFix Date: 23 March 2009 Author: Andreas Raab Fixes a problem in Process>>isTerminated which can cause severe problems if the process which is being asked runs at a higher priority than the process asking. In this situation the answer may be incorrect if an external signal occurs while the code is trying to find the bottom context of an executing process. Change Set: DelayWaitTimeout Date: 23 March 2009 Author: Andreas Raab Provides a light-weight, correct implementation of waitTimeoutMSecs: =============== Diff against Kernel-ar.239 =============== Item was added: + ----- Method: DelayWaitTimeout>>setDelay:forSemaphore: (in category 'private') ----- + setDelay: anInteger forSemaphore: aSemaphore + super setDelay: anInteger forSemaphore: aSemaphore. + process := Processor activeProcess. + expired := false.! Item was added: + ----- Method: DelayWaitTimeout>>signalWaitingProcess (in category 'signaling') ----- + signalWaitingProcess + "Release the given process from the semaphore it is waiting on. + This method relies on running at highest priority so that it cannot be preempted + by the process being released." + beingWaitedOn := false. + "Release the process but only if it is still waiting on its original list" + process suspendingList == delaySemaphore ifTrue:[ + expired := true. + process suspend; resume. + ]. + ! Item was changed: ----- Method: Process>>signalException: (in category 'signaling') ----- signalException: anException "Signal an exception in the receiver process...if the receiver is currently suspended, the exception will get signaled when the receiver is resumed. If the receiver is blocked on a Semaphore, it will be immediately re-awakened and the exception will be signaled; if the exception is resumed, then the receiver will return to a blocked state unless the blocking Semaphore has excess signals" + | oldList | - "If we are the active process, go ahead and signal the exception" self isActiveProcess ifTrue: [^anException signal]. + + "Suspend myself first to ensure that I won't run away in the + midst of the following modifications." + myList ifNotNil:[oldList := self suspend]. "Add a new method context to the stack that will signal the exception" suspendedContext := MethodContext sender: suspendedContext receiver: self + method: (self class lookupSelector: #pvtSignal:list:) + arguments: (Array with: anException with: oldList). - method: (self class methodDict at: #pvtSignal:list:) - arguments: (Array with: anException with: myList). "If we are on a list to run, then suspend and restart the receiver (this lets the receiver run if it is currently blocked on a semaphore). If we are not on a list to be run (i.e. this process is suspended), then when the process is resumed, it will signal the exception" + oldList ifNotNil: [self resume]. + ! - myList ifNotNil: [self suspend; resume].! Item was added: + ----- Method: ContextPart>>isBottomContext (in category 'query') ----- + isBottomContext + "Answer if this is the last context (the first context invoked) in my sender chain" + + ^sender isNil! Item was changed: ----- Method: Process>>isTerminated (in category 'accessing') ----- isTerminated self isActiveProcess ifTrue: [^ false]. + ^suspendedContext isNil + or: ["If the suspendedContext is the bottomContext it is the block in Process>>newProcess. + If so, and the pc is greater than the startpc, the bock has alrteady sent and returned + from value and there is nothing more to do." + suspendedContext isBottomContext + and: [suspendedContext pc > suspendedContext startpc]]! - ^ suspendedContext isNil or: [ - suspendedContext == suspendedContext bottomContext and: [ - suspendedContext pc > suspendedContext startpc]]! Item was added: + ----- Method: DelayWaitTimeout>>wait (in category 'waiting') ----- + wait + "Wait until either the semaphore is signaled or the delay times out" + [self schedule. + "It is critical that the following has no suspension point so that + the test and the wait primitive are atomic. In addition, if the delay + is no longer being waited on while entering the way we know that it + is expired because the delay has already fired." + beingWaitedOn + ifTrue:[delaySemaphore wait] + ifFalse:[expired := true]] ensure:[self unschedule]. + ^self isExpired + ! Item was changed: ----- Method: Semaphore>>waitTimeoutMSecs: (in category 'communication') ----- waitTimeoutMSecs: anInteger + "Wait on this semaphore for up to the given number of milliseconds, then timeout. + Return true if the deadline expired, false otherwise." - "Wait on this semaphore for up to the given number of milliseconds, then timeout. It is up to the sender to determine the difference between the expected event and a timeout." - | d | + d := DelayWaitTimeout new setDelay: (anInteger max: 0) forSemaphore: self. + ^d wait! - d := Delay timeoutSemaphore: self afterMSecs: (anInteger max: 0). - [self wait] ensure:[d unschedule]. - ! Item was added: + Delay subclass: #DelayWaitTimeout + instanceVariableNames: 'process expired' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Processes'! + + !DelayWaitTimeout commentStamp: '<historical>' prior: 0! + DelayWaitTimeout is a special kind of Delay used in waitTimeoutMSecs: to avoid signaling the underlying semaphore when the wait times out.! Item was changed: ----- Method: Semaphore>>waitTimeoutSeconds: (in category 'communication') ----- waitTimeoutSeconds: anInteger + "Wait on this semaphore for up to the given number of seconds, then timeout. + Return true if the deadline expired, false otherwise." + ^self waitTimeoutMSecs: anInteger * 1000. - "Wait on this semaphore for up to the given number of seconds, then timeout. It is up to the sender to determine the difference between the expected event and a timeout." - - self waitTimeoutMSecs: anInteger * 1000. ! Item was added: + ----- Method: DelayWaitTimeout>>isExpired (in category 'testing') ----- + isExpired + "Did this timeout fire before the associated semaphore was signaled?" + ^expired!

1 0

Re: [squeak-dev] The Trunk: Kernel-ar.238.mcz
by Michael Haupt 04 Sep '09

04 Sep '09

Hi, installation hangs at ~75 % during "cleaning up". The Squeak VM is at 100 % CPU load. Ctrl-. has no effect. (Mac VM 4.2.1.) Best, Michael On Fri, Sep 4, 2009 at 6:51 AM, <commits(a)source.squeak.org> wrote: > Andreas Raab uploaded a new version of Kernel to project The Trunk: > http://source.squeak.org/trunk/Kernel-ar.238.mcz > > ==================== Summary ==================== > > Name: Kernel-ar.238 > Author: ar > Time: 3 September 2009, 9:50:51 am > UUID: 9896c3f8-760f-e942-ac84-5f6c9127150c > Ancestors: Kernel-ar.237 > > http://bugs.squeak.org/view.php?id=7321 > > Change Set: AtomicProcessSuspend > Date: 23 March 2009 > Author: Andreas Raab > > In-image support for atomic process suspend. > > =============== Diff against Kernel-ar.237 =============== > > Item was changed: > ----- Method: Process>>suspend (in category 'changing process state') ----- > suspend > + "Primitive. Stop the process that the receiver represents in such a way > - "Stop the process that the receiver represents in such a way > that it can be restarted at a later time (by sending the receiver the > message resume). If the receiver represents the activeProcess, suspend it. > + Otherwise remove the receiver from the list of waiting processes. > + The return value of this method is the list the receiver was previously on (if any)." > + | oldList | > + <primitive: 88> > + "This is fallback code for VMs which only support the old primitiveSuspend which > + would not accept processes that are waiting to be run." > + myList ifNil:[^nil]. "this allows us to use suspend multiple times" > + oldList := myList. > + myList := nil. > + oldList remove: self ifAbsent:[]. > + ^oldList! > - Otherwise remove the receiver from the list of waiting processes." > - > - self isActiveProcess ifTrue: [ > - myList := nil. > - self primitiveSuspend. > - ] ifFalse: [ > - myList ifNotNil: [ > - myList remove: self ifAbsent: []. > - myList := nil]. > - ] > - ! > > Item was changed: > ----- Method: Process>>offList (in category 'accessing') ----- > offList > + "OBSOLETE. Process>>suspend will atomically reset myList if the process is suspended. > + There should never be a need to send #offList but some older users may not be aware > + of the changed semantics to suspend and may try the old hickadidoo seen here: > - "Inform the receiver that it has been taken off a list that it was > - suspended on. This is to break a backpointer." > > + (suspendingList := process suspendingList) == nil > + ifTrue: [process == Processor activeProcess ifTrue: [process suspend]] > + ifFalse: [suspendingList remove: process ifAbsent:[]. > + process offList]. > + > + Usages like the above should be replaced by a simple 'process suspend' " > myList := nil! > > Item was changed: > ----- Method: Process>>terminate (in category 'changing process state') ----- > terminate > "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating." > > + | ctxt unwindBlock oldList | > - | ctxt unwindBlock inSema | > self isActiveProcess ifTrue: [ > ctxt := thisContext. > [ ctxt := ctxt findNextUnwindContextUpTo: nil. > ctxt isNil > ] whileFalse: [ > unwindBlock := ctxt tempAt: 1. > unwindBlock ifNotNil: [ > ctxt tempAt: 1 put: nil. > thisContext terminateTo: ctxt. > unwindBlock value]. > ]. > thisContext terminateTo: nil. > + self suspend. > + ] ifFalse:[ > + myList ifNotNil:[oldList := self suspend]. > + suspendedContext ifNotNil:[ > - myList := nil. > - self primitiveSuspend. > - ] ifFalse: [ > - "Since the receiver is not the active process, drop its priority to rock-bottom so that > - it doesn't accidentally preempt the process that is trying to terminate it." > - priority := 10. > - myList ifNotNil: [ > - myList remove: self ifAbsent: []. > - "Figure out if the receiver was terminated while waiting on a Semaphore" > - inSema := myList class == Semaphore. > - myList := nil]. > - suspendedContext ifNotNil: [ > "Figure out if we are terminating the process while waiting in Semaphore>>critical: > In this case, pop the suspendedContext so that we leave the ensure: block inside > Semaphore>>critical: without signaling the semaphore." > + (oldList class == Semaphore and:[ > - (inSema == true and:[ > suspendedContext method == (Semaphore compiledMethodAt: #critical:)]) ifTrue:[ > suspendedContext := suspendedContext home. > ]. > ctxt := self popTo: suspendedContext bottomContext. > ctxt == suspendedContext bottomContext ifFalse: [ > self debug: ctxt title: 'Unwind error during termination']]. > ]. > ! > > Item was removed: > - ----- Method: Process>>primitiveSuspend (in category 'changing process state') ----- > - primitiveSuspend > - "Primitive. Stop the process that self represents in such a way > - that it can be restarted at a later time (by sending #resume). > - ASSUMES self is the active process. > - Essential. See Object documentation whatIsAPrimitive." > - > - <primitive: 88> > - self primitiveFailed! > > >

2 1

The Trunk: Kernel-ar.239.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.239.mcz ==================== Summary ==================== Name: Kernel-ar.239 Author: ar Time: 3 September 2009, 10:59:24 am UUID: 8e35a7c8-a3cc-ab46-bd6c-ad7f04321f77 Ancestors: Kernel-ar.238 Ah, yes. Our version of Monticello removes methods before installing the new ones and that doesn't play very well when it comes to Delay. Silly, silly Monticello. Restore the methods so people can load the update and leave in the cruft for now. =============== Diff against Kernel-ar.238 =============== Item was added: + ----- Method: Delay>>scheduleEvent (in category 'private') ----- + scheduleEvent + "Schedule this delay" + resumptionTime := Time millisecondClockValue + delayDuration. + AccessProtect critical:[ + ScheduledDelay := self. + TimingSemaphore signal. + ].! Item was added: + ----- Method: Delay>>unscheduleEvent (in category 'private') ----- + unscheduleEvent + AccessProtect critical:[ + FinishedDelay := self. + TimingSemaphore signal. + ].!

1 0

The Trunk: Kernel-ar.238.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.238.mcz ==================== Summary ==================== Name: Kernel-ar.238 Author: ar Time: 3 September 2009, 9:50:51 am UUID: 9896c3f8-760f-e942-ac84-5f6c9127150c Ancestors: Kernel-ar.237 http://bugs.squeak.org/view.php?id=7321 Change Set: AtomicProcessSuspend Date: 23 March 2009 Author: Andreas Raab In-image support for atomic process suspend. =============== Diff against Kernel-ar.237 =============== Item was changed: ----- Method: Process>>suspend (in category 'changing process state') ----- suspend + "Primitive. Stop the process that the receiver represents in such a way - "Stop the process that the receiver represents in such a way that it can be restarted at a later time (by sending the receiver the message resume). If the receiver represents the activeProcess, suspend it. + Otherwise remove the receiver from the list of waiting processes. + The return value of this method is the list the receiver was previously on (if any)." + | oldList | + <primitive: 88> + "This is fallback code for VMs which only support the old primitiveSuspend which + would not accept processes that are waiting to be run." + myList ifNil:[^nil]. "this allows us to use suspend multiple times" + oldList := myList. + myList := nil. + oldList remove: self ifAbsent:[]. + ^oldList! - Otherwise remove the receiver from the list of waiting processes." - - self isActiveProcess ifTrue: [ - myList := nil. - self primitiveSuspend. - ] ifFalse: [ - myList ifNotNil: [ - myList remove: self ifAbsent: []. - myList := nil]. - ] - ! Item was changed: ----- Method: Process>>offList (in category 'accessing') ----- offList + "OBSOLETE. Process>>suspend will atomically reset myList if the process is suspended. + There should never be a need to send #offList but some older users may not be aware + of the changed semantics to suspend and may try the old hickadidoo seen here: - "Inform the receiver that it has been taken off a list that it was - suspended on. This is to break a backpointer." + (suspendingList := process suspendingList) == nil + ifTrue: [process == Processor activeProcess ifTrue: [process suspend]] + ifFalse: [suspendingList remove: process ifAbsent:[]. + process offList]. + + Usages like the above should be replaced by a simple 'process suspend' " myList := nil! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating." + | ctxt unwindBlock oldList | - | ctxt unwindBlock inSema | self isActiveProcess ifTrue: [ ctxt := thisContext. [ ctxt := ctxt findNextUnwindContextUpTo: nil. ctxt isNil ] whileFalse: [ unwindBlock := ctxt tempAt: 1. unwindBlock ifNotNil: [ ctxt tempAt: 1 put: nil. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: nil. + self suspend. + ] ifFalse:[ + myList ifNotNil:[oldList := self suspend]. + suspendedContext ifNotNil:[ - myList := nil. - self primitiveSuspend. - ] ifFalse: [ - "Since the receiver is not the active process, drop its priority to rock-bottom so that - it doesn't accidentally preempt the process that is trying to terminate it." - priority := 10. - myList ifNotNil: [ - myList remove: self ifAbsent: []. - "Figure out if the receiver was terminated while waiting on a Semaphore" - inSema := myList class == Semaphore. - myList := nil]. - suspendedContext ifNotNil: [ "Figure out if we are terminating the process while waiting in Semaphore>>critical: In this case, pop the suspendedContext so that we leave the ensure: block inside Semaphore>>critical: without signaling the semaphore." + (oldList class == Semaphore and:[ - (inSema == true and:[ suspendedContext method == (Semaphore compiledMethodAt: #critical:)]) ifTrue:[ suspendedContext := suspendedContext home. ]. ctxt := self popTo: suspendedContext bottomContext. ctxt == suspendedContext bottomContext ifFalse: [ self debug: ctxt title: 'Unwind error during termination']]. ]. ! Item was removed: - ----- Method: Process>>primitiveSuspend (in category 'changing process state') ----- - primitiveSuspend - "Primitive. Stop the process that self represents in such a way - that it can be restarted at a later time (by sending #resume). - ASSUMES self is the active process. - Essential. See Object documentation whatIsAPrimitive." - - <primitive: 88> - self primitiveFailed!

1 0

The Trunk: Kernel-ar.237.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ar.237.mcz ==================== Summary ==================== Name: Kernel-ar.237 Author: ar Time: 3 September 2009, 9:48:09 am UUID: 0ce8d553-42c8-2d42-add2-fbadccdbfe28 Ancestors: Kernel-tfel.236 http://bugs.squeak.org/view.php?id=7321 Change Set: DelayCleanup Date: 23 March 2009 Author: Andreas Raab Cleans up Delay by removing many of the no longer used methods (timerInterruptWatcher etc). It also provides some fixes for methods that got mysteriously broken even though their original versions were perfectly fine, including Delay class>>timeoutSemaphore:after:. =============== Diff against Kernel-tfel.236 =============== Item was changed: + ----- Method: Delay class>>primSignal:atMilliseconds: (in category 'primitives') ----- - ----- Method: Delay class>>primSignal:atMilliseconds: (in category 'testing') ----- primSignal: aSemaphore atMilliseconds: aSmallInteger "Signal the semaphore when the millisecond clock reaches the value of the second argument. Fail if the first argument is neither a Semaphore nor nil. Essential. See Object documentation whatIsAPrimitive." - - | guardianDelay | <primitive: 136> + ^self primitiveFailed! - "VM code actually only fails if the time parameter is not a SmallInteger value" - aSmallInteger isInteger ifFalse:["somebody messed up badly and we can't do much about it" - aSemaphore ifNotNil: [ - ActiveDelay := nil. - aSemaphore signal. "Prevent an image crash"]. - ^self primitiveError: 'primSignal:atMilliseconds: failed because of a non-Integer resumption time parameter. The Semaphore has been signalled as a best guess of the right thing to do']. - - "So now we feel fairly sure that the aSmallInteger resumption time is actually a large integer and we need to just wait some more. To make the system do that we need a fake Delay and a reasonable resumption time to feed to the VM. A decent value is SmallInteger maxVal since the VM handles correlating that sort of largish value and clock wrapping. - First though we return the problem Delay to the queue" - SuspendedDelays add: ActiveDelay. - "Now we want a Delay set to fire and do nothing" - guardianDelay := self guardianDelay. - guardianDelay activate - ! Item was changed: ----- Method: Delay class>>runTimerEventLoop (in category 'timer process') ----- runTimerEventLoop "Run the timer event loop." + [RunTimerEventLoop] whileTrue: [self handleTimerEvent]! - [ - [RunTimerEventLoop] whileTrue: [self handleTimerEvent] - ] on: Error do:[:ex| - "Clear out the process so it does't get killed" - TimerEventLoop := nil. - "Launch the old-style interrupt watcher" - self startTimerInterruptWatcher. - "And pass the exception on" - ex pass. - ].! Item was changed: ----- Method: Delay class>>restoreResumptionTimes (in category 'snapshotting') ----- restoreResumptionTimes "Private!! Restore the resumption times of all scheduled Delays after a snapshot or clock roll-over. This method should be called only while the AccessProtect semaphore is held." | newBaseTime | newBaseTime := Time millisecondClockValue. SuspendedDelays do: [:d | d adjustResumptionTimeOldBase: 0 newBase: newBaseTime]. ActiveDelay == nil ifFalse: [ ActiveDelay adjustResumptionTimeOldBase: 0 newBase: newBaseTime. + ]. - ActiveDelay activate]. ! Item was changed: ----- Method: Delay class>>forMilliseconds: (in category 'instance creation') ----- + forMilliseconds: anInteger - forMilliseconds: aNumber "Return a new Delay for the given number of milliseconds. Sending 'wait' to this Delay will cause the sender's process to be suspended for approximately that length of time." + anInteger < 0 ifTrue: [self error: 'delay times cannot be negative']. + ^ self new + setDelay: anInteger asInteger + forSemaphore: Semaphore new - ^ self new setDelay: aNumber forSemaphore: Semaphore new ! Item was changed: ----- Method: Delay class>>startUp (in category 'snapshotting') ----- startUp "Restart active delay, if any, when resuming a snapshot." + DelaySuspended ifFalse:[^self error: 'Trying to activate Delay twice']. + DelaySuspended := false. self restoreResumptionTimes. - ActiveDelay == nil ifFalse: [ActiveDelay activate]. AccessProtect signal. ! Item was changed: ----- Method: Delay class>>startTimerEventLoop (in category 'timer process') ----- startTimerEventLoop "Start the timer event loop" "Delay startTimerEventLoop" self stopTimerEventLoop. - self stopTimerInterruptWatcher. AccessProtect := Semaphore forMutualExclusion. ActiveDelayStartTime := Time millisecondClockValue. SuspendedDelays := Heap withAll: (SuspendedDelays ifNil:[#()]) sortBlock: [:d1 :d2 | d1 resumptionTime <= d2 resumptionTime]. TimingSemaphore := Semaphore new. RunTimerEventLoop := true. TimerEventLoop := [self runTimerEventLoop] newProcess. TimerEventLoop priority: Processor timingPriority. TimerEventLoop resume. TimingSemaphore signal. "get going" ! Item was changed: ----- Method: Delay class>>timeoutSemaphore:afterMSecs: (in category 'instance creation') ----- timeoutSemaphore: aSemaphore afterMSecs: anInteger "Create and schedule a Delay to signal the given semaphore when the given number of milliseconds has elapsed. Return the scheduled Delay. The timeout can be cancelled by sending 'unschedule' to this Delay." "Details: This mechanism is used to provide a timeout when waiting for an external event, such as arrival of data over a network connection, to signal a semaphore. The timeout ensures that the semaphore will be signalled within a reasonable period of time even if the event fails to occur. Typically, the waiting process cancels the timeout request when awoken, then determines if the awaited event has actually occurred." + anInteger < 0 ifTrue: [self error: 'delay times cannot be negative']. + ^ (self new setDelay: anInteger forSemaphore: aSemaphore) schedule - ^ (self forMilliseconds: anInteger) schedule ! Item was changed: ----- Method: Delay class>>initialize (in category 'class initialization') ----- initialize + "Delay initialize." - "Delay initialize" self startTimerEventLoop.! Item was changed: ----- Method: Delay class>>shutDown (in category 'snapshotting') ----- shutDown "Suspend the active delay, if any, before snapshotting. It will be reactived when the snapshot is resumed." "Details: This prevents a timer interrupt from waking up the active delay in the midst snapshoting, since the active delay will be restarted when resuming the snapshot and we don't want to process the delay twice." AccessProtect wait. self primSignal: nil atMilliseconds: 0. self saveResumptionTimes. + DelaySuspended := true.! - ! Item was added: + ----- Method: Delay>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + aStream nextPutAll: '('; print: delayDuration; nextPutAll: ' msecs'. + beingWaitedOn ifTrue:[ + aStream nextPutAll: '; '; print: resumptionTime - Time millisecondClockValue; nextPutAll: ' msecs remaining'. + ]. + aStream nextPutAll: ')'.! Item was changed: ----- Method: Delay>>unschedule (in category 'private') ----- unschedule + AccessProtect critical:[ + FinishedDelay := self. + TimingSemaphore signal. + ].! - "Unschedule this Delay. Do nothing if it wasn't scheduled." - - | done | - TimerEventLoop ifNotNil:[^self unscheduleEvent]. - AccessProtect critical: [ - done := false. - [done] whileFalse: - [SuspendedDelays remove: self ifAbsent: [done := true]]. - ActiveDelay == self ifTrue: [ - SuspendedDelays isEmpty - ifTrue: [ - ActiveDelay := nil. - ActiveDelayStartTime := nil] - ifFalse: [ - SuspendedDelays removeFirst activate]]]. - ! Item was changed: ----- Method: Delay>>setDelay:forSemaphore: (in category 'private') ----- + setDelay: millisecondCount forSemaphore: aSemaphore - setDelay: milliseconds forSemaphore: aSemaphore "Private!! Initialize this delay to signal the given semaphore after the given number of milliseconds." + delayDuration := millisecondCount. - delayDuration := milliseconds asInteger. - delayDuration < 0 ifTrue: [self error: 'delay times cannot be negative']. - delayDuration > (SmallInteger maxVal // 2) - ifTrue: [self error: 'delay times can''t be longer than about six days (', (SmallInteger maxVal // 2) printString , 'ms)']. delaySemaphore := aSemaphore. + beingWaitedOn := false. + ! - beingWaitedOn := false.! Item was changed: ----- Method: Delay class>>forSeconds: (in category 'instance creation') ----- forSeconds: aNumber + "Return a new Delay for the given number of seconds. Sending 'wait' to this Delay will cause the sender's process to be suspended for approximately that length of time." + + aNumber < 0 ifTrue: [self error: 'delay times cannot be negative']. + ^ self new + setDelay: (aNumber * 1000) asInteger + forSemaphore: Semaphore new - ^ self forMilliseconds: aNumber * 1000 ! Item was changed: Object subclass: #Delay instanceVariableNames: 'delayDuration resumptionTime delaySemaphore beingWaitedOn' + classVariableNames: 'AccessProtect ActiveDelay ActiveDelayStartTime DelaySuspended FinishedDelay RunTimerEventLoop ScheduledDelay SuspendedDelays TimerEventLoop TimingSemaphore' - classVariableNames: 'AccessProtect ActiveDelay ActiveDelayStartTime FinishedDelay RunTimerEventLoop ScheduledDelay SuspendedDelays TimerEventLoop TimingSemaphore' poolDictionaries: '' category: 'Kernel-Processes'! !Delay commentStamp: 'stephaneducasse 10/1/2005 21:07' prior: 0! I am the main way that a process may pause for some amount of time. The simplest usage is like this: (Delay forSeconds: 5) wait. An instance of Delay responds to the message 'wait' by suspending the caller's process for a certain amount of time. The duration of the pause is specified when the Delay is created with the message forMilliseconds: or forSeconds:. A Delay can be used again when the current wait has finished. For example, a clock process might repeatedly wait on a one-second Delay. The maximum delay is (SmallInteger maxVal // 2) milliseconds, or about six days. A delay in progress when an image snapshot is saved is resumed when the snapshot is re-started. Delays work across millisecond clock roll-overs. For a more complex example, see #testDelayOf:for:rect: . A word of advice: This is THE highest priority code which is run in Squeak, in other words it is time-critical. The speed of this code is critical for accurate responses, it is critical for network services, it affects every last part of the system. In short: Don't fix it if it ain't broken!! This code isn't supposed to be beautiful, it's supposed to be fast!! The reason for duplicating code is to make it fast. The reason for not using ifNil:[]ifNotNil:[] is that the compiler may not inline those. Since the effect of changes are VERY hard to predict it is best to leave things as they are for now unless there is an actual need to change anything! Item was changed: ----- Method: Delay>>schedule (in category 'private') ----- schedule + "Schedule this delay" + resumptionTime := Time millisecondClockValue + delayDuration. + AccessProtect critical:[ + ScheduledDelay := self. + TimingSemaphore signal. + ].! - "Private!! Schedule this Delay, but return immediately rather than waiting. The receiver's semaphore will be signalled when its delay duration has elapsed." - - beingWaitedOn ifTrue: [self error: 'This Delay has already been scheduled.']. - - TimerEventLoop ifNotNil:[^self scheduleEvent]. - AccessProtect critical: [ - beingWaitedOn := true. - resumptionTime := Time millisecondClockValue + delayDuration. - ActiveDelay == nil - ifTrue: [self activate] - ifFalse: [ - resumptionTime < ActiveDelay resumptionTime - ifTrue: [ - SuspendedDelays add: ActiveDelay. - self activate] - ifFalse: [SuspendedDelays add: self]]]. - ! Item was removed: - ----- Method: Delay>>scheduleEvent (in category 'private') ----- - scheduleEvent - "Schedule this delay" - resumptionTime := Time millisecondClockValue + delayDuration. - AccessProtect critical:[ - ScheduledDelay := self. - TimingSemaphore signal. - ].! Item was removed: - ----- Method: Delay>>activate (in category 'private') ----- - activate - "Private!! Make the receiver the Delay to be awoken when the next timer interrupt occurs. This method should only be called from a block protected by the AccessProtect semaphore." - TimerEventLoop ifNotNil:[^nil]. - ActiveDelay := self. - ActiveDelayStartTime := Time millisecondClockValue. - ActiveDelayStartTime > resumptionTime ifTrue:[ - ActiveDelay signalWaitingProcess. - SuspendedDelays isEmpty ifTrue:[ - ActiveDelay := nil. - ActiveDelayStartTime := nil. - ] ifFalse:[SuspendedDelays removeFirst activate]. - ] ifFalse:[ - TimingSemaphore initSignals. - Delay primSignal: TimingSemaphore atMilliseconds: resumptionTime. - ].! Item was removed: - ----- Method: Delay>>unscheduleEvent (in category 'private') ----- - unscheduleEvent - AccessProtect critical:[ - FinishedDelay := self. - TimingSemaphore signal. - ].! Item was removed: - ----- Method: Delay class>>startTimerInterruptWatcher (in category 'timer process') ----- - startTimerInterruptWatcher - "Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten." - "Delay startTimerInterruptWatcher" - | p | - self stopTimerEventLoop. - self stopTimerInterruptWatcher. - TimingSemaphore := Semaphore new. - AccessProtect := Semaphore forMutualExclusion. - SuspendedDelays := - SortedCollection sortBlock: - [:d1 :d2 | d1 resumptionTime <= d2 resumptionTime]. - ActiveDelay := nil. - p := [self timerInterruptWatcher] newProcess. - p priority: Processor timingPriority. - p resume. - ! Item was removed: - ----- Method: Delay class>>guardianDelay (in category 'instance creation') ----- - guardianDelay - "Make a Delay with a resumption time far in the future but still a SmallInteger so that it can be used as a guardian for the active delay queue. No process will be waiting on this and when triggered it will do nothing. What it allows is very long Delays where the resumption time is a large integer; should such a delay get activated it will fail the primitive and we creat one of these guardians to make sure the delay timer keeps going and triggers the resumption time recalculations in save/restoreResumptionTime" - ^self new beGuardianDelay! Item was removed: - ----- Method: Delay class>>stopTimerInterruptWatcher (in category 'timer process') ----- - stopTimerInterruptWatcher - "Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten." - "Delay startTimerInterruptWatcher" - self primSignal: nil atMilliseconds: 0. - TimingSemaphore ifNotNil:[TimingSemaphore terminateProcess].! Item was removed: - ----- Method: Delay class>>timerInterruptWatcher (in category 'timer process') ----- - timerInterruptWatcher - "This loop runs in its own process. It waits for a timer interrupt and - wakes up the active delay. Note that timer interrupts are only enabled - when there are active delays." - | nowTime | - [true] - whileTrue: [TimingSemaphore wait. - AccessProtect - critical: [ActiveDelay == nil - ifFalse: [ActiveDelay signalWaitingProcess. - (nowTime := Time millisecondClockValue) < ActiveDelayStartTime - ifTrue: ["clock wrapped so adjust the resumption - times of all the suspended delays. No - point adjusting the active delay since - we've just triggered it" - SuspendedDelays - do: [:d | d adjustResumptionTimeOldBase: ActiveDelayStartTime newBase: nowTime]]]. - SuspendedDelays isEmpty - ifTrue: [ActiveDelay := nil. - ActiveDelayStartTime := nil] - ifFalse: [SuspendedDelays removeFirst activate]]]! Item was removed: - ----- Method: Delay>>beGuardianDelay (in category 'private') ----- - beGuardianDelay - "see comment for class method guardianDelay" - beingWaitedOn := false. - resumptionTime := SmallInteger maxVal. - delaySemaphore := Semaphore new!

1 0

The Trunk: Collections-ar.125.mcz
by commits＠source.squeak.org 04 Sep '09

04 Sep '09

Andreas Raab uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ar.125.mcz ==================== Summary ==================== Name: Collections-ar.125 Author: ar Time: 3 September 2009, 9:40:06 am UUID: 65d7a3ef-c4cd-d847-a137-8ebe7bcae3be Ancestors: Collections-jcg.124 http://bugs.squeak.org/view.php?id=7314 Summary 0007314: UTF8 conversion speedup Description The conversions between Squeak and UTF8 can be fairly slow. The attached changes speed up the typical conversions dramatically. =============== Diff against Collections-jcg.124 =============== Item was added: + ----- Method: ByteString>>squeakToUtf8 (in category 'converting') ----- + squeakToUtf8 + "Convert the given string from UTF-8 using the fast path if converting to Latin-1" + | outStream lastIndex nextIndex | + Latin1ToUtf8Map ifNil:[^super squeakToUtf8]. "installation guard" + lastIndex := 1. + nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex. + nextIndex = 0 ifTrue:[^self]. + outStream := (String new: self size * 2) writeStream. + [outStream next: nextIndex-lastIndex putAll: self startingAt: lastIndex. + outStream nextPutAll: (Latin1ToUtf8Encodings at: (self byteAt: nextIndex)+1). + lastIndex := nextIndex + 1. + nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex. + nextIndex = 0] whileFalse. + outStream next: self size-lastIndex+1 putAll: self startingAt: lastIndex. + ^outStream contents + ! Item was added: + ----- Method: ByteString>>utf8ToSqueak (in category 'converting') ----- + utf8ToSqueak + "Convert the given string from UTF-8 using the fast path if converting to Latin-1" + | outStream lastIndex nextIndex byte1 byte2 byte3 byte4 unicode | + Latin1ToUtf8Map ifNil:[^super utf8ToSqueak]. "installation guard" + lastIndex := 1. + nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex. + nextIndex = 0 ifTrue:[^self]. + outStream := (String new: self size) writeStream. + [outStream next: nextIndex-lastIndex putAll: self startingAt: lastIndex. + byte1 := self byteAt: nextIndex. + (byte1 bitAnd: 16rE0) = 192 ifTrue: [ "two bytes" + byte2 := self byteAt: (nextIndex := nextIndex+1). + (byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + unicode := ((byte1 bitAnd: 31) bitShift: 6) + (byte2 bitAnd: 63)]. + (byte1 bitAnd: 16rF0) = 224 ifTrue: [ "three bytes" + byte2 := self byteAt: (nextIndex := nextIndex+1). + (byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + byte3 := self byteAt: (nextIndex := nextIndex+1). + (byte3 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + unicode := ((byte1 bitAnd: 15) bitShift: 12) + ((byte2 bitAnd: 63) bitShift: 6) + + (byte3 bitAnd: 63)]. + (byte1 bitAnd: 16rF8) = 240 ifTrue: [ "four bytes" + byte2 := self byteAt: (nextIndex := nextIndex+1). + (byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + byte3 := self byteAt: (nextIndex := nextIndex+1). + (byte3 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + byte4 := self byteAt: (nextIndex := nextIndex+1). + (byte4 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1" + unicode := ((byte1 bitAnd: 16r7) bitShift: 18) + + ((byte2 bitAnd: 63) bitShift: 12) + + ((byte3 bitAnd: 63) bitShift: 6) + + (byte4 bitAnd: 63)]. + unicode ifNil:[^self]. "invalid UTF-8; presume Latin-1" + outStream nextPut: (Character value: unicode). + lastIndex := nextIndex + 1. + nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex. + nextIndex = 0] whileFalse. + outStream next: self size-lastIndex+1 putAll: self startingAt: lastIndex. + ^outStream contents + ! Item was changed: String variableByteSubclass: #ByteString instanceVariableNames: '' + classVariableNames: 'Latin1ToUtf8Encodings Latin1ToUtf8Map' - classVariableNames: '' poolDictionaries: '' category: 'Collections-Strings'! !ByteString commentStamp: '<historical>' prior: 0! This class represents the array of 8 bit wide characters. ! Item was added: + ----- Method: ByteString class>>initialize (in category 'initialization') ----- + initialize + "ByteString initialize" + | latin1 utf8 | + Latin1ToUtf8Map := ByteArray new: 256. + Latin1ToUtf8Encodings := Array new: 256. + 0 to: 255 do:[:i| + latin1 := String with: (Character value: i). + utf8 := latin1 convertToWithConverter: UTF8TextConverter new. + latin1 = utf8 ifTrue:[ + Latin1ToUtf8Map at: i+1 put: 0. "no translation needed" + ] ifFalse:[ + Latin1ToUtf8Map at: i+1 put: 1. "no translation needed" + Latin1ToUtf8Encodings at: i+1 put: utf8. + ]. + ].!

1 0

Metacello
by Bert Freudenberg 04 Sep '09

04 Sep '09

Just found this: http://gemstonesoup.wordpress.com/2009/08/25/metacello-package-management-f… Have not looked deeply yet but sounds rather interesting ... - Bert -

17 36

← Newer
1
...
29
30
31
32
33
34
35
36
37
Older →

Jump to page: