[Vm-dev] VM Maker: VMMaker-dtl.271.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 19 22:44:24 UTC 2012


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.271.mcz

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

Name: VMMaker-dtl.271
Author: dtl
Time: 19 May 2012, 6:43:01.788 pm
UUID: 570b9903-ef97-4a2a-9159-086175f5fbfb
Ancestors: VMMaker-dtl.270

VMMaker 4.9.1

Additional factoring to merge Interpreter/ObjectMemory with StackInterpreter/NewObjectMemory. No change to generated code for the interpreter VM.

Inlining note: Moved #postGCAction: from StackInterpreter to object memory because NewObjectMemory is the only sender, and the presence of both #postGCAction and #postGCAction: in the Intepreter would prevent inlining of #postGCAction when translating class Interpreter (relevant for the case of an Interpreter using a NewObjectMemory).

=============== Diff against VMMaker-dtl.270 ===============

Item was added:
+ ----- Method: Interpreter>>checkCodeIntegrity: (in category 'stack interpreter support') -----
+ checkCodeIntegrity: fullGCFlag
+ 	"This is a no-op in the Interpreter and the StackVM"
+ 	^true!

Item was added:
+ ----- Method: Interpreter>>checkInterpreterIntegrity (in category 'stack interpreter support') -----
+ checkInterpreterIntegrity
+ 	"Perform an integrity/leak check using the heapMap.  Assume
+ 	 clearLeakMapAndMapAccessibleObjects has set a bit at each
+ 	 object's header.  Check that all oops in the interpreter's state
+ 	 points to a header.  Answer if all checks pass."
+ 
+ 	^true!

Item was added:
+ ----- Method: Interpreter>>checkStackIntegrity (in category 'stack interpreter support') -----
+ checkStackIntegrity
+ 	"Perform an integrity/leak check using the heapMap.  Assume
+ 	 clearLeakMapAndMapAccessibleObjects has set a bit at each
+ 	 object's header.  Scan all objects accessible from the stack
+ 	 checking that every pointer points to a header.  Answer if no
+ 	 dangling pointers were detected."
+ 
+ 	^true!

Item was added:
+ ----- Method: Interpreter>>interpreterAllocationReserveBytes (in category 'stack interpreter support') -----
+ interpreterAllocationReserveBytes
+ 	"Extra allocation space in the object memory required by StackInterpreter"
+ 	^ 0
+ !

Item was added:
+ ----- Method: Interpreter>>isMarriedOrWidowedContext: (in category 'stack interpreter support') -----
+ isMarriedOrWidowedContext: aContext
+ 	^false!

Item was added:
+ ----- Method: Interpreter>>markAndTraceAndMaybeFreeStackPages: (in category 'stack interpreter support') -----
+ markAndTraceAndMaybeFreeStackPages: fullGCFlag
+ 	"This is a no-op in Interpreter"
+ !

Item was added:
+ ----- Method: Interpreter>>markAndTraceOrFreeMachineCode: (in category 'stack interpreter support') -----
+ markAndTraceOrFreeMachineCode: fullGCFlag
+ 	"This is a no-op in Interpreter"
+ !

Item was changed:
  ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
  
  	<inline: false>
  	fullGCLock > 0 ifTrue:
  		[self warning: 'aborting fullGC because fullGCLock > 0'.
  		 ^false].
  	self initializeFreeBlocksPreSweep.
  	self runLeakCheckerForFullGC: true.
+ 	interpreter preGCAction: true.
+ 	gcStartUsecs := self ioMicroSecondClock.
- 	self preGCAction: true.
- 	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase: true.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhaseForFullGC.
  	self runLeakCheckerForFullGC: true.
  	self fullCompaction.
  	statFullGCs := statFullGCs + 1.
+ 	statGCEndUsecs := self ioMicroSecondClock.
- 	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
  	self capturePendingFinalizationSignals.
  
  	youngStart := freeStart.  "reset the young object boundary"
  	self postGCAction: true.
  	self runLeakCheckerForFullGC: true!

Item was added:
+ ----- Method: NewObjectMemory>>heapMapAtWord: (in category 'debug printing') -----
+ heapMapAtWord: wordPointer
+ 	"Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
+ 	stubbed out here for use with trunk platform sources"
+ 
+ 	self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
+ 	^ 1
+ 
+ 	"
+ 	/*
+ 	 * Answer non-zero if the heapMap is set at wordPointer, 0 otherwise
+ 	 */
+ 	int heapMapAtWord(void *wordPointer)
+ 	{ . . . }
+ 	"!

Item was added:
+ ----- Method: NewObjectMemory>>heapMapAtWord:Put: (in category 'debug printing') -----
+ heapMapAtWord: wordPointer Put: bit
+ 	"Implemented in support code for Cog branch in Cross/vm/sqHeapMap.c and
+ 	stubbed out here for use with trunk platform sources"
+ 
+ 	self flag: #FIXME. "remove this method and add sqHeapMap.c to Cross when 64 bit address space can be supported"
+ 
+ 	"
+ 	/*
+ 	 * Set the value in the map at wordPointer to bit.
+ 	 */
+ 	void heapMapAtWordPut(void *wordPointer, int bit)
+ 	{ . . . }
+ 	"!

Item was changed:
  ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object
  	area of object memory (i.e., objects above youngStart), using
  	the root table to identify objects containing pointers to
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  
  	rootTableCount >= RootTableSize ifTrue:
  		["root table overflow; cannot do an incremental GC (this should be very rare)"
  		 statRootTableOverflows := statRootTableOverflows + 1.
  		 ^self fullGC].
  
  	self initializeFreeBlocksPreSweep.
  	self runLeakCheckerForFullGC: false.
  
+ 	interpreter preGCAction: false.
- 	self preGCAction: false.
  	"incremental GC and compaction"
  
+ 	gcStartUsecs := self ioMicroSecondClock.
- 	gcStartUsecs := self ioUTCMicrosecondsNow.
  	weakRootCount := 0.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self markPhase: false.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:
  		[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self runLeakCheckerForFullGC: false.
  	self incrementalCompaction.
  	statIncrGCs := statIncrGCs + 1.
+ 	statGCEndUsecs := self ioMicroSecondClock.
- 	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  	 or: [rootTableCount >= RootTableRedZone])
  	 or: [forceTenureFlag == true]) ifTrue:
  		["move up the young space boundary if
  		  * there are too many survivors:
  			this limits the number of objects that must be
  			processed on future incremental GC's
  		  * we're about to overflow the roots table:
  			this limits the number of full GCs that may be caused
  			by root table overflows in the near future"
  		forceTenureFlag := false.
  		statTenures := statTenures + 1.
  		self clearRootsTable.
  		((self freeSize < growHeadroom)
  		 and: [gcBiasToGrow > 0]) ifTrue:
  			[self biasToGrow.
  			 weDidGrow := true].
  		youngStart := freeStart].
  	self postGCAction: false.
  	
  	self runLeakCheckerForFullGC: false.
  	weDidGrow ifTrue:
  		[self biasToGrowCheckGCLimit]!

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 |
  	<inline: true>
  	header := self headerWhileForwardingOf: oop.
  	fmt := self formatOfHeader: header.
  	fmt <= 4 ifTrue:
  		[(fmt = 3
  		  and: [interpreter isContextHeader: header]) ifTrue:
  			["contexts end at the stack pointer"
+ 			 contextSize := self nacFetchStackPointerOf: oop.
- 			 contextSize := coInterpreter nacFetchStackPointerOf: oop.
  			 self assert: ReceiverIndex + contextSize < (self lengthOf: oop baseHeader: header format: fmt).
  			 ^CtxtTempFrameStart + contextSize * self bytesPerWord].
  		 "do sizeBitsOf: using the header we obtained"
  		 size := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  					ifTrue: [(self sizeHeader: oop) bitAnd: self allButTypeMask]
  					ifFalse: [header bitAnd: self sizeMask].
  		 ^size - self baseHeaderSize].
  	fmt < 12 ifTrue: [^0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes"
  	^(coInterpreter literalCountOf: oop) * self bytesPerWord + self baseHeaderSize!

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) ifFalse:
  			[self markAndTrace: oop]].
  	statMarkCountPriorToStackPageFreeing := statMarkCount.
  	"Only safe to free stack pages after all roots have been traced."
+ 	interpreter markAndTraceAndMaybeFreeStackPages: fullGCFlag.
- 	self markAndTraceAndMaybeFreeStackPages: fullGCFlag.
  	"Only safe to free any machine code methods after all
  	 stack pages have been traced."
+ 	coInterpreter markAndTraceOrFreeMachineCode: fullGCFlag.
- 	self markAndTraceOrFreeMachineCode: fullGCFlag.
  	statSpecialMarkCount := statSpecialMarkCount + (statMarkCount - statMarkCountPriorToStackPageFreeing)!

Item was added:
+ ----- Method: NewObjectMemory>>nacFetchStackPointerOf: (in category 'gc -- compaction') -----
+ nacFetchStackPointerOf: aContext
+ 	"A version of fetchStackPointerOf: for use when objects may be forwarded.
+ 	 Does not do an assert-check of the stack pointer being in bounds."
+ 	| sp |
+ 	sp := self fetchPointer: StackPointerIndex ofObject: aContext.
+ 	(self isIntegerObject: sp) ifFalse: [^0].
+ 	^self integerValueOf: sp!

Item was added:
+ ----- Method: NewObjectMemory>>postGCAction: (in category 'garbage collection') -----
+ postGCAction: fullGCFlag
+ 	"Shrink free memory and signal the gc semaphore."
+ 	| freeSizeNow |
+ 
+ 	freeSizeNow := self freeSize.
+ 	(freeSizeNow > self shrinkThreshold
+ 	 and: [freeSizeNow > self growHeadroom]) ifTrue:
+ 		["Attempt to shrink memory after successfully reclaiming lots of memory"
+ 		 self shrinkObjectMemory: freeSizeNow - self growHeadroom].
+ 
+ 	interpreter signalSemaphoreWithIndex: self gcSemaphoreIndex!

Item was changed:
  ----- Method: NewObjectMemory>>printMemField:name:size: (in category 'debug printing') -----
  printMemField: memField name: name size: length
  	<var: #memField type: #usqInt>
  	<var: #name type: #'char *'>
  	self print: name; tab; printHexPtr: (self cCoerce: memField to: 'char *');
  		printChar: $/;
+ 		printNum: memField - (self cCode: '(usqInt) sqMemoryBase');
- 		printNum: memField - (self cCoerce: self sqMemoryBaseAddress to: 'usqInt');
  		print: ' sz: '; printHex: length.
  	length ~= 0 ifTrue:
  		[self printChar: $/; printNum: length].
  	self cr!

Item was added:
+ ----- 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.
+ 				 (hdr bitAnd: self rootBit) ~= 0 ifTrue:
+ 					[numRootsInHeap := numRootsInHeap + 1].
+ 				 (self compactClassIndexOfHeader: hdr) = 0 ifTrue:
+ 					[fieldOop := (self classHeader: obj) bitAnd: self 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: self 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: self 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.
+ 						 (hdr bitAnd: self 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: self 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: self 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 added:
+ ----- Method: ObjectMemory>>containOnlyOops: (in category 'become') -----
+ containOnlyOops: array
+ 	"Return true if the array contains a small integer. You 
+ 	  can't become: SmallIntegers!!"
+ 	| fieldOffset |
+ 	fieldOffset := self lastPointerOf: array.
+ 	"same size as array2"
+ 	[fieldOffset >= self baseHeaderSize] whileTrue:
+ 		[(self isIntegerObject: (self longAt: array + fieldOffset)) ifTrue: [^ false].
+ 		 fieldOffset := fieldOffset - self bytesPerWord].
+ 	^true!

Item was changed:
  ----- Method: ObjectMemory>>containOnlyOops:and: (in category 'become') -----
  containOnlyOops: array1 and: array2 
  	"Return true if neither array contains a small integer. You 
  	can't become: integers!!"
  	| fieldOffset |
  	fieldOffset := self lastPointerOf: array1.
  	"same size as array2"
  	[fieldOffset >= self baseHeaderSize]
  		whileTrue: [(self isIntegerObject: (self longAt: array1 + fieldOffset)) ifTrue: [^ false].
  			(self isIntegerObject: (self longAt: array2 + fieldOffset)) ifTrue: [^ false].
  			fieldOffset := fieldOffset - self bytesPerWord].
  	^ true!

Item was added:
+ ----- Method: ObjectMemory>>forwardingPointerOf: (in category 'gc -- compaction') -----
+ forwardingPointerOf: forwardedObj
+ 	"Answer the pointer to the given forwardedOop's forwarding block."
+ 
+ 	^((self longAt: forwardedObj) bitAnd: self allButMarkBitAndTypeMask) << 1!

Item was added:
+ ----- Method: ObjectMemory>>fwdBlockValid: (in category 'gc -- compaction') -----
+ fwdBlockValid: addr 
+ 	"Answer if the given address is a valid forward table entry."
+ 	^(self oop: addr isGreaterThan: endOfMemory)
+ 	   and: [(self oop: addr isLessThanOrEqualTo: fwdTableNext)
+ 	   and: [(addr bitAnd: 3) = 0]]!

Item was added:
+ ----- Method: ObjectMemory>>headerWhileForwardingOf: (in category 'gc -- compaction') -----
+ headerWhileForwardingOf: oop
+ 	"Answer the header of the argument even though
+ 	 it may have its header word in a forwarding block."
+ 	| header fwdBlock |
+ 	<inline: true>
+ 	header := self longAt: oop.
+ 	(header bitAnd: self markBit) ~= 0 ifTrue:
+ 		["oop is forwarded; get its real header from its forwarding table entry"
+ 		 fwdBlock := (header bitAnd: self allButMarkBitAndTypeMask) << 1.
+ 		 self assert: (self fwdBlockValid: fwdBlock).
+ 		 header := self longAt: fwdBlock + self bytesPerWord].
+ 	^header!

Item was added:
+ ----- Method: ObjectMemory>>oop:isGreaterThan:andLessThan: (in category 'oop comparison') -----
+ oop: anOop isGreaterThan: baseOop andLessThan: limitOop
+ 	"Compare two oop values, treating them as object memory locations.
+ 	Use #cCoerce:to: to ensure comparison of unsigned magnitudes. This
+ 	method will be inlined during C translation."
+ 
+ 	^(self cCoerce: anOop to: #usqInt) > (self cCoerce: baseOop to: #usqInt)
+ 	  and: [(self cCoerce: anOop to: #usqInt) < (self cCoerce: limitOop to: #usqInt)]!

Item was added:
+ ----- Method: ObjectMemory>>setEndOfMemory: (in category 'initialization') -----
+ setEndOfMemory: newEndOfMemory
+ 	self assert: (newEndOfMemory bitAnd: self bytesPerWord - 1) = 0.
+ 	endOfMemory := newEndOfMemory!

Item was added:
+ ----- Method: ObjectMemory>>setMemoryLimit: (in category 'initialization') -----
+ setMemoryLimit: newMemoryLimit
+ 	self assert: (newMemoryLimit bitAnd: self bytesPerWord - 1) = 0.
+ 	memoryLimit := newMemoryLimit!

Item was changed:
  ----- Method: StackInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
  interpreterAllocationReserveBytes
  	"At a rough approximation we may need to allocate up to a couple
  	 of page's worth of contexts when switching stack pages, assigning
  	 to senders, etc.  But the snapshot primitive voids all stack pages.
  	 So a safe margin is the size of a large context times the maximum
  	 number of frames per page times the number of pages."
  	| availableBytesPerPage maxFramesPerPage |
  	availableBytesPerPage := self stackPageByteSize - self stackLimitOffset - self stackPageHeadroom.
  	maxFramesPerPage := availableBytesPerPage / self bytesPerWord // FrameSlots.
  	^2 raisedTo: (maxFramesPerPage * LargeContextSize * numStackPages) highBit!

Item was removed:
- ----- Method: StackInterpreter>>nacFetchStackPointerOf: (in category 'internal interpreter access') -----
- nacFetchStackPointerOf: aContext
- 	"A version of fetchStackPointerOf: for use when objects may be forwarded.
- 	 Does not do an assert-check of the stack pointer being in bounds."
- 	| sp |
- 	<inline: true>
- 	sp := objectMemory fetchPointer: StackPointerIndex ofObject: aContext.
- 	(objectMemory isIntegerObject: sp) ifFalse: [^0].
- 	^objectMemory integerValueOf: sp!

Item was removed:
- ----- Method: StackInterpreter>>postGCAction: (in category 'object memory support') -----
- postGCAction: fullGCFlag
- 	"Shrink free memory and signal the gc semaphore"
- 	| freeSizeNow |
- 
- 	freeSizeNow := objectMemory freeSize.
- 	(freeSizeNow > objectMemory shrinkThreshold
- 	 and: [freeSizeNow > objectMemory growHeadroom]) ifTrue:
- 		["Attempt to shrink memory after successfully reclaiming lots of memory"
- 		 objectMemory shrinkObjectMemory: freeSizeNow - objectMemory growHeadroom].
- 
- 	self signalSemaphoreWithIndex: objectMemory gcSemaphoreIndex!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.9.1'!
- 	^'4.9'!



More information about the Vm-dev mailing list