[Vm-dev] VM Maker: VMMaker.oscog-eem.1704.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Mar 2 02:06:22 UTC 2016


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

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

Name: VMMaker.oscog-eem.1704
Author: eem
Time: 1 March 2016, 6:04:07.799253 pm
UUID: 21fb8ca6-b62c-4c06-8144-bd8be0832a8d
Ancestors: VMMaker.oscog-eem.1703

Update primitiveFileRead for Spur.  It doesn't need the PrimErrObjectMayMove handling sicne Spur has pinning.

Allow the CurrentImageCoInterpreterFacade to print Cog methods (useful for looking at the methods generated during the pc mapping test).
Modify the facade's management of the headerToMethodMap so that methods are not flushed on each jit compile and asserts don't fail (compare method headers not methods).

=============== Diff against VMMaker.oscog-eem.1703 ===============

Item was added:
+ ----- Method: CoInterpreter>>setUpForUseByFacade: (in category 'debug support') -----
+ setUpForUseByFacade: aCurrentImageCoInterpreterFacade
+ 	"Set up variables with default values so that other initializations work.
+ 	 numStackPages needs to be initialized so that interpreterAllocationReserveBytes
+ 	 can be computed."
+ 	numStackPages := 0!

Item was changed:
  ----- Method: Cogit class>>cog:selector:options: (in category 'in-image compilation') -----
  cog: aCompiledMethod selector: aSelector options: optionsDictionaryOrArray
  	"StackToRegisterMappingCogit cog: (Integer >> #benchFib) selector: #benchFib options: #(COGMTVM false)"
+ 	| cogit coInterpreter |
+ 	cogit := self instanceForTests: optionsDictionaryOrArray.
+ 	coInterpreter := CurrentImageCoInterpreterFacade forCogit: cogit.
- 	| initOptions coInterpreter cogit |
- 	initOptions := self asOptionsDictionary: optionsDictionaryOrArray.
- 	CoInterpreter initializeWithOptions: initOptions.
- 	CoInterpreter objectMemoryClass initializeWithOptions: initOptions.
- 	self initializeWithOptions: initOptions.
- 	coInterpreter := CurrentImageCoInterpreterFacade forCogit: (cogit := self new).
  	[cogit
  		setInterpreter: coInterpreter;
  		singleStep: true;
  		initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size / 2. "leave space for rump C stack"
  	 cogit methodZone freeStart: (cogit methodZone freeStart roundUpTo: 1024)]
  		on: Notification
  		do: [:ex|
  			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
  				[ex resume: coInterpreter].
  			ex pass].
  	^{ coInterpreter.
  		cogit.
  		cogit cog: (coInterpreter oopForObject: aCompiledMethod) selector: (coInterpreter oopForObject: aSelector) }!

Item was changed:
  ----- Method: Cogit class>>genAndDisPICoptions: (in category 'in-image compilation') -----
  genAndDisPICoptions: optionsDictionaryOrArray
  	"StackToRegisterMappingCogit genAndDisPICoptions: #(ISA ARMv5 CogCompilerClass CogInLineLiteralsARMCompiler)"
+ 	| cogit coInterpreter |
+ 	cogit := self instanceForTests: optionsDictionaryOrArray.
+ 	coInterpreter := CurrentImageCoInterpreterFacade forCogit: cogit.
- 	| coInterpreter cogit |
- 	self initializeWithOptions: (self asOptionsDictionary: optionsDictionaryOrArray).
- 	CoInterpreter initializeWithOptions: initializationOptions.
- 	CoInterpreter objectMemoryClass initializeWithOptions: initializationOptions.
- 	coInterpreter := CurrentImageCoInterpreterFacade forCogit: (cogit := self new).
  	[cogit
  		setInterpreter: coInterpreter;
  		singleStep: true;
  		initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size / 2. "leave space for rump C stack"
  	 cogit methodZone freeStart: (cogit methodZone freeStart roundUpTo: 1024)]
  		on: Notification
  		do: [:ex|
  			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
  				[ex resume: coInterpreter]].
  	cogit disassembleFrom: cogit cPICPrototype + (cogit sizeof: CogMethod) to: cogit cPICPrototype + cogit closedPICSize!

Item was added:
+ ----- Method: Cogit class>>instanceForTests: (in category 'in-image compilation') -----
+ instanceForTests: optionsDictionaryOrArray
+ 	"Initialize all the relevant classes from the options and answer a new instance of me."
+ 	| initOptions |
+ 	initOptions := self asOptionsDictionary: optionsDictionaryOrArray.
+ 	CoInterpreter initializeWithOptions: initOptions.
+ 	CoInterpreter objectMemoryClass initializeWithOptions: initOptions.
+ 	self initializeWithOptions: initOptions.
+ 	^self new!

Item was changed:
  ----- Method: Cogit class>>testPCMappingSelect:options: (in category 'tests') -----
  testPCMappingSelect: aBlock options: optionsDictionaryOrArray
  	"Test pc mapping both ways using a selection of the methods in the current image."
  	| cogit coInterpreter |
+ 	cogit := self instanceForTests: optionsDictionaryOrArray.
- 	self initializeWithOptions: (self asOptionsDictionary: optionsDictionaryOrArray).
- 	cogit := self new.
  	coInterpreter := CurrentImageCoInterpreterFacade forCogit: cogit.
  	[cogit
  			setInterpreter: coInterpreter;
  			singleStep: true;
  			initializeCodeZoneFrom: 1024 upTo: coInterpreter memory size]
  		on: Notification
  		do: [:ex|
  			(ex messageText beginsWith: 'cannot find receiver for') ifTrue:
  				[ex resume: coInterpreter]].
  	SystemNavigation new allSelect:
  		[:m| | cm |
  		(m isQuick not
  		 and: [aBlock value: m]) ifTrue:
+ 			[Transcript nextPut: $.; flush.
- 			[coInterpreter voidHeaderToMethodMap.
- 			 Transcript nextPut: $.; flush.
  			 [coInterpreter.
  			  cm := cogit
  						cog: (coInterpreter oopForObject: m)
  						selector: (coInterpreter oopForObject: m selector).
  			   cm isNil and: [coInterpreter isCogCompiledCodeCompactionCalledFor]] whileTrue:
  				[cogit methodZone clearCogCompiledCode.
  				 coInterpreter clearCogCompiledCodeCompactionCalledFor.
  				 coInterpreter initializeObjectMap].
  			 cogit testPCMappingForCompiledMethod: m cogMethod: cm].
  		 false]!

Item was changed:
  CogClass subclass: #CurrentImageCoInterpreterFacade
  	instanceVariableNames: 'memory cogit coInterpreter objectMemory objectMap headerToMethodMap cachedObject cachedOop variables'
  	classVariableNames: ''
+ 	poolDictionaries: 'CogMethodConstants VMBasicConstants VMObjectIndices VMSqueakClassIndices'
- 	poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakClassIndices'
  	category: 'VMMaker-Support'!
  
  !CurrentImageCoInterpreterFacade commentStamp: 'eem 8/6/2014 14:59' prior: 0!
  A CurrentImageCoInterpreterFacade is a stand-in for an object memory (ObjectMemory, SpurMemoryManager, etc) that allows the Cogits to access image objects as if they were in the simulator VM's heap.  hence it allows the Cogits to generate code for methdos in the current image, for testing, etc.
  
  Instance Variables
  	cachedObject:			<Object>
  	cachedOop:			<Integer>
  	coInterpreter:			<CoInterpreter>
  	cogit:					<Cogit>
  	headerToMethodMap:	<Dictionary>
  	memory:				<ByteArray>
  	objectMap:				<IdentityDictionary>
  	objectMemory:			<NewObjectMemory|SpurMemoryManager>
  	variables:				<Dictionary>
  
  cachedObject
  	- the object matching cachedOop, to speed-up oop to obejct mapping
  
  cachedOop
  	- the last used oop
  
  coInterpreter
  	- the CoInterpreter simulator used by the cogit.
  
  cogit
  	- the code egnerator in use
  
  headerToMethodMap
  	- a map from header to CompiledMethod
  
  memory
  	- a rump memory for holding various interpreter variables (e.g. stackLimit) that are accessed as memory locations by generated code
  
  objectMap
  	- map from objects to their oops
  
  objectMemory
  	- the object memory used to encode various values, answer queries, etc
  
  variables
  	- a map from the names of variables to their addresses in memory
  !

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>cogit: (in category 'initialize-release') -----
  cogit: aCogit
  	cogit := aCogit.
  	cogit objectMemory ifNil:
  		[cogit instVarNamed: 'objectMemory' put: objectMemory].
  	coInterpreter cogit: aCogit.
  	(objectMemory respondsTo: #cogit:) ifTrue:
  		[objectMemory cogit: aCogit].
  	(objectMemory respondsTo: #coInterpreter:) ifTrue:
  		[objectMemory coInterpreter: coInterpreter].
+ 	coInterpreter setUpForUseByFacade: self.
+ 	objectMemory setUpForUseByFacade: self.
  	#('stackLimit') do:
  		[:l| self addressForLabel: l].
  	self initializeObjectMap!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>initialPCForHeader:method: (in category 'accessing') -----
- initialPCForHeader: methodHeaderOop method: aMethodOop
- 	self assert: (self objectForOop: aMethodOop) == (headerToMethodMap at: methodHeaderOop).
- 	^{ self objectForOop: aMethodOop. (self objectForOop: aMethodOop) initialPC }!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>printCogMethod: (in category 'printing') -----
+ printCogMethod: cogMethod
+ 	| address primitive |
+ 	address := cogMethod asInteger.
+ 	self printHex: address;
+ 		print: ' <-> ';
+ 		printHex: address + cogMethod blockSize.
+ 	cogMethod cmType = CMMethod ifTrue:
+ 		[self print: ': method: ';
+ 			printHex: cogMethod methodObject.
+ 		 primitive := self primitiveIndexOfMethod: cogMethod methodObject
+ 							header: cogMethod methodHeader.
+ 		 primitive ~= 0 ifTrue:
+ 			[self print: ' prim '; printNum: primitive]].
+ 	cogMethod cmType = CMBlock ifTrue:
+ 		[self print: ': block home: ';
+ 			printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger].
+ 	cogMethod cmType = CMClosedPIC ifTrue:
+ 		[self print: ': Closed PIC N: ';
+ 			printHex: cogMethod cPICNumCases].
+ 	cogMethod cmType = CMOpenPIC ifTrue:
+ 		[self print: ': Open PIC '].
+ 	self print: ' selector: '; printHex: cogMethod selector.
+ 	cogMethod selector = objectMemory nilObject
+ 		ifTrue: [self print: ' (nil)']
+ 		ifFalse: [self space; printStringOf: cogMethod selector].
+ 	self cr!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>printStringOf: (in category 'printing') -----
+ printStringOf: anOop
+ 	Transcript nextPutAll: (self objectForOop: anOop)!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>rawHeaderOf: (in category 'accessing') -----
  rawHeaderOf: aMethodOop
  	| method headerOop |
  	method := self objectForOop: aMethodOop.
  	headerOop := objectMemory integerObjectOf: (self objectForOop: aMethodOop) header.
+ 	self assert: method header = (headerToMethodMap at: headerOop ifAbsentPut: [method]) header.
- 	self assert: method = (headerToMethodMap at: headerOop ifAbsentPut: [method]).
  	^headerOop!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>space (in category 'printing') -----
+ space
+ 	Transcript space!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>voidHeaderToMethodMap (in category 'accessing') -----
- voidHeaderToMethodMap
- 	headerToMethodMap := Dictionary new!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileRead (in category 'file primitives') -----
  primitiveFileRead
  	<export: true>
+ 	self cppIf: SPURVM
+ 		ifTrue: [self primitiveFileReadWithPinning]
+ 		ifFalse: [self primitiveFileReadWithoutPinning]!
- 	| retryCount count startIndex array file elementSize bytesRead |
- 	<var: 'file' type: #'SQFile *'>
- 	<var: 'count' type: #'size_t'>
- 	<var: 'startIndex' type: #'size_t'>
- 	<var: 'elementSize' type: #'size_t'>
- 
- 	retryCount	:= 0.
- 	count		:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
- 	startIndex	:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
-  
- 	[array		:= interpreterProxy stackValue: 2.
- 	 file			:= self fileValueOf: (interpreterProxy stackValue: 3).
- 
- 	 (interpreterProxy failed
- 	 "buffer can be any indexable words or bytes object except CompiledMethod"
- 	 or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- 
- 	 elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
- 	 (startIndex >= 1
- 	  and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
- 		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
- 
- 	 "Note: adjust startIndex for zero-origin indexing"
- 	 bytesRead := self
- 					sqFile: file
- 					Read: count * elementSize
- 					Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
- 					At: (startIndex - 1) * elementSize.
- 	 interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
- 	 and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
- 		[interpreterProxy
- 			tenuringIncrementalGC;
- 			primitiveFailFor: PrimNoErr].
- 	interpreterProxy failed ifFalse:
- 		[interpreterProxy
- 			pop: 5 "pop rcvr, file, array, startIndex, count"
- 			thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!

Item was added:
+ ----- Method: FilePlugin>>primitiveFileReadWithPinning (in category 'file primitives') -----
+ primitiveFileReadWithPinning
+ 	"This version of primitiveFileRead is for garbage collectors that support pinning."
+ 	| count startIndex array file elementSize bytesRead |
+ 	<inline: true>
+ 	<var: 'file' type: #'SQFile *'>
+ 	<var: 'count' type: #'size_t'>
+ 	<var: 'startIndex' type: #'size_t'>
+ 	<var: 'elementSize' type: #'size_t'>
+ 	count		:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
+ 	startIndex	:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
+  	array		:= interpreterProxy stackValue: 2.
+ 	file			:= self fileValueOf: (interpreterProxy stackValue: 3).
+ 
+ 	(interpreterProxy failed
+ 	"buffer can be any indexable words or bytes object except CompiledMethod"
+ 	 or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 
+ 	elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
+ 	(startIndex >= 1
+ 	 and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 
+ 	"Note: adjust startIndex for zero-origin indexing"
+ 	bytesRead := self
+ 					sqFile: file
+ 					Read: count * elementSize
+ 					Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ 					At: (startIndex - 1) * elementSize.
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy
+ 			pop: 5 "pop rcvr, file, array, startIndex, count"
+ 			thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!

Item was added:
+ ----- Method: FilePlugin>>primitiveFileReadWithoutPinning (in category 'file primitives') -----
+ primitiveFileReadWithoutPinning
+ 	"This version of primitiveFileRead is for garbage collectors without support for pinning."
+ 	| retryCount count startIndex array file elementSize bytesRead |
+ 	<inline: true>
+ 	<var: 'file' type: #'SQFile *'>
+ 	<var: 'count' type: #'size_t'>
+ 	<var: 'startIndex' type: #'size_t'>
+ 	<var: 'elementSize' type: #'size_t'>
+ 	retryCount	:= 0.
+ 	count		:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
+ 	startIndex	:= interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
+  
+ 	[array		:= interpreterProxy stackValue: 2.
+ 	 file			:= self fileValueOf: (interpreterProxy stackValue: 3).
+ 
+ 	 (interpreterProxy failed
+ 	 "buffer can be any indexable words or bytes object except CompiledMethod"
+ 	 or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 
+ 	 elementSize := (interpreterProxy isWords: array) ifTrue: [4] ifFalse: [1].
+ 	 (startIndex >= 1
+ 	  and: [(startIndex + count - 1) <= (interpreterProxy slotSizeOf: array)]) ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ 
+ 	 "Note: adjust startIndex for zero-origin indexing"
+ 	 bytesRead := self
+ 					sqFile: file
+ 					Read: count * elementSize
+ 					Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ 					At: (startIndex - 1) * elementSize.
+ 	 interpreterProxy primitiveFailureCode = PrimErrObjectMayMove
+ 	 and: [(retryCount := retryCount + 1) <= 2] "Two objects, the file and the array can move"] whileTrue:
+ 		[interpreterProxy
+ 			tenuringIncrementalGC;
+ 			primitiveFailFor: PrimNoErr].
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy
+ 			pop: 5 "pop rcvr, file, array, startIndex, count"
+ 			thenPush:(interpreterProxy integerObjectOf: bytesRead // elementSize)  "push # of elements read"]!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>setUpForUseByFacade: (in category 'debug support') -----
+ setUpForUseByFacade: aCurrentImageCoInterpreterFacade
+ 	"This is a noop"!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>setUpForUseByFacade: (in category 'debug support') -----
+ setUpForUseByFacade: aCurrentImageCoInterpreterFacade
+ 	"Make sure that eden etc are initialized, so that methods can be printed.
+ 	 This is really to make addressCouldBeObj: et al work."
+ 	self edenBytes: 0.
+ 	self setHeapBase: self freeStart
+ 		memoryLimit: self endOfMemory
+ 		endOfMemory: self endOfMemory!



More information about the Vm-dev mailing list