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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 16 21:09:24 UTC 2013


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

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

Name: VMMaker.oscog-eem.462
Author: eem
Time: 16 October 2013, 2:05:55.934 pm
UUID: 0a25a2ac-0a88-48d3-9300-17cd4c915f57
Ancestors: VMMaker.oscog-eem.461

Implement heap growth by allocated segment in Spur:
Add SpurSegmentManager>>addSegmentOfSize:,
	SpurMemoryManager>>growOldSpaceByAtLeast:,
	sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:
&	InterpreterPrimitives>>primitiveGrowMemoryByAtLeast.

Initialize growHeadroom & shrinkThreshold in SpurMemMgr.

Fix slips in collapseSegmentsPostSwizzle.

Simplify scavengeReferentsOf:; the halt couldn't happen.

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

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveGrowMemoryByAtLeast (in category 'memory space primitives') -----
+ primitiveGrowMemoryByAtLeast
+ 	<option: #SpurObjectMemory>
+ 	| ammount |
+ 	ammount := self stackTop.
+ 	(objectMemory isIntegerObject: ammount) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	self halt.
+ 	(objectMemory growOldSpaceByAtLeast: (objectMemory integerValueOf: ammount))
+ 		ifNil: [self primitiveFailFor: PrimErrNoMemory]
+ 		ifNotNil: [:segSize| self pop: 1 thenPushInteger: segSize]!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
+ growOldSpaceByAtLeast: minAmmount
+ 	"Attempt to grow memory by at least minAmmount.
+ 	 Answer the size of the new segment, or nil if the attempt failed.
+ 	 Override to remove execute permission from the new segment."
+ 	| ammount |
+ 	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	statGrowMemory := statGrowMemory + 1.
+ 	ammount := minAmmount max: growHeadroom.
+ 	^(segmentManager addSegmentOfSize: ammount) ifNotNil:
+ 		[:segInfo|
+ 		 freeOldSpaceStart :=
+ 		 endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize.
+ 		 coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segStart + segInfo segSize.
+ 		 segInfo segSize]!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	| sel |
  	sel := thisContext sender method selector.
  	(#(	DoIt
  		DoItIn:
  		on:do: "from the debugger"
  		makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		objCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		bytecodePrimAtPut
  		commonAt:
  		commonAtPut:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
  		primitiveContextAtPut
  		subscript:with:storing:format:
  		printContext:
  		compare31or32Bits:equal:
  		signed64BitValueOf:
  		primDigitMultiply:negative:
  		digitLength:
  		isNegativeIntegerValueOf:
  		magnitude64BitValueOf:
  		primitiveMakePoint
  		primitiveAsCharacter
  		primitiveInputSemaphore
  		baseFrameReturn
  		primitiveExternalCall
  		primDigitCompare:
  		isLiveContext:
  		numPointerSlotsOf:
  		fileValueOf:
  		loadBitBltDestForm
  		fetchIntOrFloat:ofObject:ifNil:
  		fetchIntOrFloat:ofObject:
  		loadBitBltSourceForm
  		loadPoint:from:
  		primDigitAdd:
  		primDigitSubtract:
  		positive64BitValueOf:
  		digitBitLogic:with:opIndex:
  		signed32BitValueOf:
  		isNormalized:
  		primDigitDiv:negative:
  		bytesOrInt:growTo:
  		primitiveNewMethod
  		isCogMethodReference:
  		functionForPrimitiveExternalCall:
  		genSpecialSelectorArithmetic
  		genSpecialSelectorComparison
  		ensureContextHasBytecodePC:
  		instVar:ofContext:
  		ceBaseFrameReturn:
  		inlineCacheTagForInstance:
  		primitiveObjectAtPut
  		commonVariable:at:put:cacheIndex:
  		primDigitBitShiftMagnitude:
+ 		externalInstVar:ofContext:
+ 		primitiveGrowMemoryByAtLeast) includes: sel) ifFalse:
- 		externalInstVar:ofContext:) includes: sel) ifFalse:
  		[self halt].
  	^super isIntegerObject: oop!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>numClassTablePages (in category 'spur bootstrap') -----
+ numClassTablePages
+ 	^numClassTablePages!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') -----
  scavengeReferentsOf: referrer
  	"scavengeReferentsOf: referrer inspects all the pointers in referrer.  If
  	 any are new objects, it has them moved to FutureSurvivorSpace, and
  	 answers truth. If there are no new referents, it answers falsity. To handle
  	 weak arrays, if the referrer is weak only scavenge strong slots and answer
  	 true so that it won't be removed from the remembered set until later."
  	| foundNewReferent |
  	"forwarding objects should be followed by callers,
  	 unless the forwarder is a root in the remembered table."
  	self assert: ((manager isForwarded: referrer) not
  				or: [manager isRemembered: referrer]).
  	"unscanned ephemerons should be scanned later."
  	self assert: ((manager isEphemeron: referrer) not
  				or: [(self isScavengeSurvivor: (manager keyOfEphemeron: referrer))
  				or: [self is: referrer onWeaklingList: ephemeronList]]).
  	foundNewReferent := false.
  	0 to: (manager numStrongSlotsOf: referrer ephemeronInactiveIf: #isScavengeSurvivor:) - 1
  	   do: [:i| | referent newLocation |
  		referent := manager fetchPointer: i ofMaybeForwardedObject: referrer.
  		(manager isNonImmediate: referent) ifTrue:
  			["a forwarding pointer could be because of become: or scavenging."
  			 (manager isForwarded: referent) ifTrue:
  				[referent := manager followForwarded: referent].
  			 ((manager isNonImmediate: referent)
  			  and: [manager isYoung: referent])
+ 				ifTrue: "if target is already in future space forwarding pointer was due to a become:."
+ 					[(manager isInFutureSpace: referent)
+ 						ifTrue: [newLocation := referent. foundNewReferent := true]
- 				ifTrue:
- 					["if target is already in future space forwarding pointer was due to a become:."
- 					 (manager isInFutureSpace: referent)
- 						ifTrue: [newLocation := referent]
  						ifFalse:
+ 							[newLocation := self copyAndForward: referent.
+ 							 (manager isYoung: newLocation) ifTrue:
+ 								[foundNewReferent := true]].
- 							[(manager isForwarded: referent)
- 								ifTrue: [self halt. "can this even happen?"
- 									newLocation := manager followForwarded: referent]
- 								ifFalse: [newLocation := self copyAndForward: referent]].
- 					 (manager isYoung: newLocation) ifTrue:
- 						[foundNewReferent := true].
  					 manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: newLocation]
  				ifFalse:
  					[manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: referent]]].
  	^foundNewReferent or: [manager isWeakNonImm: referrer]!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was added:
+ ----- Method: SpurMemoryManager>>addFreeChunkWithBytes:at: (in category 'free space') -----
+ addFreeChunkWithBytes: bytes at: address
+ 	self freeChunkWithBytes: bytes at: address.
+ 	totalFreeOldSpace := totalFreeOldSpace + bytes!

Item was changed:
  ----- Method: SpurMemoryManager>>bytesLeft: (in category 'free space') -----
  bytesLeft: includeSwapSpace
  	"Answer the amount of available free space. If includeSwapSpace is true, include
  	 possibly available swap space. If includeSwapSpace is false, include possibly available
  	 physical memory. For a report on the largest free block currently availabe within
  	 Squeak memory but not counting extra memory use #primBytesLeft."
  	^totalFreeOldSpace
  	+ (scavenger eden limit - freeStart)
  	+ (scavenger pastSpace limit - pastSpaceStart)
+ 	+ (scavenger futureSpace limit - scavenger futureSpace limit)
+ 	- coInterpreter interpreterAllocationReserveBytes!
- 	+ (scavenger futureSpace limit - scavenger futureSpace limit)!

Item was added:
+ ----- Method: SpurMemoryManager>>bytesLeftInOldSpace (in category 'free space') -----
+ bytesLeftInOldSpace
+ 	"Answer the amount of available free old space.  Used by primitiveFullGC
+ 	 to answer the current available memory."
+ 	^totalFreeOldSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>growHeadroom (in category 'accessing') -----
+ growHeadroom
+ 	^growHeadroom!

Item was added:
+ ----- Method: SpurMemoryManager>>growHeadroom: (in category 'accessing') -----
+ growHeadroom: aValue
+ 	^growHeadroom := aValue!

Item was added:
+ ----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') -----
+ growOldSpaceByAtLeast: minAmmount
+ 	"Attempt to grow memory by at least minAmmount.
+ 	 Answer the size of the new segment, or nil if the attempt failed."
+ 	| ammount |
+ 	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	statGrowMemory := statGrowMemory + 1.
+ 	ammount := minAmmount max: growHeadroom.
+ 	^(segmentManager addSegmentOfSize: ammount) ifNotNil:
+ 		[:segInfo|
+ 		 freeOldSpaceStart :=
+ 		 endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializations that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0.
  	statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0.
- 	self flag: #temporary.
- 	shrinkThreshold := 16r10000000. "something huge for now"
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
  	"Assume: image reader initializes the following variables:
  		memory
  		memoryLimit
  		specialObjectsOop
  		lastHash
  	"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: BaseHeaderSize = self baseHeaderSize.
  
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  
  	segmentManager numSegments > 0 "false if Spur image bootstrap"
  		ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
  		ifFalse: [self assert: bytesToShift = 0].
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = newSpaceLimit.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
  	self initializeFreeSpacePostLoad: freeListObj.
  
  	segmentManager collapseSegmentsPostSwizzle.
  
  	self initializeNewSpaceVariables.
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
  
+ 	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
+ 	growHeadroom := 8*1024*1024.		"headroom when growing"
+ 	shrinkThreshold := 16*1024*1024.		"free space before shrinking"!
- 	"lowSpaceThreshold := 0.
- 	signalLowSpace := false.
- 	remapBufferCount := 0.
- 	tenuringThreshold := 2000.  ""tenure all suriving objects if survivor count is over this threshold""
- 	growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
- 	shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
- 
- 	""garbage collection statistics""
- 	statFullGCs := 0.
- 	statFullGCUsecs := 0.
- 	statIncrGCs := 0.
- 	statIncrGCUsecs := 0.
- 	statTenures := 0.
- 	statRootTableOverflows := 0.
- 	statGrowMemory := 0.
- 	statShrinkMemory := 0.
- 	forceTenureFlag := 0.
- 	gcBiasToGrow := 0.
- 	gcBiasToGrowGCLimit := 0.
- 	extraRootCount := 0."!

Item was added:
+ ----- Method: SpurMemoryManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
+ shrinkObjectMemory: delta 
+ 	"Attempt to shrink the object memory by the given delta amount."
+ 	self shouldBeImplemented!

Item was added:
+ ----- Method: SpurMemoryManager>>sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto: (in category 'simulation only') -----
+ sqAllocateMemorySegmentOfSize: segmentSize Above: minAddress AllocatedSizeInto: allocSizePtrOrBlock
+ 	<doNotGenerate>
+ 	"Simulate heap growth by growing memory by segmentSize + 1Meg.
+ 	 1Meg will be the distance between segments to be bridged."
+ 	| oneMeg newMemory start |
+ 	oneMeg := 1024 * 1024.
+ 	start := memory size * 4 + oneMeg.
+ 	newMemory := memory class new: memory size + (segmentSize + oneMeg / 4).
+ 	newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
+ 	memory := newMemory.
+ 	allocSizePtrOrBlock value: segmentSize.
+ 	^start!

Item was added:
+ ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
+ addSegmentOfSize: ammount
+ 	<returnTypeC: #'SpurSegmentInfo *'>
+ 	| allocatedSize |
+ 	<var: #oldSeg type: #'SpurSegmentInfo *'>
+ 	<var: #newSeg type: #'SpurSegmentInfo *'>
+ 	numSegments = numSegInfos ifTrue:
+ 		[self allocateOrExtendSegmentInfos].
+ 	self assert: numSegments < numSegInfos.
+ 	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
+ 			sqAllocateMemorySegmentOfSize: ammount
+ 			Above: manager newSpaceLimit
+ 			AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
+ 									inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
+ 		[:segAddress| | newSeg oldSeg segEnd bridgeSpan clifton |
+ 		 oldSeg  := self addressOf: (segments at: numSegments - 1).
+ 		 newSeg := self addressOf: (segments at: numSegments).
+ 		 numSegments := numSegments + 1.
+ 		 newSeg
+ 			segStart: segAddress;
+ 			segSize: allocatedSize.
+ 		 segEnd := oldSeg segStart + oldSeg segSize.
+ 		 bridgeSpan := segAddress - segEnd + manager bridgeSize.
+ 		 clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..."
+ 		 "the old bridge should be the terminator."
+ 		 self assert: (manager numSlotsOfAny: (manager objectStartingAt: clifton)) = 0.
+ 		 manager initSegmentBridgeWithBytes: bridgeSpan at: clifton.
+ 		 "the bridge should get us to the next segment"
+ 		 self assert: (manager addressAfter: (manager objectStartingAt: clifton)) = newSeg segStart.
+ 		 "and add the new free chunk to the free list"
+ 		 manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
+ 		 self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) = (newSeg segStart + newSeg segSize - manager bridgeSize).
+ 		 ^newSeg].
+ 	^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
  collapseSegmentsPostSwizzle
  	"The image has been loaded, old segments reconstructed, and the
  	  loaded image swizzled into a single contiguous segment.  Collapse
  	  the segments intio one."
  	| bridge |
  	canSwizzle := false.
  	firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
  		[^self].
  
  	numSegments := 1.
  	(self addressOf: (segments at: 0))
  		segStart: manager newSpaceLimit;
+ 		segSize: manager endOfMemory - manager newSpaceLimit.
- 		segSize: manager endOfMemory.
  	"finally plant a bridge at the end of the coallesced segment and cut back the
+ 	 manager's notion of the end of memory to immediately before the bridge."
- 	 manager's ntion of the end of memory to immediately before the bridge."
  	bridge := manager endOfMemory - manager bridgeSize.
  	manager
  		initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
  		setEndOfMemory: bridge!

Item was changed:
  ----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') -----
  initializeFromFreeChunks: freeChunks
  	"For testing, create a set of segments using the freeChunks as bridges."
  	numSegments := freeChunks size.
  	freeChunks do:
  		[:f|
  		manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f).
  		self assert: (manager isSegmentBridge: f)].
  	segments := (1 to: numSegments) collect:
  					[:i| | bridge start size |
  					bridge := freeChunks at: i.
  					start := i = 1
  								ifTrue: [manager newSpaceLimit]
  								ifFalse: [manager addressAfter: (freeChunks at: i - 1)].
  					size := bridge + manager baseHeaderSize - start.
  					SpurSegmentInfo new
+ 						segStart: start;
- 						start: start;
  						segSize: size;
  						yourself].
  	segments := CArrayAccessor on: segments.
  	freeChunks allButLast do:
  		[:bridge| self assert: (manager isValidSegmentBridge: bridge)]!

Item was changed:
  ----- Method: SpurSegmentManager>>totalBytesInSegments (in category 'snapshot') -----
  totalBytesInSegments
  	| total |
  	total := 0.
  	0 to: numSegments - 1 do:
  		[:i|
+ 		total := total + (segments at: i) segSize].
- 		total := total + (segments at: i) segSize - manager bridgeSize].
  	^total!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
  primitiveFullGC
+ 	"Do a full garbage collection and return the number of bytes available.
+ 	 If on SqueakV3ObjectMemory include swap space if dynamic memory
+ 	 management is supported."
- 	"Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)."
  
  	objectMemory fullGCLock > 0 ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	self externalWriteBackHeadFramePointers.
  	objectMemory hasSpurMemoryManagerAPI ifFalse:
  		[objectMemory incrementalGC].  "maximimize space for forwarding table"
  	objectMemory fullGC.
+ 	"In Spur we exclude swap space."
+ 	self pop: 1
+ 		thenPushInteger: (objectMemory hasSpurMemoryManagerAPI
+ 							ifTrue: [objectMemory bytesLeftInOldSpace]
+ 							ifFalse: [objectMemory bytesLeft: true])!
- 	self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).!



More information about the Vm-dev mailing list