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! |
Free forum by Nabble | Edit this page |