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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 4 22:26:06 UTC 2014


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

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

Name: VMMaker.oscog-eem.625
Author: eem
Time: 4 March 2014, 2:22:42.19 pm
UUID: 75659976-9919-4e64-bf59-d5d83894396d
Ancestors: VMMaker.oscog-eem.624

Increase length limit in stringOf: to 128 characters for Spur boot-
strap, and move it up to StackInterpreter.  Do same with openOn:.

Use neater expression for determining pur size of large free chunk
and add an assert to freeTreeNodesDo: to try and track down
appearance of small chunk in free chunk tree.

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

Item was removed:
- ----- Method: CogVMSimulator>>openOn: (in category 'initialization') -----
- openOn: fileName
- 	"(CogVMSimulator new openOn: 'clonex.image') test"
- 	objectMemory hasSpurMemoryManagerAPI ifTrue:
- 		[| fileSize potSize |
- 		fileSize := (FileDirectory directoryEntryFor: fileName) fileSize.
- 		potSize := 1 << (fileSize - 1) highBit.
- 		^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize].
- 
- 	self openOn: fileName extraMemory: 2500000.!

Item was removed:
- ----- Method: CogVMSimulator>>stringOf: (in category 'debug support') -----
- stringOf: oop
- 	| size long nLongs chars |
- 	^ String streamContents:
- 		[:strm |
- 		size := 100 min: (self stSizeOf: oop).
- 		nLongs := size-1//BytesPerWord+1.
- 		1 to: nLongs do:
- 			[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
- 			chars := self charsOfLong: long.
- 			strm nextPutAll: (i=nLongs
- 							ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
- 							ifFalse: [chars])]]!

Item was changed:
  ----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
  addFreeSubTree: freeTree
  	"Add a freeChunk sub tree back into the large free chunk tree.
  	 This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]."
  	| bytesInArg treeNode bytesInNode subNode |
  	"N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots
  	 and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits."
  	self assert: (self isFreeObject: freeTree).
  	bytesInArg := self bytesInObject: freeTree.
+ 	self assert: bytesInArg >= (self numFreeLists * self allocationUnit).
- 	self assert: bytesInArg / (self allocationUnit / self bytesPerSlot) >= self numFreeLists.
  	treeNode := freeLists at: 0.
  	self assert: treeNode ~= 0.
  	[bytesInNode := self bytesInObject: treeNode.
+ 	 self assert: bytesInNode >= (self numFreeLists * self allocationUnit).
  	 self assert: bytesInArg ~= bytesInNode.
  	 bytesInNode > bytesInArg
  		ifTrue:
  			[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
  			 subNode = 0 ifTrue:
  				[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
  				 self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
  				 ^self]]
  		ifFalse:
  			[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
  			 subNode = 0 ifTrue:
  				[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
  				 self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
  				 ^self]].
  	 treeNode := subNode] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
  addToFreeTree: freeChunk bytes: chunkBytes
  	"Add freeChunk to the large free chunk tree.
  	 For the benefit of sortedFreeObject:, answer the treeNode it is added
  	 to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
  	| childBytes parent child |
  	self assert: (self isFreeObject: freeChunk).
  	self assert: chunkBytes = (self bytesInObject: freeChunk).
+ 	self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
- 	self assert: chunkBytes / self allocationUnit >= self numFreeLists.
- 
  	self
  		storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
  		storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
  	"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
  	 Beneath the node are smaller and larger blocks."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes ifTrue: "size match; add to list at node."
  			[self storePointer: self freeChunkNextIndex
  					ofFreeChunk: freeChunk
  						withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
  				storePointer: self freeChunkNextIndex
  					ofFreeChunk: child
  						withValue: freeChunk.
  			 ^child].
  		 "walk down the tree"
  		 parent := child.
  		 child := self fetchPointer: (childBytes > chunkBytes
  										ifTrue: [self freeChunkSmallerIndex]
  										ifFalse: [self freeChunkLargerIndex])
  					ofFreeChunk: child].
  	parent = 0 ifTrue:
  		[self assert: (freeLists at: 0) = 0.
  		 freeLists at: 0 put: freeChunk.
  		 freeListsMask := freeListsMask bitOr: 1.
  		 ^0].
  	self assert: (freeListsMask anyMask: 1).
  	"insert in tree"
  	self storePointer: self freeChunkParentIndex
  			ofFreeChunk: freeChunk
  				withValue: parent.
  	self storePointer: (childBytes > chunkBytes
  									ifTrue: [self freeChunkSmallerIndex]
  									ifFalse: [self freeChunkLargerIndex])
  			ofFreeChunk: parent
  				withValue: freeChunk.
  	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>findLargestFreeChunk (in category 'free space') -----
  findLargestFreeChunk
  	"Answer, but do not remove, the largest free chunk in the free lists."
  	| treeNode childNode |
  	treeNode := freeLists at: 0.
  	treeNode = 0 ifTrue:
  		[^nil].
  	[self assert: (self isValidFreeObject: treeNode).
+ 	 self assert: (self bytesInObject: treeNode) >= (self numFreeLists * self allocationUnit).
  	 childNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
  	 childNode ~= 0] whileTrue:
  		[treeNode := childNode].
  	^treeNode!

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 |
+ 	 self assert: (self bytesInObject: treeNode) >= (self numFreeLists * self allocationUnit).
  	 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>>isLargeFreeObject: (in category 'free space') -----
  isLargeFreeObject: objOop
+ 	^(self bytesInObject: objOop) >= (self numFreeLists * self allocationUnit)!
- 	^(self bytesInObject: objOop)  / self allocationUnit >= self numFreeLists!

Item was changed:
  ----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') -----
  isValidFreeObject: objOop
  	| chunk |
  	^(self addressCouldBeObj: objOop)
  	  and: [(self isFreeObject: objOop)
  	  and: [(self isInMemory: (self addressAfter: objOop))
  	  and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0
  		   or: [self isFreeObject: chunk])
+ 	  and: [(self bytesInObject: objOop) < (self numFreeLists * self allocationUnit)
- 	  and: [(self bytesInObject: objOop) / self allocationUnit < self numFreeLists
  		    or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0
  			   or: [self isFreeObject: chunk])
  			  and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0
  				    or: [self isFreeObject: chunk])
  			  and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0
  				    or: [self isFreeObject: chunk]]]]]]]]!

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 numFreeLists * self allocationUnit) 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 changed:
  ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'snapshot') -----
  swizzleFieldsOfFreeChunk: chunk
  	<inline: true>
  	| field |
  	field := self fetchPointer: self freeChunkNextIndex ofFreeChunk: chunk.
  	field ~= 0 ifTrue:
  		[self storePointerNoAssert: self freeChunkNextIndex
  			ofFreeChunk: chunk
  			withValue: (segmentManager swizzleObj: field)].
+ 	(self bytesInObject: chunk) >= (self numFreeLists * self allocationUnit) ifTrue:
- 	(self bytesInObject: chunk) / self allocationUnit >= self numFreeLists ifTrue:
  		[self freeChunkParentIndex to: self freeChunkLargerIndex do:
  			[:index|
  			 field := self fetchPointer: index ofFreeChunk: chunk.
  			 field ~= 0 ifTrue:
  				[self storePointerNoAssert: index
  					ofFreeChunk: chunk
  					withValue: (segmentManager swizzleObj: field)]]]!

Item was added:
+ ----- Method: StackInterpreter>>openOn: (in category 'simulation') -----
+ openOn: fileName
+ 	"(StackInterpreterSimulator new openOn: 'clonex.image') openAsMorph; run"
+ 	<doNotGenerate>
+ 	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[| fileSize potSize |
+ 		fileSize := (FileDirectory directoryEntryFor: fileName)
+ 						ifNotNil: [:ent| ent fileSize]
+ 						ifNil: [((FileDoesNotExistException fileName: fileName) readOnly: true) signal].
+ 		potSize := 1 << (fileSize - 1) highBit.
+ 		^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize].
+ 	self openOn: fileName extraMemory: 2500000!

Item was added:
+ ----- Method: StackInterpreter>>stringOf: (in category 'debug support') -----
+ stringOf: oop
+ 	<doNotGenerate>
+ 	| size long nLongs chars |
+ 	^ String streamContents:
+ 		[:strm |
+ 		size := 128 min: (self stSizeOf: oop).
+ 		nLongs := size-1//BytesPerWord+1.
+ 		1 to: nLongs do:
+ 			[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
+ 			chars := self charsOfLong: long.
+ 			strm nextPutAll: (i=nLongs
+ 							ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
+ 							ifFalse: [chars])]]!

Item was removed:
- ----- Method: StackInterpreterSimulator>>openOn: (in category 'initialization') -----
- openOn: fileName
- 	"(StackInterpreterSimulator new openOn: 'clonex.image') test"
- 	objectMemory hasSpurMemoryManagerAPI ifTrue:
- 		[| fileSize potSize |
- 		fileSize := (FileDirectory directoryEntryFor: fileName) fileSize.
- 		potSize := 1 << (fileSize - 1) highBit.
- 		^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize].
- 	self openOn: fileName extraMemory: 2500000.!

Item was removed:
- ----- Method: StackInterpreterSimulator>>stringOf: (in category 'debug support') -----
- stringOf: oop
- 	| size long nLongs chars |
- 	^ String streamContents:
- 		[:strm |
- 		size := 100 min: (self stSizeOf: oop).
- 		nLongs := size-1//BytesPerWord+1.
- 		1 to: nLongs do:
- 			[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
- 			chars := self charsOfLong: long.
- 			strm nextPutAll: (i=nLongs
- 							ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
- 							ifFalse: [chars])]]!



More information about the Vm-dev mailing list