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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 3 20:34:19 UTC 2012


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

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

Name: VMMaker.oscog-eem.151
Author: eem
Time: 3 March 2012, 12:31:42.725 pm
UUID: 04f1d165-afc5-4f65-8b65-3be15e84b11d
Ancestors: VMMaker.oscog-eem.150

Various clean-ups in debugging VM crash (fixes to follow).
Provide checkedOkayOop: et al for checking (no fatal error).
Correct some receivers in simulation (objectMemory vs coInterpreter).
Provide shortPrintFramesInPage:

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

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| class canLinkCacheTag errSelIdx cogMethod newCogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreak: selector + BaseHeaderSize
  		point: (objectMemory lengthOf: selector)
  		receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	lkupClass := self superclassOf: mixinApplication.
+ 	class := objectMemory fetchClassOf: rcvr.
- 	class := self fetchClassOf: rcvr.
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	"We set the messageSelector and lkupClass for executeMethod below since things
  	 like the at cache read messageSelector and lkupClass and so they cannot be left stale."
  	messageSelector := selector.
  	lkupClass := self superclassOf: mixinApplication.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector class: lkupClass)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(errSelIdx := self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: lkupClass.
  				"NOTREACHED"
  				self assert: false]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject ifTrue:
  			[cogit setSelectorOf: cogMethod to: selector].
  		 "Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  		  selector.  If not, try and compile a new method with the correct selector."
  		 cogMethod selector ~= selector ifTrue:
  			[self assert: (self methodClassAssociationOf: newMethod) = objectMemory nilObject.
  			 newCogMethod := cogit cog: newMethod selector: selector.
  			 newCogMethod ifNotNil:
  				[cogMethod := newCogMethod]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CogVMSimulator>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
  ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
+ 	"self halt."
- 	self halt.
  	^super ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr!

Item was removed:
- ----- Method: CogVMSimulator>>printCurrPageFrames (in category 'debug printing') -----
- printCurrPageFrames
- 	self printFrameAndCallers: localFP SP: localSP!

Item was changed:
  ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection') -----
  closedPICRefersToUnmarkedObject: cPIC
  	"Answer if the ClosedPIC refers to any unmarked objects or freed/freeable target methods,
  	 applying markAndTraceOrFreeCogMethod:firstVisit: to those targets to determine if freed/freeable."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc offsetToLiteral object entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	(objectMemory isMarked: cPIC selector)  ifFalse:
  		[^true].
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	"First jump is unconditional; subsequent ones are conditional"
  	offsetToLiteral := backEnd jumpLongByteSize.
  	1 to: cPIC cPICNumCases do:
  		[:i|
  		object := backEnd literalBeforeFollowingAddress: pc - offsetToLiteral - backEnd loadLiteralByteSize.
  		((objectRepresentation couldBeObject: object)
  		 and: [(objectMemory isMarked: object) not]) ifTrue:
  			[^true].
  		object := backEnd literalBeforeFollowingAddress: pc - offsetToLiteral.
  		((objectRepresentation couldBeObject: object)
+ 		 and: [(objectMemory isMarked: object) not]) ifTrue:
- 		 and: [(coInterpreter isMarked: object) not]) ifTrue:
  			[^true].
  		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(entryPoint asUnsignedInteger < cPIC asUnsignedInteger
  		 or: [entryPoint asUnsignedInteger > (cPIC asUnsignedInteger + cPIC blockSize) asUnsignedInteger]) ifTrue:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: (targetMethod cmType = CMMethod
  						or: [targetMethod cmType = CMFree]).
  			 (self markAndTraceOrFreeCogMethod: targetMethod
  				  firstVisit: targetMethod asUnsignedInteger > pc asUnsignedInteger) ifTrue:
  				[^true]].
  		offsetToLiteral := backEnd jumpLongConditionalByteSize.
  		pc := pc + cPICCaseSize].
  	^false!

Item was added:
+ ----- Method: NewObjectMemory>>checkOkayOop: (in category 'debug support') -----
+ checkOkayOop: oop
+ 	"Verify that the given oop is legitimate. Check address, header, and size but not class.
+ 	 Answer true if OK.  Otherwise print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| sz type fmt unusedBit |
+ 
+ 	"address and size checks"
+ 	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < freeStart])
+ 		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
+ 	((oop \\ BytesPerWord) = 0)
+ 		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
+ 	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < freeStart
+ 		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
+ 
+ 	"header type checks"
+ 	type := self headerType: oop.
+ 	type = HeaderTypeFree
+ 		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
+ 	type = HeaderTypeShort ifTrue: [
+ 		(self compactClassIndexOf: oop) = 0
+ 			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeClass ifTrue: [
+ 		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeSizeAndClass ifTrue: [
+ 		((oop >= (BytesPerWord*2)) and:
+ 		 [(self headerType: oop - (BytesPerWord*2)) = type and:
+ 		 [(self headerType: oop - BytesPerWord) = type]])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 
+ 	"format check"
+ 	fmt := self formatOf: oop.
+ 	((fmt = 5) | (fmt = 7))
+ 		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
+ 
+ 	"mark and root bit checks"
+ 	unusedBit := 16r20000000.
+ 	BytesPerWord = 8
+ 		ifTrue:
+ 			[unusedBit := unusedBit << 16.
+ 			 unusedBit := unusedBit << 16].
+ 	((self longAt: oop) bitAnd: unusedBit) = 0
+ 		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
+ "xxx
+ 	((self longAt: oop) bitAnd: MarkBit) = 0
+ 		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
+ xxx"
+ 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
+ 	 [oop >= youngStart])
+ 		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
+ 	^true
+ !

Item was changed:
  ----- Method: NewObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
+ 	<var: #oop type: #usqInt>
+ 	oop := self cCoerce: signedOop to: #usqInt.
- 	<var: #oop type: 'usqInt'>
- 	oop := self cCoerce: signedOop to: 'usqInt'.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < freeStart])
- 	(oop < freeStart)
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < freeStart
- 	(oop + sz) < endOfMemory
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
  	(((self longAt: oop) bitAnd: RootBit) = 1 and:
  	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was added:
+ ----- Method: ObjectMemory>>checkOkayOop: (in category 'debug support') -----
+ checkOkayOop: oop
+ 	"Verify that the given oop is legitimate. Check address, header, and size but not class.
+ 	 Answer true if OK.  Otherwise print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| sz type fmt unusedBit |
+ 
+ 	"address and size checks"
+ 	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < endOfMemory])
+ 		ifFalse: [ self print: 'oop is not a valid address'; cr. ^false ].
+ 	((oop \\ BytesPerWord) = 0)
+ 		ifFalse: [ self print: 'oop is not a word-aligned address'; cr. ^false ].
+ 	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < endOfMemory
+ 		ifFalse: [ self print: 'oop size would make it extend beyond the end of memory'; cr. ^false ].
+ 
+ 	"header type checks"
+ 	type := self headerType: oop.
+ 	type = HeaderTypeFree
+ 		ifTrue:  [ self print: 'oop is a free chunk, not an object'; cr. ^false ].
+ 	type = HeaderTypeShort ifTrue: [
+ 		(self compactClassIndexOf: oop) = 0
+ 			ifTrue:  [ self print: 'cannot have zero compact class field in a short header'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeClass ifTrue: [
+ 		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 	type = HeaderTypeSizeAndClass ifTrue: [
+ 		((oop >= (BytesPerWord*2)) and:
+ 		 [(self headerType: oop - (BytesPerWord*2)) = type and:
+ 		 [(self headerType: oop - BytesPerWord) = type]])
+ 			ifFalse: [ self print: 'class header word has wrong type'; cr. ^false ].
+ 	].
+ 
+ 	"format check"
+ 	fmt := self formatOf: oop.
+ 	((fmt = 5) | (fmt = 7))
+ 		ifTrue:  [ self print: 'oop has an unknown format type'; cr. ^false ].
+ 
+ 	"mark and root bit checks"
+ 	unusedBit := 16r20000000.
+ 	BytesPerWord = 8
+ 		ifTrue:
+ 			[unusedBit := unusedBit << 16.
+ 			 unusedBit := unusedBit << 16].
+ 	((self longAt: oop) bitAnd: unusedBit) = 0
+ 		ifFalse: [ self print: 'unused header bit 30 is set; should be zero'; cr. ^false ].
+ "xxx
+ 	((self longAt: oop) bitAnd: MarkBit) = 0
+ 		ifFalse: [ self print: 'mark bit should not be set except during GC' ].
+ xxx"
+ 	(((self longAt: oop) bitAnd: RootBit) = 1 and:
+ 	 [oop >= youngStart])
+ 		ifTrue: [ self print: 'root bit is set in a young object'; cr. ^false ].
+ 	^true
+ !

Item was changed:
  ----- Method: ObjectMemory>>okayOop: (in category 'debug support') -----
  okayOop: signedOop
  	"Verify that the given oop is legitimate. Check address, header, and size but not class."
  
  	| sz type fmt unusedBit oop |
+ 	<var: #oop type: #usqInt>
+ 	oop := self cCoerce: signedOop to: #usqInt.
- 	<var: #oop type: 'usqInt'>
- 	oop := self cCoerce: signedOop to: 'usqInt'.
  
  	"address and size checks"
  	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop >= self startOfMemory and: [oop < endOfMemory])
- 	(oop < endOfMemory)
  		ifFalse: [ self error: 'oop is not a valid address'. ^false ].
  	((oop \\ BytesPerWord) = 0)
  		ifFalse: [ self error: 'oop is not a word-aligned address'. ^false ].
  	sz := self sizeBitsOf: oop.
  	(oop + sz) < endOfMemory
  		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory'. ^false ].
  
  	"header type checks"
  	type := self headerType: oop.
  	type = HeaderTypeFree
  		ifTrue:  [ self error: 'oop is a free chunk, not an object'. ^false ].
  	type = HeaderTypeShort ifTrue: [
  		(self compactClassIndexOf: oop) = 0
  			ifTrue:  [ self error: 'cannot have zero compact class field in a short header'. ^false ].
  	].
  	type = HeaderTypeClass ifTrue: [
  		((oop >= BytesPerWord) and: [(self headerType: oop - BytesPerWord) = type])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  	type = HeaderTypeSizeAndClass ifTrue: [
  		((oop >= (BytesPerWord*2)) and:
  		 [(self headerType: oop - (BytesPerWord*2)) = type and:
  		 [(self headerType: oop - BytesPerWord) = type]])
  			ifFalse: [ self error: 'class header word has wrong type'. ^false ].
  	].
  
  	"format check"
  	fmt := self formatOf: oop.
  	((fmt = 5) | (fmt = 7))
  		ifTrue:  [ self error: 'oop has an unknown format type'. ^false ].
  
  	"mark and root bit checks"
  	unusedBit := 16r20000000.
  	BytesPerWord = 8
  		ifTrue:
  			[unusedBit := unusedBit << 16.
  			 unusedBit := unusedBit << 16].
  	((self longAt: oop) bitAnd: unusedBit) = 0
  		ifFalse: [ self error: 'unused header bit 30 is set; should be zero'. ^false ].
  "xxx
  	((self longAt: oop) bitAnd: MarkBit) = 0
  		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
  xxx"
  	(((self longAt: oop) bitAnd: RootBit) = 1 and:
  	 [oop >= youngStart])
  		ifTrue: [ self error: 'root bit is set in a young object'. ^false ].
  	^true
  !

Item was added:
+ ----- Method: StackInterpreter>>checkOopHasOkayClass: (in category 'debug support') -----
+ checkOopHasOkayClass: oop
+ 	"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance. If OK answer true.  If  not, print reason and answer false."
+ 
+ 	<api>
+ 	<var: #oop type: #usqInt>
+ 	| oopClass formatMask behaviorFormatBits oopFormatBits |
+ 	<var: #oopClass type: #usqInt>
+ 
+ 	(objectMemory checkOkayOop: oop) ifFalse:
+ 		[^false].
+ 	oopClass := self cCoerce: (objectMemory fetchClassOf: oop) to: #usqInt.
+ 
+ 	(objectMemory isIntegerObject: oopClass) ifTrue:
+ 		[self print: 'a SmallInteger is not a valid class or behavior'; cr. ^false].
+ 	(objectMemory okayOop: oopClass) ifFalse:
+ 		[self print: 'class oop is not ok'; cr. ^false].
+ 	((objectMemory isPointers: oopClass) and: [(objectMemory lengthOf: oopClass) >= 3]) ifFalse:
+ 		[self print: 'a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
+ 	formatMask := (objectMemory isBytes: oop)
+ 						ifTrue: [16rC00]  "ignore extra bytes size bits"
+ 						ifFalse: [16rF00].
+ 
+ 	behaviorFormatBits := (objectMemory formatOfClass: oopClass) bitAnd: formatMask.
+ 	oopFormatBits := (objectMemory baseHeader: oop) bitAnd: formatMask.
+ 	behaviorFormatBits = oopFormatBits ifFalse:
+ 		[self print: 'object and its class (behavior) formats differ'; cr. ^false].
+ 	^true!

Item was changed:
  ----- Method: StackInterpreter>>findHomeForContext: (in category 'debug printing') -----
  findHomeForContext: aContext
  	| closureOrNil |
  	<inline: false>
+ 	(self isContext: aContext) ifFalse:
+ 		[^nil].
  	closureOrNil := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	closureOrNil = objectMemory nilObject ifTrue:
  		[^aContext].
+ 	(objectMemory fetchClassOf: closureOrNil) ~= (objectMemory splObj: ClassBlockClosure) ifTrue:
+ 		[^nil].
  	^self findHomeForContext: (objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closureOrNil)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiver:numArgs: (in category 'frame access') -----
  frameStackedReceiver: theFP numArgs: numArgs
  	"Answer the stacked receiver given the frame's argument count.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^stackPages longAt: theFP + (self frameStackedReceiverOffsetNumArgs: numArgs)!
- 	^stackPages longAt: theFP + FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiverOffset: (in category 'frame access') -----
  frameStackedReceiverOffset: theFP
+ 	"Answer the offset in bytes from the the frame pointer to its stacked receiver.
- 	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^self frameStackedReceiverOffsetNumArgs: (self frameNumArgs: theFP)!
- 	^FoxCallerSavedIP + BytesPerWord + ((self frameNumArgs: theFP) << ShiftForWord)!

Item was removed:
- ----- Method: StackInterpreter>>frameStackedReceiverOffset:numArgs: (in category 'frame access') -----
- frameStackedReceiverOffset: theFP numArgs: numArgs
- 	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
- 	 The receiver of a message send or the closure of a block activation is
- 	 always on the stack above any arguments and the frame itself.  See the
- 	 diagram in StackInterpreter class>>initializeFrameIndices."
- 	<inline: true>
- 	<var: #theFP type: #'char *'>
- 	^FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was added:
+ ----- Method: StackInterpreter>>frameStackedReceiverOffsetNumArgs: (in category 'frame access') -----
+ frameStackedReceiverOffsetNumArgs: numArgs
+ 	"Answer the offset in bytes from the a frame pointer to its stacked receiver,
+ 	 given the argument count.  The receiver of a message send or the closure of
+ 	 a block activation is always on the stack above any arguments and the frame
+ 	 itself.  See the diagram in StackInterpreter class>>initializeFrameIndices."
+ 	<inline: true>
+ 	^FoxCallerSavedIP + BytesPerWord + (numArgs << ShiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>printFrameAndCallers:SP: (in category 'debug printing') -----
  printFrameAndCallers: theFP SP: theSP
+ 	self printFrameAndCallers: theFP SP: theSP short: false!
- 	<inline: false>
- 	<var: #theFP type: #'char *'>
- 	<var: #theSP type: #'char *'>
- 	(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
- 	(self isBaseFrame: theFP) ifFalse:
- 		[self printFrameAndCallers: (self frameCallerFP: theFP)
- 			SP: (self frameCallerSP: theFP)].
- 	self cr.
- 	self printFrame: theFP WithSP: theSP!

Item was added:
+ ----- Method: StackInterpreter>>printFrameAndCallers:SP:short: (in category 'debug printing') -----
+ printFrameAndCallers: theFP SP: theSP short: printShort
+ 	<inline: false>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
+ 	(stackPages couldBeFramePointer: theFP) ifFalse: [^nil].
+ 	(self isBaseFrame: theFP) ifFalse:
+ 		[self printFrameAndCallers: (self frameCallerFP: theFP)
+ 			SP: (self frameCallerSP: theFP)
+ 			short: printShort].
+ 	self cr.
+ 	printShort
+ 		ifTrue: [self shortPrintFrame: theFP]
+ 		ifFalse: [self printFrame: theFP WithSP: theSP]!

Item was changed:
  ----- Method: StackInterpreter>>printFramesInPage: (in category 'debug printing') -----
  printFramesInPage: thePage
+ 	<export: true> "use export: not api, so it won't be written to cointerp.h. cogit.c is unaware of StackPage"
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
+ 	self printFrameAndCallers: thePage headFP SP: thePage headSP short: false!
- 	self printFrameAndCallers: thePage headFP SP: thePage headSP!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintContext: (in category 'debug printing') -----
  shortPrintContext: aContext
+ 	| theFP |
- 	| home theFP |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	(self isContext: aContext) ifFalse:
  		[self printHex: aContext; print: ' is not a context'; cr.
  		^nil].
- 	home := self findHomeForContext: aContext.
  	self printHex: aContext.
  	(self isMarriedOrWidowedContext: aContext)
  		ifTrue: [(self checkIsStillMarriedContext: aContext currentFP: framePointer)
  					ifTrue:
  						[(self isMachineCodeFrame: (theFP := self frameOfMarriedContext: aContext))
  							ifTrue: [self print: ' M (']
  							ifFalse: [self print: ' I ('].
  						 self printHex: theFP; print: ') ']
  					ifFalse:
  						[self print: ' w ']]
  		ifFalse: [self print: ' s '].
+ 	(self findHomeForContext: aContext)
+ 		ifNil: [self print: ' BOGUS CONTEXT (can''t determine home)']
+ 		ifNotNil:
+ 			[:home|
+ 			self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: aContext)
+ 		receiver: (home isNil
+ 					ifTrue: [objectMemory nilObject]
+ 					ifFalse: [objectMemory fetchPointer: ReceiverIndex ofObject: home])
- 	self printActivationNameFor: (objectMemory fetchPointer: MethodIndex ofObject: home)
- 		receiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home)
  		isBlock: home ~= aContext
+ 		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home)].
- 		firstTemporary: (objectMemory fetchPointer: 0 + CtxtTempFrameStart ofObject: home).
  	self cr!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFramesInPage: (in category 'debug printing') -----
  shortPrintFramesInPage: thePage
+ 	<export: true> "use export: not api, so it won't be written to cointerp.h. cogit.c is unaware of StackPage"
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
+ 	self printFrameAndCallers: thePage headFP SP: thePage headSP short: true!
- 	self shortPrintFrameAndCallers: thePage headFP!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printCurrPageFrames (in category 'debug printing') -----
- printCurrPageFrames
- 	self printFrameAndCallers: localFP SP: localSP!



More information about the Vm-dev mailing list