Backporting PR for allocating in the old space

smalltalksrc/VMMaker/InterpreterPrimitives.class.st

@@ -2776,6 +2776,20 @@ InterpreterPrimitives >> primitiveNewMethod [
 	self pop: 3 thenPush: theMethod
 ]
 
+{ #category : #'object access primitives' }
+InterpreterPrimitives >> primitiveNewOldSpace [
+	"Allocate a new pinned fixed-size instance.  Fail if the allocation would leave
+	less than lowSpaceThreshold bytes free. This *will not* cause a GC :-)"
+
+	(objectMemory instantiateClass: self stackTop isPinned: false isOldSpace: true)
+		ifNotNil: [ :obj | self pop: argumentCount + 1 thenPush: obj ]
+		ifNil: [
+			self primitiveFailFor:
+				((objectMemory isFixedSizePointerFormat: (objectMemory instSpecOfClass: self stackTop))
+					 ifTrue: [ PrimErrNoMemory ]
+					 ifFalse: [ PrimErrBadReceiver ]) ]
+]
+
 { #category : #'object access primitives' }
 InterpreterPrimitives >> primitiveNewPinned [
 
@@ -2811,6 +2825,27 @@ InterpreterPrimitives >> primitiveNewWithArg [
 					 ifFalse: [ PrimErrBadReceiver ]) ]
 ]
 
+{ #category : #'object access primitives' }
+InterpreterPrimitives >> primitiveNewWithArgOldSpace [
+
+	| size instSpec |
+
+	size := self positiveMachineIntegerValueOf: self stackTop.
+
+	(objectMemory
+		instantiateClass: (self stackValue: 1)
+		indexableSize: size
+		isPinned: false
+		isOldSpace: true)
+			ifNotNil: [ :obj | self pop: argumentCount + 1 thenPush: obj ]
+			ifNil: [ instSpec := objectMemory instSpecOfClass: (self stackValue: 1).
+			self primitiveFailFor:
+					(((objectMemory isIndexableFormat: instSpec)
+						and: [ (objectMemory isCompiledMethodFormat: instSpec) not ])
+						ifTrue: [ PrimErrNoMemory ]
+						ifFalse: [ PrimErrBadReceiver ]) ]
+]
+
 { #category : #'object access primitives' }
 InterpreterPrimitives >> primitiveNewWithArgPinned [
 	| size instSpec |

smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st

@@ -379,7 +379,7 @@ Spur32BitMemoryManager >> initSegmentBridgeWithBytes: numBytes at: address [
 ]
 
 { #category : #instantiation }
-Spur32BitMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned [
+Spur32BitMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: isOldSpace [
 	<api>
 	<var: #nElements type: #usqInt>
 	"Allocate an instance of a variable class, excepting CompiledMethod."
@@ -429,7 +429,7 @@ Spur32BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is
 		 classIndex < 0 ifTrue:
 			[coInterpreter primitiveFailFor: classIndex negated.
 			 ^nil]].
-	(numSlots > self maxSlotsForNewSpaceAlloc or: [isPinned])
+	(numSlots > self maxSlotsForNewSpaceAlloc or: [isPinned or: [isOldSpace ]])
 		ifTrue:
 			[numSlots > self maxSlotsForAlloc ifTrue:
 				[coInterpreter primitiveFailFor: PrimErrUnsupported.

smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st

@@ -420,7 +420,7 @@ Spur64BitMemoryManager >> initSegmentBridgeWithBytes: numBytes at: address [
 ]
 
 { #category : #instantiation }
-Spur64BitMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned [
+Spur64BitMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: isOldSpace [
 	<api>
 	<var: #nElements type: #usqInt>
 	"Allocate an instance of a variable class, excepting CompiledMethod."
@@ -468,7 +468,7 @@ Spur64BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is
 		 classIndex < 0 ifTrue:
 			[coInterpreter primitiveFailFor: classIndex negated.
 			 ^nil]].
-	(numSlots > self maxSlotsForNewSpaceAlloc or: [isPinned])
+	(numSlots > self maxSlotsForNewSpaceAlloc or: [isPinned or: [isOldSpace]])
 		ifTrue:
 			[numSlots > self maxSlotsForAlloc ifTrue:
 				[coInterpreter primitiveFailFor: PrimErrUnsupported.

smalltalksrc/VMMaker/SpurMemoryManager.class.st

@@ -2327,6 +2327,16 @@ SpurMemoryManager >> allocateSlots: numSlots format: formatField classIndex: cla
 { #category : #allocation }
 SpurMemoryManager >> allocateSlots: numSlots format: formatField classIndex: classIndex isPinned: isPinned [
 
+	^ self allocateSlots: numSlots
+		  format: formatField
+		  classIndex: classIndex
+		  isPinned: isPinned
+		  isOldSpace: false
+]
+
+{ #category : #allocation }
+SpurMemoryManager >> allocateSlots: numSlots format: formatField classIndex: classIndex isPinned: isPinned isOldSpace: isOldSpace [
+
 	"Allocate an object with numSlots space.  If there is room beneath scavengeThreshold
 	 allocate in newSpace, otherwise alocate in oldSpace.  If there is not room in newSpace
 	 and a scavenge is not already scheduled, schedule a scavenge."
@@ -2345,7 +2355,7 @@ SpurMemoryManager >> allocateSlots: numSlots format: formatField classIndex: cla
 
 	hasToScheduleScavenge := freeStart + numBytes > scavengeThreshold.
 
-	(hasToScheduleScavenge or: [ isPinned ]) ifTrue: [ 
+	(hasToScheduleScavenge or: [ isPinned or: [ isOldSpace ] ]) ifTrue: [ 
 		hasToScheduleScavenge ifTrue: [ 
 			needGCFlag ifFalse: [ self scheduleScavenge ] ].
 
@@ -6935,11 +6945,24 @@ SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements [
 SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned [
 	<api>
 
+	^ self instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: false
+]
+
+{ #category : #instantiation }
+SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: isOldSpace [
+	<api>
+
 	^ self subclassResponsibility
 ]
 
 { #category : #instantiation }
 SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned [
+
+	^ self instantiateClass: classObj isPinned: isPinned isOldSpace: false
+]
+
+{ #category : #instantiation }
+SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: isOldSpace [
 	| instSpec classFormat numSlots classIndex newObj |
 	classFormat := self formatOfClass: classObj.
 	instSpec := self instSpecOfClassFormat: classFormat.
@@ -6948,9 +6971,9 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned [
 	classIndex := self ensureBehaviorHash: classObj.
 	classIndex < 0 ifTrue:
 		[coInterpreter primitiveFailFor: classIndex negated.
-		 ^nil].
+		^nil].
 	numSlots := self fixedFieldsOfClassFormat: classFormat.
-	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex isPinned: isPinned.
+	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex isPinned: isPinned isOldSpace: isOldSpace.
 	newObj ifNotNil:
 		[self fillObj: newObj numSlots: numSlots with: nilObj].
 	^newObj

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -1344,7 +1344,11 @@ StackInterpreter class >> initializePrimitiveTable [
 		(574 primitiveFloat64ArrayAdd)
 
 		"Unassigned Primitives"
-		(575 597 primitiveFail)
+		(575 595 primitiveFail)
+
+		"Allocate in old space primitive"
+		(596 primitiveNewOldSpace)
+		(597 primitiveNewWithArgOldSpace)
 
 		"Pinned object creation primitives"
 		(598 primitiveNewPinned)

smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st

@@ -2692,6 +2692,74 @@ VMPrimitiveTest >> testPrimitiveNewIsNotPinned [
 	self deny: (memory isPinned: interpreter stackTop)
 ]
 
+{ #category : #'tests - primitiveNewOldSpace' }
+VMPrimitiveTest >> testPrimitiveNewOldCreatesTheObjectInOldSpace [
+	| class |
+	class := self newClassInOldSpaceWithSlots: 0 instSpec: memory nonIndexablePointerFormat.
+
+	interpreter push: class.
+	interpreter primitiveNewOldSpace.
+
+	self deny: interpreter failed.
+	self deny: (memory isYoung: interpreter stackTop).
+	self assert: (memory isOld: interpreter stackTop)
+]
+
+{ #category : #'tests - primitiveNewOldSpace' }
+VMPrimitiveTest >> testPrimitiveNewOldSpaceObjectInFullNewSpaceIsSchedulingGC [
+	| class |
+	class := self newClassInOldSpaceWithSlots: 3 instSpec: memory nonIndexablePointerFormat.
+
+	self fillNewSpace.
+
+	self deny: memory needGCFlag.
+
+	interpreter push: class.
+	interpreter primitiveNewOldSpace.
+
+	self deny: interpreter failed.
+	self assert: memory needGCFlag 
+]
+
+{ #category : #'tests - primitiveNewOldSpace' }
+VMPrimitiveTest >> testPrimitiveNewOldSpaceObjectIsNotSchedulingGC [
+	| class |
+	class := self newClassInOldSpaceWithSlots: 0 instSpec: memory nonIndexablePointerFormat.
+
+	interpreter push: class.
+	interpreter primitiveNewOldSpace.
+
+	self deny: interpreter failed.
+	self deny: memory needGCFlag 
+]
+
+{ #category : #'tests - primitiveNewOldSpace' }
+VMPrimitiveTest >> testPrimitiveNewOldSpaceWithArgsCreatesTheObjectInOldSpace [
+	| class |
+	class := self newClassInOldSpaceWithSlots: 0 instSpec: memory arrayFormat.
+
+	interpreter push: class.
+	interpreter push: (memory integerObjectOf: 7).
+	interpreter primitiveNewWithArgOldSpace.
+
+	self deny: interpreter failed.
+	self deny: (memory isYoung: interpreter stackTop).
+	self assert: (memory isOld: interpreter stackTop)
+]
+
+{ #category : #'tests - primitiveNewOldSpace' }
+VMPrimitiveTest >> testPrimitiveNewOldSpaceWithArgsObjectIsNotSchedulingGC [
+	| class |
+	class := self newClassInOldSpaceWithSlots: 0 instSpec: memory arrayFormat.
+
+	interpreter push: class.
+	interpreter push: (memory integerObjectOf: 7).
+	interpreter primitiveNewWithArgOldSpace.
+
+	self deny: interpreter failed.
+	self deny: memory needGCFlag 
+]
+
 { #category : #'tests - primitiveNewPinned' }
 VMPrimitiveTest >> testPrimitiveNewPinnedCreatesTheObjectInOldSpace [
 	| class |