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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 16 23:33:30 UTC 2013


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

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

Name: VMMaker.oscog-eem.463
Author: eem
Time: 16 October 2013, 4:30:50.194 pm
UUID: d0c77ca3-8fb8-41d8-886b-f40fa4555b88
Ancestors: VMMaker.oscog-eem.462

Don't assume new segment is above all other segments.
Fix arg count bug in primitiveGrowMemoryByAtLeast.
Add assimilateNewSegment: to avoid overriding so much
in Spur32BitCoMemoryManager & hence nuke its
growOldSpaceByAtLeast:.
Add a fudge factor (2 * baseHeaderSize + bridgeSize) to
growOldSpaceByAtLeast: and round p the request to a power-of-two.

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

Item was changed:
  ----- 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: 2 thenPushInteger: segSize]!
- 		ifNotNil: [:segSize| self pop: 1 thenPushInteger: segSize]!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
+ assimilateNewSegment: segInfo
+ 	"Update after adding a segment.
+ 	 Here we make sure the new segment is not executable."
+ 	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	coInterpreter
+ 		sqMakeMemoryNotExecutableFrom: segInfo segStart
+ 		To: segInfo segStart + segInfo segSize!

Item was removed:
- ----- 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 added:
+ ----- Method: SpurMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
+ assimilateNewSegment: segInfo
+ 	"Update after adding a segment.
+ 	 Here we set freeOldSpaceStart & endOfMemory if required."
+ 	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	segInfo segStart >= endOfMemory ifTrue:
+ 		[freeOldSpaceStart :=
+ 		 endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!

Item was changed:
  ----- 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 counts attempts, not successes."
  	statGrowMemory := statGrowMemory + 1.
+ 	"we need to include overhead for a new object header plus the segment bridge."
+ 	ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize).
+ 	"round up to the nearest power of two."
+ 	ammount := 1 << (ammount - 1) highBit.
+ 	"and grow by at least growHeadroom."
+ 	ammount := ammount max: growHeadroom.
- 	ammount := minAmmount max: growHeadroom.
  	^(segmentManager addSegmentOfSize: ammount) ifNotNil:
  		[:segInfo|
+ 		 self assimilateNewSegment: segInfo.
+ 		 segInfo segSize]!
- 		 freeOldSpaceStart :=
- 		 endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!

Item was changed:
  ----- 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| | newSegIndex newSeg |
+ 		 newSegIndex := self insertSegmentFor: segAddress.
+ 		 newSeg := self addressOf: (segments at: newSegIndex).
- 		[: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.
+ 		 self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
+ 		 self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
+ 										[self addressOf: (segments at: newSegIndex + 1)]).
+ 		 "and add the new free chunk to the free list; done here
+ 		  instead of in assimilateNewSegment: for the assert"
- 		 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).
- 		 self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) = (newSeg segStart + newSeg segSize - manager bridgeSize).
  		 ^newSeg].
  	^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>allocateOrExtendSegmentInfos (in category 'private') -----
  allocateOrExtendSegmentInfos
  	"Increase the number of allocated segInfos by 16."
+ 	<returnTypeC: #void>
  	| newNumSegs |
  	numSegInfos = 0 ifTrue:
  		[numSegInfos := 16.
  		 segments := self
  						cCode: [self c: numSegInfos alloc: (self sizeof: SpurSegmentInfo)]
  						inSmalltalk: [CArrayAccessor on: ((1 to: numSegInfos) collect: [:i| SpurSegmentInfo new])].
  		 ^self].
  	newNumSegs := numSegInfos + 16.
  	segments := self
  						cCode: [self re: newNumSegs * (self sizeof: SpurSegmentInfo) alloc: segments]
  						inSmalltalk: [CArrayAccessor on: segments object,
  									((numSegInfos to: newNumSegs) collect: [:i| SpurSegmentInfo new])].
  	self cCode:
  		[segments = 0 ifTrue:
  			[self error: 'out of memory; cannot allocate more segments'].
  		 self
  			me: segments + numSegInfos
  			ms: 0
  			et: newNumSegs - numSegInfos * (self sizeof: SpurSegmentInfo)].
  	numSegInfos := newNumSegs!

Item was added:
+ ----- Method: SpurSegmentManager>>bridgeFrom:to: (in category 'growing/shrinking memory') -----
+ bridgeFrom: aSegment to: nextSegmentOrNil
+ 	"Create a bridge from aSegment to the next segment,
+ 	 or create a terminating bridge if there is no next segment."
+ 	<var: #aSegment type: #'SpurSegmentInfo *'>
+ 	<var: #nextSegmentOrNil type: #'SpurSegmentInfo *'>
+ 	| segEnd clifton bridgeSpan |
+ 	segEnd := aSegment segStart + aSegment segSize.
+ 	clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..."
+ 	bridgeSpan := nextSegmentOrNil
+ 					ifNil: [manager bridgeSize]
+ 					ifNotNil: [nextSegmentOrNil segStart - segEnd + manager bridgeSize].
+ 	manager initSegmentBridgeWithBytes: bridgeSpan at: clifton.
+ 	"the revised bridge should get us to the new segment"
+ 	self assert: (nextSegmentOrNil isNil
+ 				 or: [(manager addressAfter: (manager objectStartingAt: clifton)) = nextSegmentOrNil segStart])
+ !

Item was added:
+ ----- Method: SpurSegmentManager>>insertSegmentFor: (in category 'growing/shrinking memory') -----
+ insertSegmentFor: segAddress
+ 	"Reserve a new segInfo for segAddress.  If segAddress
+ 	 is in the middle of the existing segments, shuffle them
+ 	 up to make room. Answer the new segment's index."
+ 	| segIndex lastSegIndex |
+ 	self assert: segAddress > ((segments at: 0) segStart + (segments at: 0) segSize).
+ 	numSegments = numSegInfos ifTrue:
+ 		[self allocateOrExtendSegmentInfos].
+ 	self assert: numSegments < numSegInfos.
+ 	segIndex := lastSegIndex := numSegments - 1.
+ 	numSegments := numSegments + 1.
+ 	[segAddress > ((segments at: segIndex) segStart
+ 					+ (segments at: segIndex) segSize) ifTrue:
+ 		[segIndex := segIndex + 1.
+ 		 lastSegIndex to: segIndex by: -1 do:
+ 			[:idx| segments at: idx + 1 put: (segments at: idx)].
+ 		 ^segIndex].
+ 	 segIndex := segIndex - 1]
+ 		repeat!



More information about the Vm-dev mailing list