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

commits at source.squeak.org commits at source.squeak.org
Wed Feb 4 02:56:18 UTC 2015


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

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

Name: VMMaker.oscog-eem.1036
Author: eem
Time: 3 February 2015, 6:54:57.116 pm
UUID: d4ac012e-2503-42d2-a8c1-e73dd59b48eb
Ancestors: VMMaker.oscog-eem.1035

Eliminate NewspeakV3 support from the Newspeak Spur VMs.
Fix commonSendAbsent's comment.

Don't expunge unmarked entries from the class table in the
segment storage markObjects: invocation.

Use numSlotsOfAny: to avoid unnecessary assert fails in some
printing & testing code.  Fix ... bug in longPrintOop:

Simulate primitiveDirectoryCreate

Fix missing supersend init bug in the DeflatePlugin.

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

Item was changed:
  ----- Method: Cogit class>>initializeBytecodeTable (in category 'class initialization') -----
  initializeBytecodeTable
  	"SimpleStackBasedCogit initializeBytecodeTableWith: Dictionary new"
  	"StackToRegisterMappingCogit initializeBytecodeTableWith: Dictionary new"
  
  	(initializationOptions at: #bytecodeTableInitializer ifAbsent: nil) ifNotNil:
  		[:initalizer| ^self perform: initalizer].
  
  	NewspeakVM ifTrue:
+ 		[^(initializationOptions at: #SpurObjectMemory ifAbsent: false)
+ 			ifTrue:
+ 				[MULTIPLEBYTECODESETS
+ 					ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid]
+ 					ifFalse: [self initializeBytecodeTableForNewspeakV4]]
+ 			ifFalse:
+ 				[MULTIPLEBYTECODESETS
+ 					ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid]
+ 					ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]].
- 		[^MULTIPLEBYTECODESETS
- 			ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid]
- 			ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]].
  	^self initializeBytecodeTableForSqueakV3PlusClosures!

Item was added:
+ ----- Method: Cogit class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'class initialization') -----
+ initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid
+ 	"SimpleStackBasedCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
+ 	"StackToRegisterMappingCogit initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
+ 
+ 	| v3Table v4Table |
+ 	"N.B. Must do it backwards to evaluate AltBlockCreationBytecodeSize & BlockCreationBytecodeSize et al correctly."
+ 	self initializeBytecodeTableForNewspeakV4.
+ 	v4Table := generatorTable.
+ 	AltBlockCreationBytecodeSize := BlockCreationBytecodeSize.
+ 	AltNSSendIsPCAnnotated := NSSendIsPCAnnotated.
+ 	AltFirstSpecialSelector := FirstSpecialSelector.
+ 	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	v3Table := generatorTable.
+ 	generatorTable := CArrayAccessor on: v3Table object, v4Table object!

Item was changed:
  ----- Method: DeflatePlugin>>initialize (in category 'initialize-release') -----
  initialize
+ 	writeStreamInstSize := 0.
+ 	super initialize!
- 	writeStreamInstSize := 0!

Item was changed:
  ----- Method: FilePlugin>>primitiveDirectoryCreate (in category 'directory primitives') -----
  primitiveDirectoryCreate
  
  	| dirName dirNameIndex dirNameSize okToCreate |
  	<var: #dirNameIndex type: 'char *'>
  	<export: true>
  
  	dirName := interpreterProxy stackValue: 0.
+ 	(interpreterProxy isBytes: dirName) ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	(interpreterProxy isBytes: dirName)
- 		ifFalse: [^interpreterProxy primitiveFail].
  	dirNameIndex := interpreterProxy firstIndexableField: dirName.
  	dirNameSize := interpreterProxy byteSizeOf: dirName.
  	"If the security plugin can be loaded, use it to check for permission.
  	If not, assume it's ok"
+ 	sCCPfn ~= 0 ifTrue:
+ 		[okToCreate := self cCode: ' ((sqInt (*)(char *, sqInt))sCCPfn)(dirNameIndex, dirNameSize)'
+ 							inSmalltalk: [true].
+ 		 okToCreate ifFalse:
+ 			[^interpreterProxy primitiveFail]].
- 	sCCPfn ~= 0
- 		ifTrue: [okToCreate := self cCode: ' ((sqInt (*)(char *, sqInt))sCCPfn)(dirNameIndex, dirNameSize)'.
- 			okToCreate
- 				ifFalse: [^interpreterProxy primitiveFail]].
  	(self
+ 		cCode: 'dir_Create(dirNameIndex, dirNameSize)'
+ 		inSmalltalk: [self createDirectory: (interpreterProxy asString: dirNameIndex)]) ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 			cCode: 'dir_Create(dirNameIndex, dirNameSize)'
- 			inSmalltalk: [false])
- 		ifFalse: [^interpreterProxy primitiveFail].
  	interpreterProxy pop: 1!

Item was added:
+ ----- Method: FilePluginSimulator>>createDirectory: (in category 'simulation') -----
+ createDirectory: aString
+ 	^[FileDirectory default primCreateDirectory: aString.
+ 	   true]
+ 		on: Error
+ 		do: [:ex| false]
+ 	!

Item was added:
+ ----- Method: ObjectMemory>>numSlotsOfAny: (in category 'object access') -----
+ numSlotsOfAny: obj
+ 	"Sput compatibility"
+ 	^self numSlotsOf: obj!

Item was changed:
  ----- Method: Spur64BitMMLESimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a64BitValue
- longAt: byteAddress put: a32BitValue
  	"Store the 64-bit value at byteAddress which must be 0 mod 4."
  	"byteAddress = 16r1F5AE8 ifTrue: [self halt]."
+ 	^self long64At: byteAddress put: a64BitValue!
- 	^self long64At: byteAddress put: a32BitValue!

Item was changed:
  ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') -----
  markAndTraceClassOf: objOop
  	"Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
- 	 Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated.
  	 And for one-way become, which can create duplicate entries in the class table, make sure
  	 objOop's classIndex refers to the classObj's actual classIndex.
  	 Note that this is recursive, but the metaclass chain should terminate quickly."
  	<inline: false>
  	| classIndex classObj realClassIndex |
  	classIndex := self classIndexOf: objOop.
  	classObj := self classOrNilAtIndex: classIndex.
+ 	self assert: (coInterpreter objCouldBeClassObj: classObj).
  	realClassIndex := self rawHashBitsOf: classObj.
  	classIndex ~= realClassIndex ifTrue:
  		[self setClassIndexOf: objOop to: realClassIndex].
  	(self isMarked: classObj) ifFalse:
  		[self setIsMarkedOf: classObj to: true.
  		 self markAndTraceClassOf: classObj.
  		 self push: classObj onObjStack: markStack]!

Item was changed:
  ----- Method: SpurMemoryManager>>markObjects: (in category 'gc - global') -----
+ markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
- markObjects: objectsShouldBeUnmarked
  	<inline: #never> "for profiling"
+ 	"Mark all accessible objects.  objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
+ 	 is true if all objects are unmarked and/or if unmarked classes shoud be removed from the class table."
- 	"Mark all accessible objects.  "
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush].
  	self runLeakCheckerForFullGC: true.
  
+ 	self shutDownIncrementalGC: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
- 	self shutDownIncrementalGC: objectsShouldBeUnmarked.
  	self initializeUnscannedEphemerons.
  	self initializeMarkStack.
  	self initializeWeaklingStack.
  	self markAccessibleObjectsAndFireEphemerons.
+ 	self expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
- 	self expungeDuplicateAndUnmarkedClasses: true.
  	self nilUnmarkedWeaklingSlots!

Item was changed:
  ----- Method: SpurMemoryManager>>restoreObjectsIn:savedHashes: (in category 'image segment in/out') -----
  restoreObjectsIn: objArray savedHashes: savedHashes
+ 	"Enumerate the objects in objArray, unmarking them and restoring their hashes
- 	"Enumerate the objects in objArray,unmarking them and restoring their hashes
  	 from the corresponding 32-bit slots in savedHashes.  The first unused entry in
  	 objArray will have a non-hash value entry in savedHashes.  Free savedHashes."
  	<inline: false>
  	0 to: (self numSlotsOf: objArray) - 1 do:
  		[:i| | hash oop |
  		(hash := self fetchLong32: i ofObject: savedHashes) > self maxIdentityHash ifTrue:
  			[(self isInOldSpace: savedHashes) ifTrue:
  				[self freeObject: savedHashes].
  			 ^self].
  		oop := self fetchPointer: i ofObject: objArray.
  		self setHashBitsOf: oop to: hash.
  		self setIsMarkedOf: oop to: false].
  	(self isInOldSpace: savedHashes) ifTrue:
  		[self freeObject: savedHashes]!

Item was changed:
  ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
  storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots
  	"This primitive is called from Squeak as...
  		<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.
  
  	 This primitive will store a binary image segment (in the same format as objercts in the heap) of the
  	 set of objects in arrayOfObjects.  All pointers from within the set to objects outside the set will be
  	 copied into the array of outPointers.  In their place in the image segment will be an oop equal to the
  	 offset in the outPointer array (the first would be 4). but with the high bit set.
  
  	 Since Spur has a class table the load primitive must insert classes that have instances in the class
  	 table.  This primitive marks such classes using the isRemembered bit, which isn't meaningful as a
  	 remembered bit in the segment.
  
  	 The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
  	 In this case it returns normally, and truncates the two arrays to exactly the right size.
  
  	 The primitive can fail for the following reasons with the specified failure codes:
  		PrimErrWritePastObject:	the segmentWordArray is too small
  		PrimErrBadIndex:			the outPointerArray is too small
  		PrimErrNoMemory:			additional allocations failed
  		PrimErrLimitExceeded:		there is no room in the hash field to store object oops."
  	<inline: false>
  	| arrayOfObjects savedInHashes savedOutHashes fillValue segStart segAddr endSeg outIndex |
  
  	self leakCheckImageSegments ifTrue:
  		[self runLeakCheckerForFullGC: true].
  
  	"First compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array."
  	arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
  	arrayOfObjects ifNil:
  		[^PrimErrNoMemory].
  
  	self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
  
  	"The scheme is to copy the objects into segmentWordArray, and then map the oops in sementWordArray.
  	 Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
  	 be able to undo any side-effects if the primitive fails because either sementWordArray or outPointerArray
  	 is too small.  The mapping is done by having the originals (either the objects in arrayOfObjects or the
  	 objects in outPointerArray) refer to their mapped locations through their identityHash, and saving their
  	 identityHashes in two ByteArrays, one that mirrors arrayOfObjects, and one that mirrors outPointerArray.
  	 Since arrayOfObjects and its saved hashes, and outPointerArray and its saved hashes, can be enumerated
  	 side-by-side, the hashes can be restored to the originals.  So the hash of an object in arrayOfObjects
  	 is set to its offset in segmentWordArray / self allocationUnit, and the hash of an object in outPointerArray
  	 is set to its index in outPointerArray plus the top hash bit.  Oops in segmentWordArray are therefore
  	 mapped by accessing the original oop's identityHash, testing the bottom bit to distinguish between internal
  	 and external oops.  The saved hash arrays are initialized with an out-of-range hash value so that the first
  	 unused entry can be identified."
  
  	savedInHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: arrayOfObjects) * 4)
  							format: self firstLongFormat
  							classIndex: self thirtyTwoBitLongsClassIndexPun.
  	savedOutHashes := self allocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
  							format: self firstLongFormat
  							classIndex: self thirtyTwoBitLongsClassIndexPun.
  	(savedInHashes isNil or: [savedOutHashes isNil]) ifTrue:
  		[self freeObject: arrayOfObjects.
  		 ^PrimErrNoMemory].
  
  	fillValue := self wordSize = 4 ifTrue: [self maxIdentityHash + 1] ifFalse: [self maxIdentityHash + 1 << 32 + (self maxIdentityHash + 1)].
  	self fillObj: savedInHashes numSlots: (self numSlotsOf: savedInHashes) with: fillValue.
  	self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: fillValue.
  
  	"Both to expand the max size of segment and to reduce the length of the
  	 load-time pass that adds classes to the class table, move classes to the
  	 front of arrayOfObjects, leaving the root array as the first element."
  	self moveClassesForwardsIn: arrayOfObjects.
  
  	segAddr := segmentWordArray + self baseHeaderSize.
  	endSeg := self addressAfter: segmentWordArray.
  
  	"Write a version number for byte order and version check."
  	segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
  	self long32At: segAddr put: self imageSegmentVersion.
  	self long32At: segAddr + 4 put: self imageSegmentVersion.
  	segStart := segAddr := segAddr + self allocationUnit.
  
  	"Copy all reachable objects to the segment."
  	0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
  		[:i| | newSegAddrOrError objOop |
  		objOop := self fetchPointer: i ofObject: arrayOfObjects.
  		self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
  		self storeLong32: i ofObject: savedInHashes withValue: (self rawHashBitsOf: objOop).
  		newSegAddrOrError := self copyObj: objOop toAddr: segAddr startAt: segStart stopAt: endSeg.
  		newSegAddrOrError < segStart ifTrue:
  			[^self return: newSegAddrOrError
  					restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
  					and: outPointerArray savedHashes: savedOutHashes].
  		 segAddr := newSegAddrOrError].
  
  	"Check that it can be safely shortened."
  	(endSeg ~= segAddr
  	 and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
  		[^self return: PrimErrWritePastObject
  				restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
  				and: outPointerArray savedHashes: savedOutHashes].
  
  	"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
  	 have their hashes set to point to their copies in segmentWordArray."
  	(outIndex := self mapOopsFrom: segStart
  					to: segAddr
  					outPointers: outPointerArray
  					outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
  		[^self return: PrimErrBadIndex
  				restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
  				and: outPointerArray savedHashes: savedOutHashes].
  
+ 	"We're done.  Shorten the results, restore hashes and return."
- 	"We're done.  SHorten the results, restore hashes and return."
  	self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
  	self shorten: outPointerArray toIndexableSize: outIndex.
  	^self return: PrimNoErr
  		restoringObjectsIn: arrayOfObjects savedHashes: savedInHashes
  		and: outPointerArray savedHashes: savedOutHashes!

Item was added:
+ ----- Method: SpurMemoryManager>>superclassOf: (in category 'simulation only') -----
+ superclassOf: classPointer
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter superclassOf: classPointer!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTable (in category 'initialization') -----
  initializeBytecodeTable
  	"StackInterpreter initializeBytecodeTable"
  
  	(initializationOptions at: #bytecodeTableInitializer ifAbsent: nil) ifNotNil:
  		[:initalizer| ^self perform: initalizer].
  
  	NewspeakVM ifTrue:
+ 		[^(initializationOptions at: #SpurObjectMemory ifAbsent: false)
+ 			ifTrue:
+ 				[MULTIPLEBYTECODESETS
+ 					ifTrue: [self initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid]
+ 					ifFalse: [self initializeBytecodeTableForNewspeakV4]]
+ 			ifFalse:
+ 				[MULTIPLEBYTECODESETS
+ 					ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid]
+ 					ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]]].
- 		[^MULTIPLEBYTECODESETS
- 			ifTrue: [self initializeBytecodeTableForNewspeakV3PlusClosuresNewspeakV4Hybrid]
- 			ifFalse: [self initializeBytecodeTableForNewspeakV3PlusClosures]].
  
  	^self initializeBytecodeTableForSqueakV3PlusClosures!

Item was added:
+ ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'initialization') -----
+ initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid
+ 	"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
+ 
+ 	| v3Table v4Table |
+ 	self initializeBytecodeTableForNewspeakV4.
+ 	v4Table := BytecodeTable.
+ 	AltBytecodeEncoderClassName := BytecodeEncoderClassName.
+ 	AltLongStoreBytecode := LongStoreBytecode.
+ 	self initializeBytecodeTableForSqueakV3PlusClosures.
+ 	v3Table := BytecodeTable.
+ 	BytecodeTable := v3Table, v4Table!

Item was changed:
  ----- Method: StackInterpreter>>commonSendAbsent (in category 'send bytecodes') -----
  commonSendAbsent
  	"Send an absent receiver message, shuffling arguments and inserting the absent
  	 receiver for the send.  Assume: messageSelector and argumentCount have been
  	 set, and that the arguments but not the receiver have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
+ 	"160-175	1010 i i i i				Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
- 	"160-175	1010 i i i i		Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
  	"240		11110000	i i i i i j j j	Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
+ 	"245		 11110101 i i i i i j j j	Send To Self Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
+ 	"254		 11111110 i i i i i j j j	kkkkkkkk Send To Enclosing Object at Depth kkkkkkkk Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	<sharedCodeInCase: #extSendAbsentImplicitBytecode>
  	self shuffleArgumentsAndStoreAbsentReceiver: localAbsentReceiver.
  	lkupClassTag := objectMemory fetchClassTagOf: localAbsentReceiver.
  	self assert: (objectMemory classForClassTag: lkupClassTag) ~= objectMemory nilObject.
  	self commonSend!

Item was changed:
  ----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
  longPrintOop: oop
  	<api>
  	| fmt lastIndex startIP bytecodesPerLine column |
  	((objectMemory isImmediate: oop)
  	 or: [(objectMemory addressCouldBeObj: oop) not
  	 or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  	 or: [(objectMemory isFreeObject: oop)
  	 or: [objectMemory isForwarded: oop]]]]) ifTrue:
  		[self printOop: oop.
  		 ^self].
  	self printHex: oop.
  	(objectMemory fetchClassOfNonImm: oop)
  		ifNil: [self print: ' has a nil class!!!!']
  		ifNotNil: [:class|
  			self print: ': a(n) '; printNameOfClass: class count: 5;
  				print: ' ('.
  			objectMemory hasSpurMemoryManagerAPI ifTrue:
  				[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
  			self printHexnp: class; print: ')'].
  	fmt := objectMemory formatOf: oop.
  	self print: ' format '; printHexnp: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop.
  	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
  	self cr.
  	(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
  		[^self printStringOf: oop; cr].
  	(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
  		[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchLong32: i ofObject: oop.
  			self space; printNum: i; space; printHex: fieldOop; space; cr].
  		 ^self].
  	"this is nonsense.  apologies."
  	startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
  	lastIndex := 256 min: startIP.
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:i| | fieldOop |
  			fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
  			self space; printNum: i - 1; space; printHex: fieldOop; space.
  			(i = 1 and: [objectMemory isCompiledMethod: oop])
  				ifTrue: [self printMethodHeaderOop: fieldOop]
  				ifFalse: [self cCode: [self printOopShort: fieldOop]
  							inSmalltalk: [self print: (self shortPrint: fieldOop)]].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
+ 			[startIP > lastIndex ifTrue: [self print: '...'; cr]]
- 			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * objectMemory wordSize + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
  					[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
  						inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>objCouldBeClassObj: (in category 'debug support') -----
  objCouldBeClassObj: objOop
  	"Answer if objOop looks like a class object.  WIth Spur be lenient if the object doesn't
  	 yet have a hash (i.e. is not yet in the classTable), and accept forwarding pointers."
  	<inline: false>
  	| fieldOop |
  	^(objectMemory isPointersNonImm: objOop)
+ 	  and: [(objectMemory numSlotsOfAny: objOop) > InstanceSpecificationIndex
- 	  and: [(objectMemory numSlotsOf: objOop) > InstanceSpecificationIndex
  	  and: [fieldOop := objectMemory fetchPointer: SuperclassIndex ofObject: objOop.
  			((objectMemory isNonImmediate: fieldOop)
  			and:[ (objectMemory isPointersNonImm: fieldOop)
  				or: [(objectMemory isOopForwarded: fieldOop)
  					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
  	  and: [fieldOop := objectMemory fetchPointer: MethodDictionaryIndex ofObject: objOop.
  			((objectMemory isNonImmediate: fieldOop)
  			and:[ (objectMemory isPointersNonImm: fieldOop)
  				or: [(objectMemory isOopForwarded: fieldOop)
  					and: [objectMemory isPointers: (objectMemory followForwarded: fieldOop)]]])
  	  and: [(objectMemory isIntegerObject: (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: objOop))]]]]!



More information about the Vm-dev mailing list