Eliot Miranda uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-eem.197.mcz
==================== Summary ====================
Name: Cog-eem.197 Author: eem Time: 23 August 2014, 5:07:26.458 pm UUID: d85c97ce-9ea8-47ce-862e-7e1ee52f987c Ancestors: Cog-eem.196
Take back the split into two ennumerators and hence fix Monticello package patching.
=============== Diff against Cog-eem.196 ===============
Item was changed: ----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') ----- addNewMethods "Get the simulator to add any and all missing methods immediately." | cmaiaSym basSym | cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:. basSym := self findSymbol: #basicAddSelector:withMethod:. basSym ifNil: [basSym := self findSymbol: #addSelectorSilently:withMethod:]. self allPrototypeClassNamesDo: [:sym :symIsMeta| (self findClassNamed: (literalMap at: sym)) ifNil: [Transcript cr; nextPutAll: 'not installing any methods for '; nextPutAll: sym; nextPutAll: '; class not found in image'; flush.] ifNotNil: [:theClass| | class | class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass]. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | methodOrNil | (className = sym + and: [symIsMeta = isMeta + and: [(method pragmaAt: #remove) isNil]]) ifTrue: - and: [symIsMeta = isMeta]) ifTrue: ["probe method dictionary of the class for each method, installing a dummy if not found." "Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush." methodOrNil := self interpreter: oldInterpreter object: class perform: cmaiaSym withArguments: {literalMap at: selector. oldHeap nilObject}. methodOrNil = oldHeap nilObject ifTrue: "no method. install the real thing now" [Transcript cr; nextPutAll: 'installing '; nextPutAll: className; nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); store: selector; flush. self interpreter: oldInterpreter object: class perform: basSym withArguments: { literalMap at: selector. self installableMethodFor: method selector: selector className: className isMeta: isMeta}. installedPrototypes add: method selector] ifFalse: "existing method; collect the methodClassAssociation; its needed later" [methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]]!
Item was removed: - ----- Method: SpurBootstrap>>allPrototypeMethodSelectors (in category 'method prototypes') ----- - allPrototypeMethodSelectors - "Answer all prototype selectors except those marked <remove>" - ^(imageTypes - inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') - into: [:prototypes :type| - prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]) reject: - [:sel| ((SpurBootstrap class >> sel) pragmaAt: #remove) notNil]!
Item was changed: ----- Method: SpurBootstrap>>fileOutPrototypesFor: (in category 'public access') ----- fileOutPrototypesFor: imageTypeOrArrayOfTypes "SpurBootstrap new fileOutPrototypesFor: 'squeak'" | internalStream | imageTypes := imageTypeOrArrayOfTypes isString ifTrue: [{imageTypeOrArrayOfTypes}] ifFalse: [imageTypeOrArrayOfTypes asArray]. internalStream := WriteStream on: (String new: 1000). internalStream header; timeStamp. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | class category preamble source | class := Smalltalk classNamed: className. isMeta ifTrue: [class := class class]. + (method pragmaAt: #remove) + ifNil: + [category := (class organization categoryOfElement: selector) ifNil: + [self class categoryForClass: className meta: isMeta selector: selector]. + preamble := class name, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''. + internalStream nextPut: $!!; nextChunkPut: preamble; cr. + source := method getSourceFromFile asString. + source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size. + (self selectorForPrototypeMethod: method) isBinary ifTrue: + [source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)]. + internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr] + ifNotNil: + [source := class name, ' removeSelector: ', selector storeString. + internalStream nextChunkPut: source; cr; cr]]. - category := (class organization categoryOfElement: selector) ifNil: - [self class categoryForClass: className meta: isMeta selector: selector]. - preamble := class name, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''. - internalStream nextPut: $!!; nextChunkPut: preamble; cr. - source := method getSourceFromFile asString. - source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size. - (self selectorForPrototypeMethod: method) isBinary ifTrue: - [source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)]. - internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr]. internalStream trailer.
FileStream writeSourceCodeFrom: internalStream baseName: 'SpurBootstrapPrototypes' isSt: true useHtml: false!
Item was changed: ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') ----- prototypeClassNameMetaSelectorMethodDo: quaternaryBlock "Evaluate aBlock with class name, class is meta, method and selector. For now find methods in class-side category #'method prototypes'. Scheme could be extended to have different protocols for different Squeak/Pharo versions." + self allPrototypeSelectors do: - self allPrototypeMethodSelectors do: [:protoSelector| | method className isMeta | method := SpurBootstrap class >> protoSelector. className := self classNameForPrototypeMethod: method. (isMeta := className endsWith: 'class') ifTrue: [className := (className allButLast: 5) asSymbol]. (method pragmaAt: #indirect) ifNotNil: [method := (isMeta ifTrue: [(Smalltalk classNamed: className) class] ifFalse: [Smalltalk classNamed: className]) >> protoSelector]. quaternaryBlock value: className value: isMeta value: (self selectorForPrototypeMethod: method) value: method]!
Item was removed: - ----- Method: SpurBootstrap>>removalClassNameMetaSelectorDo: (in category 'method prototypes') ----- - removalClassNameMetaSelectorDo: quaternaryBlock - "Evaluate aBlock with class name, class is meta, and selector for - all prototypes marked <remove>." - self allPrototypeSelectors do: - [:protoSelector| | method className isMeta | - method := SpurBootstrap class >> protoSelector. - className := self classNameForPrototypeMethod: method. - (isMeta := className endsWith: 'class') ifTrue: - [className := (className allButLast: 5) asSymbol]. - (method pragmaAt: #remove) ifNotNil: - [quaternaryBlock - value: className - value: isMeta - value: (self selectorForPrototypeMethod: method)]]!
Item was changed: ----- Method: SpurBootstrap>>removeMethods (in category 'bootstrap methods') ----- removeMethods "Get the simulator to remove any methods marked with <remove>." | removeSym | removeSym := self findSymbol: #removeSelectorSilently:. removeSym ifNil: [removeSym := self findSymbol: #removeSelector:]. + self prototypeClassNameMetaSelectorMethodDo: + [:className :isMeta :selector :method| | class | + (method pragmaAt: #remove) ifNotNil: + [(self findClassNamed: (literalMap at: className)) ifNotNil: + [:theClass| + class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass]. + Transcript + cr; + nextPutAll: 'removing '; + nextPutAll: className; + nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); + store: selector; + flush. + self interpreter: oldInterpreter + object: class + perform: removeSym + withArguments: {literalMap at: selector}]]]! - self removalClassNameMetaSelectorDo: - [:className :isMeta :selector| | class | - (self findClassNamed: (literalMap at: className)) ifNotNil: - [:theClass| - class := isMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass]. - Transcript - cr; - nextPutAll: 'removing '; - nextPutAll: className; - nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); - store: selector; - flush. - self interpreter: oldInterpreter - object: class - perform: removeSym - withArguments: {literalMap at: selector}]]!
Item was changed: ----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') ----- replaceMethods "Replace all the modified method prototypes." self allPrototypeClassNamesDo: [:sym :symIsMeta| (self findClassNamed: (literalMap at: sym)) ifNil: [Transcript cr; nextPutAll: 'not replacing any methods for '; nextPutAll: sym; nextPutAll: '; class not found in image'; flush.] ifNotNil: [:theClass| | class | class := symIsMeta ifTrue: [oldHeap fetchClassOfNonImm: theClass] ifFalse: [theClass]. self prototypeClassNameMetaSelectorMethodDo: [:className :isMeta :selector :method| | replacement methodDict index | (className = sym + and: [symIsMeta = isMeta + and: [(method pragmaAt: #remove) isNil]]) ifTrue: - and: [symIsMeta = isMeta]) ifTrue: [(installedPrototypes includes: method selector) ifFalse: ["probe method dictionary of the class for each method, installing a dummy if not found." Transcript cr; nextPutAll: 'replacing '; nextPutAll: className; nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']); store: selector; flush. replacement := self installableMethodFor: method selector: selector className: className isMeta: isMeta. methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class. index := self indexOfSelector: (literalMap at: selector) in: methodDict. oldHeap storePointer: index - SelectorStart ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict) withValue: replacement. installedPrototypes add: method selector]]]]]!
vm-dev@lists.squeakfoundation.org