[Vm-dev] VM Maker: Cog-eem.197.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Aug 23 16:07:45 UTC 2014
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]]]]]!
More information about the Vm-dev
mailing list