Fix meta try primitive

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.

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
 ]
 

smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st

@@ -953,71 +953,77 @@ 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
 	 executing one of these primitives, control won't actually return here and the matching
 	 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)"
 	"See checkForAndFollowForwardedPrimitiveState"
 	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' }

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 [
 

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. 
+]

smalltalksrc/VMMakerTests/VMPrimitiveChangeClassParametrizedTest.class.st

@@ -1,6 +1,6 @@
 Class {
 	#name : 'VMPrimitiveChangeClassParametrizedTest',
-	#superclass : 'VMPrimitiveTest',
+	#superclass : 'VMBasicPrimitiveTest',
 	#instVars : [
 		'originBytes',
 		'destinationBytes',