[Pkg] The Trunk: System-nice.243.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Feb 4 19:11:33 UTC 2010


Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.243.mcz

==================== Summary ====================

Name: System-nice.243
Author: nice
Time: 4 February 2010, 8:10:49.069 pm
UUID: fb2af05d-ab4c-44d9-98a9-9593e9d559c2
Ancestors: System-ar.242

1) move some temp assignments outside blocks
2) move some temps declaration inside blocks
3) remove some now useless fixTemps

=============== Diff against System-ar.242 ===============

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 time0 endTime observedProcess sem |
- 	| myDelay startTime time0 endTime observedProcess 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.
  	myDelay := Delay forMilliseconds: millisecs.
  	time0 := Time millisecondClockValue.
  	endTime := time0 + msecDuration.
  	sem := Semaphore new.
  	gcStats := SmalltalkImage current getVMParameters.
  	Timer ifNotNil: [ Timer terminate ].
  	Timer := [
  			[
+ 				| startTime |
  				startTime := Time millisecondClockValue.
  				myDelay wait.
  				self
  					tally: Processor preemptedProcess suspendedContext
  					in: (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.
  	"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)].
  	time := Time millisecondClockValue - time0!

Item was changed:
  ----- Method: MessageTally>>rootPrintOn:total:totalTime:threshold: (in category 'printing') -----
  rootPrintOn: aStream total: total totalTime: totalTime threshold: threshold
  
+ 	| groups sons |
- 	| sons groups p |
  	sons := self sonsOver: threshold.
  	groups := sons groupBy: [ :aTally | aTally process] having: [ :g | true].
  	groups do:[:g|
+ 		| p |
- 		sons := g asSortedCollection.
  		p := g anyOne process.
  		(reportOtherProcesses or: [ p notNil ]) ifTrue: [
  			aStream nextPutAll: '--------------------------------'; cr.
  			aStream nextPutAll: 'Process: ',  (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr.
  			aStream nextPutAll: '--------------------------------'; cr.
+ 			g asSortedCollection do:[:aSon | 
+ 				aSon 
- 			(1 to: sons size) do:[:i | 
- 				(sons at: i) 
  					treePrintOn: aStream
  					tabs: OrderedCollection new
  					thisTab: ''
  					total: total
  					totalTime: totalTime
  					tallyExact: false
  					orThreshold: threshold]].
  	]!

Item was changed:
  ----- 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 time0 |
- 	| myDelay startTime time0 observedProcess |
  	(aBlock isMemberOf: BlockClosure)
  		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 ifNotNil: [ Timer terminate ].
  	Timer := [
  		[true] whileTrue: [
+ 			| observedProcess startTime |
  			startTime := Time millisecondClockValue.
  			myDelay wait.
  			observedProcess := Processor preemptedProcess.
  			self
  				tally: observedProcess suspendedContext
  				in: 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.
  		Timer := nil.
  		time := Time millisecondClockValue - time0]!

Item was changed:
  ----- Method: MessageTally>>printSenderCountsOn: (in category 'printing') -----
  printSenderCountsOn: aStream
+ 	| mergedSenders |
- 	| mergedSenders mergedNode |
  	mergedSenders := IdentityDictionary new.
  	senders do:
  		[:node |
+ 		| mergedNode |
  		mergedNode := mergedSenders at: node method ifAbsent: [nil].
  		mergedNode == nil
  			ifTrue: [mergedSenders at: node method put: node]
  			ifFalse: [mergedNode bump: node tally]].
  	mergedSenders asSortedCollection do:
  		[:node | 
  		10 to: node tally printString size by: -1 do: [:i | aStream space].
  		node printOn: aStream total: tally totalTime: nil tallyExact: true]!

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 time0 observedProcess |
- 	| myDelay startTime time0 observedProcess |
  	(aBlock isMemberOf: BlockClosure)
  		ifFalse: [self error: 'spy needs a block here'].
  	self class: aBlock receiver class method: aBlock method.
  		"set up the probe"
  	observedProcess := Processor activeProcess.
  	myDelay := Delay forMilliseconds: millisecs.
  	time0 := Time millisecondClockValue.
  	gcStats := SmalltalkImage current getVMParameters.
  	Timer ifNotNil: [ Timer terminate ].
+ 	Timer := [ 
- 	Timer := [
  		[true] whileTrue: [
+ 			| startTime |
  			startTime := Time millisecondClockValue.
  			myDelay wait.
  			self
  				tally: Processor preemptedProcess suspendedContext
  				in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil])
  				"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.
  		Timer := nil.
  		time := Time millisecondClockValue - time0]!

Item was changed:
  ----- Method: MessageTally>>treePrintOn:tabs:thisTab:total:totalTime:tallyExact:orThreshold: (in category 'printing') -----
  treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold 
+ 	| sons |
- 	| sons sonTab |
  	tabs do: [:tab | aStream nextPutAll: tab].
  	tabs size > 0 
  		ifTrue: 
  			[self 
  				printOn: aStream
  				total: total
  				totalTime: totalTime
  				tallyExact: isExact].
  	sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold].
  	sons isEmpty 
  		ifFalse: 
  			[tabs addLast: myTab.
  			sons := sons asSortedCollection.
  			(1 to: sons size) do: 
+ 					[:i | | sonTab | 
- 					[:i | 
  					sonTab := i < sons size ifTrue: ['  |'] ifFalse: ['  '].
  					(sons at: i) 
  						treePrintOn: aStream
  						tabs: (tabs size < self maxTabs 
  								ifTrue: [tabs]
  								ifFalse: [(tabs select: [:x | x = '[']) copyWith: '['])
  						thisTab: sonTab
  						total: total
  						totalTime: totalTime
  						tallyExact: isExact
  						orThreshold: threshold].
  			tabs removeLast]!

Item was changed:
  ----- Method: Utilities class>>objectStrmFromUpdates: (in category 'fetching updates') -----
  objectStrmFromUpdates: fileName
  	"Go to the known servers and look for this file in the updates folder.  It is an auxillery file, like .morph or a .gif.  Return a RWBinaryOrTextStream on it.    Meant to be called from during the getting of updates from the server.  That assures that (Utilities serverUrls) returns the right group of servers."
- 
- 	
  	Cursor wait showWhile:
+ 		[ | urls |
+ 		urls := Utilities serverUrls collect: [:url | url, 'updates/', fileName].
- 		[ | urls |urls := Utilities serverUrls collect: [:url | url, 'updates/', fileName].
  		urls do: [:aUrl | | doc |
  			doc := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'.
  			"test here for server being up"
  			doc class == RWBinaryOrTextStream ifTrue: [^ doc reset]]].
  
  	self inform: 'All update servers are unavailable, or bad file name'.
  	^ nil!

Item was changed:
  ----- Method: ImageSegment>>copyFromRoots:sizeHint:areUnique: (in category 'read/write segment') -----
  copyFromRoots: aRootArray sizeHint: segSizeHint areUnique: areUnique
  	"Copy a tree of objects into a WordArray segment.  The copied objects in the segment are not in the normal Squeak space.  
  	[1] For exporting a project.  Objects were enumerated by ReferenceStream and aRootArray has them all.
  	[2] For exporting some classes.  See copyFromRootsForExport:. (Caller must hold Symbols, or they will not get registered in the target system.)
  	[3] For 'local segments'.  outPointers are kept in the image.
  	If this method yields a very small segment, it is because objects just below the roots are pointed at from the outside.  (See findRogueRootsImSeg: for a *destructive* diagnostic of who is pointing in.)"
  	| segmentWordArray outPointerArray segSize rootSet uniqueRoots |
  	aRootArray ifNil: [self errorWrongState].
  	uniqueRoots := areUnique 
  		ifTrue: [aRootArray]
  		ifFalse: [rootSet := IdentitySet new: aRootArray size * 3.
  			uniqueRoots := OrderedCollection new.
  			1 to: aRootArray size do: [:ii |	"Don't include any roots twice"
  				(rootSet includes: (aRootArray at: ii)) 
  					ifFalse: [
  						uniqueRoots addLast: (aRootArray at: ii).
  						rootSet add: (aRootArray at: ii)]
  					ifTrue: [userRootCnt ifNotNil: ["adjust the count"
  								ii <= userRootCnt ifTrue: [userRootCnt := userRootCnt - 1]]]].
  			uniqueRoots].
  	arrayOfRoots := uniqueRoots asArray.
  	rootSet := uniqueRoots := nil.	"be clean"
  	userRootCnt ifNil: [userRootCnt := arrayOfRoots size].
  	arrayOfRoots do: [:aRoot | 
  		aRoot indexIfCompact > 0 ifTrue: [
  			self error: 'Compact class ', aRoot name, ' cannot be a root']].
  	outPointers := nil.	"may have used this instance before"
  	segSize := segSizeHint > 0 ifTrue: [segSizeHint *3 //2] ifFalse: [50000].
  
  	["Guess a reasonable segment size"
  	segmentWordArray := WordArrayForSegment new: segSize.
+ 	outPointerArray := [Array new: segSize // 20] ifError: [
- 	[outPointerArray := Array new: segSize // 20] ifError: [
  		state := #tooBig.  ^ self].
  	"Smalltalk garbageCollect."
  	(self storeSegmentFor: arrayOfRoots
  					into: segmentWordArray
  					outPointers: outPointerArray) == nil]
  		whileTrue:
  			["Double the segment size and try again"
  			segmentWordArray := outPointerArray := nil.
  			segSize := segSize * 2].
  	segment := segmentWordArray.
  	outPointers := outPointerArray.
  	state := #activeCopy.
  	endMarker := segment nextObject. 	"for enumeration of objects"
  	endMarker == 0 ifTrue: [endMarker := 'End' clone].
  !

Item was changed:
  ----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
  storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
  
  	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
  
  	world setProperty: #optimumExtentFromAuthor toValue: world extent.
  	self validateProjectNameIfOK: [
  		self isCurrentProject ifTrue: ["exit, then do the command"
  			forget
  				ifTrue: [self forgetExistingURL]
  				ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
  			^self
  				armsLengthCommand: #storeOnServerAssumingNameValid
  				withDescription: 'Publishing' translated
  		].
  		self storeOnServerWithProgressInfoOn: aMorphOrNil.
+ 	].
- 	] fixTemps.
  !

Item was changed:
  ----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
  validateProjectNameIfOK: aBlock
  
  	| details |
  
  	details := world valueOfProperty: #ProjectDetails.
  	details ifNotNil: ["ensure project info matches real project name"
  		details at: 'projectname' put: self name.
  	].
  	self doWeWantToRename ifFalse: [^aBlock value].
  	(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
  		etpdm
  			getFullInfoFor: self 
  			ifValid: [
  				World displayWorldSafely.
  				aBlock value.
+ 			]
- 			] fixTemps
  			expandedFormat: false]
  !

Item was changed:
  ----- Method: ChangeSet>>mailOut (in category 'fileIn/Out') -----
  mailOut
  	"Email a compressed version of this changeset to the squeak-dev list, so that it can be shared with everyone.  (You will be able to edit the email before it is sent.)"
  
  	| userName message slips |
  
  	userName := MailSender userName.
  
  	self checkForConversionMethods.
+ 	message := Cursor write showWhile: [self buildMessageForMailOutWithUser: userName].
- 	Cursor write showWhile: [message := self buildMessageForMailOutWithUser: userName].
  
  	MailSender sendMessage: message.
  
  	Preferences suppressCheckForSlips ifTrue: [^ self].
  	slips := self checkForSlips.
  	(slips size > 0 and: [self confirm: 'Methods in this fileOut have halts
  or references to the Transcript
  or other ''slips'' in them.
  Would you like to browse them?'])
  		ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name]
  !



More information about the Packages mailing list