From 6cefdf53f0c1bed8f920757021746a46738a5c0d Mon Sep 17 00:00:00 2001 From: Ignacio Losiggio Date: Wed, 13 Nov 2024 11:05:43 +0100 Subject: [PATCH] Rename the "cons array" and "new array" concepts into "new array stack init" and "new array nil init" for clarity This breaks all InstructionClient implementations. --- .../SymbolicBytecodeBuilder.class.st | 12 +++---- .../FBIRBytecodeDecompilerTest.class.st | 8 ++--- .../FBDDecompiler.class.st | 16 ++++----- .../FBIRBytecodeDecompiler.class.st | 10 +++--- .../BytecodeEncoder.class.st | 14 ++++---- .../EncoderForSistaV1.class.st | 24 ++++++------- src/Kernel-CodeModel/Context.class.st | 18 +++++----- .../InstructionStream.class.st | 2 +- src/Kernel/InstructionClient.class.st | 10 +++--- src/OpalCompiler-Core/IRBuilder.class.st | 16 ++++----- .../IRBytecodeGenerator.class.st | 18 +++++----- src/OpalCompiler-Core/IRInstruction.class.st | 20 +++++------ src/OpalCompiler-Core/IRPrinter.class.st | 6 ++-- src/OpalCompiler-Core/IRPushArray.class.st | 20 +++++------ src/OpalCompiler-Core/IRTranslator.class.st | 8 ++--- .../OCASTTranslator.class.st | 2 +- src/OpalCompiler-Tests/IRBuilderTest.class.st | 34 +++++++++---------- src/OpalCompiler-Tests/IRPrinterTest.class.st | 14 ++++---- src/OpalCompiler-Tests/IRVisitorTest.class.st | 8 ++--- src/Reflectivity/RFASTTranslator.class.st | 2 +- .../TFCalloutMethodBuilder.class.st | 2 +- .../FFICalloutMethodBuilder.class.st | 2 +- 22 files changed, 133 insertions(+), 133 deletions(-) diff --git a/src/Debugging-Core/SymbolicBytecodeBuilder.class.st b/src/Debugging-Core/SymbolicBytecodeBuilder.class.st index 8cde62c82ba..ffe8ae0c924 100644 --- a/src/Debugging-Core/SymbolicBytecodeBuilder.class.st +++ b/src/Debugging-Core/SymbolicBytecodeBuilder.class.st @@ -196,12 +196,6 @@ SymbolicBytecodeBuilder >> pushClosureTemps: numTemps [ self addBytecode: 'pushClosureTemps:' , numTemps printString ] -{ #category : 'instruction decoding' } -SymbolicBytecodeBuilder >> pushConsArrayWithElements: numElements [ - - self addBytecode: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')' -] - { #category : 'instruction decoding' } SymbolicBytecodeBuilder >> pushConstant: obj [ "Print the Push Constant, obj, on Top Of Stack bytecode." @@ -237,6 +231,12 @@ SymbolicBytecodeBuilder >> pushNewArrayOfSize: numElements [ self addBytecode: 'push: (Array new: ', numElements printString, ')' ] +{ #category : 'instruction decoding' } +SymbolicBytecodeBuilder >> pushNewArrayStackInitWithElements: numElements [ + + self addBytecode: 'pop ', numElements printString, ' into (Array new: ', numElements printString, ')' +] + { #category : 'instruction decoding' } SymbolicBytecodeBuilder >> pushReceiver [ "Print the Push Active Context's Receiver on Top Of Stack bytecode." diff --git a/src/Flashback-Decompiler-Tests/FBIRBytecodeDecompilerTest.class.st b/src/Flashback-Decompiler-Tests/FBIRBytecodeDecompilerTest.class.st index 1581b296d2b..d311a19d8ce 100644 --- a/src/Flashback-Decompiler-Tests/FBIRBytecodeDecompilerTest.class.st +++ b/src/Flashback-Decompiler-Tests/FBIRBytecodeDecompilerTest.class.st @@ -259,9 +259,9 @@ FBIRBytecodeDecompilerTest >> testPopTop [ ] { #category : 'tests' } -FBIRBytecodeDecompilerTest >> testPushConsArray [ +FBIRBytecodeDecompilerTest >> testPushNewArrayStackInit [ | ir1 ir2 method | - ir1 := IRBuilderTest new testPushConsArray. + ir1 := IRBuilderTest new testPushNewArrayStackInit. method := ir1 compiledMethod. ir2 := FBIRBytecodeDecompiler new decompile: method. self deny: ir2 compiledMethod identicalTo: method. @@ -270,9 +270,9 @@ FBIRBytecodeDecompilerTest >> testPushConsArray [ ] { #category : 'tests' } -FBIRBytecodeDecompilerTest >> testPushConsArray2 [ +FBIRBytecodeDecompilerTest >> testPushNewArrayStackInit2 [ | ir1 ir2 method | - ir1 := IRBuilderTest new testPushConsArray2. + ir1 := IRBuilderTest new testPushNewArrayStackInit2. method := ir1 compiledMethod. ir2 := FBIRBytecodeDecompiler new decompile: method. self deny: ir2 compiledMethod identicalTo: method. diff --git a/src/Flashback-Decompiler/FBDDecompiler.class.st b/src/Flashback-Decompiler/FBDDecompiler.class.st index 0ecf5a48055..1714d71afc3 100644 --- a/src/Flashback-Decompiler/FBDDecompiler.class.st +++ b/src/Flashback-Decompiler/FBDDecompiler.class.st @@ -497,14 +497,6 @@ FBDDecompiler >> pushCleanClosure: aCompiledBlock [ currentSequence := savedSequence ] -{ #category : 'data flow instructions' } -FBDDecompiler >> pushConsArrayWithElements: numElements [ - | array | - array := Array new: numElements. - numElements to: 1 by: -1 do: [ :i | array at: i put: simulatedStack removeLast ]. - simulatedStack addLast: (builder codeArray: array) -] - { #category : 'data flow instructions' } FBDDecompiler >> pushConstant: value [ value isEmbeddedBlock ifTrue: [ ^self pushCleanClosure: value compiledBlock ]. @@ -543,6 +535,14 @@ FBDDecompiler >> pushNewArrayOfSize: numElements [ simulatedStack addLast: tempVect ] +{ #category : 'data flow instructions' } +FBDDecompiler >> pushNewArrayStackInitWithElements: numElements [ + | array | + array := Array new: numElements. + numElements to: 1 by: -1 do: [ :i | array at: i put: simulatedStack removeLast ]. + simulatedStack addLast: (builder codeArray: array) +] + { #category : 'data flow instructions' } FBDDecompiler >> pushReceiver [ simulatedStack addLast: builder codeReceiver diff --git a/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st b/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st index 2502f044984..b3c1b7a4104 100644 --- a/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st +++ b/src/Flashback-Decompiler/FBIRBytecodeDecompiler.class.st @@ -203,11 +203,6 @@ FBIRBytecodeDecompiler >> pushActiveContext [ irBuilder pushThisContext ] -{ #category : 'instruction decoding' } -FBIRBytecodeDecompiler >> pushConsArrayWithElements: numElements [ - irBuilder pushConsArray: numElements -] - { #category : 'instruction decoding' } FBIRBytecodeDecompiler >> pushConstant: value [ irBuilder pushLiteral: value @@ -234,6 +229,11 @@ FBIRBytecodeDecompiler >> pushNewArrayOfSize: size [ newTempVector := IRRemoteArray new size: size ] +{ #category : 'instruction decoding' } +FBIRBytecodeDecompiler >> pushNewArrayStackInitWithElements: numElements [ + irBuilder pushNewArrayStackInit: numElements +] + { #category : 'instruction decoding' } FBIRBytecodeDecompiler >> pushReceiver [ irBuilder pushReceiver diff --git a/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st b/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st index c4592b08872..cd84c9aa1e0 100644 --- a/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st +++ b/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st @@ -150,11 +150,6 @@ BytecodeEncoder >> sizePop [ ^self sizeOpcodeSelector: #genPop withArguments: #() ] -{ #category : 'opcode sizing' } -BytecodeEncoder >> sizePushConsArray: numElements [ - ^self sizeOpcodeSelector: #genPushConsArray: withArguments: {numElements} -] - { #category : 'opcode sizing' } BytecodeEncoder >> sizePushInstVar: instVarIndex [ ^self sizeOpcodeSelector: #genPushInstVar: withArguments: {instVarIndex} @@ -176,8 +171,13 @@ BytecodeEncoder >> sizePushLiteralVar: literalIndex [ ] { #category : 'opcode sizing' } -BytecodeEncoder >> sizePushNewArray: size [ - ^self sizeOpcodeSelector: #genPushNewArray: withArguments: {size} +BytecodeEncoder >> sizePushNewArrayNilInit: size [ + ^self sizeOpcodeSelector: #genPushNewArrayNilInit: withArguments: {size} +] + +{ #category : 'opcode sizing' } +BytecodeEncoder >> sizePushNewArrayStackInit: numElements [ + ^self sizeOpcodeSelector: #genPushNewArrayStackInit: withArguments: {numElements} ] { #category : 'opcode sizing' } diff --git a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st index 006c8cc0aa0..b6016cf144a 100644 --- a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st +++ b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st @@ -1034,17 +1034,6 @@ EncoderForSistaV1 >> genPushCharacter: aCharacterOrCode [ nextPut: (code bitAnd: 255) ] -{ #category : 'bytecode generation' } -EncoderForSistaV1 >> genPushConsArray: size [ - (size < 0 or: [size > 127]) ifTrue: - [^self outOfRangeError: 'size' index: size range: 0 to: 127]. - "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) - & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" - stream - nextPut: 231; - nextPut: size + 128 -] - { #category : 'extended bytecode generation' } EncoderForSistaV1 >> genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: receiverOnStack outerContextNeeded: outerContextNeeded [ "* 249 11111001 xxxxxxxx siyyyyyy push Closure Compiled block literal index xxxxxxxx (+ Extend A * 256) numCopied yyyyyy receiverOnStack: s = 1 ignoreOuterContext: i = 1" @@ -1155,7 +1144,7 @@ EncoderForSistaV1 >> genPushLiteralVar: literalIndex [ ] { #category : 'bytecode generation' } -EncoderForSistaV1 >> genPushNewArray: size [ +EncoderForSistaV1 >> genPushNewArrayNilInit: size [ (size < 0 or: [size > 127]) ifTrue: [^self outOfRangeError: 'size' index: size range: 0 to: 127]. "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) @@ -1165,6 +1154,17 @@ EncoderForSistaV1 >> genPushNewArray: size [ nextPut: size ] +{ #category : 'bytecode generation' } +EncoderForSistaV1 >> genPushNewArrayStackInit: size [ + (size < 0 or: [size > 127]) ifTrue: + [^self outOfRangeError: 'size' index: size range: 0 to: 127]. + "231 11100111 jkkkkkkk Push (Array new: kkkkkkk) (j = 0) + & Pop kkkkkkk elements into: (Array new: kkkkkkk) (j = 1)" + stream + nextPut: 231; + nextPut: size + 128 +] + { #category : 'bytecode generation' } EncoderForSistaV1 >> genPushReceiver [ "76 01001100 Push Receiver" diff --git a/src/Kernel-CodeModel/Context.class.st b/src/Kernel-CodeModel/Context.class.st index 18598f94065..241f626788f 100644 --- a/src/Kernel-CodeModel/Context.class.st +++ b/src/Kernel-CodeModel/Context.class.st @@ -1515,15 +1515,6 @@ Context >> pushClosureTemps: numTemps [ numTemps timesRepeat: [ self push: nil ] ] -{ #category : 'instruction decoding' } -Context >> pushConsArrayWithElements: numElements [ - | array | - array := Array new: numElements. - numElements to: 1 by: -1 do: [ :i | - array at: i put: self pop ]. - self push: array -] - { #category : 'instruction decoding' } Context >> pushConstant: value [ "Simulate the action of bytecode that pushes the constant, value, on the @@ -1559,6 +1550,15 @@ Context >> pushNewArrayOfSize: arraySize [ self push: (Array new: arraySize) ] +{ #category : 'instruction decoding' } +Context >> pushNewArrayStackInitWithElements: numElements [ + | array | + array := Array new: numElements. + numElements to: 1 by: -1 do: [ :i | + array at: i put: self pop ]. + self push: array +] + { #category : 'instruction decoding' } Context >> pushReceiver [ "Simulate the action of bytecode that pushes the active context's receiver diff --git a/src/Kernel-CodeModel/InstructionStream.class.st b/src/Kernel-CodeModel/InstructionStream.class.st index 5918a6d80bd..dc26da22e94 100644 --- a/src/Kernel-CodeModel/InstructionStream.class.st +++ b/src/Kernel-CodeModel/InstructionStream.class.st @@ -77,7 +77,7 @@ InstructionStream >> interpretNext2ByteSistaV1Instruction: bytecode for: client bytecode = 231 ifTrue: [^byte < 128 ifTrue: [client pushNewArrayOfSize: byte] - ifFalse: [client pushConsArrayWithElements: byte - 128]]. + ifFalse: [client pushNewArrayStackInitWithElements: byte - 128]]. bytecode = 232 ifTrue: [^client pushConstant: (extB bitShift: 8) + byte]. ^client pushConstant: (Character value: (extB bitShift: 8) + byte)]. diff --git a/src/Kernel/InstructionClient.class.st b/src/Kernel/InstructionClient.class.st index e256feddbd1..6a139f26ec5 100644 --- a/src/Kernel/InstructionClient.class.st +++ b/src/Kernel/InstructionClient.class.st @@ -148,11 +148,6 @@ InstructionClient >> pushClosureTemps: numTemps [ "push on stack nil numTemps times for the closure temps" ] -{ #category : 'instruction decoding' } -InstructionClient >> pushConsArrayWithElements: numElements [ - "Push Cons Array of size numElements popping numElements items from the stack into the array bytecode." -] - { #category : 'instruction decoding' } InstructionClient >> pushConstant: value [ "Push Constant, value, on Top Of Stack bytecode." @@ -173,6 +168,11 @@ InstructionClient >> pushNewArrayOfSize: numElements [ "Push New Array of size numElements bytecode." ] +{ #category : 'instruction decoding' } +InstructionClient >> pushNewArrayStackInitWithElements: numElements [ + "Push new Array of size numElements and fill it by popping numElements items from the stack into the array bytecode." +] + { #category : 'instruction decoding' } InstructionClient >> pushReceiver [ "Push Active Context's Receiver on Top Of Stack bytecode." diff --git a/src/OpalCompiler-Core/IRBuilder.class.st b/src/OpalCompiler-Core/IRBuilder.class.st index b426ce0a880..5c59ade4fd9 100644 --- a/src/OpalCompiler-Core/IRBuilder.class.st +++ b/src/OpalCompiler-Core/IRBuilder.class.st @@ -305,12 +305,6 @@ IRBuilder >> properties: aDict [ ir properties: aDict ] -{ #category : 'instructions' } -IRBuilder >> pushConsArray: size [ - - self add: (IRInstruction pushConsArray: size) -] - { #category : 'instructions' } IRBuilder >> pushDup [ @@ -348,9 +342,15 @@ IRBuilder >> pushLiteralVariable: object [ ] { #category : 'instructions' } -IRBuilder >> pushNewArray: size [ +IRBuilder >> pushNewArrayNilInit: size [ + + self add: (IRInstruction pushNewArrayNilInit: size) +] + +{ #category : 'instructions' } +IRBuilder >> pushNewArrayStackInit: size [ - self add: (IRInstruction pushNewArray: size) + self add: (IRInstruction pushNewArrayStackInit: size) ] { #category : 'instructions' } diff --git a/src/OpalCompiler-Core/IRBytecodeGenerator.class.st b/src/OpalCompiler-Core/IRBytecodeGenerator.class.st index 5ae3a4327ea..cf51673f578 100644 --- a/src/OpalCompiler-Core/IRBytecodeGenerator.class.st +++ b/src/OpalCompiler-Core/IRBytecodeGenerator.class.st @@ -490,13 +490,6 @@ IRBytecodeGenerator >> properties: propDict [ properties := propDict ] -{ #category : 'instructions' } -IRBytecodeGenerator >> pushConsArray: size [ - stack push. - stack pop: size. - encoder genPushConsArray: size -] - { #category : 'instructions' } IRBytecodeGenerator >> pushDup [ stack push. @@ -540,9 +533,16 @@ IRBytecodeGenerator >> pushLiteralVariable: object [ ] { #category : 'instructions' } -IRBytecodeGenerator >> pushNewArray: size [ +IRBytecodeGenerator >> pushNewArrayNilInit: size [ stack push. - encoder genPushNewArray: size + encoder genPushNewArrayNilInit: size +] + +{ #category : 'instructions' } +IRBytecodeGenerator >> pushNewArrayStackInit: size [ + stack push. + stack pop: size. + encoder genPushNewArrayStackInit: size ] { #category : 'instructions' } diff --git a/src/OpalCompiler-Core/IRInstruction.class.st b/src/OpalCompiler-Core/IRInstruction.class.st index 9cb13e93af8..286f06574b8 100644 --- a/src/OpalCompiler-Core/IRInstruction.class.st +++ b/src/OpalCompiler-Core/IRInstruction.class.st @@ -49,14 +49,6 @@ IRInstruction class >> popTop [ ^ IRPop new ] -{ #category : 'instance creation' } -IRInstruction class >> pushConsArray: aSize [ - ^IRPushArray new - size: aSize; - cons: true; - yourself -] - { #category : 'instance creation' } IRInstruction class >> pushDup [ @@ -104,11 +96,19 @@ IRInstruction class >> pushLiteralVariable: object [ ] { #category : 'instance creation' } -IRInstruction class >> pushNewArray: aSize [ +IRInstruction class >> pushNewArrayNilInit: aSize [ ^IRPushArray new size: aSize; - cons: false; + initsFromStack: false; + yourself +] + +{ #category : 'instance creation' } +IRInstruction class >> pushNewArrayStackInit: aSize [ + ^IRPushArray new + size: aSize; + initsFromStack: true; yourself ] diff --git a/src/OpalCompiler-Core/IRPrinter.class.st b/src/OpalCompiler-Core/IRPrinter.class.st index 64fdaf77130..6cc482fd5b2 100644 --- a/src/OpalCompiler-Core/IRPrinter.class.st +++ b/src/OpalCompiler-Core/IRPrinter.class.st @@ -100,11 +100,11 @@ IRPrinter >> visitPopIntoTemp: tmp [ { #category : 'visiting' } IRPrinter >> visitPushArray: array [ - array cons + array initsFromStack ifTrue: [ - stream nextPutAll: 'pushConsArray: ' ] + stream nextPutAll: 'pushNewArrayStackInit: ' ] ifFalse: [ - stream nextPutAll: 'pushNewArray: ' ]. + stream nextPutAll: 'pushNewArrayNilInit: ' ]. array size printOn: stream ] diff --git a/src/OpalCompiler-Core/IRPushArray.class.st b/src/OpalCompiler-Core/IRPushArray.class.st index 0cc2a8819dc..c39723ed78a 100644 --- a/src/OpalCompiler-Core/IRPushArray.class.st +++ b/src/OpalCompiler-Core/IRPushArray.class.st @@ -8,7 +8,7 @@ Class { #superclass : 'IRInstruction', #instVars : [ 'size', - 'cons' + 'initsFromStack' ], #category : 'OpalCompiler-Core-IR-Nodes', #package : 'OpalCompiler-Core', @@ -20,20 +20,20 @@ IRPushArray >> accept: aVisitor [ ^ aVisitor visitPushArray: self ] -{ #category : 'accessing' } -IRPushArray >> cons [ - ^ cons +{ #category : 'initialization' } +IRPushArray >> initialize [ + size := 0. + initsFromStack := false ] { #category : 'accessing' } -IRPushArray >> cons: aBool [ - cons := aBool +IRPushArray >> initsFromStack [ + ^ initsFromStack ] -{ #category : 'initialization' } -IRPushArray >> initialize [ - size := 0. - cons := false +{ #category : 'accessing' } +IRPushArray >> initsFromStack: aBool [ + initsFromStack := aBool ] { #category : 'accessing' } diff --git a/src/OpalCompiler-Core/IRTranslator.class.st b/src/OpalCompiler-Core/IRTranslator.class.st index dfc27a014cd..212ec1d6b14 100644 --- a/src/OpalCompiler-Core/IRTranslator.class.st +++ b/src/OpalCompiler-Core/IRTranslator.class.st @@ -179,11 +179,11 @@ IRTranslator >> visitPopIntoTemp: tmp [ { #category : 'visiting' } IRTranslator >> visitPushArray: array [ - array cons + array initsFromStack ifTrue: [ - gen pushConsArray: array size ] + gen pushNewArrayStackInit: array size ] ifFalse: [ - gen pushNewArray: array size ] + gen pushNewArrayNilInit: array size ] ] { #category : 'visiting' } @@ -328,6 +328,6 @@ IRTranslator >> visitStoreTemp: tmp [ IRTranslator >> visitTempVector: tempVector [ tempVectorStack push: tempVector. - gen pushNewArray: tempVector vars size. + gen pushNewArrayNilInit: tempVector vars size. gen storePopTemp: (self currentScope indexForVarNamed: tempVector name) ] diff --git a/src/OpalCompiler-Core/OCASTTranslator.class.st b/src/OpalCompiler-Core/OCASTTranslator.class.st index d54d4bab2fb..b9e5dd5060e 100644 --- a/src/OpalCompiler-Core/OCASTTranslator.class.st +++ b/src/OpalCompiler-Core/OCASTTranslator.class.st @@ -512,7 +512,7 @@ OCASTTranslator >> visitArrayNode: anArrayNode [ elementNodes := anArrayNode children. elementNodes do: [:node | self visitNode: node]. - methodBuilder pushConsArray: elementNodes size + methodBuilder pushNewArrayStackInit: elementNodes size ] { #category : 'visitor - double dispatching' } diff --git a/src/OpalCompiler-Tests/IRBuilderTest.class.st b/src/OpalCompiler-Tests/IRBuilderTest.class.st index c70927162b1..4f2ccc8831c 100644 --- a/src/OpalCompiler-Tests/IRBuilderTest.class.st +++ b/src/OpalCompiler-Tests/IRBuilderTest.class.st @@ -315,29 +315,30 @@ IRBuilderTest >> testPopTop [ ] { #category : 'tests' } -IRBuilderTest >> testPushConsArray [ +IRBuilderTest >> testPushNewArrayNilInit [ + | iRMethod aCompiledMethod receiver | iRMethod := IRBuilder new - pushReceiver; - pushConsArray: 1; + + pushNewArrayNilInit: 1; returnTop; ir. aCompiledMethod := iRMethod compiledMethod. - receiver := 5 @ 8. + receiver := (5@8). self assert: (aCompiledMethod isKindOf: CompiledMethod). - self assert: (aCompiledMethod valueWithReceiver: receiver) first identicalTo: receiver. - ^ iRMethod + self assert: ((aCompiledMethod valueWithReceiver: receiver) first isNil). + ^iRMethod ] { #category : 'tests' } -IRBuilderTest >> testPushConsArray2 [ +IRBuilderTest >> testPushNewArrayStackInit [ | iRMethod aCompiledMethod receiver | iRMethod := IRBuilder new - pushLiteral: 'hi!'; - pushConsArray: 1; + pushReceiver; + pushNewArrayStackInit: 1; returnTop; ir. @@ -346,27 +347,26 @@ IRBuilderTest >> testPushConsArray2 [ receiver := 5 @ 8. self assert: (aCompiledMethod isKindOf: CompiledMethod). - self assert: (aCompiledMethod valueWithReceiver: receiver) equals: #('hi!'). + self assert: (aCompiledMethod valueWithReceiver: receiver) first identicalTo: receiver. ^ iRMethod ] { #category : 'tests' } -IRBuilderTest >> testPushNewArray [ - +IRBuilderTest >> testPushNewArrayStackInit2 [ | iRMethod aCompiledMethod receiver | iRMethod := IRBuilder new - - pushNewArray: 1; + pushLiteral: 'hi!'; + pushNewArrayStackInit: 1; returnTop; ir. aCompiledMethod := iRMethod compiledMethod. - receiver := (5@8). + receiver := 5 @ 8. self assert: (aCompiledMethod isKindOf: CompiledMethod). - self assert: ((aCompiledMethod valueWithReceiver: receiver) first isNil). - ^iRMethod + self assert: (aCompiledMethod valueWithReceiver: receiver) equals: #('hi!'). + ^ iRMethod ] { #category : 'tests' } diff --git a/src/OpalCompiler-Tests/IRPrinterTest.class.st b/src/OpalCompiler-Tests/IRPrinterTest.class.st index 5a4388c18a3..fbe1ced7e49 100644 --- a/src/OpalCompiler-Tests/IRPrinterTest.class.st +++ b/src/OpalCompiler-Tests/IRPrinterTest.class.st @@ -144,30 +144,30 @@ returnReceiver ] { #category : 'tests' } -IRPrinterTest >> testPushConsArray [ +IRPrinterTest >> testPushNewArrayNilInit [ | ir | - ir := IRBuilderTest new testPushConsArray. + ir := IRBuilderTest new testPushNewArrayNilInit. self assert: ir longPrintString equals: ' label: 1 -pushReceiver -pushConsArray: 1 +pushNewArrayNilInit: 1 returnTop ' ] { #category : 'tests' } -IRPrinterTest >> testPushNewArray [ +IRPrinterTest >> testPushNewArrayStackInit [ | ir | - ir := IRBuilderTest new testPushNewArray. + ir := IRBuilderTest new testPushNewArrayStackInit. self assert: ir longPrintString equals: ' label: 1 -pushNewArray: 1 +pushReceiver +pushNewArrayStackInit: 1 returnTop ' ] diff --git a/src/OpalCompiler-Tests/IRVisitorTest.class.st b/src/OpalCompiler-Tests/IRVisitorTest.class.st index 493405d8efa..1602485b7ca 100644 --- a/src/OpalCompiler-Tests/IRVisitorTest.class.st +++ b/src/OpalCompiler-Tests/IRVisitorTest.class.st @@ -68,16 +68,16 @@ IRVisitorTest >> testPopTop [ ] { #category : 'tests' } -IRVisitorTest >> testPushConsArray [ +IRVisitorTest >> testPushNewArrayNilInit [ | ir | - ir := IRBuilderTest new testPushConsArray. + ir := IRBuilderTest new testPushNewArrayNilInit. self interpret: ir ] { #category : 'tests' } -IRVisitorTest >> testPushNewArray [ +IRVisitorTest >> testPushNewArrayStackInit [ | ir | - ir := IRBuilderTest new testPushNewArray. + ir := IRBuilderTest new testPushNewArrayStackInit. self interpret: ir ] diff --git a/src/Reflectivity/RFASTTranslator.class.st b/src/Reflectivity/RFASTTranslator.class.st index df9207dd01c..b26ae34dfb1 100644 --- a/src/Reflectivity/RFASTTranslator.class.st +++ b/src/Reflectivity/RFASTTranslator.class.st @@ -81,7 +81,7 @@ RFASTTranslator >> visitArrayNode: anArrayNode [ self emitMetaLinkBefore: anArrayNode. anArrayNode hasMetalinkInstead ifTrue: [ self emitMetaLinkInstead: anArrayNode ] - ifFalse: [ methodBuilder pushConsArray: elementNodes size ]. + ifFalse: [ methodBuilder pushNewArrayStackInit: elementNodes size ]. self emitMetaLinkAfterNoEnsure: anArrayNode ] diff --git a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st index b169133d6ff..08aad917143 100644 --- a/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st +++ b/src/ThreadedFFI-UFFI/TFCalloutMethodBuilder.class.st @@ -117,7 +117,7 @@ TFCalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLibr each resolvedType tfExternalTypeWithArity emitMarshallToPrimitive: builder ]. "create the array" - builder pushConsArray: functionSpec arguments size. + builder pushNewArrayStackInit: functionSpec arguments size. builder addTemp: #argumentsArray. builder storeTemp: #argumentsArray. diff --git a/src/UnifiedFFI/FFICalloutMethodBuilder.class.st b/src/UnifiedFFI/FFICalloutMethodBuilder.class.st index af5ec9e9d82..d90fcb34615 100644 --- a/src/UnifiedFFI/FFICalloutMethodBuilder.class.st +++ b/src/UnifiedFFI/FFICalloutMethodBuilder.class.st @@ -114,7 +114,7 @@ FFICalloutMethodBuilder >> generateFFICallout: builder spec: functionSpec ffiLib "iterate arguments in order (in the function) to create the function call" functionSpec arguments do: [ :each | each emitArgument: builder context: sender inCallout: self requestor ]. "create the array" - builder pushConsArray: functionSpec arguments size. + builder pushNewArrayStackInit: functionSpec arguments size. "send call and store into result" builder send: #invokeWithArguments:. functionSpec arguments do: [ :each | each emitReturnArgument: builder context: sender ].