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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 1 18:56:26 UTC 2013


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

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

Name: VMMaker.oscog-eem.316
Author: eem
Time: 1 August 2013, 11:54:30.18 am
UUID: db273bad-0d96-4432-9470-f4c21d785531
Ancestors: VMMaker.oscog-eem.315

Correct several uses of literalCountOf:, using LiteralStart instead
of 1, and BytesPerOop instead of BytesPerWord.

Correct some uses of #== to #=.

Prune the isNode:substitutableFor:inMethod:in: search for calls at
asserts.

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

Item was changed:
  ----- Method: CoInterpreter>>checkOkayFields: (in category 'debug support') -----
  checkOkayFields: oop
  	"Check if the argument is an ok object.
  	 If this is a pointers object, check that its fields are all okay oops."
  
  	| hasYoung i fieldOop |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
  	(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
  	(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
  	(self checkOopHasOkayClass: oop) ifFalse: [ ^false ].
- 	hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonInt: oop).
  	((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
+ 	hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonInt: oop).
  	(objectMemory isCompiledMethod: oop)
  		ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1]
- 			[i := (self literalCountOf: oop) - 1]
  		ifFalse:
  			[(objectMemory isContext: oop)
  				ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
  				ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
  	[i >= 0] whileTrue:
  		[fieldOop := objectMemory fetchPointer: i ofObject: oop.
  		(objectMemory isNonIntegerObject: fieldOop) ifTrue:
  			[(i = 0 and: [objectMemory isCompiledMethod: oop])
  				ifTrue:
  					[(cogMethodZone methodFor: (self pointerForOop: fieldOop)) = 0 ifTrue:
  						[self print: 'method '; printHex: oop; print: ' has an invalid cog method reference'.
  						^false]]
  				ifFalse:
  					[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
  					(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
  					(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]].
  		i := i - 1].
  	hasYoung ifTrue:
  		[^objectMemory checkOkayYoungReferrer: oop].
  	^true!

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 fetchClassOfNonInt: 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 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]
- 							ifTrue: [index := self literalCountOf: next]
  							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: Interpreter>>okayFields: (in category 'debug support') -----
  okayFields: oop
  	"Check if the argument is an ok object.
  	 If this is a pointers object, check that its fields are all okay oops."
  
  	| i fieldOop |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
  	(self okayOop: oop) ifFalse: [ ^false ].
  	(self oopHasOkayClass: oop) ifFalse: [ ^false ].
  	((self isPointers: oop) or: [self isCompiledMethod: oop]) ifFalse: [ ^true ].
  	(self isCompiledMethod: oop)
  		ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1]
- 			[i := (self literalCountOf: oop) - 1]
  		ifFalse:
  			[(self isContext: oop)
  				ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
  				ifFalse: [i := (self lengthOf: oop) - 1]].
  	[i >= 0] whileTrue: [
  		fieldOop := self fetchPointer: i ofObject: oop.
  		(self isIntegerObject: fieldOop) ifFalse: [
  			(self okayOop: fieldOop) ifFalse: [ ^false ].
  			(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
  		].
  		i := i - 1.
  	].
  	^true!

Item was changed:
  ----- Method: NewObjectMemory>>allocateInterpreterChunk: (in category 'allocation') -----
  allocateInterpreterChunk: byteSize 
  	"Allocate a chunk of the given size. Sender must be sure that the requested size
  	 includes enough space for the header word(s).  This version is for interpreter
  	 allocations and will allocate beyond the interpreter's reserveStart.  If the allocation
  	 takes freeStart over the scavenge threshold schedule a garbage collection."
  	| newChunk newFreeStart |
  	<inline: true>
  	<asmLabel: false>
  	<var: #newChunk type: #usqInt>
  	<var: #newFreeStart type: #usqInt>
  
  	newChunk := freeStart.
  	newFreeStart := freeStart + byteSize.
  	newFreeStart < scavengeThreshold ifTrue:
  		[(AllocationCheckFiller ~= 0
+ 		  and: [(self longAt: newChunk) ~= (AllocationCheckFiller = 16rADD4E55
- 		  and: [(self longAt: newChunk) ~= (AllocationCheckFiller == 16rADD4E55
  												ifTrue: [newChunk]
  												ifFalse: [AllocationCheckFiller])]) ifTrue:
  			[self error: 'last object overwritten'].
  		freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	"Don't thrash doing collections when over the scavengeThreshold.
  	 Only schedule an incrementalGC if this allocation took us over the threshold."
  	freeStart < scavengeThreshold ifTrue:
  		[self scheduleIncrementalGC].
  
  	newFreeStart < reserveStart ifTrue:
  		[freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	"space is low.  A scavenge may reclaim sufficient space and this may be a
  	 false alarm.  We actually check for low space after the incremental collection.
  	 But we really do need to do a scavenge promptly, if only to check for low
  	 space.  We cannot do a garbage collect now without moving pointers under
  	 the VM's feet, which is too error-prone and inefficient to contemplate."
  
  	self scheduleIncrementalGC.
  
  	freeStart <= endOfMemory ifTrue:
  		[freeStart := newFreeStart.
  		 ^self oopForPointer: newChunk].
  
  	self error: 'out of memory'.
  	^nil!

Item was changed:
  ----- Method: NewObjectMemory>>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:
  					[numRootsInHeap := numRootsInHeap + 1].
  				 (self compactClassIndexOfHeader: hdr) = 0 ifTrue:
  					[fieldOop := (self classHeader: obj) bitAnd: AllButTypeMask.
  					 ((self isIntegerObject: fieldOop)
  					   or: [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0]) ifTrue:
  						[self print: 'object leak in '; printHex: obj; print: ' class = '; printHex: fieldOop; cr.
  						 self eek.
  						 ok := false]].
  				 fmt := self formatOfHeader: hdr.
  				 (fmt <= 4 "pointers" or: [fmt >= 12 "compiled method"]) ifTrue:
  					[fmt >= 12
+ 						ifTrue: [fi := (self literalCountOf: obj) + LiteralStart]
- 						ifTrue: [fi := (self literalCountOf: obj) + 1 "+ 1 = methodHeader slot"]
  						ifFalse: [(fmt = 3 and: [self isContextHeader: hdr])
  									ifTrue: [fi := CtxtTempFrameStart + (coInterpreter 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.
  									 self eek.
  									 ok := false]
  								ifFalse:
  									[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
  										[self print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
  										 self eek.
  										 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.
  		"But the system copes with overflow..."
  		ok := rootTableOverflowed and: [needGCFlag]].
  	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.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 self eek.
  						 ok := false]
  					ifFalse:
  						[hdr := self baseHeader: obj.
  						 (self isYoungRootHeader: hdr) ifFalse:
  							[self print: 'non-root in rootTable @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  							 self eek.
  							 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.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
  						 self eek.
  						 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.
  				 self eek.
  				 ok := false]
  			ifFalse:
  				[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
  					ifTrue:
  						[self print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
  						 self eek.
  						 ok := false]]].
  	^ok!

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateMethodContextByteSize: (in category 'interpreter access') -----
  eeInstantiateMethodContextByteSize: sizeInBytes 
  	"This version of instantiateClass assumes that the total object 
  	 size is under 256 bytes, the limit for objects with only one or 
  	 two header words. Note that the size is specified in bytes 
  	 and should include four bytes for the base header word.
  	 Will *not* cause a GC."
  	| hash header1 |
+ 	self assert: (sizeInBytes = SmallContextSize or: [sizeInBytes = LargeContextSize]).
- 	self assert: (sizeInBytes == SmallContextSize or: [sizeInBytes == LargeContextSize]).
  	self assert: sizeInBytes <= SizeMask.
  	hash := self newObjectHash.
  	header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize.
  	self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact"
  	self assert: (header1 bitAnd: SizeMask) = 0.
  	"OR size into header1.  Must not do this if size > SizeMask"
  	header1 := header1 + sizeInBytes.
  	^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil!

Item was changed:
  ----- Method: NewObjectMemory>>fixContextSizes (in category 'initialization') -----
  fixContextSizes
  	"Correct context sizes at start-up."
  	| numBadContexts obj oop map delta hdr len i methodContextProtoIndex methodContextProto |
  	<var: #map type: #'sqInt *'>
  	methodContextProto := self splObj: (methodContextProtoIndex := 35).
  	((self isContext: methodContextProto)
  	 and: [self badContextSize: methodContextProto]) ifTrue:
  		[self splObj: methodContextProtoIndex put: nilObj.
  		 "If it is unreferenced except here; nuke it, otherwise resize it"
  		 (self numReferencesTo: methodContextProto) = 0 ifTrue:
  			[self freeObject: methodContextProto]].
  	"Count the number of bad contexts"
  	numBadContexts := 0.
  	obj := self firstObject.
  	[obj < freeStart] whileTrue:
  		[((self isFreeObject: obj) not
  		   and: [(self isContextNonInt: obj)
  		   and: [self badContextSize: obj]]) ifTrue:
  			[numBadContexts := numBadContexts + 1].
  		 obj := self objectAfter: obj].
  	numBadContexts = 0 ifTrue:
  		[^self].
  	"Allocate a map of pairs of context obj and how much it has to move."
  	map := self cCode: [self malloc: numBadContexts + 1 * 2 * BytesPerOop]
  				inSmalltalk: [CArrayAccessor on: (Array new: numBadContexts + 1 * 2)].
  	"compute the map"
  	numBadContexts := 0.
  	delta := 0.
  	obj := self firstObject.
  	[obj < freeStart] whileTrue:
  		[((self isFreeObject: obj) not
  		   and: [(self isContextNonInt: obj)
  		   and: [self badContextSize: obj]]) ifTrue:
  			[delta := ((self byteLengthOf: obj) > SmallContextSize
  						ifTrue: [LargeContextSize]
  						ifFalse: [SmallContextSize]) - (self byteLengthOf: obj).
  			 map at: numBadContexts put: (self objectAfter: obj).
  			 numBadContexts = 0
  				ifTrue: [map at: numBadContexts + 1 put: delta]
  				ifFalse: [map at: numBadContexts + 1 put: delta + (map at: numBadContexts - 1)].
  			numBadContexts := numBadContexts + 2].
  		 obj := self objectAfter: obj].
  	"block-move the segments to make room for the resized contexts"
  	map at: numBadContexts put: freeStart.
  	self assert: freeStart = youngStart. "designed to be run at startup"
  	freeStart := freeStart + (map at: numBadContexts - 1).
  	youngStart := freeStart.
  	[(numBadContexts := numBadContexts - 2) >= 0] whileTrue:
  		[obj := map at: numBadContexts.
  		 oop := map at: numBadContexts + 2.
  		 self mem:	"dest" obj + (map at: numBadContexts + 1)
  			  mo: 	"src" obj
  			  ve:	"len" oop - obj].
  	"now fix-up objs, resizing wrongly-sized contexts along the way."
  	obj := self firstObject.
  	[obj < freeStart] whileTrue:
  		[(self isFreeObject: obj) not ifTrue:
  			[((self isContextNonInt: obj)
  			   and: [self badContextSize: obj]) ifTrue:
  				[hdr := self baseHeader: obj.
  				 len := (hdr bitAnd: SizeMask) > SmallContextSize ifTrue: [LargeContextSize] ifFalse: [SmallContextSize].
  				 self baseHeader: obj put: ((hdr bitClear: SizeMask) bitOr: len).
  				 "now check the enumeration"
  				 oop := self objectAfter: obj.
  				 self assert: oop <= freeStart.
  				 numBadContexts := 0.
  				 [oop > (map at: numBadContexts)] whileTrue:
  					[numBadContexts := numBadContexts + 2].
  				 self assert: oop = ((map at: numBadContexts) + (map at: numBadContexts + 1))].
  			(self headerType: obj) ~= HeaderTypeShort ifTrue: "see remapClassOf:"
  				[oop := (hdr := self longAt: obj - BytesPerWord) bitAnd: AllButTypeMask.
  				 oop >= (map at: 0) ifTrue:
  					[numBadContexts := 2.
  					 [oop >= (map at: numBadContexts)] whileTrue:
  						[numBadContexts := numBadContexts + 2].
  					 hdr := oop + (map at: numBadContexts - 1) + (hdr bitAnd: TypeMask).
  					 self longAt: obj - BytesPerWord put: hdr]].
  			((self isPointersNonInt: obj) or: [self isCompiledMethod: obj]) ifTrue:
  				[(self isCompiledMethod: obj)
  					ifTrue:
+ 						[i := (self literalCountOf: obj) + LiteralStart]
- 						[i := self literalCountOf: obj]
  					ifFalse:
  						[(self isContextNonInt: obj)
  							ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)]
  							ifFalse: [i := self lengthOf: obj]].
  				[(i := i - 1) >= 0] whileTrue:
  					[oop := self fetchPointer: i ofObject: obj.
  					 ((self isNonIntegerObject: oop)
  					  and: [oop >= (map at: 0)]) ifTrue:
  						[numBadContexts := 2.
  						 [oop >= (map at: numBadContexts)] whileTrue:
  							[numBadContexts := numBadContexts + 2].
  						 self storePointerUnchecked: i ofObject: obj withValue: oop + (map at: numBadContexts - 1)]]]].
  		 obj := self objectAfter: obj].
  	self clearLeakMapAndMapAccessibleObjects.
  	(self asserta: self checkHeapIntegrity) ifFalse:
  		[self error: 'failed to resize contexts correctly']!

Item was changed:
  ----- Method: NewObjectMemory>>isContextHeader: (in category 'internal interpreter access') -----
  isContextHeader: aHeader
  	<inline: true>
  	"c.f. {BlockContext. MethodContext. PseudoContext} collect: [:class| class -> class indexIfCompact]"
+ 	^(self compactClassIndexOfHeader: aHeader) = ClassMethodContextCompactIndex!
- 	^(self compactClassIndexOfHeader: aHeader) == ClassMethodContextCompactIndex!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: oop 
  	"Return the byte offset of the last pointer field of the given object.  
  	 Can be used even when the type bits are not correct.
  	 Works with CompiledMethods, as well as ordinary objects."
  	| fmt header contextSize numLiterals |
  	<inline: true>
  	<asmLabel: false>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[(fmt = 3
  		  and: [self isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
  			contextSize := coInterpreter fetchStackPointerOf: oop.
+ 			^CtxtTempFrameStart + contextSize * BytesPerOop].
- 			^CtxtTempFrameStart + contextSize * BytesPerWord].
  		^(self sizeBitsOfSafe: oop) - BaseHeaderSize  "all pointers"].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	numLiterals := coInterpreter literalCountOf: oop.
+ 	^numLiterals + LiteralStart * BytesPerOop!
- 	^numLiterals * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerOf:recordWeakRoot: (in category 'object enumeration') -----
  lastPointerOf: oop recordWeakRoot: recordWeakRoot "<Boolean>"
  	"Return the byte offset of the last pointer field of the given object.  
  	 Works with CompiledMethods, as well as ordinary objects. 
  	 Can be used even when the type bits are not correct.
  	 This is a version of lastPointerOf: for markAndTrace:.
  	 Already overridden to trace stack pages for the StackInterpreter.
  	 Override to ask coInterpreter to determine literalCount of methods."
+ 	| fmt sz header contextSize numFields |
- 	| fmt sz header contextSize numLiterals |
  	<inline: true>
  	<asmLabel: false>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[fmt >= 3 ifTrue:
  			[fmt = 4 ifTrue:
  				[(recordWeakRoot and: [weakRootCount >= 0]) ifTrue:
  					["And remember as weak root"
  					 (weakRootCount := weakRootCount + 1) <= WeakRootTableSize ifFalse:
  						[self error: 'weakRoots table overflow'].
  					 weakRoots at: weakRootCount put: oop].
  				"Do not trace the object's indexed fields if it's a weak class"
+ 				numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
+ 				^numFields * BytesPerWord].
- 				^(self nonWeakFieldsOf: oop) << ShiftForWord].
  			"So fmt is 3"
  			(self isContextHeader: header) ifTrue:
  				[coInterpreter setTraceFlagOnContextsFramesPageIfNeeded: oop.
  				 "contexts end at the stack pointer avoiding having to init fields beyond it"
  				 contextSize := coInterpreter fetchStackPointerOf: oop.
  				 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
+ 				 ^CtxtTempFrameStart + contextSize * BytesPerOop]].
- 				 ^CtxtTempFrameStart + contextSize * BytesPerWord]].
  		 sz := self sizeBitsOfSafe: oop.
  		 ^sz - BaseHeaderSize  "all pointers" ].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
+ 	numFields := coInterpreter literalCountOf: oop. "so literalCountOf: may be inlined"
+ 	^numFields + LiteralStart * BytesPerOop!
- 	numLiterals := coInterpreter literalCountOf: oop.
- 	^numLiterals * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: NewObjectMemory>>lastPointerWhileForwarding: (in category 'gc -- compaction') -----
  lastPointerWhileForwarding: oop 
  	"The given object may have its header word in a forwarding block. Find  
  	 the offset of the last pointer in the object in spite of this obstacle."
  	| header fmt size contextSize numLiterals |
  	<inline: true>
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[(fmt = 3
  		  and: [self isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
  			 contextSize := coInterpreter nacFetchStackPointerOf: oop.
  			 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
+ 			 ^CtxtTempFrameStart + contextSize * BytesPerOop].
- 			 ^CtxtTempFrameStart + contextSize * BytesPerWord].
  		 "do sizeBitsOf: using the header we obtained"
  		 size := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  					ifTrue: [(self sizeHeader: oop) bitAnd: AllButTypeMask]
  					ifFalse: [header bitAnd: SizeMask].
  		 ^size - BaseHeaderSize].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  	"CompiledMethod: contains both pointers and bytes"
  	self assert: (header bitAnd: MarkBit) = 0.
  	numLiterals := coInterpreter literalCountOf: oop.
+ 	^numLiterals + LiteralStart * BytesPerOop!
- 	^numLiterals * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: NewObjectMemory>>longPrintReferencesTo: (in category 'debug printing') -----
  longPrintReferencesTo: anOop
  	"Scan the heap long printing the oops of any and all objects that refer to anOop"
  	| oop i prntObj |
  	<api>
  	prntObj := false.
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
+ 					[i := (self literalCountOf: oop) + LiteralStart]
- 					[i := self literalCountOf: oop]
  				ifFalse:
  					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self printHex: oop; print: ' @ '; printNum: i; cr.
  					 prntObj := true.
  					 i := 0]].
  			prntObj ifTrue:
  				[prntObj := false.
  				 coInterpreter longPrintOop: oop]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>numReferencesTo: (in category 'debug printing') -----
  numReferencesTo: anOop
  	"Answer the number of objects that refer to anOop, other than anOop."
  	| oop i n |
  	oop := self firstAccessibleObject.
  	n := 0.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
+ 					[i := (self literalCountOf: oop) + LiteralStart]
- 					[i := self literalCountOf: oop]
  				ifFalse:
  					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[anOop ~= oop ifTrue:
  						[n := n + 1].
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop].
  	^n!

Item was changed:
  ----- Method: NewObjectMemory>>printReferencesTo: (in category 'debug printing') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
+ 					[i := (self literalCountOf: oop) + LiteralStart]
- 					[i := self literalCountOf: oop]
  				ifFalse:
  					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: NewspeakInterpreter>>okayFields: (in category 'debug support') -----
  okayFields: oop
+ 	"Check if the argument is an ok object.
+ 	 If this is a pointers object, check that its fields are all okay oops."
- 	"If this is a pointers object, check that its fields are all okay oops."
  
+ 	| i fieldOop |
- 	| i fieldOop c |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(self okayOop: oop) ifFalse: [ ^false ].
+ 	(self oopHasOkayClass: oop) ifFalse: [ ^false ].
+ 	((self isPointers: oop) or: [self isCompiledMethod: oop]) ifFalse: [ ^true ].
+ 	(self isCompiledMethod: oop)
+ 		ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1]
+ 		ifFalse:
+ 			[(self isContext: oop)
+ 				ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
+ 				ifFalse: [i := (self lengthOf: oop) - 1]].
- 	self okayOop: oop.
- 	self oopHasOkayClass: oop.
- 	(self isPointers: oop) ifFalse: [ ^true ].
- 	c := self fetchClassOf: oop.
- 	(c = (self splObj: ClassMethodContext)
- 		or: [c = (self splObj: ClassBlockContext)])
- 		ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
- 		ifFalse: [i := (self lengthOf: oop) - 1].
  	[i >= 0] whileTrue: [
  		fieldOop := self fetchPointer: i ofObject: oop.
  		(self isIntegerObject: fieldOop) ifFalse: [
+ 			(self okayOop: fieldOop) ifFalse: [ ^false ].
+ 			(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
- 			self okayOop: fieldOop.
- 			self oopHasOkayClass: fieldOop.
  		].
  		i := i - 1.
+ 	].
+ 	^true!
- 	].!

Item was changed:
  ----- Method: ObjectMemory>>byteSwapByteObjectsFrom:to:flipFloatsIf: (in category 'image segment in/out') -----
  byteSwapByteObjectsFrom: startOop to: stopAddr flipFloatsIf: flipFloatWords
  	"Byte-swap the words of all bytes objects in a range of the 
  	image, including Strings, ByteArrays, and CompiledMethods. 
  	This returns these objects to their original byte ordering 
  	after blindly byte-swapping the entire image. For compiled 
  	methods, byte-swap only their bytecodes part.  For Floats
  	swap their most and least significant words if required."
  	| oop fmt temp wordAddr |
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(self isFreeObject: oop) ifFalse:
  			[fmt := self formatOf: oop.
  			fmt >= 8 ifTrue:
  				["oop contains bytes; unswap"
  				wordAddr := oop + BaseHeaderSize.
  				fmt >= 12 ifTrue: "compiled method; start after methodHeader and literals"
+ 					[wordAddr := wordAddr + ((self literalCountOf: oop) + LiteralStart * BytesPerOop)].
- 					[wordAddr := wordAddr + BytesPerWord + ((self literalCountOf: oop) * BytesPerWord)].
  				self reverseBytesFrom: wordAddr to: oop + (self sizeBitsOf: oop)].
  			fmt = 6  ifTrue: "Bitmap, Float etc"
  				[(self compactClassIndexOf: oop) = ClassFloatCompactIndex
  					ifTrue:
  						[flipFloatWords ifTrue:
  							[temp := self longAt: oop + BaseHeaderSize.
  							 self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4).
  							 self longAt: oop + BaseHeaderSize + 4 put: temp]]
  					ifFalse:
  						[BytesPerWord = 8 ifTrue:
  							["Object contains 32-bit half-words packed into 64-bit machine words."
  							wordAddr := oop + BaseHeaderSize.
  							self reverseWordsFrom: wordAddr to: oop + (self sizeBitsOf: oop)]]]].
  			oop := self objectAfter: oop]!

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:
  					[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) + LiteralStart]
- 						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.
  		"But the system copes with overflow..."
  		ok := rootTableOverflowed and: [allocationCount > allocationsBetweenGCs]].
  	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:
  							[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>>finalizeReference: (in category 'finalization') -----
  finalizeReference: oop 
+ 	"During sweep phase we have encountered a weak reference. Check if its object
+ 	 has gone away (or is about to) and if so, signal a semaphore.  Do *not* inline
+ 	 this in sweepPhase - it is quite an unlikely case to run into a weak reference"
+ 	| weakOop oopGone chunk numFields firstField lastField |
- 	"During sweep phase we have encountered a weak reference. 
- 	Check if  its object has gone away (or is about to) and if so, signal a 
- 	semaphore. "
- 	"Do *not* inline this in sweepPhase - it is quite an unlikely 
- 	case to run into a weak reference"
- 	| weakOop oopGone chunk firstField lastField |
  	<inline: false>
+ 	<var: #oop type: #usqInt>
+ 	<var: #weakOop type: #usqInt>
+ 	numFields := self nonWeakFieldsOf: oop. "so nonWeakFieldsOf: may be inlined"
+ 	firstField := BaseHeaderSize + (numFields << ShiftForWord).
- 	<var: #oop type: 'usqInt'>
- 	<var: #weakOop type: 'usqInt'>
- 	firstField := BaseHeaderSize + ((self nonWeakFieldsOf: oop) << ShiftForWord).
  	lastField := self lastPointerOf: oop.
+ 	firstField to: lastField by: BytesPerWord do:
+ 		[:i|
+ 		weakOop := self longAt: oop + i.
+ 		"ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
+ 		objects in non-GCable region. This could lead to a forward reference in
+ 		old space with the oop pointed to not being marked and thus treated as free."
+ 		(weakOop = nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]]) ifFalse:
+ 			["Check if the object is being collected. 
+ 			If the weak reference points  
+ 			* backward: check if the weakOops chunk is free
+ 			* forward: check if the weakOoop has been marked by GC"
+ 			weakOop < oop
+ 				ifTrue: [chunk := self chunkFromOop: weakOop.
+ 						oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
+ 				ifFalse: [oopGone := (self isMarked: weakOop) not].
+ 			oopGone ifTrue: "Store nil in the pointer and signal the  interpreter"
+ 				[self longAt: oop + i put: nilObj.
+ 				self signalFinalization: oop]]]!
- 	firstField to: lastField by: BytesPerWord do: [:i | 
- 			weakOop := self longAt: oop + i.
- 			"ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
- 			objects in non-GCable region. This could lead to a forward reference in
- 			old space with the oop pointed to not being marked and thus treated as free."
- 			(weakOop == nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]])
- 
- 				ifFalse: ["Check if the object is being collected. 
- 					If the weak reference points  
- 					* backward: check if the weakOops chunk is free
- 					* forward: check if the weakOoop has been marked by GC"
- 					weakOop < oop
- 						ifTrue: [chunk := self chunkFromOop: weakOop.
- 							oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
- 						ifFalse: [oopGone := (self isMarked: weakOop) not].
- 					oopGone ifTrue: ["Store nil in the pointer and signal the  interpreter"
- 							self longAt: oop + i put: nilObj.
- 							self signalFinalization: oop]]]!

Item was changed:
  ----- Method: ObjectMemory>>isMethodContextHeader: (in category 'contexts') -----
  isMethodContextHeader: aHeader
  	<inline: true>
  	"c.f. {BlockContext. MethodContext. PseudoContext} collect: [:class| class -> class indexIfCompact]"
+ 	^(self compactClassIndexOfHeader: aHeader) = ClassMethodContextCompactIndex!
- 	^(self compactClassIndexOfHeader: aHeader) == ClassMethodContextCompactIndex!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: oop 
  	"Return the byte offset of the last pointer field of the given object.  
  	Works with CompiledMethods, as well as ordinary objects. 
  	Can be used even when the type bits are not correct."
  	| fmt sz methodHeader header contextSize |
  	<inline: true>
  	<asmLabel: false>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue: [(fmt = 3 and: [self isContextHeader: header])
  					ifTrue: ["contexts end at the stack pointer"
  						contextSize := self fetchStackPointerOf: oop.
  						^ CtxtTempFrameStart + contextSize * BytesPerWord].
  				sz := self sizeBitsOfSafe: oop.
  				^ sz - BaseHeaderSize  "all pointers"].
  	fmt < 12 ifTrue: [^ 0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes:"
  	methodHeader := self longAt: oop + BaseHeaderSize.
+ 	^ (methodHeader >> 10 bitAnd: 255) + LiteralStart * BytesPerWord!
- 	^ (methodHeader >> 10 bitAnd: 255) * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerOf:recordWeakRoot: (in category 'gc -- mark and sweep') -----
  lastPointerOf: oop recordWeakRoot: recordWeakRoot "<Boolean>"
  	"Return the byte offset of the last pointer field of the given object.  
  	 Works with CompiledMethods, as well as ordinary objects. 
  	 Can be used even when the type bits are not correct.
  	 This is a version of lastPointerOf: for markAndTrace:."
  	| fmt sz header contextSize |
  	<inline: true>
  	header := self baseHeader: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[fmt >= 3 ifTrue:
  			[fmt = 4 ifTrue:
  				[(recordWeakRoot and: [weakRootCount >= 0]) ifTrue:
  					["And remember as weak root"
  					 (weakRootCount := weakRootCount + 1) <= WeakRootTableSize ifFalse:
  						[self error: 'weakRoots table overflow'].
  					 weakRoots at: weakRootCount put: oop].
  				"Do not trace the object's indexed fields if it's a weak class"
+ 				^(self nonWeakFieldsOf: oop) * BytesPerOop].
- 				^(self nonWeakFieldsOf: oop) << ShiftForWord].
  			"So fmt is 3"
  			(self isContextHeader: header) ifTrue:
  				["contexts end at the stack pointer avoiding having to init fields beyond it"
  				 contextSize := self fetchStackPointerOf: oop.
+ 				 ^CtxtTempFrameStart + contextSize * BytesPerOop]].
- 				 ^CtxtTempFrameStart + contextSize * BytesPerWord]].
  		 sz := self sizeBitsOfSafe: oop.
  		 ^sz - BaseHeaderSize  "all pointers" ].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes:"
+ 	^(self literalCountOf: oop) + LiteralStart * BytesPerOop!
- 	^(self literalCountOf: oop) * BytesPerWord + BaseHeaderSize!

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 |
- 	<inline: false> "No need to inline - we won't call this often"
  
  	self assert: (self isWeakNonInt: oop).
  
  	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
  	class := self fetchClassOfNonInt: oop.
  	classFormat := self formatOfClass: class.
  	^(classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1!

Item was changed:
  ----- Method: ObjectMemory>>printMethodReferencesTo: (in category 'debug printing') -----
  printMethodReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[(self isCompiledMethod: oop) ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1.
- 			[i := (self literalCountOf: oop) - 1.
  			 [i >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self printHex: oop; print: ' @ '; printNum: i; cr.
  					 i := 0].
  				 i := i - 1]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: ObjectMemory>>printReferencesTo: (in category 'debug printing') -----
  printReferencesTo: anOop
  	"Scan the heap printing the oops of any and all objects that refer to anOop"
  	| oop i |
  	<api>
  	oop := self firstAccessibleObject.
  	[oop = nil] whileFalse:
  		[((self isPointersNonInt: oop) or: [self isCompiledMethod: oop]) ifTrue:
  			[(self isCompiledMethod: oop)
  				ifTrue:
+ 					[i := (self literalCountOf: oop) + LiteralStart]
- 					[i := self literalCountOf: oop]
  				ifFalse:
  					[(self isContextNonInt: oop)
  						ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop)]
  						ifFalse: [i := self lengthOf: oop]].
  			[(i := i - 1) >= 0] whileTrue:
  				[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
  					[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
  					 i := 0]]].
  		 oop := self accessibleObjectAfter: oop]!

Item was changed:
  ----- Method: ObjectMemory>>weakFinalizerCheck: (in category 'finalization') -----
  weakFinalizerCheck: oop
  	"Our oop has at least 2 non-weak fixed slots (this is assured before entering this method, in
  	#finalizeReference:.
  	We are assuming that if its first non-weak field is an instance of ClassWeakFinalizationList class,
  	then we should add this oop to that list, by storing it to list's first field and
  	also, updating the oop's 2nd fixed slot to point to the value which we overridden:
  	
  	list := oop instVarAt: 1.
  	list class == WeakFinalizationList ifTrue: [
  		first := list instVarAt: 1.
  		oop instVarAt: 2 put: first.
  		list instVarAt: 1 put: oop ]	"
  	<inline: true>
  	<asmLabel: false> "prevent label duplication"
  	| listOop listItemOop |
  
- 	
  	listOop := self fetchPointer: 0 ofObject: oop.
+ 	(self fetchClassOf: listOop) = (self splObj: ClassWeakFinalizer) ifTrue:
+ 		[listItemOop := self fetchPointer: 0 ofObject: listOop.
+ 		 self storePointer: 1 ofObject: oop withValue: listItemOop. 
+ 		 self storePointer: 0 ofObject: listOop withValue: oop]
- 	(self fetchClassOf: listOop) == (self splObj: ClassWeakFinalizer) ifTrue: [
- 		listItemOop := self fetchPointer: 0 ofObject: listOop.
- 		self storePointer: 1 ofObject: oop withValue: listItemOop. 
- 		self storePointer: 0 ofObject: listOop withValue: oop.
- 	].
  !

Item was changed:
  ----- Method: StackInterpreter>>checkOkayFields: (in category 'debug support') -----
  checkOkayFields: oop
  	"Check if the argument is an ok object.
  	 If this is a pointers object, check that its fields are all okay oops."
  
  	| hasYoung i fieldOop |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
  	(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
  	(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
  	(self checkOopHasOkayClass: oop) ifFalse: [ ^false ].
+ 	((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
  	hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonInt: oop).
+ 	(objectMemory isCompiledMethod: oop)
+ 		ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1]
+ 		ifFalse:
+ 			[(objectMemory isContext: oop)
+ 				ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
+ 				ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
+ 	[i >= 0] whileTrue:
+ 		[fieldOop := objectMemory fetchPointer: i ofObject: oop.
+ 		(objectMemory isIntegerObject: fieldOop) ifFalse:
+ 			[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
+ 			(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
+ 			(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]].
+ 		i := i - 1].
- 	((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifTrue:
- 		[(objectMemory isCompiledMethod: oop)
- 			ifTrue:
- 				[i := (self literalCountOf: oop) - 1]
- 			ifFalse:
- 				[(objectMemory isContext: oop)
- 					ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
- 					ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
- 		[i >= 0] whileTrue:
- 			[fieldOop := objectMemory fetchPointer: i ofObject: oop.
- 			(objectMemory isIntegerObject: fieldOop) ifFalse:
- 				[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
- 				(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
- 				(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]].
- 			i := i - 1]].
  	hasYoung ifTrue:
  		[^objectMemory checkOkayYoungReferrer: oop].
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>firstByteIndexOfMethod: (in category 'compiled methods') -----
  firstByteIndexOfMethod: methodObj
  	"Answer the one-relative index of the first bytecode in methodObj.
  	 Used for safer bounds-checking on methods."
+ 	^(self literalCountOf: methodObj) + LiteralStart * BytesPerOop + 1!
- 	^(self literalCountOf: methodObj) + LiteralStart * BytesPerWord + 1!

Item was changed:
  ----- Method: StackInterpreter>>okayFields: (in category 'debug support') -----
  okayFields: oop
  	"Check if the argument is an ok object.
  	 If this is a pointers object, check that its fields are all okay oops."
  
  	| i fieldOop |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
  	(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
  	(objectMemory okayOop: oop) ifFalse: [ ^false ].
  	(self oopHasOkayClass: oop) ifFalse: [ ^false ].
  	((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
  	(objectMemory isCompiledMethod: oop)
  		ifTrue:
+ 			[i := (self literalCountOf: oop) + LiteralStart - 1]
- 			[i := (self literalCountOf: oop) - 1]
  		ifFalse:
  			[(objectMemory isContext: oop)
  				ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
  				ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
  	[i >= 0] whileTrue: [
  		fieldOop := objectMemory fetchPointer: i ofObject: oop.
  		(objectMemory isIntegerObject: fieldOop) ifFalse: [
  			(objectMemory okayOop: fieldOop) ifFalse: [ ^false ].
  			(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
  		].
  		i := i - 1.
  	].
  	^true!

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 fetchClassOfNonInt: 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 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]
- 							ifTrue: [index := self literalCountOf: next]
  							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: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
  isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
  	"Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument."
  
  	| var madeNonTrivialCall |
  	aNode isConstant ifTrue: [^true].
  
  	aNode isVariable ifTrue:
  		[var := aNode name.
  		((locals includes: var) or: [args includes: var]) ifTrue: [^true].
  		(#(self true false nil) includes: var) ifTrue: [^true].
  		"We can substitute any variable provided it is only read in the method being inlined,
  		 and if it is not read after any non-trivial call (which may update the variable)."
  		madeNonTrivialCall := false.
  		(targetMeth isComplete
+ 		 and: [targetMeth parseTree
+ 				noneSatisfy:
+ 					[:node|
+ 					 (node isSend
+ 					  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
+ 						[var = 'child' ifTrue:
+ 							[Transcript cr; nextPutAll: node selector; flush].
+ 						madeNonTrivialCall := true].
+ 					 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
+ 					 or: [node isAssignment
+ 						  and: [node variable name = argName]]]
+ 				unless:
+ 					[:node|
+ 					node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue:
- 		 and: [targetMeth parseTree noneSatisfy:
- 				[:node|
- 				 (node isSend
- 				  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
- 					[madeNonTrivialCall := true].
- 				 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
- 				 or: [node isAssignment
- 					  and: [node variable name = argName]]]]) ifTrue:
  			[^true].
  		(targetMeth maySubstituteGlobal: var in: aCodeGen) ifTrue: [^true]].
  
  	"For now allow literal blocks to be substituted.  They better be accessed only
  	 with value[:value:*] messages though!!"
  	aNode isStmtList ifTrue: [^true].
  
  	"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
  	aNode nodesDo: [ :node |
  		node isSend ifTrue: [
  			node isBuiltinOperator ifFalse: [^false].
  		].
  		node isVariable ifTrue: [
  			var := node name.
  			((locals includes: var) or:
  			 [(args includes: var) or:
  			 [(#(self true false nil) includes: var) or:
  			 [targetMeth maySubstituteGlobal: var in: aCodeGen]]]) ifFalse: [^false].
  		].
  		(node isConstant or: [node isVariable or: [node isSend]]) ifFalse: [^false].
  	].
  
  	^ true!

Item was added:
+ ----- Method: TParseNode>>anySatisfy:unless: (in category 'enumerating') -----
+ anySatisfy: aBlock unless: cautionaryBlock
+ 	self
+ 		nodesDo: [:n| (aBlock value: n) ifTrue: [^true]]
+ 		unless: cautionaryBlock.
+ 	^false!

Item was changed:
  ----- Method: TParseNode>>nodesDo:unless: (in category 'enumerating') -----
  nodesDo: aBlock unless: cautionaryBlock
+ 	"Evaluate aBlock for all nodes in  the tree except those for which cautionaryBlock
+ 	 answers true or are children of those for which cautionaryBlock answers true."
+ 	(cautionaryBlock value: self) ifFalse:
+ 		[aBlock value: self]!
- 
- 	(cautionaryBlock value: self) ifTrue: [^self].
- 	aBlock value: self!

Item was added:
+ ----- Method: TParseNode>>noneSatisfy:unless: (in category 'enumerating') -----
+ noneSatisfy: aBlock unless: cautionaryBlock
+ 	self
+ 		nodesDo: [:n| (aBlock value: n) ifTrue: [^false]]
+ 		unless: cautionaryBlock.
+ 	^true!



More information about the Vm-dev mailing list