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

commits at source.squeak.org commits at source.squeak.org
Sun Aug 10 04:36:10 UTC 2014


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

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

Name: Cog-eem.186
Author: eem
Time: 9 August 2014, 9:35:47.504 pm
UUID: 19202710-242f-4183-b28a-2f536468d794
Ancestors: Cog-eem.185

Munger needs to create proper sourceless methods.

=============== Diff against Cog-eem.185 ===============

Item was changed:
  ----- Method: SpurOldToNewMethodFormatMunger>>installableMethodFor:selector:siblingMethod: (in category 'munging') -----
+ installableMethodFor: methodWithSource selector: selectorOop siblingMethod: sibling 
+ 	| method classOop clone delta numBytes |
+ 	method := methodWithSource copyWithTempsFromMethodNode: methodWithSource methodNode.
- installableMethodFor: method selector: selectorOop siblingMethod: sibling 
- 	| classOop clone delta numBytes |
  	delta := (method primitive > 0
  			  and: [(method at: method initialPC) ~= method methodClass callPrimitiveCode])
  				ifTrue: [3]
  				ifFalse: [0].
  	clone := heap
+ 				allocateSlots: (heap numSlotsForBytes: (numBytes := method size) + delta)
- 				allocateSlots: ((numBytes := heap numSlotsForBytes: method endPC + 1) + delta)
  				format: (heap compiledMethodFormatForNumBytes: numBytes + delta)
  				classIndex: (heap classIndexOf: sibling).
  	classOop := interpreter methodClassOf: sibling.
  	method methodClass isMeta ifTrue:
  		[classOop := heap fetchPointer: interpreter thisClassIndex ofObject: classOop].
  	heap storePointer: 0
  		ofObject: clone
  		withValue: (self methodHeaderForMethod: method).
  	1 to: method numLiterals - 2 do:
  		[:i|
  		heap storePointer: i
  			ofObject: clone
  			withValue: (self literalFor: (method literalAt: i) inClass: classOop)].
  	heap
  		storePointer: method numLiterals - 1
  			ofObject: clone
  				withValue: selectorOop;
  		storePointer: method numLiterals
  			ofObject: clone
  				withValue: (interpreter methodClassAssociationOf: sibling).
  
  	delta > 0 ifTrue:
  		[heap
  			storeByte: method initialPC - 1 ofObject: clone 	withValue: 139;
  			storeByte: method initialPC + 0 ofObject: clone withValue: (method primitive bitAnd: 255);
  			storeByte: method initialPC + 1 ofObject: clone withValue: (method primitive bitShift: -8)].
+ 	method initialPC to: method size do:
- 	method initialPC to: method endPC do:
  		[:i|
  		 heap storeByte: i - 1 + delta ofObject: clone withValue: (method at: i)].
  
  	^clone!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>replaceMethods (in category 'munging') -----
+ replaceMethods
+ 	| byteSymbolClassIndex symbols symbolSizes |
+ 	byteSymbolClassIndex := heap classIndexOf: (heap splObj: SelectorDoesNotUnderstand).
+ 	symbols := Set with: #bindingOf:.
+ 	replacements do:
+ 		[:tuple| | method adder |
+ 		symbols add: tuple second.
+ 		method := tuple last.
+ 		adder := [:lit|
+ 				   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
+ 				   (lit isVariableBinding and: [lit key isSymbol]) ifTrue: [symbols add: lit key].
+ 				   lit isArray ifTrue: [lit do: adder]].
+ 		method literals do: adder].
+ 	symbolSizes := symbols collect: [:ea| ea size].
+ 	symbolOops := Dictionary new.
+ 	heap allObjectsDo:
+ 		[:obj| | sz |
+ 		((heap classIndexOf: obj) = byteSymbolClassIndex
+ 		 and: [symbolSizes includes: (sz := heap numBytesOf: obj)]) ifTrue:
+ 			[symbols do:
+ 				[:s|
+ 				 (sz = s size
+ 				  and: [(interpreter stringOf: obj) = s]) ifTrue:
+ 					[symbolOops at: s put: obj]]]].
+ 	replacements do:
+ 		[:tuple|
+ 		[:classOop :selector :method| | replacement methodDict methodArray index |
+ 		methodDict := heap fetchPointer: MethodDictionaryIndex ofObject: classOop.
+ 		methodArray := heap fetchPointer: MethodArrayIndex ofObject: methodDict.
+ 		index := (0 to: (heap numSlotsOf: methodArray) - 1) detect: [:i| (heap fetchPointer: i ofObject: methodArray) ~= heap nilObject].
+ 		replacement := self installableMethodFor: method
+ 							selector: (symbolOops at: selector)
+ 							siblingMethod: (heap fetchPointer: index ofObject: methodArray).
+ 		index := self indexOfSelector: (symbolOops at: selector) in: methodDict.
+ 		heap
+ 			storePointer: index - SelectorStart
+ 			ofObject: methodArray
+ 			withValue: replacement] valueWithArguments: tuple]!

Item was removed:
- ----- Method: SpurOldToNewMethodFormatMunger>>replaceMethodsAddingThemTo: (in category 'munging') -----
- replaceMethodsAddingThemTo: replacedSet
- 	| byteSymbolClassIndex symbols symbolSizes |
- 	byteSymbolClassIndex := heap classIndexOf: (heap splObj: SelectorDoesNotUnderstand).
- 	symbols := Set with: #bindingOf:.
- 	replacements do:
- 		[:tuple| | method adder |
- 		symbols add: tuple second.
- 		method := tuple last.
- 		adder := [:lit|
- 				   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
- 				   (lit isVariableBinding and: [lit key isSymbol]) ifTrue: [symbols add: lit key].
- 				   lit isArray ifTrue: [lit do: adder]].
- 		method literals do: adder].
- 	symbolSizes := symbols collect: [:ea| ea size].
- 	symbolOops := Dictionary new.
- 	heap allObjectsDo:
- 		[:obj| | sz |
- 		((heap classIndexOf: obj) = byteSymbolClassIndex
- 		 and: [symbolSizes includes: (sz := heap numBytesOf: obj)]) ifTrue:
- 			[symbols do:
- 				[:s|
- 				 (sz = s size
- 				  and: [(interpreter stringOf: obj) = s]) ifTrue:
- 					[symbolOops at: s put: obj]]]].
- 	replacements do:
- 		[:tuple|
- 		[:classOop :selector :method| | replacement methodDict methodArray index |
- 		methodDict := heap fetchPointer: MethodDictionaryIndex ofObject: classOop.
- 		methodArray := heap fetchPointer: MethodArrayIndex ofObject: methodDict.
- 		index := (0 to: (heap numSlotsOf: methodArray) - 1) detect: [:i| (heap fetchPointer: i ofObject: methodArray) ~= heap nilObject].
- 		replacement := self installableMethodFor: method
- 							selector: (symbolOops at: selector)
- 							siblingMethod: (heap fetchPointer: index ofObject: methodArray).
- 		index := self indexOfSelector: (symbolOops at: selector) in: methodDict.
- 		heap
- 			storePointer: index - SelectorStart
- 			ofObject: methodArray
- 			withValue: replacement.
- 		replacedSet add: replacement] valueWithArguments: tuple]!

Item was changed:
  ----- Method: SpurOldToNewMethodFormatMunger>>updateAndForwardMethods (in category 'munging') -----
  updateAndForwardMethods
  	| new now lastDotTime |
  	new := Set new: 1000.
  	lastDotTime := Time now asSeconds.
  	heap allObjectsDo:
  		[:obj|
  		((heap isCompiledMethod: obj)
  		 and: [(new includes: obj) not]) ifTrue:
  			[| header |
  			 (heap primitiveIndexOfMethodHeader: (header := heap methodHeaderOf: obj)) > 0
  				ifTrue:
  					[new add: (self mungePrimitiveMethod: obj).
  					 (now := Time now asSeconds) > lastDotTime ifTrue:
  						[Transcript nextPut: $.; flush.
  						 lastDotTime := now]]
  				ifFalse:
  					[heap
  						storePointerUnchecked: 0
  						ofObject: obj
  						withValue: (self convertOldMethodHeader: header)]]].
  	Spur32BitMMLESimulator adoptInstance: interpreter objectMemory.
  	self withExecutableInterpreter: interpreter
+ 		do: [self replaceMethods]!
- 		do: [self replaceMethodsAddingThemTo: new]!



More information about the Vm-dev mailing list