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

commits at source.squeak.org commits at source.squeak.org
Fri Feb 12 20:01:36 UTC 2016


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

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

Name: VMMaker.oscog-eem.1675
Author: eem
Time: 12 February 2016, 11:59:28.202137 am
UUID: 93ae77a3-3832-4364-83f3-531823c9bd31
Ancestors: VMMaker.oscog-eem.1674

IMMUTABILITY:
Fix the declaration/definition of ceCannotAssignTo:withIndex:valueToAssign: which needs to be included, but only if -DIMMUTABILITY=1.  So modify Slang to output #if FOO && !BAR code around functions that include option: pragmas whose arguments are in namesDefinedAtCompileTime.

Tim, Esteban, I'm committing this so I can build new VMs now.  I can't figure out if Esteban's changes for the IA32ABI plugin are correct yet (not enough brain power), but I can build with the source I generate, so I'm going to commit, generate source, build new VMs and then merge with your changes.  Apologies.

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

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstants:on: (in category 'C code generator') -----
  emitCConstants: constList on: aStream
  	"Store the global variable declarations on the given stream."
  	constList isEmpty ifTrue: [^self].
  	aStream cr; nextPutAll: '/*** Constants ***/'; cr.
  	(self sortStrings: constList) do:
  		[:varName| | node default value conditional |
  		node := constants at: varName.
  		node name isEmpty ifFalse:
  			["If the definition includes a C comment, take it as is, otherwise convert the value from Smalltalk to C.
  			  Allow the class to provide an alternative definition, either of just the value or the whole shebang."
  			default := (node value isString and: [node value includesSubString: '/*'])
  							ifTrue: [node value]
  							ifFalse: [self cLiteralFor: node value name: varName].
  			default = #undefined
  				ifTrue: [aStream nextPutAll: '#undef '; nextPutAll: node name; cr]
  				ifFalse:
  					[conditional := VMBasicConstants namesDefinedAtCompileTime includes: node name.
+ 					conditional ifTrue:
- 					 conditional ifTrue:
  						[aStream nextPutAll: '#if !!defined('; nextPutAll: node name; nextPutAll: ') /* Allow this to be overridden on the compiler command line */'; cr].
+ 					value := vmClass
- 					 value := vmClass
  								ifNotNil:
  									[(vmClass specialValueForConstant: node name default: default)
  										ifNotNil: [:specialDef| specialDef]
  										ifNil: [default]]
  								ifNil: [default].
  					value first ~= $# ifTrue:
+ 						[aStream nextPutAll: (conditional ifTrue: ['# define '] ifFalse: ['#define ']); nextPutAll: node name; space].
- 						[aStream nextPutAll: '#define '; nextPutAll: node name; space].
  					aStream nextPutAll: value; cr.
  					conditional ifTrue:
  						[aStream nextPutAll: '#endif'; cr]]]].
  	aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
  emitCFunctionPrototypes: methodList on: aStream 
  	"Store prototype declarations for all non-inlined methods on the given stream.
  	 Add a define for a NoDbgRegParms attribute for static functions used for debugging.
  	 gcc and other compilers will use non-standard calling conventions for static functions
  	 when optimizing.  The optimization can render the functions unusable in gdb.  The sqConfig.h
  	 file for the platform should define PlatformNoDbgRegParms suitably for the platform's
  	 compiler, if the compiler can be persuaded not to generate such functions.
  	 Add a define for a NeverInline attribute that tells the compiler never to inline functions
  	 with the attribute.  We mark functions we want to observe in a profiler as NeverInline.
  	 The sqConfig.h file for the platform should define NeverInline suitably for the platform's
  	 compiler, if the compiler can be persuaded not to inline certain functions."
  	aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
  	vmClass ifNotNil:
  		[NoRegParmsInAssertVMs ifTrue:
  			[aStream nextPutAll: '\\#if !!PRODUCTION && defined(PlatformNoDbgRegParms)\# define NoDbgRegParms PlatformNoDbgRegParms\#endif' withCRs.
  			 aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
  		 aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
  	(methodList select: [:m| m isRealMethod and: [self shouldGenerateMethod: m]]) do:
  		[:m |
  		vmClass ifNotNil:
  			[(NoRegParmsInAssertVMs and: [m export not and: [m isStatic and: [m args notEmpty]]]) ifTrue:
  				[m addFunctionAttribute: 'NoDbgRegParms'].
  			 m inline == #never ifTrue:
  				[m addFunctionAttribute: 'NeverInline']].
+ 		m emitCFunctionPrototype: aStream generator: self].
- 		m emitCFunctionPrototype: aStream generator: self.
- 		aStream nextPut: $; ; cr].
  	aStream cr!

Item was changed:
  ----- Method: CCodeGenerator>>optionIsTrue:in: (in category 'utilities') -----
  optionIsTrue: pragma in: aClass
  	"Answer whether an option: or notOption: pragma is true in the context of aClass.
  	 The argument to the option: pragma is interpreted as either a Cogit class name
  	 or a class variable name or a variable name in VMBasicConstants."
  	| key |
  	key := pragma argumentAt: 1.
+ 
+ 	"If the option is one to be defined at compile time we'll generate a
+ 	 conditional around its declaration and definition."
+ 	(VMBasicConstants namesDefinedAtCompileTime includes: key) ifTrue:
+ 		[^true].
+ 
  	"If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
  	(Smalltalk classNamed: key) ifNotNil:
  		[:optionClass|
  		 aClass cogitClass ifNotNil:
  			[:cogitClass|
  			 (optionClass includesBehavior: Cogit) ifTrue:
  				[^cogitClass includesBehavior: optionClass]].
  		 aClass objectMemoryClass ifNotNil:
  			[:objectMemoryClass|
  			 ((optionClass includesBehavior: ObjectMemory)
  			   or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
  				[^objectMemoryClass includesBehavior: optionClass]]].
  	"Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
  	{aClass initializationOptions.
  	  aClass.
  	  VMBasicConstants.
  	  aClass interpreterClass.
  	  aClass objectMemoryClass} do:
  		[:scopeOrNil|
  		 scopeOrNil ifNotNil:
  			[:scope|
  			 (scope bindingOf: key) ifNotNil:
  				[:binding|
  				binding value ~~ false ifTrue: [^true]]]].
  	^false!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetImmutability (in category 'object access primitives') -----
  primitiveGetImmutability
+ 	self cppIf: #IMMUTABILITY
+ 		ifTrue:
+ 			[| rcvr |
+ 			 rcvr := self stackValue: 0.
+ 			 self pop: argumentCount + 1 thenPushBool: (objectMemory isOopImmutable: rcvr)]
+ 		ifFalse:
+ 			[self primitiveFailFor: PrimErrUnsupported]!
- 	<option: #IMMUTABILITY>
- 	| rcvr bool |
- 	rcvr := self stackValue: 0.
- 	bool := (objectMemory isOopImmutable: rcvr)
- 		ifTrue: [ TrueObject ]
- 		ifFalse: [ FalseObject ].
- 	self pop: argumentCount + 1 thenPush: (objectMemory splObj: bool)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSetImmutability (in category 'object access primitives') -----
  primitiveSetImmutability
+ 	self cppIf: #IMMUTABILITY
+ 		ifTrue:
+ 			[| rcvr wasImmutable |
+ 			 rcvr := self stackValue: 1.
+ 			 (objectMemory isImmediate: rcvr) ifTrue:
+ 				[^self primitiveFailFor: PrimErrBadReceiver].
+ 			 wasImmutable := objectMemory isObjImmutable: rcvr.
+ 			 self stackTop = objectMemory trueObject
+ 				ifTrue:
+ 					[(self canBeImmutable: rcvr) ifFalse:
+ 						[^self primitiveFailFor: PrimErrInappropriate].
+ 					  objectMemory setIsImmutableOf: rcvr to: true]
+ 				ifFalse: [
+ 			self stackTop = objectMemory falseObject
+ 				ifTrue: [objectMemory setIsImmutableOf: rcvr to: false]
+ 			 	ifFalse:
+ 					[^self primitiveFailFor: PrimErrBadArgument]].
+ 			 self pop: argumentCount + 1 thenPushBool: wasImmutable]
+ 		ifFalse:
+ 			[self primitiveFailFor: PrimErrUnsupported]!
- 	<option: #IMMUTABILITY>
- 	| rcvr boolean wasImmutable |
- 	rcvr := self stackValue: 1.
- 	(objectMemory isImmediate: rcvr) ifTrue:
- 		[^self primitiveFailFor: PrimErrBadReceiver].
- 	boolean := self booleanValueOf: self stackTop.
- 	self successful ifFalse:
- 		[^self primitiveFailFor: PrimErrBadArgument].
- 	boolean ifTrue: 
- 		[(self canBeImmutable: rcvr) ifFalse:
- 			[^self primitiveFailFor: PrimErrInappropriate]]. 
- 	wasImmutable := objectMemory booleanObjectOf: (objectMemory isOopImmutable: rcvr).
- 	objectMemory setIsImmutableOf: rcvr to: boolean.
- 	self pop: argumentCount + 1 thenPush: wasImmutable!

Item was added:
+ ----- Method: TMethod>>compileTimeOptionPragmas (in category 'accessing') -----
+ compileTimeOptionPragmas
+ 	"Answer the (possibly empty) sequence of option: or notOption: pragmas
+ 	 whose arguments are values to be defined at compile time."
+ 	^self compiledMethod pragmas select:
+ 		[:pragma|
+ 		 (#option: == pragma keyword or: [#notOption: == pragma keyword])
+ 		 and: [VMBasicConstants namesDefinedAtCompileTime includes: (pragma argumentAt: 1)]]!

Item was changed:
  ----- Method: TMethod>>emitCCodeOn:generator: (in category 'C code generation') -----
  emitCCodeOn: aStream generator: aCodeGen
  	"Emit C code for this method onto the given stream.
  	 All calls to inlined methods should already have been expanded."
+ 	| conditional |
  
  	aCodeGen currentMethod: self.
  	self emitCCommentOn: aStream.	"place method comment and method name before function."
  	aStream crtab; nextPutAll: '/* '; nextPutAll: self definingClass name; nextPutAll: '>>#'; nextPutAll: self smalltalkSelector; nextPutAll: ' */'.	
  	aStream cr. 
+ 	conditional := self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
- 	self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: false.
  	aStream cr; nextPut: ${.
  	self emitCLocalsOn: aStream generator: aCodeGen.
  	aCodeGen
  		pushScope: declarations
  		while: [parseTree emitCCodeOn: aStream level: 1 generator: aCodeGen].
+ 	aStream nextPut: $}; cr.
+ 	conditional ifTrue:
+ 		[self terminateConditionalDefineFor: self compileTimeOptionPragmas on: aStream]!
- 	aStream nextPut: $}; cr!

Item was changed:
  ----- Method: TMethod>>emitCFunctionPrototype:generator: (in category 'C code generation') -----
  emitCFunctionPrototype: aStream generator: aCodeGen
  	"Emit a C function header for this method onto the given stream."
  
  	properties ifNotNil:
  		[(properties at: #api: ifAbsent: []) ifNotNil:
  			[:pragma|
+ 			aStream
+ 				nextPutAll: (pragma argumentAt: 1);
+ 				nextPut: $;;
+ 				cr.
- 			aStream nextPutAll: (pragma argumentAt: 1).
  			^self]].
  	self emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: true!

Item was changed:
  ----- Method: TMethod>>emitCFunctionPrototype:generator:isPrototype: (in category 'C code generation') -----
  emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: isPrototype "<Boolean>"
+ 	"Emit a C function header for this method onto the given stream.
+ 	 Answer if the method has any compileTimeOptionPragmas"
+ 	| compileTimeOptionPragmas returnTypeIsFunctionPointer |
+ 	(compileTimeOptionPragmas := self compileTimeOptionPragmas) notEmpty ifTrue:
+ 		[self outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
- 	"Emit a C function header for this method onto the given stream."
- 	| returnTypeIsFunctionPointer |
  	returnTypeIsFunctionPointer := returnType last = $)
  									and: [returnType includesSubString: (aCodeGen cFunctionNameFor: selector)].
  	export 
  		ifTrue:
  			[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
  		ifFalse:
  			[self isStatic
  				ifTrue: [aStream nextPutAll: 'static ']
  				ifFalse:
  					[isPrototype ifTrue:
  						[aStream nextPutAll: 'extern ']].
  			 (isPrototype or: [inline ~~ #always]) ifFalse: [aStream nextPutAll: 'inline '].
  			 aStream nextPutAll: returnType].
  	(functionAttributes isNil or: [returnTypeIsFunctionPointer]) ifFalse:
  		[aStream space; nextPutAll: functionAttributes].
  	isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
  	returnTypeIsFunctionPointer ifFalse:
  		[aStream
  			nextPutAll: (aCodeGen cFunctionNameFor: selector);
  			nextPut: $(.
  		args isEmpty
  			ifTrue: [aStream nextPutAll: #void]
  			ifFalse:
  				[args
  					do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
  					separatedBy: [aStream nextPutAll: ', ']].
+ 		aStream nextPut: $)].
+ 	isPrototype ifTrue:
+ 		[aStream nextPut: $;; cr.
+ 		 self terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ 	^compileTimeOptionPragmas notEmpty!
- 		aStream nextPut: $)]!

Item was added:
+ ----- Method: TMethod>>outputConditionalDefineFor:on: (in category 'C code generation') -----
+ outputConditionalDefineFor: compileTimeOptionPragmas on: aStream
+ 	aStream nextPutAll: '#if '.
+ 	compileTimeOptionPragmas
+ 		do: [:pragma|
+ 			pragma keyword = #notOption: ifTrue:
+ 				[aStream nextPut: $!!].
+ 			aStream nextPutAll: (pragma argumentAt: 1)]
+ 		separatedBy: [aStream nextPutAll: ' && '].
+ 	 aStream cr!

Item was added:
+ ----- Method: TMethod>>terminateConditionalDefineFor:on: (in category 'C code generation') -----
+ terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream
+ 	compileTimeOptionPragmas ifEmpty: [^self].
+ 	aStream nextPutAll: '#endif /* '.
+ 	compileTimeOptionPragmas
+ 		do: [:pragma|
+ 			pragma keyword = #notOption: ifTrue:
+ 				[aStream nextPut: $!!].
+ 			aStream nextPutAll: (pragma argumentAt: 1)]
+ 		separatedBy: [aStream nextPutAll: ' && '].
+ 	 aStream nextPutAll: ' */'; cr!

Item was changed:
  ----- Method: VMClass class>>shouldIncludeMethodForSelector: (in category 'translation') -----
  shouldIncludeMethodForSelector: selector
  	"Answer whether a primitive method should be translated.  Emit a warning to the transcript if the method doesn't exist."
  	^(self whichClassIncludesSelector: selector)
  		ifNotNil:
  			[:c|
  			 (c >> selector pragmaAt: #option:)
  				ifNotNil:
  					[:pragma|
+ 					(VMBasicConstants namesDefinedAtCompileTime includes: pragma arguments first)
+ 					 or: [initializationOptions
+ 							at: pragma arguments first
+ 							ifAbsent: [(self bindingOf: pragma arguments first)
+ 										ifNil: [false]
+ 										ifNotNil: [:binding| binding value ~~ #undefined]]]]
- 					initializationOptions
- 						at: pragma arguments first
- 						ifAbsent: [(self bindingOf: pragma arguments first)
- 									ifNil: [false]
- 									ifNotNil: [:binding| binding value ~~ #undefined]]]
  				ifNil: [true]]
  		ifNil:
  			[Transcript nextPutAll: 'Cannot find implementation of '; nextPutAll: selector; nextPutAll: ' in hierarchy of '; print: self; cr; flush.
  			 false]!

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 |
  	(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]])].
- 				tokenish: [:ch| ch = $_ or: [ch isAlphaNumeric]]).
- 		aStream nextPut: $;; cr].
  	aStream nextPutAll: '#else /* !!defined(SQUEAK_BUILTIN_PLUGIN) */'.
  	pluginFuncs do:
  		[:tMethod|
  		self withOptionalVerbiageFor: tMethod selector
  			on: aStream
  			do: [aStream cr.
  				tMethod static: false; export: false; emitCFunctionPrototype: aStream generator: self.
  				aStream nextPut: $;]
  			ifOptionalDo:
  				[aStream cr; 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']].
  	aStream cr; nextPutAll: 'extern'.
  	aStream cr; nextPutAll: '#endif'; cr!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>storeVirtualMachineProxyImplementation:on: (in category 'private') -----
  storeVirtualMachineProxyImplementation: categoryList on: fileName
  	"Store the interpreter definitions on the given file"
  	| stream |
  	stream := FileStream newFileNamed: fileName.
  	stream nextPutAll:'
  #include <math.h>
  #include <stdio.h>
  #include <stdlib.h>
  #include <string.h>
  #include <time.h>
  #include "sqVirtualMachine.h"'; cr;cr.
  	stream nextPutAll:'/*** Function prototypes ***/'.
  
  	categoryList do:[:assoc|
  		stream cr; cr; nextPutAll:'/* InterpreterProxy methodsFor: ''',assoc key, ''' */'; cr.
  		(self sortStrings: assoc value) do:[:sel|
+ 			(methods at: sel) emitCFunctionPrototype: stream generator: self]].
- 			(methods at: sel) emitCFunctionPrototype: stream generator: self.
- 			stream nextPut: $;; cr]].
  
  	stream cr; nextPutAll:'struct VirtualMachine *VM = NULL;'; cr.
  	stream cr; nextPutAll:
  'static int majorVersion(void) {
  	return VM_PROXY_MAJOR;
  }
  
  static int minorVersion(void) {
  	return VM_PROXY_MINOR;
  }
  
  struct VirtualMachine* sqGetInterpreterProxy(void)
  {
  	if(VM) return VM;
  	VM = (struct VirtualMachine *) calloc(1, sizeof(VirtualMachine));
  	/* Initialize Function pointers */
  	VM->majorVersion = majorVersion;
  	VM->minorVersion = minorVersion;
  '.
  	categoryList do:[:assoc|
  		stream cr; crtab; nextPutAll:'/* InterpreterProxy methodsFor: ''',assoc key, ''' */'; crtab.
  		assoc value asSortedCollection do:[:sel|
  		stream nextPutAll:'VM->';
  			nextPutAll: (self cFunctionNameFor: sel);
  			nextPutAll:' = ';
  			nextPutAll: (self cFunctionNameFor: sel);
  			nextPutAll:';';
  			crtab]].
  
  	stream cr; crtab; nextPutAll:'return VM;'; cr; nextPutAll:'}'; cr.
  	stream close.!



More information about the Vm-dev mailing list