diff --git a/smalltalksrc/VMMaker/CogX64Compiler.class.st b/smalltalksrc/VMMaker/CogX64Compiler.class.st index e90cda4299..24c964b20f 100644 --- a/smalltalksrc/VMMaker/CogX64Compiler.class.st +++ b/smalltalksrc/VMMaker/CogX64Compiler.class.st @@ -433,6 +433,13 @@ CogX64Compiler >> canZeroExtend [ ^true ] +{ #category : 'testing' } +CogX64Compiler >> checkIs32bit: offset [ + + (offset between: -2147483648 and: 2147483647) ifFalse: [ + self error: 'Cannot jump to distances larger than 32 bits' ] +] + { #category : 'accessing' } CogX64Compiler >> cmpC32RTempByteSize [ ^5 @@ -4276,13 +4283,6 @@ CogX64Compiler >> is32BitSignedImmediate: a64BitUnsignedOperand [ inSmalltalk: [((a64BitUnsignedOperand >> 32) signedIntFromLong + 1 bitXor: 1) = (a64BitUnsignedOperand >> 31 bitAnd: 1)] ] -{ #category : 'testing' } -CogX64Compiler >> checkIs32bit: offset [ - - (offset between: -2147483648 and: 2147483647) ifFalse: [ - self error: 'Cannot jump to distances larger than 32 bits' ] -] - { #category : 'testing' } CogX64Compiler >> isAddressRelativeToVarBase: varAddress [ "Support for addressing variables off the dedicated VarBaseReg. Allow for 1Mb of variables. diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 1d25da78b0..63533936dd 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -3801,7 +3801,11 @@ StackInterpreter >> checkForAndFollowForwardedPrimitiveState [ | primIndex | self assert: self failed. primIndex := self primitiveIndexOf: newMethod. - self assert: (argumentCount = (self argumentCountOf: newMethod) or: [ self isMetaPrimitiveIndex: primIndex ]). + + "Check that the argument count is correct. + But ignore the check in meta primitives, they modify the VM state and we don't have the info to verify" + self assert: ((self isMetaPrimitiveIndex: primIndex) or: [argumentCount = (self argumentCountOf: newMethod)]). + ^ self checkForAndFollowForwardedPrimitiveState: primIndex ] diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index 28f915798a..2b815ed614 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -953,46 +953,50 @@ StackInterpreterPrimitives >> primitiveDoPrimitiveWithArgs [ or Context>>receiver: anObject tryPrimitive: primIndex withArgs: argArray. If this primitive fails, arrange that its error code is a negative integer, to distinguish between this failing and the primitive it invokes failing." - | argumentArray arraySize index primIdx savedNumArgs rcvr | + + | argumentArray arraySize index primIdx savedNumArgs rcvr savedTempOop savedTempOop2 | "See checkForAndFollowForwardedPrimitiveState" metaAccessorDepth := -2. - (argumentCount between: 2 and: 3) ifFalse: - [^self primitiveFailFor: PrimErrUnsupported negated]. + (argumentCount between: 2 and: 3) ifFalse: [ + ^ self primitiveFailFor: PrimErrUnsupported negated ]. argumentArray := self stackTop. primIdx := self stackValue: 1. - ((objectMemory isArray: argumentArray) - and: [objectMemory isIntegerObject: primIdx]) ifFalse: - [^self primitiveFailFor: PrimErrBadArgument negated]. + ((objectMemory isArray: argumentArray) and: [ + objectMemory isIntegerObject: primIdx ]) ifFalse: [ + ^ self primitiveFailFor: PrimErrBadArgument negated ]. arraySize := objectMemory numSlotsOf: argumentArray. - (self roomToPushNArgs: arraySize) ifFalse: - [^self primitiveFailFor: PrimErrLimitExceeded negated]. + (self roomToPushNArgs: arraySize) ifFalse: [ + ^ self primitiveFailFor: PrimErrLimitExceeded negated ]. primIdx := objectMemory integerValueOf: primIdx. primitiveFunctionPointer := self functionPointerFor: primIdx. - primitiveFunctionPointer = 0 ifTrue: - [primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs. - ^self primitiveFailFor: PrimErrBadIndex negated]. + primitiveFunctionPointer = 0 ifTrue: [ + primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs. + ^ self primitiveFailFor: PrimErrBadIndex negated ]. "Pop primIndex and argArray, then push args in place..." (savedNumArgs := argumentCount) = 3 - ifTrue: "...and receiver if the three arg form" - [tempOop2 := self stackValue: 4. "actual receiver" - rcvr := self stackValue: 3. "receiver for primitive" - (objectMemory isOopForwarded: rcvr) ifTrue: - [rcvr := objectMemory followForwarded: rcvr]. - self pop: 4; push: rcvr] "use first arg as receiver" - ifFalse: - [self pop: 2]. + ifTrue: [ "use first arg as receiver""...and receiver if the three arg form" + savedTempOop2 := tempOop2. + tempOop2 := self stackValue: 3. "actual receiver" + rcvr := self stackValue: 2. "receiver for primitive" + (objectMemory isOopForwarded: rcvr) ifTrue: [ + rcvr := objectMemory followForwarded: rcvr ]. + self + pop: 4; + push: rcvr ] + ifFalse: [ self pop: 2 ]. argumentCount := arraySize. index := 1. - [index <= arraySize] whileTrue: - [self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray). - index := index + 1]. - - self isPrimitiveFunctionPointerAnIndex ifTrue: - [self executeQuickPrimitive. - tempOop2 := 0. - ^nil]. + [ index <= arraySize ] whileTrue: [ + self push: + (objectMemory fetchPointer: index - 1 ofObject: argumentArray). + index := index + 1 ]. + + self isPrimitiveFunctionPointerAnIndex ifTrue: [ + self executeQuickPrimitive. + tempOop2 := savedTempOop2. + ^ nil ]. "We use tempOop instead of pushRemappableOop:/popRemappableOop here because in the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back to either the interpreter or machine code, depending on the process activated. So if we're @@ -1000,6 +1004,7 @@ StackInterpreterPrimitives >> primitiveDoPrimitiveWithArgs [ popRemappableOop: wouldn't occur, potentially overflowing the remap buffer. Note that while recursion could occur (nil tryPrimitive: 118 withArgs: #(118 #(110 #()))) it counts as shooting oneself in the foot." + savedTempOop := tempOop. tempOop := argumentArray. "prim might alloc/gc" "Run the primitive (sets primFailCode)" @@ -1007,17 +1012,18 @@ StackInterpreterPrimitives >> primitiveDoPrimitiveWithArgs [ metaAccessorDepth := primitiveAccessorDepthTable at: primIdx. self slowPrimitiveResponse. - self successful ifFalse: "If primitive failed, then restore state for failure code" - [self pop: arraySize. - savedNumArgs = 3 ifTrue: - [rcvr := self stackTop. - self stackTopPut: tempOop2. - self push: rcvr]. - self pushInteger: primIdx. - self push: tempOop. - primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs. - argumentCount := savedNumArgs]. - tempOop := tempOop2 := 0 + self successful ifFalse: [ "If primitive failed, then restore state for failure code" + self pop: arraySize. + savedNumArgs = 3 ifTrue: [ + rcvr := self stackTop. + self stackTopPut: tempOop2. + tempOop2 := savedTempOop2. + self push: rcvr ]. + self pushInteger: primIdx. + self push: tempOop. + primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs. + argumentCount := savedNumArgs. + tempOop := savedTempOop ] ] { #category : 'control primitives' } diff --git a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st index 6cf3d691df..e230e0cd3e 100644 --- a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st @@ -998,26 +998,6 @@ StackInterpreterSimulator >> primitiveContextAt [ ^super primitiveContextAt ] -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveDoPrimitiveWithArgs [ - self halt. - ^super primitiveDoPrimitiveWithArgs -] - -{ #category : 'control primitives' } -StackInterpreterSimulator >> primitiveExecuteMethod [ - self halt: thisContext selector. - ^super primitiveExecuteMethod -] - -{ #category : 'control primitives' } -StackInterpreterSimulator >> primitiveExecuteMethodArgsArray [ - self halt: thisContext selector. - "(objectMemory isOopCompiledMethod: self stackTop) ifFalse: - [self halt]." - ^super primitiveExecuteMethodArgsArray -] - { #category : 'debugging traps' } StackInterpreterSimulator >> primitiveFailFor: reasonCode [ "self halt." @@ -1090,31 +1070,6 @@ StackInterpreterSimulator >> primitiveObjectPointsTo [ ^super primitiveObjectPointsTo ] -{ #category : 'object access primitives' } -StackInterpreterSimulator >> primitiveStoreStackp [ - "self printContext: (self stackValue: 1). - self halt." - super primitiveStoreStackp. - "self printContext: self stackTop" -] - -{ #category : 'system control primitives' } -StackInterpreterSimulator >> primitiveVMParameter [ - - (self stackTop = (objectMemory integerObjectOf: 9) - or: [self stackTop = (objectMemory integerObjectOf: 52)]) ifTrue: - [self halt]. - ^super primitiveVMParameter -] - -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveWait [ - "Catch errors before we start the whole morphic error process" - - "byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity" - ^ super primitiveWait -] - { #category : 'debug printing' } StackInterpreterSimulator >> print: it [ @@ -1426,15 +1381,6 @@ StackInterpreterSimulator >> singleStep [ self incrementByteCount ] -{ #category : 'primitive support' } -StackInterpreterSimulator >> slowPrimitiveResponse [ - primTraceLog ifNotNil: - [primTraceLog size > 127 ifTrue: - [primTraceLog removeFirst]. - primTraceLog addLast: primitiveFunctionPointer]. - ^super slowPrimitiveResponse -] - { #category : 'debug printing' } StackInterpreterSimulator >> space [ diff --git a/smalltalksrc/VMMakerTests/VMBasicPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMBasicPrimitiveTest.class.st new file mode 100644 index 0000000000..7f68ed10e2 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMBasicPrimitiveTest.class.st @@ -0,0 +1,92 @@ +Class { + #name : 'VMBasicPrimitiveTest', + #superclass : 'VMInterpreterTests', + #category : 'VMMakerTests-InterpreterTests', + #package : 'VMMakerTests', + #tag : 'InterpreterTests' +} + +{ #category : 'asserting' } +VMBasicPrimitiveTest >> assert: anOop contentEquals: oopToCompare [ + + | numSlotOop numSlotOopToCompare | + numSlotOop := memory numSlotsOf: anOop. + numSlotOopToCompare := (memory numSlotsOf: anOop). + self assert: numSlotOop equals: numSlotOopToCompare. + + 0 to: numSlotOop do: [:index | + self assert: (memory fetchByte: index ofObject: anOop) equals: (memory fetchByte: index ofObject:oopToCompare) + ] + +] + +{ #category : 'as yet unclassified' } +VMBasicPrimitiveTest >> fillNewSpace [ + + "Allocate enough space to generate a full new space" + + self assert: (memory + allocateSlots: (memory scavengeThreshold - memory freeStart + - (2 * memory baseHeaderSize) roundDownTo: 8) // self wordSize + format: memory arrayFormat + classIndex: memory arrayClassIndexPun) isNotNil +] + +{ #category : 'instance creation' } +VMBasicPrimitiveTest >> newArrayWith: aCollection [ + | array | + array := self newObjectWithSlots: aCollection size format: memory arrayFormat classIndex: memory arrayClassIndexPun. + aCollection withIndexDo: [ :item :index | + memory storePointer: index - 1 ofObject: array withValue: item + ]. + ^ array + +] + +{ #category : 'running' } +VMBasicPrimitiveTest >> setUp [ + "taken from VMSimpleStackBasedCogitBytecodeTest >> #setup" + + | newMethod ctx page | + super setUp. + + "Create the root context with a valid method" + "Let's create a method with enough size. It should have at least a literal (4 or 8 bytes depending the word size) and some bytecodes, so we can put the IP inside the method" + newMethod := methodBuilder newMethod buildMethod. + + "The context has 5 (in 32 bits) or 9 (in 64 bits) as initial IP, as method has at least one literal" + ctx := self + newSmallContextReceiver: memory nilObject + method: newMethod + arguments: #( ) + temporaries: #( ) + ip: self wordSize + 1. + + page := interpreter makeBaseFrameFor: ctx. + interpreter setStackPointersFromPage: page. + interpreter setStackPageAndLimit: page +] + +{ #category : 'tests - primitiveIdentical' } +VMBasicPrimitiveTest >> setUpForwardedObjects [ + | class1 class2 object1 object2 array1 array2 | + + class1 := self newClassInOldSpaceWithSlots: 1 instSpec: memory nonIndexablePointerFormat. + class2 := self newClassInOldSpaceWithSlots: 2 instSpec: memory nonIndexablePointerFormat. + + object1 := memory instantiateClass: class1. + object2 := memory instantiateClass: class2. + + array1 := self newArrayWith: { object1 }. + array2 := self newArrayWith: { object2 }. + + interpreter push: array1. + interpreter push: array2. + + interpreter primitiveArrayBecome. + + self assert: (memory isForwarded: object1) equals: true. + self assert: (memory isForwarded: object2) equals: true. + + ^ object1. +] diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveChangeClassParametrizedTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveChangeClassParametrizedTest.class.st index 900071ad35..8086be0104 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveChangeClassParametrizedTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPrimitiveChangeClassParametrizedTest.class.st @@ -1,6 +1,6 @@ Class { #name : 'VMPrimitiveChangeClassParametrizedTest', - #superclass : 'VMPrimitiveTest', + #superclass : 'VMBasicPrimitiveTest', #instVars : [ 'originBytes', 'destinationBytes', diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st index 009a19163e..323283d347 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st @@ -1,6 +1,6 @@ Class { #name : 'VMPrimitiveTest', - #superclass : 'VMInterpreterTests', + #superclass : 'VMBasicPrimitiveTest', #pools : [ 'VMBasicConstants', 'VMBytecodeConstants', @@ -11,92 +11,6 @@ Class { #tag : 'InterpreterTests' } -{ #category : 'asserting' } -VMPrimitiveTest >> assert: anOop contentEquals: oopToCompare [ - - | numSlotOop numSlotOopToCompare | - numSlotOop := memory numSlotsOf: anOop. - numSlotOopToCompare := (memory numSlotsOf: anOop). - self assert: numSlotOop equals: numSlotOopToCompare. - - 0 to: numSlotOop do: [:index | - self assert: (memory fetchByte: index ofObject: anOop) equals: (memory fetchByte: index ofObject:oopToCompare) - ] - -] - -{ #category : 'as yet unclassified' } -VMPrimitiveTest >> fillNewSpace [ - - "Allocate enough space to generate a full new space" - - self assert: (memory - allocateSlots: (memory scavengeThreshold - memory freeStart - - (2 * memory baseHeaderSize) roundDownTo: 8) // self wordSize - format: memory arrayFormat - classIndex: memory arrayClassIndexPun) isNotNil -] - -{ #category : 'instance creation' } -VMPrimitiveTest >> newArrayWith: aCollection [ - | array | - array := self newObjectWithSlots: aCollection size format: memory arrayFormat classIndex: memory arrayClassIndexPun. - aCollection withIndexDo: [ :item :index | - memory storePointer: index - 1 ofObject: array withValue: item - ]. - ^ array - -] - -{ #category : 'running' } -VMPrimitiveTest >> setUp [ - - "taken from VMSimpleStackBasedCogitBytecodeTest >> #setup" - - | newMethod ctx page | - super setUp. - - "Create the root context with a valid method" - "Let's create a method with enough size. It should have at least a literal (4 or 8 bytes depending the word size) and some bytecodes, so we can put the IP inside the method" - newMethod := methodBuilder newMethod buildMethod. - - "The context has 5 (in 32 bits) or 9 (in 64 bits) as initial IP, as method has at least one literal" - ctx := self - newSmallContextReceiver: memory nilObject - method: newMethod - arguments: #( ) - temporaries: #( ) - ip: self wordSize + 1. - - page := interpreter makeBaseFrameFor: ctx. - interpreter setStackPointersFromPage: page. - interpreter setStackPageAndLimit: page -] - -{ #category : 'tests - primitiveIdentical' } -VMPrimitiveTest >> setUpForwardedObjects [ - | class1 class2 object1 object2 array1 array2 | - - class1 := self newClassInOldSpaceWithSlots: 1 instSpec: memory nonIndexablePointerFormat. - class2 := self newClassInOldSpaceWithSlots: 2 instSpec: memory nonIndexablePointerFormat. - - object1 := memory instantiateClass: class1. - object2 := memory instantiateClass: class2. - - array1 := self newArrayWith: { object1 }. - array2 := self newArrayWith: { object2 }. - - interpreter push: array1. - interpreter push: array2. - - interpreter primitiveArrayBecome. - - self assert: (memory isForwarded: object1) equals: true. - self assert: (memory isForwarded: object2) equals: true. - - ^ object1. -] - { #category : 'tests - primitiveAdd' } VMPrimitiveTest >> testPrimitiveAddFailsWithTypeErrorOnFirstOperand [ diff --git a/smalltalksrc/VMMakerTests/VMTryPrimitivePrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMTryPrimitivePrimitiveTest.class.st new file mode 100644 index 0000000000..40f527e036 --- /dev/null +++ b/smalltalksrc/VMMakerTests/VMTryPrimitivePrimitiveTest.class.st @@ -0,0 +1,256 @@ +Class { + #name : 'VMTryPrimitivePrimitiveTest', + #superclass : 'VMBasicPrimitiveTest', + #instVars : [ + 'tryPrimitiveMethod', + 'tryPrimitiveMirrorMethod', + 'externalCallMethod' + ], + #category : 'VMMakerTests-InterpreterTests', + #package : 'VMMakerTests', + #tag : 'InterpreterTests' +} + +{ #category : 'running' } +VMTryPrimitivePrimitiveTest >> setUp [ + + super setUp. + + interpreter initializePluginEntries. + + "Prototype of #tryPrimitive:withArgs: + callPrimitive: 118 #[ f8 76 00 ]" + tryPrimitiveMethod := methodBuilder + isPrimitive: true; + numberOfArguments: 2; + bytecodes: #[ 16rf8 16r76 16r00 ]; + buildMethod. + + "Prototype of #withReceiver:tryPrimitive:withArguments: + callPrimitive: 118 #[ f8 76 00 ]" + tryPrimitiveMirrorMethod := methodBuilder + isPrimitive: true; + numberOfArguments: 3; + bytecodes: #[ 16rf8 16r76 16r00 ]; + buildMethod. + + "Prototype of #externalCall" + externalCallMethod := methodBuilder + isPrimitive: true; + numberOfArguments: 1; + literals: {(#( nil nil nil 19) forMemory: memory inMethod: nil)}; + buildMethod +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveMirrorTryPrimitiveWithReentrantFailure [ + " Call the primitive tryPrimitive reflectively, calling in turn out of bounds array access + SomeObject withReceiver: ( 17 ) tryPrimitive: 118 withArgs: #( 60 #( 2 ) ) + => 17" + + | arrayAccessPrimitiveArguments tryPrimitiveArguments receiver canary | + canary := memory integerObjectOf: 16rAF3BAB3. + interpreter push: canary. + + "Push the receiver of the mirror primitive, which is not the receiver of the invoked primitive" + interpreter push: memory nilObject. + + receiver := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: receiver withValue: (memory integerObjectOf: 17). + + interpreter push: receiver. + interpreter push: (memory integerObjectOf: 118). + + arrayAccessPrimitiveArguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arrayAccessPrimitiveArguments withValue: (memory integerObjectOf: 2). + + tryPrimitiveArguments := self newArrayWithSlots: 2. + memory storePointer: 0 ofObject: tryPrimitiveArguments withValue: (memory integerObjectOf: 60). + memory storePointer: 1 ofObject: tryPrimitiveArguments withValue: arrayAccessPrimitiveArguments. + interpreter push: tryPrimitiveArguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMirrorMethod. + interpreter argumentCount: 3. + interpreter primitiveDoPrimitiveWithArgs. + + "This should fail and leave the stack untouched" + self assert: interpreter failed. + self assert: interpreter popStack equals: tryPrimitiveArguments. + self assert: interpreter popStack equals: (memory integerObjectOf: 118). + self assert: interpreter popStack equals: receiver. + self assert: interpreter popStack equals: memory nilObject. + self assert: interpreter popStack equals: canary +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveFailsAndLeaveTheStackUnchanged [ + " Call the primitive plus reflectively, failing because of wrong argument type + 17 tryPrimitive: 1 withArgs: #( Object new ) + => Should activate the `tryPrimitive:withArgs:` method" + + | arguments canary | + canary := memory integerObjectOf: 16rAF3BAB3. + interpreter push: canary. + + interpreter push: (memory integerObjectOf: 17). + interpreter push: (memory integerObjectOf: 1). + + arguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arguments withValue: (self newObjectWithSlots: 0). + interpreter push: arguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + "This should fail and leave the stack untouched" + self assert: interpreter failed. + 3 timesRepeat: [interpreter popStack]. + self assert: interpreter popStack equals: canary. + +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveFailsIfPrimitiveFails [ + " Call the primitive plus reflectively, failing because of wrong argument type + 17 tryPrimitive: 1 withArgs: #( Object new ) + => Should activate the `tryPrimitive:withArgs:` method" + + | arguments | + interpreter push: (memory integerObjectOf: 17). + interpreter push: (memory integerObjectOf: 1). + + arguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arguments withValue: (self newObjectWithSlots: 0). + interpreter push: arguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + "This should fail and leave the stack untouched" + self assert: interpreter failed. + self assert: interpreter popStack equals: arguments. + self assert: interpreter popStack equals: (memory integerObjectOf: 1). + self assert: interpreter popStack equals: (memory integerObjectOf: 17). +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveShouldInvokeAddition [ + " Call the primitive plus reflectively + 17 tryPrimitive: 1 withArgs: #( 42 ) + => 59" + + | arguments | + interpreter push: (memory integerObjectOf: 17). + interpreter push: (memory integerObjectOf: 1). + + arguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arguments withValue: (memory integerObjectOf: 42). + interpreter push: arguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + self deny: interpreter failed. + self assert: interpreter popStack equals: ((memory integerObjectOf: 59)) +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveShouldInvokeItself [ + " Call the primitive tryPrimitive reflectively, calling in turn the addition + 17 tryPrimitive: 118 withArgs: #( 1 #( 42 ) ) + => 59" + + | additionPrimitiveArguments tryPrimitiveArguments | + interpreter push: (memory integerObjectOf: 17). + interpreter push: (memory integerObjectOf: 118). + + additionPrimitiveArguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: additionPrimitiveArguments withValue: (memory integerObjectOf: 42). + + tryPrimitiveArguments := self newArrayWithSlots: 2. + memory storePointer: 0 ofObject: tryPrimitiveArguments withValue: (memory integerObjectOf: 1). + memory storePointer: 1 ofObject: tryPrimitiveArguments withValue: additionPrimitiveArguments. + interpreter push: tryPrimitiveArguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + self deny: interpreter failed. + self assert: interpreter popStack equals: ((memory integerObjectOf: 59)) +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveWithArrayAccess [ + " Call the primitive tryPrimitive reflectively, calling in turn array access + #( 17 ) tryPrimitive: 118 withArgs: #( 60 #( 1 ) ) + => 17" + + | arrayAccessPrimitiveArguments tryPrimitiveArguments receiver | + receiver := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: receiver withValue: (memory integerObjectOf: 17). + + interpreter push: receiver. + interpreter push: (memory integerObjectOf: 118). + + arrayAccessPrimitiveArguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arrayAccessPrimitiveArguments withValue: (memory integerObjectOf: 1). + + tryPrimitiveArguments := self newArrayWithSlots: 2. + memory storePointer: 0 ofObject: tryPrimitiveArguments withValue: (memory integerObjectOf: 60). + memory storePointer: 1 ofObject: tryPrimitiveArguments withValue: arrayAccessPrimitiveArguments. + interpreter push: tryPrimitiveArguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + self deny: interpreter failed. + self assert: interpreter popStack equals: ((memory integerObjectOf: 17)) +] + +{ #category : 'tests - primitiveTryPrimitive' } +VMTryPrimitivePrimitiveTest >> testPrimitiveTryPrimitiveWithReentrantFailure [ + " Call the primitive tryPrimitive reflectively, calling in turn out of bounds array access + #( 17 ) tryPrimitive: 118 withArgs: #( 60 #( 2 ) ) + => 17" + + | arrayAccessPrimitiveArguments tryPrimitiveArguments receiver canary | + canary := memory integerObjectOf: 16rAF3BAB3. + interpreter push: canary. + + receiver := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: receiver withValue: (memory integerObjectOf: 17). + + interpreter push: receiver. + interpreter push: (memory integerObjectOf: 118). + + arrayAccessPrimitiveArguments := self newArrayWithSlots: 1. + memory storePointer: 0 ofObject: arrayAccessPrimitiveArguments withValue: (memory integerObjectOf: 2). + + tryPrimitiveArguments := self newArrayWithSlots: 2. + memory storePointer: 0 ofObject: tryPrimitiveArguments withValue: (memory integerObjectOf: 60). + memory storePointer: 1 ofObject: tryPrimitiveArguments withValue: arrayAccessPrimitiveArguments. + interpreter push: tryPrimitiveArguments. + + "Simulate calling the method tryPrimitive:withArgs:" + interpreter newMethod: tryPrimitiveMethod. + interpreter argumentCount: 2. + interpreter primitiveDoPrimitiveWithArgs. + + "This should fail and leave the stack untouched" + self assert: interpreter failed. + self assert: interpreter popStack equals: tryPrimitiveArguments. + self assert: interpreter popStack equals: (memory integerObjectOf: 118). + self assert: interpreter popStack equals: receiver. + self assert: interpreter popStack equals: canary +]