VM Maker: Cog-eem.129.mcz

 
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.129.mcz

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

Name: Cog-eem.129
Author: eem
Time: 15 January 2014, 5:59:45.417 pm
UUID: ca78a842-5919-418a-ad96-0f9189dbed66
Ancestors: Cog-eem.128

Add a utility to the Spur bootstrap that will patch appropriate
Monticello packages with appropriate Spur bootstrap methods.

=============== Diff against Cog-eem.128 ===============

Item was added:
+ Object subclass: #SpurBootstrapMonticelloPackagePatcher
+ instanceVariableNames: 'sourceDir destDir'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
+
+ !SpurBootstrapMonticelloPackagePatcher commentStamp: 'eem 1/15/2014 17:59' prior: 0!
+ A SpurBootstrapMonticelloPackagePatcher is used to construct a new set of patched Monticello packages for Spur.  The use case is some bootstrap process loads a set of Monticello packages.  To repeat the bootstrap with a Spur image the bootstrap must use suitably patched Monticello packages containing the new method versions on the class side of SpurBootstrap.
+
+ Instance Variables
+ destDir: <FileDirectory>
+ sourceDir: <FileDirectory>
+
+ destDir
+ - directory to which patched packages are to be written
+
+ sourceDir
+ - directory from which packages to be patched are to be read!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>filesForPackage:in: (in category 'private-accessing') -----
+ filesForPackage: package in: aDirectory
+ ^aDirectory fileNames select:
+ [:fileName|
+ (fileName beginsWith: package name)
+ and: [(fileName at: package name size + 1) isLetter not]]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>from:to: (in category 'initialization') -----
+ from: sourceDirName to: destDirName
+ sourceDir := FileDirectory on: sourceDirName.
+ destDir := FileDirectory on: destDirName!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>packages (in category 'private-accessing') -----
+ packages
+ "SpurBootstrapMonticelloPackagePatcher new packages"
+ | packages |
+ packages := Set new.
+ SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
+ [:className :isMeta :selector :method| | class |
+ class := Smalltalk classNamed: className.
+ isMeta ifTrue:
+ [class := class class].
+ packages add: ((class includesSelector: selector)
+ ifTrue: [PackageOrganizer default packageOfMethod: (class >> selector) methodReference]
+ ifFalse: [PackageOrganizer default  packageOfClass: class])].
+ ^packages!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>packagesAndPatches (in category 'private-accessing') -----
+ packagesAndPatches
+ "SpurBootstrapMonticelloPackagePatcher new packagesAndPatches"
+ | packagesAndPatches |
+ packagesAndPatches := Dictionary new.
+ SpurBootstrap new prototypeClassNameMetaSelectorMethodDo:
+ [:className :isMeta :selector :method| | class methodReference |
+ class := Smalltalk classNamed: className.
+ isMeta ifTrue:
+ [class := class class].
+ methodReference := (class includesSelector: selector) ifTrue:
+ [(class >> selector) methodReference].
+ (packagesAndPatches
+ at: (methodReference
+ ifNotNil: [PackageOrganizer default packageOfMethod: methodReference]
+ ifNil: [PackageOrganizer default  packageOfClass: class])
+ ifAbsentPut: [OrderedCollection new])
+ add: (MCAddition of: (MCMethodDefinition
+ className: className
+ classIsMeta: isMeta
+ selector: selector
+ category: (methodReference
+ ifNotNil: [methodReference category]
+ ifNil: [Categorizer default])
+ timeStamp: method timeStamp
+ source: (method getSourceFromFile asString allButFirst: method selector size - selector size)))].
+ ^packagesAndPatches!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>patch (in category 'patching') -----
+ patch
+ "(SpurBootstrapMonticelloPackagePatcher new
+ from: '/Users/eliot/Glue/repositories/nsboot/smalltalk'
+ to: '/Users/eliot/Glue/repositories/spurnsboot/smalltalk')
+ patch"
+ self packagesAndPatches keysAndValuesDo:
+ [:package :patches|
+ (self filesForPackage: package in: sourceDir) do:
+ [:packageFile|
+ self patchPackage: packageFile with: patches for: package]]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchForPackage:withPatches:snapshot: (in category 'patching') -----
+ patchForPackage: package withPatches: patches snapshot: snapshot
+ (package includesClass: Character) ifTrue:
+ [snapshot halt].
+ ^MCPatch operations: patches!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchPackage:with:for: (in category 'patching') -----
+ patchPackage: packageFileName with: patches for: package
+ | version newVersion |
+ version := self versionFor: packageFileName.
+ newVersion := self version: version withPatches: patches for: package.
+ self storeVersion: newVersion!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>storeVersion: (in category 'patching') -----
+ storeVersion: newVersion
+ [(MCDirectoryRepository new directory: destDir) storeVersion: newVersion]
+ on: FileExistsException
+ do: [:ex| ex resume: (ex fileClass forceNewFileNamed: ex fileName)]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>version:withPatches:for: (in category 'patching') -----
+ version: version withPatches: patches for: package
+ | snapshot ancestry |
+ snapshot := MCPatcher
+ apply: (self patchForPackage: package withPatches: patches snapshot: version snapshot)
+ to: version snapshot.
+ ancestry := MCWorkingAncestry new addAncestor: version info.
+ ^MCVersion
+ package: version package
+ info: (ancestry
+ infoWithName: version info name
+ message: version info name, ' patched for Spur')
+ snapshot: snapshot
+ dependencies: {} "punt on computing dependencies; there are't any so far"
+ !

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>versionFor: (in category 'patching') -----
+ versionFor: packageFileName
+ ^sourceDir
+ readOnlyFileNamed: packageFileName
+ do: [:fs|
+ ((MCVersionReader readerClassForFileNamed: fs fullName)
+ on: fs fileName: fs fullName)
+ version]!