- Fixing crash when method is a forwarder in Cog

- Making the remembered set to be initialized only for the old remembered set
- printing all objects in the perm space.
- printing class table
- Adding tests

smalltalksrc/VMMaker/CoInterpreter.class.st

@@ -5199,6 +5199,10 @@ CoInterpreter >> mustMapMachineCodePC: theIP context: aOnceMarriedContext [
 	<var: #cogMethod type: #'CogMethod *'>
 	theIP = HasBeenReturnedFromMCPC ifTrue:
 		[^objectMemory nilObject].
+
+	"We need to ensure that the context does not have forwarders"
+	objectMemory followForwardedObjectFields: aOnceMarriedContext toDepth: 0.
+
 	maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aOnceMarriedContext.
 	methodObj := objectMemory fetchPointer: MethodIndex ofObject: aOnceMarriedContext.
 	self assert: (theIP signedBitShift: -16) = -1.

smalltalksrc/VMMaker/Cogit.class.st

@@ -4932,18 +4932,20 @@ Cogit >> cogFullBlockMethod: aMethodObj numCopied: numCopied [
 	<var: #startTime type: #usqLong>
 	<var: #cogMethod type: #'CogMethod *'>
 
-	| cogMethod 	startTime |
+	| cogMethod 	startTime ultimateLiteral |
 
 	(self exclude: aMethodObj) ifTrue:
 		[^nil].
 	
 	startTime := coInterpreter ioUTCMicrosecondsNow.	
-
+	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
+	ultimateLiteral := coInterpreter ultimateLiteralOf: aMethodObj.
+	
+	self deny: (objectMemory isForwarded: ultimateLiteral).
 	self deny: (coInterpreter methodHasCogMethod: aMethodObj).
-	self assert: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
+	self assert: (objectMemory isOopCompiledMethod: ultimateLiteral).
 	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
 
-	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
 	methodObj := aMethodObj.
 	methodHeader := objectMemory methodHeaderOf: aMethodObj.
 	receiverTags := objectMemory receiverTagBitsForMethod: methodObj.

smalltalksrc/VMMaker/SpurGenerationScavenger.class.st

@@ -744,7 +744,7 @@ SpurGenerationScavenger >> mapOopsFromPermSpace [
 						[manager setIsRememberedOf: referrer to: false].
 		 sourceIndex := sourceIndex + 1].
 
-	manager getFromPermSpaceRememberedSet rememberedSetSize: destIndex.
+	manager getFromPermSpaceRememberedSet setRememberedSetSize: destIndex.
 ]
 
 { #category : #accessing }
@@ -1201,7 +1201,7 @@ SpurGenerationScavenger >> scavengeRememberedSetStartingAt: n [
 					ifFalse:
 						[manager setIsRememberedOf: referrer to: false]].
 		 sourceIndex := sourceIndex + 1].
-	manager getFromOldSpaceRememberedSet rememberedSetSize: destIndex.
+	manager getFromOldSpaceRememberedSet setRememberedSetSize: destIndex.
 	self assert: self noUnfiredEphemeronsAtEndOfRememberedSet.
 ]
 

smalltalksrc/VMMaker/SpurMemoryManager.class.st

@@ -3023,10 +3023,11 @@ SpurMemoryManager >> characterValueOf: oop [
 ]
 
 { #category : #'debug support' }
-SpurMemoryManager >> cheapAddressCouldBeInHeap: address [ 
-	^(address bitAnd: self wordSize - 1) = 0
-	  and: [(self oop: address isGreaterThanOrEqualTo: memoryMap newSpaceStart)
-	  and: [self oop: address isLessThan: memoryMap oldSpaceEnd]]
+SpurMemoryManager >> cheapAddressCouldBeInHeap: address [
+
+	^ (address bitAnd: self wordSize - 1) = 0 and: [ 
+		  (self isInNewSpace: address) or: [ 
+			  (self isInOldSpace: address) or: [ self isInPermSpace: address ] ] ]
 ]
 
 { #category : #'plugin support' }
@@ -4720,13 +4721,13 @@ SpurMemoryManager >> expungeDuplicateAndUnmarkedClasses: expungeUnmarked [
 					[classIndex < classTableIndex ifTrue:
 						[classTableIndex := classIndex]]
 				ifFalse:
-					[((expungeUnmarked and: [(self isMarked: classOrNil) not])
+					[((expungeUnmarked and: [(self isMarkedOrPermanent: classOrNil) not])
 					   or: [(self rawHashBitsOf: classOrNil) ~= classIndex]) ifTrue:
 						[self storePointerUnchecked: j
 							ofObject: classTablePage
 							withValue: nilObj.
 						 "but if it is marked, it should still be in the table at its correct index."
-						 self assert: ((expungeUnmarked and: [(self isMarked: classOrNil) not])
+						 self assert: ((expungeUnmarked and: [(self isMarkedOrPermanent: classOrNil) not])
 									or: [(self classAtIndex: (self rawHashBitsOf: classOrNil)) = classOrNil]).
 						 "If the removed class is before the classTableIndex, set the
 						  classTableIndex to point to the empty slot so as to reuse it asap."
@@ -6557,8 +6558,8 @@ SpurMemoryManager >> initializeObjectMemory: bytesToShift [
 	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space"
 	self initializeNewSpaceVariables.
 
-	fromOldSpaceRememberedSet initializeRememberedSet.
-	fromPermSpaceRememberedSet initializeRememberedSet.
+	fromOldSpaceRememberedSet initializeRememberedSetShouldStartEmpty: true.
+	fromPermSpaceRememberedSet initializeRememberedSetShouldStartEmpty: false.
 
 	segmentManager checkSegments.
 	compactor biasForGC.
@@ -10009,6 +10010,26 @@ SpurMemoryManager >> printBogons [
 	compactor printTheBogons: bogon
 ]
 
+{ #category : #printing }
+SpurMemoryManager >> printClassTableEntries [
+
+	<api>
+	coInterpreter
+		print: 'Class Table Entries';
+		cr.
+	coInterpreter
+		print: '-----------------';
+		cr;
+		cr.
+
+	0 to: numClassTablePages - 1 do: [ :i | 
+		| page |
+		coInterpreter printNum: i.
+
+		page := self fetchPointer: i ofObject: hiddenRootsObj.
+		coInterpreter longPrintOop: page ]
+]
+
 { #category : #'debug printing' }
 SpurMemoryManager >> printContextReferencesTo: anOop [
 	"Scan the heap printing the oops of any and all contexts that refer to anOop"

smalltalksrc/VMMaker/StackInterpreter.class.st

@@ -11348,6 +11348,16 @@ StackInterpreter >> printActivationNameForSelector: aSelector startClass: startC
 		ifFalse: [self print: 'INVALID SELECTOR']
 ]
 
+{ #category : #'debug printing' }
+StackInterpreter >> printAllPermanentObjects [
+	<api>
+
+	self print: 'Permanent Objects'; cr.
+	self print: '-----------------'; cr; cr.
+
+	objectMemory allPermSpaceObjectsDo: [ :anOop | self longPrintOop: anOop; cr ].
+]
+
 { #category : #'debug printing' }
 StackInterpreter >> printAllStacks [
 	"Print all the stacks of all running processes, including those that are currently suspended."
@@ -15229,6 +15239,13 @@ StackInterpreter >> ultimateLiteralOf: aMethodOop [
 	^self literal: (objectMemory literalCountOf: aMethodOop) - 1 ofMethod: aMethodOop
 ]
 
+{ #category : #'debug printing' }
+StackInterpreter >> ultimateLiteralOf: aMethodOop put: aValue [
+	<api>
+	self assert: (objectMemory isOopCompiledMethod: aMethodOop).
+	^self literal: (objectMemory literalCountOf: aMethodOop) - 1 ofMethod: aMethodOop put: aValue
+]
+
 { #category : #'internal interpreter access' }
 StackInterpreter >> unPop: nItems [
 	"In the StackInterpreter stacks grow down."

smalltalksrc/VMMaker/VMMemoryMap.class.st

@@ -301,14 +301,14 @@ VMMemoryMap >> codeZoneStart: anInteger [
 VMMemoryMap >> doCheckMemoryMap [
 
 	self assert: (self isYoungObject: self newSpaceStart).
-	self assert: (self isYoungObject: self newSpaceEnd - memoryMapConfiguration confWordSize).
+	self assert: (self isYoungObject: self newSpaceEnd - BytesPerWord).
 	self assert: (self isOldObject: self newSpaceStart) not.
-	self assert: (self isOldObject: self newSpaceEnd - memoryMapConfiguration confWordSize) not.
+	self assert: (self isOldObject: self newSpaceEnd - BytesPerWord) not.
 	self assert: (self isYoungObject: self newSpaceEnd).
 	self assert: (self isYoungObject: self oldSpaceStart) not.
 	self assert: (self isYoungObject: self oldSpaceEnd) not.
 	self assert: (self isOldObject: self oldSpaceStart).
-	self assert: (self isOldObject: self oldSpaceEnd - memoryMapConfiguration confWordSize).
+	self assert: (self isOldObject: self oldSpaceEnd - BytesPerWord).
 	self assert: (self isOldObject: self oldSpaceEnd).
 
 ]
@@ -517,7 +517,7 @@ VMMemoryMap >> memset: startAddress _: value _: size [
 
 	<doNotGenerate>
 
-	startAddress to: startAddress + size - 1 by: memoryMapConfiguration confWordSize do: [ :address |
+	startAddress to: startAddress + size - 1 by: BytesPerWord do: [ :address |
 		memoryManager longAt: address put: value ]
 
 ]

smalltalksrc/VMMaker/VMRememberedSet.class.st

@@ -59,6 +59,22 @@ VMRememberedSet class >> shouldBeGenerated [
 	^ false
 ]
 
+{ #category : #initialization }
+VMRememberedSet >> countNotNilObjects [
+
+	<inline: false>
+
+	| count |
+	count := 0.
+
+	0 to: self rememberedSetLimit do: [ :i | 
+		"The remembered set might be initialized with 0"
+		((self objectAt: i) = manager nilObject or: [ (self objectAt: i) = 0 ]) ifTrue: [ ^ count ].
+		count := i ].
+
+	^ count
+]
+
 { #category : #'store check' }
 VMRememberedSet >> doRemember: objOop [
 	"Add the argument to the remembered set and set its isRemembered bit to true.
@@ -73,7 +89,8 @@ VMRememberedSet >> doRemember: objOop [
 	rememberedSetSize >= rememberedSetLimit ifTrue:
 		[self growRememberedSet].
 	rememberedSetArray at: rememberedSetSize put: objOop.
-	(rememberedSetSize := rememberedSetSize + 1) >= rememberedSetRedZone ifTrue:
+	self setRememberedSetSize: rememberedSetSize + 1.
+	rememberedSetSize >= rememberedSetRedZone ifTrue:
 		[manager scheduleScavenge].
 	^objOop
 ]
@@ -93,7 +110,9 @@ VMRememberedSet >> forgetObject: objOop [
 					[rememberedSetArray at: index put: (rememberedSetArray at: rememberedSetSize - 1).
 					 index := rememberedSetSize]
 				ifFalse: [index := index + 1]]].
-	rememberedSetSize := rememberedSetSize - 1.
+
+	self setRememberedSetSize: rememberedSetSize - 1.
+
 	self assert: rememberedSetSize >= 0
 ]
 
@@ -151,7 +170,7 @@ VMRememberedSet >> initialize [
 ]
 
 { #category : #initialization }
-VMRememberedSet >> initializeRememberedSet [
+VMRememberedSet >> initializeRememberedSetShouldStartEmpty: shouldStartEmpty [
 	| obj |
 	obj := self objectOop.
 	obj = manager nilObject
@@ -165,8 +184,13 @@ VMRememberedSet >> initializeRememberedSet [
 	self assert: (manager formatOf: obj) = manager wordIndexableFormat.
 	self assert: (manager isPinned: obj).
 	rememberedSetArray := manager firstIndexableField: obj.
-	rememberedSetSize := 0.
+
 	self rememberedSetLimit: (manager numSlotsOf: obj).
+
+	shouldStartEmpty 
+		ifTrue: [rememberedSetSize := 0]
+		ifFalse: [rememberedSetSize := self countNotNilObjects].
+
 	self setRememberedSetRedZone
 ]
 
@@ -323,12 +347,6 @@ VMRememberedSet >> rememberedSetSize [
 	^rememberedSetSize
 ]
 
-{ #category : #accessing }
-VMRememberedSet >> rememberedSetSize: aSize [
-
-	rememberedSetSize := aSize
-]
-
 { #category : #'debug support' }
 VMRememberedSet >> rememberedSetWithIndexDo: aBlock [
 
@@ -345,13 +363,17 @@ VMRememberedSet >> rememberedSetWithIndexDo: aBlock startingAt: startIndex [
 { #category : #accessing }
 VMRememberedSet >> removeByIndexUsingPreviousSize: anIndex [
 
+	| newRememberedSetSize |
+
 	previousRememberedSetSize := previousRememberedSetSize - 1.
-	rememberedSetSize := rememberedSetSize - 1.
+	newRememberedSetSize := rememberedSetSize - 1.
 
 	rememberedSetArray
 		at: anIndex put: (rememberedSetArray at: previousRememberedSetSize);
 		at: previousRememberedSetSize
-		put: (rememberedSetArray at: rememberedSetSize)
+		put: (rememberedSetArray at: newRememberedSetSize).
+
+	self setRememberedSetSize: newRememberedSetSize.
 ]
 
 { #category : #'debug support' }
@@ -382,16 +404,19 @@ VMRememberedSet >> removeLastEphemeronTo: index andSave: anOop [
 { #category : #accessing }
 VMRememberedSet >> removeLastObject [
 
-	rememberedSetSize := rememberedSetSize - 1
+	self setRememberedSetSize: rememberedSetSize - 1
 ]
 
 { #category : #accessing }
 VMRememberedSet >> removeObjectAt: anIndex [
 
-	rememberedSetSize := rememberedSetSize - 1.
+	| newRememberedSetSize |
+	newRememberedSetSize := rememberedSetSize - 1.
 
 	rememberedSetArray
-		at: anIndex put: (rememberedSetArray at: rememberedSetSize)
+		at: anIndex put: (rememberedSetArray at: newRememberedSetSize).
+
+	self setRememberedSetSize: newRememberedSetSize.
 ]
 
 { #category : #accessing }
@@ -429,6 +454,14 @@ VMRememberedSet >> setRememberedSetRedZone [
 	self rememberedSetRedZone: (self rememberedSetLimit * 3 // 4 max: self fudge)
 ]
 
+{ #category : #initialization }
+VMRememberedSet >> setRememberedSetSize: aNewValue [
+
+	"We want to guarantee that the first free position is a with 0"
+	rememberedSetSize := aNewValue.
+	aNewValue < rememberedSetLimit ifTrue: [ rememberedSetArray at: aNewValue put: 0 ]
+]
+
 { #category : #scavenger }
 VMRememberedSet >> startingLoop [
 

smalltalksrc/VMMaker/ZnBufferedWriteStream.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : #ZnBufferedWriteStream }
+
+{ #category : #'*VMMaker' }
+ZnBufferedWriteStream >> stream [
+	^ stream
+]