The Trunk: System-ar.307.mcz

Andreas Raab uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ar.307.mcz

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

Name: System-ar.307
Author: ar
Time: 31 March 2010, 11:17:35.995 pm
UUID: d272ac32-bc34-f24f-86e0-11acd6af0ba2
Ancestors: System-ul.306

Adds a new condensing method.

        Smalltalk appendChangesTo: 'myfile.sources'

will copy the original sources file and append a condensed version of the changes. These later versions are linked to the earlier ones so that the 'versions' of some method show its ancestry in the sources file.  This gives us the ability to preserve the 'shipped' ancestry of methods while avoiding all the intermediate versions during development.

Also bullet-proofs ChangeSet>>scanVersionsOf: in the case of broken preambles.


=============== Diff against System-ul.306 ===============

Item was added:
+ ----- Method: SmalltalkImage>>appendChangesTo: (in category 'housekeeping') -----
+ appendChangesTo: sourcesName
+
+ "Condense changes to the end of the given sources file.
+ If the file is the same as Smalltalk sourcesName, then just append
+ the changes. If the file is different, then copy the sources file and
+ append the changes afterwards."
+
+ "Smalltalk appendChangesTo: 'test123.sources'"
+
+ "To verify correctness of the operation run the following code:
+ [ | sourceMap |
+ sourceMap := Dictionary new.
+
+ (CompiledMethod allInstances select:[:cm| cm isInstalled]) do:[:cm|
+ sourceMap at: cm methodReference put:
+ (cm getSourceFor: cm selector in: cm methodClass)].
+ Smalltalk allClassesAndTraitsDo:[:aClass|
+ sourceMap at: aClass put: aClass comment].
+
+ Smalltalk appendChangesTo: 'verify.sources'.
+
+ (CompiledMethod allInstances select:[:cm| cm isInstalled]) do:[:cm|
+ self assert: (sourceMap at: cm methodReference) =
+ (cm getSourceFor: cm selector in: cm methodClass)].
+ Smalltalk allClassesAndTraitsDo:[:aClass|
+ self assert: (sourceMap at: aClass) = aClass comment].
+ ]"
+
+ | fullName sourcesFile |
+ fullName := FileDirectory default fullNameFor: sourcesName.
+ (fullName endsWith: '.sources') ifFalse:[self error: 'New name must end with .sources'].
+ fullName = Smalltalk sourcesName ifFalse:[
+ "Copy sources file; change file name accordingly"
+ FileStream forceNewFileNamed: fullName do:[:newFile| | bufSize |
+ bufSize := 16r10000.
+ sourcesFile := (SourceFiles at: 1) readOnlyCopy.
+ sourcesFile position: 0.
+ 'Copying sources...' displayProgressAt: Sensor cursorPoint
+ from: 0 to: sourcesFile size during:[:bar|
+ [sourcesFile atEnd] whileFalse:[
+ bar value: sourcesFile position.
+ newFile nextPutAll: (sourcesFile next: bufSize)]].
+ newFile position = sourcesFile size ifFalse:[self error: 'File copy failed'].
+ ].
+ self setMacFileInfoOn: fullName.
+ "Change to the new sources file and reopen"
+ self closeSourceFiles.
+ SourceFileVersionString := (FileDirectory localNameFor: fullName)
+ allButLast: '.sources' size.
+ self openSourceFiles.
+ ].
+
+ "We've copied the old to the new sources file; reopen the sources file read/write"
+ sourcesFile := SourceFiles at: 1.
+ sourcesFile close; open: sourcesFile fullName forWrite: true. "should be openReadWrite"
+ sourcesFile timeStamp. "remember when we did this"
+
+ "Copy method sources from changes to sources"
+ CompiledMethod allInstances do:[:method|
+ (method isInstalled and:[method fileIndex = 2]) ifTrue:[
+ | class selector category preamble changeList index chgRec string source |
+ class := method methodClass.
+ selector := method selector.
+ source := class sourceCodeAt: selector.
+ category := class organization categoryOfElement: selector.
+ preamble := class name, ' methodsFor: ', category asString printString,
+ ' stamp: ', method timeStamp printString.
+
+ "Find the last version in the sources file; link up the prior: version"
+ changeList := ChangeSet scanVersionsOf: method
+ class: class meta: class isMeta category: category  selector: selector.
+ index := changeList findLast:[:any| any fileIndex = 1].
+ index > 0 ifTrue:[
+ chgRec := changeList at: index.
+ preamble := preamble, ' prior: ', (SourceFiles
+ sourcePointerFromFileIndex: chgRec fileIndex
+ andPosition: chgRec position) printString].
+
+ "append to sources file"
+ sourcesFile setToEnd; cr; nextPut: $!!; nextChunkPut: preamble; cr.
+ string := RemoteString newString: source onFileNumber: 1 toFile: sourcesFile.
+ sourcesFile nextChunkPut: ' '.
+ method setSourcePosition: string position inFile: 1
+ ].
+ ] displayingProgress: 'Moving changes...'.
+
+ "Copy class comments from changes to sources"
+ self  allClassesAndTraitsDo: [:classOrTrait |
+ classOrTrait moveClassCommentTo: sourcesFile fileIndex: 1.
+ ].
+
+ "We've moved everything; reopen the source files"
+ self closeSourceFiles; openSourceFiles.
+
+ "Finally, run condenseChanges -- they *should* be empty
+ but it's better to be safe than sorry"
+ self condenseChanges.
+ !

Item was changed:
  ----- Method: ChangeSet class>>scanVersionsOf:class:meta:category:selector: (in category 'scanning') -----
  scanVersionsOf: method class: class meta: meta category: cat selector: selector
  | position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp changeList file |
  changeList := OrderedCollection new.
  position := method filePosition.
  sourceFilesCopy := SourceFiles collect:[:x | x ifNotNil:[x readOnlyCopy]].
  method fileIndex == 0 ifTrue: [^ nil].
  file := sourceFilesCopy at: method fileIndex.
  [position notNil & file notNil] whileTrue:[
  preamble := method getPreambleFrom: file at: (0 max: position - 3).
  "Preamble is likely a linked method preamble, if we're in
  a changes file (not the sources file).  Try to parse it
  for prior source position and file index"
  prevPos := nil.
  stamp := ''.
  (preamble findString: 'methodsFor:' startingAt: 1) > 0
+ ifTrue: [tokens := [Scanner new scanTokens: preamble] on: Error do:[#()]]
- ifTrue: [tokens := Scanner new scanTokens: preamble]
  ifFalse: [tokens := Array new  "ie cant be back ref"].
  ((tokens size between: 7 and: 8)
  and: [(tokens at: tokens size-5) = #methodsFor:]) ifTrue:[
  (tokens at: tokens size-3) = #stamp: ifTrue:[
  "New format gives change stamp and unified prior pointer"
  stamp := tokens at: tokens size-2.
  prevPos := tokens last.
  prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
  prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos.
  ] ifFalse: ["Old format gives no stamp; prior pointer in two parts"
  prevPos := tokens at: tokens size-2.
  prevFileIndex := tokens last.
  ].
  (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]
  ].
  ((tokens size between: 5 and: 6)
  and: [(tokens at: tokens size-3) = #methodsFor:]) ifTrue:[
  (tokens at: tokens size-1) = #stamp: ifTrue: [
  "New format gives change stamp and unified prior pointer"
  stamp := tokens at: tokens size.
  ]
  ].
    changeList add: (ChangeRecord new file: file position: position type: #method
  class: class name category: cat meta: meta stamp: stamp).
  position := prevPos.
  prevPos notNil ifTrue:[file := sourceFilesCopy at: prevFileIndex].
  ].
  sourceFilesCopy do: [:x | x ifNotNil:[x close]].
  ^changeList!