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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 16 16:07:15 UTC 2013


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

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

Name: Cog-eem.87
Author: eem
Time: 16 September 2013, 9:07:03.261 am
UUID: a605b782-2c58-423e-a78a-9642beea261d
Ancestors: Cog-eem.86

Scavenge the image post bootstrap (not that it gets that far yet...)

=============== Diff against Cog-eem.86 ===============

Item was changed:
  Object subclass: #SpurBootstrap
  	instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage symbolMap methodClasses installedPrototypes sizeSym rehashSym'
+ 	classVariableNames: 'NewInterpreter TransformedImage'
- 	classVariableNames: 'TransformedImage'
  	poolDictionaries: 'VMObjectIndices'
  	category: 'Cog-Bootstrapping'!
  
  !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
  SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.
  
  e.g.
  	(SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
  		transform;
  		launch
  
  Bootstrap issues:
  - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
    based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
  - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?
  
  Instance Variables
  	classToIndex:			<Dictionary>
  	lastClassTablePage:	<Integer>
  	map:					<Dictionary>
  	methodClasses:		<Set>
  	newHeap:				<SpurMemoryManager>
  	oldHeap:				<NewObjectMemory>
  	oldInterpreter:			<StackInterpreterSimulator>
  	reverseMap:			<Dictionary>
  	symbolMap:				<Dictionary>
  
  classToIndex
  	- oldClass to new classIndex map
  
  lastClassTablePage
  	- oop in newHeap of last classTable page.  U<sed in validation to filter-out class table.
  
  methodClasses
  	- cache of methodClassAssociations for classes in which modified methods are installed
  
  map
  	- oldObject to newObject map
  
  newHeap
  	- the output, bootstrapped image
  
  oldHeap
  	- the input, image
  
  oldInterpreter
  	- the interpreter associated with oldHeap, needed for a hack to grab WeakArray
  
  reverseMap
  	- newObject to oldObject map
  
  symbolMap
  	- symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!

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 |
- 	| fp savedpc result |
  	savedpc := sim localIP.
+ 	savedsp := sim localSP.
  	sim internalPush: receiver.
  	arguments do: [:arg| sim internalPush: arg].
  	sim
  		argumentCount: arguments size;
  		messageSelector: selector.
  	fp := sim localFP.
  	sim normalSend.
  	[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>>launch: (in category 'testing') -----
  launch: heap
  	| sim |
  	sim := StackInterpreterSimulator onObjectMemory: heap.
  	heap coInterpreter: sim.
- 	sim initializeInterpreter: 0.
  	sim
+ 		initializeInterpreter: 0;
+ 		transcript: Transcript. "deep copy copies this"
+ 	sim
  		instVarNamed: 'printSends' put: true;
  		instVarNamed: 'printReturns' put: true;
  		instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal. "for now"
  	sim run!

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.
  	newHeap coInterpreter: sim.
  	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 classTableIndex + 7 // 8.
  	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: "don't rehash twice (actually without limit), so don't rehash any new objects created."
  			[newHeap allExistingObjectsDo:
  				[:o| | classIndex |
  				classIndex := newHeap classIndexOf: o.
  				((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
+ 					[(n := n + 1) \\ 8 = 0 ifTrue:
+ 					 	[Transcript nextPut: $.; flush].
- 					[n := n + 1.
- 					 Transcript nextPut: $.; flush.
  					 (self interpreter: sim
  							object: o
  							perform: (map at: sizeSym)
  							withArguments: #()) ~= (newHeap integerObjectOf: 0) ifTrue:
  						[self interpreter: sim
  							object: o
  							perform: (map at: rehashSym)
  							withArguments: #()]]]]!

Item was changed:
  ----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') -----
  saveTransformedImage
+ 	newHeap coInterpreter: nil.
  	TransformedImage := newHeap veryDeepCopy!

Item was added:
+ ----- Method: SpurBootstrap>>scavengeImage (in category 'bootstrap image') -----
+ scavengeImage
+ 	"Scavenge the image to get it into a simpler state."
+ 	newHeap coInterpreter voidVMStateForSnapshot.
+ 	newHeap sufficientSpaceAfterGC: 0!

Item was changed:
  ----- Method: SpurBootstrap>>transform (in category 'bootstrap image') -----
  transform
  	self rememberRehashSymbol.
  	self installModifiedMethods.
  	self bootstrapImage.
  	self validate.
  	self rehashImage.
+ 	self scavengeImage.
  	self followForwardingPointers.
  	Transcript nextPutAll: 'done.'; flush.!



More information about the Vm-dev mailing list