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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 9 19:55:10 UTC 2015


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

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

Name: VMMaker.oscog-eem.1012
Author: eem
Time: 8 January 2015, 5:00:01.721 pm
UUID: 0c6e99ae-1afa-4f1e-a20c-3ded152f264d
Ancestors: VMMaker.oscog-eem.1011

Spur:
Make sure the saved contexts at the top of each
stack page are followed post-become in
followForwardingPointersInStackZone:.

Add an assert to Spur's shouldRemapObj: to verify
that new space references are only visited once in
a scavenge.

Add asserts to check that contexts are not
forwarded when marrying stable contexts.

General:
Never inline mapStackPages, for debugging.

Add an assert to returnToExecutive:postContextSwitch:
to ensure the instructionPointer is valid when
checking for being at a send return pc.

Eliminate the simulator overrides for
withSmallIntegerTags: and don't assume the
SmallInteger tag pattern.

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

Item was changed:
  ----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
  	 To avoid a read barrier on inst var fetch we scan the receivers in the stack zone and follow
  	 any forwarded ones.  This is way cheaper than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP oop offset |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asUnsignedInteger.
  					 theSP := theSP + objectMemory wordSize].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  offset := self frameStackedReceiverOffset: theFP.
  			  oop := stackPages longAt: theFP + offset.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theFP + offset
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			 (self isMachineCodeFrame: theFP)
  				ifTrue:
  					[oop := stackPages longAt: theFP + FoxMFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxMFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := (self mframeHomeMethod: theFP) methodObject.
  					 self assert: (objectMemory isForwarded: oop) not]
  				ifFalse:
  					[oop := stackPages longAt: theFP + FoxIFReceiver.
  					 (objectMemory isOopForwarded: oop) ifTrue:
  						[stackPages
  							longAt: theFP + FoxIFReceiver
  							put: (objectMemory followForwarded: oop)].
  					 oop := self iframeMethod: theFP.
  					 (objectMemory isForwarded: oop) ifTrue:
  						[| newOop delta |
  						 newOop := objectMemory followForwarded: oop.
  						 delta := newOop - oop.
  						 (theIPPtr ~= 0
  						  and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
  							[stackPages
  								longAt: theIPPtr
  								put: (stackPages longAt: theIPPtr) + delta].
  						stackPages
  							longAt: theFP + FoxIFSavedIP
  							put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
  						stackPages
  							longAt: theFP + FoxMethod
  							put: (oop := newOop)]].
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
+ 				 theFP := callerFP].
+ 			 theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ 			 [theSP <= thePage baseAddress] whileTrue:
+ 				[oop := stackPages longAt: theSP.
+ 				 (objectMemory isForwarded: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
+ 				 theSP := theSP + objectMemory wordSize]]]!
- 				 theFP := callerFP]]]!

Item was changed:
  ----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build the base
  	 frame to reflect the context's state.  Answer the new page.  Override to
  	 hold the caller context in a different place,  In the StackInterpreter we use
  	 the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
  	 trampoline.  Simply hold the caller context in the first word of the stack."
  	<returnTypeC: #'StackPage *'>
  	| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
  	<var: #cogMethod type: #'CogMethod *'>
  	"theIP must be typed as signed because it is assigned ceCannotResumePC and so maybe implicitly typed as unsigned."
  	<var: #theIP type: #sqInt>
+ 	self assert: (objectMemory isContext: aContext).
  	self assert: (self isSingleContext: aContext).
  	self assert: (objectMemory goodContextSize: aContext).
  	theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	self assert: HasBeenReturnedFromMCPC signedIntFromLong < 0.
  	theIP := (objectMemory isIntegerObject: theIP)
  				ifTrue: [objectMemory integerValueOf: theIP]
  				ifFalse: [HasBeenReturnedFromMCPC].
  	theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  	page := self newStackPage.
  	"first word on stack is caller context of base frame"
  	stackPages
  		longAt: (pointer := page baseAddress)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: aContext.
  	rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  	maybeClosure ~= objectMemory nilObject
  		ifTrue:
  			[numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: maybeClosure]
  		ifFalse:
  			[| header |
  			 header := objectMemory methodHeaderOf: theMethod.
  			 numArgs := self argumentCountOfMethodHeader: header.
  			 "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  			 (theIP signedIntFromLong > 0
  			  and: [(self methodHeaderHasPrimitive: header)
  			  and: [theIP = (1 + (objectMemory lastPointerOf: theMethod))]]) ifTrue:
  				[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  			 stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: rcvr].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - objectMemory wordSize)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is base return trampoline"
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: cogit ceBaseFrameReturnPC.
  	"base frame's saved fp is null"
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: 0.
  	"N.B.  Don't set the baseFP, which marks the page as in use, until after
  	 ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
  	 can cause a compiled code compaction which, if marked as in use, will
  	 examine this partially initialized page and crash."
  	page headFP: pointer.
  	"Create either a machine code frame or an interpreter frame based on the pc.  If the pc is -ve
  	 it is a machine code pc and so we produce a machine code frame.  If +ve an interpreter frame.
  	 N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
  	 any circumstances.  See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
  	theIP signedIntFromLong < 0
  		ifTrue:
  			[| cogMethod |
  			 "Since we would have to generate a machine-code method to be able to map
  			  the native pc anyway we should create a native method and native frame."
  			 cogMethod := self ensureMethodIsCogged: theMethod.
  			 theMethod := cogMethod asInteger.
  			 maybeClosure ~= objectMemory nilObject
  				ifTrue:
  					["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP = HasBeenReturnedFromMCPC signedIntFromLong
  						ifTrue:
  							[theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
  												inHomeMethod: (self cCoerceSimple: theMethod
  																	to: #'CogMethod *')) asInteger.
  							 theMethod = 0 ifTrue:
  								[self error: 'cannot find machine code block matching closure''s startpc'].
  							 theIP := cogit ceCannotResumePC]
  						ifFalse:
  							[self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
  							 theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
  							 theIP := theMethod - theIP signedIntFromShort].
  					 stackPages
  						longAt: (pointer := pointer - objectMemory wordSize)
  						put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
  				ifFalse:
  					[self assert: (theIP signedBitShift: -16) >= -1.
  					 "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
  					  appropriately so that the frame stays in the cannotReturn: state."
  					 theIP := theIP = HasBeenReturnedFromMCPC signedIntFromLong
  								ifTrue: [cogit ceCannotResumePC]
  								ifFalse: [theMethod asInteger - theIP].
  					 stackPages
  						longAt: (pointer := pointer - objectMemory wordSize)
  						put: theMethod + MFMethodFlagHasContextFlag].
  			 stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: aContext]
  		ifFalse:
  			[stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: theMethod.
  			stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: aContext.
  			stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  			stackPages
  				longAt: (pointer := pointer - objectMemory wordSize)
  				put: 0. "FoxIFSavedIP"
  			theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
  	page baseFP: page headFP.
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: rcvr.
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - objectMemory wordSize)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"top of stack is the instruction pointer"
  	stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  	page headSP: pointer.
  	self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
  
  	"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) plus SmallInteger tags."
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  	self assert: (self validStackPageBaseFrame: page).
  	^page!

Item was changed:
  ----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
+ 	<inline: #never>
- 	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := ((self isMachineCodeFrame: theFP)
  									or: [(self iframeSavedIP: theFP) = 0])
  										ifTrue: [0]
  										ifFalse: [theFP + FoxIFSavedIP]]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + objectMemory wordSize].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 frameRcvrOffset := self frameReceiverOffset: theFP.
  	 		  [theSP <= frameRcvrOffset] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize].
  			 (self frameHasContext: theFP) ifTrue:
  				[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
  					[stackPages
  						longAt: theFP + FoxThisContext
  						put: (objectMemory remapObj: (self frameContext: theFP))].
  				 "forwarding scheme in SqueakV3 obj rep makes this hard to check."
  				 objectMemory hasSpurMemoryManagerAPI ifTrue:
  					[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
  								and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
  			(self isMachineCodeFrame: theFP) ifFalse:
  				[(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue:
  					[theIPPtr ~= 0 ifTrue:
  						[theIP := stackPages longAt: theIPPtr.
  						 theIP = cogit ceReturnToInterpreterPC
  							ifTrue:
  								[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
  								 theIPPtr := theFP + FoxIFSavedIP.
  								 theIP := stackPages longAt: theIPPtr]
  							ifFalse:
  								[self assert: theIP > (self iframeMethod: theFP)].
  						 theIP := theIP - (self iframeMethod: theFP)].
  					 stackPages
  						longAt: theFP + FoxMethod
  						put: (objectMemory remapObj: (self iframeMethod: theFP)).
  					 theIPPtr ~= 0 ifTrue:
  						[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize]]]!

Item was changed:
  ----- Method: CoInterpreter>>returnToExecutive:postContextSwitch: (in category 'enilopmarts') -----
  returnToExecutive: inInterpreter postContextSwitch: switchedContext
  	"Return to the current frame, either by entering machine code, or longjmp-ing back to the
  	 interpreter or simply returning, depending on where we are. To know whether to return or
  	 enter machine code we have to know from whence we came.  We could have come from
  	 the interpreter, either directly or via a machine code primitive.  We could have come from
  	 machine code.  The instructionPointer tells us where from.  If it is above startOfMemory we're
  	 in the interpreter.  If it is below, then we are in machine-code unless it is ceReturnToInterpreterPC,
  	 in which case we're in a machine-code primitive called from the interpreter."
  	<inline: false>
  	| cogMethod retValue fullyInInterpreter |
  	<var: #cogMethod type: #'CogBlockMethod *'>
  
  	cogit assertCStackWellAligned.
  	(self isMachineCodeFrame: framePointer) ifTrue:
  		[self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
  		 "If returning after a context switch then a result may have to be popped from the stack.
  		  If the process is suspended at a send then the result of the primitive in which the
  		  process was suspended is still on the stack and must be popped into ReceiverResultReg.
  		  If not, nothing should be popped and ReceiverResultReg gets the receiver."
  		 switchedContext
  			ifTrue:
  				[cogMethod := self mframeCogMethod: framePointer.
+ 				self assert: (instructionPointer > cogit minCogMethodAddress 
+ 							and: [instructionPointer < cogit maxCogMethodAddress]).
  				 (instructionPointer ~= (cogMethod asInteger + cogMethod stackCheckOffset)
  				  and: [cogit isSendReturnPC: instructionPointer])
  					ifTrue:
  						[self assert: (objectMemory addressCouldBeOop: self stackTop).
  						 retValue := self popStack]
  					ifFalse:
  						[retValue := self mframeReceiver: framePointer]]
  			ifFalse: [retValue := self mframeReceiver: framePointer].
  		 self push: instructionPointer.
  		 self push: retValue.
  		 cogit ceEnterCogCodePopReceiverReg
  		 "NOTREACHED"].
  	self setMethod: (self iframeMethod: framePointer).
  	fullyInInterpreter := inInterpreter.
  	instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  		[instructionPointer := (self iframeSavedIP: framePointer) asUnsignedInteger.
  		 fullyInInterpreter := false].
  	self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'.
  	fullyInInterpreter ifFalse:
  		[self siglong: reenterInterpreter jmp: ReturnToInterpreter.
  		 "NOTREACHED"].
  	^nil!

Item was removed:
- ----- Method: CogVMSimulator>>withSmallIntegerTags: (in category 'frame access') -----
- withSmallIntegerTags: aValueOrSurrogate
- 	"The simulator works with strictly positive bit patterns"
- 	| value |
- 	value := aValueOrSurrogate asInteger.
- 	^value < 0
- 		ifTrue: [(value bitAnd: 16rFFFFFFFF) + 1]
- 		ifFalse: [value + 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>asUnsigned: (in category 'primitive support') -----
  asUnsigned: anInteger
  	<inline: true>
+ 	^self cCode: [anInteger asUnsignedLong] inSmalltalk: [anInteger bitAnd: objectMemory maxCInteger]!
- 	^self cCode: [anInteger asUnsignedLong] inSmalltalk: [anInteger bitAnd: objectMemory maxSmallInteger]!

Item was added:
+ ----- Method: NewObjectMemory>>smallIntegerTag (in category 'cog jit support') -----
+ smallIntegerTag
+ 	^1!

Item was added:
+ ----- Method: ObjectMemory>>maxCInteger (in category 'interpreter access') -----
+ maxCInteger
+ 	^16rFFFFFFFF!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>maxCInteger (in category 'interpreter access') -----
+ maxCInteger
+ 	^16rFFFFFFFF!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>maxCInteger (in category 'interpreter access') -----
+ maxCInteger
+ 	^16rFFFFFFFFFFFFFFFF!

Item was added:
+ ----- Method: SpurMemoryManager>>maxCInteger (in category 'interpreter access') -----
+ maxCInteger
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'gc - scavenging') -----
  shouldRemapObj: objOop
  	<api>
  	"Answer if the obj should be scavenged (or simply followed). The method is called
  	 shouldRemapObj: for compatibility with ObjectMemory."
  	^(self isForwarded: objOop)
+ 	  or: [self deny: (self isInFutureSpace: objOop).
+ 		  self isReallyYoungObject: objOop]!
- 	  or: [self isReallyYoungObject: objOop]!

Item was changed:
  ----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
  followForwardingPointersInStackZone: theBecomeEffectsFlags
  	"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
  	 The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
  	 probe, since notionally objects' internals are accessed only via sending messages to them,
  	 the exception is primitives that access the internals of the non-receiver argument(s).
  	 To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and
  	 methods in the stack zone and follow any forwarded ones.  This is of course way cheaper
  	 than scanning all of memory as in the old become."
  	| theIPPtr |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #usqInt>
  
  	(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  		[(objectMemory isForwarded: method) ifTrue:
  			[theIPPtr := instructionPointer - method.
  			 method := objectMemory followForwarded: method.
  			 instructionPointer := method + theIPPtr].
  		(objectMemory isForwarded: newMethod) ifTrue:
  			[newMethod := objectMemory followForwarded: newMethod]].
  
  	self assert: stackPage ~= 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP asInteger.
  					 theSP := theSP + objectMemory wordSize].
  			 [self assert: (thePage addressIsInPage: theFP).
  			  self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
  			  oop := stackPages longAt: theFP + FoxReceiver.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theFP + FoxReceiver
  					put: (objectMemory followForwarded: oop)].
  			  theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asInteger. "reuse theIP; its just an offset here"
  			  oop := stackPages longAt: theIP.
  			  (objectMemory isOopForwarded: oop) ifTrue:
  				[stackPages
  					longAt: theIP
  					put: (objectMemory followForwarded: oop)].
  			  ((self frameHasContext: theFP)
  			   and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory followForwarded: (self frameContext: theFP))].
  			  oop := self frameMethod: theFP.
  			  (objectMemory isForwarded: oop) ifTrue:
  				[| newOop delta |
  				 newOop := objectMemory followForwarded: oop.
  				 theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 delta := newOop - oop.
  					 stackPages
  						longAt: theIPPtr
  						put: (stackPages longAt: theIPPtr) + delta].
  				stackPages
  					longAt: theFP + FoxMethod
  					put: (oop := newOop)].
  			  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := (theFP + FoxCallerSavedIP) asInteger.
+ 				 theFP := callerFP].
+ 			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
+ 			 [theSP <= thePage baseAddress] whileTrue:
+ 				[oop := stackPages longAt: theSP.
+ 				 (objectMemory isForwarded: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
+ 				 theSP := theSP + objectMemory wordSize]]]!
- 				 theFP := callerFP]]]!

Item was changed:
  ----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build the base
  	 frame to reflect the context's state.  Answer the new page."
  	<returnTypeC: #'StackPage *'>
  	| page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
+ 	self assert: (objectMemory isContext: aContext).
  	self assert: (self isSingleContext: aContext).
  	self assert: (objectMemory goodContextSize: aContext).
  	page := self newStackPage.
  	pointer := page baseAddress.
  	theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  	(objectMemory isIntegerObject: theIP) ifFalse:
  		[self error: 'context is not resumable'].
  	theIP := objectMemory integerValueOf: theIP.
  	rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := objectMemory followField: ClosureIndex ofObject: aContext.
  	maybeClosure ~= objectMemory nilObject
  		ifTrue:
  			[numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages longAt: pointer put: maybeClosure]
  		ifFalse:
  			[| header |
  			 header := objectMemory methodHeaderOf: theMethod.
  			 numArgs := self argumentCountOfMethodHeader: header.
  			 "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
  			 (theIP signedIntFromLong > 0
  			  and: [(self methodHeaderHasPrimitive: header)
  			  and: [theIP = (1 + (objectMemory lastPointerOf: theMethod))]]) ifTrue:
  				[theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  			 stackPages longAt: pointer put: rcvr].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - objectMemory wordSize)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is sender context in base frame"
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"base frame's saved fp is null"
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: 0.
  	page baseFP: pointer; headFP: pointer.
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: theMethod.
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: aContext.
  	stackPages
  		longAt: (pointer := pointer - objectMemory wordSize)
  		put: rcvr.
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
  			longAt: (pointer := pointer - objectMemory wordSize)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"top of stack is the instruction pointer"
  	theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
  	stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  	page headSP: pointer.
  	self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
  
  	"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) plus SmallInteger tags."
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  	self assert: (self validStackPageBaseFrame: page).
  	^page!

Item was changed:
  ----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
+ 	<inline: #never>
- 	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIPPtr theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + objectMemory wordSize].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 [theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize].
  			 (self frameHasContext: theFP) ifTrue:
  				[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
  					[stackPages
  						longAt: theFP + FoxThisContext
  						put: (objectMemory remapObj: (self frameContext: theFP))].
  				 "With SqueakV3 objectMemory can't assert since object body is yet to move."
  				 objectMemory hasSpurMemoryManagerAPI ifTrue:
  					[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
  								  and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
  			 (objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
  				[theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  				 stackPages
  					longAt: theFP + FoxMethod
  					put: (objectMemory remapObj: (self frameMethod: theFP)).
  				 theIPPtr ~= 0 ifTrue:
  					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize]]]!

Item was changed:
  ----- Method: StackInterpreter>>withSmallIntegerTags: (in category 'frame access') -----
  withSmallIntegerTags: value
  	<inline: true>
  	<var: #value type: #'char *'>
  	self assert: ((self oopForPointer: value) bitAnd: objectMemory wordSize - 1) = 0.
+ 	^(self
+ 		cCode: [self oopForPointer: value]
+ 		inSmalltalk: [value bitAnd: objectMemory maxCInteger]) + objectMemory smallIntegerTag!
- 	^(self oopForPointer: value) + 1!

Item was removed:
- ----- Method: StackInterpreterSimulator>>withSmallIntegerTags: (in category 'frame access') -----
- withSmallIntegerTags: value
- 	"The simulator works with strictly positive bit patterns"
- 	^value < 0
- 		ifTrue: [(value bitAnd: 16rFFFFFFFF) + 1]
- 		ifFalse: [value + 1]!



More information about the Vm-dev mailing list