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

commits at source.squeak.org commits at source.squeak.org
Wed Aug 27 13:55:25 UTC 2014


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

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

Name: Cog-eem.198
Author: eem
Time: 27 August 2014, 2:55:09.655 pm
UUID: c2460750-90b8-4b00-801e-e2d4e6ef07d2
Ancestors: Cog-eem.197

Spur bootstrap:
Merge with changes from Esteban to ignore changes to
missing classes (e.g. COntext in Squeak and ContextPart &
MethodContext in Pharo 4).

Do not create replacement Character methods for Character
methods already installed (keep an installedMethodOops set).

=============== Diff against Cog-eem.197 ===============

Item was changed:
  SimulatorHarness subclass: #SpurBootstrap
+ 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes installedMethodOops classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex toBeInitialized'
- 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes classMetaclass imageTypes classMethodContextIndex classBlockClosureIndex toBeInitialized'
  	classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize 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>>addMissingClassVars: (in category 'bootstrap image') -----
  addMissingClassVars: classVars
  	"Add any missing class vars given classVars, a Dictionary from nonMetaClass to binding.
  	 Initialize any classes that get inst vars added."
  	| addClassVarNameSym bindingOfSym |
  	classVars isEmpty ifTrue:
  		[^self].
  	addClassVarNameSym := self findSymbol: #addClassVarName:.
+ 	addClassVarNameSym ifNil: 
+ 		[addClassVarNameSym := self findSymbol: #addClassVarNamed:].
  	bindingOfSym := self findSymbol: #bindingOf:.
  	classVars keysAndValuesDo:
  		[:binding :class| 
  		Transcript cr;  nextPutAll: 'ADDING CLASS VAR '; store: binding key; nextPutAll: ' TO '; print: class; flush.
  		self interpreter: oldInterpreter
  			object: (self oldClassOopFor: class)
  			perform: addClassVarNameSym
  			withArguments: {oldHeap stringForCString: binding key}.
  		literalMap
  			at: binding
  			put: (self interpreter: oldInterpreter
  					object: (self oldClassOopFor: class)
  					perform: bindingOfSym
  					withArguments: {self findSymbol: binding key})].
  	toBeInitialized := classVars asSet!

Item was changed:
  ----- Method: SpurBootstrap>>checkReshapeOf: (in category 'bootstrap image') -----
  checkReshapeOf: ourMethodClasses
  	"Check the shape of all our method classes match the shape of those in the image to be bootstrapped.
  	 Use the simulator to redefine any that need it.  Does /not/ reshape metaclasses; these we assume are ok."
  	| toReshape |
  	toReshape := Set new.
  	ourMethodClasses do:
+ 		[:mc|
+ 		(literalMap at: mc binding ifAbsent: []) ifNotNil:
+ 			[:binding|
+ 			(mc ~~ Character "Character will reshape anyway"
+ 			 and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
+ 				[toReshape add: mc]]].
- 		[:mc| | binding |
- 		binding := literalMap at: mc binding.
- 		self assert: binding ~= oldHeap nilObject.
- 		(mc ~~ Character "Character will reshape anyway"
- 		 and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
- 			[toReshape add: mc]].
  	toReshape isEmpty ifTrue:
  		[^self].
  	"Assume only one class in any subtree needs reshaping.  Fast and loose but gets us there for now."
  	toReshape copy do:
  		[:class|
  		toReshape removeAll: (toReshape select: [:ea| ea inheritsFrom: class])].
  	toReshape do:
  		[:class|
  		Transcript cr;  nextPutAll: 'RESHAPING '; print: class; flush.
  		self interpreter: oldInterpreter
  			object: (self oldClassOopFor: Compiler)
  			perform: (self findSymbol: #evaluate:)
  			withArguments: {oldHeap stringForCString: class definition}]!

Item was changed:
  ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
  findRequiredGlobals
  	"Look for the necessary gobal bindings in the prototype methods in the old image.
  	 This has to be done early by sending bindingOf: to Smalltalk.  Collect the class
  	 hierarchy of all prototypes that access inst vars (non-local prototypes) to check
  	 their shapes.  Also find out Metaclass, needed for identifying classes."
  	| globals ourMethodClasses classVars bindingOfSym |
  	globals := Set new.
  	ourMethodClasses := Set new.
  	classVars := Dictionary new.
  	self prototypeClassNameMetaSelectorMethodDo:
+ 		[:c :m :s :method| | allNonMetaSupers |
+ 		(Smalltalk classNamed: c) ifNotNil:
+ 			[ :nonMetaClass|
+ 			allNonMetaSupers := nonMetaClass withAllSuperclasses.
+ 			method methodClass ~= SpurBootstrap class ifTrue:
+ 				[ourMethodClasses addAll: allNonMetaSupers].
+ 			globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
+ 			method literals do:
+ 				[:l|
+ 				(l isVariableBinding and: [l key isSymbol]) ifTrue:
+ 					[(Smalltalk bindingOf: l key) == l
+ 						ifTrue: [globals add: l]
+ 						ifFalse:
+ 							[self assert: (nonMetaClass bindingOf: l key) == l.
+ 							classVars at: l put: nonMetaClass]]]]].
- 		[:c :m :s :method| | nonMetaClass allNonMetaSupers |
- 		allNonMetaSupers := (nonMetaClass := Smalltalk classNamed: c) withAllSuperclasses.
- 		method methodClass ~= SpurBootstrap class ifTrue:
- 			[ourMethodClasses addAll: allNonMetaSupers].
- 		globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
- 		method literals do:
- 			[:l|
- 			(l isVariableBinding and: [l key isSymbol]) ifTrue:
- 				[(Smalltalk bindingOf: l key) == l
- 					ifTrue: [globals add: l]
- 					ifFalse:
- 						[self assert: (nonMetaClass bindingOf: l key) == l.
- 						classVars at: l put: nonMetaClass]]]].
  	globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
  	bindingOfSym := self findSymbol: #bindingOf:.
  	self withExecutableInterpreter: oldInterpreter
  		do:	[| toBeAdded |
  			globals do:
  				[:global| | bindingOop |
  				bindingOop := self interpreter: oldInterpreter
  									object: (oldHeap splObj: 8) "Smalltalk"
  									perform: bindingOfSym
  									withArguments: {self findSymbol: global key}.
+ 				bindingOop ~= oldHeap nilObject ifTrue:
+ 					[literalMap at: global put: bindingOop]].
- 				self assert: bindingOop ~= oldHeap nilObject.
- 				literalMap at: global put: bindingOop].
  			 toBeAdded := Dictionary new.
  			 classVars keysAndValuesDo:
  				[:var :class| | val |
  				(self findSymbol: var key) "New class inst vars may not yet be interned."
  					ifNil: [toBeAdded at: var put: class]
  					ifNotNil:
  						[:varName|
  						val := self interpreter: oldInterpreter
  									object: (self oldClassOopFor: class)
  									perform: bindingOfSym
  									withArguments: {varName}.
  						val ~= oldHeap nilObject
  							ifTrue: [literalMap at: var put: val]
  							ifFalse: [toBeAdded at: var put: class]]].
  			"May have to redefine to add missing inst vars and/or add any missing class vars."
  			self checkReshapeOf: ourMethodClasses.
  			self addMissingClassVars: toBeAdded]!

Item was changed:
  ----- Method: SpurBootstrap>>initMaps (in category 'initialize-release') -----
  initMaps
  	map := Dictionary new: oldHeap memory size // 4.
  	reverseMap := Dictionary new: oldHeap memory size // 4.
  	classToIndex := Dictionary new: 1024.
  	literalMap := IdentityDictionary new.
  	methodClasses := Set new.
  	installedPrototypes := Set new.
+ 	installedMethodOops := Set new.
  	classMetaclass := nil!

Item was changed:
  ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
  installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
  	"Create a sourceless method to install in the bootstrapped image.  It will allow the
  	 bootstrap to limp along until the relevant transformed Monticello package is loaded."
  	| compiledMethodClass methodClassBinding methodClass sourcelessMethod bytes newMethod delta initialPC |
  	compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
  	methodClassBinding := self methodClassBindingForClassName: className isMeta: isMeta.
  	methodClass := oldHeap fetchPointer: ValueIndex ofObject: methodClassBinding.
  	"the prototypes have source pointers.  the Character methods to be replaced don't."
  	sourcelessMethod := aCompiledMethod trailer hasSourcePointer
  							ifTrue: [aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode]
  							ifFalse: [aCompiledMethod].
  	initialPC := sourcelessMethod initialPC.
  	bytes := sourcelessMethod size - initialPC + 1.
  	"Ugh, this is complicated.  We could be running on Spur with the new method format
  	 or on non-Spur with the old format.  Make both work."
  	delta := (sourcelessMethod primitive > 0
  			 and: [(sourcelessMethod at: initialPC) = sourcelessMethod encoderClass callPrimitiveCode])
  				ifTrue: [3]
  				ifFalse: [0].
  	newMethod := self
  					interpreter: oldInterpreter
  					object: compiledMethodClass
  					perform: (self findSymbol: #newMethod:header:)
  					withArguments: { oldHeap integerObjectOf: bytes - delta.
  									   oldHeap integerObjectOf: (self oldFormatHeaderFor: sourcelessMethod) }.
  	1 to: sourcelessMethod numLiterals - 2 do:
  		[:i| | literal oop |
  		literal := sourcelessMethod literalAt: i.
  		oop := (literal isLiteral or: [literal isVariableBinding])
  					ifTrue:
  						[literal isInteger
  							ifTrue: [oldHeap integerObjectOf: literal]
  							ifFalse: [literalMap
  										at: literal
  										ifAbsent: [self findLiteral: literal
  														inClass: methodClass]]]
  					ifFalse: "should be a VMObjectProxy"
  						[literal oop].
  		oldHeap storePointer: i ofObject: newMethod withValue: oop].
  	oldHeap
  		storePointer: sourcelessMethod numLiterals - 1
  		ofObject: newMethod
  		withValue: (selector isSymbol
  						ifTrue: [self findSymbol: selector]
  						ifFalse: [selector oop]);
  		storePointer: sourcelessMethod numLiterals
  		ofObject: newMethod
  		withValue: methodClassBinding.
  	initialPC to: sourcelessMethod size - delta do:
  		[:i|
  		oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i + delta)].
+ 	installedMethodOops add: newMethod.
  	^newMethod!

Item was changed:
  ----- Method: SpurBootstrap>>replacementForCharacterMethod: (in category 'bootstrap methods') -----
  replacementForCharacterMethod: characterMethodOop
  	"Answer a replacement method for the argument if it refers
  	 to Character's old inst var value.  Otherwise answer nil."
  	| proxy asIntegerProxy clone assembly newInsts newMethod |
  	"(oldHeap stringOf: (oldHeap longAt: characterMethodOop + (oldHeap lastPointerOf: characterMethodOop) - 4)) = 'isOctetCharacter' ifTrue:
  		[self halt]."
+ 	"Don't replace something already installed."
+ 	(installedMethodOops includes: characterMethodOop) ifTrue:
+ 		[^nil].
  	proxy := VMCompiledMethodProxy new
  				for: characterMethodOop
  				coInterpreter: oldInterpreter
  				objectMemory: oldHeap.
  	self assert: (oldHeap literalCountOf: characterMethodOop) = proxy numLiterals.
  	clone := self cloneMethodProxy: proxy.
  	self assert: proxy numLiterals = clone numLiterals.
+ 	clone isReturnSpecial ifTrue:
+ 		[^nil].
  	"Quick methods accessing value should have been replaced.  The halt will fire if there
  	 is a missing prototype for such a method on the class side of SpurBootstrap.  The
  	 relevant Character prototypes there so far are Character>>asInteger, Character>>
  	 asciiValue, Character>>hash & Character>>identityHash.  Conceivably the bootstrap
  	 could be applied to an image that has others; hence the halt."
  	clone isReturnField ifTrue: [self halt].
  	clone hasInstVarRef ifFalse:
  		[^nil].
  	clone setSourcePointer: 0.
  	asIntegerProxy := VMObjectProxy new
  							for: (literalMap at: #asInteger)
  							coInterpreter: oldInterpreter
  							objectMemory: oldHeap.
  	assembly := BytecodeDisassembler new disassemble: clone.
  	assembly literals: (assembly literals allButLast: 2), {asIntegerProxy}, (assembly literals last: 2).
  		"Do this by looking for index of pushReceiverVariable: and replacing it by pushSelf, send asInteger"
  	newInsts := (assembly instructions piecesCutWhere:
  					[:msgOrLabelAssoc :nextInst|
  					 msgOrLabelAssoc isVariableBinding not
  					 and: [msgOrLabelAssoc selector == #pushReceiverVariable:]]) fold:
  				[:a :b|
  				 a allButLast,
  				 {	Message selector: #pushReceiver.
  					Message
  						selector: #send:super:numArgs:
  						arguments: {asIntegerProxy. false. 0}},
  				 b].
  	assembly instructions: newInsts.
  	newMethod := assembly assemble.
  	self assert: clone numLiterals + 1 = newMethod numLiterals.
  	^self
  		installableMethodFor: newMethod
  		selector: clone selector
  		className: #Character
  		isMeta: false!



More information about the Vm-dev mailing list