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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 16 23:10:29 UTC 2020


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

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

Name: VMMaker.oscog-eem.2775
Author: eem
Time: 16 July 2020, 4:10:20.53343 pm
UUID: 5277c7af-b6e2-42b2-879d-eab85ff574c2
Ancestors: VMMaker.oscog-eem.2774

ThreadedFFIPlugin: Add primitiveCDataModel which with 0 args answers the C data model name (LLP64, ILP32 et al), and with a ByteArray arg of 9 elements, answers the sizes of char, short, etc, & wchar_t.
Add ThreadedFFIPluginPartialSimulator to test the above primitive.  Hence implement InterpreterProxy>>deny: & stringForCString:.

Slang:
Fix a bug with the struct name cache (somehow I lost the updates to the methods that loaded the cache, which should have been changed to send ensureStructTypeCache).  Rename ensureStructTypeNameCache to ensureStructTypeCache to match voidStructTypeCache.
Allow TMethod>>typeFor:in: to infer tpes for non-integral constants (integral constants need very special handling, done in the client).
Eliminate unnecessary parentheses in ifNil:.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateIfNil:on:indent: (in category 'C translation') -----
  generateIfNil: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	(self isNilConstantReceiverOf: msgNode)
  		ifFalse:
+ 			[aStream nextPutAll: 'if (!!'.
+ 			 self emitCExpression: msgNode receiver on: aStream indent: level + 1.
+ 			 aStream nextPutAll: ') {'; cr.
- 			[aStream nextPutAll: 'if (!!('.
- 			 msgNode receiver emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 			 aStream nextPutAll: ')) {'; cr.
  			 msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
  			 aStream tab: level; nextPut: $}]
  		ifTrue:
  			[msgNode args first emitCCodeOn: aStream level: level generator: self]!

Item was added:
+ ----- Method: InterpreterProxy>>deny: (in category 'testing') -----
+ deny: aBooleanOrBlock
+ 	aBooleanOrBlock value ifTrue: [AssertionFailure signal: 'Assertion failed']!

Item was changed:
  ----- Method: InterpreterProxy>>stringForCString: (in category 'testing') -----
  stringForCString: aCString
  	"Answer a ByteString object containing the bytes (possibly UTF-8?) in the null-terminated C string aCString."
  	<option: #(atLeastVMProxyMajor:minor: 1 14)>
  	<returnTypeC: #sqInt>
  	<var: #aCString type: #'char *'>
+ 	self assert: aCString isString.
+ 	^aCString!
- 	self notYetImplemented!

Item was changed:
  ----- Method: TConstantNode>>typeOrNilFrom:in: (in category 'type inference') -----
  typeOrNilFrom: aCodeGenerator in: aTMethod
  	"For integers, answer int unless the value does not fit into a 32bits signed int.
  	In that case, answer the shortest architecture independant integer type that could hold the constant.
  	This method must be consistent with CCodeGenerator>>cLiteralFor:"
  	| hb |
  	value isInteger
  		ifTrue:
  			[value positive
  				ifTrue:
  					[hb := value highBit.
  					hb < 32 ifTrue: [^#int].
  					hb = 32 ifTrue: [^#'unsigned int'].
  					hb = 64 ifTrue: [^#'unsigned long long'].
  					^#'long long']
  				ifFalse:
  					[hb := value bitInvert highBit.
  					hb < 32 ifTrue: [^#int].
  					^#'long long']].
  	value isFloat ifTrue: [^#double].
+ 	(#(nil true false) includes: value) ifTrue: [^#sqInt]. "A machine word sized variable is better on 64-bits than int, we think."
- 	(#(nil true false) includes: value) ifTrue: [^#int].
  	(value isString and: [value isSymbol not]) ifTrue: [^#'char *'].
  	^nil!

Item was changed:
  ----- Method: TMethod>>typeFor:in: (in category 'utilities') -----
+ typeFor: aVariableOrConstantOrVariableNameString in: aCodeGen
- typeFor: aVariable in: aCodeGen
  	"Answer the type for aVariable, deferring to aCodeGen (which defers to the vmClass)
  	 if no type is found and the variable is global (not an arg or a local).  Expect the
  	 cCodeGen to answer nil for variables without types. nil for typelessness is required
  	 by the type propagation logic in inlineSend:directReturn:exitVar:in:."
  	| varName |
+ 	aVariableOrConstantOrVariableNameString isString ifFalse:
+ 		["N.B. Very important *not* to type integers, to allow the client to do the work of merging various integer types."
+ 		 (aVariableOrConstantOrVariableNameString isConstant
+ 		  and: [aVariableOrConstantOrVariableNameString value isInteger not]) ifTrue:
+ 			[^aVariableOrConstantOrVariableNameString typeOrNilFrom: aCodeGen in: self]].
+ 	varName := aVariableOrConstantOrVariableNameString asString.
- 	varName := aVariable asString.
  	^(declarations
  			at: varName
  			ifAbsent:
  				[(args includes: varName) "arg types default to sqInt"
  					ifTrue: ['sqInt ', varName]
  					ifFalse:
  						[(locals includes: varName) ifFalse: "don't provide type for locals"
  							[aCodeGen typeOfVariable: varName]]]) ifNotNil:
  		[:decl|
  		aCodeGen extractTypeFor: varName fromDeclaration: decl]!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>primitiveCDataModel (in category 'primitives') -----
+ primitiveCDataModel
+ 	"Two forms of C Data Model infomation.
+ 	 With 0 arguments answer the string naming the C data model, LP32, LP64, LLP64, etc.
+ 	 WIth 1 argument, which must be a ByteArray of at least 9 elements, answer the sizes of
+ 	 char, short, int, long, long long, wchar_t, float, double, void *."
+ 	<export: true>
+ 	| errorCode model |
+ 	interpreterProxy methodArgumentCount = 1 ifTrue:
+ 		[| sizes |
+ 		sizes := interpreterProxy stackValue: 0.
+ 		((interpreterProxy isBytes: sizes)
+ 		 and: [(interpreterProxy slotSizeOf: sizes) = 9]) ifFalse:
+ 			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ 		 (self cCoerceSimple: (interpreterProxy firstIndexableField: sizes) to: #'char *')
+ 			at: 0 put: (self sizeof: #char);
+ 			at: 1 put: (self sizeof: #short);
+ 			at: 2 put: (self sizeof: #int);
+ 			at: 3 put: (self sizeof: #long);
+ 			at: 4 put: (self sizeof: #'long long');
+ 			at: 5 put: (self sizeof: #wchar_t);
+ 			at: 6 put: (self sizeof: #float);
+ 			at: 7 put: (self sizeof: #double);
+ 			at: 8 put: (self sizeof: #'void *').
+ 		^interpreterProxy methodReturnValue: sizes].
+ 
+ 	interpreterProxy methodArgumentCount = 0 ifFalse:
+ 		[^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
+ 
+ 	"Attempt to identify the programming model:
+ 					   LP32    ILP32    LLP64   LP64    ILP64  SILP64(unidentified)
+ 		char			 8		 8		  8		 8		 8		 8
+ 
+ 		short			16		16		16		16		16		64
+ 
+ 		int				16		32		32		32		64		64
+ 
+ 		long			32		32		32 		64		64		64
+ 
+ 		long long		64		64		64		64		64		64
+ 
+ 		pointer			32		32		64		64		64		64"
+ 
+ 	errorCode := 0. "Set bit 0 if char is wrong, bit 1 if short is wrong, 2 for int, 3 for long, 4 for long long, 5 for void *"
+ 	(self sizeof: #char) ~= 1 ifTrue:
+ 		[errorCode := errorCode + 1].
+ 	(self sizeof: #short) ~= 2 ifTrue: "N.B. SILP64 exists on Cray supercomputers; we don't care..."
+ 		[errorCode := errorCode + 2].
+ 	(self sizeof: #'long long') ~= 8 ifTrue:
+ 		[errorCode := errorCode + 16].
+ 
+ 	(self sizeof: #'void *') = 8 ifTrue: "LP64 LLP64 ILP64"
+ 		[(self sizeof: #int) = 8 ifTrue: "ILP64"
+ 			[(self sizeof: #long) = 8
+ 				ifTrue: [model := 'ILP64']
+ 				ifFalse: [errorCode := errorCode + 8]].
+ 		 (self sizeof: #int) = 4 ifTrue: "LP64 or LLP64"
+ 			[(self sizeof: #long) = 8 ifTrue: "LP64"
+ 				[model := 'LP64'].
+ 			 (self sizeof: #long) = 4 ifTrue: "LLP64"
+ 				[model := 'LLP64'].
+ 			 ((self sizeof: #long) ~= 8 and: [(self sizeof: #long) ~= 4]) ifTrue:
+ 				[errorCode := errorCode + 8]].
+ 		 ((self sizeof: #int) ~= 8 and: [(self sizeof: #int) ~= 4]) ifTrue:
+ 			[errorCode := errorCode + 4]].
+ 
+ 	(self sizeof: #'void *') = 4 ifTrue: "LP32 ILP32"
+ 		[(self sizeof: #long) ~= 4 ifTrue:
+ 			[errorCode := errorCode + 8].
+ 		 (self sizeof: #int) = 4 ifTrue: "ILP32"
+ 			[model := 'ILP32'].
+ 		 (self sizeof: #int) = 2 ifTrue: "LP32"
+ 			[model := 'LP32'].
+ 		 ((self sizeof: #int) ~= 4 and: [(self sizeof: #int) ~= 2]) ifTrue:
+ 			[errorCode := errorCode + 4]].
+ 
+ 	((self sizeof: #'void *') ~= 8 and: [(self sizeof: #'void *') ~= 4]) ifTrue:
+ 		[errorCode := errorCode + 32].
+ 
+ 	errorCode ~= 0 ifTrue:
+ 		[^interpreterProxy primitiveFailForOSError: errorCode].
+ 	model ifNil:
+ 		[^interpreterProxy primitiveFailFor: PrimErrNotFound].
+ 	interpreterProxy methodReturnString: model
+ 
+ "Screed for testing
+ 	| proxy plugin |
+ 	proxy := InterpreterProxy new.
+ 	plugin := ThreadedFFIPluginPartialSimulator new.
+ 	plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 4 long 4 #'long long' 8 #'void *' 8  #'void *' 4 float 4 double 8 wchar_t 4)).
+ 	plugin sizes: (Dictionary newFromPairs: #(char 1 short 2 int 2 long 4 #'long long' 8 #'void *' 4 float 4 double 8 wchar_t 4)).
+ 	plugin instVarNamed: 'interpreterProxy' put: proxy.
+ 	proxy synthesizeStackFor: plugin with: (Array with: (ByteArray new: 9)).
+ 	plugin primitiveCDataModel.
+ 	^proxy stackValue: 0"!

Item was added:
+ ThreadedFFIPlugin subclass: #ThreadedFFIPluginPartialSimulator
+ 	instanceVariableNames: 'sizes'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins-FFI'!
+ 
+ !ThreadedFFIPluginPartialSimulator commentStamp: 'eem 7/16/2020 12:22' prior: 0!
+ A ThreadedFFIPluginPartialSimulator exists to test a few primitives such as primitiveCProgrammingModel.
+ 
+ Instance Variables
+ 	sizes	a Dictionary of sizes for sizeof:!

Item was added:
+ ----- Method: ThreadedFFIPluginPartialSimulator>>sizeof: (in category 'simulation support') -----
+ sizeof: aType
+ 	^sizes
+ 		ifNil: [super sizeof: aType]
+ 		ifNotNil: [sizes at: aType]!

Item was added:
+ ----- Method: ThreadedFFIPluginPartialSimulator>>sizes (in category 'accessing') -----
+ sizes
+ 
+ 	^ sizes!

Item was added:
+ ----- Method: ThreadedFFIPluginPartialSimulator>>sizes: (in category 'accessing') -----
+ sizes: anObject
+ 
+ 	sizes := anObject.!

Item was added:
+ ----- Method: VMStructType class>>ensureStructTypeCache (in category 'translation') -----
+ ensureStructTypeCache
+ 	^StructTypeNameCache ifNil:
+ 		[StructTypeNameCache := Set new.
+ 		 self allSubclassesDo:
+ 			[:sc| sc addStructTypeNamesTo: StructTypeNameCache].
+ 		 StructTypeNameCache]!

Item was removed:
- ----- Method: VMStructType class>>ensureStructTypeNameCache (in category 'translation') -----
- ensureStructTypeNameCache
- 	^StructTypeNameCache ifNil:
- 		[StructTypeNameCache := Set new.
- 		 self allSubclassesDo:
- 			[:sc| sc addStructTypeNamesTo: StructTypeNameCache].
- 		 StructTypeNameCache]!

Item was changed:
  ----- Method: VMStructType class>>isTypePointerToStruct: (in category 'translation') -----
  isTypePointerToStruct: type
  	| index |
  	^type notNil
  	  and: [(index := type indexOf: $*) > 0
+ 	  and: [self ensureStructTypeCache anySatisfy:
- 	  and: [self ensureStructTypeNameCache anySatisfy:
  			[:structType|
  			(type beginsWith: structType)
  			and: [index > structType size]]]]!

Item was changed:
  ----- Method: VMStructType class>>isTypeStruct: (in category 'translation') -----
  isTypeStruct: type
+ 	self ensureStructTypeCache.
- 	StructTypeNameCache ifNil:
- 		[StructTypeNameCache := Set new.
- 		 self allSubclassesDo:
- 			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName]].
  	^type notNil
  	  and: [StructTypeNameCache anySatisfy:
  			[:structType|
  			type = structType]]!

Item was changed:
  ----- Method: VMStructType class>>structTargetKindForDeclaration: (in category 'translation') -----
  structTargetKindForDeclaration: decl
  	^(decl notNil
+ 	   and: [(self ensureStructTypeCache includes: decl)
- 	   and: [(self ensureStructTypeNameCache includes: decl)
  			or: [StructTypeNameCache anySatisfy:
  					[:structType|
  					(decl beginsWith: structType)
  					and: [(decl indexOf: $* ifAbsent: [decl indexOf: Character space]) > structType size]]]]) ifTrue:
  		[(decl indexOf: $*) > 0
  			ifTrue: [#pointer]
  			ifFalse: [#struct]]!

Item was changed:
  ----- Method: VMStructType class>>structTargetKindForType: (in category 'translation') -----
  structTargetKindForType: type
+ 	self ensureStructTypeCache.
- 	StructTypeNameCache ifNil:
- 		[StructTypeNameCache := Set new.
- 		 self allSubclassesDo:
- 			[:sc| StructTypeNameCache add: sc name; add: sc structTypeName ]].
  	^(type notNil
  	   and: [StructTypeNameCache anySatisfy:
  			[:structType|
  			(type beginsWith: structType)
  			and: [type size = structType size
  				or: [(type at: structType size + 1) isAlphaNumeric not]]]]) ifTrue:
  		[(type includes: $*)
  			ifTrue: [#pointer]
  			ifFalse: [#struct]]!



More information about the Vm-dev mailing list