From db80d7e0db9de70f32775c186966350632672064 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Thu, 5 Oct 2023 16:48:57 +0200 Subject: [PATCH 01/12] Added tests for the new primitiveNewOldSpace --- .../VMMakerTests/VMPrimitiveTest.class.st | 68 +++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st index c229c96b28..bb5d084688 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveTest.class.st +++ b/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 | From cdadad51663aa6f407492d7fd78e9eea89cf4ee9 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Thu, 5 Oct 2023 17:34:27 +0200 Subject: [PATCH 02/12] First implementation of the primitiveNewOldSpace and primitiveNewWithArgOldSpace --- .../VMMaker/InterpreterPrimitives.class.st | 29 ++++++++ .../VMMaker/Spur32BitMemoryManager.class.st | 70 +++++++++++++++++++ .../VMMaker/Spur64BitMemoryManager.class.st | 69 ++++++++++++++++++ .../VMMaker/SpurMemoryManager.class.st | 30 ++++++++ 4 files changed, 198 insertions(+) diff --git a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st index 2f78231cb9..82f7ddc891 100644 --- a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st +++ b/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 instantiateClassInOldSpace: self stackTop) + 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,21 @@ InterpreterPrimitives >> primitiveNewWithArg [ ifFalse: [ PrimErrBadReceiver ]) ] ] +{ #category : #'object access primitives' } +InterpreterPrimitives >> primitiveNewWithArgOldSpace [ + + | size instSpec | + size := self positiveMachineIntegerValueOf: self stackTop. + + (objectMemory instantiateClassInOldSpace: (self stackValue: 1) indexableSize: size) + 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 | diff --git a/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st b/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st index b34928cd65..603a01cbe1 100644 --- a/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st +++ b/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st @@ -446,6 +446,76 @@ Spur32BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is ^newObj ] +{ #category : #instantiation } +Spur32BitMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ + + + "Allocate an instance of a variable class, excepting CompiledMethod." + | instSpec classFormat numSlots classIndex newObj fillValue | + classFormat := self formatOfClassSafe: classObj. + classFormat == -1 ifTrue: + [self primitiveFailFor: PrimErrBadReceiver. "no format" + ^nil]. + instSpec := self instSpecOfClassFormat: classFormat. + classIndex := self rawHashBitsOf: classObj. + fillValue := 0. + instSpec caseOf: { + [self arrayFormat] -> + [numSlots := nElements. + fillValue := nilObj]. + [self indexablePointersFormat] -> + [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. + fillValue := nilObj]. + [self weakArrayFormat] -> + [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. + fillValue := nilObj]. + [self sixtyFourBitIndexableFormat] -> + [nElements > (self maxSlotsForAlloc / 2) ifTrue: + [coInterpreter primitiveFailFor: PrimErrUnsupported. + ^nil]. + numSlots := nElements * 2]. + [self firstLongFormat] -> + [(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue: + [coInterpreter primitiveFailFor: PrimErrBadReceiver. + ^nil]. + numSlots := nElements]. + [self firstShortFormat] -> + [numSlots := nElements + 1 // 2. + instSpec := instSpec + (nElements bitAnd: 1)]. + [self firstByteFormat] -> + [numSlots := nElements + 3 // 4. + instSpec := instSpec + (4 - nElements bitAnd: 3)] } + otherwise: "non-indexable" + ["Some Squeak images include funky fixed subclasses of abstract variable + superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection. + The (Threaded)FFIPlugin expects to be able to instantiate ExternalData via + this method. + Hence allow fixed classes to be instantiated here iff nElements = 0." + (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue: + [coInterpreter primitiveFailFor: PrimErrBadReceiver. + ^nil]. + numSlots := self fixedFieldsOfClassFormat: classFormat. + fillValue := nilObj]. + classIndex = 0 ifTrue: + [classIndex := self ensureBehaviorHash: classObj. + classIndex < 0 ifTrue: + [coInterpreter primitiveFailFor: classIndex negated. + ^nil]]. + + numSlots > self maxSlotsForAlloc ifTrue: + [coInterpreter primitiveFailFor: PrimErrUnsupported. + ^ nil]. + newObj := self + allocateSlotsInOldSpace: numSlots + format: instSpec + classIndex: classIndex. + + newObj ifNotNil: + [self fillObj: newObj numSlots: numSlots with: fillValue] + ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. + ^newObj +] + { #category : #instantiation } Spur32BitMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ diff --git a/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st b/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st index c845e664a1..519ca0ee50 100644 --- a/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st +++ b/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st @@ -485,6 +485,75 @@ Spur64BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is ^newObj ] +{ #category : #instantiation } +Spur64BitMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ + + + "Allocate an instance of a variable class, excepting CompiledMethod." + | instSpec classFormat numSlots classIndex newObj fillValue | + classFormat := self formatOfClassSafe: classObj. + classFormat == -1 ifTrue: + [self primitiveFailFor: PrimErrBadReceiver. "no format" + ^nil]. + instSpec := self instSpecOfClassFormat: classFormat. + classIndex := self rawHashBitsOf: classObj. + fillValue := 0. + instSpec caseOf: { + [self arrayFormat] -> + [numSlots := nElements. + fillValue := nilObj]. + [self indexablePointersFormat] -> + [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. + fillValue := nilObj]. + [self weakArrayFormat] -> + [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. + fillValue := nilObj]. + [self sixtyFourBitIndexableFormat] -> + [numSlots := nElements]. + [self firstLongFormat] -> + [(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue: + [coInterpreter primitiveFailFor: PrimErrBadReceiver. + ^nil]. + numSlots := nElements + 1 // 2. + instSpec := instSpec + (nElements bitAnd: 1)]. + [self firstShortFormat] -> + [numSlots := nElements + 3 // 4. + instSpec := instSpec + (4 - nElements bitAnd: 3)]. + [self firstByteFormat] -> + [numSlots := nElements + 7 // 8. + instSpec := instSpec + (8 - nElements bitAnd: 7)] } + otherwise: "non-indexable" + ["Some Squeak images include funky fixed subclasses of abstract variable + superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection. + The (Threaded)FFIPlugin expects to be able to instantiate ExternalData via + this method. + Hence allow fixed classes to be instantiated here iff nElements = 0." + (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue: + [coInterpreter primitiveFailFor: PrimErrBadReceiver. + ^nil]. + numSlots := self fixedFieldsOfClassFormat: classFormat. + fillValue := nilObj]. + + classIndex = 0 ifTrue: + [classIndex := self ensureBehaviorHash: classObj. + classIndex < 0 ifTrue: + [coInterpreter primitiveFailFor: classIndex negated. + ^nil]]. + + numSlots > self maxSlotsForAlloc ifTrue: + [coInterpreter primitiveFailFor: PrimErrUnsupported. + ^ nil]. + newObj := self + allocateSlotsInOldSpace: numSlots + format: instSpec + classIndex: classIndex . + + newObj ifNotNil: + [self fillObj: newObj numSlots: numSlots with: fillValue] + ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. + ^newObj +] + { #category : #instantiation } Spur64BitMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 9bbd076bf0..ddc8fe3a6c 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6956,6 +6956,36 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned [ ^newObj ] +{ #category : #instantiation } +SpurMemoryManager >> instantiateClassInOldSpace: classObj [ + | instSpec classFormat numSlots classIndex newObj | + classFormat := self formatOfClassSafe: classObj. + classFormat == -1 ifTrue: + [self primitiveFailFor: PrimErrBadReceiver. "no format" + ^nil]. + instSpec := self instSpecOfClassFormat: classFormat. + (self isFixedSizePointerFormat: instSpec) ifFalse: + [self primitiveFailFor: PrimErrBadReceiver. "bad format" + ^nil]. + classIndex := self ensureBehaviorHash: classObj. + classIndex < 0 ifTrue: + [coInterpreter primitiveFailFor: classIndex negated. + ^nil]. + numSlots := self fixedFieldsOfClassFormat: classFormat. + newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex. + newObj ifNotNil: + [self fillObj: newObj numSlots: numSlots with: nilObj] + ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. + ^newObj +] + +{ #category : #instantiation } +SpurMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ + + + ^ self subclassResponsibility +] + { #category : #instantiation } SpurMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ From 952c0a6bbfa292b16c0d74ab491b08fe692f01a6 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Tue, 7 Nov 2023 23:36:58 -0300 Subject: [PATCH 03/12] Refactores newOldSpace primitive --- .../VMMaker/InterpreterPrimitives.class.st | 2 +- .../VMMaker/SpurMemoryManager.class.st | 32 +++++++++---------- 2 files changed, 16 insertions(+), 18 deletions(-) diff --git a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st index 82f7ddc891..72d465946e 100644 --- a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st @@ -2781,7 +2781,7 @@ 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 instantiateClassInOldSpace: self stackTop) + (objectMemory instantiateClass: self stackTop isPinned: false isOldSpace: true) ifNotNil: [ :obj | self pop: argumentCount + 1 thenPush: obj ] ifNil: [ self primitiveFailFor: diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index ddc8fe3a6c..c612cf05d1 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/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 ] ]. @@ -6940,24 +6950,12 @@ SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinne { #category : #instantiation } SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned [ - | instSpec classFormat numSlots classIndex newObj | - classFormat := self formatOfClass: classObj. - instSpec := self instSpecOfClassFormat: classFormat. - (self isFixedSizePointerFormat: instSpec) ifFalse: - [^nil]. - classIndex := self ensureBehaviorHash: classObj. - classIndex < 0 ifTrue: - [coInterpreter primitiveFailFor: classIndex negated. - ^nil]. - numSlots := self fixedFieldsOfClassFormat: classFormat. - newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex isPinned: isPinned. - newObj ifNotNil: - [self fillObj: newObj numSlots: numSlots with: nilObj]. - ^newObj + + ^ self instantiateClass: classObj isPinned: isPinned isOldSpace: false ] { #category : #instantiation } -SpurMemoryManager >> instantiateClassInOldSpace: classObj [ +SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: isOldSpace [ | instSpec classFormat numSlots classIndex newObj | classFormat := self formatOfClassSafe: classObj. classFormat == -1 ifTrue: @@ -6972,7 +6970,7 @@ SpurMemoryManager >> instantiateClassInOldSpace: classObj [ [coInterpreter primitiveFailFor: classIndex negated. ^nil]. numSlots := self fixedFieldsOfClassFormat: classFormat. - newObj := self allocateSlotsInOldSpace: numSlots format: instSpec classIndex: classIndex. + newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex isPinned: isPinned isOldSpace: isOldSpace. newObj ifNotNil: [self fillObj: newObj numSlots: numSlots with: nilObj] ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. From 1abc4082c09e5bbe476bcc458dcbb692b7ee1823 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Fri, 6 Oct 2023 11:25:50 +0200 Subject: [PATCH 04/12] Refactoring primitive new old space with args --- .../VMMaker/InterpreterPrimitives.class.st | 20 +++-- .../VMMaker/Spur32BitMemoryManager.class.st | 74 +------------------ .../VMMaker/Spur64BitMemoryManager.class.st | 73 +----------------- .../VMMaker/SpurMemoryManager.class.st | 14 ++-- 4 files changed, 24 insertions(+), 157 deletions(-) diff --git a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st index 72d465946e..e27b544d0b 100644 --- a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st @@ -2829,15 +2829,21 @@ InterpreterPrimitives >> primitiveNewWithArg [ InterpreterPrimitives >> primitiveNewWithArgOldSpace [ | size instSpec | + size := self positiveMachineIntegerValueOf: self stackTop. - (objectMemory instantiateClassInOldSpace: (self stackValue: 1) indexableSize: size) - 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 ]) ] + (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' } diff --git a/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st b/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st index 603a01cbe1..08a5767a12 100644 --- a/smalltalksrc/VMMaker/Spur32BitMemoryManager.class.st +++ b/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 [ "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. @@ -446,76 +446,6 @@ Spur32BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is ^newObj ] -{ #category : #instantiation } -Spur32BitMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ - - - "Allocate an instance of a variable class, excepting CompiledMethod." - | instSpec classFormat numSlots classIndex newObj fillValue | - classFormat := self formatOfClassSafe: classObj. - classFormat == -1 ifTrue: - [self primitiveFailFor: PrimErrBadReceiver. "no format" - ^nil]. - instSpec := self instSpecOfClassFormat: classFormat. - classIndex := self rawHashBitsOf: classObj. - fillValue := 0. - instSpec caseOf: { - [self arrayFormat] -> - [numSlots := nElements. - fillValue := nilObj]. - [self indexablePointersFormat] -> - [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. - fillValue := nilObj]. - [self weakArrayFormat] -> - [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. - fillValue := nilObj]. - [self sixtyFourBitIndexableFormat] -> - [nElements > (self maxSlotsForAlloc / 2) ifTrue: - [coInterpreter primitiveFailFor: PrimErrUnsupported. - ^nil]. - numSlots := nElements * 2]. - [self firstLongFormat] -> - [(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue: - [coInterpreter primitiveFailFor: PrimErrBadReceiver. - ^nil]. - numSlots := nElements]. - [self firstShortFormat] -> - [numSlots := nElements + 1 // 2. - instSpec := instSpec + (nElements bitAnd: 1)]. - [self firstByteFormat] -> - [numSlots := nElements + 3 // 4. - instSpec := instSpec + (4 - nElements bitAnd: 3)] } - otherwise: "non-indexable" - ["Some Squeak images include funky fixed subclasses of abstract variable - superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection. - The (Threaded)FFIPlugin expects to be able to instantiate ExternalData via - this method. - Hence allow fixed classes to be instantiated here iff nElements = 0." - (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue: - [coInterpreter primitiveFailFor: PrimErrBadReceiver. - ^nil]. - numSlots := self fixedFieldsOfClassFormat: classFormat. - fillValue := nilObj]. - classIndex = 0 ifTrue: - [classIndex := self ensureBehaviorHash: classObj. - classIndex < 0 ifTrue: - [coInterpreter primitiveFailFor: classIndex negated. - ^nil]]. - - numSlots > self maxSlotsForAlloc ifTrue: - [coInterpreter primitiveFailFor: PrimErrUnsupported. - ^ nil]. - newObj := self - allocateSlotsInOldSpace: numSlots - format: instSpec - classIndex: classIndex. - - newObj ifNotNil: - [self fillObj: newObj numSlots: numSlots with: fillValue] - ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. - ^newObj -] - { #category : #instantiation } Spur32BitMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ diff --git a/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st b/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st index 519ca0ee50..2577da24de 100644 --- a/smalltalksrc/VMMaker/Spur64BitMemoryManager.class.st +++ b/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 [ "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. @@ -485,75 +485,6 @@ Spur64BitMemoryManager >> instantiateClass: classObj indexableSize: nElements is ^newObj ] -{ #category : #instantiation } -Spur64BitMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ - - - "Allocate an instance of a variable class, excepting CompiledMethod." - | instSpec classFormat numSlots classIndex newObj fillValue | - classFormat := self formatOfClassSafe: classObj. - classFormat == -1 ifTrue: - [self primitiveFailFor: PrimErrBadReceiver. "no format" - ^nil]. - instSpec := self instSpecOfClassFormat: classFormat. - classIndex := self rawHashBitsOf: classObj. - fillValue := 0. - instSpec caseOf: { - [self arrayFormat] -> - [numSlots := nElements. - fillValue := nilObj]. - [self indexablePointersFormat] -> - [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. - fillValue := nilObj]. - [self weakArrayFormat] -> - [numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements. - fillValue := nilObj]. - [self sixtyFourBitIndexableFormat] -> - [numSlots := nElements]. - [self firstLongFormat] -> - [(classIndex = ClassFloatCompactIndex and: [nElements ~= 2]) ifTrue: - [coInterpreter primitiveFailFor: PrimErrBadReceiver. - ^nil]. - numSlots := nElements + 1 // 2. - instSpec := instSpec + (nElements bitAnd: 1)]. - [self firstShortFormat] -> - [numSlots := nElements + 3 // 4. - instSpec := instSpec + (4 - nElements bitAnd: 3)]. - [self firstByteFormat] -> - [numSlots := nElements + 7 // 8. - instSpec := instSpec + (8 - nElements bitAnd: 7)] } - otherwise: "non-indexable" - ["Some Squeak images include funky fixed subclasses of abstract variable - superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection. - The (Threaded)FFIPlugin expects to be able to instantiate ExternalData via - this method. - Hence allow fixed classes to be instantiated here iff nElements = 0." - (nElements ~= 0 or: [instSpec > self lastPointerFormat]) ifTrue: - [coInterpreter primitiveFailFor: PrimErrBadReceiver. - ^nil]. - numSlots := self fixedFieldsOfClassFormat: classFormat. - fillValue := nilObj]. - - classIndex = 0 ifTrue: - [classIndex := self ensureBehaviorHash: classObj. - classIndex < 0 ifTrue: - [coInterpreter primitiveFailFor: classIndex negated. - ^nil]]. - - numSlots > self maxSlotsForAlloc ifTrue: - [coInterpreter primitiveFailFor: PrimErrUnsupported. - ^ nil]. - newObj := self - allocateSlotsInOldSpace: numSlots - format: instSpec - classIndex: classIndex . - - newObj ifNotNil: - [self fillObj: newObj numSlots: numSlots with: fillValue] - ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. - ^newObj -] - { #category : #instantiation } Spur64BitMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index c612cf05d1..8e08e7a5c2 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6945,6 +6945,13 @@ SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements [ SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned [ + ^ self instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: false +] + +{ #category : #instantiation } +SpurMemoryManager >> instantiateClass: classObj indexableSize: nElements isPinned: isPinned isOldSpace: isOldSpace [ + + ^ self subclassResponsibility ] @@ -6977,13 +6984,6 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: i ^newObj ] -{ #category : #instantiation } -SpurMemoryManager >> instantiateClassInOldSpace: classObj indexableSize: nElements [ - - - ^ self subclassResponsibility -] - { #category : #instantiation } SpurMemoryManager >> instantiateCompiledMethodClass: classObj indexableSize: nElements [ From 6351cce5de905609809e0da2e95853420c09f6c1 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Fri, 6 Oct 2023 11:29:07 +0200 Subject: [PATCH 05/12] Added primitives to the primitive table --- smalltalksrc/VMMaker/StackInterpreter.class.st | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index 83f0771ec0..e5fc334378 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/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) From 70654edf52c5af8a8116c2eefc822d698772c642 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Fri, 6 Oct 2023 11:37:53 +0200 Subject: [PATCH 06/12] Updated image version --- cmake/vmmaker.cmake | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cmake/vmmaker.cmake b/cmake/vmmaker.cmake index fb0c56f60d..12085df94f 100644 --- a/cmake/vmmaker.cmake +++ b/cmake/vmmaker.cmake @@ -120,8 +120,8 @@ if(GENERATE_SOURCES) ExternalProject_Add( vmmaker - URL https://files.pharo.org/image/110/Pharo11-SNAPSHOT.build.688.sha.cf3d3fd.arch.64bit.zip - URL_HASH SHA256=c050ddcedce70ec92c22a3244aa5ebbc655dcaffcb42ac80fbf1f6e795c7010d + URL https://files.pharo.org/image/110/Pharo11-SNAPSHOT.build.707.sha.f720787.arch.64bit.zip + URL_HASH SHA256=b96a943513c6a79c7319b285e46719fbe74c570ace3fa0c9ead43123c165671a BUILD_COMMAND ${VMMAKER_VM} --headless ${VMMAKER_DIR}/image/Pharo11-SNAPSHOT-64bit-cf3d3fd.image --no-default-preferences save VMMaker COMMAND ${VMMAKER_VM} --headless ${VMMAKER_IMAGE} --no-default-preferences --save --quit "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}/scripts/installVMMaker.st" "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}" "${ICEBERG_DEFAULT_REMOTE}" UPDATE_COMMAND "" From 5e25de701f602c8953323f44c7debd3f3df2dbb4 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Fri, 6 Oct 2023 11:39:28 +0200 Subject: [PATCH 07/12] Undo changes --- cmake/vmmaker.cmake | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cmake/vmmaker.cmake b/cmake/vmmaker.cmake index 12085df94f..fb0c56f60d 100644 --- a/cmake/vmmaker.cmake +++ b/cmake/vmmaker.cmake @@ -120,8 +120,8 @@ if(GENERATE_SOURCES) ExternalProject_Add( vmmaker - URL https://files.pharo.org/image/110/Pharo11-SNAPSHOT.build.707.sha.f720787.arch.64bit.zip - URL_HASH SHA256=b96a943513c6a79c7319b285e46719fbe74c570ace3fa0c9ead43123c165671a + URL https://files.pharo.org/image/110/Pharo11-SNAPSHOT.build.688.sha.cf3d3fd.arch.64bit.zip + URL_HASH SHA256=c050ddcedce70ec92c22a3244aa5ebbc655dcaffcb42ac80fbf1f6e795c7010d BUILD_COMMAND ${VMMAKER_VM} --headless ${VMMAKER_DIR}/image/Pharo11-SNAPSHOT-64bit-cf3d3fd.image --no-default-preferences save VMMaker COMMAND ${VMMAKER_VM} --headless ${VMMAKER_IMAGE} --no-default-preferences --save --quit "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}/scripts/installVMMaker.st" "${CMAKE_CURRENT_SOURCE_DIR_TO_OUT}" "${ICEBERG_DEFAULT_REMOTE}" UPDATE_COMMAND "" From 4ef3a0812ea2fdffefc81c238a9169d8161d6a92 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Fri, 13 Oct 2023 21:22:29 +0200 Subject: [PATCH 08/12] Removed space - make the CI run again --- smalltalksrc/VMMaker/StackInterpreter.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index e5fc334378..8b8a6ba2ea 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -1345,7 +1345,7 @@ StackInterpreter class >> initializePrimitiveTable [ "Unassigned Primitives" (575 595 primitiveFail) - + "Allocate in old space primitive" (596 primitiveNewOldSpace) (597 primitiveNewWithArgOldSpace) From 1bc1833622db83b60aa1533d012428d08297f8f7 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Wed, 8 Nov 2023 16:05:24 -0300 Subject: [PATCH 09/12] Removed usage of #formatOfClassSafe: --- smalltalksrc/VMMaker/SpurMemoryManager.class.st | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 8e08e7a5c2..3e6380368e 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6964,13 +6964,9 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned [ { #category : #instantiation } SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: isOldSpace [ | instSpec classFormat numSlots classIndex newObj | - classFormat := self formatOfClassSafe: classObj. - classFormat == -1 ifTrue: - [self primitiveFailFor: PrimErrBadReceiver. "no format" - ^nil]. + classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. (self isFixedSizePointerFormat: instSpec) ifFalse: - [self primitiveFailFor: PrimErrBadReceiver. "bad format" ^nil]. classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: @@ -6979,8 +6975,7 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: i numSlots := self fixedFieldsOfClassFormat: classFormat. newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex isPinned: isPinned isOldSpace: isOldSpace. newObj ifNotNil: - [self fillObj: newObj numSlots: numSlots with: nilObj] - ifNil: [ self primitiveFailFor: PrimErrNoMemory ]. + [self fillObj: newObj numSlots: numSlots with: nilObj]. ^newObj ] From 43c17d95808e906859936c012f0ca64cf1580cd8 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Thu, 9 Nov 2023 09:18:51 -0300 Subject: [PATCH 10/12] Solved syntax problem --- smalltalksrc/VMMaker/SpurMemoryManager.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 3e6380368e..6e45d66514 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6971,7 +6971,7 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: i 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 isOldSpace: isOldSpace. newObj ifNotNil: From bf59b6ab2352c9d94db27f5d6b10e0c0994ba46b Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Thu, 9 Nov 2023 09:20:47 -0300 Subject: [PATCH 11/12] Syntax --- smalltalksrc/VMMaker/SpurMemoryManager.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 6e45d66514..abe1b0f88e 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6967,7 +6967,7 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: i classFormat := self formatOfClass: classObj. instSpec := self instSpecOfClassFormat: classFormat. (self isFixedSizePointerFormat: instSpec) ifFalse: - ^nil]. + [^nil]. classIndex := self ensureBehaviorHash: classObj. classIndex < 0 ifTrue: [coInterpreter primitiveFailFor: classIndex negated. From 47694ef12dfe7fc8a1f143b35a63c6dd3e537d42 Mon Sep 17 00:00:00 2001 From: jordanmontt Date: Thu, 9 Nov 2023 09:21:25 -0300 Subject: [PATCH 12/12] Syntax --- smalltalksrc/VMMaker/SpurMemoryManager.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index abe1b0f88e..9853d20b92 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -6971,7 +6971,7 @@ SpurMemoryManager >> instantiateClass: classObj isPinned: isPinned isOldSpace: i 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 isOldSpace: isOldSpace. newObj ifNotNil: