[Vm-dev] VM Maker: Cog-eem.211.mcz

[commits at source.squeak.org]

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

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

Name: Cog-eem.211
Author: eem
Time: 16 October 2014, 1:25:24.459 pm
UUID: 4296b46e-4123-4261-98f0-c9fe23be3528
Ancestors: Cog-eem.210

Provide uploadNewerSpurConfigurationsInTrunk to create update.spur versions
of trunk updates.  Refactor a common sequence into a packages method.  Fix
a warning for the catefory of setValue:.

=============== Diff against Cog-eem.210 ===============

Item was changed:
  ----- Method: SpurBootstrap class>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
  categoryForClass: className meta: isMeta selector: selector 
  	^(isMeta
  			ifTrue: [{ className. #class. selector }]
  			ifFalse: [{ className. selector }])
  		caseOf: {
  			[#(Behavior allInstancesOrNil)]					-> [#enumerating].
  			[#(Behavior byteSizeOfInstance)]				-> [#'accessing instances and variables'].
  			[#(Behavior byteSizeOfInstanceOfSize:)]		-> [#'accessing instances and variables'].
  			[#(Behavior elementSize)]						-> [#'accessing instances and variables'].
  			[#(Behavior handleFailingBasicNew)]			-> [#private].
  			[#(Behavior handleFailingBasicNew:)]			-> [#private].
  			[#(Behavior handleFailingFailingBasicNew)]		-> [#private].
  			[#(Behavior handleFailingFailingBasicNew:)]		-> [#private].
  			[#(Behavior identityHash)]						-> [#comparing].
  			[#(Behavior isEphemeronClass)]				-> [#testing].
  			[#(Behavior isImmediateClass)]					-> [#testing].
  			[#(Character identityHash)]						-> [#comparing].
+ 			[#(Character setValue:)]						-> [#accessing].
  			[#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
  															-> [#'subclass creation'].
  			[#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
  															-> [#public].
  			[#(CompiledMethod bytecodeSetName)]		-> [#accessing].
  			[#(CompiledMethod class handleFailingFailingNewMethod:header:)]
  															-> [#private].
  			[#(CompiledMethod class handleFailingNewMethod:header:)]
  															-> [#private].
  			[#(CompiledMethod class headerFlagForEncoder:)]
  															-> [#'method encoding'].
  			[#(CompiledMethod class installPrimaryBytecodeSet:)]
  															-> [#'class initialization'].
  			[#(CompiledMethod class installSecondaryBytecodeSet:)]
  															-> [#'class initialization'].
  			[#(Context class allInstances)]					-> [#enumerating].
  			[#(Context class allInstancesDo:)]				-> [#enumerating].
  			[#(Context failPrimitiveWith:)]					-> [#'system simulation'].
  			[#(Context isPrimFailToken:)]					-> [#private].
  			[#(Context send:to:with:lookupIn:)]				-> [#controlling].
  			[#(ContextPart isPrimFailToken:)]				-> [#private].
  			[#(ContextPart send:to:with:lookupIn:)]			-> [#controlling].
  			[#(EncoderForV3 computeMethodHeaderForNumArgs:numTemps:numLits:primitive:)]
  															-> [#'method encoding'].
  			[#(EncoderForV3PlusClosures genCallPrimitive:)]
  															-> [#'bytecode generation'].
  			[#(EncoderForV3PlusClosures class callPrimitiveCode)]
  															-> [#'bytecode decoding'].
  			[#(MethodContext failPrimitiveWith:)]			-> [#'system simulation'].
  			[#(MethodContext class allInstances)]			-> [#enumerating].
  			[#(MethodContext class allInstancesDo:)]		-> [#enumerating].
  			[#(SmallInteger asCharacter)]					-> [#converting].
  			[#(SmalltalkImage growMemoryByAtLeast:)]	-> [#'memory space'].
  			[#(SmalltalkImage maxIdentityHash)]			-> [#'system attributes'].
  			[#(SystemDictionary growMemoryByAtLeast:)]	-> [#'memory space'].
  			[#(SystemDictionary maxIdentityHash)]			-> [#'system attributes'].
  			[#(SystemDictionary setGCParameters)]		-> [#'snapshot and quit'].
  			[#(SystemNavigation allObjects)]				-> [#query].
  			[#(SystemNavigation allObjectsOrNil)]			-> [#query].
  			 }
  		otherwise:
  			[Transcript nextPutAll: className.
  			 isMeta ifTrue: [Transcript nextPutAll: ' class'].
  			 Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
  			 ^Categorizer default]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>findOldestConfigurationFor:inVersionNames:repository: (in category 'configurations') -----
+ findOldestConfigurationFor: packageVersions inVersionNames: configurationVersionNames repository: repo
+ 	| oldest |
+ 	oldest := configurationVersionNames first.
+ 	configurationVersionNames do:
+ 		[:cfgver| | config |
+ 		config := repo versionNamed: cfgver.
+ 		(packageVersions noneSatisfy:
+ 			[:pkgver| | configVersion |
+ 			configVersion := config dependencies detect:
+ 								[:dep|
+ 								 pkgver packageName = dep package name].
+ 			configVersion versionInfo versionNumber >= pkgver versionNumber]) ifTrue:
+ 				[^oldest].
+ 		oldest := cfgver].
+ 	self error: 'couldn''t find configuration newer than supplied versions'!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>packages (in category 'private-accessing') -----
+ packages
+ 	"Answer the packages Spur modifies."
+ 	^self packagesAndPatches keys!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadAllInTrunk (in category 'patching') -----
  patchAndUploadAllInTrunk
  	"Look for all versions in the default repository that have patched versions there-in.
  	 Download and patch them and upload the patched versions (overwriting the older ones)."
  	"(SpurBootstrapMonticelloPackagePatcher new
  		from: 'spurpackages'
  		to: 'trunkpackages')
  			patchAndUploadAllInTrunk"
  	| seed trunk sourceRepo cacheRepo |
  	seed := 'Are you really sure you want to do this?\It should happen only once!!' withCRs.
  	3 timesRepeat:
  		[(UIManager confirm: seed) ifFalse: [^self].
  		 seed := seed copyReplaceAll: 'really ' with: 'really, really '].
  	sourceDir assureExistence; deleteLocalFiles.
  	destDir assureExistence; deleteLocalFiles.
  	sourceRepo := MCDirectoryRepository directory: sourceDir.
  	cacheRepo := MCCacheRepository default.
  	(trunk := self trunk) cacheAllFileNamesDuring:
  		[| latestBranches latestUnbranched |
+ 		latestBranches := self packages collect:
- 		latestBranches := self packagesAndPatches keys collect:
  							[:package|
  							(trunk versionNamesForPackageNamed: package name, '.spur') detectMin: [:vn | vn asMCVersionName versionNumber]].
  		latestUnbranched := latestBranches collect: [:verName| (trunk versionNamed: (verName copyReplaceAll: '.spur' with: '') asMCVersionName) info ancestors first versionName].
  		((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
  			reject: [:unpatched| unpatched includesSubString: '.spur'])
  			do: [:unpatched|
  				"it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant.  At least for the cache repositoriy that's not true."
  				sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
  		 self patchAsNeeded.
  		 self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadNewer (in category 'patching') -----
  patchAndUploadNewer
  	"Look for unbranched versions on the default repository that are newer than the
  	 image''s versions. Download and patch them and upload the patched versions."
  	"(SpurBootstrapMonticelloPackagePatcher new
  		from: 'spurpackages'
  		to: 'trunkpackages')
  			patchAndUploadNewer"
  	| repo sourceRepo |
  	sourceDir deleteLocalFiles.
  	destDir deleteLocalFiles.
  	repo := self repositoryForUrl: MCMcmUpdater defaultUpdateURL.
  	sourceRepo := MCDirectoryRepository directory: sourceDir.
  	repo cacheAllFileNamesDuring:
+ 		[self packages do:
- 		[self packagesAndPatches keys do:
  			[:package| | workingCopy |
  			workingCopy := MCWorkingCopy allManagers detect: [:pkg| pkg packageName = package packageName].
  			(workingCopy possiblyNewerVersionsIn: repo) do:
  				[:newerVersion|
  				 newerVersion packageAndBranchName = package packageName ifTrue: "Don't patch already patched packages!!!!"
  					[(sourceRepo includesVersionNamed: newerVersion) ifFalse:
  						[sourceRepo storeVersion: (repo versionNamed: newerVersion)]]]].
  		 self patchAsNeeded.
  		 self uploadFrom: (MCDirectoryRepository directory: destDir) to: repo]!

Item was changed:
  ----- Method: SpurBootstrapMonticelloPackagePatcher>>patchAndUploadUnpatchedInTrunk (in category 'patching') -----
  patchAndUploadUnpatchedInTrunk
  	"Look for unbranched versions in the default repository that are newer than the
  	 latest patched versions there-in. Download and patch them and upload the patched
  	 versions."
  	"(SpurBootstrapMonticelloPackagePatcher new
  		from: 'spurpackages'
  		to: 'trunkpackages')
  			patchAndUploadUnpatchedInTrunk"
  	| trunk sourceRepo cacheRepo |
  	sourceDir assureExistence; deleteLocalFiles.
  	destDir assureExistence; deleteLocalFiles.
  	sourceRepo := MCDirectoryRepository directory: sourceDir.
  	cacheRepo := MCCacheRepository default.
  	(trunk := self trunk) cacheAllFileNamesDuring:
  		[| latestBranches latestUnbranched |
+ 		latestBranches := self packages collect:
- 		latestBranches := self packagesAndPatches keys collect:
  							[:package|
  							(trunk versionNamesForPackageNamed: package name, '.spur') detectMax: [:vn | vn asMCVersionName versionNumber]].
  		latestUnbranched := latestBranches collect: [:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
  		((trunk possiblyNewerVersionsOfAnyOf: latestUnbranched)
  			reject: [:unpatched| unpatched includesSubString: '.spur'])
  			do: [:unpatched|
  				"it is claimed that whether a repository contains a .mcz or a .mcd is irrelevant.  At least for the cache repositoriy that's not true."
  				sourceRepo storeVersion: (self cachedNonDiffyVersionNamed: unpatched from: trunk)].
  		 self patchAsNeeded.
  		 self uploadFrom: (MCDirectoryRepository directory: destDir) to: trunk]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>spurConfigurationOf:forRepository: (in category 'configurations') -----
+ spurConfigurationOf: anMCConfiguration forRepository: repo
+ 	"Answer a copy of anMCConfiguration containing the matching Spur dependencies.
+ 	 If no replacements could be made (because no Spur versions exist) then answer nil."
+ 	| found clone |
+ 	found := false.
+ 	clone := Array streamContents:
+ 				[:s|
+ 				s nextPut: #name; nextPut: (anMCConfiguration name copyReplaceAll: 'update-' with: 'update.spur-');
+ 				 "no location accessor!!!!"
+ 				  nextPut: #repository; nextPut: {anMCConfiguration repositories first locationWithTrailingSlash allButLast}.
+ 				 anMCConfiguration dependencies do:
+ 					[:dep| | info pkg ver spurVersionName |
+ 					 info := dep versionInfo.
+ 					 ((pkg := self packages
+ 								detect: [:package| package name = dep package name]
+ 								ifNone: []) notNil
+ 					  and: [spurVersionName := (info name
+ 													copyReplaceAll: pkg name
+ 													with: pkg name, '.spur'), '.mcz'.
+ 						 (ver := MCCacheRepository default versionNamed: spurVersionName asMCVersionName) ifNil:
+ 							[ver := repo versionNamed: spurVersionName asMCVersionName].
+ 						 ver notNil])
+ 						ifTrue: [found := true. info := ver info].
+ 					(ver isNil and: [spurVersionName notNil]) ifTrue:
+ 						[Transcript nextPutAll: 'failed to get ', spurVersionName, ' in ', anMCConfiguration name; cr; flush].
+ 					s nextPut: #dependency; nextPut: (MCConfiguration dependencyToArray: (MCVersionDependency package: dep package info: info))]].
+ 	^found ifTrue:
+ 		[MCConfiguration fromArray: clone]!

Item was added:
+ ----- Method: SpurBootstrapMonticelloPackagePatcher>>uploadNewerSpurConfigurationsInTrunk (in category 'configurations') -----
+ uploadNewerSpurConfigurationsInTrunk
+ 	"Make sure that update.spur configurations exist for all relevant update.* configurations."
+ 	"SpurBootstrapMonticelloPackagePatcher new uploadNewerSpurConfigurationsInTrunk"
+ 	| trunk |
+ 	trunk := self trunk.
+ 	trunk cacheAllFileNamesDuring:
+ 		[| configurations spurConfigurations oldestUpdate |
+ 		 spurConfigurations := (trunk versionNamesForPackageNamed: 'update.spur') sort: [:a :b| a versionNumber > b versionNumber].
+ 		 configurations := ((trunk versionNamesForPackageNamed: 'update') select: [:n| n beginsWith: 'update-']) sort: [:a :b| a versionNumber > b versionNumber].
+ 		 oldestUpdate := spurConfigurations isEmpty
+ 							ifTrue:
+ 								[| earliestBranches earliestUnbranched  |
+ 								 earliestBranches := self packages collect:
+ 														[:package|
+ 														(trunk versionNamesForPackageNamed: package name, '.spur') detectMin:
+ 															[:vn | vn asMCVersionName versionNumber]].
+ 								 earliestUnbranched := earliestBranches collect:
+ 															[:verName| (verName copyReplaceAll: '.spur' with: '') asMCVersionName].
+ 								 self
+ 									findOldestConfigurationFor: earliestUnbranched
+ 									inVersionNames: configurations
+ 									repository: trunk]
+ 							ifFalse:
+ 								[spurConfigurations first copyReplaceAll: '.spur' with: ''].
+ 		 Transcript nextPutAll: 'Oldest: ', oldestUpdate; cr; flush.
+ 		 (configurations copyFrom: 1 to: (configurations indexOf: oldestUpdate) - 1) reverseDo:
+ 			[:configName|
+ 			 "((configName beginsWith: 'update-eem.29') and: ['34' includes: (configName at: 14)]) ifTrue:
+ 				[self halt]."
+ 			 (self spurConfigurationOf: (trunk versionNamed: configName) forRepository: trunk) ifNotNil:
+ 				[:edition| trunk storeVersion: edition]]]!