nicolas cellier uploaded a new version of Smallapack-OpalCompiler to project Smallapack: http://www.squeaksource.com/Smallapack/Smallapack-OpalCompiler-nice.1.mcz ==================== Summary ==================== Name: Smallapack-OpalCompiler-nice.1 Author: nice Time: 9 January 2019, 10:06:51.934402 pm UUID: 3f42d7a1-9630-46c3-b388-08ba6f735982 Ancestors: WIP on a variant of Opal COmpiler for implementing methods and sending messages with more than 15 arguments. The core principles have been implemented, but generated compiled methods are not correct right now (crash the VM). Either the number of temps or the stack depth is incorrect, or something else... To be inquired further. Missing: - some Reflectivity extensions - Decompiler support - Support for FFI call with more than 15 arguments ==================== Snapshot ==================== SystemOrganization addCategory: #'Smallapack-OpalCompiler'! RFSemanticAnalyzer subclass: #SLRFSemanticAnalyzer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLRFSemanticAnalyzer commentStamp: 'nice 1/9/2019 21:23' prior: 0! I am the Reflective semantic analyzer for Smallapack Opal Compiler. I know how to deal with method arguments when they are passed thru a single array.! ----- Method: SLRFSemanticAnalyzer>>visitMethodNode: (in category 'visitor') ----- visitMethodNode: aMethodNode aMethodNode arguments size < 16 ifTrue: [ ^super visitMethodNode: aMethodNode ]. ^self visitMethodNodeWithManyArgs: aMethodNode! IRPushRemoteTemp subclass: #IRPushArrayedArg instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !IRPushArrayedArg commentStamp: 'nice 1/9/2019 20:57' prior: 0! I represent an instruction for pushing an argument of a method on the stack. I am used when arguments have been packed into a single array.! ----- Method: IRPushArrayedArg>>accept: (in category 'visiting') ----- accept: aVisitor ^ aVisitor visitPushArrayedArg: self! ----- Method: IRVisitor>>visit1ArrayForAllArgument: (in category '*Smallapack-OpalCompiler') ----- visit1ArrayForAllArgument: oneArray! ----- Method: IRVisitor>>visitPushArrayedArg: (in category '*Smallapack-OpalCompiler') ----- visitPushArrayedArg: pushArrayedArg! IRMethod subclass: #SLIRMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLIRMethod commentStamp: 'nice 1/9/2019 20:52' prior: 0! I am the IRMethod for Smallapack Opal Compiler My sole interest is to use SLCompilationContext! ----- Method: SLIRMethod>>compilationContext (in category 'accessing') ----- compilationContext ^ compilationContext ifNil: [ "only happens when decompiling or using stand-alone" compilationContext := SLCompilationContext default]! OCASTTranslatorForValue subclass: #SLASTTranslatorForValue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLASTTranslatorForValue commentStamp: 'nice 1/9/2019 21:12' prior: 0! I am an auxiliary of AST to IR translator for Smallapack Opal Compiler. I generate instructions that keep resulting value on the execution stack. I am specialized for sending messages with more than 15 arguments.! ----- Method: SLASTTranslatorForValue>>classForEffect (in category 'initialization') ----- classForEffect ^SLASTTranslatorForEffect ! ----- Method: SLASTTranslatorForValue>>classForValue (in category 'initialization') ----- classForValue ^SLASTTranslatorForValue! ----- Method: SLASTTranslatorForValue>>emitMessageNode: (in category 'visitor-double dispatching') ----- emitMessageNode: aMessageNode aMessageNode arguments size < 16 ifTrue: [ ^super emitMessageNode: aMessageNode ]. ^ self emitMessageNodeWithManyArgs: aMessageNode! OpalCompiler subclass: #SLOpalCompiler instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLOpalCompiler commentStamp: 'nice 1/9/2019 21:55' prior: 0! I am a variant of Opal Compiler used for Smallapack. I am able to generate methods with more than 15 arguments, and send messages with more than 15 arguments. My strategy is to pass ALL arguments into a single array argument when more than 15. An alternative proposed by Eliot Miranda would be to pass 14 first arguments unchanged, and all excess arguments into an array in 15th-position. But my purpose for Smallapack is to generate FFI calls, and for that, a single array of arguments is required, that explains why the single array for all arguments has my preference. For this purpose, I am using a specialized compilation context.! ----- Method: SLOpalCompiler>>compilationContextClass (in category 'accessing') ----- compilationContextClass ^compilationContextClass ifNil: [ SLCompilationContext ]! ReflectiveMethod variableSubclass: #SLReflectiveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLReflectiveMethod commentStamp: 'nice 1/9/2019 21:28' prior: 0! I am a Reflective method for Smallapack Opal compiler. I am using specialized ancillary classes that can deal with messages/methods with more than 15 args. I am currently unused, because the class name for original Opal Compiler is encoded to deeply in existing code base (CompiledMethod), see references to my superclass ReflectiveMethod. CompiledMethod is a class known to the VM, so we cannot easily substitute it for referencing SLReflectiveMethod instead. PLEASE FIX ME.! ----- Method: SLReflectiveMethod>>generatePrimitiveWrapper (in category 'evaluation') ----- generatePrimitiveWrapper | wrappedMethod send wrapperMethod | OCASTSemanticCleaner clean: ast. ast compilationContext semanticAnalyzerClass: SLRFSemanticAnalyzer; astTranslatorClass: SLRFASTTranslator. ast doSemanticAnalysis. "force semantic analysis" wrappedMethod := ast generate: compiledMethod trailer. send := RBMessageNode receiver: (RBSelfNode named: #self) selector: #rFwithArgs:executeMethod: arguments: {RBArrayNode statements: ast arguments . (RBLiteralNode value: wrappedMethod)}. wrapperMethod := RBMethodNode selector: ast selector arguments: ast arguments body: (RBReturnNode value: send) asSequenceNode. wrapperMethod methodClass: ast methodClass. wrapperMethod propertyAt: #wrappedPrimitive put: true. ast hasMetalink ifTrue: [wrapperMethod propertyAt: #links put: (ast propertyAt: #links)]. ast := wrapperMethod.! ----- Method: SLReflectiveMethod>>recompileAST (in category 'evaluation') ----- recompileAST | links | OCASTSemanticCleaner clean: ast. ast compilationContext semanticAnalyzerClass: RFSemanticAnalyzer; astTranslatorClass: SLRFASTTranslator. ast doSemanticAnalysis. "force semantic analysis" compiledMethod := ast generate: compiledMethod trailer. compiledMethod reflectiveMethod: self.! ----- Method: OCASTSemanticAnalyzer>>declareArrayedArgumentNode: (in category '*Smallapack-OpalCompiler') ----- declareArrayedArgumentNode: aVariableNode ^self declareVariableNode: aVariableNode as: (SLArrayedArgumentVariable new vectorName: scope arrayArgumentName)! ----- Method: OCASTSemanticAnalyzer>>visitMethodNodeWithManyArgs: (in category '*Smallapack-OpalCompiler') ----- visitMethodNodeWithManyArgs: aMethodNode scope := compilationContext scope newMethodScope. aMethodNode scope: scope. scope node: aMethodNode. self declareArgumentNode: (RBArgumentNode named: scope arrayArgumentName). aMethodNode arguments do: [:node | self declareArrayedArgumentNode: node ]. aMethodNode pragmas do: [:each | self visitNode: each]. self visitNode: aMethodNode body. scope := scope outerScope.! OCASTSemanticAnalyzer subclass: #SLASTSemanticAnalyzer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLASTSemanticAnalyzer commentStamp: 'nice 1/9/2019 21:01' prior: 0! I am the AST semantic analyzer for Smallapack Opal Compiler. I am here for mapping argument names to argument index when all arguments are passed in a single array. This single array argument construct is used for by-passing the 15-argument limit.! ----- Method: SLASTSemanticAnalyzer>>visitMethodNode: (in category 'visitor') ----- visitMethodNode: aMethodNode aMethodNode arguments size < 16 ifTrue: [ ^super visitMethodNode: aMethodNode ]. ^self visitMethodNodeWithManyArgs: aMethodNode! RFASTTranslatorForEffect subclass: #SLRFASTTranslatorForEffect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLRFASTTranslatorForEffect commentStamp: 'nice 1/9/2019 21:12' prior: 0! I am an auxiliary of Refective AST to IR translator for Smallapack Opal Compiler. I generate instructions that pop resulting value from the execution stack. I am specialized for sending messages with more than 15 arguments.! ----- Method: SLRFASTTranslatorForEffect>>classForEffect (in category 'initialization') ----- classForEffect ^SLRFASTTranslatorForEffect ! ----- Method: SLRFASTTranslatorForEffect>>classForValue (in category 'initialization') ----- classForValue ^SLRFASTTranslatorForValue! ----- Method: SLRFASTTranslatorForEffect>>emitMessageNode: (in category 'visitor-double dispatching') ----- emitMessageNode: aMessageNode aMessageNode arguments size < 16 ifTrue: [ ^super emitMessageNode: aMessageNode ]. ^ self emitMessageNodeWithManyArgs: aMessageNode! ----- Method: SLRFASTTranslatorForEffect>>emitMessageNodeWithManyArgs: (in category 'visitor-double dispatching') ----- emitMessageNodeWithManyArgs: aMessageNode super emitMessageNodeWithManyArgs: aMessageNode. methodBuilder popTop.! ----- Method: RFASTTranslator>>emitMessageNodeWithManyArgs: (in category '*Smallapack-OpalCompiler') ----- emitMessageNodeWithManyArgs: aMessageNode | argArrayNode | self emitPrepareLinkAfter: aMessageNode. aMessageNode isCascaded ifFalse: [ valueTranslator visitNode: aMessageNode receiver ]. argArrayNode := (RBArrayNode statements: aMessageNode arguments). valueTranslator visitNode: argArrayNode. self emitMetaLinkBefore: aMessageNode. aMessageNode hasMetalinkInstead ifTrue: [ self emitMetaLinkInstead: aMessageNode ] ifFalse: [ aMessageNode isSuperSend ifTrue: [ methodBuilder send: aMessageNode selector toSuperOf: self compilationContext getClass ] ifFalse: [ methodBuilder send: aMessageNode selector ] ]. self emitMetaLinkAfter: aMessageNode.! RFASTTranslator subclass: #SLRFASTTranslator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLRFASTTranslator commentStamp: 'nice 1/9/2019 21:05' prior: 0! I am a reflective AST to IR translator for Smallapack Opal Compiler. I know how to produce instructions for methods with more than 15 arguments. And I use instruction generators for value/effect that know how to generate message sends with more than 15 arguments.! ----- Method: SLRFASTTranslator>>classForEffect (in category 'initialization') ----- classForEffect ^SLRFASTTranslatorForEffect ! ----- Method: SLRFASTTranslator>>classForValue (in category 'initialization') ----- classForValue ^SLRFASTTranslatorForValue! ----- Method: SLRFASTTranslator>>initialize (in category 'initialization') ----- initialize methodBuilder := SLIRBuilder new. effectTranslator := self as: self classForEffect. valueTranslator := self as: self classForValue. effectTranslator instVarNamed: #effectTranslator put: effectTranslator. effectTranslator instVarNamed: #valueTranslator put: valueTranslator. valueTranslator instVarNamed: #valueTranslator put: valueTranslator. ! ----- Method: SLRFASTTranslator>>visitMethodNode: (in category 'visitor-double dispatching') ----- visitMethodNode: aMethodNode aMethodNode arguments size > 15 ifFalse: [ ^super visitMethodNode: aMethodNode ]. ^self visitMethodNodeWithManyArgs: aMethodNode! RFASTTranslatorForValue subclass: #SLRFASTTranslatorForValue instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLRFASTTranslatorForValue commentStamp: 'nice 1/9/2019 21:13' prior: 0! I am an auxiliary of Reflective AST to IR translator for Smallapack Opal Compiler. I generate instructions that keep resulting value on the execution stack. I am specialized for sending messages with more than 15 arguments.! ----- Method: SLRFASTTranslatorForValue>>classForEffect (in category 'initialization') ----- classForEffect ^SLRFASTTranslatorForEffect ! ----- Method: SLRFASTTranslatorForValue>>classForValue (in category 'initialization') ----- classForValue ^SLRFASTTranslatorForValue! ----- Method: SLRFASTTranslatorForValue>>emitMessageNode: (in category 'visitor-double dispatching') ----- emitMessageNode: aMessageNode aMessageNode arguments size < 16 ifTrue: [ ^super emitMessageNode: aMessageNode ]. ^ self emitMessageNodeWithManyArgs: aMessageNode! ----- Method: IRTranslatorV2>>visit1ArrayForAllArgument: (in category '*Smallapack-OpalCompiler') ----- visit1ArrayForAllArgument: oneArray "Don't generate code, but remember the associated variables" tempVectorStack push: oneArray.! ----- Method: IRTranslatorV2>>visitPushArrayedArg: (in category '*Smallapack-OpalCompiler') ----- visitPushArrayedArg: remoteTemp | tempIndex argumentRank tempVector | tempVector := tempVectorStack detect: [:each | each name = remoteTemp tempVectorName]. "we may hardcode 0 because we know that the argument array is the first temp" tempIndex := self currentScope indexForVarNamed: remoteTemp tempVectorName. argumentRank := tempVector indexForVarNamed: remoteTemp name. gen pushRemoteTemp: argumentRank inVectorAt: tempIndex ! OCArgumentVariable variableSubclass: #SLArrayedArgumentVariable instanceVariableNames: 'vectorName' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLArrayedArgumentVariable commentStamp: 'nice 1/9/2019 21:07' prior: 0! I represent an argument variable for the case when several arguments are passed into an array. Such construct is used to bypass the 15-arguments limit. I remember the name of the array variable (vectorName), and I know how to generate instructions for reading the argument variable (push it on the stack). ! ----- Method: SLArrayedArgumentVariable>>emitValue: (in category 'emitting') ----- emitValue: methodBuilder methodBuilder pushArrayedArg: name inVector: vectorName.! ----- Method: SLArrayedArgumentVariable>>vectorName (in category 'accessing') ----- vectorName ^ vectorName! ----- Method: SLArrayedArgumentVariable>>vectorName: (in category 'accessing') ----- vectorName: anObject vectorName := anObject! IRBytecodeGenerator subclass: #SLIRBytecodeGenerator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLIRBytecodeGenerator commentStamp: 'nice 1/9/2019 21:34' prior: 0! I transform IR instructions into a sequence of bytecodes for Smallapack Opal Compiler. I am specialized for sending messages with more than 15 arguments. I also handle a correct method header for a method with more than 15 arguments.! ----- Method: SLIRBytecodeGenerator>>numArgs: (in category 'accessing') ----- numArgs: anInteger "For writing the CompiledMethod header, we know that 16 arguments or more will be passed into a single array argument." numArgs := anInteger > 15 ifTrue: [ 1 ] ifFalse: [ anInteger ]! ----- Method: SLIRBytecodeGenerator>>send: (in category 'instructions') ----- send: selector | nArgs | nArgs := selector numArgs. nArgs > 15 ifTrue: [ nArgs := 1 ]. stack pop: nArgs. (self encoderClass specialSelectors includes: selector) ifTrue: [ ^ encoder genSendSpecial: (self encoderClass specialSelectors indexOf: selector) numArgs: nArgs ]. encoder genSend: (self literalIndexOf: selector) numArgs: nArgs! ----- Method: SLIRBytecodeGenerator>>send:toSuperOf: (in category 'instructions') ----- send: selector toSuperOf: behavior (encoder class = OpalEncoderForSistaV1 and: [ inBlock ]) ifTrue: [ | index nArgs | behavior isTrait ifTrue: [ "Trait methods are copied to the users and only the last literal is updated. For directed super send the literal of the super send should be updated too." self error: 'not supported' ]. nArgs := selector numArgs. nArgs > 15 ifTrue: [ nArgs := 1 ]. stack pop: nArgs. encoder genPushLiteralVar: (self literalIndexOf: behavior binding). index := self literalIndexOf: selector. encoder genSendDirectedSuper: index numArgs: nArgs ] ifFalse: [ | index nArgs | nArgs := selector numArgs. nArgs > 15 ifTrue: [ nArgs := 1 ]. stack pop: nArgs. self addLastLiteral: behavior binding. index := self literalIndexOf: selector. encoder genSendSuper: index numArgs: nArgs ] ! OCASTTranslatorForEffect subclass: #SLASTTranslatorForEffect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLASTTranslatorForEffect commentStamp: 'nice 1/9/2019 21:12' prior: 0! I am an auxiliary of AST to IR translator for Smallapack Opal Compiler. I generate instructions that pop resulting value from the execution stack. I am specialized for sending messages with more than 15 arguments.! ----- Method: SLASTTranslatorForEffect>>classForEffect (in category 'initialization') ----- classForEffect ^SLASTTranslatorForEffect ! ----- Method: SLASTTranslatorForEffect>>classForValue (in category 'initialization') ----- classForValue ^SLASTTranslatorForValue! ----- Method: SLASTTranslatorForEffect>>emitMessageNode: (in category 'visitor-double dispatching') ----- emitMessageNode: aMessageNode aMessageNode arguments size < 16 ifTrue: [ ^super emitMessageNode: aMessageNode ]. ^ self emitMessageNodeWithManyArgs: aMessageNode! ----- Method: SLASTTranslatorForEffect>>emitMessageNodeWithManyArgs: (in category 'visitor-double dispatching') ----- emitMessageNodeWithManyArgs: aMessageNode super emitMessageNodeWithManyArgs: aMessageNode. methodBuilder popTop.! IRTempVector variableSubclass: #IR1ArrayForAllArgument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !IR1ArrayForAllArgument commentStamp: 'nice 1/9/2019 21:03' prior: 0! I represent a pseudo instruction used when passing all arguments into a single Array This construct is used for by-passing the 15-arguments limitation of bytecode (more exactly, the limitation of CompiledCode header). I do not generate any code, because there isn't any code needed. I am there only for mapping argument variable names to 0-based position into the array.! ----- Method: IR1ArrayForAllArgument>>accept: (in category 'visiting') ----- accept: aVisitor ^ aVisitor visit1ArrayForAllArgument: self! ----- Method: IRPrinterV2>>visitPushArrayedArg: (in category '*Smallapack-OpalCompiler') ----- visitPushArrayedArg: pushArrayedArg stream nextPutAll: 'pushArrayedArg: '. pushArrayedArg name printOn: stream.. stream nextPutAll: ' inVector: '. pushArrayedArg tempVectorName printOn: stream! ----- Method: IRBuilder>>create1arrayForAllArgumentNamed:withVars: (in category '*Smallapack-OpalCompiler') ----- create1arrayForAllArgumentNamed: name withVars: anArray "self addVectorTemps: anArray." self addTemp: name. self add: (IRInstruction create1arrayForAllArgumentNamed: name withVars: anArray).! ----- Method: IRBuilder>>pushArrayedArg:inVector: (in category '*Smallapack-OpalCompiler') ----- pushArrayedArg: name inVector: nameOfVector ^self add: (IRInstruction pushArrayedArg: name inVectorAt: nameOfVector)! IRBuilder subclass: #SLIRBuilder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLIRBuilder commentStamp: 'nice 1/9/2019 20:51' prior: 0! I am the IRBuilder for Smallapack Opal Compiler My sole interest is to use SLIRMethod! ----- Method: SLIRBuilder>>initialize (in category 'initialization') ----- initialize ir := SLIRMethod new. jumpAheadStacks := IdentityDictionary new. jumpBackTargetStacks := IdentityDictionary new. sourceMapNodes := OrderedCollection new. "stack" currentScope := Stack new. self pushScope: ir. "Leave an empty sequence up front (guaranteed not to be in loop)" ir startSequence: ((IRSequence orderNumber: 0) method:ir). currentSequence := (IRSequence orderNumber: 1) method:ir. ir startSequence add: (IRJump new destination: currentSequence; bytecodeIndex: sourceMapByteIndex; yourself). ! ----- Method: OCASTTranslator>>emitMessageNodeWithManyArgs: (in category '*Smallapack-OpalCompiler') ----- emitMessageNodeWithManyArgs: aMessageNode "For sending a message with more than 15 arguments, stack all the arguments into a single array, and send with 1 array argument." | argArrayNode | argArrayNode := (RBArrayNode statements: aMessageNode arguments). aMessageNode isCascaded ifFalse: [ valueTranslator visitNode: aMessageNode receiver]. valueTranslator visitNode: argArrayNode. aMessageNode isSuperSend ifTrue: [methodBuilder send: aMessageNode selector toSuperOf: self compilationContext getClass] ifFalse: [methodBuilder send: aMessageNode selector].! ----- Method: OCASTTranslator>>visitMethodNodeWithManyArgs: (in category '*Smallapack-OpalCompiler') ----- visitMethodNodeWithManyArgs: aMethodNode methodBuilder compilationContext: aMethodNode compilationContext. methodBuilder addTemps: aMethodNode scope tempVarNames. methodBuilder properties: aMethodNode properties. methodBuilder irPrimitive: aMethodNode primitiveFromPragma. aMethodNode pragmas do: [:each | self visitPragmaNode: each]. methodBuilder numArgs: 1 "dilemna: answer the effective or the apparent number of arguments? The apparent would be: aMethodNode arguments size". methodBuilder create1arrayForAllArgumentNamed: aMethodNode scope arrayArgumentName withVars: (aMethodNode arguments collect: [:each| each name] as: Array). aMethodNode scope tempVector ifNotEmpty: [ methodBuilder createTempVectorNamed: aMethodNode scope tempVectorName withVars: (aMethodNode scope tempVector collect: [:each| each name]) asArray. ]. effectTranslator visitNode: aMethodNode body. aMethodNode body lastIsReturn ifFalse: [methodBuilder pushReceiver; returnTop]! OCASTTranslator subclass: #SLASTTranslator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLASTTranslator commentStamp: 'nice 1/9/2019 21:04' prior: 0! I am an AST to IR translator for Smallapack Opal Compiler. I know how to produce instructions for methods with more than 15 arguments. And I use instruction generators for value/effect that know how to generate message sends with more than 15 arguments.! ----- Method: SLASTTranslator>>classForEffect (in category 'initialization') ----- classForEffect ^SLASTTranslatorForEffect ! ----- Method: SLASTTranslator>>classForValue (in category 'initialization') ----- classForValue ^SLASTTranslatorForValue! ----- Method: SLASTTranslator>>initialize (in category 'initialization') ----- initialize methodBuilder := SLIRBuilder new. effectTranslator := self as: self classForEffect. valueTranslator := self as: self classForValue. effectTranslator instVarNamed: #effectTranslator put: effectTranslator. effectTranslator instVarNamed: #valueTranslator put: valueTranslator. valueTranslator instVarNamed: #valueTranslator put: valueTranslator. ! ----- Method: SLASTTranslator>>visitMethodNode: (in category 'visitor-double dispatching') ----- visitMethodNode: aMethodNode aMethodNode arguments size > 15 ifFalse: [ ^super visitMethodNode: aMethodNode ]. ^self visitMethodNodeWithManyArgs: aMethodNode! CompilationContext subclass: #SLCompilationContext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Smallapack-OpalCompiler'! !SLCompilationContext commentStamp: 'nice 1/9/2019 21:16' prior: 0! I am a variant of Opal compilation context used for Smallapack. I am able to generate methods with more than 15 arguments, and send messages with more than 15 arguments. For this purpose, I am using specialized ancillary classes - for semantic analysis of methods - for AST to IR tanslation - for IR to bytecode translation ! ----- Method: SLCompilationContext>>astTranslatorClass (in category 'accessing') ----- astTranslatorClass ^ astTranslatorClass ifNil: [ astTranslatorClass := SLASTTranslator ]! ----- Method: SLCompilationContext>>bytecodeGeneratorClass (in category 'accessing') ----- bytecodeGeneratorClass ^ bytecodeGeneratorClass ifNil: [ bytecodeGeneratorClass := SLIRBytecodeGenerator ]! ----- Method: SLCompilationContext>>semanticAnalyzerClass (in category 'accessing') ----- semanticAnalyzerClass ^ semanticAnalyzerClass ifNil: [ semanticAnalyzerClass := SLASTSemanticAnalyzer ]! ----- Method: IRInstruction class>>create1arrayForAllArgumentNamed:withVars: (in category '*Smallapack-OpalCompiler') ----- create1arrayForAllArgumentNamed: aTempVectorName withVars: anArray ^ IR1ArrayForAllArgument new name: aTempVectorName; vars: anArray; yourself.! ----- Method: IRInstruction class>>pushArrayedArg:inVectorAt: (in category '*Smallapack-OpalCompiler') ----- pushArrayedArg: aName inVectorAt: nameOfVector ^ IRPushArrayedArg new name: aName; tempVectorName: nameOfVector; yourself.! ----- Method: OCAbstractMethodScope>>arrayArgumentName (in category '*Smallapack-OpalCompiler') ----- arrayArgumentName ^'1arrayForAllArguments'!