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

commits at source.squeak.org commits at source.squeak.org
Sat Aug 22 01:20:48 UTC 2015 

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

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

Name: VMMaker.oscog-eem.1441
Author: eem
Time: 21 August 2015, 6:18:57.387 pm
UUID: c41d605b-7d2e-4ecc-95e1-b295119106a7
Ancestors: VMMaker.oscog-eem.1440

Modify Spur ImageSegment load to become the segmentWordArray into an Array of the loaded objects if load is successful, hence decoupling ImageSegment from the assumption that objects are allocated in order.

Fix the (unused) ByteArray>>long64At: extension method to do what it advertises.

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

Item was changed:
  ----- Method: ByteArray>>long64At: (in category '*VMMaker-accessing') -----
  long64At: index
  	"Answer a 64-bit integer in Smalltalk order (little-endian)."
  	| n1 n2 |
+ 	n1 := self unsignedLongAt: index bigEndian: false.
+ 	n2 := self unsignedLongAt: index+4 bigEndian: false.
+ 	^(n2 bitShift: 32) + n1!
- 	n1 := self unsignedLongAt: index bigEndian: true.
- 	n2 := self unsignedLongAt: index+4 bigEndian: true.
- 	^(n1 bitShift: 32) + n2!

Item was removed:
- ----- 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."
- 	| objOop |
- 	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.
- 		 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>>assignClassIndicesAndPinFrom:to:outPointers:filling: (in category 'image segment in/out') -----
+ assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray filling: loadedObjectsArray
+ 	"This is part of loadImageSegmentFrom:outPointers:.
+ 	 Make a final pass, assigning the real class indices and/or pinning pinned objects."
+ 	| fillIdx objOop |
+ 	objOop := self objectStartingAt: segmentStart.
+ 	fillIdx := 0.
+ 	[objOop < segmentLimit] whileTrue:
+ 		[| classRef classOop classIndex |
+ 		 self storePointerUnchecked: fillIdx ofObject: loadedObjectsArray withValue: objOop.
+ 		 fillIdx := fillIdx + 1.
+ 		 "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.
+ 		 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 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 segmentWordArray will become an
+ 	 array of the loaded objects.  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?"
- 	 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 numLoadedObjects loadedObjectsArray |
- 	| 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."
  	segVersion := self longAt: segmentWordArray + self baseHeaderSize.
  	(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
  		[self reverseBytesIn32BitWordsFrom: 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
  				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 >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) 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 ~= 0 ifTrue:
  		[^errorCode].
+ 	numLoadedObjects := errorCode negated.
+ 	loadedObjectsArray := self allocateSlots: numLoadedObjects format: self arrayFormat classIndex: ClassArrayCompactIndex.
+ 	loadedObjectsArray ifNil:
+ 		[^PrimErrNoMemory].
  
  	"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 and collecting the loaded objects in loadedObjectsArray"
+ 	self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray filling: loadedObjectsArray.
- 	"Make a final pass, assigning class indices and/or pinning pinned objects"
- 	self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
  
+ 	"Evaporate the container, leaving the newly loaded objects in place."
- 	"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].
+ 
+ 	"Finally forward the segmentWordArray to the loadedObjectsArray"
+ 	self forward: segmentWordArray to: loadedObjectsArray.
  	
  	self runLeakCheckerFor: GCModeImageSegment.
  
  	^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:."
+ 	| numOutPointers numSegObjs objOop |
- 	| numOutPointers objOop |
  	numOutPointers := self numSlotsOf: outPointerArray.
+ 	numSegObjs := 0.
  	objOop := self objectStartingAt: segmentStart.
  	[objOop < segmentLimit] whileTrue:
  		[| classIndex hash oop mappedOop |
+ 		 numSegObjs := numSegObjs + 1.
  		 (self isMarked: objOop) ifTrue:
  			[^PrimErrInappropriate].
  		 classIndex := (self classIndexOf: objOop) - self firstClassIndexPun.
  		 "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].
+ 	^numSegObjs negated!
- 	^0!

More information about the Vm-dev mailing list