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

commits at source.squeak.org commits at source.squeak.org
Sat Jun 23 21:20:58 UTC 2012


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

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

Name: VMMaker.oscog-eem.165
Author: eem
Time: 23 June 2012, 2:18:33.789 pm
UUID: 4e4f16aa-51e6-4806-8764-613b5d38d7df
Ancestors: VMMaker.oscog-eem.164

Nuke tempCountOfMethodHeader: in favour of temporaryCountOfMethodHeader:.
Refactor frame marriage to allow subclasses to specify saving of temps.

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

Item was changed:
  ----- Method: CoInterpreter class>>exportAPISelectors (in category 'translation') -----
  exportAPISelectors
  	"Yes this is a mess.  When all exportAPI methods are marked with the <api> pragma
  	 this can go away."
  	| omExports |
  	omExports := (self objectMemoryClass withAllSuperclasses copyUpTo: VMClass)
  					inject: Set new into: [:api :c| api addAll: c exportAPISelectors; yourself].
  	^((self withAllSuperclasses copyUpTo: VMClass),
  		self ancilliaryClasses
  			inject: omExports
  			into: [:set :class| set addAll: (self exportAPISelectorsFor: class); yourself])
  	 	addAll: #(	argumentCountOfMethodHeader:
  					canContextSwitchIfActivating:
  					classHeader:
  					compactClassIndexOf:
  					fetchByte:ofObject:
  					functionPointerFor:inClass:
  					isNonIntegerObject:
  					lastPointerOf:
  					literal:ofMethod:
  					popStack
  					primitiveClosureValueNoContextSwitch
  					specialSelector:
  					stackTop
+ 					tempCountOf:);
- 					tempCountOf:
- 					tempCountOfMethodHeader:);
  		yourself!

Item was added:
+ ----- Method: CoInterpreter>>frameNumTemps: (in category 'trampolines') -----
+ frameNumTemps: theFP
+ 	"For subclasses to redefine to implement different closure semantics."
+ 	<var: #theFP type: #'char *'>
+ 	^0!

Item was changed:
  ----- Method: CoInterpreter>>internalActivateNewMethod (in category 'message sending') -----
  internalActivateNewMethod
  	| methodHeader numTemps rcvr errorCode switched |
  	<inline: true>
  
  	methodHeader := self rawHeaderOf: newMethod.
  	self assert: (self isCogMethodReference: methodHeader) not.
+ 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
- 	numTemps := self tempCountOfMethodHeader: methodHeader.
  
  	rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?"
  
  	self internalPush: localIP.
  	self internalPush: localFP.
  	localFP := localSP.
  	self internalPush: newMethod.
  	self setMethod: newMethod.
  	self internalPush: objectMemory nilObject. "FxThisContext field"
  	self internalPush: (self
  						encodeFrameFieldHasContext: false
  						isBlock: false
  						numArgs: (self argumentCountOfMethodHeader: methodHeader)).
  	self internalPush: 0. "FoxIFSavedIP"
  	self internalPush: rcvr.
  
  	"Initialize temps..."
  	argumentCount + 1 to: numTemps do:
  		[:i | self internalPush: objectMemory nilObject].
  
  	"-1 to account for pre-increment in fetchNextBytecode"
  	localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1.
  
  	"Pass primitive error code to last temp if method receives it (indicated by an
  	 initial long store temp bytecode).  We don't need to check that newMethod
  	 actually has a primitive because the initial 129 only occurs if there is one."
  	primFailCode ~= 0 ifTrue:
  		[(objectMemory byteAtPointer: localIP + 1) = 129 "long store temp" ifTrue:
  			[errorCode := self getErrorObjectFromPrimFailCode.
  			 self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  		primFailCode := 0].
  
  	self assert: (self frameNumArgs: localFP) == argumentCount.
  	self assert: (self frameIsBlockActivation: localFP) not.
  	self assert: (self frameHasContext: localFP) not.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  	localSP < stackLimit ifTrue:
  		[self externalizeIPandSP.
  		 switched := self handleStackOverflowOrEventAllowContextSwitch:
  						(self canContextSwitchIfActivating: methodHeader).
  		 self returnToExecutive: true postContextSwitch: switched.
  		 self internalizeIPandSP]!

Item was removed:
- ----- Method: CoInterpreter>>marryFrame:SP: (in category 'frame access') -----
- marryFrame: theFP SP: theSP
- 	"Marry an unmarried frame.  This means creating a spouse context  initialized with
- 	 a subset of the frame's state (state through the last argument) that references the
- 	 frame. This is important enough for performance to be worth streamlining.
- 
- 	Override to set the ``has context'' flag appropriately for both machine code and interpreter frames
- 	and to streamline the machine code/interpreter differences.."
- 	| theContext methodFieldOrObj closureOrNil rcvr byteSize numArgs numStack |
- 	<inline: false>
- 	<var: #theFP type: #'char *'>
- 	<var: #theSP type: #'char *'>
- 	<var: #cogMethod type: #'CogMethod *'>
- 	self assert: (self frameHasContext: theFP) not.
- 	self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing"
- 
- 	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
- 	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
- 	 context isn't informative enough in a debugging situation.  We compromise, retaining
- 	 only the arguments with no temporaries.  Note that we still set the stack pointer to its
- 	 current value, but stack contents other than the arguments are nil."
- 	methodFieldOrObj := self frameMethodField: theFP.
- 	methodFieldOrObj asUnsignedInteger < objectMemory startOfMemory "inline (self isMachineCodeFrame: theFP)"
- 		ifTrue:
- 			[| cogMethod |
- 			 stackPages
- 				longAt: theFP + FoxMethod
- 				put: methodFieldOrObj + MFMethodFlagHasContextFlag.
- 			 cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'.
- 			 numArgs := cogMethod cmNumArgs.
- 			 cogMethod cmType = CMMethod
- 				ifTrue:
- 					[closureOrNil := objectMemory nilObject]
- 				ifFalse:
- 					[cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod.
- 					 closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs].
- 			 byteSize := (cogMethod methodHeader bitAnd: LargeContextBit) ~= 0
- 							ifTrue: [LargeContextSize]
- 							ifFalse: [SmallContextSize].
- 			 methodFieldOrObj := cogMethod methodObject.
- 			 rcvr := self mframeReceiver: theFP.
- 			 numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs]
- 		ifFalse:
- 			[self setIFrameHasContext: theFP.
- 			 numArgs := self iframeNumArgs: theFP.
- 			 byteSize := ((self headerOf: methodFieldOrObj) bitAnd: LargeContextBit) ~= 0
- 							ifTrue: [LargeContextSize]
- 							ifFalse: [SmallContextSize].
- 			 closureOrNil := (self iframeIsBlockActivation: theFP)
- 								ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
- 								ifFalse: [objectMemory nilObject].
- 			 rcvr := self iframeReceiver: theFP.
- 			 numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs].
- 	theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize.
- 	self setFrameContext: theFP to: theContext.
- 	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
- 	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
- 	 w.r.t. the frame when we check for validity)"
- 	objectMemory storePointerUnchecked: SenderIndex
- 		ofObject: theContext
- 		withValue: (self withSmallIntegerTags: theFP).
- 	objectMemory storePointerUnchecked: InstructionPointerIndex
- 		ofObject: theContext
- 		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
- 	objectMemory storePointerUnchecked: StackPointerIndex
- 		ofObject: theContext
- 		withValue: (objectMemory integerObjectOf: numStack).
- 	objectMemory storePointerUnchecked: MethodIndex
- 		ofObject: theContext
- 		withValue: methodFieldOrObj.
- 	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
- 	objectMemory storePointerUnchecked: ReceiverIndex
- 		ofObject: theContext
- 		withValue: rcvr.
- 	1 to: numArgs do:
- 		[:i|
- 		objectMemory storePointerUnchecked: ReceiverIndex + i
- 			ofObject: theContext
- 			withValue: (self temporary: i - 1 in: theFP)].
- 	numArgs + 1 to: numStack do:
- 		[:i|
- 		objectMemory storePointerUnchecked: ReceiverIndex + i
- 			ofObject: theContext
- 			withValue: objectMemory nilObject].
- 
- 	self assert: (self frameHasContext: theFP).
- 	self assert: (self frameOfMarriedContext: theContext) = theFP.
- 	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
- 
- 	^theContext!

Item was added:
+ ----- Method: CoInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') -----
+ marryFrame: theFP SP: theSP copyTemps: copyTemps
+ 	"Marry an unmarried frame.  This means creating a spouse context
+ 	 initialized with a subset of the frame's state that references the frame.
+ 	 For the default closure implementation we do not need to copy temps.
+ 	 Different closure implementations may require temps to be copied.
+ 
+ 	 This method is important enough for performance to be worth streamlining.
+ 
+ 	Override to set the ``has context'' flag appropriately for both machine code and interpreter frames
+ 	and to streamline the machine code/interpreter differences.."
+ 	| theContext methodFieldOrObj closureOrNil rcvr byteSize numArgs numStack numTemps |
+ 	<inline: true>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	self assert: (self frameHasContext: theFP) not.
+ 	self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing"
+ 
+ 	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
+ 	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
+ 	 context isn't informative enough in a debugging situation.  If copyTemps is false (as it
+ 	 is in the default closure implementation) compromise, retaining only the arguments with
+ 	 no temporaries.  Note that we still set the stack pointer to its current value, but stack
+ 	 contents other than the arguments are nil."
+ 	methodFieldOrObj := self frameMethodField: theFP.
+ 	methodFieldOrObj asUnsignedInteger < objectMemory startOfMemory "inline (self isMachineCodeFrame: theFP)"
+ 		ifTrue:
+ 			[| cogMethod |
+ 			 stackPages
+ 				longAt: theFP + FoxMethod
+ 				put: methodFieldOrObj + MFMethodFlagHasContextFlag.
+ 			 cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'.
+ 			 numArgs := cogMethod cmNumArgs.
+ 			 cogMethod cmType = CMMethod
+ 				ifTrue:
+ 					[closureOrNil := objectMemory nilObject]
+ 				ifFalse:
+ 					[cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod.
+ 					 closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs].
+ 			 byteSize := (cogMethod methodHeader bitAnd: LargeContextBit) ~= 0
+ 							ifTrue: [LargeContextSize]
+ 							ifFalse: [SmallContextSize].
+ 			 methodFieldOrObj := cogMethod methodObject.
+ 			 rcvr := self mframeReceiver: theFP.
+ 			 numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs]
+ 		ifFalse:
+ 			[self setIFrameHasContext: theFP.
+ 			 numArgs := self iframeNumArgs: theFP.
+ 			 byteSize := ((self headerOf: methodFieldOrObj) bitAnd: LargeContextBit) ~= 0
+ 							ifTrue: [LargeContextSize]
+ 							ifFalse: [SmallContextSize].
+ 			 closureOrNil := (self iframeIsBlockActivation: theFP)
+ 								ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
+ 								ifFalse: [objectMemory nilObject].
+ 			 rcvr := self iframeReceiver: theFP.
+ 			 numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs].
+ 	theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize.
+ 	self setFrameContext: theFP to: theContext.
+ 	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
+ 	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
+ 	 w.r.t. the frame when we check for validity)"
+ 	objectMemory storePointerUnchecked: SenderIndex
+ 		ofObject: theContext
+ 		withValue: (self withSmallIntegerTags: theFP).
+ 	objectMemory storePointerUnchecked: InstructionPointerIndex
+ 		ofObject: theContext
+ 		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
+ 	objectMemory storePointerUnchecked: StackPointerIndex
+ 		ofObject: theContext
+ 		withValue: (objectMemory integerObjectOf: numStack).
+ 	objectMemory storePointerUnchecked: MethodIndex
+ 		ofObject: theContext
+ 		withValue: methodFieldOrObj.
+ 	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
+ 	objectMemory storePointerUnchecked: ReceiverIndex
+ 		ofObject: theContext
+ 		withValue: rcvr.
+ 	1 to: numArgs do:
+ 		[:i|
+ 		objectMemory storePointerUnchecked: ReceiverIndex + i
+ 			ofObject: theContext
+ 			withValue: (self temporary: i - 1 in: theFP)].
+ 	copyTemps ifTrue:
+ 		[numTemps := self frameNumTemps: theFP.
+ 		 1 to: numTemps do:
+ 			[:i|
+ 			objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs
+ 				ofObject: theContext
+ 				withValue: (self temporary: i - 1 in: theFP)].
+ 		 numArgs := numArgs + numTemps].
+ 
+ 	numArgs + 1 to: numStack do:
+ 		[:i|
+ 		objectMemory storePointerUnchecked: ReceiverIndex + i
+ 			ofObject: theContext
+ 			withValue: objectMemory nilObject].
+ 
+ 	self assert: (self frameHasContext: theFP).
+ 	self assert: (self frameOfMarriedContext: theContext) = theFP.
+ 	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
+ 
+ 	^theContext!

Item was changed:
  ----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
  printFrame: theFP WithSP: theSP
  	| 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]
- 			 numTemps := self tempCountOfMethodHeader: 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 |
  		 rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
  		 ((objectMemory isNonIntegerObject: rcvrOrClosure)
  		 and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
  		 and: [(objectMemory fetchClassOfNonInt: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
  			ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
  			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.
  	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: '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: 'stck' at: addr]]]!

Item was changed:
  ----- Method: StackInterpreter>>internalActivateNewMethod (in category 'message sending') -----
  internalActivateNewMethod
  	| methodHeader numTemps rcvr errorCode |
  	<inline: true>
  
  	methodHeader := self headerOf: newMethod.
+ 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
- 	numTemps := self tempCountOfMethodHeader: methodHeader.
  
  	rcvr := self internalStackValue: argumentCount. "could new rcvr be set at point of send?"
  
  	self internalPush: localIP.
  	self internalPush: localFP.
  	localFP := localSP.
  	self internalPush: newMethod.
  	self setMethod: newMethod.
  	self internalPush: (self
  						encodeFrameFieldHasContext: false
  						isBlock: false
  						numArgs: (self argumentCountOfMethodHeader: methodHeader)).
  	self internalPush: objectMemory nilObject. "FxThisContext field"
  	self internalPush: rcvr.
  
  	"Initialize temps..."
  	argumentCount + 1 to: numTemps do:
  		[:i | self internalPush: objectMemory nilObject].
  
  	"-1 to account for pre-increment in fetchNextBytecode"
  	localIP := self pointerForOop: (self initialPCForHeader: methodHeader method: newMethod) - 1.
  
  	"Pass primitive error code to last temp if method receives it (indicated
  	 by an initial long store temp bytecode).  Protect against obsolete values
  	 in primFailCode by checking that newMethod actually has a primitive?"
  	primFailCode ~= 0 ifTrue:
  		[((self methodHeaderHasPrimitive: methodHeader)
  		   and: [(objectMemory byteAtPointer: localIP + 1) = 129 "long store temp"]) ifTrue:
  			[errorCode := self getErrorObjectFromPrimFailCode.
  			 self internalStackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  		primFailCode := 0].
  
  	self assert: (self frameNumArgs: localFP) == argumentCount.
  	self assert: (self frameIsBlockActivation: localFP) not.
  	self assert: (self frameHasContext: localFP) not.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)."
  	localSP < stackLimit ifTrue:
  		[self externalizeIPandSP.
  		 self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: methodHeader).
  		 self internalizeIPandSP]!

Item was changed:
  ----- Method: StackInterpreter>>marryFrame:SP: (in category 'frame access') -----
  marryFrame: theFP SP: theSP
  	"Marry an unmarried frame.  This means creating a spouse context
  	 initialized with a subset of the frame's state (state through the last argument)
  	 that references the frame."
- 	| theContext methodHeader byteSize numArgs numStack closureOrNil |
  	<inline: false>
+ 	^self marryFrame: theFP SP: theSP copyTemps: false!
- 	<var: #theFP type: #'char *'>
- 	<var: #theSP type: #'char *'>
- 	self assert: (self frameHasContext: theFP) not.
- 
- 	methodHeader := self headerOf: (self frameMethod: theFP).
- 	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
- 	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
- 	 context isn't informative enough in a debugging situation.  We compromise, retaining
- 	 only the arguments with no temporaries.  Note that we still set the stack pointer to its
- 	 current value, but stack contents other than the arguments are nil."
- 	numArgs := self frameNumArgs: theFP.
- 	numStack := self stackPointerIndexForFrame: theFP WithSP: theSP.
- 
- 	closureOrNil := (self frameIsBlockActivation: theFP)
- 						ifTrue: [self pushedReceiverOrClosureOfFrame: theFP]
- 						ifFalse: [objectMemory nilObject].
- 
- 	byteSize := (methodHeader bitAnd: LargeContextBit) ~= 0
- 					ifTrue: [LargeContextSize]
- 					ifFalse: [SmallContextSize].
- 	theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize.
- 	self assert: numStack + ReceiverIndex << ShiftForWord + BaseHeaderSize <= byteSize. 
- 	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
- 	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
- 	 w.r.t. the frame when we check for validity)"
- 	objectMemory storePointerUnchecked: SenderIndex
- 		ofObject: theContext
- 		withValue: (self withSmallIntegerTags: theFP).
- 	objectMemory storePointerUnchecked: InstructionPointerIndex
- 		ofObject: theContext
- 		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
- 	objectMemory storePointerUnchecked: StackPointerIndex
- 		ofObject: theContext
- 		withValue: (objectMemory integerObjectOf: numStack).
- 	objectMemory storePointerUnchecked: MethodIndex
- 		ofObject: theContext
- 		withValue: (self frameMethod: theFP).
- 	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
- 	objectMemory storePointerUnchecked: ReceiverIndex
- 		ofObject: theContext
- 		withValue: (self frameReceiver: theFP).
- 	"Store just the arguments.  If the frame is divorced the context
- 	 will have valid arguments but all temporaries will be nil."
- 	1 to: numArgs do:
- 		[:i|
- 		objectMemory storePointerUnchecked: ReceiverIndex + i
- 			ofObject: theContext "inline self temporary: i - 1 in:theFP" 
- 			withValue: (stackPages longAt: theFP
- 										+ FoxCallerSavedIP
- 										+ ((numArgs - i + 1) * BytesPerWord))].
- 	numArgs + 1 to: numStack do:
- 		[:i|
- 		objectMemory storePointerUnchecked: ReceiverIndex + i
- 			ofObject: theContext
- 			withValue: objectMemory nilObject].
- 
- 	self setFrameContext: theFP to: theContext.
- 	self setFrameHasContext: theFP.
- 
- 	self assert: (self frameHasContext: theFP).
- 	self assert: (self frameOfMarriedContext: theContext) = theFP.
- 	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
- 
- 	^theContext
- !

Item was added:
+ ----- Method: StackInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') -----
+ marryFrame: theFP SP: theSP copyTemps: copyTemps
+ 	"Marry an unmarried frame.  This means creating a spouse context
+ 	 initialized with a subset of the frame's state that references the frame.
+ 	 For the default closure implementation we do not need to copy temps.
+ 	 Different closure implementations may require temps to be copied."
+ 	| theContext methodHeader byteSize numArgs numStack closureOrNil numTemps |
+ 	<inline: true>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
+ 	self assert: (self frameHasContext: theFP) not.
+ 
+ 	methodHeader := self headerOf: (self frameMethod: theFP).
+ 	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
+ 	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
+ 	 context isn't informative enough in a debugging situation.  If copyTemps is false (as it
+ 	 is in the default closure implementation) compromise, retaining only the arguments with
+ 	 no temporaries.  Note that we still set the stack pointer to its current value, but stack
+ 	 contents other than the arguments are nil."
+ 	numArgs := self frameNumArgs: theFP.
+ 	numStack := self stackPointerIndexForFrame: theFP WithSP: theSP.
+ 
+ 	closureOrNil := (self frameIsBlockActivation: theFP)
+ 						ifTrue: [self pushedReceiverOrClosureOfFrame: theFP]
+ 						ifFalse: [objectMemory nilObject].
+ 
+ 	byteSize := (methodHeader bitAnd: LargeContextBit) ~= 0
+ 					ifTrue: [LargeContextSize]
+ 					ifFalse: [SmallContextSize].
+ 	theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize.
+ 	self assert: numStack + ReceiverIndex << ShiftForWord + BaseHeaderSize <= byteSize. 
+ 	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
+ 	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
+ 	 w.r.t. the frame when we check for validity)"
+ 	objectMemory storePointerUnchecked: SenderIndex
+ 		ofObject: theContext
+ 		withValue: (self withSmallIntegerTags: theFP).
+ 	objectMemory storePointerUnchecked: InstructionPointerIndex
+ 		ofObject: theContext
+ 		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
+ 	objectMemory storePointerUnchecked: StackPointerIndex
+ 		ofObject: theContext
+ 		withValue: (objectMemory integerObjectOf: numStack).
+ 	objectMemory storePointerUnchecked: MethodIndex
+ 		ofObject: theContext
+ 		withValue: (self frameMethod: theFP).
+ 	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
+ 	objectMemory storePointerUnchecked: ReceiverIndex
+ 		ofObject: theContext
+ 		withValue: (self frameReceiver: theFP).
+ 	"If copyTemps is false, store just the arguments.  If the frame is divorced the context
+ 	 will have valid arguments but all temporaries will be nil."
+ 	1 to: numArgs do:
+ 		[:i|
+ 		objectMemory storePointerUnchecked: ReceiverIndex + i
+ 			ofObject: theContext "inline self temporary: i - 1 in:theFP" 
+ 			withValue: (stackPages longAt: theFP
+ 										+ FoxCallerSavedIP
+ 										+ ((numArgs - i + 1) * BytesPerWord))].
+ 	copyTemps ifTrue:
+ 		[numTemps := self frameNumTemps: theFP.
+ 		 1 to: numTemps do:
+ 			[:i|
+ 			objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs
+ 				ofObject: theContext
+ 				withValue: (self temporary: i - 1 in: theFP)].
+ 		 numArgs := numArgs + numTemps].
+ 
+ 	numArgs + 1 to: numStack do:
+ 		[:i|
+ 		objectMemory storePointerUnchecked: ReceiverIndex + i
+ 			ofObject: theContext
+ 			withValue: objectMemory nilObject].
+ 
+ 	self setFrameContext: theFP to: theContext.
+ 	self setFrameHasContext: theFP.
+ 
+ 	self assert: (self frameHasContext: theFP).
+ 	self assert: (self frameOfMarriedContext: theContext) = theFP.
+ 	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
+ 
+ 	^theContext
+ !

Item was changed:
  ----- Method: StackInterpreter>>tempCountOf: (in category 'compiled methods') -----
  tempCountOf: methodPointer
+ 	^self temporaryCountOfMethodHeader: (self headerOf: methodPointer)!
- 	^self tempCountOfMethodHeader: (self headerOf: methodPointer)!

Item was removed:
- ----- Method: StackInterpreter>>tempCountOfMethodHeader: (in category 'compiled methods') -----
- tempCountOfMethodHeader: header
- 	<inline: true>
- 	^ (header >> 19) bitAnd: 16r3F!

Item was changed:
  ----- Method: StackInterpreter>>temporaryCountOfMethodHeader: (in category 'compiled methods') -----
  temporaryCountOfMethodHeader: header
+ 	<inline: true>
  	^(header >> 19) bitAnd: 16r3F!



More information about the Vm-dev mailing list