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

commits at source.squeak.org commits at source.squeak.org
Sat Sep 7 20:18:37 UTC 2013


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

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

Name: Cog-eem.75
Author: eem
Time: 7 September 2013, 1:18:24.463 pm
UUID: f6d7520c-4738-4d03-b5b0-5126b4650eb7
Ancestors: Cog-eem.74

Refactor enumeration of prototype metods to add isMeta info.
FIrst cut of installableMethodFor:selector:className:isMeta:.

=============== Diff against Cog-eem.74 ===============

Item was changed:
  Object subclass: #SpurBootstrap
+ 	instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage symbolMap methodClasses'
- 	instanceVariableNames: 'oldHeap newHeap map reverseMap classToIndex oldInterpreter lastClassTablePage symbolMap'
  	classVariableNames: ''
  	poolDictionaries: 'VMObjectIndices'
  	category: 'Cog-Bootstrapping'!
  
  !SpurBootstrap commentStamp: 'eem 9/2/2013 13:26' prior: 0!
  SpurBootstrap bootstraps an image in CogMemoryManager format from a Squeak V3 + closures format.
  
  e.g.
  	(SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
  		transform;
  		launch
  
  Instance Variables
  	classToIndex:		<Dictionary>
  	map:		<Dictionary>
  	newHeap:		<CogMemoryManager>
  	oldHeap:		<NewObjectMemory>
  	oldInterpreter:		<StackInterpreterSimulator>
  
  classToIndex
  	- oldClass to new classIndex map
  
  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
  !

Item was changed:
  ----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') -----
  addNewMethods
+ 	"Get the simulator to add any and all missing methods immediately."
- 	"Get the simulator to add fake methods for all missing methods so that when we install
- 	 the prototypes we can assign directly to the method dictionaries since by this time the
- 	 system could well be inconsistent and broken by the changes."
  	| cmaiaSym basSym |
  	cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:.
  	basSym := self findSymbol: #basicAddSelector:withMethod:.
+ 	self allPrototypeClassNamesDo:
+ 		[:sym :symIsMeta| | class |
- 	self allPrototypeClassNames do:
- 		[:sym| | class |
  		class := self findClassNamed: (symbolMap at: sym).
+ 		symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
+ 		self prototypeClassNameMetaSelectorMethodDo:
+ 			[:className :isMeta :selector :method| | methodOrNil |
+ 			(className = sym
+ 			 and: [symIsMeta = isMeta]) ifTrue:
- 		self prototypeClassNameSelectorMethodDo:
- 			[:className :selector :method|
- 			className = sym 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 interpreterObject: class
+ 									perform: cmaiaSym
+ 									withArguments: {symbolMap 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 interpreterObject: class
+ 							perform: basSym
+ 							withArguments: { symbolMap at: selector.
+ 											   self installableMethodFor: method
+ 												selector: selector
+ 												className: className
+ 												isMeta: isMeta}]
+ 					ifFalse: "existing method; collect the methodClassAssociation; its needed later"
+ 						[methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]!
- 				[Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush.
- 				 (self interpreterObject: class
- 						perform: cmaiaSym
- 						withArguments: {symbolMap at: selector. oldHeap nilObject}) = oldHeap nilObject ifTrue:
- 					["no method.  install the real thing now"
- 					 self interpreterObject: class
- 						perform: basSym
- 						withArguments: {symbolMap at: selector. self installableMethodFor: method}]]]]]!

Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeClassNames (in category 'method prototypes') -----
- allPrototypeClassNames
- 	"self basicNew allPrototypeClassNames"
- 	| symbols |
- 	symbols := Set new.
- 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') do:
- 		[:protoSelector| | method |
- 		method := SpurBootstrap class >> protoSelector.
- 		symbols add: (self classNameForPrototypeMethod: method)].
- 	^symbols!

Item was added:
+ ----- Method: SpurBootstrap>>allPrototypeClassNamesDo: (in category 'method prototypes') -----
+ allPrototypeClassNamesDo: aBlock
+ 	"self basicNew allPrototypeClassNames"
+ 	| pairs |
+ 	pairs := Set new.
+ 	self prototypeClassNameMetaSelectorMethodDo:
+ 		[:className :isMeta :selector :method |
+ 		pairs add: {className. isMeta}].
+ 	pairs do: [:pair| aBlock value: pair first value: pair last]!

Item was changed:
  ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
  allPrototypeMethodSymbols
  	"self basicNew allPrototypeMethodSymbols"
  	| symbols |
  	symbols := Set new.
+ 	self prototypeClassNameMetaSelectorMethodDo:
+ 		[:className :isMeta :selector :method |
+ 		symbols
+ 			add: className;
+ 			add: selector;
+ 			addAll: (method literals select: [:l| l isSymbol and: [l ~~ method selector]])].
- 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') do:
- 		[:protoSelector| | method |
- 		method := SpurBootstrap class >> protoSelector.
- 		symbols add: (self selectorForPrototypeMethod: method).
- 		symbols addAll: (method literals select: [:l| l isSymbol and: [l ~~ protoSelector]])].
  	^symbols!

Item was added:
+ ----- Method: SpurBootstrap>>findClassNamed: (in category 'bootstrap methods') -----
+ findClassNamed: symbolOop 
+ 	oldHeap allObjectsDo:
+ 		[:o|
+ 		((oldHeap isPointersNonImm: o)
+ 		 and: [(oldInterpreter addressCouldBeClassObj: o)
+ 		 and: [(oldHeap fetchPointer: oldInterpreter classNameIndex ofObject: o) = symbolOop]]) ifTrue:
+ 			[^o]].
+ 	^nil!

Item was changed:
  ----- Method: SpurBootstrap>>installModifiedMethods (in category 'bootstrap methods') -----
  installModifiedMethods
  	"Install all the methods in the class-side method prototypes protocol in the relevant classes
  	 in the new image.  First use the simulator to get the image to intern all symbols and add
  	 dummy methods under new selectors.  With that done we can manually replace the relevant
  	 methods with the prototypes, mapping selectors and global variables as required."
+ 	symbolMap := Dictionary new.
+ 	methodClasses := Set new.
  	self withExecutableInterpreterDo:
  		[self internAllSymbols.
  		 self addNewMethods.
  		 self replaceMethods].
  	self modifyCharacterMethods!

Item was added:
+ ----- Method: SpurBootstrap>>installableMethodFor:selector:className:isMeta: (in category 'bootstrap methods') -----
+ installableMethodFor: aCompiledMethod selector: selector className: className isMeta: isMeta
+ 	| compiledMethodClass sourcelessMethod bytes newMethod methodClass |
+ 	compiledMethodClass := self findClassNamed: (self findSymbol: #CompiledMethod).
+ 	sourcelessMethod := aCompiledMethod copyWithTempsFromMethodNode: aCompiledMethod methodNode.
+ 	sourcelessMethod selector: selector.
+ 	bytes := sourcelessMethod size - sourcelessMethod initialPC + 1.
+ 	newMethod := self
+ 					interpreterObject: compiledMethodClass
+ 					perform: (self findSymbol: #newMethod:header:)
+ 					withArguments: { oldHeap integerObjectOf: bytes.
+ 									   oldHeap integerObjectOf: sourcelessMethod header }.
+ 	1 to: sourcelessMethod numLiterals - 1 do:
+ 		[:i| | literal |
+ 		literal := sourcelessMethod literalAt: i.
+ 		literal := literal isInteger
+ 					ifTrue: [oldHeap integerObjectOf: literal]
+ 					ifFalse: [symbolMap at: literal].
+ 		oldHeap storePointer: i ofObject: newMethod withValue: literal].
+ 	methodClass := self methodClassForClassName: className isMeta: isMeta.
+ 	oldHeap storePointer: sourcelessMethod numLiterals ofObject: newMethod withValue: methodClass.
+ 	sourcelessMethod initialPC to: sourcelessMethod size do:
+ 		[:i|
+ 		oldHeap storeByte: i - 1 ofObject: newMethod withValue: (sourcelessMethod byteAt: i)].
+ 	^newMethod!

Item was changed:
  ----- Method: SpurBootstrap>>internAllSymbols (in category 'bootstrap methods') -----
  internAllSymbols
  	"Ensure that all symbols in the method prototypes are interned so that later we can install them.
  	 Enter them into the map, this system's symbol -> oldHeap's version.
  	 Do this by interpreting Symbol intern: 'aSymbol' for each symbol."
  	| internSym |
- 	symbolMap := Dictionary new.
  	internSym := self findSymbol: #intern:.
  	self allPrototypeMethodSymbols do:
  		[:sym| | string |
  		(self findSymbol: sym)
  			ifNotNil: [:imageSym| symbolMap at: sym put: imageSym]
  			ifNil:
  				[Transcript cr; nextPutAll: 'interning '; nextPutAll: sym; flush.
  				string := oldHeap instantiateClass: (oldHeap splObj: ClassByteString) indexableSize: sym size.
  				1 to: sym size do:
  					[:i| oldHeap storeByte: i - 1 ofObject: string withValue: (sym at: i) asInteger].
  				"Interpret Symbol intern: sym to ... intern it :-)"
  				symbolMap
  					at: sym
  					put: (self interpreterObject: self symbolClass
  							perform: internSym
  							withArguments: {string})]].
  	symbolMap keysAndValuesDo:
  		[:sym :imageSym|
  		self assert: sym = (oldHeap stringOf: imageSym)]!

Item was added:
+ ----- Method: SpurBootstrap>>methodClassForClassName:isMeta: (in category 'bootstrap methods') -----
+ methodClassForClassName: classNameSymbol isMeta: isMeta 
+ 	| class |
+ 	class := self findClassNamed: classNameSymbol.
+ 	isMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
+ 	methodClasses do:
+ 		[:mca|
+ 		class = (oldHeap fetchPointer: ValueIndex ofObject: mca) ifTrue:
+ 			[^mca]].
+ 	oldHeap allObjectsDo:
+ 		[:o| | methodClassAssociation |
+ 		(oldHeap isCompiledMethod: o) ifTrue:
+ 			[methodClassAssociation := oldInterpreter methodClassAssociationOf: o.
+ 			 class == (oldHeap fetchPointer: ValueIndex ofObject: methodClassAssociation) ifTrue:
+ 				[methodClasses add: methodClassAssociation.
+ 				 ^methodClassAssociation]]].
+ 	self error: 'could not find methodClassAssociation for ', classNameSymbol, (isMeta ifTrue: [' class'] ifFalse:[''])!

Item was added:
+ ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
+ prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
+ 	"Evaluate aBlock with class name, class is meta, method and selector."
+ 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') do:
+ 		[:protoSelector| | method className isMeta |
+ 		method := SpurBootstrap class >> protoSelector.
+ 		className := self classNameForPrototypeMethod: method.
+ 		(isMeta := className endsWith: 'class') ifTrue:
+ 			[className := (className allButLast: 5) asSymbol].
+ 		quaternaryBlock
+ 			value: className
+ 			value: isMeta
+ 			value: (self selectorForPrototypeMethod: method)
+ 			value: method]!

Item was removed:
- ----- Method: SpurBootstrap>>prototypeClassNameSelectorMethodDo: (in category 'method prototypes') -----
- prototypeClassNameSelectorMethodDo: trinaryBlock
- 	"Evaluate aBlock with class name, method and selector."
- 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') do:
- 		[:protoSelector| | method |
- 		method := SpurBootstrap class >> protoSelector.
- 		trinaryBlock
- 			value: (self classNameForPrototypeMethod: method)
- 			value: (self selectorForPrototypeMethod: method)
- 			value: method]!



More information about the Vm-dev mailing list