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

commits at source.squeak.org commits at source.squeak.org
Tue Mar 18 00:19:28 UTC 2014


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

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

Name: VMMaker.oscog-eem.643
Author: eem
Time: 17 March 2014, 5:17:01.477 pm
UUID: 9fbc0481-828d-43dc-8c73-012d2e427a77
Ancestors: VMMaker.oscog-eem.642

More simulation/debugging work.

Make CoInterpreter>>printFrame: not mislead as to the number of
temps in a block activation.

Make maybeCheckStackDepth:sp:pc: cope with the pc for an unwind-
protect callback.

Void the cached stack depths on any GC to avoid false assert-fails.

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

Item was changed:
  ----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
  printFrame: theFP WithSP: theSP
  	<api>
  	| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #addr type: #'char *'>
  	<var: #rcvrAddress type: #'char *'>
  	<var: #cogMethod type: #'CogBlockMethod *'>
  	<var: #homeMethod type: #'CogMethod *'>
  	self cCode: '' inSmalltalk: [self transcript ensureCr].
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[| cogMethod homeMethod |
  			 cogMethod := self mframeCogMethod: theFP.
  			 homeMethod := self mframeHomeMethod: theFP.
  			 theMethod := homeMethod asInteger.
  			 theMethodEnd := homeMethod asInteger + homeMethod blockSize.
  			 numArgs := cogMethod cmNumArgs.
  			 numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
  		ifFalse:
  			[theMethod := self frameMethodObject: theFP.
  			 theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
  			 numArgs := self iframeNumArgs: theFP.
  			 numTemps := self tempCountOf: theMethod].
  	(self frameIsBlockActivation: theFP) ifTrue:
  		[| rcvrOrClosure |
+ 		 "No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs"
  		 rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
  		 ((objectMemory isNonImmediate: rcvrOrClosure)
  		 and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
  		 and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
  			ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
+ 			ifFalse: [numTemps := numArgs]].
- 			ifFalse: [numTemps := 0]].
  	self shortPrintFrame: theFP.
  	(self isBaseFrame: theFP) ifTrue:
  		[self printFrameOop: '(caller ctxt'
  			at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * BytesPerWord).
  		 self printFrameOop: '(saved ctxt'
  			at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * BytesPerWord)].
  	self printFrameOop: 'rcvr/clsr'
  		at: theFP + FoxCallerSavedIP + ((numArgs + 1) * BytesPerWord).
  	numArgs to: 1 by: -1 do:
  		[:i|
  		self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * BytesPerWord)].
  	self printFrameThing: 'caller ip'
  		at: theFP + FoxCallerSavedIP
  		extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
  						['ceReturnToInterptreter']).
  	self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
  	self printFrameMethodFor: theFP.
  	(self isMachineCodeFrame: theFP) ifFalse:
  		[self printFrameFlagsForFP: theFP].
  	self printFrameOop: 'context' at: theFP + FoxThisContext.
  	(self isMachineCodeFrame: theFP) ifTrue:
  		[self printFrameFlagsForFP: theFP].
  	(self isMachineCodeFrame: theFP)
  		ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
  		ifFalse:
  			[self printFrameThing: 'saved ip'
  				at: theFP + FoxIFSavedIP
  				extra: ((self iframeSavedIP: theFP) = 0
  							ifTrue: [0]
  							ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - BaseHeaderSize]).
  			 rcvrAddress := theFP + FoxIFReceiver].
  	self printFrameOop: 'receiver' at: rcvrAddress.
  	topThing := stackPages longAt: theSP.
  	(topThing between: theMethod and: theMethodEnd)
  		ifTrue:
  			[rcvrAddress - BytesPerWord to: theSP + BytesPerWord by: BytesPerWord negated do:
  				[:addr| | index |
  				index := rcvrAddress - addr / BytesPerWord + numArgs.
  				index <= numTemps
  					ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
+ 					ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
+ 													ifTrue: ['temp/stck']
+ 													ifFalse: ['stck'])
+ 								at: addr]].
- 					ifFalse: [self printFrameOop: 'stck' at: addr]].
  			self printFrameThing: 'frame ip'
  				at: theSP
  				extra: ((self isMachineCodeFrame: theFP)
  						ifTrue: [topThing - theMethod]
  						ifFalse: [topThing - theMethod + 2 - BaseHeaderSize])]
  		ifFalse:
  			[rcvrAddress - BytesPerWord to: theSP by: BytesPerWord negated do:
  				[:addr| | index |
  				index := rcvrAddress - addr / BytesPerWord + numArgs.
  				index <= numTemps
  					ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
+ 					ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
+ 													ifTrue: ['temp/stck']
+ 													ifFalse: ['stck'])
+ 								at: addr]]]!
- 					ifFalse: [self printFrameOop: 'stck' at: addr]]]!

Item was changed:
  ----- Method: CogVMSimulator>>maybeCheckStackDepth:sp:pc: (in category 'debug support') -----
  maybeCheckStackDepth: delta sp: sp pc: mcpc
+ 	| asp bcpc startbcpc cogHomeMethod cogBlockMethod csp debugStackPointers |
- 	| asp bcpc cogHomeMethod cogBlockMethod csp debugStackPointers |
  	debugStackDepthDictionary ifNil: [^self].
  	(self isMachineCodeFrame: framePointer) ifFalse: [^self].
  	cogBlockMethod := self mframeCogMethod: framePointer.
  	cogHomeMethod := self asCogHomeMethod: cogBlockMethod.
  	debugStackPointers := debugStackDepthDictionary
  								at: cogHomeMethod methodObject
  								ifAbsentPut: [self debugStackPointersFor: cogHomeMethod methodObject].
+ 	startbcpc := cogHomeMethod = cogBlockMethod
+ 					ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
+ 					ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)].
+ 	bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in: cogBlockMethod.
- 	bcpc := cogit
- 				bytecodePCFor: mcpc
- 				startBcpc: (cogHomeMethod = cogBlockMethod
- 								ifTrue: [self startPCOfMethod: cogHomeMethod methodObject]
- 								ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)])
- 				in: cogBlockMethod.
  	self assert: bcpc ~= 0.
+ 	cogBlockMethod ~= cogHomeMethod ifTrue:
+ 		[| lastbcpc |
+ 		 lastbcpc := cogit lastBytecodePCForBlockAt: startbcpc in: cogHomeMethod methodObject.
+ 		 bcpc > lastbcpc ifTrue:
+ 			[bcpc := lastbcpc]].
  	asp := self stackPointerIndexForFrame: framePointer WithSP: sp + BytesPerWord.
  	csp := debugStackPointers at: bcpc.
  	"Compensate lazily for absent receiver sends."
  	(NewspeakVM
  	 and: [asp - delta = csp
  	 and: [cogit isAbsentReceiverSendAt: mcpc in: cogHomeMethod]]) ifTrue:
  		[csp := debugStackPointers at: bcpc put: csp + 1].
  	self assert: asp - delta + 1 = csp!

Item was added:
+ ----- Method: CogVMSimulator>>preGCAction: (in category 'object memory support') -----
+ preGCAction: gcModeArg
+ 	"Override to void debugStackPointers on any GC/remap"
+ 	debugStackDepthDictionary ifNotNil:
+ 		[debugStackDepthDictionary := Dictionary new].
+ 	^super preGCAction: gcModeArg!

Item was added:
+ ----- Method: Cogit>>lastBytecodePCForBlockAt:in: (in category 'method map') -----
+ lastBytecodePCForBlockAt: startbcpc in: aMethodObj
+ 	"Answer the 0-relative pc of the last bytecode in the block starting at the 0-relative startbcpc in aMethodObj."
+ 	| methodHeader bcpc bsOffset byte descriptor |
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	methodHeader := coInterpreter headerOf: aMethodObj.
+ 	bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: methodHeader).
+ 	bsOffset := self bytecodeSetOffsetForHeader: methodHeader.
+ 	byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
+ 	descriptor := self generatorAt: byte.
+ 	^(self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj) - 1!



More information about the Vm-dev mailing list