[Vm-dev] VM Maker: VMMaker.oscog-nice.1830.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 21 22:04:22 UTC 2016


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1830.mcz

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

Name: VMMaker.oscog-nice.1830
Author: nice
Time: 22 April 2016, 12:02:03.049 am
UUID: 77b5402f-abf8-46ad-8f3c-4c8ab5e2e64a
Ancestors: VMMaker.oscog-eem.1829

Generate integer type checking as C macros rather than direct/indirect interpreterProxy function call in plugins.

This remove the need for (compatibility broken) 
platforms/Cross/vm/sqVirtualMemory.[ch] rev 3673
which can now safely be reverted.

Don't generate asCInt as (oop >> 1) because it would not work in Spur 64 VM. Fortunately, this selector was unused.

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

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>generateAsCInt:on:indent: (in category 'translating builtins') -----
  generateAsCInt: aNode on: aStream indent: anInteger
+ 	self genCallOf: #integerValueOf: with: aNode receiver on: aStream!
- 
- 	aStream nextPut: $(.
- 	self emitCExpression: aNode receiver on: aStream.
- 	aStream nextPutAll: ' >> 1)'.!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>notePluginFunctionsUsedByMacros (in category 'public') -----
+ notePluginFunctionsUsedByMacros
+ 	"Declare the plugin functions that are used by macros."
+ 	#(
+ 		isKindOfInteger: #(classLargeNegativeInteger classLargePositiveInteger fetchClassOf: isIntegerObject: )
+ 		isIntegerObject:  #()
+ 		isLargeIntegerObject: #(classLargeNegativeInteger classLargePositiveInteger fetchClassOf: )
+ 		isLargeNegativeIntegerObject: 	#(classLargeNegativeInteger fetchClassOf: )
+ 		isLargePositiveIntegerObject: 	#(classLargePositiveInteger fetchClassOf: ))
+ 			pairsDo: [:macro :funcs |
+ 				(pluginFunctionsUsed includes: macro) ifTrue: [pluginFunctionsUsed addAll: funcs]].!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>pluginFunctionsToClone (in category 'public') -----
  pluginFunctionsToClone
  	"Answer those of the used plugin functions to clone as a sorted collection.
  	 Exclude those that are static to sqVirtualMachine.c and hence always need
+ 	 to be called through interpreterProxy.
+ 	 Also exclude those that are generated as macros rather than function call."
- 	 to be called through interpreterProxy."
  
  	^((pluginFunctionsUsed
  		reject: [:selector| self noteUsedPluginFunction: selector])
+ 			select: [:selector| (InterpreterProxy includesSelector: selector) and: [(self selectorsThatAreGeneratedAsMacros includes: selector) not]])
- 			select: [:selector| InterpreterProxy includesSelector: selector])
  				asSortedCollection!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>preDeclareInterpreterProxyOn: (in category 'C code generator') -----
  preDeclareInterpreterProxyOn: aStream
  	"Put the necessary #defines needed before interpreterProxy.  Basically
  	 internal plugins use the VM's interpreterProxy variable and external plugins
  	 use their own.  Override to keep local copies of all functions in external
  	 prims, and link directly in internal plugins."
  	"| pcc |
  	pcc := self new.
  	(InterpreterProxy selectors reject: [:s| #(initialize private) includes: (InterpreterProxy whichCategoryIncludesSelector: s)]) do:
  		[:s| pcc noteUsedPluginFunction: s].
  	pcc preDeclareInterpreterProxyOn: Transcript.
  	Transcript flush"
  	| pluginFuncs interpreterClass objectMemoryClass |
+ 	self notePluginFunctionsUsedByMacros.
+ 	self preDeclareMacrosForFastClassChekingOn: aStream.
  	(pluginFuncs := self pluginFunctionsToClone) isEmpty ifTrue:
  		[^super preDeclareInterpreterProxyOn: aStream].
+ 	
  	aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr.
  	interpreterClass := self referenceInterpreterClass.
  	objectMemoryClass := self referenceObjectMemoryClass.
  	pluginFuncs := pluginFuncs collect:
  						[:selector| | reference actual |
  						reference := self compileToTMethodSelector: selector
  										in: ((interpreterClass whichClassIncludesSelector: selector) ifNil:
  											[(objectMemoryClass whichClassIncludesSelector: selector) ifNil:
  												[InterpreterProxy]]).
  						actual := self compileToTMethodSelector: selector in: InterpreterProxy.
  						(reference returnType ~= actual returnType
  						 or: [(1 to: reference args size) anySatisfy:
  								[:i| (reference typeFor: (reference args at: i) in: self)
  								  ~= (actual typeFor: (actual args at: i) in: self)]]) ifTrue:
  							[self logger
  								nextPutAll: 'warning, signature of InterpreterProxy>>';
  								nextPutAll: selector;
  								nextPutAll: ' does not match reference implementation.';
  								cr].
  						actual].
  	pluginFuncs do:
  		[:tMethod|
  		 tMethod recordDeclarationsIn: self.
  		 tMethod returnType ifNil:
  			[tMethod inferReturnTypeIn: self]].
  	pluginFuncs do:
  		[:tMethod| | functionName |
  		functionName := self cFunctionNameFor: tMethod selector.
  		aStream nextPutAll:
  			((String streamContents:
  					[:s|
  					tMethod
  						static: true;
  						emitCFunctionPrototype: s generator: self])
  				copyReplaceAll: functionName
  				with: '(*', functionName, ')'
  				tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]])].
  	aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'; cr.
  	pluginFuncs do:
  		[:tMethod|
  		self withOptionalVerbiageFor: tMethod selector
  			on: aStream
  			do: [tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self]
  			ifOptionalDo:
  				[aStream nextPutAll: '# define '.
  				 (TSendNode new
  					setSelector: tMethod selector
  						receiver: (TVariableNode new setName: 'interpreterProxy')
  							arguments: (tMethod args collect: [:a| TVariableNode new setName: a]))
  					emitCCodeAsArgumentOn: aStream
  						level: 0
  							generator: self.
  				 aStream nextPutAll: ' 0'; cr]].
+ 	aStream nextPutAll: 'extern'; cr; nextPutAll: '#endif'; cr.!
- 	aStream nextPutAll: 'extern'; cr; nextPutAll: '#endif'; cr!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>preDeclareMacrosForFastClassChekingOn: (in category 'C code generator') -----
+ preDeclareMacrosForFastClassChekingOn: aStream
+ 	"These macros can be used to check for various case of Integer type.
+ 	Since they can be defined based on existing API, this is a good trade off:
+ 	- avoid extending the interpreterProxy API like mad
+ 	- provide fast type checking"
+ 	
+ 	"Fast-up generated code by using a macro for this well known function unconditionnally"
+ 	aStream cr; nextPutAll: '#define isIntegerObject(oop) (oop & 1)'; cr. 
+ 	
+ 	aStream cr; nextPutAll: '#if SPURVM && defined(SQUEAK_BUILTIN_PLUGIN)'.
+ 	
+ 	"Compact class index are hardcoded because there is no guaranty that the pool values at generation time are that of SPUR..
+ 	 Make sure they are in sync with SpurMemoryManager class>>initializeCompactClassIndices"
+ 	aStream cr; nextPutAll: '# define LargeNegativeIntegerClassIndex 32'.
+ 	aStream cr; nextPutAll: '# define LargePositiveIntegerClassIndex 33'.
+ 	aStream cr; nextPutAll: 'extern sqInt classIndexOf(sqInt);'.
+ 	aStream cr; nextPutAll: '# define isKindOfInteger(oop) (isImmediate(oop) ? isIntegerObject(oop) : (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'.
+ 	aStream cr; nextPutAll: '# define isLargeIntegerObject(oop) (!!isImmediate(oop) && (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'.
+ 	aStream cr; nextPutAll: '# define isLargeNegativeIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargeNegativeIntegerClassIndex)'.
+ 	aStream cr; nextPutAll: '# define isLargePositiveIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargePositiveIntegerClassIndex)'.
+ 	
+ 	aStream cr; nextPutAll: '#else /* defined(SQUEAK_BUILTIN_PLUGIN) && defined(SPURVM) */'.
+ 	
+ 	aStream cr; nextPutAll: '# define isLargeNegativeIntegerObject(oop) (fetchClassOf(oop) == classLargeNegativeInteger())'.
+ 	aStream cr; nextPutAll: '# define isLargePositiveIntegerObject(oop) (fetchClassOf(oop) == classLargePositiveInteger())'.
+ 	aStream cr; nextPutAll: '# define isLargeIntegerObject(oop) (isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'.
+ 	aStream cr; nextPutAll: '# define isKindOfInteger(oop) (isIntegerObject(oop) || isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'.
+ 
+ 	aStream cr; nextPutAll: '#endif /* defined(SQUEAK_BUILTIN_PLUGIN) && defined(SPURVM) */'; cr
+ 	!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>selectorsThatAreGeneratedAsMacros (in category 'public') -----
+ selectorsThatAreGeneratedAsMacros
+ 	"Answer a list of selectors that are generated as a C macro rather than as an interpreterProxy function call."
+ 	
+ 	^#(isKindOfInteger: isIntegerObject: isLargeIntegerObject: isLargeNegativeIntegerObject: isLargePositiveIntegerObject:)!



More information about the Vm-dev mailing list