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

commits at source.squeak.org commits at source.squeak.org
Mon May 6 22:00:10 UTC 2013 

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

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

Name: VMMaker.oscog-eem.287
Author: eem
Time: 6 May 2013, 2:57:40.075 pm
UUID: 11b3f2a0-e1f5-47f5-b57e-52c93081cefe
Ancestors: VMMaker.oscog-dtl.286

Fix mistaken use of MFrameSlots in StackInterpreter>>
interpreterAllocationReserveBytes.
Some asserts in the allocation routines to attempt to catch what 
appeared to have been a compiler bug.
Use addressCouldBeObj: in oopHasAcceptableClass:.

=============== Diff against VMMaker.oscog-dtl.286 ===============

Item was added:
+ ----- Method: CoInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
+ interpreterAllocationReserveBytes
+ 	"At a rough approximation we may need to allocate up to a couple
+ 	 of page's worth of contexts when switching stack pages, assigning
+ 	 to senders, etc.  But the snapshot primitive voids all stack pages.
+ 	 So a safe margin is the size of a large context times the maximum
+ 	 number of frames per page times the number of pages."
+ 	| maxUsedBytesPerPage maxFramesPerPage |
+ 	maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset.
+ 	maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots.
+ 	^maxFramesPerPage * LargeContextSize * numStackPages!

Item was changed:
  ----- Method: NewObjectMemory>>allocate:headerSize:h1:h2:h3:doFill:format: (in category 'allocation') -----
  allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOopArg h3: extendedSize doFill: doFill format: format
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes space for the base header word.) Initialize the header fields of the new object and fill the remainder of the object with a value appropriate for the format.
  	May cause a GC"
  
  	| newObj classOop |
  	<inline: true>
+ 	<var: #i type: #usqInt>
+ 	<var: #end type: #usqInt>
- 	<var: #i type: 'usqInt'>
- 	<var: #end type: 'usqInt'>
  	newObj := self allocateChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	newObj = 0
  		ifTrue:
  			["remap classOop because GC may move the classOop"
  			hdrSize > 1 ifTrue: [self pushRemappableOop: classOopArg].
  			newObj := self allocateChunkAfterGC: byteSize + (hdrSize - 1 * BytesPerWord).
  			hdrSize > 1 ifTrue: [classOop := self popRemappableOop].
  			newObj = 0 ifTrue: [^newObj]]
  		ifFalse: [classOop := classOopArg].
  
  	hdrSize = 3 ifTrue:
  		[self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + BytesPerWord put: (classOop bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  		 newObj := newObj + (BytesPerWord*2)].
  
  	hdrSize = 2 ifTrue:
  		[self longAt: newObj put: (classOop bitOr: HeaderTypeClass).
  		 self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  		 newObj := newObj + BytesPerWord].
  
  	hdrSize = 1 ifTrue:
  		[self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  
  	"clear new object"
  	doFill ifTrue:
  		[| fillWord end i |
  		 fillWord := format <= 4
+ 						ifTrue: [nilObj] "if pointers, fill with nil oop"
+ 						ifFalse: [0].
- 					ifTrue: [nilObj] "if pointers, fill with nil oop"
- 					ifFalse: [0].
  		 end := newObj + byteSize.
+ 		 i := newObj + BytesPerWord. "skip header"
- 		 i := newObj + BytesPerWord.
  		 [i < end] whileTrue:
  			[self longAt: i put: fillWord.
+ 			 i := i + BytesPerWord].
+ 		 self assert: i = freeStart.].
- 			 i := i + BytesPerWord]].
  	DoExpensiveAssertionChecks ifTrue:
  		[self okayOop: newObj.
  		 self oopHasOkayClass: newObj.
  		 (self safeObjectAfter: newObj) = freeStart ifFalse:
  			[self error: 'allocate bug: did not set header of new oop correctly']].
  
  	^newObj!

Item was changed:
  ----- Method: NewObjectMemory>>eeAllocate:headerSize:h1:h2:h3: (in category 'allocation') -----
  eeAllocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes
+ 	 space for the base header word.) Initialize the header fields of the new object.
+ 	 Does *not* initialize the objects' fields. Will *not* cause a GC.  This version is for the execution engine's use only."
- 	 space for the base header word.) Initialize the header fields of the new object and fill the remainder of
- 	 the object with the given value.  Will not cause a GC.  This version is for the execution engine"
  
  	| newObj |
  	<inline: true>
  	<asmLabel: false>
+ 	<var: #i type: #usqInt>
+ 	<var: #end type: #usqInt>
- 	<var: #i type: 'usqInt'>
- 	<var: #end type: 'usqInt'>
  	newObj := self allocateInterpreterChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	newObj = 0 ifTrue: [^newObj].
  	hdrSize = 3 ifTrue:
  		[self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + BytesPerWord put: (classOop bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  		 newObj := newObj + (BytesPerWord*2)].
  
  	 hdrSize = 2 ifTrue:
  		[self longAt: newObj put: (classOop bitOr: HeaderTypeClass).
  		 self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  		 newObj := newObj + BytesPerWord].
  
  	 hdrSize = 1 ifTrue:
  		[self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  
  	DoExpensiveAssertionChecks ifTrue:
  		[self okayOop: newObj.
  		 self oopHasOkayClass: newObj.
  		 (self safeObjectAfter: newObj) = freeStart ifFalse:
  			[self error: 'allocate bug: did not set header of new oop correctly']].
  
  	^newObj!

Item was changed:
  ----- Method: NewObjectMemory>>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 zero.  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?"
  
  	| endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data |
  	<inline: false>
  	<var: #endSeg type: #usqInt>
  	<var: #segOop type: #usqInt>
  	<var: #fieldPtr type: #usqInt>
  	<var: #lastOut type: #usqInt>
  	<var: #outPtr type: #usqInt>
  	<var: #lastPtr type: #usqInt>
  
  	DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  	lastOut := outPointerArray + (self lastPointerOf: outPointerArray).
  	endSeg := segmentWordArray + (self sizeBitsOf: segmentWordArray) - BaseHeaderSize.
  
  	"Version check.  Byte order of the WordArray now"
  	data := self longAt: segmentWordArray + BaseHeaderSize.
+ 	(coInterpreter readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
- 	(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
  		"Not readable -- try again with reversed bytes..."
  		[self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord.
  		data := self longAt: segmentWordArray + BaseHeaderSize.
+ 		(coInterpreter readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
- 		(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
  			"Still NG -- put things back and fail"
  			[self reverseBytesFrom: segmentWordArray + BaseHeaderSize to: endSeg + BytesPerWord.
  			DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  			^0]].
  	"Reverse the Byte type objects if the data is from opposite endian machine.
  	 Revese the words in Floats if from an earlier version with different Float order.
  	 Test top byte.  $d on the Mac or $s on the PC.  Rest of word is equal."
  	(data >> 16) = (self imageSegmentVersion >> 16)
  		ifTrue:
  			"Need to swap floats if the segment is being loaded into a little-endian VM from a version
  			 that keeps Floats in big-endian word order as was the case prior to the 6505 image format."
  			[(self isPlatformFloatOrderVersion: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse:
  				[self vmEndianness ~= 1 "~= 1 => little-endian" ifTrue:
  					[segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord.
  					 self wordSwapFloatsFrom: segOop to: endSeg + BytesPerWord]]]
  		ifFalse: "Reverse the byte-type objects once"
  			[segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord.
  				 "Oop of first embedded object"
  			self byteSwapByteObjectsFrom: segOop
  				to: endSeg + BytesPerWord
  				flipFloatsIf: (self isPlatformFloatOrderVersion: (data bitAnd: 16rFFFF "low 2 bytes"))].
  
  	"Proceed through the segment, remapping pointers..."
  	segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord.
  	[segOop <= endSeg] whileTrue:
  		[(self headerType: segOop) <= 1
  			ifTrue: ["This object has a class field (type = 0 or 1) -- start with that."
  					fieldPtr := segOop - BytesPerWord.  doingClass := true]
  			ifFalse: ["No class field -- start with first data field"
  					fieldPtr := segOop + BaseHeaderSize.  doingClass := false].
  		lastPtr := segOop + (self lastPointerOf: segOop).	"last field"
  		lastPtr > endSeg ifTrue:
  			[DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  			^0 "out of bounds"].
  
  		"Go through all oops, remapping them..."
  		[fieldPtr > lastPtr] whileFalse:
  			["Examine each pointer field"
  			fieldOop := self longAt: fieldPtr.
  			doingClass ifTrue:
  				[hdrTypeBits := self headerType: fieldPtr.
  				fieldOop := fieldOop - hdrTypeBits].
  			(self isIntegerObject: fieldOop)
  				ifTrue:
  					["Integer -- nothing to do"
  					fieldPtr := fieldPtr + BytesPerWord]
  				ifFalse:
  					[(fieldOop bitAnd: 3) = 0 ifFalse:
  						[^0 "bad oop"].
  					(fieldOop bitAnd: 16r80000000) = 0
  						ifTrue: ["Internal pointer -- add segment offset"
  								mapOop := fieldOop + segmentWordArray]
  						ifFalse: ["External pointer -- look it up in outPointers"
  								outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF).
  								outPtr > lastOut ifTrue:
  									[^0 "out of bounds"].
  								mapOop := self longAt: outPtr].
  					doingClass
  						ifTrue: [self longAt: fieldPtr put: mapOop + hdrTypeBits.
  								fieldPtr := fieldPtr + 8.
  								doingClass := false]
  						ifFalse: [self longAt: fieldPtr put: mapOop.
  								fieldPtr := fieldPtr + BytesPerWord].
  					segOop < youngStart ifTrue:
  						[self possibleRootStoreInto: segOop value: mapOop]]].
  		segOop := self objectAfter: segOop].
  
  	"Again, proceed through the segment checking consistency..."
  	segOop := self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord.
  	[segOop <= endSeg] whileTrue:
  		[(self oopHasAcceptableClass: segOop) ifFalse:
  			[^0 "inconsistency"].
  		fieldPtr := segOop + BaseHeaderSize.		"first field"
  		lastPtr := segOop + (self lastPointerOf: segOop).	"last field"
  		"Go through all oops, remapping them..."
  		[fieldPtr > lastPtr] whileFalse:
  			["Examine each pointer field"
  			fieldOop := self longAt: fieldPtr.
  			(self oopHasAcceptableClass: fieldOop) ifFalse:
  				[^0 "inconsistency"].
  			fieldPtr := fieldPtr + BytesPerWord].
  		segOop := self objectAfter: segOop].
  
  	"Truncate the segment word array to size = BytesPerWord (vers stamp only)"
  	extraSize := self extraHeaderBytes: segmentWordArray.
  	hdrTypeBits := self headerType: segmentWordArray.
  	extraSize = 8
  		ifTrue: [self longAt: segmentWordArray-extraSize put: BaseHeaderSize + BytesPerWord + hdrTypeBits]
  		ifFalse: [header := self longAt: segmentWordArray.
  				self longAt: segmentWordArray
  					put: header - (header bitAnd: SizeMask) + BaseHeaderSize + BytesPerWord].	
  	"and return the roots array which was first in the segment"
  	DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  	^self oopFromChunk: segmentWordArray + BaseHeaderSize + BytesPerWord!

Item was changed:
  ----- Method: NewObjectMemory>>oopHasAcceptableClass: (in category 'image segment in/out') -----
  oopHasAcceptableClass: signedOop
  	"Similar to oopHasOkayClass:, except that it only returns true or false."
  
  	| oopClass formatMask behaviorFormatBits oopFormatBits oop |
  	<var: #oop type: #usqInt>
  	<var: #oopClass type: #usqInt>
  
  	(self isIntegerObject: signedOop) ifTrue: [^ true].
  
  	oop := self cCoerce: signedOop to: #usqInt.
+ 	(self addressCouldBeObj: oop) ifFalse: [^ false].
  
- 	oop < freeStart ifFalse: [^ false].
- 	((oop \\ BytesPerWord) = 0) ifFalse: [^ false].
- 	(oop + (self sizeBitsOf: oop)) <= freeStart ifFalse: [^ false].
  	oopClass := self cCoerce: (self fetchClassOfNonInt: oop) to: #usqInt.
+ 	(self addressCouldBeObj: oopClass) ifFalse: [^ false].
- 
- 	(self isIntegerObject: oopClass) ifTrue: [^ false].
- 	(oopClass < freeStart) ifFalse: [^ false].
- 	((oopClass \\ BytesPerWord) = 0) ifFalse: [^ false].
  	(oopClass + (self sizeBitsOf: oopClass)) <= freeStart ifFalse: [^ false].
+ 
  	((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
+ 
  	formatMask := (self isBytesNonInt: oop)
  						ifTrue: [16rC00]  "ignore extra bytes size bits"
  						ifFalse: [16rF00].
  
  	behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
  	oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
  	behaviorFormatBits = oopFormatBits ifFalse: [^ false].
  	^ true!

Item was changed:
  ----- Method: ObjectMemory>>oopHasAcceptableClass: (in category 'image segment in/out') -----
  oopHasAcceptableClass: signedOop
  	"Similar to oopHasOkayClass:, except that it only returns true or false."
  
  	| oopClass formatMask behaviorFormatBits oopFormatBits oop |
  	<var: #oop type: #usqInt>
  	<var: #oopClass type: #usqInt>
  
  	(self isIntegerObject: signedOop) ifTrue: [^ true].
  
  	oop := self cCoerce: signedOop to: #usqInt.
+ 	(self addressCouldBeObj: oop) ifFalse: [^ false].
  
- 	oop < freeBlock ifFalse: [^ false].
- 	((oop \\ BytesPerWord) = 0) ifFalse: [^ false].
- 	(oop + (self sizeBitsOf: oop)) < freeBlock ifFalse: [^ false].
  	oopClass := self cCoerce: (self fetchClassOfNonInt: oop) to: #usqInt.
+ 	(self addressCouldBeObj: oopClass) ifFalse: [^ false].
- 
- 	(self isIntegerObject: oopClass) ifTrue: [^ false].
- 	(oopClass < freeBlock) ifFalse: [^ false].
- 	((oopClass \\ BytesPerWord) = 0) ifFalse: [^ false].
  	(oopClass + (self sizeBitsOf: oopClass)) < freeBlock ifFalse: [^ false].
+ 
  	((self isPointersNonInt: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
- 	(self isBytesNonInt: oop)
- 		ifTrue: [ formatMask := 16rC00 ]  "ignore extra bytes size bits"
- 		ifFalse: [ formatMask := 16rF00 ].
  
+ 	formatMask := (self isBytesNonInt: oop)
+ 						ifTrue: [16rC00]  "ignore extra bytes size bits"
+ 						ifFalse: [16rF00].
+ 
  	behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
  	oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
  	behaviorFormatBits = oopFormatBits ifFalse: [^ false].
  	^ true!

Item was changed:
  ----- Method: StackInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
  interpreterAllocationReserveBytes
  	"At a rough approximation we may need to allocate up to a couple
  	 of page's worth of contexts when switching stack pages, assigning
  	 to senders, etc.  But the snapshot primitive voids all stack pages.
  	 So a safe margin is the size of a large context times the maximum
  	 number of frames per page times the number of pages."
  	| maxUsedBytesPerPage maxFramesPerPage |
  	maxUsedBytesPerPage := self stackPageFrameBytes + self stackLimitOffset.
+ 	maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // FrameSlots.
- 	maxFramesPerPage := maxUsedBytesPerPage / BytesPerWord // MFrameSlots.
  	^maxFramesPerPage * LargeContextSize * numStackPages!

More information about the Vm-dev mailing list