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

commits at source.squeak.org commits at source.squeak.org
Mon Dec 15 20:37:20 UTC 2014


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

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

Name: VMMaker.oscog-eem.986
Author: eem
Time: 15 December 2014, 12:33:36.599 pm
UUID: 62703abf-bfd4-4966-a13c-036fa3da9950
Ancestors: VMMaker.oscog-eem.985

Spur:
Eliminate the erroneous and confusing
setRawNumSlotsOf:to: and setOverflowNumSlotsOf:to:.
Use rawNumSlotsOf:put: & rawOverflowSlotsOf:put:
which match the getters.  Hence fix 64-bit compaction.

Simulator:
Don't warn of MNU redirection in doits.

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

Item was changed:
  ----- Method: CogVMSimulator>>doesNotUnderstand: (in category 'error handling') -----
  doesNotUnderstand: aMessage
  	"If this is a doit and the objectMemory understands, pass it on."
  	(thisContext findContextSuchThat: [:ctxt| ctxt selector == #evaluate:in:to:notifying:ifFail:logged:]) ifNotNil:
  		[(objectMemory class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[thisContext sender selector ~~ #DoIt ifTrue:
+ 					[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush].
- 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: objectMemory]].
  		(cogit class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[thisContext sender selector ~~ #DoIt ifTrue:
+ 					[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to cogit'; cr; flush].
- 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to cogit'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: cogit]]].
  	^super doesNotUnderstand: aMessage!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>coalesce:and: (in category 'gc - global') -----
  coalesce: obj1 and: obj2
  	| header1NumSlots header2NumSlots obj2slots newNumSlots |
  	header1NumSlots := self rawNumSlotsOf: obj1.
  	header2NumSlots := self rawNumSlotsOf: obj2.
  
  	"compute total number of slots in obj2, including header"
  	obj2slots := header2NumSlots = self numSlotsMask
  					ifTrue: [(self rawOverflowSlotsOf: obj2) + (2 * self baseHeaderSize / self wordSize)]
  					ifFalse: [(header2NumSlots = 0 ifTrue: [1] ifFalse: [header2NumSlots]) + (self baseHeaderSize / self wordSize)].
  	self assert: obj2slots * self wordSize = (self bytesInObject: obj2).
  
  	"if obj1 already has a double header things are simple..."
  	header1NumSlots = self numSlotsMask ifTrue:
  		[self rawOverflowSlotsOf: obj1 put: obj2slots + (self rawOverflowSlotsOf: obj1).
  		 ^obj1].
  
  	"compute total number of slots in obj1, excluding header"
  	header1NumSlots := header1NumSlots = 0 ifTrue: [1] ifFalse: [header1NumSlots].
  	self assert: header1NumSlots * self wordSize + self baseHeaderSize = (self bytesInObject: obj1).
  	newNumSlots := obj2slots + header1NumSlots.
  
  	"if obj1 still only requires a single header things are simple..."
  	newNumSlots < self numSlotsMask ifTrue:
  		[self rawNumSlotsOf: obj1 put: newNumSlots.
  		 ^obj1].
  
  	"convert from single to double header..."
  	newNumSlots := newNumSlots - (self baseHeaderSize / self wordSize).
  	self
+ 		rawNumSlotsOf: obj1 + self baseHeaderSize put: self numSlotsMask;
+ 		rawOverflowSlotsOf: obj1 + self baseHeaderSize put: newNumSlots.
- 		setRawNumSlotsOf: obj1 + self baseHeaderSize to: self numSlotsMask;
- 		setOverflowNumSlotsOf: obj1 + self baseHeaderSize to: newNumSlots.
  	^obj1 + self baseHeaderSize!

Item was changed:
  ----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
  allInstancesOf: aClass
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of instances as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| classIndex freeChunk ptr start limit count bytes |
  	classIndex := self rawHashBitsOf: aClass.
  	classIndex = 0 ifTrue:
  		[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 ^freeChunk].
  	MarkObjectsForEnumerationPrimitives ifTrue:
  		[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk.
  	start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	(self isClassAtUniqueIndex: aClass)
  		ifTrue:
  			[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
  		ifFalse:
  			[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
  	self assert: (self isEmptyObjStack: markStack).
  	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeObject: freeChunk.
  		 ^self integerObjectOf: count].
  	count < self numSlotsMask ifTrue:
  		[| smallObj |
  		 smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 0 to: count - 1 do:
  			[:i|
  			self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
  		 self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self beRootIfOld: smallObj.
  		 self checkFreeSpace.
  		 ^smallObj].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
+ 	self rawOverflowSlotsOf: freeChunk put: count.
- 	self setOverflowNumSlotsOf: freeChunk to: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace.
  	self runLeakCheckerForFullGC: false.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
  allObjects
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of objects as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| freeChunk ptr start limit count bytes |
  	MarkObjectsForEnumerationPrimitives ifTrue:
  		[self markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk.
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerOop]]
  				ifFalse:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: (self isEmptyObjStack: markStack).
  	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	self assert: count >= self numSlotsMask.
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInObject: freeChunk) at: (self startOfObject: freeChunk).
  		 self checkFreeSpace.
  		 ^self integerObjectOf: count].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
+ 	self rawOverflowSlotsOf: freeChunk put: count.
- 	self setOverflowNumSlotsOf: freeChunk to: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace.
  	self runLeakCheckerForFullGC: false.
  	^freeChunk
  	
  	!

Item was changed:
  ----- Method: SpurMemoryManager>>forward:to: (in category 'become implementation') -----
  forward: obj1 to: obj2
  	self set: obj1 classIndexTo: self isForwardedObjectClassIndexPun formatTo: self forwardedFormat.
  	self storePointer: 0 ofForwarder: obj1 withValue: obj2.
  	"For safety make sure the forwarder has a slot count that includes its contents."
  	(self rawNumSlotsOf: obj1) = 0 ifTrue:
+ 		[self rawNumSlotsOf: obj1 put: 1]!
- 		[self setRawNumSlotsOf: obj1 to: 1]!

Item was changed:
  ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
  loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
  	"This primitive is called from Squeak as...
  		<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
  
  	"This primitive will load a binary image segment created by primitiveStoreImageSegment.
  	 It expects the outPointer array to be of the proper size, and the wordArray to be well formed.
  	 It will return as its value the original array of roots, and the erstwhile segmentWordArray will
  	 have been truncated to a size of one word, i.e. retaining the version stamp.  If this primitive
  	 should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and
  	 unusable jumble.  But what more could you have done with it anyway?"
  
  	<inline: false>
  	| segmentLimit segmentStart segVersion errorCode |
  
  	segmentLimit := self numSlotsOf: segmentWordArray.
  	(self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue:
  		[^PrimErrBadArgument].
  
  	"First thing is to verify format.  If Spur is ever ported to big-endian machines then the segment
  	 may have to be byte/word swapped, but so far it only runs on little-endian machines, so for now
  	 just fail if endinanness is wrong."
  	segVersion := self longAt: segmentWordArray + self baseHeaderSize.
  	(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
  		[self reverseBytesFrom: segmentWordArray + self baseHeaderSize
  			to: (self addressAfter: segmentWordArray).
  		 segVersion := self longAt: segmentWordArray + self baseHeaderSize.
  		 (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
  			[self reverseBytesFrom: segmentWordArray + self baseHeaderSize
  				to: (self addressAfter: segmentWordArray).
  		^PrimErrBadArgument]].
  
  	segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit.
  	segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize.
  
  	"Notionally reverse the Byte type objects if the data is from opposite endian machine.
  	 Test top byte.  $d on the Mac or $s on the PC.  Rest of word is equal.  If Spur is ever
  	 ported to big-endian machines then the segment may have to be byte/word swapped,
  	 but so far it only runs on little-endian machines, so for now just fail if endinanness is wrong."
  	self flag: #endianness.
  	(segVersion >> 16) ~= (self imageSegmentVersion >> 16) ifTrue:
  		"Reverse the byte-type objects once"
  		[true
  			ifTrue: [^PrimErrBadArgument]
  			ifFalse:
  				[self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart)
  					to: segmentLimit
  					flipFloatsIf: false]].
  
  	"scan through mapping oops and validating class references. Defer entering any
  	 class objects into the class table and/or pinning objects until a second pass."
  	errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
  	errorCode ~= 0 ifTrue:
  		[^errorCode].
  
  	"Scan for classes contained in the segment, entering them into the class table.
  	 Classes are at the front, after the root array and have the remembered bit set."
  	errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit.
  	errorCode ~= 0 ifTrue:
  		[^errorCode].
  
  	"Make a final pass, assigning class indices and/or pinning pinned objects"
  	self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
  
  	"Finally evaporate the container, leaving the newly loaded objects in place."
  	(self hasOverflowHeader: segmentWordArray)
+ 		ifTrue: [self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]
+ 		ifFalse: [self rawNumSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop].
- 		ifTrue: [self setOverflowNumSlotsOf: segmentWordArray to: self allocationUnit / self bytesPerOop]
- 		ifFalse: [self setRawNumSlotsOf: segmentWordArray to: self allocationUnit / self bytesPerOop].
  	
  	self leakCheckImageSegments ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^self objectStartingAt: segmentStart!

Item was changed:
  ----- Method: SpurMemoryManager>>setObjectFree: (in category 'free space') -----
  setObjectFree: objOop
  	"Mark an object free, but do not add it to the free lists.  The wrinkle here
  	 is that we don't tolerate a zero-slot count in a free object so that the
  	 (self long64At: objOop) ~= 0 assert in isEnumerableObject: isn't triggered."
  		 
  	(self rawNumSlotsOf: objOop) = 0 ifTrue:
+ 		[self rawNumSlotsOf: objOop put: 1].
- 		[self setRawNumSlotsOf: objOop to: 1].
  	self setFree: objOop!

Item was removed:
- ----- Method: SpurMemoryManager>>setOverflowNumSlotsOf:to: (in category 'free space') -----
- setOverflowNumSlotsOf: objOop to: numSlots
- 	self flag: #endian.
- 	self long32At: objOop - self baseHeaderSize put: numSlots!

Item was removed:
- ----- Method: SpurMemoryManager>>setRawNumSlotsOf:to: (in category 'free space') -----
- setRawNumSlotsOf: objOop to: n
- 	"Private to free space. See freeSmallObject:"
- 	self flag: #endian.
- 	self byteAt: objOop + 7 put: n!

Item was changed:
  ----- Method: StackInterpreterSimulator>>doesNotUnderstand: (in category 'error handling') -----
  doesNotUnderstand: aMessage
  	"If this is a doit and the objectMemory understands, pass it on."
  	(thisContext findContextSuchThat: [:ctxt| ctxt selector == #evaluate:in:to:notifying:ifFail:logged:]) ifNotNil:
  		[(objectMemory class whichClassIncludesSelector: aMessage selector) ifNotNil:
  			[:implementingClass|
  			(implementingClass inheritsFrom: Object) ifTrue: "i.e. VMClass and below"
+ 				[thisContext sender selector ~~ #DoIt ifTrue:
+ 					[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush].
- 				[Transcript nextPutAll: 'warning: redirecting ', aMessage selector, ' in ', thisContext sender printString, ' to objectMemory'; cr; flush.
  				 aMessage lookupClass: nil.
  				^aMessage sentTo: objectMemory]]].
  	^super doesNotUnderstand: aMessage!



More information about the Vm-dev mailing list