[Vm-dev] VM Maker: VMMaker.oscog-eem.255.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Jan 13 02:31:23 UTC 2013


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.255.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.255
Author: eem
Time: 12 January 2013, 6:28:41.398 pm
UUID: 51e53ec1-8caf-41f6-9293-1088ef4b82d8
Ancestors: VMMaker.oscog-eem.254

[New[Co]]ObjectMemory:
Fix freeing of objects for becomeForward:.  Remove freed young
roots from the rootsTable.  Filter freed objects pointet to from the
extraRootsTable (because these locations can change it is wrong
to remove entries from the extraRootsTable).

Abstract away use of the RootBit into isYoungRoot[Header]:

StackToRegisterMappingCogit:
Fix marshalling of absent receiver sends.  The items beneath the
arguments (and to-be-pushed receiver) must be spilled before
the receiver is pushed.

Improve code quality for numArgs > numRegArgs sends when
receiver is not a spill and there are no uses of ReceiverResultReg
amongst args.  e.g. now avoids loading ReceiverResultReg from stack
in code such as 1 with: 2 with: 3 .

=============== Diff against VMMaker.oscog-eem.254 ===============

Item was changed:
  ----- Method: CogVMSimulator>>filterPerformOf:to: (in category 'control primitives') -----
  filterPerformOf: selector to: receiver
  	"This is to allow simulator to filter start-up items to avoid as-yet unsimulatable plugins."
  	performFilters ifNil: [^false].
  	(performFilters at: (self shortPrint: receiver) ifAbsent: []) ifNotNil:
  		[:messages|
- 		self halt.
  		^messages includes: (self stringOf: selector)].
  	^false!

Item was changed:
  ----- Method: Interpreter>>primitiveIsRoot (in category 'memory space primitives') -----
  primitiveIsRoot
  	"Primitive. Answer whether the argument to the primitive is a root for young space"
  	| oop |
  	<export: true>
  	oop := self stackObjectValue: 0.
+ 	successFlag ifTrue:
+ 		[self pop: argumentCount + 1 thenPushBool: (self isYoungRoot: oop)]!
- 	successFlag ifTrue:[
- 		self pop: argumentCount + 1.
- 		self pushBool: ((self baseHeader: oop) bitAnd: RootBit).
- 	].!

Item was changed:
  ----- Method: NewCoObjectMemory>>ceStoreCheck: (in category 'trampolines') -----
  ceStoreCheck: anOop
  	<api>
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	it allows the code generator to reload ReceiverResultReg cheaply."
  	self assert: (self isNonIntegerObject: anOop).
  	self assert: (self oop: anOop isLessThan: self youngStart).
+ 	self assert: (self isYoungRoot: anOop) not.
- 	self assert: ((self baseHeader: anOop) bitAnd: RootBit) = 0.
  	self noteAsRoot: anOop headerLoc: anOop.
  	^anOop!

Item was added:
+ ----- Method: NewCoObjectMemory>>freeObject: (in category 'become') -----
+ freeObject: obj
+ 	self assert: ((self isCompiledMethod: obj) not or: [(self methodHasCogMethod: obj) not]).
+ 	super freeObject: obj!

Item was changed:
  ----- Method: NewObjectMemory>>checkOkayOop: (in category 'debug support') -----
  checkOkayOop: oop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class.
  	 Answer true if OK.  Otherwise print reason and answer false."
  
  	<api>
  	<var: #oop type: #usqInt>
  	| sz type fmt unusedBit |
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
  	(oop >= self startOfMemory and: [oop < freeStart])
  		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) < freeStart
  		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
  xxx"
+ 	((self isYoungRoot: oop) and: [oop >= youngStart])
- 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
- 	 [oop >= youngStart])
  		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
  	^true
  !

Item was changed:
  ----- Method: NewObjectMemory>>mapPointersInObjectsFrom:to: (in category 'gc -- compaction') -----
  mapPointersInObjectsFrom: memStart to: memEnd
  	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory.
  	 Also remap pointers in root objects which may contains pointers into the given memory range, and
  	 don't forget to flush the method cache based on the range."
  	<inline: false>
  	"update interpreter variables"
  	coInterpreter mapInterpreterOops.
  	1 to: extraRootCount do:
  		[:i | | oop |
  		oop := (extraRoots at: i) at: 0.
+ 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
- 		(self isIntegerObject: oop) ifFalse:
  			[(extraRoots at: i) at: 0 put: (self remap: oop)]].
  	coInterpreter flushMethodCacheFrom: memStart to: memEnd.
  	self updatePointersInRootObjectsFrom: memStart to: memEnd.
  	self updatePointersInRangeFrom: memStart to: memEnd!

Item was changed:
  ----- Method: NewObjectMemory>>markPhase: (in category 'gc -- mark and sweep') -----
  markPhase: fullGCFlag
  	"Mark phase of the mark and sweep garbage collector. Set 
  	 the mark bits of all reachable objects. Free chunks are 
  	 untouched by this process."
  	"Assume: All non-free objects are initially unmarked. Root 
  	 objects were unmarked when they were made roots.
  	 (Make sure this stays true!!!!)."
  	| oop statMarkCountPriorToStackPageFreeing |
  	<inline: false>
  	"trace the interpreter's objects, including the active stacks
  	 and special objects array"
  	self markAndTraceInterpreterOops: fullGCFlag.
  	statSpecialMarkCount := statMarkCount.
  	"trace the roots"
  	1 to: rootTableCount do:
  		[:i | 
  		oop := rootTable at: i.
  		self markAndTrace: oop].
  	1 to: extraRootCount do:
  		[:i|
  		oop := (extraRoots at: i) at: 0.
+ 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
- 		(self isIntegerObject: oop) ifFalse:
  			[self markAndTrace: oop]].
  	statMarkCountPriorToStackPageFreeing := statMarkCount.
  	"Only safe to free stack pages after all roots have been traced."
  	self markAndTraceAndMaybeFreeStackPages: fullGCFlag.
  	"Only safe to free any machine code methods after all
  	 stack pages have been traced."
  	self markAndTraceOrFreeMachineCode: fullGCFlag.
  	statSpecialMarkCount := statSpecialMarkCount + (statMarkCount - statMarkCountPriorToStackPageFreeing)!

Item was changed:
  ----- Method: NewObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
  noteAsRoot: oop headerLoc: headerLoc 
  	"Record that the given oop in the old object area points to an 
  	 object in the young area. HeaderLoc is usually = oop, but may
  	 be an addr in a forwarding block."
  	| header |
  	<inline: true>
  	<asmLabel: false> 
  	header := self longAt: headerLoc.
+ 	(self isYoungRootHeader: header) ifFalse:
- 	(header bitAnd: RootBit) = 0 ifTrue:
  		"record oop as root only if not already recorded"
  		[rootTableCount < RootTableSize ifTrue:
+ 			"record root if there is enough room in the roots table"
- 			"record root if there is enough room in the roots  table "
  			[rootTableCount := rootTableCount + 1.
  			 rootTable at: rootTableCount put: oop.
  			 self longAt: headerLoc put: (header bitOr: RootBit).
  			 rootTableCount > RootTableRedZone ifTrue:
  				"if we're now in the red zone force an IGC ASAP"
  				[self scheduleIncrementalGC]]]!

Item was changed:
  ----- Method: NewObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
  	<var: #oop type: #usqInt>
  	oop := self cCoerce: signedOop to: #usqInt.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
  	(oop >= self startOfMemory and: [oop < freeStart])
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) <= freeStart
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
+ 	((self isYoungRoot: oop) and: [oop >= youngStart])
- 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
- 	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was changed:
  ----- Method: NewspeakInterpreter>>primitiveIsRoot (in category 'memory space primitives') -----
  primitiveIsRoot
  	"Primitive. Answer whether the argument to the primitive is a root for young space"
  	| oop |
  	<export: true>
  	oop := self stackObjectValue: 0.
+ 	self successful ifTrue:
+ 		[self pop: argumentCount + 1 thenPushBool: (self isYoungRoot: oop)]!
- 	self successful ifTrue:[
- 		self pop: argumentCount + 1.
- 		self pushBool: ((self baseHeader: oop) bitAnd: RootBit).
- 	].!

Item was changed:
  ----- Method: ObjectMemory>>checkHeapIntegrity (in category 'memory access') -----
  checkHeapIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccessibleObjects has set a bit at each
  	 object's header.  Scan all objects in the heap checking that every
  	 pointer points to a header.  Scan the rootTable, remapBuffer and
  	 extraRootTable checking that every entry is a pointer to a header.
  	 Check that the number of roots is correct and that all rootTable
  	 entries have their rootBit set. Answer if all checks pass."
  	| ok obj sz hdr fmt fi fieldOop numRootsInHeap |
  	<inline: false>
  	ok := true.
  	numRootsInHeap := 0.
  	obj := self firstObject.
  	[self oop: obj isLessThan: self startOfFreeSpace] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
  				[hdr := self baseHeader: obj.
+ 				 (self isYoungRootHeader: hdr) ifTrue:
- 				 (hdr bitAnd: RootBit) ~= 0 ifTrue:
  					[numRootsInHeap := numRootsInHeap + 1].
  				 (self compactClassIndexOfHeader: hdr) = 0 ifTrue:
  					[fieldOop := (self classHeader: obj) bitAnd: AllButTypeMask.
  					 ((self isIntegerObject: fieldOop)
  					   or: [(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  						[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
  						 ok := false]].
  				 fmt := self formatOfHeader: hdr.
  				 (fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
  					[fmt >= 12
  						ifTrue: [fi := (self literalCountOf: obj) + 1 "+ 1 = methodHeader slot"]
  						ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
  									ifTrue: [fi := CtxtTempFrameStart + (self fetchStackPointerOf: obj)]
  									ifFalse: [fi := self lengthOf: obj]].
  					[(fi := fi - 1) >= 0] whileTrue:
  						[fieldOop := self fetchPointer: fi ofObject: obj.
  						 (self isNonIntegerObject: fieldOop) ifTrue:
  							[(fieldOop bitAnd: BytesPerWord - 1) ~= 0
  								ifTrue:
  									[self print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  									 ok := false]
  								ifFalse:
  									[(self heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  										[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  										 ok := false]]]]].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz].
  	numRootsInHeap ~= rootTableCount ifTrue:
  		[self print: 'root count mismatch. #heap roots '; printNum: numRootsInHeap; print: '; #roots '; printNum: rootTableCount; cr.
  		 ok := false].
  	1 to: rootTableCount do:
  		[:ri|
  		obj := rootTable at: ri.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned oop in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 ok := false]
  					ifFalse:
  						[hdr := self baseHeader: obj.
+ 						 (self isYoungRootHeader: hdr) ifFalse:
- 						 (hdr bitAnd: RootBit) = 0 ifTrue:
  							[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  							 ok := false]]]].
  	1 to: remapBufferCount do:
  		[:ri|
  		obj := remapBuffer at: ri.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 ok := false]]].
  	1 to: extraRootCount do:
  		[:ri|
  		obj := (extraRoots at: ri) at: 0.
  		(obj bitAnd: BytesPerWord - 1) ~= 0
  			ifTrue:
  				[self print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  				 ok := false]
  			ifFalse:
  				[(self heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  						 ok := false]]].
  	^ok!

Item was changed:
  ----- Method: ObjectMemory>>checkOkayOop: (in category 'debug support') -----
  checkOkayOop: oop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class.
  	 Answer true if OK.  Otherwise print reason and answer false."
  
  	<api>
  	<var: #oop type: #usqInt>
  	| sz type fmt unusedBit |
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
  	(oop >= self startOfMemory and: [oop < endOfMemory])
  		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) < endOfMemory
  		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
  xxx"
+ 	((self isYoungRoot: oop) and: [oop >= youngStart])
- 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
- 	 [oop >= youngStart])
  		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
  	^true
  !

Item was changed:
  ----- Method: ObjectMemory>>freeObject: (in category 'become') -----
  freeObject: obj
  	| objHeader objHeaderBytes objHeaderType objSize |
  	objHeader := self baseHeader: obj.
+ 	(self isYoungRootHeader: objHeader) ifTrue:
+ 		[self removeYoungRoot: obj].
  	objHeaderType := objHeader bitAnd: TypeMask.
  	objHeaderBytes := headerTypeBytes at: objHeaderType.
  	(objHeaderType bitAnd: 1) = 1 "HeaderTypeClass or HeaderTypeShort"
  		ifTrue: [objSize := objHeader bitAnd: SizeMask]
  		ifFalse:
  			[objHeaderType = HeaderTypeFree
  				ifTrue: [^nil]. "already free"
  			objSize := (self sizeHeader: obj) bitAnd: LongSizeMask].
  	self assert: (objSize + objHeaderBytes bitAnd: AllButTypeMask) = (objSize + objHeaderBytes).
  	self longAt: obj - objHeaderBytes
  		put: ((objSize + objHeaderBytes) bitOr: HeaderTypeFree)!

Item was changed:
  ----- Method: ObjectMemory>>isYoungRoot: (in category 'garbage collection') -----
  isYoungRoot: oop
  	"Answer if oop is a root for objects in youngSpace"
+ 	^self isYoungRootHeader: (self baseHeader: oop)!
- 	^((self baseHeader: oop) bitAnd: RootBit) ~= 0!

Item was added:
+ ----- Method: ObjectMemory>>isYoungRootHeader: (in category 'garbage collection') -----
+ isYoungRootHeader: header
+ 	"Answer if oop is a root for objects in youngSpace"
+ 	^(header bitAnd: RootBit) ~= 0!

Item was changed:
  ----- Method: ObjectMemory>>mapPointersInObjectsFrom:to: (in category 'gc -- compaction') -----
  mapPointersInObjectsFrom: memStart to: memEnd
  	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory. Also remap pointers in root objects which may contains pointers into the given memory range, and don't forget to flush the method cache based on the range"
  	| oop |
  	<inline: false>
  	"update interpreter variables"
  	self mapInterpreterOops.
  	1 to: extraRootCount do:[:i |
  		oop := (extraRoots at: i) at: 0.
+ 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
+ 			[(extraRoots at: i) at: 0 put: (self remap: oop)]].
- 		(self isIntegerObject: oop) ifFalse:[(extraRoots at: i) at: 0 put: (self remap: oop)]].
  	self flushMethodCacheFrom: memStart to: memEnd.
  	self updatePointersInRootObjectsFrom: memStart to: memEnd.
  	self updatePointersInRangeFrom: memStart to: memEnd.
  !

Item was changed:
  ----- Method: ObjectMemory>>markPhase (in category 'gc -- mark and sweep') -----
  markPhase
  	"Mark phase of the mark and sweep garbage collector. Set 
  	the mark bits of all reachable objects. Free chunks are 
  	untouched by this process."
  	"Assume: All non-free objects are initially unmarked. Root 
  	objects were unmarked when they were made roots. (Make 
  	sure this stays true!!!!)."
  	| oop |
  	<inline: false>
  	"clear the recycled context lists"
  	freeContexts := NilContext.
  	freeLargeContexts := NilContext.
  	"trace the interpreter's objects, including the active stack 
  	and special objects array"
  	self markAndTraceInterpreterOops.
  	statSpecialMarkCount := statMarkCount.
  	"trace the roots"
  	1 to: rootTableCount do: [:i | 
+ 		oop := rootTable at: i.
+ 		self markAndTrace: oop].
- 			oop := rootTable at: i.
- 			self markAndTrace: oop].
  	1 to: extraRootCount do:[:i|
+ 		oop := (extraRoots at: i) at: 0.
+ 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
+ 			[self markAndTrace: oop]].
- 			oop := (extraRoots at: i) at: 0.
- 			(self isIntegerObject: oop) ifFalse:[self markAndTrace: oop]].
  !

Item was changed:
  ----- Method: ObjectMemory>>noteAsRoot:headerLoc: (in category 'garbage collection') -----
  noteAsRoot: oop headerLoc: headerLoc 
  	"Record that the given oop in the old object area points to an 
  	object in the young area. 
  	HeaderLoc is usually = oop, but may be an addr in a 
  	forwarding block."
  	| header |
  	<inline: true>
  	<asmLabel: false> 
  	header := self longAt: headerLoc.
+ 	(self isYoungRootHeader: header) ifFalse:
+ 		["record oop as root only if not already recorded"
+ 		rootTableCount < RootTableRedZone
+ 			ifTrue: ["record root if there is enough room in the roots table "
+ 				rootTableCount := rootTableCount + 1.
+ 				rootTable at: rootTableCount put: oop.
+ 				self longAt: headerLoc put: (header bitOr: RootBit)]
+ 			ifFalse: ["we're getting in the red zone"
+ 				rootTableCount < RootTableSize
+ 					ifTrue: ["but there's still space to record it"
+ 						rootTableCount := rootTableCount + 1.
+ 						rootTable at: rootTableCount put: oop.
+ 						self longAt: headerLoc put: (header bitOr: RootBit).
+ 						"but force an IGC on the next allocation"
+ 						allocationCount := allocationsBetweenGCs + 1]]]!
- 	(header bitAnd: RootBit) = 0
- 		ifTrue: ["record oop as root only if not already recorded"
- 			rootTableCount < RootTableRedZone
- 				ifTrue: ["record root if there is enough room in the roots 
- 					table "
- 					rootTableCount := rootTableCount + 1.
- 					rootTable at: rootTableCount put: oop.
- 					self longAt: headerLoc put: (header bitOr: RootBit)]
- 				ifFalse: ["we're getting in the red zone"
- 					rootTableCount < RootTableSize
- 						ifTrue: ["but there's still space to record it"
- 							rootTableCount := rootTableCount + 1.
- 							rootTable at: rootTableCount put: oop.
- 							self longAt: headerLoc put: (header bitOr: RootBit).
- 							"but force an IGC on the next allocation"
- 							allocationCount := allocationsBetweenGCs + 1]]]!

Item was changed:
  ----- Method: ObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
  	<var: #oop type: #usqInt>
  	oop := self cCoerce: signedOop to: #usqInt.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
  	(oop >= self startOfMemory and: [oop < endOfMemory])
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) < endOfMemory
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
+ 	((self isYoungRoot: oop) and: [oop >= youngStart])
- 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
- 	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was changed:
  ----- Method: ObjectMemory>>removeGCRoot: (in category 'plugin support') -----
  removeGCRoot: varLoc
  	"Remove the given variable location to the extra roots table"
- 	| root |
  	<export: true>
  	<var: #varLoc type: #'sqInt *'>
+ 	1 to: extraRootCount do:
+ 		[:i|
+ 		varLoc = (extraRoots at: i) ifTrue: "swap varLoc with last entry"
+ 			[extraRoots at: i put: (extraRoots at: extraRootCount).
+ 			 extraRootCount := extraRootCount-1.
+ 			 ^true]].
- 	<var: #root type: #'sqInt *'>
- 	1 to: extraRootCount do:[:i|
- 		root := extraRoots at: i.
- 		root == varLoc ifTrue:["swap varLoc with last entry"
- 			extraRoots at: i put: (extraRoots at: extraRootCount).
- 			extraRootCount := extraRootCount-1.
- 			^true]].
  	^false "not found"!

Item was added:
+ ----- Method: ObjectMemory>>removeYoungRoot: (in category 'become') -----
+ removeYoungRoot: obj
+ 	"Remove the given young root form the root table (for freeObject: for becomeForward:)."
+ 	<inline: false>
+ 	1 to: rootTableCount do:
+ 		[:i|
+ 		obj = (rootTable at: i) ifTrue:"swap obj with last entry"
+ 			[rootTable at: i put: (rootTable at: rootTableCount).
+ 			rootTableCount := rootTableCount-1.
+ 			^true]].
+ 	^false "not found"!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>anyReferencesToRegister:inTopNItems: (in category 'simulation stack') -----
+ anyReferencesToRegister: reg inTopNItems: n
+ 	| regMask |
+ 	regMask := self registerMaskFor: reg.
+ 	simStackPtr to: simStackPtr - n + 1 by: -1 do:
+ 		[:i|
+ 		((self simStackAt: i) registerMask anyMask: regMask) ifTrue:
+ 			[^true]].
+ 	^false!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>marshallImplicitReceiverSendArguments: (in category 'simulation stack') -----
  marshallImplicitReceiverSendArguments: numArgs
  	"Spill everything on the simulated stack that needs spilling (that below arguments).
  	 Marshall arguments to stack and/or registers depending on arg count.
  	 If the args don't fit in registers push receiver and args (spill everything).  Assume
  	 receiver already in ResultReceiverReg so shuffle args and push it if necessary."
+ 	self ssFlushTo: simStackPtr - numArgs.
  	numArgs > self numRegArgs
  		ifTrue:
  			["The arguments must be pushed to the stack, and hence the receiver
  			   must be inserted beneath the args.  Reduce or eliminate the argument
  			   shuffle by only moving already spilled items."
  			| numSpilled |
  			numSpilled := self numberOfSpillsInTopNItems: numArgs.
  			numSpilled > 0
  				ifTrue:
  					[self MoveMw: 0 r: SPReg R: TempReg.
  					 self PushR: TempReg.
  					 2 to: numSpilled do:
  						[:index|
  						self MoveMw: index * BytesPerWord r: SPReg R: TempReg.
  						self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg].
  					 self MoveR: ReceiverResultReg Mw: numSpilled * BytesPerWord r: SPReg]
  				ifFalse:
  					[self PushR: ReceiverResultReg].
  			self ssFlushTo: simStackPtr]
  		"Move the args to the register arguments, being careful to do
  		 so last to first so e.g. previous contents don't get overwritten.
  		 Also check for any arg registers in use by other args."
  		ifFalse:
+ 			[numArgs > 0 ifTrue:
- 			[self ssFlushTo: simStackPtr - numArgs - 1.
- 			 numArgs > 0 ifTrue:
  				[(self numRegArgs > 1 and: [numArgs > 1])
  					ifTrue:
  						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 2.
  						 self ssAllocateRequiredReg: Arg1Reg upThrough: simStackPtr - 1]
  					ifFalse:
  						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 1]].
  			 (self numRegArgs > 1 and: [numArgs > 1]) ifTrue:
  				[(self simStackAt: simStackPtr) popToReg: Arg1Reg].
  			 numArgs > 0 ifTrue:
  				[(self simStackAt: simStackPtr - numArgs + 1)
  					popToReg: Arg0Reg]].
  	self ssPop: numArgs!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>marshallSendArguments: (in category 'simulation stack') -----
  marshallSendArguments: numArgs 
  	"Spill everything on the simulated stack that needs spilling (that below receiver and arguments).
  	 Marshall receiver and arguments to stack and/or registers depending on arg count.
  	 If the args don't fit in registers push receiver and args (spill everything), but still assign
  	 the receiver to ReceiverResultReg."
+ 	self ssFlushTo: simStackPtr - numArgs - 1.
  	numArgs > self numRegArgs
  		ifTrue:
+ 			"If there are no spills and no references to ReceiverResultReg
+ 			 the fetch of ReceiverResultReg from the stack can be avoided
+ 			 by assigning directly to ReceiverResultReg and pushing it."
+ 			[| numSpilled anyRefs |
+ 			numSpilled := self numberOfSpillsInTopNItems: numArgs + 1.
+ 			anyRefs := self anyReferencesToRegister: ReceiverResultReg inTopNItems: numArgs + 1.
+ 			(numSpilled > 0 or: [anyRefs])
+ 				ifTrue:
+ 					[self ssFlushTo: simStackPtr.
+ 					 (self simStackAt: simStackPtr - numArgs)
+ 						storeToReg: ReceiverResultReg]
+ 				ifFalse:
+ 					[(self simStackAt: simStackPtr - numArgs)
+ 						storeToReg: ReceiverResultReg;
+ 					 	type: SSRegister;
+ 						register: ReceiverResultReg.
+ 					 self ssFlushTo: simStackPtr]]
- 			[self ssFlushTo: simStackPtr.
- 			 (self simStackAt: simStackPtr - numArgs)
- 				storeToReg: ReceiverResultReg]
- 		"move the args to the register arguments, being careful to do
- 		 so last to first so e.g. previous contents don't get overwritten.
- 		 Also check for any arg registers in use by other args."
  		ifFalse:
+ 			"Move the args to the register arguments, being careful to do
+ 			 so last to first so e.g. previous contents don't get overwritten.
+ 			 Also check for any arg registers in use by other args."
+ 			[numArgs > 0 ifTrue:
- 			[self ssFlushTo: simStackPtr - numArgs - 1.
- 			 numArgs > 0 ifTrue:
  				[(self numRegArgs > 1 and: [numArgs > 1])
  					ifTrue:
  						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 2.
  						 self ssAllocateRequiredReg: Arg1Reg upThrough: simStackPtr - 1]
  					ifFalse:
  						[self ssAllocateRequiredReg: Arg0Reg upThrough: simStackPtr - 1]].
  			 (self numRegArgs > 1 and: [numArgs > 1]) ifTrue:
  				[(self simStackAt: simStackPtr) popToReg: Arg1Reg].
  			 numArgs > 0 ifTrue:
  				[(self simStackAt: simStackPtr - numArgs + 1)
  					popToReg: Arg0Reg].
  			 (self simStackAt: simStackPtr - numArgs)
  				popToReg: ReceiverResultReg].
  	self ssPop: numArgs + 1!



More information about the Vm-dev mailing list