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

commits at source.squeak.org commits at source.squeak.org
Wed Feb 4 18:49:29 UTC 2015 

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

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

Name: VMMaker.oscog-eem.1037
Author: eem
Time: 4 February 2015, 10:48:02.497 am
UUID: 36af936c-f30f-4e91-9d1f-4b41f1122891
Ancestors: VMMaker.oscog-eem.1036

Spur image segments:
Offset class indices in objects in segment to avoid
confusion with forwarders etc.

Comment helper methods better.

Add 32-bit byte swapping for 64-bit segment support.

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

Item was added:
+ ----- Method: Spur32BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
+ byteSwapped32Bits: w
+ 	^self byteSwapped: w!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
+ byteSwapped32Bits: w
+ 	"Answer the given 32-bit integer with its bytes in the reverse order."
+ 	^  ((w bitShift: Byte3ShiftNegated) bitAnd: Byte0Mask)
+ 	 + ((w bitShift: Byte1ShiftNegated) bitAnd: Byte1Mask)
+ 	 + ((w bitShift: Byte1Shift             ) bitAnd: Byte2Mask)
+ 	 + ((w bitShift: Byte3Shift             ) bitAnd: Byte3Mask)!

Item was changed:
  ----- Method: SpurMemoryManager>>assignClassIndicesAndPinFrom:to:outPointers: (in category 'image segment in/out') -----
  assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray
+ 	"This is part of loadImageSegmentFrom:outPointers:.
+ 	 Make a final pass, assigning the real class indices and/or pinning pinned objects."
- 	"Make a final pass, assigning class indices and/or pinning pinned objects"
  	| objOop topHashBit |
  	topHashBit := 1 bitShift: self identityHashFieldWidth - 1.
  	objOop := self objectStartingAt: segmentStart.
  	[objOop < segmentLimit] whileTrue:
  		[| classRef classOop classIndex |
+ 		 "In the segment, class indices are offset indexes into the segment data,
+ 		  or into outPointers.  See mapOopsFrom:to:outPointers:outHashes:."
+ 		 classRef := (self classIndexOf: objOop) - self firstClassIndexPun.
- 		 classRef := self classIndexOf: objOop.
  		 classOop := (classRef anyMask: topHashBit)
  						ifTrue: [self fetchPointer: classRef - topHashBit ofObject: outPointerArray]
  						ifFalse: [classRef * self allocationUnit + segmentStart].
  		 classIndex := self rawHashBitsOf: classOop.
  		 self assert: (classIndex > self lastClassIndexPun
  					  and: [(self classOrNilAtIndex: classIndex) = classOop]).
  		 self setClassIndexOf: objOop to: classIndex.
  		 ((self isInNewSpace: objOop)
  		  and: [self isPinned: objOop]) ifTrue:
  			[| oldClone |
  			 oldClone := self cloneInOldSpaceForPinning: objOop.
  			 oldClone ~= 0 ifTrue:
  				[self setIsPinnedOf: oldClone to: true.
  				 self forward: objOop to: oldClone]].
  		 objOop := self objectAfter: objOop limit: segmentLimit].
  !

Item was added:
+ ----- Method: SpurMemoryManager>>byteSwapped32Bits: (in category 'snapshot') -----
+ byteSwapped32Bits: w
+ 	self subclassResponsibility!

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].
  
+ 	"Verify format.  If the format is wrong, word-swap (since ImageSegment data are 32-bit longs).
+ 	 If it is still wrong, undo the damage and fail."
- 	"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: 16rFFFFFF "low 3 bytes")) ifFalse:
+ 		[self reverseBytesIn32BitWordsFrom: 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: 16rFFFFFF "low 3 bytes")) ifFalse:
+ 			[self reverseBytesIn32BitWordsFrom: segmentWordArray + self baseHeaderSize
- 		 (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
- 			[self reverseBytesFrom: segmentWordArray + self baseHeaderSize
  				to: (self addressAfter: segmentWordArray).
+ 			 ^PrimErrBadArgument]].
- 		^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 >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) ifTrue:
- 	(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].
  	
  	self leakCheckImageSegments ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	^self objectStartingAt: segmentStart!

Item was changed:
  ----- Method: SpurMemoryManager>>mapOopsAndValidateClassRefsFrom:to:outPointers: (in category 'image segment in/out') -----
  mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray
+ 	"This is part of loadImageSegmentFrom:outPointers:.
+ 	 Scan through mapping oops and validating class references.  Defer
+ 	 entering any class objects into the class table and/or pinning objects
+ 	 until the second pass in assignClassIndicesAndPinFrom:to:outPointers:."
- 	"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."
  	| numOutPointers objOop topHashBit topOopBit |
  	numOutPointers := self numSlotsOf: outPointerArray.
  	topHashBit := 1 bitShift: self identityHashFieldWidth - 1.
  	topOopBit := 1 bitShift: self bytesPerOop * 8 - 1.
  	objOop := self objectStartingAt: segmentStart.
  	[objOop < segmentLimit] whileTrue:
  		[| classIndex hash oop mappedOop |
  		 (self isMarked: objOop) ifTrue:
  			[^PrimErrInappropriate].
+ 		 classIndex := (self classIndexOf: objOop) - self firstClassIndexPun.
- 		 classIndex := self classIndexOf: objOop.
  		 "validate the class ref, but don't update it until any internal classes have been added to the class table."
  		 (classIndex anyMask: topHashBit)
  			ifTrue:
  				[classIndex - topHashBit >= numOutPointers ifTrue:
  					[^PrimErrBadIndex].
  				 mappedOop := self fetchPointer: classIndex - topHashBit ofObject: outPointerArray.
  				 hash := self rawHashBitsOf: mappedOop.
  				 (hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = mappedOop]) ifFalse:
  					[^PrimErrInappropriate]]
  			ifFalse: "The class is contained within the segment."
  				[(oop := classIndex * self allocationUnit + segmentStart) >= segmentLimit ifTrue:
  					[^PrimErrBadIndex].
  				 (self rawHashBitsOf: oop) ~= 0 ifTrue:
  					[^PrimErrInappropriate]].
  		 0 to: (self numPointerSlotsOf: objOop) - 1 do:
  			[:i|
  			 oop := self fetchPointer: i ofObject: objOop.
  			 (self isNonImmediate: oop) ifTrue:
  				[(oop anyMask: topOopBit)
  					ifTrue:
  						[(oop := oop - topOopBit / self bytesPerOop) >= numOutPointers ifTrue:
  							[^PrimErrBadIndex].
  						 mappedOop := self fetchPointer: oop ofObject: outPointerArray]
  					ifFalse:
  						[(oop bitAnd: self allocationUnit - 1) ~= 0 ifTrue:
  							[^PrimErrInappropriate].
  						 (mappedOop := oop + segmentStart) >= segmentLimit ifTrue:
  							[^PrimErrBadIndex]].
  				 self storePointerUnchecked: i ofObject: objOop withValue: mappedOop]].
  		 objOop := self objectAfter: objOop limit: segmentLimit].
  	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>mapOopsFrom:to:outPointers:outHashes: (in category 'image segment in/out') -----
  mapOopsFrom: segStart to: segAddr outPointers: outPointerArray outHashes: savedOutHashes
+ 	"This is part of storeImageSegmentInto:outPointers:roots:.
+ 	 Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
+ 	 have had their hashes set to point to their copies in segmentWordArray.  Answer the
+ 	 outIndex if the scan succeded.  Fail if outPointers is too small and answer -1."
- 	"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
- 	 have their hashes set to point to their copies in segmentWordArray.  Answer the outIndex
- 	 if the scan succeded, otherwise answer -1.  It will fail if outPointers is too small."
  	| objOop outIndex topHashBit topOopBit |
  	outIndex := 0.
  	self fillObj: outPointerArray numSlots: (self numSlotsOf: outPointerArray) with: nilObj.
  	topHashBit := 1 bitShift: self identityHashFieldWidth - 1.
  	topOopBit := 1 bitShift: self bytesPerOop * 8 - 1.
  	objOop := self objectStartingAt: segStart.
  	[objOop < segAddr] whileTrue:
+ 		[| oop segIndex |
- 		[| oop hash |
  		 oop := self fetchClassOfNonImm: objOop.
  		 (self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
  			[outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
  			 outIndex = 0 ifTrue:"no room in outPointers; fail"
  				[^-1]].
+ 		 "Set the clone's class index to an offset index into segmentWordArray.
+ 		  Use an offset so that code cannot confuse a clone with e.g. a forwarder."
+ 		 segIndex := self rawHashBitsOf: oop.
+ 		 self setClassIndexOf: objOop to: segIndex + self firstClassIndexPun.
- 		 hash := self rawHashBitsOf: oop.
- 		 self setClassIndexOf: objOop to: hash.
  		 0 to: (self numPointerSlotsOf: objOop) - 1 do:
  			[:i|
  			 oop := self fetchPointer: i ofObject: objOop.
  			 (self isNonImmediate: oop) ifTrue:
  				[(self isMarked: oop) ifFalse: "oop is a new outPointer; allocate its oop"
  					[outIndex := self newOutPointer: oop at: outIndex in: outPointerArray hashes: savedOutHashes topHashBit: topHashBit.
  					 outIndex = 0 ifTrue: "no room in outPointers; fail"
  						[^-1]].
  				 oop := self mappedOopOf: oop topHashBit: topHashBit topOopBit: topOopBit..
  				 self storePointerUnchecked: i ofObject: objOop withValue: oop]].
  		 objOop := self objectAfter: objOop limit: segAddr].
  	^outIndex!

Item was added:
+ ----- Method: SpurMemoryManager>>reverseBytesIn32BitWordsFrom:to: (in category 'snapshot') -----
+ reverseBytesIn32BitWordsFrom: startAddr to: stopAddr
+ 	"Byte-swap the given range of memory (not inclusive of stopAddr!!)."
+ 	| addr |
+ 	addr := startAddr.
+ 	[self oop: addr isLessThan: stopAddr] whileTrue:
+ 		[self long32At: addr put: (self byteSwapped32Bits: (self long32At: addr)).
+ 		 addr := addr + self wordSize]!

More information about the Vm-dev mailing list