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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 2 03:48:08 UTC 2013


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

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

Name: VMMaker.oscog-eem.340
Author: eem
Time: 1 September 2013, 8:44:19.179 pm
UUID: 302ce24d-f89a-46d0-9734-aa7c34dce91a
Ancestors: VMMaker.oscog-eem.339

More of the bootstrap.

Fix various endianness slips in header access.  Need at some stage
to construct CogMemoryManager32BitsLE et al and separate out
the endian-specific code.  For now just flag: #endianness.

Assign nil, true, false & specialObjectsArray.   Leave room for
newSpace and codeSpace in the initial heap so we can launch
the bootstrap immediately.

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

Item was changed:
  ----- Method: CMM32LSBSimulator>>longLongAt: (in category 'memory access') -----
  longLongAt: byteAddress
+ 	"memory is a Bitmap, a 32-bit indexable array of bits"
  	| hiWord loWord |
  	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	loWord := memory at: byteAddress // 4 + 1.
+ 	hiWord := memory at: byteAddress // 4 + 2.
- 	hiWord := memory at: byteAddress // 8 + 1.
- 	loWord := memory at: byteAddress // 8 + 2.
  	^hiWord = 0
  		ifTrue: [loWord]
  		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was changed:
  ----- Method: CMM32LSBSimulator>>longLongAt:put: (in category 'memory access') -----
  longLongAt: byteAddress put: a64BitValue
+ 	"memory is a Bitmap, a 32-bit indexable array of bits"
  	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
  	memory
+ 		at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff);
+ 		at: byteAddress // 4 + 2 put: a64BitValue >> 32.
- 		at: byteAddress // 8 + 1 put: a64BitValue >> 32;
- 		at: byteAddress // 8 + 2 put: (a64BitValue bitAnd: 16rffffffff).
  	^a64BitValue!

Item was changed:
  ----- Method: CogClass>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	"Type coercion for translation and simulation.
  	 For simulation answer a suitable surrogate for the struct types"
  	^cTypeString caseOf:
+ 	   {	[#'unsigned long']							->	[value].
+ 		[#sqInt]										->	[value].
+ 		[#usqInt]									->	[value].
- 	   {	[#'unsigned long']						->	[value].
- 		[#sqInt]									->	[value].
  		[#'AbstractInstruction *']					->	[value].
  		[#'BytecodeFixup *']						->	[value].
+ 		[#'CogMethod *']							->	[value].
+ 		[#'char *']									->	[value].
+ 		[#'sqInt *']									->	[value].
+ 		[#'void *']									->	[value].
+ 		[#'void (*)()']								->	[value].
+ 		[#'void (*)(void)']							->	[value].
+ 		[#'unsigned long (*)(void)']					->	[value].
- 		[#'CogMethod *']						->	[value].
- 		[#'char *']								->	[value].
- 		[#'sqInt *']								->	[value].
- 		[#'void *']								->	[value].
- 		[#'void (*)()']							->	[value].
- 		[#'void (*)(void)']						->	[value].
- 		[#'unsigned long (*)(void)']				->	[value].
  		[#'void (*)(unsigned long,unsigned long)']	->	[value] }!

Item was changed:
+ CogClass subclass: #CogMemoryManager
- VMClass subclass: #CogMemoryManager
(excessive size, no diff calculated)

Item was added:
+ ----- Method: CogMemoryManager>>allObjectsDo: (in category 'debug support') -----
+ allObjectsDo: aBlock
+ 	<doNotGenerate>
+ 	| prevObj prevPrevObj objOop |
+ 	prevPrevObj := prevObj := nil.
+ 	objOop := self firstObject.
+ 	[self assert: objOop \\ self allocationUnit = 0.
+ 	 objOop < freeStart] whileTrue:
+ 		[(self isFreeObject: objOop) ifFalse:
+ 			[aBlock value: objOop].
+ 		 prevPrevObj := prevObj.
+ 		 prevObj := objOop.
+ 		 objOop := self objectAfter: objOop].
+ 	prevPrevObj class.
+ 	prevObj class!

Item was changed:
  ----- Method: CogMemoryManager>>allocateMemoryOfSize: (in category 'simulation') -----
  allocateMemoryOfSize: limit
  	<doNotGenerate>
  	memory := (self endianness == #little
  					ifTrue: [LittleEndianBitmap]
  					ifFalse: [Bitmap]) new: (limit roundUpTo: 8).
+ 	freeStart := startOfMemory := 0.
- 	freeStart := 0.
  	scavengeThreshold := newSpaceLimit := memory size * 4 "Bitmap is a 4-byte per word array"!

Item was added:
+ ----- Method: CogMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') -----
+ allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes
+ 	<doNotGenerate>
+ 	self assert: (memoryBytes \\ self allocationUnit = 0
+ 				and: [newSpaceBytes \\ self allocationUnit = 0
+ 				and: [codeBytes \\ self allocationUnit = 0]]).
+ 	memory := (self endianness == #little
+ 					ifTrue: [LittleEndianBitmap]
+ 					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4.
+ 	startOfMemory := codeBytes.
+ 	"leave newSpace empty for the bootstrap"
+ 	freeStart := newSpaceBytes + startOfMemory.
+ 	newSpaceLimit := newSpaceBytes + startOfMemory.
+ 	scavengeThreshold := memory size * 4 "Bitmap is a 4-byte per word array"!

Item was added:
+ ----- Method: CogMemoryManager>>classIndexOf: (in category 'header access') -----
+ classIndexOf: objOop
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>falseObject (in category 'accessing') -----
+ falseObject
+ 	^falseObj!

Item was added:
+ ----- Method: CogMemoryManager>>falseObject: (in category 'accessing') -----
+ falseObject: anOop
+ 	"For mapInterpreterOops"
+ 	falseObj := anOop!

Item was added:
+ ----- Method: CogMemoryManager>>firstObject (in category 'object enumeration') -----
+ firstObject
+ 	"Return the first object or free chunk in the heap."
+ 
+ 	^nilObj!

Item was changed:
  ----- Method: CogMemoryManager>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ 	"0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6,7,8 unused
+ 	 9 (?) 64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
- formatOf: objOop 
  	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>freeStart (in category 'accessing') -----
+ freeStart
+ 	^freeStart!

Item was changed:
  ----- Method: CogMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') -----
  headerForSlots: numSlots format: formatField classIndex: classIndex 
  	"The header format in LSB is
  	 MSB:	| 8: slotSize			| (on a byte boundary)
  			| 2 bits				|
  			| 22: identityHash	| (on a word boundary)
  			| 3 bits				|
  			| 5: format			| (on a byte boundary)
  			| 2 bits				|
  			| 22: classIndex		| (on a word boundary) : LSB
  	 The remaining bits (7) need to be used for
  		isGrey
  		isMarked
  		isRemembered
  		isPinned
  		isImmutable
  	 leaving 2 unused bits."
+ 	^ (numSlots << self slotSizeFullWordShift)
+ 	+ (formatField << self formatShift)
- 	^ (numSlots << 56)
- 	+ (formatField << 24)
  	+ classIndex!

Item was added:
+ ----- Method: CogMemoryManager>>isFreeObject: (in category 'header access') -----
+ isFreeObject: objOop
+ 	^(self classIndexOf: objOop) = 0!

Item was added:
+ ----- Method: CogMemoryManager>>isImmediate: (in category 'object testing') -----
+ isImmediate: oop 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>objectAfter: (in category 'object enumeration') -----
+ objectAfter: objOop
+ 	"Object parsing.
+ 	1. all objects have at least a word following the header, for a forwarding pointer.
+ 	2. objects with an overflow size have a preceeing word with a saturated slotSize.  If the word following
+ 	    an object doesn't have a saturated size field it must be a single-header object.  If the word following
+ 	   does have a saturated slotSize it must be the overflow size word."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogMemoryManager>>overflowSlotsMask (in category 'header format') -----
+ overflowSlotsMask
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: CogMemoryManager>>rawSlotSizeOf: (in category 'object access') -----
  rawSlotSizeOf: oop
  	<returnTypeC: #usqInt>
+ 	| halfHeader slotSize |
+ 	self flag: #endianness.
+ 	halfHeader := self longAt: oop + 4.
+ 	slotSize := halfHeader >> self slotSizeHalfWordShift bitAnd: self slotSizeMask.
- 	| header slotSize |
- 	header := self longAt: oop.
- 	slotSize := header >> self slotSizeHalfWordShift bitAnd: self slotSizeMask.
  	^slotSize = self slotSizeMask
+ 		ifTrue: [self longAt: oop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
- 		ifTrue: [self cCoerceSimple: (self longLongAt: oop - self baseHeaderSize) to: #usqInt]
  		ifFalse: [slotSize]!

Item was added:
+ ----- Method: CogMemoryManager>>slotSizeFullWordShift (in category 'header format') -----
+ slotSizeFullWordShift
+ 	^56!

Item was added:
+ ----- Method: CogMemoryManager>>specialObjectsOop (in category 'accessing') -----
+ specialObjectsOop
+ 	^specialObjectsOop!

Item was added:
+ ----- Method: CogMemoryManager>>specialObjectsOop: (in category 'accessing') -----
+ specialObjectsOop: anObject
+ 	"For mapInterpreterOops"
+ 	specialObjectsOop := anObject!

Item was added:
+ ----- Method: CogMemoryManager>>startOfMemory (in category 'accessing') -----
+ startOfMemory
+ 	"Return the start of object memory.  This is immediately after the native code zone.
+ 	 N.B. the stack zone is alloca'ed. Use a macro so as not to punish the debug VM."
+ 	<cmacro: '() heapBase'>
+ 	<returnTypeC: #usqInt>
+ 	^coInterpreter ifNil: [startOfMemory] ifNotNil: [coInterpreter heapBase]!

Item was added:
+ ----- Method: CogMemoryManager>>startOfMemory: (in category 'simulation') -----
+ startOfMemory: value
+ 	startOfMemory := value.
+ 	(freeStart isNil or: [freeStart < value]) ifTrue:
+ 		[freeStart := value]!

Item was added:
+ ----- Method: CogMemoryManager>>trueObject (in category 'accessing') -----
+ trueObject
+ 	^trueObj!

Item was added:
+ ----- Method: CogMemoryManager>>trueObject: (in category 'accessing') -----
+ trueObject: anOop
+ 	"For mapInterpreterOops"
+ 	trueObj := anOop!

Item was changed:
  ----- Method: CogMemoryManager32Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
  	 16 bytes otherwise (slot size in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self slotSizeMask
  		ifTrue:
  			[newObj := freeStart + self baseHeaderSize.
  			 numBytes := self baseHeaderSize + self baseHeaderSize "double header"
+ 						+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
- 						+ 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"
  	self assert: numBytes \\ self allocationUnit = 0.
  	freeStart + numBytes > scavengeThreshold ifTrue:
  		[freeStart + numBytes > newSpaceLimit ifTrue:
  			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
  		 self scheduleScavenge].
  	numSlots >= self slotSizeMask
+ 		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 slotSizeMask << self slotSizeHalfWordShift.
- 		ifTrue:
- 			[self longLongAt: freeStart put: numSlots.
  			 self longLongAt: newObj put: (self headerForSlots: self slotSizeMask 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: CogMemoryManager32Bits>>classIndexOf: (in category 'header access') -----
+ classIndexOf: objOop
+ 	self flag: #endianness.
+ 	^(self longAt: objOop) bitAnd: self classIndexMask!

Item was changed:
  ----- Method: CogMemoryManager32Bits>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ 	"0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6,7,8 unused
+ 	 9 (?) 64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
+ 	self flag: #endianness.
+ 	^(self longAt: objOop) >> self formatShift bitAnd: self formatMask!
- formatOf: objOop 
- 	^(self longAt: objOop + self wordSize) >> self formatShift bitAnd: self formatMask!

Item was added:
+ ----- Method: CogMemoryManager32Bits>>isImmediate: (in category 'object testing') -----
+ isImmediate: oop 
+ 	^(oop bitAnd: 3) ~= 0!

Item was added:
+ ----- Method: CogMemoryManager32Bits>>objectAfter: (in category 'object enumeration') -----
+ objectAfter: objOop
+ 	"Object parsing.
+ 	1. all objects have at least a word following the header, for a forwarding pointer.
+ 	2. objects with an overflow size have a preceeing word with a saturated slotSize.  If the word following
+ 	    an object doesn't have a saturated size field it must be a single-header object.  If the word following
+ 	   does have a saturated slotSize it must be the overflow size word."
+ 	| rawSlotSize slotBytes followingWordAddress followingWord |
+ 	rawSlotSize := self rawSlotSizeOf: objOop.
+ 	slotBytes := rawSlotSize = 0
+ 					ifTrue: [self allocationUnit]
+ 					ifFalse: [rawSlotSize + (rawSlotSize bitAnd: 1) << self shiftForWord].
+ 	followingWordAddress := objOop + self baseHeaderSize + slotBytes.
+ 	followingWordAddress >= freeStart ifTrue:
+ 		[^freeStart].
+ 	self flag: #endianness.
+ 	followingWord := self longAt: followingWordAddress + 4.
+ 	^followingWord >> self slotSizeHalfWordShift = self slotSizeMask
+ 		ifTrue: [followingWordAddress + self baseHeaderSize]
+ 		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: CogMemoryManager64Bits>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the slot size field (max implies overflow),
  	 16 bytes otherwise (slot size in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self slotSizeMask
  		ifTrue:
+ 			[numSlots > 16rffffffff ifTrue:
+ 				[^nil].
+ 			 newObj := freeStart + self baseHeaderSize.
- 			[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:
  		[freeStart + numBytes > newSpaceLimit ifTrue:
  			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
  		 self scheduleScavenge].
  	numSlots >= self slotSizeMask
+ 		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 slotSizeMask << self slotSizeHalfWordShift.
- 		ifTrue:
- 			[self longLongAt: freeStart put: numSlots.
  			 self longLongAt: newObj put: (self headerForSlots: self slotSizeMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  		freeStart := freeStart + numBytes.
  	^newObj!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>classIndexOf: (in category 'header access') -----
+ classIndexOf: objOop
+ 	^(self longLongAt: objOop) bitAnd: self classIndexMask!

Item was changed:
  ----- Method: CogMemoryManager64Bits>>formatOf: (in category 'object access') -----
+ formatOf: objOop
+ 	"0 = 0 sized objects (UndefinedObject True False et al)
+ 	 1 = non-indexable objects with inst vars (Point et al)
+ 	 2 = indexable objects with no inst vars (Array et al)
+ 	 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 	 4 = weak indexable objects with inst vars (WeakArray et al)
+ 	 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 	 6,7,8 unused
+ 	 9 (?) 64-bit indexable
+ 	 10 - 11 32-bit indexable
+ 	 12 - 15 16-bit indexable
+ 	 16 - 23 byte indexable
+ 	 24 - 31 compiled method"
- formatOf: objOop 
  	^(self longLongAt: objOop) >> self formatShift bitAnd: self formatMask!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>isImmediate: (in category 'object testing') -----
+ isImmediate: oop 
+ 	^(oop bitAnd: 7) ~= 0!

Item was added:
+ ----- Method: CogMemoryManager64Bits>>objectAfter: (in category 'object enumeration') -----
+ objectAfter: objOop
+ 	"Object parsing.
+ 	1. all objects have at least a word following the header, for a forwarding pointer.
+ 	2. objects with an overflow size have a preceeing word with a saturated slotSize.  If the word following
+ 	    an object doesn't have a saturated size field it must be a single-header object.  If the word following
+ 	   does have a saturated slotSize it must be the overflow size word."
+ 	| followingWordAddress followingWord |
+ 	followingWordAddress := objOop
+ 							+ self baseHeaderSize
+ 							+ ((self rawSlotSizeOf: objOop) << self shiftForWord max: self allocationUnit).
+ 	self flag: #endianness.
+ 	followingWord := self longAt: followingWordAddress + 4.
+ 	^followingWord >> self slotSizeHalfWordShift = self slotSizeMask
+ 		ifTrue: [followingWordAddress + self baseHeaderSize]
+ 		ifFalse: [followingWordAddress]!

Item was added:
+ ----- Method: ObjectMemory>>isImmediateCharacter: (in category 'interpreter access') -----
+ isImmediateCharacter: objectPointer
+ 
+ 	^false!

Item was added:
+ ----- Method: ObjectMemory>>isImmediateObject: (in category 'interpreter access') -----
+ isImmediateObject: objectPointer
+ 
+ 	^(objectPointer bitAnd: 1) > 0!

Item was changed:
  ----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
  requiredMethodNames: options
  	"return the list of method names that should be retained for export or other support reasons"
  	| requiredList |
  	requiredList := self exportAPISelectors: options.
  	requiredList addAll: (NewObjectMemory requiredMethodNames: options).
  	"A number of methods required by VM support code, jitter, specific platforms etc"
  	requiredList addAll: #(
  		assertValidExecutionPointe:r:s:
  		characterForAscii:
  		findClassOfMethod:forReceiver: findSelectorOfMethod:
  			forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
  		getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
  			getSavedWindowSize getThisSessionID
  		interpret
  		loadInitialContext
- 		oopFromChunk:
  		primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
  			printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop:
  				printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
  		readableFormat: readImageFromFile:HeapSize:StartingAt:
  		setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
  			setSavedWindowSize: success:
  		validInstructionPointer:inMethod:framePointer:).
  
  	"Nice to actually have all the primitives available"
  	requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).
  
  	"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
  	InterpreterProxy organization categories do:
  		[:cat |
  		((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
  			[requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
  
  	^requiredList!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine column |
  	<inline: false>
  	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
- 	(objectMemory isIntegerObject: oop) ifTrue:
- 		[^self
  			cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
  			inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self print: ' is not on the heap'; cr.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self print: ' is misaligned'; cr.
  		 ^nil].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
  		 ^nil].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonInt: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
  		 ^nil].
  	fmt := objectMemory formatOf: oop.
  	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
  	self cr.
  	(fmt > 4 and: [fmt < 12]) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr.
  			 ^nil].
  		 (objectMemory isWords: oop) ifTrue:
  			[lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^nil].
  		^self printStringOf: oop; cr].
  	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / BytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := startIP * BytesPerWord + 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+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: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  	| name classOop |
+ 	(objectMemory isImmediate: oop) ifTrue:
+ 		[(objectMemory isImmediateCharacter: oop) ifTrue: [^ '=$' , (objectMemory integerValueOf: oop) printString , 
+ 			' (' , (String with: (Character value: (objectMemory integerValueOf: oop))) , ')'].
+ 		(objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString , 
+ 			' (' , (objectMemory integerValueOf: oop) hex , ')'].
+ 		^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
- 	(objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString , 
- 		' (' , (objectMemory integerValueOf: oop) hex , ')'].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[^' is not on the heap'].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^' is misaligned'].
  	classOop := objectMemory fetchClassOf: oop.
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue: [
  		^ 'class ' , (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	name = 'String' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'Character' ifTrue: [^ '=' , (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  	name = 'UndefinedObject' ifTrue: [^ 'nil'].
  	name = 'False' ifTrue: [^ 'false'].
  	name = 'True' ifTrue: [^ 'true'].
  	name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
  	name = 'Association' ifTrue: [^ '(' ,
  				(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
  				' -> ' ,
  				(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
  	('AEIOU' includes: name first)
  		ifTrue: [^ 'an ' , name]
  		ifFalse: [^ 'a ' , name]!



More information about the Vm-dev mailing list