Implementing testing of objects and allocation of bytearrays

hernanmd · Mar 29, 2022 · 1bca761 · 1bca761
1 parent d63451a
commit 1bca761
Show file tree

Hide file tree

Showing 6 changed files with 280 additions and 49 deletions.
diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st
@@ -616,7 +616,8 @@ Class {
 		'statShrinkMemory',
 		'statAllocatedBytes',
 		'statMaxAllocSegmentTime',
-		'unscannedEphemeronsQueueInitialSize'
+		'unscannedEphemeronsQueueInitialSize',
+		'permSpaceFreeStart'
 	],
 	#classVars : [
 		'BitsPerByte',
@@ -1950,7 +1951,7 @@ SpurMemoryManager >> allocateMemoryOfSize: memoryBytes initialAddress: initialAd
 ]
 
 { #category : #initialization }
-SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes methodCacheSize: methodCacheSize primitiveTraceLogSize: primitiveLogSize rumpCStackSize: rumpCStackSize initialAddress: initialAddress [
+SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes methodCacheSize: methodCacheSize primitiveTraceLogSize: primitiveLogSize rumpCStackSize: rumpCStackSize initialAddress: initialAddress permSpaceSize: permSpaceSize [
 
 	"Intialize the receiver for bootsraping an image.
 	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
@@ -1980,12 +1981,11 @@ SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceByt
 	self assert: allocatedAddress = initialAddress.
 		
 	memoryMap newSpaceStart: initialAddress + newSpaceStartOffset.
-	memoryMap oldSpaceEnd: (freeOldSpaceStart := initialAddress + allocatedMemory).
-	"leave newSpace empty for the bootstrap"
-	freeStart := newSpaceBytes + memoryMap newSpaceStart.
-
 	memoryMap newSpaceEnd: newSpaceBytes + memoryMap newSpaceStart.
 	memoryMap oldSpaceStart: memoryMap newSpaceEnd.
+	memoryMap setOldSpaceEnd: (freeOldSpaceStart := initialAddress + allocatedMemory).
+	"leave newSpace empty for the bootstrap"
+	freeStart := newSpaceBytes + memoryMap newSpaceStart.
 	
 	scavengeThreshold := allocatedMemory. "i.e. /don't/ scavenge."
 	scavenger := SpurGenerationScavenger simulatorClass new.
@@ -1996,7 +1996,14 @@ SpurMemoryManager >> allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceByt
 		survivorBytes: newSpaceBytes // self scavengerDenominator.
 	compactor := self class compactorClass simulatorClass new
 		             manager: self;
-		             yourself
+		             yourself.
+	
+	permSpaceSize > 0 
+		ifTrue: [ 
+			memoryMap permSpaceStart: (self allocateMemoryOfSize: permSpaceSize initialAddress: 16r10000000).
+			memoryMap permSpaceEnd: memoryMap permSpaceStart + permSpaceSize.
+			permSpaceFreeStart := memoryMap permSpaceStart ] 
+
 ]
 
 { #category : #allocation }
@@ -2462,6 +2469,45 @@ SpurMemoryManager >> allocateSlotsInOldSpace: numSlots format: formatField class
 				classIndex: classIndex ]
 ]
 
+{ #category : #allocation }
+SpurMemoryManager >> allocateSlotsInPermSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex [
+
+	"Answer the oop of a chunk of space in permanent Space with numSlots slots.  The header
+	 will have been filled-in but not the contents.  If no memory is available answer nil."
+
+	<var: #totalBytes type: #usqInt>
+	<inline: false>
+
+	| chunk newOop |
+
+	permSpaceFreeStart + totalBytes > memoryMap permSpaceEnd
+		ifTrue: [ ^ nil ].
+	
+	chunk := permSpaceFreeStart.
+	permSpaceFreeStart := permSpaceFreeStart + totalBytes.
+
+	newOop := self
+		          initializeHeaderOfStartAddress: chunk
+		          numSlots: numSlots
+		          format: formatField
+		          classIndex: classIndex
+		          pinned: false.
+
+	^ newOop
+]
+
+{ #category : #allocation }
+SpurMemoryManager >> allocateSlotsInPermSpace: numSlots format: formatField classIndex: classIndex [
+
+	<inline: true>
+
+	^ self
+		  allocateSlotsInPermSpace: numSlots
+		  bytes: (self objectBytesForSlots: numSlots)
+		  format: formatField
+		  classIndex: classIndex
+]
+
 { #category : #allocation }
 SpurMemoryManager >> allocateSmallNewSpaceSlots: numSlots format: formatField classIndex: classIndex [
 	"Allocate an object with numSlots in newSpace, where numSlots is known to be small.
@@ -2625,7 +2671,7 @@ SpurMemoryManager >> assimilateNewSegment: segInfo [
 	 Here we set freeOldSpaceStart & oldSpaceEnd if required."
 	<var: #segInfo type: #'SpurSegmentInfo *'>
 	segInfo segLimit >= memoryMap oldSpaceEnd ifTrue:
-		[ memoryMap oldSpaceEnd: (freeOldSpaceStart := segInfo segLimit - self bridgeSize)]
+		[ memoryMap setOldSpaceEnd: (freeOldSpaceStart := segInfo segLimit - self bridgeSize)]
 ]
 
 { #category : #compaction }
@@ -3349,7 +3395,9 @@ SpurMemoryManager >> checkMemoryMap [
 	self assert: (self isYoungObject: memoryMap oldSpaceEnd) not.
 	self assert: (self isOldObject: memoryMap newSpaceEnd).
 	self assert: (self isOldObject: memoryMap oldSpaceStart).
-	self assert: (self isOldObject: memoryMap oldSpaceEnd)
+	
+	self flag: #todo.
+"	self assert: (self isOldObject: memoryMap oldSpaceEnd)"
 ]
 
 { #category : #'debug support' }
@@ -6366,6 +6414,7 @@ SpurMemoryManager >> initializeFromMemoryMap [
 	pastSpaceStart := scavenger pastSpace start.
 
 	freeOldSpaceStart := memoryMap oldSpaceEnd.
+	permSpaceFreeStart := memoryMap permSpaceStart.
 
 ]
 
@@ -6487,7 +6536,7 @@ SpurMemoryManager >> initializeOldSpaceFirstFree: startOfFreeOldSpace [
 		freeOldStart < limit ifTrue:
 			[freeChunk := self freeChunkWithBytes: limit - freeOldStart at: freeOldStart.
 			 self assert: (self addressAfter: freeChunk) = limit]].
-	memoryMap oldSpaceEnd: memoryMap oldSpaceEnd - self bridgeSize.
+	memoryMap setOldSpaceEnd: memoryMap oldSpaceEnd - self bridgeSize.
 	freeOldSpaceStart := memoryMap oldSpaceEnd.
 	self checkFreeSpace: GCModeFreeSpace
 ]
@@ -7285,10 +7334,13 @@ SpurMemoryManager >> isObjImmutable: anOop [
 
 { #category : #'object testing' }
 SpurMemoryManager >> isOldObject: objOop [
-	<api>
+
+	<doNotGenerate>
 	"Answer if obj is old. Require that obj is non-immediate."
-	self assert: (self isNonImmediate: objOop).
-	^self oop: objOop isGreaterThanOrEqualTo: memoryMap oldSpaceStart
+	self assert: (self isNonImmediate: objOop).	
+	
+	^ memoryMap isOldObject: objOop
+
 ]
 
 { #category : #'object testing' }
@@ -7319,6 +7371,17 @@ SpurMemoryManager >> isOopMutable: oop [
 	  and: [(self isImmutable: oop) not]
 ]
 
+{ #category : #'object testing' }
+SpurMemoryManager >> isPermanentObject: objOop [
+
+	<doNotGenerate>
+	"Answer if obj is old. Require that obj is non-immediate."
+	self assert: (self isNonImmediate: objOop).	
+	
+	^ memoryMap isPermanentObject: objOop
+
+]
+
 { #category : #'header access' }
 SpurMemoryManager >> isPinned: objOop [
 	<api>
@@ -7644,10 +7707,10 @@ SpurMemoryManager >> isYoung: oop [
 
 { #category : #'object testing' }
 SpurMemoryManager >> isYoungObject: objOop [
-	<api>
+	<doNotGenerate>
 	"Answer if obj is young. Require that obj is non-immediate."
 	self assert: (self isNonImmediate: objOop).
-	^self oop: objOop isLessThan: memoryMap newSpaceEnd
+	^ memoryMap isYoungObject: objOop
 ]
 
 { #category : #'object access' }
@@ -9280,7 +9343,11 @@ SpurMemoryManager >> objectAfter: objOop [
 		 (self isInPastSpace: objOop) ifTrue:
 			[^self objectAfter: objOop limit: pastSpaceStart].
 		 ^self objectAfter: objOop limit: scavenger futureSurvivorStart].
-	^self objectAfter: objOop limit: memoryMap oldSpaceEnd
+	
+	^ (memoryMap isPermanentObject: objOop)
+		ifTrue: [ self objectAfter: objOop limit: memoryMap permSpaceEnd ]
+		ifFalse: [ self objectAfter: objOop limit: memoryMap oldSpaceEnd ]
+	
 ]
 
 { #category : #'object enumeration' }
@@ -9476,6 +9543,11 @@ SpurMemoryManager >> pastSpaceStart [
 	^pastSpaceStart
 ]
 
+{ #category : #accessing }
+SpurMemoryManager >> permSpaceFreeStart [
+	^ permSpaceFreeStart
+]
+
 { #category : #'primitive support' }
 SpurMemoryManager >> pinObject: objOop [
 	"Attempt to pin objOop, which must not be immediate.
@@ -10881,7 +10953,7 @@ SpurMemoryManager >> setEndOfMemory: newEndOfMemory [
 	"Set by the segment manager after swizzling the image,
 	 and by the SpurBootstrap on writing out the transformed image."
 
-	memoryMap oldSpaceEnd: newEndOfMemory.
+	memoryMap setOldSpaceEnd: newEndOfMemory.
 
 	freeOldSpaceStart > newEndOfMemory ifTrue:
 		[freeOldSpaceStart := newEndOfMemory]
@@ -11003,7 +11075,7 @@ SpurMemoryManager >> setLastSegment: segInfo [
 	<var: #currentEnd type: #usqInt>
 	currentEnd := segInfo segLimit - self bridgeSize.
 	currentEnd <= memoryMap oldSpaceEnd ifTrue:
-		[memoryMap oldSpaceEnd: currentEnd.
+		[memoryMap setOldSpaceEnd: currentEnd.
 		 freeOldSpaceStart > currentEnd ifTrue:
 			[freeOldSpaceStart :=currentEnd]]
 ]

diff --git a/smalltalksrc/VMMaker/TVMSpurMemoryManagerSimulator.trait.st b/smalltalksrc/VMMaker/TVMSpurMemoryManagerSimulator.trait.st
@@ -10,7 +10,7 @@ TVMSpurMemoryManagerSimulator >> initializeFreeSpaceForFacadeFrom: base to: limi
 
 	self getMemoryMap newSpaceEnd: (self freeStart: base).
 	self getMemoryMap oldSpaceStart: self getMemoryMap newSpaceEnd.
-	self getMemoryMap oldSpaceEnd: limit.
+	self getMemoryMap setOldSpaceEnd: limit.
 
 	self scavengeThreshold: limit * 3 // 4.
 	self segmentManager initSegmentForInImageCompilationFrom: base to: limit.
@@ -55,7 +55,7 @@ TVMSpurMemoryManagerSimulator >> setHeapBase: baseOfHeap memoryLimit: memLimit e
 
 	self getMemoryMap oldSpaceStart: self getMemoryMap newSpaceEnd.
 	self freeOldSpaceStart: memEnd.
-	self getMemoryMap oldSpaceEnd: memLimit.
+	self getMemoryMap setOldSpaceEnd: memLimit.
 
 	^baseOfHeap
 ]

diff --git a/smalltalksrc/VMMaker/VMMemoryMap.class.st b/smalltalksrc/VMMaker/VMMemoryMap.class.st
@@ -11,7 +11,10 @@ Class {
 		'initialOldSpaceSize',
 		'initialNewSpaceSize',
 		'initialHeadroom',
-		'memoryMapConfiguration'
+		'memoryMapConfiguration',
+		'permSpaceStart',
+		'permSpaceEnd',
+		'oldSpaceMask'
 	],
 	#category : #'VMMaker-Memory'
 }
@@ -63,6 +66,7 @@ VMMemoryMap >> allocateHeap [
 	<inline: false>
 	self allocateNewObjectsSpace.
 	self allocateOldObjectsSpace.
+	self allocatePermObjectsSpace.	
 ]
 
 { #category : #private }
@@ -97,7 +101,7 @@ VMMemoryMap >> allocateOldObjectsSpace [
 
 	self oldSpaceStart ifNil: [ self insufficientMemoryAvailableError ].
 
-	self oldSpaceEnd: self oldSpaceStart + sizeToAllocate
+	self setOldSpaceEnd: self oldSpaceStart + sizeToAllocate
 ]
 
 { #category : #accessing }
@@ -159,6 +163,33 @@ VMMemoryMap >> insufficientMemoryAvailableError [
 	self error.
 ]
 
+{ #category : #'testing objects' }
+VMMemoryMap >> isOldObject: anOop [ 
+	<api>
+	self flag:#todo.
+	"^ anOop allMask: oldSpaceMask "
+	^ oldSpaceStart <= anOop and: [ anOop < oldSpaceEnd ]
+
+]
+
+{ #category : #'testing objects' }
+VMMemoryMap >> isPermanentObject: anOop [ 
+	<api>
+	self flag:#todo.
+	"^ anOop allMask: oldSpaceMask "
+	^ permSpaceStart <= anOop and: [ anOop < permSpaceEnd ]
+
+]
+
+{ #category : #'testing objects' }
+VMMemoryMap >> isYoungObject: anOop [ 
+	<api>
+	self flag:#todo.
+	"^ anOop allMask: oldSpaceMask "
+	^ newSpaceStart <= anOop and: [ anOop < newSpaceEnd ]
+
+]
+
 { #category : #accessing }
 VMMemoryMap >> memoryManager [
 
@@ -200,12 +231,6 @@ VMMemoryMap >> oldSpaceEnd [
 	^ oldSpaceEnd
 ]
 
-{ #category : #accessing }
-VMMemoryMap >> oldSpaceEnd: anInteger [ 
-
-	oldSpaceEnd := anInteger
-]
-
 { #category : #accessing }
 VMMemoryMap >> oldSpaceStart [
 
@@ -218,6 +243,34 @@ VMMemoryMap >> oldSpaceStart: anObject [
 	oldSpaceStart := anObject
 ]
 
+{ #category : #accessing }
+VMMemoryMap >> permSpaceEnd [
+	^ permSpaceEnd
+]
+
+{ #category : #accessing }
+VMMemoryMap >> permSpaceEnd: anInteger [ 
+
+	permSpaceEnd := anInteger
+]
+
+{ #category : #accessing }
+VMMemoryMap >> permSpaceStart [
+	^ permSpaceStart
+]
+
+{ #category : #accessing }
+VMMemoryMap >> permSpaceStart: anInteger [ 
+
+	permSpaceStart := anInteger 
+]
+
+{ #category : #initialization }
+VMMemoryMap >> setOldSpaceEnd: anInteger [ 
+
+	oldSpaceEnd := anInteger.
+]
+
 { #category : #accessing }
 VMMemoryMap >> startOfObjectMemory [
 
@@ -226,11 +279,3 @@ VMMemoryMap >> startOfObjectMemory [
 	"The first object space in the memory map is the newSpace."
 	^ self newSpaceStart 
 ]
-
-{ #category : #accessing }
-VMMemoryMap >> wordSize: anInteger [ 
-
-	<doNotGenerate>
-
-	wordSize := anInteger
-]