VM Maker: VMMaker.oscog-eem.2775.mcz

 
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]]!