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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2588
Author: eem
Time: 22 November 2019, 12:54:50.761896 pm
UUID: f53bff41-2866-4ca9-a512-4665b1c5e74d
Ancestors: VMMaker.oscog-nice.2587

Slang for plugins:

Generaet more efficient code for dereferencing SmallInteger type parameters in SmartSyntaxPlugins.
Avoid a stack variable access by assigning to the target variable in the validation expression, and referring to the variable in the conversion expression, e.g. instead of

    sqInt v;

        if (!(isIntegerObject(stackValue(0))))
                return primitiveFailFor(PrimErrBadArgument);
        v = stackIntegerValue(0);

generate

    sqInt v;

        if (!(isIntegerObject(v = stackValue(0))))
                return primitiveFailFor(PrimErrBadArgument);
        v = integerValueOf(v);

Allow the Cog ProcessorSimulationPlugins to use the inlined macro definitions for isIntegerObject:, integerObjectOf: & integerValueOf: even though they're external plugins (since in single steppng, marshalling performance is at a premium).

=============== Diff against VMMaker.oscog-nice.2587 ===============

Item was changed:
  ----- Method: SmartSyntaxPluginAssignmentCodeGenerator>>ccgLoad:expr:asIntegerValueFrom: (in category 'coercing') -----
  ccgLoad: aBlock expr: aString asIntegerValueFrom: anInteger
+ "Assume the variable has already been assigned by SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asIntegerValueFrom:,
+ so merely convert it.  This avoids two stack accesses."
  ^String streamContents:
  [:aStream |
  aStream
  nextPutAll: aString;
+ nextPutAll: ' := interpreterProxy integerValueOf: ';
+ nextPutAll: aString]!
- nextPutAll: ' := interpreterProxy stackIntegerValue: ';
- print: anInteger]!

Item was changed:
  ----- Method: SmartSyntaxPluginValidationCodeGenerator>>ccgLoad:expr:asIntegerValueFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: variableName asIntegerValueFrom: stackIndex
+ "Cache the value in the variable to avoid accessing the stack more than once."
+ ^String streamContents:
+ [:aStream |
+ aStream
+ nextPutAll: 'interpreterProxy ';
+ nextPutAll: #isIntegerObject:;
+ nextPutAll: ' ('; nextPutAll: variableName; nextPutAll: ' := ';
+ nextPutAll: (self stackAccessorFor: stackIndex);
+ nextPut: $)]!
- ccgLoad: aBlock expr: aString asIntegerValueFrom: stackIndex
- ^self loadAs: #isIntegerObject: from: stackIndex!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>generateInterpreterProxyFunctionDereference:on:indent: (in category 'C translation') -----
  generateInterpreterProxyFunctionDereference: aNode on: aStream indent: anInteger
  | pluginsToClone |
  pluginsToClone := self pluginFunctionsToClone copyWithoutAll: self selectorsThatAreGeneratedAsMacros.
  pluginsToClone isEmpty ifTrue:
  [^self].
  aStream cr.
  self withConditionalDefineOf: 'SQUEAK_BUILTIN_PLUGIN'
  comment: nil
  on: aStream
  do: [pluginsToClone do:
  [:s| | cs |
+ self withGuardAgainstDefinitionOf: s on: aStream do:
+ [cs := self cFunctionNameFor: s.
+ self withOptionalVerbiageFor: s
- cs := self cFunctionNameFor: s.
- self withOptionalVerbiageFor: s
- on: aStream
- do: [aStream tab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;; cr]
- ifOptionalDo:
- [self
- withConditionalDefineOf: cs
- comment: nil
  on: aStream
+ do: [aStream tab: anInteger; nextPutAll: cs; nextPutAll: ' = interpreterProxy->'; nextPutAll: cs; nextPut: $;; cr]
+ ifOptionalDo:
+ [self
+ withConditionalDefineOf: cs
+ comment: nil
+ on: aStream
+ do: [aStream tab: anInteger; nextPutAll: cs; nextPutAll: ' = 0;'; cr]]]]]!
- do: [aStream tab: anInteger; nextPutAll: cs; nextPutAll: ' = 0;'; cr]]]]!

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 |
  self notePluginFunctionsUsedByMacros.
  (pluginFuncs := self pluginFunctionsToClone) isEmpty ifTrue:
  [^super preDeclareInterpreterProxyOn: aStream].
  (pluginFuncs includesAnyOf: self selectorsThatAreGeneratedAsMacros) ifTrue:
+ [self preDeclareMacrosForFastClassCheckingOn: aStream guardWith: #'SQUEAK_BUILTIN_PLUGIN'].
- [self preDeclareMacrosForFastClassCheckingOn: aStream].
  pluginFuncs := pluginFuncs copyWithoutAll: self selectorsThatAreGeneratedAsMacros.
  pluginFuncs isEmpty ifTrue:
  [^self].
  pluginFuncs := self collectAndCheckInterpreterProxyInterfaceFor: pluginFuncs verbose: false.
  aStream cr; nextPutAll: '#if !!defined(SQUEAK_BUILTIN_PLUGIN)'; cr.
  pluginFuncs do:
+ [:tMethod|
+ self withGuardAgainstDefinitionOf: tMethod selector on: aStream do:
+ [| 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]])]].
- [: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 withGuardAgainstDefinitionOf: tMethod selector on: aStream do:
  [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!

Item was removed:
- ----- Method: VMPluginCodeGenerator>>preDeclareMacrosForFastClassCheckingOn: (in category 'C code generator') -----
- preDeclareMacrosForFastClassCheckingOn: aStream
- "These macros can be used to check for various cases of Integer types.
- Since they can be defined based on existing API, this is a good trade off:
- - avoid extending the interpreterProxy API unnecessarily
- - provide fast type checking"
-
- "Speed-up generated code for internal plugins by using macros and fixed class indices to define this well known functionality."
- #( '#if defined(SQUEAK_BUILTIN_PLUGIN)' cr
-
- '# define isIntegerObject(oop) ((oop) & 1)' cr
-
- '# if SPURVM'
- 'extern sqInt classIndexOf(sqInt);'
- "Compact class indices are hardcoded here because there is no guarantee that the pool values at generation time
- are that of SPUR.. Make sure they are in sync with SpurMemoryManager class>>initializeCompactClassIndices"
- '# define LargeNegativeIntegerClassIndex 32'
- '# define LargePositiveIntegerClassIndex 33'
- '# if BytesPerOop == 4'
- '#  define isImmediate(oop) ((oop) & 3)'
- '# else'
- '#  define isImmediate(oop) ((oop) & 7)'
- '# endif'
- '# define isKindOfInteger(oop) (isImmediate(oop) ? isIntegerObject(oop) : (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'
- '# define isLargeIntegerObject(oop) (!!isImmediate(oop) && (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'
- '# define isLargeNegativeIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargeNegativeIntegerClassIndex)'
- '# define isLargePositiveIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargePositiveIntegerClassIndex)'
- '# endif /* SPURVM */'
- '#endif /* defined(SQUEAK_BUILTIN_PLUGIN) */' cr
-
- "If the functionality has not been defined via macros, define default versions using existing plugin API"
- '#if !!defined(isKindOfInteger)'
- '# define isLargeNegativeIntegerObject(oop) (fetchClassOf(oop) == classLargeNegativeInteger())'
- '# define isLargePositiveIntegerObject(oop) (fetchClassOf(oop) == classLargePositiveInteger())'
- '# define isLargeIntegerObject(oop) (isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'
- '# define isKindOfInteger(oop) (isIntegerObject(oop) || isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'
- '#endif' cr) do:
- [:element|
- aStream cr.
- element ~~ #cr ifTrue: [aStream nextPutAll: element]]!

Item was added:
+ ----- Method: VMPluginCodeGenerator>>preDeclareMacrosForFastClassCheckingOn:guardWith: (in category 'C code generator') -----
+ preDeclareMacrosForFastClassCheckingOn: aStream guardWith: guardMacroOrNil
+ "These macros can be used to check for various cases of Integer types.
+ Since they can be defined based on existing API, this is a good trade off:
+ - avoid extending the interpreterProxy API unnecessarily
+ - provide fast type checking"
+
+ "Speed-up generated code for internal plugins by using macros and fixed class indices to define this well known functionality."
+ (guardMacroOrNil ifNotNil: [{'#if defined(', guardMacroOrNil, ')'. #cr}] ifNil: [#()]),
+ #( '# define isIntegerObject(oop) ((oop) & 1)'
+ '# define integerObjectOf(oop) (((oop) << NumSmallIntegerTagBits) | 1)'
+ '# define integerValueOf(oop) ((oop) >> NumSmallIntegerTagBits)' cr
+
+ '# if SPURVM'
+ 'extern sqInt classIndexOf(sqInt);'
+ "Compact class indices are hardcoded here because there is no guarantee that the pool values at generation time
+ are that of SPUR.. Make sure they are in sync with SpurMemoryManager class>>initializeCompactClassIndices"
+ '# define LargeNegativeIntegerClassIndex 32'
+ '# define LargePositiveIntegerClassIndex 33'
+ '# if BytesPerOop == 4'
+ '#  define isImmediate(oop) ((oop) & 3)'
+ '# else'
+ '#  define isImmediate(oop) ((oop) & 7)'
+ '# endif'
+ '# define isKindOfInteger(oop) (isImmediate(oop) ? isIntegerObject(oop) : (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'
+ '# define isLargeIntegerObject(oop) (!!isImmediate(oop) && (unsigned)(classIndexOf(oop) - LargeNegativeIntegerClassIndex) <= 1)'
+ '# define isLargeNegativeIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargeNegativeIntegerClassIndex)'
+ '# define isLargePositiveIntegerObject(oop) (!!isImmediate(oop) && classIndexOf(oop) == LargePositiveIntegerClassIndex)'
+ '# endif /* SPURVM */'),
+ (guardMacroOrNil ifNotNil: [{'#endif /* defined(', guardMacroOrNil, ') */'}] ifNil: [#()]),
+
+ "If the functionality has not been defined via macros, define default versions using existing plugin API"
+ #( cr
+ '#if !!defined(isKindOfInteger)'
+ '# define isLargeNegativeIntegerObject(oop) (fetchClassOf(oop) == classLargeNegativeInteger())'
+ '# define isLargePositiveIntegerObject(oop) (fetchClassOf(oop) == classLargePositiveInteger())'
+ '# define isLargeIntegerObject(oop) (isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'
+ '# define isKindOfInteger(oop) (isIntegerObject(oop) || isLargeNegativeIntegerObject(oop) || isLargePositiveIntegerObject(oop))'
+ '#endif' cr) do:
+ [:element|
+ aStream cr.
+ element ~~ #cr ifTrue: [aStream nextPutAll: element]]!

Item was changed:
  ----- Method: VMPluginCodeGenerator>>selectorsThatMayBeGeneratedAsMacros (in category 'public') -----
  selectorsThatMayBeGeneratedAsMacros
  "Answer a list of selectors that maybe generated as a C macro rather than as an interpreterProxy function call."
 
+ ^self selectorsThatAreGeneratedAsMacros, #(isIntegerObject: integerValueOf: integerObjectOf: isImmediate:)!
- ^self selectorsThatAreGeneratedAsMacros, #(isIntegerObject: isImmediate:)!