Making allocations through a dynamic variable

src/Kernel-CodeModel/Behavior.class.st

@@ -374,37 +374,14 @@ Behavior >> basicIdentityHash [
 
 { #category : 'instance creation' }
 Behavior >> basicNew [
-	"Primitive. Answer an instance of the receiver (which is a class) with no
-	 indexable variables. Fail if the class is indexable. Essential. See Object
-	 documentation whatIsAPrimitive.
-
-	 If the primitive fails because space is low then the scavenger will run
-	 before the method is activated.  Check that space was low and retry
-	 via handleFailingBasicNew if so."
 
-	<primitive: 70 error: ec>
-	ec == #'insufficient object memory' ifTrue:
-		[^self handleFailingBasicNew].
-	self isVariable ifTrue: [^self basicNew: 0].
-	self primitiveFailed
+	^ ObjectAllocator value allocate: self
 ]
 
 { #category : 'instance creation' }
 Behavior >> basicNew: sizeRequested [
-	"Primitive. Answer an instance of this class with the number of indexable
-	 variables specified by the argument, sizeRequested.  Fail if this class is not
-	 indexable or if the argument is not a positive Integer, or if there is not
-	 enough memory available. Essential. See Object documentation whatIsAPrimitive.
 
-	 If the primitive fails because space is low then the scavenger will run before the
-	 method is activated.  Check args and retry via handleFailingBasicNew: if they're OK."
-
-	<primitive: 71 error: ec>
-	ec == #'insufficient object memory' ifTrue:
-		[^self handleFailingBasicNew: sizeRequested].
-	self isVariable ifFalse:
-		[self error: self printString, ' cannot have variable sized instances'].
-	self primitiveFailed
+	^ ObjectAllocator value allocate: self size: sizeRequested
 ]
 
 { #category : 'instance creation' }
@@ -1328,15 +1305,17 @@ Behavior >> newTenured [
 	are made in the new space, that why the new space exists.
 	Use this method when you know that tenuring the object is what you want."
 
-	^ self basicNewTenured initialize
+	^ ObjectAllocator value: TenuredAllocator during: [ self new ]
 ]
 
 { #category : 'instance creation' }
-Behavior >> newTenured: sizeRequested [
+Behavior >> newTenured: requestedSize [
 	"Allocates the variable size object in the old space. See newTenured comment for more
 	information."
 
-	^ (self basicNewTenured: sizeRequested) initialize
+	^ ObjectAllocator
+		  value: TenuredAllocator
+		  during: [ self new: requestedSize ]
 ]
 
 { #category : 'initialization' }
@@ -1400,6 +1379,42 @@ Behavior >> printOn: aStream [
 	self superclass printOn: aStream
 ]
 
+{ #category : 'instance creation' }
+Behavior >> privateBasicNew [
+	"Primitive. Answer an instance of the receiver (which is a class) with no
+	 indexable variables. Fail if the class is indexable. Essential. See Object
+	 documentation whatIsAPrimitive.
+
+	 If the primitive fails because space is low then the scavenger will run
+	 before the method is activated.  Check that space was low and retry
+	 via handleFailingBasicNew if so."
+
+	<primitive: 70 error: ec>
+	ec == #'insufficient object memory' ifTrue:
+		[^self handleFailingBasicNew].
+	self isVariable ifTrue: [^self basicNew: 0].
+	self primitiveFailed
+]
+
+{ #category : 'instance creation' }
+Behavior >> privateBasicNew: sizeRequested [
+	"Primitive. Answer an instance of this class with the number of indexable
+	 variables specified by the argument, sizeRequested.  Fail if this class is not
+	 indexable or if the argument is not a positive Integer, or if there is not
+	 enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+	 If the primitive fails because space is low then the scavenger will run before the
+	 method is activated.  Check args and retry via handleFailingBasicNew: if they're OK."
+
+	<primitive: 71 error: ec>
+	ec == #'insufficient object memory' ifTrue: [
+		^ self handleFailingBasicNew: sizeRequested ].
+	self isVariable ifFalse: [
+		self error:
+			self printString , ' cannot have variable sized instances' ].
+	self primitiveFailed
+]
+
 { #category : 'accessing - properties' }
 Behavior >> properties [
 	^ ClassProperties at: self ifAbsent: nil

src/Kernel-CodeModel/NormalAllocator.class.st

@@ -0,0 +1,19 @@
+Class {
+	#name : 'NormalAllocator',
+	#superclass : 'Object',
+	#category : 'Kernel-CodeModel-Allocators',
+	#package : 'Kernel-CodeModel',
+	#tag : 'Allocators'
+}
+
+{ #category : 'instance creation' }
+NormalAllocator class >> allocate: aClass [
+
+	^ aClass privateBasicNew
+]
+
+{ #category : 'instance creation' }
+NormalAllocator class >> allocate: aClass size: requestedSize [
+
+	^ aClass privateBasicNew: requestedSize
+]

src/Kernel-CodeModel/ObjectAllocator.class.st

@@ -0,0 +1,13 @@
+Class {
+	#name : 'ObjectAllocator',
+	#superclass : 'DynamicVariable',
+	#category : 'Kernel-CodeModel-Allocators',
+	#package : 'Kernel-CodeModel',
+	#tag : 'Allocators'
+}
+
+{ #category : 'accessing' }
+ObjectAllocator >> default [
+
+	^ NormalAllocator
+]

src/Kernel-CodeModel/TenuredAllocator.class.st

@@ -0,0 +1,19 @@
+Class {
+	#name : 'TenuredAllocator',
+	#superclass : 'Object',
+	#category : 'Kernel-CodeModel-Allocators',
+	#package : 'Kernel-CodeModel',
+	#tag : 'Allocators'
+}
+
+{ #category : 'instance creation' }
+TenuredAllocator class >> allocate: aClass [
+
+	^ aClass basicNewTenured
+]
+
+{ #category : 'instance creation' }
+TenuredAllocator class >> allocate: aClass size: requestedSize [
+
+	^ aClass basicNewTenured: requestedSize
+]

src/ThreadedFFI-UFFI/Behavior.extension.st

@@ -23,11 +23,13 @@ Behavior >> basicNewPinned: requestedSize [
 { #category : '*ThreadedFFI-UFFI' }
 Behavior >> newPinned [
 
-	^ self basicNewPinned initialize
+	^ ObjectAllocator value: PinnedAllocator during: [ self new ]
 ]
 
 { #category : '*ThreadedFFI-UFFI' }
-Behavior >> newPinned: sizeRequested [
+Behavior >> newPinned: requestedSize [
 
-	^ (self basicNewPinned: sizeRequested) initialize
+	^ ObjectAllocator
+		  value: PinnedAllocator
+		  during: [ self new: requestedSize ]
 ]

src/ThreadedFFI-UFFI/PinnedAllocator.class.st

@@ -0,0 +1,18 @@
+Class {
+	#name : 'PinnedAllocator',
+	#superclass : 'Object',
+	#category : 'ThreadedFFI-UFFI',
+	#package : 'ThreadedFFI-UFFI'
+}
+
+{ #category : 'instance creation' }
+PinnedAllocator class >> allocate: aClass [
+
+	^ aClass basicNewPinned
+]
+
+{ #category : 'instance creation' }
+PinnedAllocator class >> allocate: aClass size: requestedSize [
+
+	^ aClass basicNewPinned: requestedSize
+]