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

commits at source.squeak.org commits at source.squeak.org
Wed Sep 25 07:10:35 UTC 2013


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

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

Name: VMMaker.oscog-eem.410
Author: eem
Time: 25 September 2013, 12:05:46.443 am
UUID: 44528c31-6609-4ea6-8817-4935e5166568
Ancestors: VMMaker.oscog-eem.409

Fix bug in SpurMemMgr>>allocateOldSpaceChunkOfBytes: so it won't
try to create slivers of size 8 byets when splitting free chunks.

Fix nonIndexablePointerFormat to answer the right value.

Explicitly comment the result guaranteed to be young property of
the eeInstantiate* routines.

Implement allocateNewSpaceSlots:format:classIndex: for SpurMemMgr
& implement its eeInstantiate* routines using it.

Adapt createActualMessage: to Spur (fast alloc given class indices).

Eliminate padding from shortPrintOop:

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

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateClassIndex:format:numSlots: (in category 'interpreter access') -----
  eeInstantiateClassIndex: compactClassIndex format: objFormat numSlots: numSlots
  	"Instantiate an instance of a compact class.  ee stands for execution engine and
  	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
  	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ 	 call is used in routines that do just that we are safe.  Break this rule and die in GC.
+ 	 Result is guaranteed to be young."
- 	 call is used in routines that do just that we are safe.  Break this rule and die in GC."
  	<api>
  	| hash header1 header2 byteSize header3 hdrSize |
  	<inline: false>
  	"cannot have a negative indexable field count"
  	self assert: (numSlots >= 0 and: [compactClassIndex ~= 0]).
  	self assert: (objFormat < self firstByteFormat
  					ifTrue: [objFormat]
  					ifFalse: [objFormat bitAnd: self byteFormatMask])
  				= (self instSpecOfClass: (self compactClassAt: compactClassIndex)).
  	hash := self newObjectHash.
  	"Low 2 bits are 0"
  	header1 := (objFormat << self instFormatFieldLSB
  					bitOr: compactClassIndex << 12)
  					bitOr: (hash bitAnd: HashMaskUnshifted) << HashBitsOffset.
  	self assert: "sizeHiBits" ((self formatOfClass: (self compactClassAt: compactClassIndex)) bitAnd: 16r60000) >> 9 = 0.
  	self flag: #sizeLowBits.
  	"size in bytes -- low 2 bits are 0; may need another shift if 64-bits.
  	 strangely, size includes size of header, but only of single header.
  	 why include header size at all?  gives us an extra word."
  	byteSize := numSlots << (ShiftForWord + (ShiftForWord-2)) + BaseHeaderSize.
  	(BytesPerWord = 8 "David, please check this!!!!"
  	 and: [objFormat >= self firstLongFormat "32-bit longs and byte objects"
  	 and: [(numSlots bitAnd: 1) ~= 0]]) ifTrue:
  		["extra low bit (4) for 64-bit VM goes in 4-bit (betw hdr bits and sizeBits)"
  		 header1 := header1 bitOr: 4].
  	byteSize > 255 "requires size header word/full header"
  		ifTrue: [header3 := byteSize. hdrSize := 3. header2 := self compactClassAt: compactClassIndex]
  		ifFalse: [header1 := header1 bitOr: byteSize. hdrSize := 1].
  	^self eeAllocate: byteSize headerSize: hdrSize h1: header1 h2: header2 h3: header3!

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateMethodContextSlots: (in category 'interpreter access') -----
  eeInstantiateMethodContextSlots: numSlots 
  	"This version of instantiateClass assumes that the total object 
  	 size is under 256 bytes, the limit for objects with only one or 
  	 two header words. Note that the size is specified in bytes 
  	 and should include four bytes for the base header word.
+ 	 Will *not* cause a GC. Result is guaranteed to be young."
- 	 Will *not* cause a GC."
  	| sizeInBytes hash header1 |
  	self assert: (numSlots = SmallContextSlots or: [numSlots = LargeContextSlots]).
  	sizeInBytes := numSlots * BytesPerOop + BaseHeaderSize.
  	self assert: sizeInBytes <= SizeMask.
  	hash := self newObjectHash.
  	header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: self formatOfMethodContextMinusSize.
  	self assert: (header1 bitAnd: CompactClassMask) > 0. "contexts must be compact"
  	self assert: (header1 bitAnd: SizeMask) = 0.
  	"OR size into header1.  Must not do this if size > SizeMask"
  	header1 := header1 + sizeInBytes.
  	^self eeAllocate: sizeInBytes headerSize: 1 h1: header1 h2: nil h3: nil!

Item was changed:
  ----- Method: NewObjectMemory>>eeInstantiateSmallClass:numSlots: (in category 'interpreter access') -----
  eeInstantiateSmallClass: classPointer numSlots: numSlots
+ 	"This version of instantiateClass assumes that the total object size is under
+ 	 256 bytes, the limit for objects with only one or two header words. 
- 	"This version of instantiateClass assumes that the total object
- 	 size is under 256 bytes, the limit for objects with only one or
- 	 two header words. 
  	 NOTE this code will only work for sizes that are an integral number of words
+ 		(hence not a 32-bit LargeInteger in a 64-bit system).
- 		(like not a 32-bit LargeInteger in a 64-bit system).
- 	 Will *not* cause a GC.
  	 Note that the created small object IS NOT FILLED and must be completed before returning it to Squeak.
+ 	 Since this call is used in routines that do just that we are safe. Break this rule and die in GC.
+ 	 Will *not* cause a GC. Result is guaranteed to be young."
- 	 Since this call is used in routines that do just that we are safe. Break this rule and die."
  
  	| sizeInBytes hash header1 header2 hdrSize |
  	sizeInBytes := numSlots << ShiftForWord + BaseHeaderSize.
  	self assert: sizeInBytes <= 252.
  	hash := self newObjectHash.
  	header1 := (hash bitAnd: HashMaskUnshifted) << HashBitsOffset bitOr: (self formatOfClass: classPointer).
  	header2 := classPointer.
  	hdrSize := (header1 bitAnd: CompactClassMask) > 0 "is this a compact class"
  				ifTrue: [1]
  				ifFalse: [2].
  	header1 := header1 + (sizeInBytes - (header1 bitAnd: SizeMask+Size4Bit)).
  	^self eeAllocate: sizeInBytes headerSize: hdrSize h1: header1 h2: header2 h3: 0!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>scavengingGC (in category 'generation scavenging') -----
  scavengingGC
  	"Run the scavenger."
+ 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ 													ifTrue: ['th']
+ 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
- 	self halt: (statScavenges + 1) printString, (#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th'), ' scavenge'.
  	^super scavengingGC!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
+ 	| numBytes newObj |
+ 	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceeding word).
+ 	 Objects always have at least one slot, for the forwarding pointer,
+ 	 and are multiples of 8 bytes in length."
+ 	numSlots >= self numSlotsMask
+ 		ifTrue:
+ 			[newObj := freeStart + self baseHeaderSize.
+ 			 numBytes := self baseHeaderSize + self baseHeaderSize "double header"
+ 						+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
+ 		ifFalse:
+ 			[newObj := freeStart.
+ 			 numBytes := self baseHeaderSize "single header"
+ 						+ (numSlots <= 1
+ 							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ 							ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
+ 	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 freeStart + numBytes > scavenger eden limit ifTrue:
+ 			[^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']].
+ 	numSlots >= self numSlotsMask
+ 		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ 			[self flag: #endianness.
+ 			 self longAt: freeStart put: numSlots.
+ 			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
+ 			 self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ 		ifFalse:
+ 			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ 	self assert: numBytes \\ self allocationUnit = 0.
+ 	self assert: newObj \\ self allocationUnit = 0.
+ 	freeStart := freeStart + numBytes.
+ 	^newObj!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
+ 	| numBytes newObj |
+ 	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 	 16 bytes otherwise (num slots in preceeding word).
+ 	 Objects always have at least one slot, for the forwarding pointer,
+ 	 and are multiples of 8 bytes in length."
+ 	numSlots >= self numSlotsMask
+ 		ifTrue:
+ 			[numSlots > 16rffffffff ifTrue:
+ 				[^nil].
+ 			 newObj := freeStart + self baseHeaderSize.
+ 			 numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
+ 						+ (numSlots * self bytesPerSlot)]
+ 		ifFalse:
+ 			[newObj := freeStart.
+ 			 numBytes := self baseHeaderSize "single header"
+ 						+ (numSlots < 1
+ 							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ 							ifFalse: [numSlots * self bytesPerSlot])].
+ 	
+ 	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 freeStart + numBytes > scavenger eden limit ifTrue:
+ 			[^self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:']].
+ 	numSlots >= self numSlotsMask
+ 		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ 			[self flag: #endianness.
+ 			 self longAt: freeStart put: numSlots.
+ 			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
+ 			 self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ 		ifFalse:
+ 			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ 	self assert: numBytes \\ self allocationUnit = 0.
+ 	self assert: newObj \\ self allocationUnit = 0.
+ 	freeStart := freeStart + numBytes.
+ 	^newObj!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
+ allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes
  	"Answer a chunk of oldSpace from the free lists, if available,
  	 otherwise answer nil.  N.B.  the chunk is simply a pointer, it has
  	 no valid header.  The caller *must* fill in the header correctly."
  	| initialIndex chunk index nodeBytes parent child smaller larger |
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	initialIndex := chunkBytes / self allocationUnit.
  	(initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
  		[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
  			[self assert: chunk = (self startOfObject: chunk).
  			^self unlinkFreeChunk: chunk atIndex: initialIndex].
  		 freeListsMask := freeListsMask - (1 << initialIndex).
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 index := initialIndex.
  		 [(index := index + index) < NumFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[((freeListsMask anyMask: 1 << index)
  			 and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
  				[self assert: chunk = (self startOfObject: chunk).
  				 self unlinkFreeChunk: chunk atIndex: index.
  				 self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
  				 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes.
  				^chunk]].
+ 		 "now get desperate and use the first that'll fit.
+ 		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
+ 		  leave room for the forwarding pointer/next free link, we can only break chunks
+ 		  that are at least 16 bytes larger, hence start at initialIndex + 2."
+ 		 index := initialIndex + 1.
- 		 "now get desperate and use the first that'll fit"
- 		 index := initialIndex.
  		 [(index := index + 1) < NumFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self unlinkFreeChunk: chunk atIndex: index.
  					 self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
  					 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  						at: (self startOfObject: chunk) + chunkBytes.
  					^chunk].
  				 freeListsMask := freeListsMask - (1 << index)]]].
  
  	"Large chunk, or no space on small free lists.  Search the large chunk list.
  	 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.
  	 When the search ends parent should hold the smallest chunk at least as
  	 large as chunkBytes, or 0 if none."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[| childBytes |
  		 self assert: (self isFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
  			[chunk := self fetchPointer: self freeChunkNextIndex
  							ofFreeChunk: child.
  			 chunk ~= 0 ifTrue:
  				[self storePointer: self freeChunkNextIndex
  					ofFreeChunk: child
  					withValue: (self fetchPointer: self freeChunkNextIndex
  									ofFreeChunk: chunk).
  				 ^self startOfObject: chunk].
  			 child := 0]. "break out of loop to remove interior node"
  		childBytes < chunkBytes
  			ifTrue: "walk down the tree"
  				[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
  			ifFalse:
  				[parent := child.
  				 nodeBytes := childBytes.
  				 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]].
  	parent = 0 ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  		 self halt].
  
  	"self printFreeChunk: parent"
  	self assert: nodeBytes >= chunkBytes.
  	self assert: (self bytesInObject: parent) = nodeBytes.
  
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex
  					ofFreeChunk: parent.
  	chunk ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: parent
  			withValue: (self fetchPointer: self freeChunkNextIndex
  							ofFreeChunk: chunk).
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
  
  	"no list; remove an interior node; reorder tree simply.  two cases (which have mirrors, for four total):
  	 case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| S |
  		 _/_
  		 | S |
  
  	 case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
  	 add the left subtree to the bottom left of the right subtree (mirrored for large vs small) 
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| R |
  		 _/_  _\_		    _/_
  		 | L | | R |		    | L |"
  
  	chunk := parent.
  	smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
  	larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
  	parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
  	parent = 0
  		ifTrue: "no parent; stitch the subnodes back into the root"
  			[smaller = 0
  				ifTrue: [freeLists at: 0 put: larger]
  				ifFalse:
  					[freeLists at: 0 put: smaller.
  					 larger ~= 0 ifTrue:
  						[self addFreeSubTree: larger]]]
  		ifFalse: "parent; stitch back into appropriate side of parent."
  			[smaller = 0
  				ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
  											ifTrue: [self freeChunkSmallerIndex]
  											ifFalse: [self freeChunkLargerIndex])
  							ofFreeChunk: parent
  							withValue: larger]
  				ifFalse:
  					[self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
  											ifTrue: [self freeChunkSmallerIndex]
  											ifFalse: [self freeChunkLargerIndex])
  							ofFreeChunk: parent
  							withValue: smaller.
  					 larger ~= 0 ifTrue:
  						[self addFreeSubTree: larger]]].
  	"if there's space left over, add the fragment back."
  	chunkBytes ~= nodeBytes ifTrue:
  		[self freeChunkWithBytes: nodeBytes - chunkBytes
  				at: (self startOfObject: chunk) + chunkBytes].
  	^self startOfObject: chunk!

Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateClassIndex:format:numSlots: (in category 'allocation') -----
  eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots
  	"Instantiate an instance of a compact class.  ee stands for execution engine and
  	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
  	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ 	 call is used in routines that do just that we are safe.  Break this rule and die in GC.
+ 	 Result is guaranteed to be young."
- 	 call is used in routines that do just that we are safe.  Break this rule and die in GC."
  	<inline: true>
  	self assert: (numSlots > 0 and: [knownClassIndex ~= 0]).
  	self assert: (objFormat < self firstByteFormat
  					ifTrue: [objFormat]
  					ifFalse: [objFormat bitAnd: self byteFormatMask])
  				= (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)).
+ 	^self allocateNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex!
- 	^self allocateSlots: numSlots format: objFormat classIndex: knownClassIndex!

Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateMethodContextSlots: (in category 'allocation') -----
  eeInstantiateMethodContextSlots: numSlots
+ 	"Allocate a new MethodContext.  ee stands for execution engine and
+ 	 implies that this allocation will *NOT* cause a GC.  N.B. the instantiated object
+ 	 IS NOT FILLED and must be completed before returning it to Smalltalk. Since this
+ 	 call is used in routines that do just that we are safe.  Break this rule and die in GC.
+ 	 Result is guaranteed to be young."
  	<inline: true>
+ 	<inline: true>
  	^self
+ 		allocateNewSpaceSlots: numSlots
- 		allocateSlots: numSlots
  		format: self indexablePointersFormat
  		classIndex: ClassMethodContextCompactIndex!

Item was changed:
+ ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>eeInstantiateSmallClass:numSlots: (in category 'allocation') -----
  eeInstantiateSmallClass: classObj numSlots: numSlots
+ 	"Instantiate an instance of a class, with only a few slots.  ee stands for execution
+ 	 engine and implies that this allocation will *NOT* cause a GC.  N.B. the instantiated
+ 	 object IS NOT FILLED and must be completed before returning it to Smalltalk. Since
+ 	 this call is used in routines that do just that we are safe.  Break this rule and die in GC.
+ 	 Result is guaranteed to be young."
  	| classIndex |
  	<inline: true>
  	classIndex := self ensureBehaviorHash: classObj.
  	^self
  		eeInstantiateClassIndex: classIndex
  		format: (self instSpecOfClass: classObj)
  		numSlots: numSlots!

Item was changed:
  ----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
  enterIntoClassTable: aBehavior
  	"Enter aBehavior into the class table and answer 0.  Otherwise answer a primitive failure code."
+ 	<inline: false>
  	| initialMajorIndex majorIndex minorIndex page |
  	majorIndex := classTableIndex >> self classTableMajorIndexShift.
  	initialMajorIndex := majorIndex.
  	"classTableIndex should never index the first page; it's reserved for known classes"
  	self assert: initialMajorIndex > 0.
  	minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
  
  	[page := self fetchPointer: majorIndex ofObject: classTableRootObj.
  	 page = nilObj ifTrue:
  		[page := self allocateSlotsInOldSpace: self classTablePageSize
  					format: self arrayFormat
  					classIndex: self arrayClassIndexPun.
  		 page ifNil:
  			[^PrimErrNoMemory].
  		 self fillObj: page numSlots: self classTablePageSize with: nilObj.
  		 self storePointer: majorIndex
  			ofObject: classTableRootObj
  			withValue: page.
  		 minorIndex := 0].
  	 minorIndex to: self classTablePageSize - 1 do:
  		[:i|
  		(self fetchPointer: i ofObject: page) = nilObj ifTrue:
  			[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
  			 self storePointer: i
  				ofObject: page
  				withValue: aBehavior.
  			 self setHashBitsOf: aBehavior to: classTableIndex.
  			 self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
  			 "now fault-in method lookup chain."
  			 self scanClassPostBecome: aBehavior
  				effects: BecamePointerObjectFlag+BecameCompiledMethodFlag.
  			 ^0]].
  	 majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
  	 majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
  		[^PrimErrLimitExceeded]] repeat!

Item was changed:
+ ----- Method: SpurMemoryManager>>instantiateClass: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>instantiateClass: (in category 'allocation') -----
  instantiateClass: classObj
  	| instSpec classFormat numSlots classIndex newObj |
  	classFormat := self formatOfClass: classObj.
  	instSpec := self instSpecOfClassFormat: classFormat.
  	(self isFixedSizePointerFormat: instSpec) ifFalse:
  		[^nil].
  	classIndex := self ensureBehaviorHash: classObj.
  	classIndex < 0 ifTrue:
  		[coInterpreter primitiveFailFor: classIndex negated.
  		 ^nil].
  	numSlots := self fixedFieldsOfClassFormat: classFormat.
  	newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
  	newObj ifNotNil:
  		[self fillObj: newObj numSlots: numSlots with: nilObj].
  	^newObj!

Item was changed:
+ ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
  instantiateClass: classObj indexableSize: nElements
  	^self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	| sel |
  	sel := thisContext sender method selector.
  	(#(	DoIt
  		DoItIn:
  		on:do: "from the debugger"
  		makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		objCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		bytecodePrimAtPut
  		commonAt:
  		commonAtPut:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
  		primitiveContextAtPut
  		subscript:with:storing:format:
  		printContext:
  		compare31or32Bits:equal:
  		signed64BitValueOf:
  		primDigitMultiply:negative:
  		digitLength:
  		isNegativeIntegerValueOf:
  		magnitude64BitValueOf:
  		primitiveMakePoint
  		primitiveAsCharacter
  		primitiveInputSemaphore
  		baseFrameReturn
  		primitiveExternalCall
  		primDigitCompare:
  		isLiveContext:
  		numPointerSlotsOf:
  		fileValueOf:
  		loadBitBltDestForm
  		fetchIntOrFloat:ofObject:ifNil:
  		fetchIntOrFloat:ofObject:
  		loadBitBltSourceForm
  		loadPoint:from:
  		primDigitAdd:
  		primDigitSubtract:
  		positive64BitValueOf:
  		digitBitLogic:with:opIndex:
  		signed32BitValueOf:
  		isNormalized:
+ 		primDigitDiv:negative:
+ 		bytesOrInt:growTo:) includes: sel) ifFalse:
- 		primDigitDiv:negative:) includes: sel) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>nonIndexablePointerFormat (in category 'header format') -----
  nonIndexablePointerFormat
+ 	^1!
- 	^2!

Item was changed:
  ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
  createActualMessageTo: lookupClass 
  	"Bundle up the selector, arguments and lookupClass into a Message object. 
  	 In the process it pops the arguments off the stack, and pushes the message object. 
  	 This can then be presented as the argument of e.g. #doesNotUnderstand:"
  	| argumentArray message |
  	<inline: false> "This is a useful break-point"
  	self assert: ((objectMemory isImmediate: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
+ 	objectMemory hasSpurMemoryManagerAPI
+ 		ifTrue:
+ 			[argumentArray := objectMemory
+ 								eeInstantiateClassIndex: ClassArrayCompactIndex
+ 								format: objectMemory arrayFormat
+ 								numSlots: argumentCount.
+ 			 message := objectMemory
+ 								eeInstantiateClassIndex: ClassMessageCompactIndex
+ 								format: objectMemory nonIndexablePointerFormat
+ 								numSlots: MessageLookupClassIndex + 1]
+ 		ifFalse:
+ 			[argumentArray := objectMemory
+ 								eeInstantiateClass: (objectMemory splObj: ClassArray)
+ 								indexableSize: argumentCount.
+ 			 message := objectMemory
+ 								eeInstantiateClass: (objectMemory splObj: ClassMessage)
+ 								indexableSize: 0].
- 	argumentArray := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
- 	message := objectMemory eeInstantiateClass: (objectMemory splObj: ClassMessage) indexableSize: 0.
  
  	"Since the array is new can use unchecked stores."
+ 	(argumentCount - 1) * BytesPerOop to: 0 by: BytesPerOop negated do:
- 	(argumentCount - 1) * BytesPerWord to: 0 by: BytesPerWord negated do:
  		[:i|
  		self longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
  	"Since message is new can use unchecked stores."
  	objectMemory
  		storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector;
  		storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray;
  		storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
  
  	self push: message.
  
  	argumentCount := 1.!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  	<inline: false>
+ 	self printHexnp: oop.
- 	self printHex: oop.
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^self
  				cCode: 'printf("=$%ld ($%c)\n", (long)characterValueOf(oop), (long)characterValueOf(oop))'
  				inSmalltalk: [self print: (self shortPrint: oop); cr]].
  		 ^self
  			cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
  			inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [' is not on the heap']); cr.
  		 ^nil].
  	((objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]) ifTrue:
  		[^self printOop: oop].
  	self print: ': a(n) '.
  	self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
  	self cr!



More information about the Vm-dev mailing list