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

commits at source.squeak.org commits at source.squeak.org
Tue Jul 19 00:17:51 UTC 2022


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

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

Name: VMMaker.oscog-eem.3214
Author: eem
Time: 18 July 2022, 5:17:38.344205 pm
UUID: 4aea2ebe-e8da-4b7c-a606-257ca7a8d071
Ancestors: VMMaker.oscog-eem.3213

Simplify creating the signature map by SmartSyntaxPluginSimulator, also sharing the code generator used to access signatures to compute accessor depths.

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

Item was changed:
  InterpreterPlugin subclass: #SmartSyntaxPluginSimulator
+ 	instanceVariableNames: 'actualPlugin signatureMap pluginClass logging codeGenerator'
- 	instanceVariableNames: 'actualPlugin signatureMap pluginClass logging'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SmartSyntaxPlugins'!

Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>codeGenerator (in category 'accessing-simulation') -----
+ codeGenerator
+ 	^codeGenerator!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>computeSignatureFor:from: (in category 'initialize') -----
  computeSignatureFor: selector from: tuple
- 	| signature |
- 	signature := tuple second collect:
- 					[:className|
- 					(Smalltalk classNamed: className)
- 						ifNil: [self error: 'Argument class' , className, ' does not exist']
- 						ifNotNil:
- 							[:argClass|
- 							argClass
- 								ccg: self
- 								prolog: true
- 								expr: [interpreterProxy primitiveFail]
- 								index: nil]].
  	^signatureMap
+ 		at: selector
+ 		put: {	tuple first.
+ 				tuple second collect:
+ 					[:argClass|
+ 					argClass
+ 						ccg: self
+ 						prolog: true
+ 						expr: [interpreterProxy primitiveFail]
+ 						index: nil].
- 		at: tuple first asSymbol
- 		put: {	selector.
- 				signature.
  				tuple third
+ 					ifNil: [#yourself]
- 					ifNil: [[:oop| oop]]
  					ifNotNil:
+ 						[:rcvrClass|
+ 						rcvrClass
+ 							ccg: self
+ 							prolog: false
+ 							expr: [interpreterProxy primitiveFail]
+ 							index: nil] }!
- 						[:rcvrClassSymbol|
- 						(Smalltalk classNamed: rcvrClassSymbol)
- 							ifNil: [self error: 'Receiver class' , rcvrClassSymbol, ' does not exist']
- 							ifNotNil:
- 								[:rcvrClass|
- 								rcvrClass
- 									ccg: self
- 									prolog: false
- 									expr: [interpreterProxy primitiveFail]
- 									index: nil]] }!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>computeSignatureMap (in category 'initialize') -----
  computeSignatureMap
  	signatureMap := Dictionary new.
+ 	codeGenerator := pluginClass buildCodeGenerator.
+ 	codeGenerator inferTypesForImplicitlyTypedVariablesAndMethods.
+ 	codeGenerator sortedExportMethods do:
+ 		[:tm|
+ 		tm primitiveSpecInto:
+ 			[:smalltalkSel :primSel :rcvrSpec :argSpec|
+ 			self computeSignatureFor: primSel from: { smalltalkSel. argSpec ifNil: [#()]. rcvrSpec }]]!
- 	(pluginClass withAllSuperclasses copyUpTo: SmartSyntaxInterpreterPlugin) do:
- 		[:theClass|
- 		 theClass selectorsAndMethodsDo:
- 			[:s :m|
- 			(m messages includesAnyOf: #(primitive: primitive:parameters: primitive:parameters:receiver:))
- 				ifTrue: [self getPrimitiveSignatureFor: m]
- 				ifFalse:
- 					[(m pragmaAt: #export:) ifNotNil:
- 						[:exportPragma|
- 						(exportPragma argumentAt: 1) ifTrue:
- 							[self computeSignatureFor: m selector from: { s. #(). nil }]]]]]!

Item was added:
+ ----- Method: SmartSyntaxPluginTMethod>>primitiveSpecInto: (in category 'simulation') -----
+ primitiveSpecInto: aQaternaryBlock
+ 	^aQaternaryBlock value: self smalltalkSelector value: selector value: rcvrSpec value: parmSpecs!

Item was changed:
  ----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
  tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
  	"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
  	<doNotGenerate>
  	| plugin realPluginClass plugins |
  	self transcript cr; show: 'Looking for module ', pluginString.
  	pluginString isEmpty
  		ifTrue:
  			[plugin := self]
  		ifFalse:
  			[plugins := InterpreterPlugin allSubclasses select:
  							[:psc|
  							 psc moduleName asString = pluginString asString
  							 and: [psc shouldBeTranslated]].
  			 plugins isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
  			 plugins size > 1 ifTrue: [^self error: 'This won''t work...'].
  			 "plugins size > 1 ifTrue:
  				[self transcript show: '...multiple plugin classes; choosing ', plugins last name]."
  			 realPluginClass := plugins anyOne. "hopefully lowest in the hierarchy..."
  			 plugin := realPluginClass simulatorForInterpreterInterface: objectMemory.
  			 plugin ifNil: [self transcript show: ' ... no simulator class; cannot simulate'. ^nil].
  			 (plugin respondsTo: #initialiseModule) ifTrue:
  				[plugin initialiseModule ifFalse:
  					[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
  	self transcript show: ' ... loaded'.
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[| cg |
- 		[| realPlugin cg |
  		 self transcript show: '...computing accessor depths'.
  		 plugin class isPluginClass
  			ifTrue:
+ 				[cg := plugin isSmartSyntaxPluginSimulator
+ 					ifTrue: [plugin codeGenerator]
+ 					ifFalse:
+ 						[(plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated]) buildCodeGenerator]]
- 				[realPlugin := (plugin isSmartSyntaxPluginSimulator
- 									ifTrue: [realPluginClass]
- 									ifFalse: [plugin class])
- 								 withAllSuperclasses detect: [:class| class shouldBeTranslated].
- 				 cg := realPlugin buildCodeGenerator]
  			ifFalse:
  				[cg := self computeAccessorDepthsForInterpreterPrimitives].
  		 cg exportedPrimitiveNames do:
  			[:primName| | fnSymbol |
  			 fnSymbol := primName asSymbol.
+ 			 pluginEntries addLast: {	plugin.
+ 										fnSymbol.
+ 										[plugin perform: fnSymbol. self].
+ 										self metadataFlagsFor: fnSymbol using: cg}].
- 			 pluginEntries addLast: {plugin.
- 									fnSymbol.
- 									[plugin perform: fnSymbol. self].
- 									self metadataFlagsFor: fnSymbol using: cg}].
  		 self transcript show: '...done'].
  	^pluginString asString -> plugin!



More information about the Vm-dev mailing list