VM Maker: VMMaker.oscog-eem.2404.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.2404.mcz

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

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

Name: VMMaker.oscog-eem.2404
Author: eem
Time: 6 June 2018, 8:50:34.703258 pm
UUID: 95c23edd-e78a-43a0-a3cf-408e3838ce84
Ancestors: VMMaker.oscog-eem.2403

Spur Compaction & Slang
Add support for static resolution of very limited polymorphism, specifically that required to select between the SpurSelectiveCompactor and the SpurPlanningCompactor at run-time, using SpurSelectiveCompactor for normal GC and SpurPlanningCompactor for snapshots.

SpurHybridCompactor is the compactorClass that selects between these two, based on its planNotSelect instance variable.  

CCodeGenerator gets a staticallyResolvedPolymorphicReceivers dictionary that aps variable names to classes, and hence SpurHybridCompactor maps planningCompactor to SpurPlanningCompactor and selectiveCompactor to SpurSelectiveCompactor.  Mapping of the selectors happens in TMethod>>prepareMethodIn: via CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:.

All the ugliness is in SpurCompa tor class and subclass implementations of declareCVarsIn:, where we have to map the methods themselves, mapping the API (e.g. SpurPlanningCompactor>>compact to SpurPlanningCompactor>>SPC_compact, and SpurSelectiveCompactor>>compact to SpurSelectiveCompactor>>SS_compact, because SpurSelectiveCompactor inherits from SpurSweeper and mapping things twice (once from compact to SS_compact and then subsequently from SS_compact to SSC_compact) is too tricky, whereas mapping all SpurSelectiveCompactor API methods to SS_... is much easier.

Remove the otherwise unreferenced biasForGC inst var from SpurSweeper because the Slang static resolution mechanism currently only supports name mangling of selectors, not instance variables.  If and when we need this we can implement it, but for the moment KISS.

To generate a VM using SpurHybridCompactor siomply set the compactorClass SpurHybridCompactor option in the VMMaker options, e.g.

generateSqueakSpurCog64VM
        "No primitives since we can use those for the Cog VM"
        ^VMMaker
                generate: CoInterpreter
                and: StackToRegisterMappingCogit
                with: #(ObjectMemory Spur64BitCoMemoryManager
                                compactorClass SpurHybridCompactor
                                MULTIPLEBYTECODESETS true
                                bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
                to: (FileDirectory default pathFromURI: self sourceTree, '/spur64src')
                platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
                including:#()

WARNING Will Robinson!  I have only tested the Slang generation and VM compilation.  I jhave not checked whether this runs in the simulator yet.  Yes, that's backwards, but I expect this is far enough along that getting the sdimulator to work should be easy; it's the simple bit.

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

Item was changed:
  Object subclass: #CCodeGenerator
+ instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker'
- instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker'
  classVariableNames: 'NoRegParmsInAssertVMs'
  poolDictionaries: 'VMBasicConstants'
  category: 'VMMaker-Translation to C'!
 
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was added:
+ ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: (in category 'public') -----
+ ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode
+ "We allow a limited amount of polymorphism; if a class chooses, its selectoers can be
+ prefixed with a given string to disambiguate. This hack allows us to use two different
+ compaction algorithms with the same API at the same time; the selection being done
+ by a class which holds the flag stating which algorithm is in effect at the current time."
+ | class |
+ staticallyResolvedPolymorphicReceivers ifNil: [^self].
+ aSendNode receiver isVariable ifFalse:
+ [^self].
+ class := staticallyResolvedPolymorphicReceivers
+ at: aSendNode receiver name
+ ifAbsent: [^self].
+ aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)!

Item was added:
+ ----- Method: CCodeGenerator>>methodsForDefiningClass: (in category 'utilities') -----
+ methodsForDefiningClass: dc
+ "Answer a collection of methods that refer to the given global variable."
+
+ ^methods select: [:tMethod| tMethod definingClass == dc]!

Item was added:
+ ----- Method: CCodeGenerator>>staticallyResolveMethodNamed:forClass:to: (in category 'public') -----
+ staticallyResolveMethodNamed: selector forClass: aClass to: staticallyResolvedSelector
+ "We allow a limited amount of polymorphism; if a class chooses, its selectoers can be
+ prefixed with a given string to disambiguate. This hack allows us to use two different
+ compaction algorithms with the same API at the same time; the selection being done
+ by a class which holds the flag stating which algorithm is in effect at the current time."
+ | method |
+ method := methods
+ removeKey: selector
+ ifAbsent:
+ [self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector.
+ ^self].
+ method selector: staticallyResolvedSelector.
+ methods at: staticallyResolvedSelector put: method!

Item was added:
+ ----- Method: CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to: (in category 'public') -----
+ staticallyResolvedPolymorphicReceiver: variableName to: aClass
+ "We allow a limited amount of polymorphism; if a class chooses, its selectoers can be
+ prefixed with a given string to disambiguate. This hack allows us to use two different
+ compaction algorithms with the same API at the same time; the selection being done
+ by a class which holds the flag stating which algorithm is in effect at the current time."
+ (staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new])
+ at: variableName
+ put: aClass!

Item was changed:
  TMethod subclass: #SmartSyntaxPluginTMethod
  instanceVariableNames: 'isPrimitive suppressingFailureGuards fullSelector fullArgs parmSpecs rcvrSpec'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-SmartSyntaxPlugins'!
 
+ !SmartSyntaxPluginTMethod commentStamp: 'eem 6/6/2018 14:06' prior: 0!
+ Variation of TMethod node of the Smalltalk C Code Generator, used in conjunction with SmartSyntaxPluginCodeGenerator and SmartSyntaxInterpreterPlugin to generate named primitives from methods containing type coercion specifications such as
+ primitive: functionName parameters: #(Boolean Oop String WordsArray WordsOrBytes)
+ primitive: functionName parameters: #(SmallInteger LargeNegativeInteger LargePositiveInteger Integer Unsigned) receiver: #Oop!
- !SmartSyntaxPluginTMethod commentStamp: '<historical>' prior: 0!
- Variation of TMethod node of the Smalltalk C Code Generator, used in conjunction with TestCodeGenerator and TestInterpreterPlugin to generate named primitives with type coercion specifications.!

Item was changed:
+ ----- Method: SmartSyntaxPluginTMethod>>fromContext:primitive:parameters:receiver: (in category 'initialization') -----
- ----- Method: SmartSyntaxPluginTMethod>>fromContext:primitive:parameters:receiver: (in category 'initializing') -----
  fromContext: aContext primitive: aString parameters: aClassList receiver: aClass
 
  fullArgs := args := aContext tempNames
  copyFrom: 1
  to: aContext method numArgs.
  self
  primitive: aString
  parameters: aClassList
  receiver: aClass!

Item was changed:
+ ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initialization') -----
- ----- Method: SmartSyntaxPluginTMethod>>setSelector:definingClass:args:locals:block:primitive:properties:comment: (in category 'initializing') -----
  setSelector: sel definingClass: class args: argList locals: localList block: aBlockNode primitive: aNumber properties: methodProperties comment: aComment
  "Initialize this method using the given information."
 
  selector := sel.
  definingClass := class.
  returnType := #sqInt. "assume return type is sqInt for now"
  args := argList asOrderedCollection collect: [:arg | arg key].
  locals := (localList collect: [:arg | arg key]) asSet.
  declarations := Dictionary new.
  primitive := aNumber.
  properties := methodProperties.
  comment := aComment.
  parseTree := aBlockNode asTranslatorNodeIn: self.
  labels := Set new.
  complete := false.  "set to true when all possible inlining has been done"
  export := self extractExportDirective.
  static := self extractStaticDirective.
  self extractSharedCase.
  isPrimitive := false.  "set to true only if you find a primtive direction."
  suppressingFailureGuards := self extractSuppressFailureGuardDirective.
  self recordDeclarationsIn: nil.
  self extractPrimitiveDirectives.
  !

Item was added:
+ ----- Method: SpurCompactor class>>classesForTranslation (in category 'translation') -----
+ classesForTranslation
+ ^(self withAllSuperclasses copyUpThrough: SpurCompactor) reverse!

Item was added:
+ ----- Method: SpurCompactor class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ "If subclasses are being used but are not the compactorClass itself
+ then staticvally resolve their api selectors."
+ ((self inheritsFrom: SpurCompactor)
+ and: [(initializationOptions at: #compactorClass) ~= self name]) ifTrue:
+ [#(compact biasForGC biasForSnapshot remapObj: shouldRemapObj:) do:
+ [:selectorToStaticallyResolve|
+ aCCodeGenerator
+ staticallyResolveMethodNamed: selectorToStaticallyResolve
+ forClass: self
+ to: (self staticallyResolvePolymorphicSelector: selectorToStaticallyResolve)]]!

Item was changed:
+ ----- Method: SpurCompactor class>>implicitReturnTypeFor: (in category 'translation') -----
- ----- Method: SpurCompactor class>>implicitReturnTypeFor: (in category 'as yet unclassified') -----
  implicitReturnTypeFor: aSelector
  "Answer the return type for methods that don't have an explicit return."
  ^#void!

Item was added:
+ ----- Method: SpurCompactor>>scavenger: (in category 'initialization') -----
+ scavenger: aSpurGenerationScavenger
+ <doNotGenerate>
+ scavenger := aSpurGenerationScavenger!

Item was added:
+ SpurCompactor subclass: #SpurHybridCompactor
+ instanceVariableNames: 'planningCompactor selectiveCompactor planNotSelect'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurMemoryManager'!
+
+ !SpurHybridCompactor commentStamp: 'eem 6/6/2018 19:25' prior: 0!
+ A SpurHybridCompactor is a compactor that uses SpurSelectiveCompactor for normal GC compactions, but uses SpurPlanningCompactor for snapshot.
+
+ Instance Variables
+ planNotSelect: <Boolean>
+ planningCompactor: <SpurPlanningCompactor>
+ selectiveCompactor: <SpurSelectiveCompactor>
+
+ planNotSelect
+ - the boolean that selects between the two compactors; if true it chooses SpurPlanningCompactor
+
+ planningCompactor
+ - the SpurPlanningCompactor
+
+ selectiveCompactor
+ - the SpurSelectiveCompactor
+ !

Item was added:
+ ----- Method: SpurHybridCompactor class>>ancilliaryClasses: (in category 'translation') -----
+ ancilliaryClasses: options
+ "Answer any extra classes to be included in the translation."
+ ^{ SpurPlanningCompactor.
+ SpurSelectiveCompactor.
+ SpurSweeper }!

Item was added:
+ ----- Method: SpurHybridCompactor class>>classesForTranslation (in category 'translation') -----
+ classesForTranslation
+ ^(self ancilliaryClasses: nil), super classesForTranslation!

Item was added:
+ ----- Method: SpurHybridCompactor class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ aCCodeGenerator
+ staticallyResolvedPolymorphicReceiver: 'planningCompactor' to: SpurPlanningCompactor;
+ staticallyResolvedPolymorphicReceiver: 'selectiveCompactor' to: SpurSweeper"SpurSelectiveCompactor" "The selector mangling is easier this way"!

Item was added:
+ ----- Method: SpurHybridCompactor>>biasForGC (in category 'api') -----
+ biasForGC
+ planNotSelect := false.
+ selectiveCompactor biasForGC!

Item was added:
+ ----- Method: SpurHybridCompactor>>biasForSnapshot (in category 'api') -----
+ biasForSnapshot
+ planNotSelect := true.
+ planningCompactor biasForSnapshot!

Item was added:
+ ----- Method: SpurHybridCompactor>>coInterpreter: (in category 'initialization') -----
+ coInterpreter: aVMSimulator
+ <doNotGenerate>
+ super coInterpreter: aVMSimulator.
+ planningCompactor coInterpreter: aVMSimulator.
+ selectiveCompactor coInterpreter: aVMSimulator!

Item was added:
+ ----- Method: SpurHybridCompactor>>compact (in category 'api') -----
+ compact
+ planNotSelect
+ ifTrue: [planningCompactor compact]
+ ifFalse: [selectiveCompactor compact]!

Item was added:
+ ----- Method: SpurHybridCompactor>>manager: (in category 'initialization') -----
+ manager: aSpurNBitMMXEndianSimulator
+ <doNotGenerate>
+ super manager: aSpurNBitMMXEndianSimulator.
+ (planningCompactor ifNil: [planningCompactor := SpurPlanningCompactor simulatorClass new])
+ manager: aSpurNBitMMXEndianSimulator.
+ (selectiveCompactor ifNil: [selectiveCompactor := SpurSelectiveCompactor simulatorClass new])
+ manager: aSpurNBitMMXEndianSimulator.
+
+ planNotSelect := false!

Item was added:
+ ----- Method: SpurHybridCompactor>>remapObj: (in category 'api') -----
+ remapObj: objOop
+ <api>
+ <inline: false>
+ planNotSelect ifTrue:
+ [^manager slidingCompactionRemapObj: objOop].
+ ^super remapObj: objOop!

Item was added:
+ ----- Method: SpurHybridCompactor>>scavenger: (in category 'initialization') -----
+ scavenger: aSpurGenerationScavenger
+ <doNotGenerate>
+ super scavenger: aSpurGenerationScavenger. "I always thought the scavenger was super..."
+ planningCompactor scavenger: aSpurGenerationScavenger.
+ selectiveCompactor scavenger: aSpurGenerationScavenger!

Item was added:
+ ----- Method: SpurHybridCompactor>>shouldRemapObj: (in category 'api') -----
+ shouldRemapObj: objOop
+ <api>
+ <inline: false>
+ planNotSelect ifTrue:
+ [^manager slidingCompactionShouldRemapObj: objOop].
+ ^super shouldRemapObj: objOop!

Item was changed:
  ----- Method: SpurMemoryManager class>>ancilliaryClasses: (in category 'translation') -----
  ancilliaryClasses: options
  initializationOptions ifNil: [initializationOptions := options].
  ^{ SpurGenerationScavenger. SpurScavengeLogRecord. SpurSegmentManager. SpurSegmentInfo },
+ self compactorClass classesForTranslation,
- (self compactorClass withAllSuperclasses copyUpThrough: SpurCompactor) reverse,
  SpurNewSpaceSpace withAllSubclasses
 
  !

Item was changed:
  ----- Method: SpurMemoryManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
  isNonArgumentImplicitReceiverVariableName: aString
+ ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'planningCompactor' 'selectiveCompactor' 'heapMap') includes: aString!
- ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'heapMap') includes: aString!

Item was changed:
  ----- Method: SpurPlanningCompactor class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ super declareCVarsIn: aCCodeGenerator.
  self declareCAsOop: (self instVarNames select: [:iv| iv endsWith: 'Object']) in: aCCodeGenerator.
  aCCodeGenerator
  var: 'savedFirstFieldsSpace' type: #SpurContiguousObjStack!

Item was changed:
  ----- Method: SpurSelectiveCompactor class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ super declareCVarsIn: aCCodeGenerator.
  aCCodeGenerator var: 'segmentToFill' type: #'SpurSegmentInfo *'!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>findNextSegmentToCompact (in category 'compaction') -----
  findNextSegmentToCompact
  "Answers the next segment to compact or nil if none.
   The next segment to compact:
  - cannot be segment 0 (Segment 0 has specific objects
   (nil, true, etc.) and special size computed at start-up
   that we don't want to deal with)
  - cannot have a high occupation rate (> MaxOccupationForCompaction)"
  | leastOccupied leastOccupiedSegment tempOccupied segInfo |
  <var: 'segInfo' type: #'SpurSegmentInfo *'>
  leastOccupied := 16rFFFF.
  1 to: manager numSegments - 1 do:
  [:i|
  segInfo := self addressOf: (manager segmentManager segments at: i).
  ((self isSegmentBeingCompacted: segInfo) or: [segInfo containsPinned or: [manager segmentManager isEmptySegment: segInfo] ])
  ifFalse:
  [(tempOccupied := self occupationOf: segInfo) <= leastOccupied
  ifTrue: [ leastOccupied := tempOccupied.
  leastOccupiedSegment := segInfo ]]].
+ leastOccupied > MaxOccupationForCompaction ifTrue:
+ [^self cCoerceSimple: nil to: #'SpurSegmentInfo *'].
+ ^leastOccupiedSegment!
- leastOccupied > MaxOccupationForCompaction ifTrue: [^nil].
- ^ leastOccupiedSegment!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>postSwizzleAction (in category 'api') -----
  postSwizzleAction
+ "Since the compact abuses the swizzle field of segment, it needs to be reset after start-up."
- "Since the compact abuses the swizzle field of segment, it needs to be rest after start-up."
  | segInfo |
  <var: 'segInfo' type: #'SpurSegmentInfo *'>
  0 to: manager numSegments - 1 do:
  [:i|
  segInfo := self addressOf: (manager segmentManager segments at: i).
  segInfo swizzle: 0 ]!

Item was changed:
  SpurCompactor subclass: #SpurSweeper
+ instanceVariableNames: ''
- instanceVariableNames: 'biasForGC'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-SpurMemoryManager'!
 
  !SpurSweeper commentStamp: 'cb 4/27/2018 09:43' prior: 0!
  SpurSweeper is a sweep-only algorithm, setting the compactor to SpurSweeper effectively changes the fullGC to a mark-sweep non-moving algorithm.
 
  SpurSweeper is a reference implementation if one wants to evaluate GC performance and compare it to a Mark-Sweep. It's also the only non-moving GC available right now which can be convenient for some experiments. One of the main reason why it was implemented is because advanced compaction algorithm includes a sweep phase (See SelectiveCompactor for example) and SpurSweeper allows to debug the sweep phase separatedly.
  !

Item was changed:
  ----- Method: SpurSweeper>>biasForGC (in category 'api') -----
+ biasForGC!
- biasForGC
- biasForGC := true.!

Item was changed:
  ----- Method: SpurSweeper>>biasForSnapshot (in category 'api') -----
+ biasForSnapshot!
- biasForSnapshot
- biasForGC := false.!

Item was changed:
+ ----- Method: TMethod>>addTypeForSelf (in category 'initialization') -----
- ----- Method: TMethod>>addTypeForSelf (in category 'utilities') -----
  addTypeForSelf
  "If self should be typed then add a suitable type declaration.
  Preserve the flagging of an implicit self using the #implicit symbol as the fake type."
  self typeForSelf ifNotNil:
  [:typeForSelf|
  self declarationAt: 'self'
  put: (typeForSelf == #implicit
  ifTrue: [typeForSelf]
  ifFalse: [typeForSelf, ' self'])]!

Item was changed:
  ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
  prepareMethodIn: aCodeGen
  "Record sends of builtin operators, map sends of the special selector dispatchOn:in:
  with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
  Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects.
  As a hack also update the types of variables introduced to implement cascades correctly.
  This has to be done at the same time as this is done, so why not piggy back here?"
  extraVariableNumber ifNotNil:
  [declarations keysAndValuesDo:
  [:varName :decl|
  decl isBlock ifTrue:
  [self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
  locals add: varName.
  self declarationAt: varName
  put: (decl value: self value: aCodeGen), ' ', varName]]].
  aCodeGen
  pushScope: declarations
  while:"N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
  [parseTree nodesWithParentsDo:
  [:node :parent|
  node isSend ifTrue:
+ [aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node.
+ (aCodeGen isBuiltinSelector: node selector)
- [(aCodeGen isBuiltinSelector: node selector)
  ifTrue:
  [node isBuiltinOperator: true.
  "If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
  node selector = #to:by:do: ifTrue:
  [self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]]
  ifFalse:
  [(CaseStatements includes: node selector) ifTrue:
  [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})].
  (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
  [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })].
  (#(printf: f:printf:) includes: node selector) ifTrue:
  [| map |
  map := Dictionary new.
  node nodesDo:
  [:subNode|
  (subNode isConstant and: [subNode value isString and: [subNode value includes: $%]]) ifTrue:
  [map at: subNode put: subNode asPrintfFormatStringNode].
  node replaceNodesIn: map]]]]]]!

Item was added:
+ ----- Method: TSendNode>>selector: (in category 'accessing') -----
+ selector: aSymbol
+ selector := aSymbol!

Item was added:
+ ----- Method: VMClass class>>staticallyResolvePolymorphicSelector: (in category 'translation') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+ ^((self name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol!