[squeak-dev] The Inbox: System-fbs.517.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 4 22:45:12 UTC 2013


Frank Shearar uploaded a new version of System to project The Inbox:
http://source.squeak.org/inbox/System-fbs.517.mcz

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

Name: System-fbs.517
Author: fbs
Time: 4 March 2013, 10:44:38.221 pm
UUID: 33c1ed01-a761-41ed-8dd8-f4abf26395b3
Ancestors: System-fbs.516

Transform callers of Utilities class >> #timeStampForMethod: to callers of CompiledMethod >> #timeStamp.

=============== Diff against System-fbs.516 ===============

Item was changed:
  ----- Method: ChangeSet>>methodsWithInitialsOtherThan: (in category 'moving changes') -----
  methodsWithInitialsOtherThan: myInits
  	"Return a collection of method refs whose author appears to be different from the given one"
  	| slips |
  	slips := OrderedCollection new.
  	self changedClasses do:
  		[:aClass |
  		(self methodChangesAtClass: aClass name) associationsDo: 
  				[:mAssoc | | aTimeStamp method | (#(remove addedThenRemoved) includes: mAssoc value) ifFalse:
  					[method := aClass compiledMethodAt: mAssoc key ifAbsent: [nil].
  					method ifNotNil:
+ 						[((aTimeStamp := method timeStamp) notNil and:
- 						[((aTimeStamp := Utilities timeStampForMethod: method) notNil and:
  							[(aTimeStamp beginsWith: myInits) not])
  								ifTrue: [slips add: aClass name , ' ' , mAssoc key]]]]].
  	^ slips
  
  	"Smalltalk browseMessageList: (ChangeSet current methodsWithInitialsOtherThan: 'sw') name: 'authoring problems'"!

Item was changed:
  ----- Method: ImageSegment>>writeForExportWithSources:inDirectory: (in category 'read/write segment') -----
  writeForExportWithSources: fName inDirectory: aDirectory
  	"Write the segment on the disk with all info needed to reconstruct it in a new image.  For export.  Out pointers are encoded as normal objects on the disk.  Append the source code of any classes in roots.  Target system will quickly transfer the sources to its changes file."
  
  	"this is the old version which I restored until I solve the gzip problem"
  
  	| fileStream temp tempFileName zipper allClassesInRoots classesToWriteEntirely methodsWithSource |
  	state = #activeCopy ifFalse: [self error: 'wrong state'].
  	(fName includes: $.) ifFalse: [
  		^ self inform: 'Please use ''.pr'' or ''.extSeg'' at the end of the file name'.].
  	temp := endMarker.
  	endMarker := nil.
  	tempFileName := aDirectory nextNameFor: 'SqProject' extension: 'temp'.
  	zipper := [
  		ProgressNotification signal: '3:uncompressedSaveComplete'.
  		(aDirectory oldFileNamed: tempFileName) compressFile.	"makes xxx.gz"
  		aDirectory 
  			rename: (tempFileName, FileDirectory dot, 'gz')
  			toBe: fName.
  		aDirectory
  			deleteFileNamed: tempFileName
  			ifAbsent: []
  	].
  	fileStream := aDirectory newFileNamed: tempFileName.
  	fileStream fileOutClass: nil andObject: self.
  		"remember extra structures.  Note class names."
  	endMarker := temp.
  
  	"append sources"
  	allClassesInRoots := arrayOfRoots select: [:cls | cls isKindOf: Behavior].
  	classesToWriteEntirely := allClassesInRoots select: [ :cls | cls theNonMetaClass isSystemDefined].
  	methodsWithSource := OrderedCollection new.
  	allClassesInRoots do: [ :cls |
  		(classesToWriteEntirely includes: cls) ifFalse: [
  			cls selectorsAndMethodsDo: [ :sel :meth |
  				meth sourcePointer = 0 ifFalse: [methodsWithSource add: {cls. sel. meth}].
  			].
  		].
  	].
  	(classesToWriteEntirely isEmpty and: [methodsWithSource isEmpty]) ifTrue: [zipper value. ^ self].
  
  	fileStream reopen; setToEnd.
  	fileStream nextPutAll: '\\!!ImageSegment new!!\\' withCRs.
  	methodsWithSource do: [ :each |
  		fileStream nextPut: $!!.	"try to pacify ImageSegment>>scanFrom:"
  		fileStream nextChunkPut: 'RenamedClassSourceReader formerClassName: ',
  				each first name printString,' methodsFor: ',
  				(each first organization categoryOfElement: each second) asString printString,
+ 				' stamp: ',(each third timeStamp) printString; cr.
- 				' stamp: ',(Utilities timeStampForMethod: each third) printString; cr.
  		fileStream nextChunkPut: (each third getSourceFor: each second in: each first) asString.
  		fileStream nextChunkPut: ' '; cr.
  	].
  	classesToWriteEntirely do: [:cls | 
  		cls isMeta ifFalse: [fileStream nextPutAll: 
  						(cls name, ' category: ''', cls category, '''.!!'); cr; cr].
  		cls organization
  			putCommentOnFile: fileStream
  			numbered: 0
  			moveSource: false
  			forClass: cls.	"does nothing if metaclass"
  		cls organization categories do: 
  			[:heading |
  			cls fileOutCategory: heading
  				on: fileStream
  				moveSource: false
  				toFile: 0]].
  	"no class initialization -- it came in as a real object"
  	fileStream close.
  	zipper value.!

Item was changed:
  ----- Method: ImageSegment>>writeForExportWithSources:inDirectory:changeSet: (in category 'read/write segment') -----
  writeForExportWithSources: fName inDirectory: aDirectory changeSet:
  aChangeSetOrNil
  	"Write the segment on the disk with all info needed to
  reconstruct it in a new image.  For export.  Out pointers are encoded
  as normal objects on the disk.  Append the source code of any classes
  in roots.  Target system will quickly transfer the sources to its
  changes file."
  	"Files out a changeSet first, so that a project can contain
  classes that are unique to the project."
  
  	| fileStream temp tempFileName zipper allClassesInRoots
  classesToWriteEntirely methodsWithSource |
  	state = #activeCopy ifFalse: [self error: 'wrong state'].
  	(fName includes: $.) ifFalse: [
  		^ self inform: 'Please use ''.pr'' or ''.extSeg'' at
  the end of the file name'.].
  	temp := endMarker.
  	endMarker := nil.
  	tempFileName := aDirectory nextNameFor: 'SqProject' extension: 'temp'.
  	zipper := [
  		Preferences debugPrintSpaceLog ifTrue:[
  			fileStream := aDirectory newFileNamed:
  				(fName copyFrom: 1 to: (fName
  lastIndexOf: $.)), 'space'.
  			self printSpaceAnalysisOn: fileStream.
  			fileStream close].
  		ProgressNotification signal: '3:uncompressedSaveComplete'.
  		(aDirectory oldFileNamed: tempFileName) compressFile.
  	"makes xxx.gz"
  		aDirectory
  			rename: (tempFileName, FileDirectory dot, 'gz')
  			toBe: fName.
  		aDirectory
  			deleteFileNamed: tempFileName
  			ifAbsent: []
  	].
  	fileStream := aDirectory newFileNamed: tempFileName.
  	fileStream fileOutChangeSet: aChangeSetOrNil andObject: self.
  		"remember extra structures.  Note class names."
  	endMarker := temp.
  
  	"append sources"
  	allClassesInRoots := arrayOfRoots select: [:cls | cls
  isKindOf: Behavior].
  	classesToWriteEntirely := allClassesInRoots select: [ :cls |
  cls theNonMetaClass isSystemDefined].
  	methodsWithSource := OrderedCollection new.
  	allClassesInRoots do: [ :cls |
  		(classesToWriteEntirely includes: cls) ifFalse: [
  			cls selectorsAndMethodsDo: [ :sel :meth |
  				meth sourcePointer = 0 ifFalse:
  [methodsWithSource add: {cls. sel. meth}].
  			].
  		].
  	].
  	(classesToWriteEntirely isEmpty and: [methodsWithSource
  isEmpty]) ifTrue: [zipper value. ^ self].
  
  	fileStream reopen; setToEnd.
  	fileStream nextPutAll: '\\!!ImageSegment new!!\\' withCRs.
  	methodsWithSource do: [ :each |
  		fileStream nextPut: $!!.	"try to pacify
  ImageSegment>>scanFrom:"
  		fileStream nextChunkPut: 'RenamedClassSourceReader
  formerClassName: ',
  				each first name printString,' methodsFor: ',
  				(each first organization
  categoryOfElement: each second) asString printString,
+ 				' stamp: ',(each third timeStamp) printString; cr.
- 				' stamp: ',(Utilities
- timeStampForMethod: each third) printString; cr.
  		fileStream nextChunkPut: (each third getSourceFor:
  each second in: each first) asString.
  		fileStream nextChunkPut: ' '; cr.
  	].
  	classesToWriteEntirely do: [:cls |
  		cls isMeta ifFalse: [fileStream nextPutAll:
  						(cls name, '
  category: ''', cls category, '''.!!'); cr; cr].
  		cls organization
  			putCommentOnFile: fileStream
  			numbered: 0
  			moveSource: false
  			forClass: cls.	"does nothing if metaclass"
  		cls organization categories do:
  			[:heading |
  			cls fileOutCategory: heading
  				on: fileStream
  				moveSource: false
  				toFile: 0]].
  	"no class initialization -- it came in as a real object"
  	fileStream close.
  	zipper value.
  !

Item was changed:
  ----- Method: ImageSegment>>writeForExportWithSourcesGZ:inDirectory: (in category 'read/write segment') -----
  writeForExportWithSourcesGZ: fName inDirectory: aDirectory
  	"Write the segment on the disk with all info needed to reconstruct it in a new image.  For export.  Out pointers are encoded as normal objects on the disk.  Append the source code of any classes in roots.  Target system will quickly transfer the sources to its changes file."
  
  	"this is the gzipped version which I have temporarily suspended until I can get resolve the problem with forward references tring to reposition the stream - RAA 11 june 2000"
  
  
  
  
  	| fileStream temp allClassesInRoots classesToWriteEntirely methodsWithSource |
  	state = #activeCopy ifFalse: [self error: 'wrong state'].
  	(fName includes: $.) ifFalse: [
  		^ self inform: 'Please use ''.pr'' or ''.extSeg'' at the end of the file name'.].
  	temp := endMarker.
  	endMarker := nil.
  	fileStream := GZipSurrogateStream newFileNamed: fName inDirectory: aDirectory.
  	fileStream fileOutClass: nil andObject: self.
  		"remember extra structures.  Note class names."
  	endMarker := temp.
  
  	"append sources"
  	allClassesInRoots := arrayOfRoots select: [:cls | cls isKindOf: Behavior].
  	classesToWriteEntirely := allClassesInRoots select: [ :cls | cls theNonMetaClass isSystemDefined].
  	methodsWithSource := OrderedCollection new.
  	allClassesInRoots do: [ :cls |
  		(classesToWriteEntirely includes: cls) ifFalse: [
  			cls selectorsAndMethodsDo: [ :sel :meth |
  				meth sourcePointer = 0 ifFalse: [methodsWithSource add: {cls. sel. meth}].
  			].
  		].
  	].
  	(classesToWriteEntirely isEmpty and: [methodsWithSource isEmpty]) ifTrue: [
  		fileStream reallyClose.	"since #close is ignored"
  		^ self
  	].
  	"fileStream reopen; setToEnd."	"<--not required with gzipped surrogate stream"
  	fileStream nextPutAll: '\\!!ImageSegment new!!\\' withCRs.
  	methodsWithSource do: [ :each |
  		fileStream nextPut: $!!.	"try to pacify ImageSegment>>scanFrom:"
  		fileStream nextChunkPut: 'RenamedClassSourceReader formerClassName: ',
  				each first name printString,' methodsFor: ',
  				(each first organization categoryOfElement: each second) asString printString,
+ 				' stamp: ',(each third timeStamp) printString; cr.
- 				' stamp: ',(Utilities timeStampForMethod: each third) printString; cr.
  		fileStream nextChunkPut: (each third getSourceFor: each second in: each first) asString.
  		fileStream nextChunkPut: ' '; cr.
  	].
  	classesToWriteEntirely do: [:cls | 
  		cls isMeta ifFalse: [fileStream nextPutAll: 
  						(cls name, ' category: ''', cls category, '''.!!'); cr; cr].
  		cls organization
  			putCommentOnFile: fileStream
  			numbered: 0
  			moveSource: false
  			forClass: cls.	"does nothing if metaclass"
  		cls organization categories do: 
  			[:heading |
  			cls fileOutCategory: heading
  				on: fileStream
  				moveSource: false
  				toFile: 0]].
  	"no class initialization -- it came in as a real object"
  	fileStream reallyClose.	"since #close is ignored"
  !

Item was changed:
  ----- Method: Utilities class>>doesMethod:forClass:bearInitials: (in category 'miscellaneous') -----
  doesMethod: aSelector forClass: aClass bearInitials: initials
  	"Answer whether a method bears the given initials at the head of its time stamp"
  
  	| aTimeStamp implementingClass aMethod |
  	implementingClass := aClass whichClassIncludesSelector: aSelector.
  	implementingClass ifNil: [^ false].
  	(aMethod := implementingClass compiledMethodAt: aSelector)
  		ifNil: [^ false].
+ 	^ (aTimeStamp := aMethod timeStamp) notNil and:
- 	^ (aTimeStamp := self timeStampForMethod: aMethod) notNil and:
  		[aTimeStamp beginsWith: initials]!

Item was changed:
  ----- Method: Utilities class>>methodsWithInitials: (in category 'identification') -----
  methodsWithInitials: targetInitials
  	"Based on a do-it contributed to the Squeak mailing list by Göran Hultgen:
   Browse methods whose initials (in the time-stamp, as logged to disk) match the given initials.
   Print out the complete time-stamp table to the Transcript.
   Answer a list of (initials -> count) associations.
  
  CAUTION: It may take several minutes for this to complete."
  
  	"Time millisecondsToRun: [Utilities methodsWithInitials: 'bf']"
  
  	| initials timeStamp  allSubmitters |
  	initials := ''.
  	timeStamp := ''.
  	allSubmitters := Bag new.
  	self systemNavigation
  		browseAllSelect:
  			[:cm |
+ 				timeStamp := cm timeStamp.
- 				timeStamp := Utilities timeStampForMethod: cm.
  				initials := timeStamp isEmpty
  					ifTrue:
  						['']
  					ifFalse:
  						[timeStamp substrings first].
  				initials := initials isEmpty
  					ifTrue:
  						['<no time stamp>']
  					ifFalse:
  						[initials first isDigit
  							ifTrue:
  								['<date>']
  							ifFalse:
  								[initials]].
  				allSubmitters add: initials.
  				(initials = targetInitials)]
  		name: ('Methods with initials ', targetInitials)
  		autoSelect: nil.
  
  	allSubmitters sortedCounts do: [:elem | Transcript cr; show: elem asString].
  	^ allSubmitters
  !

Item was removed:
- ----- Method: Utilities class>>timeStampForMethod: (in category 'miscellaneous') -----
- timeStampForMethod: method
- 	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."
- 	"Utilities timeStampForMethod: (Utilities class compiledMethodAt: #timeStampForMethod:)"
- 
- 	^ method timeStamp!



More information about the Squeak-dev mailing list