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

commits at source.squeak.org commits at source.squeak.org
Sat Aug 9 21:13:22 UTC 2014


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

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

Name: Cog-eem.184
Author: eem
Time: 9 August 2014, 2:12:52.662 pm
UUID: bb3a2213-8813-486f-9d97-cbd72970400f
Ancestors: Cog-eem.183

Provide an old compiled method format to new format
image converter for Spur.
Comment typo.

=============== Diff against Cog-eem.183 ===============

Item was changed:
  ----- Method: SpurBootstrap>>fillInCompiledMethod:from: (in category 'bootstrap image') -----
  fillInCompiledMethod: newObj from: oldObj
  	| firstByteIndex primIndex |
  	self fillInPointerObject: newObj from: oldObj.
+ 	"Now convert the CompiledMethod's format.  First write the header in the new format"
- 	"Now convert the COmpiledMethod's format.  First write the header in tye new format"
  	newHeap
  		storePointerUnchecked: 0
  		ofObject: newObj
  		withValue: (self convertOldMethodHeader: (oldHeap fetchPointer: 0 ofObject: oldObj)).
  	"Then if necessary prepend the callPrimitive: bytecode"
  	(primIndex := oldInterpreter primitiveIndexOf: oldObj) > 0
  		ifTrue:
  			[firstByteIndex := oldHeap lastPointerOf: oldObj.
  			 newHeap
  				storeByte: firstByteIndex + 0 ofObject: newObj withValue: 139;
  				storeByte: firstByteIndex + 1 ofObject: newObj withValue: (primIndex bitAnd: 255);
  				storeByte: firstByteIndex + 2 ofObject: newObj withValue: (primIndex bitShift: -8).
  			 firstByteIndex to: (oldHeap numBytesOf: oldObj) - 1 do:
  				[:i|
  				newHeap storeByte: i + 3 ofObject: newObj withValue: (oldHeap fetchByte: i ofObject: oldObj)]]
  		ifFalse:
  			[(oldHeap lastPointerOf: oldObj) / oldHeap wordSize to: (oldHeap numSlotsOf: oldObj) - 1 do:
  				[:i|
  				newHeap storeLong32: i ofObject: newObj withValue: (oldHeap fetchLong32: i ofObject: oldObj)]]!

Item was added:
+ Spur32BitMMLESimulator subclass: #SpurOldFormat32BitMMLESimulator
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurOldFormat32BitMMLESimulator>>literalCountOfMethodHeader: (in category 'method access') -----
+ literalCountOfMethodHeader: header
+ 	self assert: (self isIntegerObject: header).
+ 	^header >> 10 bitAnd: 16rFF!

Item was added:
+ ----- Method: SpurOldFormat32BitMMLESimulator>>primitiveIndexOfMethodHeader: (in category 'method access') -----
+ primitiveIndexOfMethodHeader: methodHeader
+ 	| primBits |
+ 	primBits := (self integerValueOf: methodHeader) bitAnd: 16r100001FF.
+ 	^(primBits bitAnd: 16r1FF) + (primBits >> 19)!

Item was added:
+ Object subclass: #SpurOldToNewMethodFormatMunger
+ 	instanceVariableNames: 'interpreter heap'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'VMObjectIndices'
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>convertOldMethodHeader: (in category 'munging') -----
+ convertOldMethodHeader: methodHeader
+ 	^heap integerObjectOf:
+ 		   ((interpreter argumentCountOfMethodHeader: methodHeader) << 24)
+ 		+ ((interpreter temporaryCountOfMethodHeader: methodHeader) << 18)
+ 		+ ((interpreter methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [1 << 17] ifFalse: [0])
+ 		+ ((heap primitiveIndexOfMethodHeader: methodHeader) > 0 ifTrue: [1 << 16] ifFalse: [0])
+ 		+ (heap literalCountOfMethodHeader: methodHeader)!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>incrementPCField:ofObject:by: (in category 'munging') -----
+ incrementPCField: fieldIndex ofObject: newObj by: n
+ 	| value |
+ 	value := heap fetchPointer: fieldIndex ofObject: newObj.
+ 	(heap isIntegerObject: value)
+ 		ifTrue:
+ 			[heap
+ 				storePointerUnchecked: fieldIndex
+ 				ofObject: newObj
+ 				withValue: (heap integerObjectOf: n + (heap integerValueOf: value))]
+ 		ifFalse:
+ 			[self assert: value = heap nilObject]!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>mapPCs (in category 'munging') -----
+ mapPCs
+ 	| cbc cmc |
+ 	cmc := 36.
+ 	cbc := 37.
+ 	heap allObjectsDo:
+ 		[:obj| | ci |
+ 		ci := heap classIndexOf: obj.
+ 		(ci <= 37 and: [ci >= 36]) ifTrue:
+ 			[ci = 37 ifTrue: [self mungeClosure: obj].
+ 			 ci = 36 ifTrue: [self mungeContext: obj]]]!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>munge: (in category 'public access') -----
+ munge: imageName
+ 	interpreter := StackInterpreterSimulator newWithOptions: #(ObjectMemory Spur32BitMemoryManager).
+ 	interpreter desiredNumStackPages: 4; initStackPages.
+ 	heap := interpreter objectMemory.
+ 	self assert: heap class == Spur32BitMMLESimulator.
+ 	SpurOldFormat32BitMMLESimulator adoptInstance: heap.
+ 	interpreter openOn: imageName extraMemory: 0.
+ 	self mapPCs.
+ 	self updateAndForwardMethods.
+ 	self snapshot!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>mungeClosure: (in category 'munging') -----
+ mungeClosure: obj
+ 	| method |
+ 	method := heap
+ 					fetchPointer: MethodIndex
+ 					ofObject: (heap
+ 								fetchPointer: ClosureOuterContextIndex
+ 								ofObject: obj).
+ 	(heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
+ 		[self incrementPCField: ClosureStartPCIndex ofObject: obj by: 3]!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>mungeContext: (in category 'munging') -----
+ mungeContext: obj
+ 	| method |
+ 	method := heap fetchPointer: MethodIndex ofObject: obj.
+ 	(heap primitiveIndexOfMethodHeader: (heap methodHeaderOf: method)) > 0 ifTrue:
+ 		[self incrementPCField: InstructionPointerIndex ofObject: obj by: 3]!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>mungePrimitiveMethod: (in category 'munging') -----
+ mungePrimitiveMethod: obj
+ 	| numBytes copy firstByteIndex primIndex numPointerSlots header |
+ 	numBytes := heap byteSizeOf: obj.
+ 	copy := heap allocateSlotsInOldSpace: (heap numSlotsForBytes: numBytes + 3)
+ 				format: (heap compiledMethodFormatForNumBytes: numBytes + 3)
+ 				classIndex: (heap classIndexOf: obj).
+ 	header := heap methodHeaderOf: obj.
+ 	numPointerSlots := (heap literalCountOfMethodHeader: header) + LiteralStart.
+ 	heap
+ 		storePointerUnchecked: 0
+ 		ofObject: copy
+ 		withValue: (self convertOldMethodHeader: header).
+ 	1 to: numPointerSlots - 1 do:
+ 		[:i|
+ 		heap storePointer: i
+ 			ofObject: copy
+ 			withValue: (heap fetchPointer: i ofObject: obj)].
+ 	primIndex := heap primitiveIndexOfMethodHeader: header.
+ 	firstByteIndex := numPointerSlots * heap bytesPerOop.
+ 	heap
+ 		storeByte: firstByteIndex + 0 ofObject: copy withValue: 139;
+ 		storeByte: firstByteIndex + 1 ofObject: copy withValue: (primIndex bitAnd: 255);
+ 		storeByte: firstByteIndex + 2 ofObject: copy withValue: (primIndex bitShift: -8).
+ 	firstByteIndex to: numBytes - 1 do:
+ 		[:i|
+ 		heap storeByte: i + 3 ofObject: copy withValue: (heap fetchByte: i ofObject: obj)].
+ 	heap forward: obj to: copy.
+ 	^copy!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>snapshot (in category 'saving') -----
+ snapshot
+ 	Spur32BitMMLESimulator adoptInstance: heap.
+ 	interpreter imageName: 'munged-', (FileDirectory default localNameFor: interpreter imageName).
+ 	[heap parent: heap; setCheckForLeaks: 15; fullGC; fullGC]
+ 		on: Halt
+ 		do: [:ex|
+ 			"suppress halts from the usual suspects (development time halts)"
+ 			(#(fullGC globalGarbageCollect) includes: ex signalerContext sender selector)
+ 				ifTrue: [ex resume]
+ 				ifFalse: [ex pass]].
+ 	interpreter halt; writeImageFileIO!

Item was added:
+ ----- Method: SpurOldToNewMethodFormatMunger>>updateAndForwardMethods (in category 'munging') -----
+ updateAndForwardMethods
+ 	| new now lastDotTime |
+ 	new := Set new: 1000.
+ 	lastDotTime := Time now asSeconds.
+ 	heap allObjectsDo:
+ 		[:obj|
+ 		obj = 16rAC9A30 ifTrue: [self halt].
+ 		((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)]]]!



More information about the Vm-dev mailing list