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

commits at source.squeak.org commits at source.squeak.org
Fri Aug 1 08:48:51 UTC 2014


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

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

Name: Cog-eem.177
Author: eem
Time: 31 July 2014, 10:48:21.716 pm
UUID: c93172a9-43d7-4591-b624-ffb06e5ded82
Ancestors: Cog-eem.176

SpurBootstrap:
Support different prototypes of the same method for Pharo
and Squeak.

Allow a trailing .image on the image name.

Use hex in the debugger.

Allow prototypes on missing classes.

Use bigger eden and smaller stack zone, and turn off
assertValidExecutionPointersAtEachStep for Spur image.

Tidy up report.

Needs VMMaker.oscog-eem.840

=============== Diff against Cog-eem.176 ===============

Item was changed:
  ----- Method: SpurBootstrap class>>bootstrapImage:type: (in category 'utilities') -----
+ bootstrapImage: imageFileNameOrBaseName type: typeName
- bootstrapImage: imageFileBaseName type: typeName
  	"SpurBootstrap bootstrapImage: '/Users/eliot/Squeak/Squeak4.5/Squeak4.5-13680'"
+ 	| imageFileBaseName imageFormat |
+ 	imageFileBaseName := (imageFileNameOrBaseName endsWith: '.image')
+ 								ifTrue: [imageFileNameOrBaseName allButLast: 6]
+ 								ifFalse: [imageFileNameOrBaseName].
- 	| imageFormat |
  	imageFormat := ImageFormat fromFile: imageFileBaseName, '.image'.
  	imageFormat requiresClosureSupport ifFalse:
  		[self error: 'Can''t bootstrap this image since Spur assumes closure support.'].
  	imageFormat requiresSpurSupport ifTrue:
  		[self error: 'This image is already in Spur format.'].
  	imageFormat is32Bit ifTrue:
+ 		[^SpurBootstrap32 new bootstrapImage: imageFileBaseName type: typeName].
- 		[^ SpurBootstrap32 new bootstrapImage: imageFileBaseName type: typeName ].
  	self error: '64-bit support and 64-bit generation as-yet-unimplemented'!

Item was added:
+ ----- Method: SpurBootstrap class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
+ defaultIntegerBaseInDebugger
+ 	^16!

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:
+ 				[:class|
+ 				symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
+ 				self prototypeClassNameMetaSelectorMethodDo:
+ 					[:className :isMeta :selector :method| | methodOrNil |
+ 					(className = sym
+ 					 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
- 		[:sym :symIsMeta| | class |
- 		class := self findClassNamed: (literalMap at: sym).
- 		symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
- 		self prototypeClassNameMetaSelectorMethodDo:
- 			[:className :isMeta :selector :method| | methodOrNil |
- 			(className = sym
- 			 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: 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)]]]]]!
- 									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 changed:
  ----- Method: SpurBootstrap>>interpreter:object:perform:withArguments: (in category 'bootstrap methods') -----
  interpreter: sim object: receiver perform: selector withArguments: arguments
  	"Interpret an expression in oldHeap using oldInterpreter.
  	 Answer the result."
  	| fp savedpc savedsp result startByteCount |
+ 	self assert: ({receiver. selector}, arguments allSatisfy:
+ 					[:oop| oop isInteger and: [sim objectMemory addressCouldBeOop: oop]]).
  	savedpc := sim localIP.
  	savedsp := sim localSP.
  	sim internalPush: receiver.
  	arguments do: [:arg| sim internalPush: arg].
  	sim
  		argumentCount: arguments size;
  		messageSelector: selector.
  	fp := sim localFP.
  	startByteCount := sim byteCount.
  	"sim byteCount = 66849 ifTrue: [self halt]."
  	sim normalSend.
  	sim incrementByteCount. "otherwise, send is not counted"
  	["sim printFrame: sim localFP WithSP: sim localSP"
  	 "sim setBreakSelector: #elementsForwardIdentityTo:"
  	 "sim byteCount = 66849 ifTrue: [self halt]."
  	 "(sim byteCount > 7508930 and: [sim localFP = -16r27894]) ifTrue:
  		[self halt]."
  	 fp = sim localFP] whileFalse:
  		[sim singleStep].
  	result := sim internalPopStack.
  	self assert: savedsp = sim localSP.
  	self assert: sim localIP - 1 = savedpc.
  	sim localIP: savedpc.
  	^result!

Item was changed:
  ----- Method: SpurBootstrap>>on: (in category 'initialize-release') -----
  on: imageName
  	StackInterpreter initializeWithOptions: Dictionary new.
  	(oldInterpreter := StackInterpreterSimulator new)
  		openOn: imageName extraMemory: 0;
  		assertValidExecutionPointersAtEachStep: false.
  	oldHeap := oldInterpreter objectMemory.
  	newHeap := Spur32BitMMLESimulator new.
  	newHeap
  		allocateMemoryOfSize: (oldHeap youngStart * 3 / 2 roundUpTo: 1024 * 1024)
+ 		newSpaceSize: 4 * 1024 * 1024
+ 		stackSize: 16 * 1024
- 		newSpaceSize: 2 * 1024 * 1024
- 		stackSize: 1024 * 1024
  		codeSize: 0.
  	newHeap setCheckForLeaks: 15 - 6. "don't check become; or newSpace; soooo many rehashes in bootstrap"
  	newHeap bootstrapping: true.
  	self initMaps!

Item was changed:
  ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
  rehashImage
  	"Rehash all collections in newHeap.
  	 Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
  	 Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
  	| n sim rehashFlags |
  	sim := StackInterpreterSimulator onObjectMemory: newHeap.
  	sim 
  		setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
+ 		imageName: 'spur image';
+ 		assertValidExecutionPointersAtEachStep: false..
- 		imageName: 'spur image'.
  	newHeap coInterpreter: sim.
  	sim bootstrapping: true.
  	sim initializeInterpreter: 0.
  	sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
  
  	newHeap
  		setHashBitsOf: newHeap nilObject to: 1;
  		setHashBitsOf: newHeap falseObject to: 2;
  		setHashBitsOf: newHeap trueObject to: 3.
  
  	rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
  	n := 0.
  	newHeap classTableObjectsDo:
  		[:class| | classIndex |
  		sim messageSelector: (map at: rehashSym).
  		"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
  		((sim lookupMethodNoMNUEtcInClass: class) = 0
  		 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
  			[n := n + 1.
  			 classIndex := newHeap rawHashBitsOf: class.
  			 rehashFlags
  				at: classIndex >> 3 + 1
  				put: ((rehashFlags at: classIndex >> 3 + 1)
  						bitOr: (1 << (classIndex bitAnd: 7)))]].
  	Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
  	n := 0.
  	self withExecutableInterpreter: sim
  		do: [sim setBreakSelector: 'error:'.
  			 "don't rehash twice (actually without limit), so don't rehash any new objects created."
  			 newHeap allExistingOldSpaceObjectsDo:
  				[:o| | classIndex |
  				classIndex := newHeap classIndexOf: o.
  				((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
+ 					[(n := n + 1) \\ 16 = 0 ifTrue:
- 					[(n := n + 1) \\ 8 = 0 ifTrue:
  					 	[Transcript nextPut: $.; flush].
  					 "2845 = n ifTrue: [self halt]."
  					 "Rehash an object if its size is > 0.
  					  Symbol implements rehash, but let's not waste time rehashing it; in Squeak
  					  up to 2013 symbols are kept in a set which will get reashed anyway..
  					  Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
  					 ((sim addressCouldBeClassObj: o)
  					   or: [(self interpreter: sim
  							object: o
  							perform: (map at: sizeSym)
  							withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
  						[self interpreter: sim
  							object: o
  							perform: (map at: rehashSym)
  							withArguments: #()]]]]!

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:
+ 				[:class|
+ 				symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
+ 				self prototypeClassNameMetaSelectorMethodDo:
+ 					[:className :isMeta :selector :method| | replacement methodDict index |
+ 					(className = sym
+ 					 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]]]]]!
- 		[:sym :symIsMeta| | class |
- 		class := self findClassNamed: (literalMap at: sym).
- 		symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
- 		self prototypeClassNameMetaSelectorMethodDo:
- 			[:className :isMeta :selector :method| | replacement methodDict index |
- 			(className = sym
- 			 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]]]]!

Item was changed:
  ----- Method: SpurBootstrap>>reportSizes (in category 'bootstrap image') -----
  reportSizes
  	| change oldAvgBytes newAvgBytes |
  	change := newHeapSize - oldHeapSize / oldHeapSize.
  	oldAvgBytes := oldHeapSize asFloat / oldHeapNumObjs.
  	Transcript
  		nextPutAll: 'done.'; cr;
+ 		nextPutAll: 'old heap size: '; nextPutAll: oldHeapSize asStringWithCommas; tab;
+ 		nextPutAll: ' (avg obj bytes '; print: oldAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: oldAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
+ 		nextPutAll: 'initial new heap size: '; nextPutAll: newHeapSize asStringWithCommas; cr;
+ 		nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
- 		nextPutAll: 'old heap size: '; print: oldHeapSize; tab;
- 		nextPutAll: ' (avg obj bytes '; print: (oldAvgBytes roundTo: 0.01); nextPutAll: ' words '; print: (oldAvgBytes / self wordSize roundTo: 0.01); nextPut: $); cr;
- 		nextPutAll: 'initial new heap size: '; print: newHeapSize; cr;
- 		nextPutAll: 'change: '; print: (change * 100.0 roundTo: 0.01); nextPut: $%; cr;
  		flush.
  	newHeapSize := newHeap endOfMemory
  					- newHeap scavenger eden limit
  					- newHeap totalFreeListBytes.
  	change := newHeapSize - oldHeapSize / oldHeapSize.
  	newAvgBytes := newHeapSize asFloat / newHeapNumObjs.
  	Transcript
+ 		nextPutAll: 'final new heap size: '; nextPutAll: newHeapSize asStringWithCommas; tab;
+ 		nextPutAll: ' (avg obj bytes '; print: newAvgBytes maxDecimalPlaces: 2; nextPutAll: ' words '; print: newAvgBytes / self wordSize maxDecimalPlaces: 2; nextPut: $); cr;
+ 		nextPutAll: 'change: '; print: change * 100.0 maxDecimalPlaces: 2; nextPut: $%; cr;
- 		nextPutAll: 'final new heap size: '; print: newHeapSize; tab;
- 		nextPutAll: ' (avg obj bytes '; print: (newAvgBytes roundTo: 0.01); nextPutAll: ' words '; print: (newAvgBytes / self wordSize roundTo: 0.01); nextPut: $); cr;
- 		nextPutAll: 'change: '; print: (change * 100.0 roundTo: 0.01); nextPut: $%; cr;
  		flush!



More information about the Vm-dev mailing list