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

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

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

Name: VMMaker.oscog-eem.2259
Author: eem
Time: 8 August 2017, 12:37:11.878857 pm
UUID: 2f1fc238-68f1-4f4c-96c6-ed2af969b6d2
Ancestors: VMMaker.oscog-eem.2258

Plugin Slang
Make sure the accessor depths of optional primitives are emitted as conditionals.

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

Item was changed:
  ----- Method: CCodeGenerator>>emitExportsNamed:pluginName:on: (in category 'C code generator') -----
  emitExportsNamed: exportsNamePrefix pluginName: pluginName on: aStream
  "Store all the exported primitives in the form used by the internal named prim system."
  | nilVMClass excludeDepth |
  (nilVMClass := vmClass isNil) ifTrue: "We need a vmClass temporarily to compute accessor depths."
  [vmClass := StackInterpreter].
  "Don't include the depth in the vm's named primitives if the vm is non-Spur."
  excludeDepth := exportsNamePrefix = 'vm'
   and: [pluginName isEmpty
   and: [vmClass objectMemoryClass hasSpurMemoryManagerAPI not]].
  aStream cr; cr; nextPutAll: 'static char _m[] = "'; nextPutAll: pluginName; nextPutAll: '";'.
  aStream cr; nextPutAll: 'void* '; nextPutAll: exportsNamePrefix; nextPutAll: '_exports[][3] = {'; cr.
+ self sortedExportMethods do:
+ [:method|
+ self withOptionalConditionalDefineFor: method
+ on: aStream
+ do: [| primName |
+ primName := self cFunctionNameFor: method selector.
+ aStream tab; nextPutAll: '{(void*)_m, "'; nextPutAll: primName.
+ excludeDepth ifFalse:
+ [(self accessorDepthForSelector: primName asSymbol) ifNotNil:
+ [:depth| "store the accessor depth in a hidden byte immediately after the primName"
+ self assert: depth < 128.
+ aStream
+ nextPutAll: '\000\';
+ nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3)]].
+ aStream nextPutAll: '", (void*)'; nextPutAll: primName; nextPutAll: '},'; cr]].
- ((methods select: [:m| m export]) asSortedCollection: [:a :b| a selector caseSensitiveLessOrEqual: b selector]) do:
- [:method| | compileTimeOptionPragmas primName |
- (compileTimeOptionPragmas := method compileTimeOptionPragmas) notEmpty ifTrue:
- [method outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
- primName := self cFunctionNameFor: method selector.
- aStream tab; nextPutAll: '{(void*)_m, "'; nextPutAll: primName.
- excludeDepth ifFalse:
- [(self accessorDepthForSelector: primName asSymbol) ifNotNil:
- [:depth| "store the accessor depth in a hidden byte immediately after the primName"
- self assert: depth < 128.
- aStream
- nextPutAll: '\000\';
- nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3)]].
- aStream nextPutAll: '", (void*)'; nextPutAll: primName; nextPutAll: '},'; cr.
- method terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream].
  aStream tab; nextPutAll: '{NULL, NULL, NULL}'; cr; nextPutAll: '};'; cr.
  nilVMClass ifTrue:
  [vmClass := nil]!

Item was changed:
  ----- Method: CCodeGenerator>>promoteIntegerArithmeticTypes:and: (in category 'type inference') -----
  promoteIntegerArithmeticTypes: firstType and: secondType
  "Answer the return type for an arithmetic send.
  Deal with integer promotion rules of C99.
  See section 6.3 Conversions of the standard.
 
  6.3.1.1 ...snip...
  If an int can represent all values of the original type, the value is converted to an int;
  otherwise, it is converted to an unsigned int. These are called the integer promotions.
+ All other types are unchanged by the integer promotions
- All other types are unchanged by the inte ger promotions
 
  6.3.1.8 ...snip...
  Otherwise, the integer promotions are performed on both operands
  Then the following rules are applied to the promoted operands:
 
  If both operands have the same type, then no further conversion is needed.
 
  Otherwise, if both operands have signed integer types or both have unsigned integer
  types, the operand with the type of lesser integer conversion rank is converted to the
  type of the operand with greater rank.
 
  Otherwise, if the operand that has unsigned integer type has rank greater or equal to
  the rank of the type of the other operand, then the operand with signed integer type
  is converted to the type of the operand with unsigned integer type.
 
  Otherwise, if the type of the operand with signed integer type can represent all of the
  values of the type of the operand with unsigned integer type, then the operand with
  unsigned integer type is converted to the type of the operand with signed integer type.
 
  Otherwise, both operands are converted to the unsigned integer type corresponding to
  the type of the operand with signed integer type.
 
+ This is so that the generated code behaviour is insensitive to inlining."
- This is so that the generated code behaviour is unsensitive to inlining."
  | length1 length2 intSize |
  length1 := self sizeOfIntegralCType: firstType.
  length2 := self sizeOfIntegralCType: secondType.
  intSize := self sizeOfIntegralCType: #int.
  (length1 < intSize and: [length2 < intSize]) ifTrue: [^#int]. "Integer promotion"
  length1 > length2 ifTrue: [^firstType].
  length2 > length1 ifTrue: [^secondType].
  firstType first = $u ifTrue: [^firstType].
  secondType first = $u ifTrue: [^secondType].
  ^firstType!

Item was added:
+ ----- Method: CCodeGenerator>>sortedExportMethods (in category 'public') -----
+ sortedExportMethods
+ "Answer a suitably-sorted array of all exported TMethods"
+ ^(methods select: [:m| m export]) asSortedCollection: [:a :b| a selector caseSensitiveLessOrEqual: b selector]!

Item was added:
+ ----- Method: CCodeGenerator>>withOptionalConditionalDefineFor:on:do: (in category 'C code generator') -----
+ withOptionalConditionalDefineFor: aTMethod on: aStream do: aBlock
+ "Evaluate aBlock, surrounded by an appropriate conditional define added to the stream if required."
+ | compileTimeOptionPragmas |
+ (compileTimeOptionPragmas := aTMethod compileTimeOptionPragmas) notEmpty ifTrue:
+ [aTMethod outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
+ aBlock value.
+ aTMethod terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream!

Item was changed:
  ----- Method: VMMaker class>>makerFor:and:with:to:platformDir: (in category 'utilities') -----
  makerFor: interpreterClass and: cogitClassOrNil with: optionsPairsArrayArg to: srcDirName platformDir: platDirName
  "Initialize a VMMaker to generate the VM to the given target directory. Include plugins in pluginList.
  Example:
  (VMMaker
  generate: NewspeakInterpreter
  to: (FileDirectory default pathFromURI: 'cogvm/newspeaksrc')
  platformDir: (FileDirectory default pathFromURI: 'cogvm/platforms')
  including:#( AsynchFilePlugin FloatArrayPlugin RePlugin B2DPlugin FloatMathPlugin SecurityPlugin
  BMPReadWriterPlugin IA32ABI SocketPlugin BitBltPlugin JPEGReadWriter2Plugin SurfacePlugin
  DSAPrims JPEGReaderPlugin UUIDPlugin DropPlugin LargeIntegers UnixOSProcessPlugin
  FileCopyPlugin Matrix2x3Plugin Win32OSProcessPlugin FilePlugin MiscPrimitivePlugin ZipPlugin))"
  | maker optionsPairsArray |
  maker := self forPlatform: 'Cross'.
  maker sourceDirectoryName: srcDirName.
  maker platformRootDirectoryName: platDirName.
  maker interpreterClass: interpreterClass.
  optionsPairsArray := (cogitClassOrNil isNil or: [optionsPairsArrayArg includes: #Cogit])
+ ifTrue: [optionsPairsArrayArg]
+ ifFalse: [optionsPairsArrayArg, { #Cogit. cogitClassOrNil name }].
- ifNil: [optionsPairsArrayArg]
- ifNotNil: [optionsPairsArrayArg, { #Cogit. cogitClassOrNil name }].
  maker options: optionsPairsArray.
  ^maker
  !

Item was changed:
  ----- Method: VMPluginCodeGenerator>>emitAccessorDepthsOn: (in category 'C code generator') -----
  emitAccessorDepthsOn: aStream
  "Output accessor depth bytes for all primitives in the plugin.
  This is for external primitives in Spur."
+ self sortedExportMethods do:
+ [:method| | primName |
+ primName := self cFunctionNameFor: method selector.
- (self sortStrings: self exportedPrimitiveNames) do:
- [:primName|
  (self accessorDepthForSelector: primName asSymbol) ifNotNil:
  [:depth|
  "store the accessor depth in a byte variable; save a little space
   by omitting depths < 0; support code supplies the default."
  self assert: depth < 128.
  depth >= 0 ifTrue:
+ [self withOptionalConditionalDefineFor: method
+ on: aStream
+ do: [aStream
+ nextPutAll: 'signed char ';
+ nextPutAll: primName;
+ nextPutAll: 'AccessorDepth = ';
+ nextPutAll: (self cLiteralFor: depth);
+ nextPut: $;;
+ cr]]]]!
- [aStream
- nextPutAll: 'signed char ';
- nextPutAll: primName;
- nextPutAll: 'AccessorDepth = ';
- nextPutAll: (self cLiteralFor: depth);
- nextPut: $;;
- cr]]]!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>emitExportsOn: (in category 'C code generator') -----
  emitExportsOn: aStream
  "Store all the exported primitives in the form used by the internal named prim system."
+ | nilVMClass |
+ (nilVMClass := vmClass isNil) ifTrue: "We need a vmClass temporarily to compute accessor depths."
+ [vmClass := StackInterpreter].
  aStream cr; cr; nextPutAll:'#ifdef SQUEAK_BUILTIN_PLUGIN'.
  self emitExportsNamed: pluginClass moduleName
  pluginName: pluginClass moduleExportsName
  on: aStream.
  aStream cr; nextPutAll: '#else /* ifdef SQ_BUILTIN_PLUGIN */'; cr; cr.
  self emitAccessorDepthsOn: aStream.
+ aStream cr; nextPutAll: '#endif /* ifdef SQ_BUILTIN_PLUGIN */'; cr.
+ nilVMClass ifTrue:
+ [vmClass := nil]!
- aStream cr; nextPutAll: '#endif /* ifdef SQ_BUILTIN_PLUGIN */'; cr!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') -----
+ sizeOfIntegralCType: anIntegralCType "<String>"
+ "Hack; because the plugin sources are compiled either as 32 or 64 bit
+ size those types which are either 32 or 64 bits in size as 48 bits.
+ This happens to produce sane results for integer promotion."
+ "N.B. Only works for values for which isIntegralCType: answers true."
+ | prunedCType index |
+ (anIntegralCType beginsWith: 'register ') ifTrue:
+ [^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)].
+ prunedCType := (anIntegralCType beginsWith: 'unsigned ')
+ ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed]
+ ifFalse: [(anIntegralCType beginsWith: 'signed ')
+ ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed]
+ ifFalse: [anIntegralCType]].
+
+ ^prunedCType asString caseOf: {
+ ['sqLong'] -> [8].
+ ['usqLong'] -> [8].
+ ['long long'] -> [8].
+ ['sqInt'] -> [6].
+ ['usqInt'] -> [6].
+ ['sqIntptr_t'] -> [6].
+ ['usqIntptr_t'] -> [6].
+ ['int'] -> [4].
+ ['short'] -> [2].
+ ['short int'] -> [2].
+ ['char'] -> [1].
+ ['long'] -> [BytesPerWord]. "It's ambiguous on LLP64 and we'll later remove it"
+ ['size_t'] -> [6].
+ ['pid_t'] -> [6].
+ }
+ otherwise:
+ [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned  : 8'"
+  and: [(anIntegralCType includesAnyOf: '[*]') not
+  and: [(index := anIntegralCType indexOf: $:) > 0]])
+ ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8]
+ ifFalse: [self error: 'unrecognized integral type']]!