[Vm-dev] VM Maker: VMMaker.oscog-eem.3166.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Feb 23 00:52:34 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3166.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3166
Author: eem
Time: 22 February 2022, 4:52:25.394844 pm
UUID: bda1c176-bedf-4490-bb95-90d3851c1526
Ancestors: VMMaker.oscog-eem.3165
StackInterpreter: stackPage should either be nil or a StackPage, not zero or a StackPage.
Slang type inferrence: have it construct pointer types in the house style (no space between the * and the following var name).
=============== Diff against VMMaker.oscog-eem.3165 ===============
Item was changed:
----- Method: CoInterpreter>>divorceAllFramesSuchThat: (in category 'frame access') -----
divorceAllFramesSuchThat: criterion
"Divorce all frames that satisfy criterion nd answer the current activeContext."
<var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
| activeContext divorcedSome |
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
self ensurePushedInstructionPointer.
self externalWriteBackHeadFramePointers.
+ [stackPage ifNotNil: "This is needed for the assert in externalDivorceFrame:andContext:"
- [stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
[stackPages markStackPageMostRecentlyUsed: stackPage].
"Slang can't currently cope with the lack of the variable here.
Something to do with the preceding statement. Take it out
and the code is good. leave it in and we get do { ... } while(l1:)"
divorcedSome := self divorceSomeFramesIf: criterion.
divorcedSome] whileTrue.
^activeContext!
Item was changed:
----- Method: CoInterpreter>>divorceMachineCodeFramesWithMethod: (in category 'frame access') -----
divorceMachineCodeFramesWithMethod: methodObj
| cogMethod divorcedSome |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cogMethodOf: methodObj.
+ [stackPage ifNotNil: "This is needed for the assert in externalDivorceFrame:andContext:"
- [stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
[stackPages markStackPageMostRecentlyUsed: stackPage].
"Slang can't currently cope with the lack of the variable here.
Something to do with the preceding statement. Take it out
and the code is good. leave it in and we get do { ... } while(l1:)"
divorcedSome := self divorceSomeMachineCodeFramesWithMethod: cogMethod.
divorcedSome] whileTrue!
Item was changed:
----- Method: CoInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
flushExternalPrimitives
"Flush the references to external functions from plugin primitives.
Then continue execution answering self.
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.
Override to ensure that any and all activations of an external method
have a bytecode pc so that if code generation changes (e.g. a primitive
method is used, unloaded, and the reloaded primitive is marked with
the FastCPrimitiveFlag) stale machine code pcs have been eliminated.
THIS MUST BE INVOKED IN THE CONTEXT OF A PRIMITIVE."
| activeContext theFrame thePage |
activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForExternalPrimitiveMethod:.
objectMemory allObjectsDo:
[:oop|
(objectMemory isCompiledMethod: oop)
ifTrue:
[self flushExternalPrimitiveOf: oop]
ifFalse:
[(objectMemory isContext: oop) ifTrue:
[self mapToBytecodePCIfActivationOfExternalMethod: oop]]].
cogit unlinkSendsToMethodsSuchThat: #cogMethodHasExternalPrim: AndFreeIf: true.
self flushMethodCache.
self flushExternalPrimitiveTable.
self cCode: '' inSmalltalk:
[self assert: (cogit methodZone cogMethodsSelect: [:cogMethod| cogMethod cmType > CMFree and: [cogit cogMethodHasExternalPrim: cogMethod]]) isEmpty].
"If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
+ [self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
- [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
self popStack. "pop pushed instructionPointer"
self pop: argumentCount.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
self pop: argumentCount!
Item was changed:
----- Method: CoInterpreter>>flushMethodsWithMachineCodePrimitivesAndContinueAnswering: (in category 'primitive support') -----
flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"Arrange that any and all cog methods with machine code primitives can be and are discarded.
Hence scan contexts and map their PCs to bytecode PCs if required, and scan frames, divorcing
the frames of activationsif required. Then continue execution answering result. THIS MUST BE
INVOKED IN THE CONTEXT OF A PRIMITIVE. It exists to support vmParameterAt:put:."
| activeContext theFrame thePage |
activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameWithCogMethod:.
self ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs.
cogit unlinkSendsToMethodsSuchThat: #cogMethodHasMachineCodePrim: AndFreeIf: true.
"If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
+ [self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
- [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
"pop bogus machine-code instructionPointer, arguments and receiver"
self pop: argumentCount + 2 thenPush: result.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
self pop: argumentCount + 1 thenPush: result!
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 bytecode, literal and inst var fetch and non-local return, we scan
the receivers (including the stacked receiver for non-local return) and method references
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.
Override to handle machine code frames"
| theIPPtr |
<inline: false>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer > method ifTrue: [instructionPointer - method].
method := objectMemory followForwarded: method.
theIPPtr ifNotNil: [instructionPointer := method + theIPPtr]].
(objectMemory isOopForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
+ stackPage ifNil: "the system must be snapshotting; nothing to do..."
- stackPage = 0 ifTrue: "the system must be snapshotting; nothing to do..."
[self assert: (stackPages mostRecentlyUsedPage isNil or: [stackPages mostRecentlyUsedPage isFree]).
self cCode: [] inSmalltalk: [self assert: stackPages allPagesFree].
^self].
self externalWriteBackHeadFramePointers.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP oop offset |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
theIPPtr := thePage = stackPage ifFalse: [thePage headSP asUnsignedInteger].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr isNil or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
(self isMachineCodeFrame: theFP)
ifTrue:
[oop := stackPages longAt: theFP + FoxMFReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxMFReceiver
put: (objectMemory followForwarded: oop)].
self assert: (objectMemory isForwarded: (self mframeHomeMethod: theFP) methodObject) 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 |
newOop := objectMemory followForwarded: oop.
offset := newOop - oop.
(theIPPtr notNil
and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
[stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + offset].
stackPages
longAt: theFP + FoxIFSavedIP
put: (stackPages longAt: theFP + FoxIFSavedIP) + offset.
stackPages
longAt: theFP + FoxMethod
put: (oop := newOop)]].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
offset := self frameStackedReceiverOffset: theFP.
oop := stackPages longAt: theFP + offset.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + offset
put: (objectMemory followForwarded: oop)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
theFP := callerFP].
"And finally follow the saved context and the caller context."
theSP := thePage baseAddress - 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]]]!
Item was changed:
----- Method: CoInterpreter>>tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom:to:returnValue: (in category 'return bytecodes') -----
tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue
"Handle the cannot return response for a base frame return to an invalid context.
Build a new base frame for the context in the cannot resume state ready for the
send of cannotReturn:.
Since we have returned from the base frame of the page the context is effectively widowed.
But its sender needs to be contextToReturnTo, and its pc needs to be the HasBeenReturnedFromMCPC
marker. So bereave it (as a side-effect of isWidowedContext:), assign contextToReturnTo to
sender, and rebuild its frame, which will have the ceCannotResumePC as its pc. Finally push
returnValue and set instructionPointer to ceCannotResumePC in preparation for the send."
| newPage |
<inline: false>
+ self assert: (stackPage notNil and: [stackPage isFree]).
- <var: #newPage type: #'StackPage *'>
- self assert: (stackPage ~= 0 and: [stackPage isFree]).
self isWidowedContext: contextToReturnFrom.
self assert: (self isMarriedOrWidowedContext: contextToReturnFrom) not.
objectMemory
storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo;
storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPCOop.
"void the instructionPointer to stop it being incorrectly updated in a code
compaction in makeBaseFrameFor:."
instructionPointer := 0.
newPage := self makeBaseFrameFor: contextToReturnFrom.
self assert: stackPage = newPage.
self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage.
self assert: self stackTop = cogit ceCannotResumePC.
"overwrite the ceSendCannotResumePC on the stack. If ever re-executed
the returnValue will be taken from top-of-stack by ceCannotResume."
self stackTopPut: returnValue.
"Assign it to instructionPointer as externalCannotReturn:from: pushes it."
instructionPointer := cogit ceCannotResumePC!
Item was changed:
----- Method: CoInterpreterPrimitives>>primitiveVoidVMStateForMethod (in category 'system control primitives') -----
primitiveVoidVMStateForMethod
"The receiver (or first argument) must be a compiledMethod. The optional (or second) argument must be a
boolean. Clear all VM state associated with the method, including any machine code, or machine code pcs
in context objects. If the optional boolean argument is false do not scan the heap looking for contexts."
| activeContext methodObj scanHeapForContexts hasCogMethod theFrame thePage |
- <var: #theFrame type: #'char *'>
- <var: #thePage type: #'StackPage *'>
scanHeapForContexts := true. "See comment ''One might think...'' below"
"In Smalltalk allow both aMethod voidCogVMState and aMethod voidCogVMStateScanningContextsIf: aBoolean"
argumentCount = 0
ifTrue:
[methodObj := self stackTop]
ifFalse:
[methodObj := self stackValue: 1.
scanHeapForContexts := self booleanValueOf: self stackTop.
self failed ifTrue:
[^self primitiveFailFor: PrimErrBadArgument]].
NewspeakVM
ifFalse:
[argumentCount > 1 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs]]
ifTrue: "In the NewspeakVM we allow VMMirror voidStateFor: method scanningIf: aBoolean as well as the Smalltalk forms."
[argumentCount >= 2 ifTrue:
[argumentCount > 2 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs].
(objectMemory isOopCompiledMethod: methodObj) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument]]].
self flushMethodCacheForMethod: methodObj.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
self ensurePushedInstructionPointer.
self externalWriteBackHeadFramePointers.
(hasCogMethod := self methodHasCogMethod: methodObj) ifTrue:
[self divorceMachineCodeFramesWithMethod: methodObj].
"One might think (as this author did) that the heap scan is unnecessary if the method does not
have a cog method. But it could be the case that the code zone has recently been reclaimed
and so not having a cog method is no indication that it didn't have a cog method some time in
the recent past, and that there are indeed still contexts with machine code pcs out there. The
only steps that can be avoided are divorcing frames in the stack zone, and scanning to unlink and
free if there isn't a cog method, unless we are told otherwise."
scanHeapForContexts ifTrue:
[self ensureAllContextsWithMethodHaveBytecodePCs: methodObj].
hasCogMethod ifTrue:
[cogit unlinkSendsTo: methodObj andFreeIf: true].
"If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
+ [self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
- [self zeroStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
self popStack. "pop bogus machine-code instructionPointer"
self assert: (methodObj = self stackTop or: [argumentCount > 0 and: [methodObj = (self stackValue: 1)]]).
self pop: argumentCount.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
self assert: (methodObj = self stackTop or: [argumentCount > 0 and: [methodObj = (self stackValue: 1)]]).
self pop: argumentCount!
Item was changed:
----- Method: StackInterpreter>>divorceAllFrames (in category 'frame access') -----
divorceAllFrames
| activeContext |
<inline: false>
+ stackPage ifNotNil:
- <var: #aPage type: #'StackPage *'>
- stackPage ~= 0 ifTrue:
[self externalWriteBackHeadFramePointers].
activeContext := self
ensureFrameIsMarried: framePointer
SP: stackPointer + objectMemory wordSize.
0 to: numStackPages - 1 do:
[:i| | aPage |
aPage := stackPages stackPageAt: i.
(stackPages isFree: aPage) ifFalse:
[self divorceFramesIn: aPage]].
+ self nilStackPage.
- self zeroStackPage.
^activeContext!
Item was changed:
----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') -----
externalDivorceFrame: theFP andContext: ctxt
"Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack."
| thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
<inline: false>
- <var: #theFP type: #'char *'>
- <var: #thePage type: #'StackPage *'>
- <var: #theSP type: #'char *'>
- <var: #newPage type: #'StackPage *'>
- <var: #frameAbove type: #'char *'>
- <var: #callerFP type: #'char *'>
- <var: #callerSP type: #'char *'>
"stackPage needs to have current head pointers to avoid confusion."
+ self assert: (stackPage isNil or: [stackPage = stackPages mostRecentlyUsedPage]).
- self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]).
thePage := stackPages stackPageFor: theFP.
(onCurrent := thePage = stackPage) ifFalse:
[stackPages markStackPageNextMostRecentlyUsed: thePage].
theSP := self findSPOf: theFP on: thePage.
self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
callerCtx := self ensureCallerContext: theFP.
(frameAbove := self findFrameAbove: theFP inPage: thePage) = 0
ifTrue: "If we're divorcing the top frame we can simply peel it off."
[theIP := stackPages longAt: thePage headSP]
ifFalse: "othewise move all frames above to a new stack and then peel the frame off."
[newPage := stackPages newStackPage.
theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
onCurrent
ifTrue:
[self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage]
ifFalse:
[stackPages markStackPageMostRecentlyUsed: newPage].
self assert: (self frameCallerContext: frameAbove) = ctxt].
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: ctxt
withValue: (self contextInstructionPointer: theIP frame: theFP).
objectMemory storePointer: SenderIndex
ofObject: ctxt
withValue: callerCtx.
callerFP := self frameCallerFP: theFP.
callerFP = 0 "theFP is a base frame; it is now alone; free the entire page"
ifTrue: [stackPages freeStackPage: thePage]
ifFalse:
[callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
callerSP := (self frameCallerSP: theFP) - objectMemory wordSize.
stackPages longAt: callerSP put: callerIP.
self setHeadFP: callerFP andSP: callerSP inPage: thePage]
!
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 and non-local return, we scan
the receivers (including the stacked receiver for non-local return) and method references
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>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer - method.
method := objectMemory followForwarded: method.
instructionPointer := method + theIPPtr].
(objectMemory isOopForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
+ stackPage ifNil: "the system must be snapshotting; nothing to do..."
- stackPage = 0 ifTrue: "the system must be snapshotting; nothing to do..."
[self assert: (stackPages mostRecentlyUsedPage isNil or: [stackPages mostRecentlyUsedPage isFree]).
self cCode: [] inSmalltalk: [self assert: stackPages allPagesFree].
^self].
self externalWriteBackHeadFramePointers.
0 to: numStackPages - 1 do:
[:i| | thePage theFP callerFP offset oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
theIPPtr := thePage = stackPage ifFalse: [thePage headSP asUnsignedInteger].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr isNil or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
oop := stackPages longAt: theFP + FoxReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxReceiver
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 ifNotNil:
[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)].
offset := self frameStackedReceiverOffset: theFP.
oop := stackPages longAt: theFP + offset.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + offset
put: (objectMemory followForwarded: oop)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
theFP := callerFP].
"And finally follow the caller context."
self assert: theFP = thePage baseFP.
oop := self frameCallerContext: theFP.
(objectMemory isForwarded: oop) ifTrue:
[self frameCallerContext: theFP put: (objectMemory followForwarded: oop)]]]!
Item was changed:
----- Method: StackInterpreter>>initStackPageGC (in category 'object memory support') -----
initStackPageGC
"GC of pages. Throwing away all stack pages on full GC is simple but dangerous
because it causes us to allocate lots of contexts immediately before a GC.
Reclaiming pages whose top context is not referenced is poor because it would
take N incrementalGCs to reclaim N unused pages. Only the page whose top
context is not referred to by the bottom context of any other page would be
reclaimed. Not until the next GC would the page whose top contect is the
previously reclaimed page's base frame's bottom context be reclaimed.
Better is to not mark stack pages until their contexts are encountered. We can
eagerly trace the active page and the page reachable from its bottom context
if any, and so on. Other pages can be marked when we encounter a married
context."
- <var: #thePage type: #'StackPage *'>
<inline: true>
"Need to write back the frame pointers unless all pages are free (as in snapshot)"
+ stackPage ifNotNil:
- stackPage ~= 0 ifTrue:
[self externalWriteBackHeadFramePointers].
0 to: numStackPages - 1 do:
[:i| | thePage |
thePage := stackPages stackPageAt: i.
thePage trace: StackPageUnreached]!
Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
super initialize.
primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not".
newFinalization := false.
stackLimit := 0. "This is also the initialization flag for the stack system."
+ stackPage := overflowedPage := nil.
- stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
tempOop := tempOop2 := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
sendWheelEvents := deferDisplayUpdates := false.
displayBits := displayWidth := displayHeight := displayDepth := 0.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
primitiveCalloutPointer := -1. "initialized in declaration in declareCVarsIn:"
transcript := Transcript. "initialized to stdout in readImageFromFile:HeapSize:StartingAt:"
pcPreviousToFunction := PCPreviousToFunction. "initialized via StackInterpreter class>>declareCVarsIn:"
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
statIdleUsecs := 0!
Item was changed:
----- Method: StackInterpreter>>markAndTraceStackPages: (in category 'object memory support') -----
markAndTraceStackPages: fullGCFlag
"GC of pages. Throwing away all stack pages on full GC is simple but dangerous
because it causes us to allocate lots of contexts immediately before a GC.
Reclaiming pages whose top context is not referenced is poor because it would
take N incrementalGCs to reclaim N unused pages. Only the page whose top
context is not referred to by the bottom context of any other page would be
reclaimed. Not until the next GC would the page whose top contect is the
previously reclaimed page's base frame's bottom context be reclaimed.
Better is to not mark stack pages until their contexts are encountered. We can
eagerly trace the active page and the page reachable from its bottom context
if any, and so on. Other pages can be marked when we encounter a married
context."
| thePage context |
- <var: #thePage type: #'StackPage *'>
<inline: false>
objectMemory hasSpurMemoryManagerAPI ifFalse:
[self initStackPageGC].
"On an incremental GC simply consider all non-free stack pages to be roots."
fullGCFlag ifFalse:
[0 to: numStackPages - 1 do:
[:i|
thePage := stackPages stackPageAt: i.
(stackPages isFree: thePage) ifFalse:
[self markAndTraceStackPage: thePage]].
^nil].
"On a full GC only eagerly trace pages referenced from
the base of the active page, i.e. on the active stack."
+ stackPage ifNil: [^nil].
- stackPage = 0 ifTrue: [^nil].
thePage := stackPage.
[self markAndTraceStackPage: thePage.
context := self frameCallerContext: thePage baseFP.
((objectMemory isContext: context)
and: [(self isMarriedOrWidowedContext: context)
and: [self isStillMarriedContext: context]]) ifTrue:
[thePage := stackPages stackPageFor: (self frameOfMarriedContext: context).
self assert: (stackPages isFree: thePage) not].
thePage trace < StackPageTraced] whileTrue!
Item was changed:
----- Method: StackInterpreter>>marryContextInNewStackPageAndInitializeInterpreterRegisters: (in category 'frame access') -----
marryContextInNewStackPageAndInitializeInterpreterRegisters: aContext
"Establish aContext at the base of a new stackPage, make the stackPage the
active one and set-up the interreter registers. This is used to boot the system
and bring it back after a snapshot."
<inline: false>
| newPage |
+ self assert: stackPage isNil.
- <var: #newPage type: #'StackPage *'>
- self assert: stackPage = 0.
newPage := self makeBaseFrameFor: aContext.
self setStackPageAndLimit: newPage.
self setStackPointersFromPage: newPage.
self setMethod: (self iframeMethod: stackPage headFP).
instructionPointer := self popStack!
Item was added:
+ ----- Method: StackInterpreter>>nilStackPage (in category 'stack pages') -----
+ nilStackPage
+ "In its own method as a debugging hook.
+ Frame pointers should have been written back already."
+ <inline: true>
+ self assert: (stackPage isNil
+ or: [stackPage headFP = framePointer
+ and: [stackPage headSP = stackPointer]]).
+ stackPage := nil!
Item was changed:
----- Method: StackInterpreter>>postGCUpdateDisplayBits (in category 'object memory support') -----
postGCUpdateDisplayBits
"Update the displayBits after a GC may have moved it.
Answer if the displayBits appear valid. The wrinkle here is that the displayBits could be a surface handle."
<inline: false>
| displayObj bitsOop bitsNow |
displayObj := objectMemory splObj: TheDisplay.
((objectMemory isPointers: displayObj)
and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse:
[^false].
bitsOop := objectMemory followOopField: 0 ofObject: displayObj.
(bitsOop = objectMemory nilObject "it ain't yet set"
or: [objectMemory isIntegerObject: bitsOop]) ifTrue: "It's a surface; our work here is done..."
[^true].
self assert: ((objectMemory addressCouldBeObj: bitsOop)
and: [objectMemory isWordsOrBytes: bitsOop]).
(objectMemory hasSpurMemoryManagerAPI
and: [objectMemory isPinned: bitsOop]) ifFalse:
[(objectMemory hasSpurMemoryManagerAPI
+ and: [stackPage notNil]) ifTrue: "If stackPage is nil we're snapshotting and now is not the time to pin."
- and: [stackPage ~= 0]) ifTrue: "If stackPage is zero we're snapshotting and now is not the time to pin."
[objectMemory pinObject: bitsOop.
bitsOop := objectMemory followOopField: 0 ofObject: displayObj].
bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
displayBits ~= bitsNow ifTrue:
[displayBits := bitsNow.
self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]].
^true!
Item was changed:
----- Method: StackInterpreter>>preBecomeAction (in category 'object memory support') -----
preBecomeAction
"Need to write back the frame pointers unless all pages are free (as in snapshot)"
+ stackPage ifNotNil:
- stackPage ~= 0 ifTrue:
[self externalWriteBackHeadFramePointers]!
Item was changed:
----- Method: StackInterpreter>>preGCAction: (in category 'object memory support') -----
preGCAction: gcModeArg
"Need to write back the frame pointers unless all pages are free (as in snapshot)"
+ stackPage ifNotNil:
- stackPage ~= 0 ifTrue:
[self externalWriteBackHeadFramePointers].
(gcModeArg = GCModeFull
and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
[self flushMethodCache]!
Item was changed:
----- Method: StackInterpreter>>setStackPageAndLimit: (in category 'stack pages') -----
setStackPageAndLimit: thePage
"Set stackPage to a different page. Set stackLimit unless it has
been smashed. Make the stackPage the most recently used"
<inline: true>
<var: #thePage type: #'StackPage *'>
+ self assert: thePage notNil.
- self assert: thePage ~= 0.
stackPage := thePage.
stackLimit ~= self allOnesAsCharStar ifTrue:
[stackLimit := stackPage stackLimit].
stackPages markStackPageMostRecentlyUsed: thePage!
Item was removed:
- ----- Method: StackInterpreter>>zeroStackPage (in category 'stack pages') -----
- zeroStackPage
- "In its own method as a debugging hook.
- Frame pointers should have been written back already."
- <inline: true>
- self assert: (stackPage = 0
- or: [stackPage headFP = framePointer
- and: [stackPage headSP = stackPointer]]).
- stackPage := 0!
Item was changed:
----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
inferTypesForImplicitlyTypedVariablesIn: aCodeGen
"infer types for untyped variables from assignments and arithmetic uses.
For debugging answer a Dictionary from var to the nodes that determined types
This for debugging:
(self copy inferTypesForImplicitlyTypedVariablesIn: aCodeGen)"
+ | alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes prependType |
- | alreadyExplicitlyTypedOrNotToBeTyped asYetUntyped mustBeSigned newDeclarations effectiveNodes |
aCodeGen maybeBreakForTestToInline: selector in: self.
alreadyExplicitlyTypedOrNotToBeTyped := declarations keys asSet.
asYetUntyped := locals copyWithoutAll: alreadyExplicitlyTypedOrNotToBeTyped.
mustBeSigned := Set new.
newDeclarations := Dictionary new.
effectiveNodes := Dictionary new. "this for debugging"
+ prependType := [:type :var| type last == $* ifTrue: [type, var] ifFalse: [type, ' ', var]].
parseTree nodesDo:
[:node| | type var |
"If there is something of the form i >= 0, then i should be signed, not unsigned."
(node isSend
and: [(locals includes: (var := node receiver variableNameOrNil))
and: [(#(<= < >= >) includes: node selector)
and: [node args first isConstant
and: [node args first value = 0]]]]) ifTrue:
[mustBeSigned add: var.
effectiveNodes at: var put: { #signed. node }, (effectiveNodes at: var ifAbsent: [#()])].
"if an assignment to an untyped local of a known type, set the local's type to that type.
Only observe known sends (methods in the current set) and typed local variables."
(node isAssignment
and: [(locals includes: (var := node variable name))
and: [(alreadyExplicitlyTypedOrNotToBeTyped includes: var) not]]) ifTrue: "don't be fooled by previously inferred types"
[type := node expression isSend
ifTrue: [aCodeGen returnTypeForSend: node expression in: self ifNil: nil]
ifFalse: [self typeFor: (node expression isAssignment
ifTrue: [node expression variable]
ifFalse: [node expression]) in: aCodeGen].
type "If untyped, then cannot type the variable yet. A subsequent assignment may assign a subtype of what this type ends up being"
ifNil: "Further, if the type derives from an as-yet-untyped method, we must defer."
[node expression isSend ifTrue:
[alreadyExplicitlyTypedOrNotToBeTyped add: var.
(aCodeGen methodNamed: node expression selector) ifNotNil:
[newDeclarations removeKey: var ifAbsent: nil]]]
ifNotNil: "Merge simple types (but *don't* merge untyped vars); complex types must be defined by the programmer."
[((aCodeGen isSimpleType: type) or: [aCodeGen isFloatingPointCType: type]) ifTrue:
[(asYetUntyped includes: var)
+ ifTrue:
+ [newDeclarations at: var put: (prependType value: type value: var).
+ asYetUntyped remove: var]
- ifTrue: [newDeclarations at: var put: type, ' ', var. asYetUntyped remove: var]
ifFalse:
[aCodeGen mergeTypeOf: var in: newDeclarations with: type method: self].
effectiveNodes at: var put: { newDeclarations at: var. node }, (effectiveNodes at: var ifAbsent: [#()])]]]].
mustBeSigned do:
[:var|
(newDeclarations at: var ifAbsent: nil) ifNotNil:
[:decl| | type |
type := aCodeGen extractTypeFor: var fromDeclaration: decl.
type first == $u ifTrue:
+ [newDeclarations at: var put: (prependType value: (aCodeGen signedTypeForIntegralType: type) value: var)]]].
- [newDeclarations at: var put: (aCodeGen signedTypeForIntegralType: type), ' ', var]]].
newDeclarations keysAndValuesDo:
[:var :decl| declarations at: var put: decl].
^effectiveNodes!
More information about the Vm-dev
mailing list