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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.557
Author: eem
Time: 11 December 2013, 1:43:49.106 pm
UUID: 5837253f-a896-43ac-bcc6-816e923030e7
Ancestors: VMMaker.oscog-eem.556

Spur:
Fix bug in swizzleObjStackAt: that was stopping a snapshot starting.

More assert checks in free tree enumeration.

Fix new space enumeration assert for image bootstrap.

Fix bug in freeChunk print method & add a free list printing method.

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

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
+ 		primitiveFileSetPosition
+ 		bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:) includes: sel) ifFalse:
- 		primitiveFileSetPosition) includes: sel) ifFalse:
  		[self halt].
  	^super isIntegerObject: oop!

Item was changed:
  ----- Method: SpurMemoryManager>>allNewSpaceEntitiesDo: (in category 'object enumeration') -----
  allNewSpaceEntitiesDo: aBlock
  	"Enumerate all new space objects, including free objects."
  	<inline: true>
  	| prevObj prevPrevObj objOop limit |
  	prevPrevObj := prevObj := nil.
  	"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
  	  in pastSpace.  Objects are allocated in eden.  So enumerate only pastSpace and eden."
+ 	self assert: (self bootstrapping or: [scavenger pastSpace start < scavenger eden start]).
- 	self assert: scavenger pastSpace start < scavenger eden start.
  	objOop := self objectStartingAt: scavenger pastSpace start.
  	limit := pastSpaceStart.
  	[self oop: objOop isLessThan: limit] whileTrue:
  		[aBlock value: objOop.
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: limit].
  	objOop := self objectStartingAt: scavenger eden start.
  	[self oop: objOop isLessThan: freeStart] whileTrue:
  		[aBlock value: objOop.
  		 prevPrevObj := prevObj.
  		 prevObj := objOop.
  		 objOop := self objectAfter: objOop limit: freeStart].
  	self touch: prevPrevObj.
  	self touch: prevObj!

Item was changed:
  ----- Method: SpurMemoryManager>>freeTreeNodesDo: (in category 'free space') -----
  freeTreeNodesDo: aBlock
  	"Enumerate all nodes in the free tree (in order, smaller to larger),
  	 but *not* including the next nodes of the same size off each tree node.
  	 This is an iterative version so that the block argument can be
  	 inlined by Slang. The trick to an iterative binary tree application is
  	 to apply the function on the way back up when returning from a
  	 particular direction, in this case up from the larger child.
  
  	 N.B For the convenience of rebuildFreeTreeFromSortedFreeChunks
  	 aBlock *MUST* answer the freeTreeNode it was invoked with, or
  	 its replacement if it was replaced by aBlock."
  	<inline: true>
  	| treeNode cameFrom |
  	treeNode := freeLists at: 0.
  	treeNode = 0 ifTrue:
  		[^self].
  	cameFrom := -1.
  	[| smallChild largeChild |
  	 smallChild := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
  	 largeChild := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
+ 	 self assert: (smallChild = 0 or: [treeNode = (self fetchPointer: self freeChunkParentIndex ofFreeChunk: smallChild)]).
+ 	 self assert: (largeChild = 0 or: [treeNode = (self fetchPointer: self freeChunkParentIndex ofFreeChunk: largeChild)]).
  	 "apply if the node has no children, or it has no large children and we're
  	  returning from the small child, or we're returning from the large child."
  	 ((smallChild = 0 and: [largeChild = 0])
  	  or: [largeChild = 0
  			ifTrue: [cameFrom = smallChild]
  			ifFalse: [cameFrom = largeChild]])
  		ifTrue:
  			[treeNode := aBlock value: treeNode.
  			 "and since we've applied we must move on up"
  			 cameFrom := treeNode.
  			 treeNode := self fetchPointer: self freeChunkParentIndex ofFreeChunk: treeNode]
  		ifFalse:
  			[(smallChild ~= 0 and: [cameFrom ~= smallChild])
  				ifTrue:
  					[treeNode := smallChild]
  				ifFalse:
  					[self assert: largeChild ~= 0.
  					 treeNode := largeChild].
  			 cameFrom := -1].
  	 treeNode ~= 0] whileTrue!

Item was changed:
  ----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
  printFreeChunk: freeChunk
  	<api>
  	| numBytes |
  	numBytes := self bytesInObject: freeChunk.
  	coInterpreter
  		print: 'freeChunk '; printHexPtrnp: freeChunk;
  		print: ' bytes '; printNum: numBytes;
  		print: ' next '; printHexPtrnp: (self fetchPointer: self freeChunkNextIndex
  											ofFreeChunk: freeChunk).
+ 	numBytes / self allocationUnit >= self numFreeLists ifTrue:
- 	numBytes / self allocationUnit > self numFreeLists ifTrue:
  		[coInterpreter
  			print: ' ^ '; printHexPtrnp: (self fetchPointer: self freeChunkParentIndex
  											ofFreeChunk: freeChunk);
  			print: ' < '; printHexPtrnp: (self fetchPointer: self freeChunkSmallerIndex
  											ofFreeChunk: freeChunk);
  			print: ' > '; printHexPtrnp: (self fetchPointer: self freeChunkLargerIndex
  											ofFreeChunk: freeChunk)].
  	coInterpreter cr!

Item was added:
+ ----- Method: SpurMemoryManager>>printFreeList: (in category 'debug printing') -----
+ printFreeList: chunkOrIndex
+ 	<api>
+ 	| freeChunk |
+ 	(chunkOrIndex >= 0 and: [chunkOrIndex < self numFreeLists]) ifTrue:
+ 		[^self printFreeList: (freeLists at: chunkOrIndex)].
+ 	freeChunk := chunkOrIndex.
+ 	[freeChunk ~= 0] whileTrue:
+ 		[self printFreeChunk: freeChunk.
+ 		 freeChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk]!

Item was changed:
  ----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') -----
  swizzleObjStackAt: objStackRootIndex
  	"On load, swizzle the pointers in an obj stack. Answer the obj stack's oop."
  	| firstPage stackOrNil index field |
  	firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
  	stackOrNil = nilObj ifTrue:
  		[^stackOrNil].
  	[self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
  	 self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex.
  	 "There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
  	   if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4.
  	   Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
  	 index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
  	 "swizzle fields including ObjStackNextx and leave field containing the next link."
  	 [field := self fetchPointer: index ofObject: stackOrNil.
+ 	  (field = 0 or: [self isImmediate: field]) ifFalse:
- 	  (self isImmediate: field) ifFalse:
  		[field := segmentManager swizzleObj: field.
  		 self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field].
+ 	  (index := index - 1) > ObjStackMyx] whileTrue.
- 	  (index := index - 1) > ObjStackTopx] whileTrue.
  	 (stackOrNil := field) ~= 0] whileTrue.
  	[stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage.
  	 stackOrNil ~= 0] whileTrue:
  		[field := segmentManager swizzleObj: stackOrNil.
  		 self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field.
  		 firstPage := stackOrNil].
  	self assert: (self isValidObjStackAt: objStackRootIndex).
  	^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj!