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

commits at source.squeak.org commits at source.squeak.org
Thu Sep 26 21:41:30 UTC 2013


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

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

Name: VMMaker.oscog-eem.414
Author: eem
Time: 26 September 2013, 2:38:43.606 pm
UUID: a208fc7a-c1bd-4ae9-98ab-2a81e5d238fa
Ancestors: VMMaker.oscog-eem.413

isWeakNonInt: => isWeakNonImm: (for Spur)

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

Item was changed:
  ----- Method: CoInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
  pathTo: goal using: stack followWeak: followWeak
  	"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
  	 If found, unmark, leaving path in stack, and answer 0.  Otherwise answer an error:
  		PrimErrBadArgument if stack is not an Array
  		PrimErrBadIndex if search overflows stack
  		PrimErrNotFound if goal cannot be found"
  	| current hdr index next stackSize stackp freeStartAtStart |
  	(objectMemory isArray: stack) ifFalse:
  		[^PrimErrBadArgument].
  	freeStartAtStart := objectMemory freeStart. "check no allocations during search"
  	objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
  	stackSize := objectMemory lengthOf: stack.
  	objectMemory mark: stack.
  	"no need. the current context is not reachable from the active process (suspendedContext is nil)"
  	"objectMemory mark: self activeProcess."
  	current := objectMemory specialObjectsOop.
  	objectMemory mark: current.
  	index := objectMemory lengthOf: current.
  	stackp := 0.
  	[[(index := index - 1) >= -1] whileTrue:
  		[next := (stackPages couldBeFramePointer: current)
  					ifTrue:
  						[index >= 0
  							ifTrue: [self field: index ofFrame: (self cCoerceSimple: current to: #'char *')]
  							ifFalse: [objectMemory nilObject]]
  					ifFalse:
  						[index >= 0
  							ifTrue:
  								[hdr := objectMemory baseHeader: current.
  								 (objectMemory isContextHeader: hdr)
  									ifTrue: [self fieldOrSenderFP: index ofContext: current]
  									ifFalse: [objectMemory fetchPointer: index ofObject: current]]
  							ifFalse:
  								[objectMemory fetchClassOfNonImm: current]].
  		 (stackPages couldBeFramePointer: next)
  			ifTrue: [self assert: (self isFrame: (self cCoerceSimple: next to: #'char *')
  										onPage: (stackPages stackPageFor: (self cCoerceSimple: next to: #'char *')))]
  			ifFalse:
  				[next >= heapBase ifTrue:
  					[self assert: (self checkOkayOop: next)]].
  		 next = goal ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory storePointer: stackp ofObject: stack withValue: current.
  			 self pruneStack: stack stackp: stackp.
  			 ^0].
  		 ((objectMemory isNonIntegerObject: next)
  		  and: [(stackPages couldBeFramePointer: next)
  				ifTrue: [(self frameIsMarked: next) not]
  				ifFalse:
  					[next >= heapBase "exclude Cog methods"
  					  and: [(objectMemory isMarked: next) not
  					  and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
+ 					  and: [followWeak or: [(objectMemory isWeakNonImm: next) not]]]]]])
- 					  and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]])
  			ifTrue:
  				[stackp + 2 > stackSize ifTrue:
  					[self assert: freeStartAtStart = objectMemory freeStart.
  					 self unmarkAfterPathTo.
  					 objectMemory nilFieldsOf: stack.
  					 ^PrimErrBadIndex]. "PrimErrNoMemory ?"
  				 objectMemory
  					storePointerUnchecked: stackp ofObject: stack withValue: current;
  					storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
  				 stackp := stackp + 2.
  				 (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
  					ifTrue:
  						[self markFrame: next.
  						index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
  					ifFalse:
  						[hdr := objectMemory baseHeader: next.
  						 objectMemory baseHeader: next put: (hdr bitOr: MarkBit).
  						 (objectMemory isCompiledMethodHeader: hdr)
  							ifTrue: [index := (self literalCountOf: next) + LiteralStart]
  							ifFalse: [index := objectMemory lengthOf: next]].
  				 current := next]].
  		 current = objectMemory specialObjectsOop ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory nilFieldsOf: stack.
  			^PrimErrNotFound].
  		 index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
  		 current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
  		 stackp := stackp - 2] repeat!

Item was changed:
  ----- Method: NewObjectMemory>>sweepPhase (in category 'gc -- mark and sweep') -----
  sweepPhase
  	"Sweep memory from youngStart through the end of memory. Free all 
  	inaccessible objects and coalesce adjacent free chunks. Clear the mark 
  	bits of accessible objects. Compute the starting point for the first pass of 
  	incremental compaction (compStart). Return the number of surviving 
  	objects. "
  	"Details: Each time a non-free object is encountered, decrement the 
  	number of available forward table entries. If all entries are spoken for 
  	(i.e., entriesAvailable reaches zero), set compStart to the last free 
  	chunk before that object or, if there is no free chunk before the given 
  	object, the first free chunk after it. Thus, at the end of the sweep 
  	phase, compStart through compEnd spans the highest collection of 
  	non-free objects that can be accomodated by the forwarding table. This 
  	information is used by the first pass of incremental compaction to 
  	ensure that space is initially freed at the end of memory. Note that 
  	there should always be at least one free chunk--the one at the end of 
  	the heap."
  	| entriesAvailable survivors freeChunk firstFree oop oopHeader oopHeaderType hdrBytes oopSize freeChunkSize freeStartLocal |
  	<inline: false>
  	<var: #oop type: #usqInt>
  	<var: #freeStartLocal type: #usqInt>
  	entriesAvailable := self fwdTableInit: BytesPerWord*2.
  	survivors := 0.
  	freeChunk := nil.
  	firstFree := nil.
  	"will be updated later"
  	freeStartLocal := freeStart.
  	oop := self oopFromChunk: youngStart.
  	[oop < freeStartLocal]
  		whileTrue: ["get oop's header, header type, size, and header size"
  			statSweepCount := statSweepCount + 1.
  			oopHeader := self baseHeader: oop.
  			oopHeaderType := oopHeader bitAnd: TypeMask.
  			hdrBytes := headerTypeBytes at: oopHeaderType.
  			(oopHeaderType bitAnd: 1) = 1
  				ifTrue: [oopSize := oopHeader bitAnd: SizeMask]
  				ifFalse: [oopHeaderType = HeaderTypeSizeAndClass
  						ifTrue: [oopSize := (self sizeHeader: oop) bitAnd: LongSizeMask]
  						ifFalse: ["free chunk" oopSize := oopHeader bitAnd: LongSizeMask]].
  			(oopHeader bitAnd: MarkBit) = 0
  				ifTrue: ["object is not marked; free it"
  					"<-- Finalization support: We need to mark each oop chunk as free -->"
  					self longAt: oop - hdrBytes put: HeaderTypeFree.
  					freeChunk ~= nil
  						ifTrue: ["enlarge current free chunk to include this oop"
  							freeChunkSize := freeChunkSize + oopSize + hdrBytes]
  						ifFalse: ["start a new free chunk"
  							freeChunk := oop - hdrBytes.
  							"chunk may start 4 or 8 bytes before oop"
  							freeChunkSize := oopSize + (oop - freeChunk).
  							"adjust size for possible extra header bytes"
  							firstFree = nil ifTrue: [firstFree := freeChunk]]]
  				ifFalse: ["object is marked; clear its mark bit and possibly adjust 
  					the compaction start"
  					self longAt: oop put: (oopHeader bitAnd: AllButMarkBit).
  					"<-- Finalization support: Check if we're running about a weak class -->"
+ 					(self isWeakNonImm: oop) ifTrue: [self finalizeReference: oop].
- 					(self isWeakNonInt: oop) ifTrue: [self finalizeReference: oop].
  					entriesAvailable > 0
  						ifTrue: [entriesAvailable := entriesAvailable - 1]
  						ifFalse: ["start compaction at the last free chunk before this object"
  							firstFree := freeChunk].
  					freeChunk ~= nil
  						ifTrue: ["record the size of the last free chunk"
  							self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree).
  							freeChunk := nil].
  					survivors := survivors + 1].
  			oopSize = 0 ifTrue:
  				[self error: 'zero sized object encountered in sweep'].
  			oop := self oopFromChunk: oop + oopSize].
  	freeChunk ~= nil
  		ifTrue: ["record size of final free chunk"
  			self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree)].
  	oop = freeStart
  		ifFalse: [self error: 'sweep failed to find exact end of memory'].
  	compStart := firstFree = nil
  					ifTrue: [freeStart]
  					ifFalse: [firstFree].
  	^survivors!

Item was changed:
  ----- Method: NewObjectMemory>>sweepPhaseForFullGC (in category 'garbage collection') -----
  sweepPhaseForFullGC
  	"Sweep memory from youngStart through the end of memory. Free all
  	 inaccessible objects and coalesce adjacent free chunks. Clear the mark
  	 bits of accessible objects. Compute the starting point for the first pass
  	 of incremental compaction (compStart). Return the number of surviving
  	 objects.  Unlike sweepPhase this always leaves compStart pointing at the
  	 first free chunk."
  	| survivors freeChunk firstFree oop oopHeader oopHeaderType hdrBytes oopSize freeChunkSize endOfMemoryLocal |
  	<inline: false>
  	<var: #oop type: #usqInt>
  	<var: #endOfMemoryLocal type: #usqInt>
  	self fwdTableInit: BytesPerWord*2.
  	survivors := 0.
  	freeChunk := nil.
  	firstFree := nil.
  	"will be updated later"
  	endOfMemoryLocal := endOfMemory.
  	oop := self oopFromChunk: youngStart.
  	[oop < endOfMemoryLocal]
  		whileTrue: ["get oop's header, header type, size, and header size"
  			statSweepCount := statSweepCount + 1.
  			oopHeader := self baseHeader: oop.
  			oopHeaderType := oopHeader bitAnd: TypeMask.
  			hdrBytes := headerTypeBytes at: oopHeaderType.
  			(oopHeaderType bitAnd: 1) = 1
  				ifTrue: [oopSize := oopHeader bitAnd: SizeMask]
  				ifFalse: [oopHeaderType = HeaderTypeSizeAndClass
  						ifTrue: [oopSize := (self sizeHeader: oop) bitAnd: LongSizeMask]
  						ifFalse: [self assert: (oopHeader bitAnd: MarkBit) = 0.
  								oopSize := oopHeader bitAnd: LongSizeMask]].
  			(oopHeader bitAnd: MarkBit) = 0
  				ifTrue: ["object is not marked; free it"
  					"<-- Finalization support: We need to mark each oop chunk as free -->"
  					self longAt: oop - hdrBytes put: HeaderTypeFree.
  					freeChunk ~= nil
  						ifTrue: ["enlarge current free chunk to include this oop"
  							freeChunkSize := freeChunkSize + oopSize + hdrBytes]
  						ifFalse: ["start a new free chunk"
  							freeChunk := oop - hdrBytes.
  							"chunk may start 4 or 8 bytes before oop"
  							freeChunkSize := oopSize + (oop - freeChunk).
  							"adjust size for possible extra header bytes"
  							firstFree = nil ifTrue: [firstFree := freeChunk]]]
  				ifFalse: ["object is marked; clear its mark bit and possibly adjust 
  					the compaction start"
  					self longAt: oop put: (oopHeader bitAnd: AllButMarkBit).
  					"<-- Finalization support: Check if we're running about a weak class -->"
+ 					(self isWeakNonImm: oop) ifTrue: [self finalizeReference: oop].
- 					(self isWeakNonInt: oop) ifTrue: [self finalizeReference: oop].
  					freeChunk ~= nil
  						ifTrue: ["record the size of the last free chunk"
  							self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree).
  							freeChunk := nil].
  					survivors := survivors + 1].
  			oop := self oopFromChunk: oop + oopSize].
  	freeChunk ~= nil
  		ifTrue: ["record size of final free chunk"
  			self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree)].
  	oop = endOfMemory
  		ifFalse: [self error: 'sweep failed to find exact end of memory'].
  	firstFree = nil
  		ifTrue: [self error: 'expected to find at least one free object']
  		ifFalse: [compStart := firstFree].
  
  	^ survivors!

Item was changed:
  ----- Method: ObjectMemory>>isWeak: (in category 'header access') -----
  isWeak: oop
  	"Answer true if the argument has only weak fields that can hold oops. See comment in formatOf:"
+ 	^(self isNonIntegerObject: oop) and: [self isWeakNonImm: oop]!
- 	^(self isNonIntegerObject: oop) and:[self isWeakNonInt: oop]!

Item was added:
+ ----- Method: ObjectMemory>>isWeakNonImm: (in category 'header access') -----
+ isWeakNonImm: oop
+ 	"Answer if the argument has only weak fields that can hold oops. See comment in formatOf:"
+ 	^(self formatOf: oop) = self weakArrayFormat!

Item was removed:
- ----- Method: ObjectMemory>>isWeakNonInt: (in category 'header access') -----
- isWeakNonInt: oop
- 	"Answer if the argument has only weak fields that can hold oops. See comment in formatOf:"
- 	^(self formatOf: oop) = self lastPointerFormat!

Item was changed:
  ----- Method: ObjectMemory>>nonWeakFieldsOf: (in category 'object format') -----
  nonWeakFieldsOf: oop
  	"Return the number of non-weak fields in oop (i.e. the number of fixed fields).
  	Note: The following is copied from fixedFieldsOf:format:length: since we do know
  	the format of the oop (e.g. format = 4) and thus don't need the length."
  	| class classFormat |
  
+ 	self assert: (self isWeakNonImm: oop).
- 	self assert: (self isWeakNonInt: oop).
  
  	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
  	class := self fetchClassOfNonImm: oop.
  	classFormat := self formatOfClass: class.
  	^(classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1!

Item was changed:
  ----- Method: ObjectMemory>>sweepPhase (in category 'gc -- mark and sweep') -----
  sweepPhase
  	"Sweep memory from youngStart through the end of memory. Free all 
  	inaccessible objects and coalesce adjacent free chunks. Clear the mark 
  	bits of accessible objects. Compute the starting point for the first pass of 
  	incremental compaction (compStart). Return the number of surviving 
  	objects. "
  	"Details: Each time a non-free object is encountered, decrement the 
  	number of available forward table entries. If all entries are spoken for 
  	(i.e., entriesAvailable reaches zero), set compStart to the last free 
  	chunk before that object or, if there is no free chunk before the given 
  	object, the first free chunk after it. Thus, at the end of the sweep 
  	phase, compStart through compEnd spans the highest collection of 
  	non-free objects that can be accomodated by the forwarding table. This 
  	information is used by the first pass of incremental compaction to 
  	ensure that space is initially freed at the end of memory. Note that 
  	there should always be at least one free chunk--the one at the end of 
  	the heap."
  	| entriesAvailable survivors freeChunk firstFree oop oopHeader oopHeaderType hdrBytes oopSize freeChunkSize endOfMemoryLocal |
  	<inline: false>
  	<var: #oop type: 'usqInt'>
  	<var: #endOfMemoryLocal type: 'usqInt'>
  	entriesAvailable := self fwdTableInit: BytesPerWord*2.
  	survivors := 0.
  	freeChunk := nil.
  	firstFree := nil.
  	"will be updated later"
  	endOfMemoryLocal := endOfMemory.
  	oop := self oopFromChunk: youngStart.
  	[oop < endOfMemoryLocal]
  		whileTrue: ["get oop's header, header type, size, and header size"
  			statSweepCount := statSweepCount + 1.
  			oopHeader := self baseHeader: oop.
  			oopHeaderType := oopHeader bitAnd: TypeMask.
  			hdrBytes := headerTypeBytes at: oopHeaderType.
  			(oopHeaderType bitAnd: 1) = 1
  				ifTrue: [oopSize := oopHeader bitAnd: SizeMask]
  				ifFalse: [oopHeaderType = HeaderTypeSizeAndClass
  						ifTrue: [oopSize := (self sizeHeader: oop) bitAnd: LongSizeMask]
  						ifFalse: ["free chunk" oopSize := oopHeader bitAnd: LongSizeMask]].
  			(oopHeader bitAnd: MarkBit) = 0
  				ifTrue: ["object is not marked; free it"
  					"<-- Finalization support: We need to mark each oop chunk as free -->"
  					self longAt: oop - hdrBytes put: HeaderTypeFree.
  					freeChunk ~= nil
  						ifTrue: ["enlarge current free chunk to include this oop"
  							freeChunkSize := freeChunkSize + oopSize + hdrBytes]
  						ifFalse: ["start a new free chunk"
  							freeChunk := oop - hdrBytes.
  							"chunk may start 4 or 8 bytes before oop"
  							freeChunkSize := oopSize + (oop - freeChunk).
  							"adjust size for possible extra header bytes"
  							firstFree = nil ifTrue: [firstFree := freeChunk]]]
  				ifFalse: ["object is marked; clear its mark bit and possibly adjust 
  					the compaction start"
  					self longAt: oop put: (oopHeader bitAnd: AllButMarkBit).
  					"<-- Finalization support: Check if we're running about a weak class -->"
+ 					(self isWeakNonImm: oop) ifTrue: [self finalizeReference: oop].
- 					(self isWeakNonInt: oop) ifTrue: [self finalizeReference: oop].
  					entriesAvailable > 0
  						ifTrue: [entriesAvailable := entriesAvailable - 1]
  						ifFalse: ["start compaction at the last free chunk before this object"
  							firstFree := freeChunk].
  					freeChunk ~= nil
  						ifTrue: ["record the size of the last free chunk"
  							self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree).
  							freeChunk := nil].
  					survivors := survivors + 1].
  			oop := self oopFromChunk: oop + oopSize].
  	freeChunk ~= nil
  		ifTrue: ["record size of final free chunk"
  			self longAt: freeChunk put: ((freeChunkSize bitAnd: LongSizeMask) bitOr: HeaderTypeFree)].
  	oop = endOfMemory
  		ifFalse: [self error: 'sweep failed to find exact end of memory'].
  	firstFree = nil
  		ifTrue: [self error: 'expected to find at least one free object']
  		ifFalse: [compStart := firstFree].
  
  	^ survivors!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
  pathTo: goal using: stack followWeak: followWeak
  	"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
  	 If found, unmark, leaving path in stack, and answer 0.  Otherwise answer an error:
  		PrimErrBadArgument if stack is not an Array
  		PrimErrBadIndex if search overflows stack
  		PrimErrNotFound if goal cannot be found"
  	| current hdr index next stackSize stackp freeStartAtStart |
  	(objectMemory isArray: stack) ifFalse:
  		[^PrimErrBadArgument].
  	freeStartAtStart := objectMemory freeStart. "check no allocations during search"
  	objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
  	stackSize := objectMemory lengthOf: stack.
  	objectMemory mark: stack.
  	"no need. the current context is not reachable from the active process (suspendedContext is nil)"
  	"objectMemory mark: self activeProcess."
  	current := objectMemory specialObjectsOop.
  	objectMemory mark: current.
  	index := objectMemory lengthOf: current.
  	stackp := 0.
  	[[(index := index - 1) >= -1] whileTrue:
  		[next := (stackPages couldBeFramePointer: current)
  					ifTrue:
  						[index >= 0
  							ifTrue: [self field: index ofFrame: current]
  							ifFalse: [objectMemory nilObject]]
  					ifFalse:
  						[index >= 0
  							ifTrue:
  								[hdr := objectMemory baseHeader: current.
  								 (objectMemory isContextHeader: hdr)
  									ifTrue: [self fieldOrSenderFP: index ofContext: current]
  									ifFalse: [objectMemory fetchPointer: index ofObject: current]]
  							ifFalse:
  								[objectMemory fetchClassOfNonImm: current]].
  		 (stackPages couldBeFramePointer: next)
  			ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))]
  			ifFalse: [self assert: (self checkOkayOop: next)].
  		 next = goal ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory storePointer: stackp ofObject: stack withValue: current.
  			 self pruneStack: stack stackp: stackp.
  			 ^0].
  		 ((objectMemory isNonIntegerObject: next)
  		  and: [(stackPages couldBeFramePointer: next)
  				ifTrue: [(self frameIsMarked: next) not]
  				ifFalse:
  					[(objectMemory isMarked: next) not
  					  and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
+ 					  and: [followWeak or: [(objectMemory isWeakNonImm: next) not]]]]])
- 					  and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]])
  			ifTrue:
  				[stackp + 2 > stackSize ifTrue:
  					[self assert: freeStartAtStart = objectMemory freeStart.
  					 self unmarkAfterPathTo.
  					 objectMemory nilFieldsOf: stack.
  					 ^PrimErrBadIndex]. "PrimErrNoMemory ?"
  				 objectMemory
  					storePointerUnchecked: stackp ofObject: stack withValue: current;
  					storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
  				 stackp := stackp + 2.
  				 (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
  					ifTrue:
  						[self markFrame: next.
  						index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
  					ifFalse:
  						[hdr := objectMemory baseHeader: next.
  						 objectMemory baseHeader: next put: (hdr bitOr: MarkBit).
  						 (objectMemory isCompiledMethodHeader: hdr)
  							ifTrue: [index := (self literalCountOf: next) + LiteralStart]
  							ifFalse: [index := objectMemory lengthOf: next]].
  				 current := next]].
  		 current = objectMemory specialObjectsOop ifTrue:
  			[self assert: freeStartAtStart = objectMemory freeStart.
  			 self unmarkAfterPathTo.
  			 objectMemory nilFieldsOf: stack.
  			^PrimErrNotFound].
  		 index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
  		 current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
  		 stackp := stackp - 2] repeat!



More information about the Vm-dev mailing list