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

commits at source.squeak.org commits at source.squeak.org
Wed Feb 11 02:21:54 UTC 2015


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

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

Name: VMMaker.oscog-eem.1049
Author: eem
Time: 10 February 2015, 6:20:21.812 pm
UUID: aeda18a2-b9e8-4f87-8f4f-194a0155cc4a
Ancestors: VMMaker.oscog-eem.1048

Spur:
It's the atCache, stupid.  Flush the atCache after every become.
Eliminate duplicate flush in flushExternalPrimitives.

Introduce lastPointerOfArray: and use it to slim down
become checking.  Simplify getErrorObjectFromPrimFailCode.
Use lastPointerOfMethodHeader: in makeBaseFrameFor:
to same effect.

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

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 lastPointerOfMethodHeader: header))]]) ifTrue:
- 			  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: SpurMemoryManager>>containsOnlyValidBecomeObjects: (in category 'become implementation') -----
  containsOnlyValidBecomeObjects: array
  	"Answer 0 if the array contains only unpinned non-immediates.
  	 Otherwise answer an informative error code.
  	 Can't become: immediates!!  Shouldn't become pinned objects."
  	| fieldOffset effectsFlags oop |
+ 	fieldOffset := self lastPointerOfArray: array.
- 	fieldOffset := self lastPointerOf: array.
  	effectsFlags := 0.
  	"same size as array2"
  	[fieldOffset >= self baseHeaderSize] whileTrue:
  		[oop := self longAt: array + fieldOffset.
  		 (self isOopForwarded: oop) ifTrue:
  			[oop := self followForwarded: oop.
  			 self longAt: array + fieldOffset put: oop].
  		 (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  		 (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  		 effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
  		 fieldOffset := fieldOffset - self bytesPerOop].
  	"only set flags after checking all args."
  	becomeEffectsFlags := effectsFlags.
  	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and: (in category 'become implementation') -----
  containsOnlyValidBecomeObjects: array1 and: array2
  	"Answer 0 if neither array contains only unpinned non-immediates.
  	 Otherwise answer an informative error code.
  	 Can't become: immediates!!  Shouldn't become pinned objects."
  	| fieldOffset effectsFlags oop size |
  	fieldOffset := self lastPointerOf: array1.
  	effectsFlags := size := 0.
  	"same size as array2"
  	[fieldOffset >= self baseHeaderSize] whileTrue:
  		[oop := self longAt: array1 + fieldOffset.
  		 (self isOopForwarded: oop) ifTrue:
  			[oop := self followForwarded: oop.
  			 self longAt: array1 + fieldOffset put: oop].
  		 (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  		 (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  		 effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
  		 size := size + (self bytesInObject: oop).
  		 oop := self longAt: array2 + fieldOffset.
  		 (self isOopForwarded: oop) ifTrue:
  			[oop := self followForwarded: oop.
  			 self longAt: array2 + fieldOffset put: oop].
  		 (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
  		 (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
  		 effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
  		 size := size + (self bytesInObject: oop).
  		 fieldOffset := fieldOffset - self bytesPerOop].
- 	"only set flags after checking all args."
- 	becomeEffectsFlags := effectsFlags.
  	size >= (totalFreeOldSpace + (scavengeThreshold - freeStart)) ifTrue:
  		[^PrimErrNoMemory].
+ 	"only set flags after checking all args."
+ 	becomeEffectsFlags := effectsFlags.
  	^0!

Item was added:
+ ----- Method: SpurMemoryManager>>lastPointerOfArray: (in category 'object enumeration') -----
+ lastPointerOfArray: objOop 
+ 	"Answer the byte offset of the last pointer field of the given array."
+ 	self assert: (self isArray: objOop).
+ 	^(self numSlotsOf: objOop) - 1 * self bytesPerOop + self baseHeaderSize!

Item was changed:
  ----- Method: StackInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
  flushExternalPrimitives
  	"Flush the references to external functions from plugin primitives.
  	 This will force a reload of those primitives when accessed next. 
  	 Note: We must flush the method cache here also, so that any failed
  	 primitives are looked up again."
  	objectMemory allObjectsDo:
  		[:oop| | primIdx |
  		(objectMemory isFreeObject: oop) ifFalse:
  			[(objectMemory isCompiledMethod: oop) ifTrue: "This is a compiled method"
  				[primIdx := self primitiveIndexOf: oop.
  				 primIdx = PrimitiveExternalCallIndex ifTrue: "It's primitiveExternalCall"
  					[self flushExternalPrimitiveOf: oop]]]].
  	self flushMethodCache.
- 	self flushAtCache.
  	self flushExternalPrimitiveTable!

Item was changed:
  ----- Method: StackInterpreter>>getErrorObjectFromPrimFailCode (in category 'message sending') -----
  getErrorObjectFromPrimFailCode
  	"Answer the errorCode object to supply to a failing primitive method that accepts one.
  	 If there is a primitive error table and the primFailCode is a valid index there-in answer
  	 the coprresponding entry in the table, otherwise simply answer the code as an integer."
  	| table |
  	primFailCode > 0 ifTrue:
  		[table := objectMemory splObj: PrimErrTableIndex.
+ 		 primFailCode <= (objectMemory numSlotsOf: table) ifTrue:
- 		 primFailCode <= ((objectMemory lastPointerOf: table) // objectMemory wordSize) ifTrue:
  			[^objectMemory fetchPointer: primFailCode - 1 ofObject: table]].
  	^objectMemory integerObjectOf: primFailCode!

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 lastPointerOfMethodHeader: header))]]) ifTrue:
- 			  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>>spurPostBecomeAction: (in category 'object memory support') -----
  spurPostBecomeAction: theBecomeEffectsFlags
  	"Insulate the stack zone from the effects of a become.
  	 All receivers must be unfollowed for two reasons:
  		1. inst var access is direct with no read barrier
  		2. super sends (always to the receiver) have no class check and so don't trap
  		   for forwarded receivers.  This is an issue for primitives that assume their receiver
  		   is valid and don't validate.
  	 Super sends require an explicit check to ensure receivers in super sends are unforwarded.
  	 e.g. super doSomethingWith: (self become: other) forwards the receiver self pushed on the
  	 stack.  So we could avoid following non-pointer receivers.  But this is too tricky,  Instead, we
  	 always follow receivers.
  	 Methods must be unfollowed since bytecode access is direct with no read barrier.
  	 But this only needs to be done if the becomeEffectsFlags indicate that a
  	 CompiledMethod was becommed.
  	 The scheduler state must be followed, but only if the becomeEffectsFlags indicate
  	 that a pointer object was becommed."
  	<option: #SpurObjectMemory>
  	<inline: false> "For VM profiling"
  	self followForwardingPointersInStackZone: theBecomeEffectsFlags.
+ 	self flushAtCache.
  	theBecomeEffectsFlags ~= 0 ifTrue:
  		[(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
  			[self followForwardedMethodsInMethodCache.
  			 self followForwardedMethodsInMethodZone]. "for CoInterpreter"
  		 (theBecomeEffectsFlags anyMask: BecameActiveClassFlag) ifTrue:
  			[self flushBecommedClassesInMethodCache.
  			 self flushBecommedClassesInMethodZone]. "for CoInterpreter"
  		 self followForwardingPointersInScheduler.
  		 self followForwardingPointersInSpecialObjectsArray.
  		 self followForwardingPointersInProfileState]!



More information about the Vm-dev mailing list