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

commits at source.squeak.org commits at source.squeak.org
Wed Apr 3 22:22:02 UTC 2013


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

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

Name: VMMaker.oscog-eem.280
Author: eem
Time: 3 April 2013, 3:19:05.275 pm
UUID: 8caedff8-7423-4f1d-a007-19ea906a098b
Ancestors: VMMaker.oscog-eem.279

Add primitivePathToUsing which mimics the PointerFinder and can hence be used to
debug it.

Remove unnecessary forceInterruptCheck in NewObjectMemory>>become:with:twoWay:copyHash:.
(heartbeat does this for us).

Fix bug in assert in NewCoObjectMemory>>restoreHeaderOf:to:.

Slang:
Move SmartSyntaxPluginTMethod>>oopVariable: to TMethod.

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

Item was changed:
  StackInterpreterPrimitives subclass: #CoInterpreter
  	instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod lastBackwardJumpMethod backwardJumpCount reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod processHasThreadId flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile noThreadingOfGUIThread'
+ 	classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- 	classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
  	poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  
  !CoInterpreter commentStamp: '<historical>' prior: 0!
  I am a variant of the StackInterpreter that can co-exist with the Cog JIT.  I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT.  See CogMethod class's comment for method interoperability.!

Item was changed:
  ----- Method: CoInterpreter class>>initializeFrameIndices (in category 'initialization') -----
  initializeFrameIndices
  	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
  	 Terminology
  		Frames are either single (have no context) or married (have a context).
  		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
  	 Stacks grow down:
  
  			receiver for method activations/closure for block activations
  			arg0
  			...
  			argN
  			caller's saved ip/this stackPage (for a base frame)
  	fp->	saved fp
  			method
  			context (initialized to nil)
  			frame flags (interpreter only)
  			saved method ip (initialized to 0; interpreter only)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  
  	In an interpreter frame
  		frame flags holds
  			the number of arguments (since argument temporaries are above the frame)
  			the flag for a block activation
  			and the flag indicating if the context field is valid (whether the frame is married).
  		saved method ip holds the saved method ip when the callee frame is a machine code frame.
  		This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address.
  	In a machine code frame
  		the flag indicating if the context is valid is the least significant bit of the method pointer
  		the flag for a block activation is the next most significant bit of the method pointer
  
  	Interpreter frames are distinguished from method frames by the method field which will
  	be a pointer into the heap for an interpreter frame and a pointer into the method zone for
  	a machine code frame.
  
  	The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage,
  	in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame."
  
  	| fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP |
  	fxCallerSavedIP := 1.
  	fxSavedFP := 0.
  	fxMethod := -1.
  	fxThisContext := -2.
  	fxIFrameFlags := -3.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
  							 Can find ``is block'' bit
  							 Can find ``has context'' bit"
  	fxIFSavedIP := -4.
  	fxIFReceiver := -5.
  	fxMFReceiver := -3.
  
  	"For debugging nil out values that differ in the StackInterpreter."
  	FrameSlots := #undeclared.
  	IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1.
  	MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1.
  
  	FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord.
  	"In Cog a base frame's caller context is stored on the first word of the stack page."
  	FoxCallerContext := #undeclared.
  	FoxSavedFP := fxSavedFP * BytesPerWord.
  	FoxMethod := fxMethod * BytesPerWord.
  	FoxThisContext := fxThisContext * BytesPerWord.
  	FoxFrameFlags := #undeclared.
  	FoxIFrameFlags := fxIFrameFlags * BytesPerWord.
  	FoxIFSavedIP := fxIFSavedIP * BytesPerWord.
  	FoxReceiver := #undeclared.
  	FoxIFReceiver := fxIFReceiver * BytesPerWord.
  	FoxMFReceiver := fxMFReceiver * BytesPerWord.
  
  	"N.B.  There is room for one more flag given the current 8 byte alignment of methods (which
  	 is at least needed to distinguish the checked and uncecked entry points by their alignment."
  	MFMethodFlagHasContextFlag := 1.
  	MFMethodFlagIsBlockFlag := 2.
+ 	MFMethodFlagFrameIsMarkedFlag := 4. "for pathTo:using:followWeak:"
+ 	MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag + MFMethodFlagFrameIsMarkedFlag.
- 	MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag.
  	MFMethodMask := (MFMethodFlagsMask + 1) negated!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') -----
+ frameIsMarked: theFPInt
+ 	| methodField |
+ 	methodField := stackPages longAt: theFPInt + FoxMethod.
+ 	^methodField asUnsignedInteger < objectMemory startOfMemory
+ 		ifTrue: [(methodField bitAnd: 4) ~= 0]
+ 		ifFalse: [((stackPages longAt: theFPInt + FoxIFrameFlags) bitAnd: 2) ~= 0]!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>markFrame: (in category 'object access primitives') -----
+ markFrame: theFPInt
+ 	| methodField |
+ 	methodField := stackPages longAt: theFPInt + FoxMethod.
+ 	methodField asUnsignedInteger < objectMemory startOfMemory
+ 		ifTrue:
+ 			[stackPages
+ 				longAt: theFPInt + FoxMethod
+ 				put: (methodField bitOr: 4)]
+ 		ifFalse:
+ 			[stackPages
+ 				longAt: theFPInt + FoxIFrameFlags
+ 				put: ((stackPages longAt: theFPInt + FoxIFrameFlags) bitOr: 2)]!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
+ pathTo: goal using: stack followWeak: followWeak
+ 	"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
+ 	 If found, unmark, leaving path in stack, and answer 0.  Otherwise answer an error:
+ 		PrimErrBadArgument if stack is not an Array
+ 		PrimErrBadIndex if search overflows stack
+ 		PrimErrNotFound if goal cannot be found"
+ 	| current hdr index next stackSize stackp freeStartAtStart |
+ 	(objectMemory isArray: stack) ifFalse:
+ 		[^PrimErrBadArgument].
+ 	freeStartAtStart := objectMemory freeStart. "check no allocations during search"
+ 	objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
+ 	stackSize := objectMemory lengthOf: stack.
+ 	objectMemory mark: stack.
+ 	"no need. the current context is not reachable from the active process (suspendedContext is nil)"
+ 	"objectMemory mark: self activeProcess."
+ 	current := objectMemory specialObjectsOop.
+ 	objectMemory mark: current.
+ 	index := objectMemory lengthOf: current.
+ 	stackp := 0.
+ 	[[(index := index - 1) >= -1] whileTrue:
+ 		[next := (stackPages couldBeFramePointer: current)
+ 					ifTrue:
+ 						[index >= 0
+ 							ifTrue: [self field: index ofFrame: current]
+ 							ifFalse: [objectMemory nilObject]]
+ 					ifFalse:
+ 						[index >= 0
+ 							ifTrue:
+ 								[hdr := objectMemory baseHeader: current.
+ 								 (objectMemory isContextHeader: hdr)
+ 									ifTrue: [self fieldOrSenderFP: index ofContext: current]
+ 									ifFalse: [objectMemory fetchPointer: index ofObject: current]]
+ 							ifFalse:
+ 								[objectMemory fetchClassOfNonInt: current]].
+ 		 (stackPages couldBeFramePointer: next)
+ 			ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))]
+ 			ifFalse:
+ 				[next >= heapBase ifTrue:
+ 					[self assert: (self checkOkayOop: next)]].
+ 		 next = goal ifTrue:
+ 			[self assert: freeStartAtStart = objectMemory freeStart.
+ 			 self unmarkAfterPathTo.
+ 			 objectMemory storePointer: stackp ofObject: stack withValue: current.
+ 			 self pruneStack: stack stackp: stackp.
+ 			 ^0].
+ 		 ((objectMemory isNonIntegerObject: next)
+ 		  and: [(stackPages couldBeFramePointer: next)
+ 				ifTrue: [(self frameIsMarked: next) not]
+ 				ifFalse:
+ 					[next >= heapBase "exclude Cog methods"
+ 					  and: [(objectMemory isMarked: next) not
+ 					  and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
+ 					  and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]]])
+ 			ifTrue:
+ 				[stackp + 2 > stackSize ifTrue:
+ 					[self assert: freeStartAtStart = objectMemory freeStart.
+ 					 self unmarkAfterPathTo.
+ 					 objectMemory nilFieldsOf: stack.
+ 					 ^PrimErrBadIndex]. "PrimErrNoMemory ?"
+ 				 objectMemory
+ 					storePointerUnchecked: stackp ofObject: stack withValue: current;
+ 					storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
+ 				 stackp := stackp + 2.
+ 				 (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
+ 					ifTrue:
+ 						[self markFrame: next.
+ 						index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
+ 					ifFalse:
+ 						[hdr := objectMemory baseHeader: next.
+ 						 objectMemory baseHeader: next put: (hdr bitOr: MarkBit).
+ 						 (objectMemory isCompiledMethodHeader: hdr)
+ 							ifTrue: [index := self literalCountOf: next]
+ 							ifFalse: [index := objectMemory lengthOf: next]].
+ 				 current := next]].
+ 		 current = objectMemory specialObjectsOop ifTrue:
+ 			[self assert: freeStartAtStart = objectMemory freeStart.
+ 			 self unmarkAfterPathTo.
+ 			 objectMemory nilFieldsOf: stack.
+ 			^PrimErrNotFound].
+ 		 index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
+ 		 current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
+ 		 stackp := stackp - 2] repeat!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
+ unmarkAllFrames
+ 	| thePage theFP methodField flags |
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theFP type: #'char *'>
+ 	<inline: false>
+ 	0 to: numStackPages - 1 do:
+ 		[:i|
+ 		thePage := stackPages stackPageAt: i.
+ 		(stackPages isFree: thePage) ifFalse:
+ 			[theFP := thePage  headFP.
+ 			 [methodField := self longAt: theFP + FoxMethod.
+ 			 methodField asUnsignedInteger < objectMemory startOfMemory
+ 				ifTrue:
+ 					[(methodField bitAnd: 4) ~= 0 ifTrue:
+ 						[self longAt: theFP + FoxMethod put: methodField - 4]]
+ 				ifFalse:
+ 					[flags := self longAt: theFP + FoxIFrameFlags.
+ 					  (flags bitAnd: 2) ~= 0 ifTrue:
+ 						[self longAt: theFP + FoxIFrameFlags put: flags - 2]].
+ 			  (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitivePathToUsing (in category 'other primitives') -----
+ primitivePathToUsing
+ 	"primitivePathTo: anObject using: stack <Array> followWeak: boolean
+ 	 Answer a path to anObject from the root that does not pass through
+ 	 the current context"
+ 	| err path |
+ 	<export: true>
+ 	self externalWriteBackHeadFramePointers.
+ 	err := self pathTo: (self stackValue: 2) using: (self stackValue: 1) followWeak: self stackTop = objectMemory trueObject.
+ 	err ~= 0 ifTrue:
+ 		[^self primitiveFailFor: err].
+ 	path := self self stackValue: 1.
+ 	self pop: argumentCount + 1 thenPush: path!

Item was changed:
  ----- Method: NewCoObjectMemory>>restoreHeaderOf:to: (in category 'become') -----
  restoreHeaderOf: obj to: objHeader
  	super restoreHeaderOf: obj to: objHeader.
  	(self isCompiledMethodHeader: objHeader) ifTrue:
  		[(self asserta: ((coInterpreter methodHasCogMethod: obj) not
+ 						or: [obj = (coInterpreter cogMethodOf: obj) methodObject])) ifFalse:
- 						or: [obj = (coInterpreter cogMethodOf: obj)])) ifFalse:
  			[self error: 'attempt to become cogged method']]!

Item was added:
+ ----- Method: NewObjectMemory>>allObjectsDo: (in category 'debug support') -----
+ allObjectsDo: aBlock
+ 	<doNotGenerate>
+ 	| oop |
+ 	oop := self firstObject.
+ 	[oop < freeStart] whileTrue:
+ 		[(self isFreeObject: oop) ifFalse:
+ 			[aBlock value: oop].
+ 		 oop := self objectAfterWhileForwarding: oop]!

Item was changed:
  ----- Method: NewObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
  become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
  	"All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length. 
  	Returns PrimNoErr if the primitive succeeds."
  	"Implementation: Uses forwarding blocks to update references as done in compaction."
  	| start |
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
  	(self isArray: array1) ifFalse:
  		[^PrimErrBadReceiver].
  	((self isArray: array2)
  	 and: [(self lastPointerOf: array1) = (self lastPointerOf: array2)]) ifFalse:
  		[^PrimErrBadArgument].
  	(twoWayFlag or: [copyHashFlag])
  		ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
  		ifFalse: [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate]].
  
  	(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse:
  		[^PrimErrNoMemory]. "fail; not enough space for forwarding table"
  
  	(self allYoung: array1 and: array2)
  		ifTrue: [start := youngStart"sweep only the young objects plus the roots"]
  		ifFalse: [start := self startOfMemory"sweep all objects"].
  	coInterpreter preBecomeAction.
  	self mapPointersInObjectsFrom: start to: freeStart.
  	twoWayFlag
  		ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
  		ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
  	coInterpreter postBecomeAction.
  
  	self initializeMemoryFirstFree: freeStart. "re-initialize memory used for forwarding table"
  	self leakCheckBecome ifTrue:
  		[self runLeakCheckerForFullGC: true].
- 	self forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP"
  
  	^PrimNoErr "success"!

Item was added:
+ ----- Method: NewObjectMemory>>mark: (in category 'primitive support') -----
+ mark: obj
+ 	<inline: true>
+ 	self baseHeader: obj put: ((self baseHeader: obj) bitOr: MarkBit)!

Item was added:
+ ----- Method: NewObjectMemory>>nilFieldsOf: (in category 'primitive support') -----
+ nilFieldsOf: arrayObj 
+ 	0 to: (self lengthOf: arrayObj) - 1 do:
+ 		[:i|
+ 		self storePointerUnchecked: i ofObject: arrayObj withValue: nilObj]!

Item was added:
+ ----- Method: NewObjectMemory>>unmarkAllObjects (in category 'primitive support') -----
+ unmarkAllObjects
+ 	| oop hdr |
+ 	oop := self firstObject.
+ 	[oop < freeStart] whileTrue:
+ 		[(self isFreeObject: oop) ifFalse:
+ 			[hdr := self baseHeader: oop.
+ 			 (hdr bitAnd: MarkBit) ~= 0 ifTrue:
+ 				[self baseHeader: oop put: (hdr bitAnd: AllButMarkBit)]].
+ 		 oop := self objectAfter: oop]!

Item was removed:
- ----- Method: SmartSyntaxPluginTMethod>>oopVariable: (in category 'private') -----
- oopVariable: aString
- 
- 	(locals includes: aString) ifFalse:
- 		[locals add: aString.
- 		self declarationAt: aString put: 'sqInt ', aString].
- 	^TVariableNode new setName: aString!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>field:ofFrame: (in category 'object access primitives') -----
+ field: index ofFrame: theFP
+ 	"Arrange to answer naked frame pointers for unmarried
+ 	 senders to avoid reifying contexts in the search."
+ 	<var: #theFP type: #'char *'>
+ 	<inline: false>
+ 	| callerFP |
+ 	<var: #callerFP type: #'char *'>
+ 	^index caseOf:
+ 		{[SenderIndex] ->	[callerFP := self frameCallerFP: theFP.
+ 							 callerFP = 0
+ 								ifTrue: [self frameCallerContext: theFP]
+ 								ifFalse: [(self frameHasContext: callerFP)
+ 											ifTrue: [self assert: (self checkIsStillMarriedContext: (self frameContext: callerFP) currentFP: nil).
+ 													self frameContext: callerFP]
+ 											ifFalse: [callerFP]]].
+ 		[StackPointerIndex]			->	[ConstZero].
+ 		[InstructionPointerIndex]	->	[ConstZero].
+ 		[MethodIndex]				->	[self frameMethodObject: theFP].
+ 		[ClosureIndex]				->	[(self frameIsBlockActivation: theFP)
+ 											ifTrue: [self frameStackedReceiver: theFP
+ 														numArgs: (self frameNumArgs: theFP)]
+ 											ifFalse: [objectMemory nilObject]].
+ 		[ReceiverIndex]				->	[self frameReceiver: theFP] }
+ 		otherwise:
+ 			[self assert: (index - CtxtTempFrameStart between: 0 and: (self stackPointerIndexForFrame: theFP)).
+ 			 self temporary: index - CtxtTempFrameStart in: theFP]!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>fieldOrSenderFP:ofContext: (in category 'object access primitives') -----
+ fieldOrSenderFP: index ofContext: contextObj
+ 	"Arrange to answer naked frame pointers for unmarried
+ 	 senders to avoid reifying contexts in the search."
+ 	<inline: false>
+ 	| tempIndex spouseFP |
+ 	<var: #spouseFP type: #'char *'>
+ 	tempIndex := index - CtxtTempFrameStart.
+ 	(self isStillMarriedContext: contextObj) ifFalse:
+ 		[^tempIndex >= (self fetchStackPointerOf: contextObj)
+ 			ifTrue: [objectMemory nilObject]
+ 			ifFalse: [self fetchPointer: index ofObject: contextObj]].
+ 	spouseFP := self frameOfMarriedContext: contextObj.
+ 	tempIndex >= (self stackPointerIndexForFrame: spouseFP) ifTrue:
+ 		[^objectMemory nilObject].
+ 	^self field: index ofFrame: spouseFP!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>fieldsInFrame: (in category 'object access primitives') -----
+ fieldsInFrame: theFP
+ 	<var: #theFP type: #'char *'>
+ 	^CtxtTempFrameStart + (self stackPointerIndexForFrame: theFP)!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>frameIsMarked: (in category 'object access primitives') -----
+ frameIsMarked: theFPInt
+ 	^((stackPages longAt: theFPInt + FoxFrameFlags) bitAnd: 2) ~= 0!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>isFrame:onPage: (in category 'object access primitives') -----
+ isFrame: aFrame onPage: aPage
+ 	<var: #aFrame type: #'char *'>
+ 	<var: #aPage type: #'StackPage *'>
+ 	| theFP |
+ 	<var: #theFP type: #'char *'>
+ 	theFP := aPage headFP.
+ 	[theFP = aFrame ifTrue: [^true].
+ 	 theFP ~= aPage baseFP
+ 	 and: [(stackPages stackPageFor: theFP) = aPage]] whileTrue:
+ 		[theFP := self frameCallerFP: theFP].
+ 	^false!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>markFrame: (in category 'object access primitives') -----
+ markFrame: theFPInt
+ 	stackPages
+ 		longAt: theFPInt + FoxFrameFlags
+ 		put: ((stackPages longAt: theFPInt + FoxFrameFlags) bitOr: 2)!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>pathTo:using:followWeak: (in category 'object access primitives') -----
+ pathTo: goal using: stack followWeak: followWeak
+ 	"Trace objects and frames from the root, marking visited objects, pushing the current path on stack, until goal is found.
+ 	 If found, unmark, leaving path in stack, and answer 0.  Otherwise answer an error:
+ 		PrimErrBadArgument if stack is not an Array
+ 		PrimErrBadIndex if search overflows stack
+ 		PrimErrNotFound if goal cannot be found"
+ 	| current hdr index next stackSize stackp freeStartAtStart |
+ 	(objectMemory isArray: stack) ifFalse:
+ 		[^PrimErrBadArgument].
+ 	freeStartAtStart := objectMemory freeStart. "check no allocations during search"
+ 	objectMemory beRootIfOld: stack. "so no store checks are necessary on stack"
+ 	stackSize := objectMemory lengthOf: stack.
+ 	objectMemory mark: stack.
+ 	"no need. the current context is not reachable from the active process (suspendedContext is nil)"
+ 	"objectMemory mark: self activeProcess."
+ 	current := objectMemory specialObjectsOop.
+ 	objectMemory mark: current.
+ 	index := objectMemory lengthOf: current.
+ 	stackp := 0.
+ 	[[(index := index - 1) >= -1] whileTrue:
+ 		[next := (stackPages couldBeFramePointer: current)
+ 					ifTrue:
+ 						[index >= 0
+ 							ifTrue: [self field: index ofFrame: current]
+ 							ifFalse: [objectMemory nilObject]]
+ 					ifFalse:
+ 						[index >= 0
+ 							ifTrue:
+ 								[hdr := objectMemory baseHeader: current.
+ 								 (objectMemory isContextHeader: hdr)
+ 									ifTrue: [self fieldOrSenderFP: index ofContext: current]
+ 									ifFalse: [objectMemory fetchPointer: index ofObject: current]]
+ 							ifFalse:
+ 								[objectMemory fetchClassOfNonInt: current]].
+ 		 (stackPages couldBeFramePointer: next)
+ 			ifTrue: [self assert: (self isFrame: next onPage: (stackPages stackPageFor: next))]
+ 			ifFalse: [self assert: (self checkOkayOop: next)].
+ 		 next = goal ifTrue:
+ 			[self assert: freeStartAtStart = objectMemory freeStart.
+ 			 self unmarkAfterPathTo.
+ 			 objectMemory storePointer: stackp ofObject: stack withValue: current.
+ 			 self pruneStack: stack stackp: stackp.
+ 			 ^0].
+ 		 ((objectMemory isNonIntegerObject: next)
+ 		  and: [(stackPages couldBeFramePointer: next)
+ 				ifTrue: [(self frameIsMarked: next) not]
+ 				ifFalse:
+ 					[(objectMemory isMarked: next) not
+ 					  and: [((objectMemory isPointers: next) or: [objectMemory isCompiledMethod: next])
+ 					  and: [followWeak or: [(objectMemory isWeakNonInt: next) not]]]]])
+ 			ifTrue:
+ 				[stackp + 2 > stackSize ifTrue:
+ 					[self assert: freeStartAtStart = objectMemory freeStart.
+ 					 self unmarkAfterPathTo.
+ 					 objectMemory nilFieldsOf: stack.
+ 					 ^PrimErrBadIndex]. "PrimErrNoMemory ?"
+ 				 objectMemory
+ 					storePointerUnchecked: stackp ofObject: stack withValue: current;
+ 					storePointerUnchecked: stackp + 1 ofObject: stack withValue: (objectMemory integerObjectOf: index).
+ 				 stackp := stackp + 2.
+ 				 (stackPages couldBeFramePointer: (self cCoerceSimple: next to: #'char *'))
+ 					ifTrue:
+ 						[self markFrame: next.
+ 						index := self fieldsInFrame: (self cCoerceSimple: next to: #'char *')]
+ 					ifFalse:
+ 						[hdr := objectMemory baseHeader: next.
+ 						 objectMemory baseHeader: next put: (hdr bitOr: MarkBit).
+ 						 (objectMemory isCompiledMethodHeader: hdr)
+ 							ifTrue: [index := self literalCountOf: next]
+ 							ifFalse: [index := objectMemory lengthOf: next]].
+ 				 current := next]].
+ 		 current = objectMemory specialObjectsOop ifTrue:
+ 			[self assert: freeStartAtStart = objectMemory freeStart.
+ 			 self unmarkAfterPathTo.
+ 			 objectMemory nilFieldsOf: stack.
+ 			^PrimErrNotFound].
+ 		 index := objectMemory integerValueOf: (objectMemory fetchPointer: stackp - 1 ofObject: stack).
+ 		 current := objectMemory fetchPointer: stackp - 2 ofObject: stack.
+ 		 stackp := stackp - 2] repeat!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>pruneStack:stackp: (in category 'object access primitives') -----
+ pruneStack: stack stackp: stackp
+ 	"Prune the stack to contain only the path, removing stacked indices
+ 	 and mapping frame pointers to contexts  The  issue here is that a
+ 	 GC can occur during ensureFrameIsMarried:SP:, but frame pointers
+ 	 are not valid objects.  So first prune back to objects and framePointers
+ 	 as integers, and then replace frame pointers as integers by contexts."
+ 	
+ 	<inline: false>
+ 	| objOrFP theStack finger |
+ 	<var: #theFP type: #'char *'>
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theFPAbove type: #'char *'>
+ 	finger := 1.
+ 	2 to: stackp - 1 by: 2 do:
+ 		[:i|
+ 		objOrFP := objectMemory fetchPointer: i ofObject: stack.
+ 		(stackPages couldBeFramePointer: (self cCoerceSimple: objOrFP to: #'char *')) ifTrue:
+ 			[objOrFP := self withSmallIntegerTags: objOrFP].
+ 		objectMemory
+ 			storePointerUnchecked: finger
+ 			ofObject: stack
+ 			withValue: objOrFP.
+ 		finger := finger + 1].
+ 	finger to: (objectMemory lengthOf: stack) - 1 do:
+ 		[:i|
+ 		objectMemory
+ 			storePointerUnchecked: i
+ 			ofObject: stack
+ 			withValue: objectMemory nilObject].
+ 	objectMemory pushRemappableOop: (theStack := stack).
+ 	1 to: finger - 1 do:
+ 		[:i| | thePage theFP theFPAbove |
+ 		objOrFP := objectMemory fetchPointer: i ofObject: theStack.
+ 		(self isIntegerObject: objOrFP) ifTrue:
+ 			[theFP := self withoutSmallIntegerTags: objOrFP.
+ 			 thePage := stackPages stackPageFor: theFP.
+ 			 theFPAbove := self findFrameAbove: theFP inPage: thePage.
+ 			 objOrFP := self ensureFrameIsMarried: theFP SP: (self frameCallerSP: theFPAbove).
+ 			 theStack := objectMemory topRemappableOop.
+ 			 objectMemory "after a GC stack may no longer be a root."
+ 				storePointer: finger
+ 				ofObject: theStack
+ 				withValue: objOrFP]].
+ 	objectMemory popRemappableOop!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>unmarkAfterPathTo (in category 'object access primitives') -----
+ unmarkAfterPathTo
+ 	<inline: false>
+ 	self unmarkAllFrames.
+ 	objectMemory unmarkAllObjects!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>unmarkAllFrames (in category 'object access primitives') -----
+ unmarkAllFrames
+ 	| thePage theFP flags |
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #theFP type: #'char *'>
+ 	<inline: false>
+ 	0 to: numStackPages - 1 do:
+ 		[:i|
+ 		thePage := stackPages stackPageAt: i.
+ 		(stackPages isFree: thePage) ifFalse:
+ 			[theFP := thePage  headFP.
+ 			 [flags := self longAt: theFP + FoxFrameFlags.
+ 			  (flags bitAnd: 2) ~= 0 ifTrue:
+ 				[self longAt: theFP + FoxFrameFlags put: flags - 2].
+ 			  (theFP := self frameCallerFP: theFP) ~= 0] whileTrue]]!

Item was added:
+ ----- Method: TMethod>>oopVariable: (in category 'private') -----
+ oopVariable: aString
+ 
+ 	(locals includes: aString) ifFalse:
+ 		[locals add: aString.
+ 		self declarationAt: aString put: 'sqInt ', aString].
+ 	^TVariableNode new setName: aString!



More information about the Vm-dev mailing list