[Vm-dev] VM Maker: VMMaker.oscog-eem.1432.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Aug 15 01:51:32 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1432.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1432
Author: eem
Time: 14 August 2015, 6:49:05.319 pm
UUID: 926b6e9a-689f-411b-8b70-baa322cf73e7
Ancestors: VMMaker.oscog-tfel.1431
Finally erge and refactor [Co]InterpreterStackPages into these plus a common superclass CogStackPages. rename InterpreterStackPage to CogStackPage. Add stats to compute the average number of live pages at map. Move newStackPage into CogStackPages cuz that's where freeStackPage: is.
Make marshallAbsentReceiverSendArguments: use wordSize instead of BytesperWord.
=============== Diff against VMMaker.oscog-tfel.1431 ===============
Item was removed:
- ----- Method: CCodeGenerator>>structClasses: (in category 'accessing') -----
- structClasses: classes
- structClasses := classes.
- structClasses do:
- [:structClass| self addStructClass: structClass]!
Item was changed:
----- Method: CoInterpreter>>baseFrameReturn (in category 'return bytecodes') -----
baseFrameReturn
"Return from a baseFrame (the bottom frame in a stackPage). The context to
return to (which may be married) is stored in the first word of the stack."
<inline: true>
| contextToReturnTo retToContext theFP theSP thePage newPage frameAbove |
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
<var: #frameAbove type: #'char *'>
contextToReturnTo := self frameCallerContext: localFP.
"The stack page is effectively free now, so free it. We must free it to be
correct in determining if contextToReturnTo is still married, and in case
makeBaseFrameFor: cogs a method, which may cause a code compaction,
in which case the frame must be free to avoid the relocation machinery
tracing the dead frame. Since freeing now temporarily violates the page-list
ordering invariant, use the assert-free version."
stackPages freeStackPageNoAssert: stackPage.
retToContext := objectMemory isContext: contextToReturnTo.
(retToContext
and: [self isStillMarriedContext: contextToReturnTo])
ifTrue:
[theFP := self frameOfMarriedContext: contextToReturnTo.
thePage := stackPages stackPageFor: theFP.
theFP = thePage headFP
ifTrue:
[theSP := thePage headSP]
ifFalse:
["Returning to some interior frame, presumably because of a sender assignment.
Move the frames above to another page (they may be in use, e.g. via coroutining).
Make the interior frame the top frame."
frameAbove := self findFrameAbove: theFP inPage: thePage.
"Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
+ newPage := stackPages newStackPage.
- newPage := self newStackPage.
self assert: newPage = stackPage.
self moveFramesIn: thePage through: frameAbove toPage: newPage.
stackPages markStackPageMostRecentlyUsed: newPage.
theFP := thePage headFP.
theSP := thePage headSP]]
ifFalse:
[(retToContext
and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
[| contextToReturnFrom |
contextToReturnFrom := stackPages longAt: stackPage baseAddress - objectMemory wordSize.
self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom
to: contextToReturnTo
returnValue: localReturnValue.
^self externalCannotReturn: localReturnValue from: contextToReturnFrom].
"We must void the instructionPointer to stop it being updated if makeBaseFrameFor:
cogs a method, which may cause a code compaction."
instructionPointer := 0.
thePage := self makeBaseFrameFor: contextToReturnTo.
theFP := thePage headFP.
theSP := thePage headSP].
self setStackPageAndLimit: thePage.
self assert: (stackPages stackPageFor: theFP) = stackPage.
localSP := theSP.
localFP := theFP.
localIP := self pointerForOop: self internalStackTop.
localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
["localIP in the cog method zone indicates a return to machine code."
^self returnToMachineCodeFrame].
localIP := self pointerForOop: (self iframeSavedIP: localFP)].
self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
self setMethod: (self iframeMethod: localFP).
self internalStackTopPut: localReturnValue.
^self fetchNextBytecode!
Item was changed:
----- Method: CoInterpreter>>ceBaseFrameReturn: (in category 'trampolines') -----
ceBaseFrameReturn: returnValue
"Return across a page boundary. The context to return to (which may be married)
is stored in the first word of the stack. We get here when a return instruction jumps
to the ceBaseFrameReturn: address that is the return pc for base frames. A consequence
of this is that the current frame is no longer valid since an interrupt may have overwritten
its state as soon as the stack pointer has been cut-back beyond the return pc. So to have
a context to send the cannotReturn: message to we also store the base frame's context
in the second word of the stack page."
<api>
| contextToReturnTo contextToReturnFrom isAContext thePage newPage frameAbove |
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
<var: #frameAbove type: #'char *'>
self assert: (stackPages stackPageFor: stackPointer) = stackPage.
self assert: stackPages mostRecentlyUsedPage = stackPage.
cogit assertCStackWellAligned.
self assert: framePointer = 0.
self assert: stackPointer <= (stackPage baseAddress - objectMemory wordSize).
self assert: stackPage baseFP + (2 * objectMemory wordSize) < stackPage baseAddress.
"We would like to use the following assert but we can't since the stack pointer will be above the
base frame pointer in the base frame return and hence the 0 a base frame pointer points at could
be overwritten which will cause the isBaseFrame assert in frameCallerContext: to fail."
"self assert: (self frameCallerContext: stackPage baseFP) = (stackPages longAt: stackPage baseAddress)."
self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress - objectMemory wordSize))
and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress - objectMemory wordSize)]).
self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress))
and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress)]).
contextToReturnTo := stackPages longAt: stackPage baseAddress.
"The stack page is effectively free now, so free it. We must free it to be
correct in determining if contextToReturnTo is still married, and in case
makeBaseFrameFor: cogs a method, which may cause a code compaction,
in which case the frame must be free to avoid the relocation machinery
tracing the dead frame. Since freeing now temporarily violates the page-list
ordering invariant, use the assert-free version."
stackPages freeStackPageNoAssert: stackPage.
isAContext := objectMemory isContext: contextToReturnTo.
(isAContext
and: [self isStillMarriedContext: contextToReturnTo])
ifTrue:
[framePointer := self frameOfMarriedContext: contextToReturnTo.
thePage := stackPages stackPageFor: framePointer.
framePointer = thePage headFP
ifTrue:
[stackPointer := thePage headSP]
ifFalse:
["Returning to some interior frame, presumably because of a sender assignment.
Move the frames above to another page (they may be in use, e.g. via coroutining).
Make the interior frame the top frame."
frameAbove := self findFrameAbove: framePointer inPage: thePage.
"Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
+ newPage := stackPages newStackPage.
- newPage := self newStackPage.
self assert: newPage = stackPage.
self moveFramesIn: thePage through: frameAbove toPage: newPage.
stackPages markStackPageMostRecentlyUsed: newPage.
framePointer := thePage headFP.
stackPointer := thePage headSP]]
ifFalse:
[(isAContext
and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
[contextToReturnFrom := stackPages longAt: stackPage baseAddress - objectMemory wordSize.
self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom
to: contextToReturnTo
returnValue: returnValue.
^self externalCannotReturn: returnValue from: contextToReturnFrom].
"void the instructionPointer to stop it being incorrectly updated in a code
compaction in makeBaseFrameFor:."
instructionPointer := 0.
thePage := self makeBaseFrameFor: contextToReturnTo.
framePointer := thePage headFP.
stackPointer := thePage headSP].
self setStackPageAndLimit: thePage.
self assert: (stackPages stackPageFor: framePointer) = stackPage.
(self isMachineCodeFrame: framePointer) ifTrue:
[self push: returnValue.
cogit ceEnterCogCodePopReceiverReg.
"NOTREACHED"].
instructionPointer := self stackTop.
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[instructionPointer := self iframeSavedIP: framePointer].
self setMethod: (self iframeMethod: framePointer).
self stackTopPut: returnValue. "a.k.a. pop saved ip then push result"
self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer).
self siglong: reenterInterpreter jmp: ReturnToInterpreter.
"NOTREACHED"
^nil!
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 := stackPages newStackPage.
- page := self newStackPage.
"first word on stack is caller context of base frame"
stackPages
longAt: (pointer := page baseAddress)
put: (objectMemory followObjField: 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:
[(objectMemory isForwarded: maybeClosure) ifTrue:
[maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
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:
[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>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #frameRcvrOffset type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #'char *'>
+ stackPages countStackPagesMap.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
+ stackPages countLivePageWhenMapping.
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 frameReceiverLocation: 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:
+ CogStackPages subclass: #CoInterpreterStackPages
+ instanceVariableNames: 'stackBasePlus1 pageMap minStackAddress maxStackAddress'
- CogClass subclass: #CoInterpreterStackPages
- instanceVariableNames: 'coInterpreter objectMemory stackBasePlus1 pages mostRecentlyUsedPage overflowLimit bytesPerPage pageMap minStackAddress maxStackAddress'
classVariableNames: ''
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-JIT'!
+ !CoInterpreterStackPages commentStamp: 'eem 8/14/2015 16:10' prior: 0!
- !CoInterpreterStackPages commentStamp: '<historical>' prior: 0!
I am a class that helps organize the CoInterpreter's collection of stack pages. I hold the set of stack pages represented by CogStackPageSurrogate instances/StackPage structs. The pages are held in a doubly-linked list that notionally has two heads:
mostRecentlyUsedPage-->used page<->used page<->used page<->used page<--leastRecentlyUsedPage
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page
In fact we don't need the least-recently-used page, and so it is only present conceptually. The point is that there is a possibly empty but contiguous sequence of free pages starting at mostRecentlyUsedPage nextPage. New pages are allocated preferentially from the free page next to the MRUP.
+ If there are no free pages then (effectively) the LRUP's frames are flushed to contexts and it is used instead.
+
+ Instance Variables
+ maxStackAddress: <Integer>
+ minStackAddress: <Integer>
+ pageMap: <Dictionary>
+ stackBasePlus1: <Integer>
+
+ maxStackAddress
+ - the maximum valid byte address in the stack zone
+
+ minStackAddress
+ - the minimum valid byte address in the stack zone
+
+ pageMap
+ - a map from address to the CogStackPageSurrogate for that address
+
+ stackBasePlus1
+ - the address of the 2nd byte in the stack memory, used for mapping stack addresses to page indices!
- If there are no free pages then (effectively) the LRUP's frames are flushed to contexts and it is used instead.!
Item was changed:
----- Method: CoInterpreterStackPages class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
aCCodeGenerator
- var: #mostRecentlyUsedPage type: #'StackPage *';
var: #stackBasePlus1 type: #'char *';
- var: #pages type: #'StackPage *'.
- aCCodeGenerator
- removeVariable: 'coInterpreter'; "These are simulation/debugging things only"
- removeVariable: 'objectMemory'; "These are simulation/debugging things only"
removeVariable: 'pageMap'; "These are simulation/debugging things only"
removeVariable: 'maxStackAddress'; "These are simulation/debugging things only"
+ removeVariable: 'minStackAddress' "These are simulation/debugging things only"!
- removeVariable: 'minStackAddress'; "These are simulation/debugging things only"
- removeMethodForSelector: #memIndexFor:!
Item was removed:
- ----- Method: CoInterpreterStackPages>>allPagesFree (in category 'assertions') -----
- allPagesFree
- ^pages allSatisfy: [:page| page isFree]!
Item was removed:
- ----- Method: CoInterpreterStackPages>>byteAt: (in category 'memory access') -----
- byteAt: byteAddress "<Integer>"
- self subclassResponsibility!
Item was removed:
- ----- Method: CoInterpreterStackPages>>extraStackBytes (in category 'initialization') -----
- extraStackBytes
- "See initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:
- ``Because stack pages grow down...''"
- ^objectMemory wordSize!
Item was removed:
- ----- Method: CoInterpreterStackPages>>freeStackPage: (in category 'page access') -----
- freeStackPage: aPage "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- <var: #aPage type: #'StackPage *'>
- <inline: false>
- self freeStackPageNoAssert: aPage.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: CoInterpreterStackPages>>freeStackPageNoAssert: (in category 'page access') -----
- freeStackPageNoAssert: aPage "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- <var: #aPage type: #'StackPage *'>
- <returnTypeC: #void>
- | prev |
- <var: #prev type: #'StackPage *'>
- aPage baseFP: 0.
- aPage == mostRecentlyUsedPage ifTrue:
- [mostRecentlyUsedPage := mostRecentlyUsedPage prevPage.
- ^nil].
- (prev := aPage prevPage) isFree ifTrue:
- [^nil].
- prev nextPage: aPage nextPage.
- aPage nextPage prevPage: prev.
- aPage nextPage: mostRecentlyUsedPage nextPage.
- mostRecentlyUsedPage nextPage prevPage: aPage.
- aPage prevPage: mostRecentlyUsedPage.
- mostRecentlyUsedPage nextPage: aPage!
Item was changed:
----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
"Initialize the stack pages. In the C VM theStackPages will be alloca'ed memory to hold the
stack pages on the C stack. In the simulator they are housed in the memory between the
cogMethodZone and the heap."
<var: #theStackPages type: #'char *'>
<returnTypeC: #void>
| numPages page structStackPageSize pageStructBase count |
<var: #page type: #'StackPage *'>
<var: #pageStructBase type: #'char *'>
self cCode: []
inSmalltalk:
[self assert: objectMemory startOfMemory - coInterpreter cogCodeSize - Cogit guardPageSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize
= (stackSlots * objectMemory wordSize roundUpTo: objectMemory allocationUnit)].
+ structStackPageSize := coInterpreter sizeof: CogStackPage.
- structStackPageSize := coInterpreter sizeof: InterpreterStackPage.
bytesPerPage := slotsPerPage * objectMemory wordSize.
numPages := coInterpreter numStkPages.
"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
push the stackPage array up one word to avoid the overlap. This word is extraStackBytes."
pageStructBase := theStackPages + (numPages * bytesPerPage) + objectMemory wordSize.
pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *']
inSmalltalk:
[pageMap := Dictionary new.
((0 to: numPages - 1) collect:
[:i|
+ CogStackPage surrogateClass new
- InterpreterStackPage surrogateClass new
address: pageStructBase + (i * structStackPageSize)
simulator: coInterpreter
zoneBase: coInterpreter stackZoneBase
zoneLimit: objectMemory startOfMemory])
do: [:pageSurrogate|
pageMap at: pageSurrogate address put: pageSurrogate];
yourself].
"make sure there's enough headroom"
self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset
>= coInterpreter stackPageHeadroom.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
page
lastAddress: theStackPages + (index * bytesPerPage);
baseAddress: page lastAddress + bytesPerPage;
stackLimit: page baseAddress - coInterpreter stackLimitBytes;
realStackLimit: page stackLimit;
baseFP: 0;
nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
"Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from
aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)"
stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1.
self cCode: []
inSmalltalk:
[minStackAddress := theStackPages.
maxStackAddress := theStackPages + (numPages * bytesPerPage) + objectMemory wordSize - 1].
"The overflow limit is the amount of stack to retain when moving frames from an overflowing
stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:"
page := self stackPageAt: 0.
overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
self assert: (self pageIndexFor: page baseAddress) == index.
self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * objectMemory wordSize)) == index.
self assert: (self stackPageFor: page baseAddress) == page.
self assert: (self stackPageFor: page stackLimit) == page.
self cCode: []
inSmalltalk:
[| memIndex |
memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
== (memIndex + slotsPerPage - 1).
index < (numPages - 1) ifTrue:
[self assert: (self stackPageFor: page baseAddress + objectMemory wordSize) == (self stackPageAt: index + 1)]].
coInterpreter initializePageTraceToInvalid: page].
mostRecentlyUsedPage := self stackPageAt: 0.
page := mostRecentlyUsedPage.
count := 0.
[| theIndex |
count := count + 1.
theIndex := self pageIndexFor: page baseAddress.
self assert: (self stackPageAt: theIndex) == page.
self assert: (self pageIndexFor: page baseAddress) == theIndex.
self assert: (self pageIndexFor: page stackLimit) == theIndex.
self assert: (self pageIndexFor: page lastAddress + 1) == theIndex.
(page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
self assert: count == numPages.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CoInterpreterStackPages>>initializeWithByteSize:for: (in category 'initialization') -----
initializeWithByteSize: byteSize "<Integer>" for: anInterpreter "<CoInterpreter>" "^<Array of: <Integer>"
"Initialize the stackPages memory for simulation. To keep access monitoring
+ in one place we defer to the coInterpreter for accessing memory. Answer the
+ base address of th ememory."
- in one place we defer to the coInterpreter for accessing memory."
<doNotGenerate>
coInterpreter := anInterpreter.
objectMemory := coInterpreter objectMemory.
^anInterpreter stackZoneBase!
Item was removed:
- ----- Method: CoInterpreterStackPages>>isFree: (in category 'page access') -----
- isFree: thePage
- "This is an anachronism. Previously Slang couldn't generate the method correctly
- from e.g. CogStackPageSurrogate>>isFree since Slang didn't do substitution on self.
- Now it does, but there are still callers of isFree: so we keep this for simulation."
- <doNotGenerate>
- ^thePage baseFP = 0!
Item was removed:
- ----- Method: CoInterpreterStackPages>>markStackPageLeastMostRecentlyUsed: (in category 'page access') -----
- markStackPageLeastMostRecentlyUsed: page "<InterpreterStackPage>"
- "This method is used to move a page to the end of the used pages.
- This is to keep asserts checking pageListIsWellFormed happy."
-
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
-
- <var: #page type: #'StackPage *'>
- <returnTypeC: #void>
- | lastUsedPage |
- <var: #lastUsedPage type: #'StackPage *'>
- self assert: page = mostRecentlyUsedPage nextPage.
- lastUsedPage := page nextPage.
- [lastUsedPage isFree] whileTrue:
- [lastUsedPage := lastUsedPage nextPage].
- lastUsedPage nextPage = page ifTrue:
- [^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- lastUsedPage prevPage nextPage: page.
- page prevPage: lastUsedPage prevPage.
- page nextPage: lastUsedPage.
- lastUsedPage prevPage: page.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: CoInterpreterStackPages>>markStackPageMostRecentlyUsed: (in category 'page access') -----
- markStackPageMostRecentlyUsed: page "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- <var: #page type: #'StackPage *'>
- <returnTypeC: #void>
- page == mostRecentlyUsedPage ifTrue:
- [^nil].
- "Common case; making new page most recently used."
- page prevPage == mostRecentlyUsedPage ifTrue:
- [mostRecentlyUsedPage := page.
- self assert: self pageListIsWellFormed.
- ^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- mostRecentlyUsedPage nextPage prevPage: page.
- page prevPage: mostRecentlyUsedPage.
- page nextPage: mostRecentlyUsedPage nextPage.
- mostRecentlyUsedPage nextPage: page.
- mostRecentlyUsedPage := page.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: CoInterpreterStackPages>>markStackPageNextMostRecentlyUsed: (in category 'page access') -----
- markStackPageNextMostRecentlyUsed: page "<InterpreterStackPage>"
- "This method is used to move a page to a position in the list such that it cannot
- be deallocated when a new page is allocated, without changing the most recently
- used page. There must be at least 3 pages in the system. So making the page
- the MRU's prevPage is sufficient to ensure it won't be deallocated."
-
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
-
- <var: #page type: #'StackPage *'>
- <returnTypeC: #void>
- self assert: page ~~ mostRecentlyUsedPage.
- page nextPage == mostRecentlyUsedPage ifTrue:
- [^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- mostRecentlyUsedPage prevPage nextPage: page.
- page prevPage: mostRecentlyUsedPage prevPage.
- page nextPage: mostRecentlyUsedPage.
- mostRecentlyUsedPage prevPage: page.
- self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CoInterpreterStackPages>>memIndexFor: (in category 'page access') -----
memIndexFor: byteAddress
+ "Map an address into the stack zone into a word index into the slots in the stack zone."
+ <doNotGenerate>
^(self oopForPointer: byteAddress) - coInterpreter stackZoneBase - 1 // objectMemory wordSize + 1!
Item was removed:
- ----- Method: CoInterpreterStackPages>>mostRecentlyUsedPage (in category 'page access') -----
- mostRecentlyUsedPage
- <cmacro: '() GIV(mostRecentlyUsedPage)'>
- <returnTypeC: #'StackPage *'> "this is to guide Slang's inliner"
- ^mostRecentlyUsedPage!
Item was removed:
- ----- Method: CoInterpreterStackPages>>overflowLimit (in category 'page access') -----
- overflowLimit
- ^overflowLimit!
Item was removed:
- ----- Method: CoInterpreterStackPages>>pageListIsWellFormed (in category 'assertions') -----
- pageListIsWellFormed
- "Answer if the stack page list is well-formed.
- MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- | ok page count limit |
- <inline: false>
- <var: #page type: #'StackPage *'>
- ok := true.
- page := mostRecentlyUsedPage nextPage.
- count := 1.
- limit := coInterpreter numStkPages * 2.
- [page isFree
- and: [page ~= mostRecentlyUsedPage
- and: [count <= limit]]] whileTrue:
- [(self asserta: page nextPage prevPage == page) ifFalse:
- [ok := false].
- page := page nextPage.
- count := count + 1].
- [page ~= mostRecentlyUsedPage
- and: [count <= limit]] whileTrue:
- [(self asserta: page nextPage prevPage == page) ifFalse:
- [ok := false].
- (self asserta: page isFree not)
- ifTrue:
- [(self asserta: ((page addressIsInPage: page baseFP)
- and: [page addressIsInPage: page headSP])) ifFalse:
- [ok := false]]
- ifFalse:
- [ok := false].
- page := page nextPage.
- count := count + 1].
- (self asserta: count = coInterpreter numStkPages) ifFalse:
- [ok := false].
- ^ok!
Item was removed:
- ----- Method: CoInterpreterStackPages>>pages (in category 'accessing') -----
- pages
- <doNotGenerate>
- ^pages!
Item was removed:
- ----- Method: CoInterpreterStackPages>>setInterpreter: (in category 'initialization') -----
- setInterpreter: anInterpreter
- "Initialize the stackPages memory for simulation. To keep access monitoring
- in one place we defer to the coInterpreter for accessing memory."
- <doNotGenerate>
- coInterpreter := anInterpreter.
- objectMemory := coInterpreter objectMemory!
Item was removed:
- ----- Method: CoInterpreterStackPages>>somePageHasHeadFrameFP: (in category 'assertions') -----
- somePageHasHeadFrameFP: theFP
- ^pages anySatisfy: [:page| page headFP = theFP]!
Item was removed:
- ----- Method: CoInterpreterStackPages>>stackPageAt: (in category 'page access') -----
- stackPageAt: index
- "Answer the page for a page index.
- N.B. This is a zero-relative index."
- <returnTypeC: #'StackPage *'>
- ^self stackPageAt: index pages: pages!
Item was removed:
- ----- Method: CoInterpreterStackPages>>stackPageAt:pages: (in category 'page access') -----
- stackPageAt: index pages: thePages
- "Answer the page for a page index.
- N.B. This is a zero-relative index."
- <cmacro: '(index,pages) ((pages) + (index))'>
- <returnTypeC: #'StackPage *'> "for Slang..."
- ^thePages at: index + 1!
Item was removed:
- ----- Method: CoInterpreterStackPages>>stackPageClass (in category 'initialization') -----
- stackPageClass
- <doNotGenerate>
- ^InterpreterStackPage!
Item was removed:
- ----- Method: CoInterpreterStackPages>>stackPageFor: (in category 'page access') -----
- stackPageFor: pointer "<Integer>"
- <inline: true>
- <var: #pointer type: #'void *'>
- <returnTypeC: #'StackPage *'>
- ^self stackPageAt: (self pageIndexFor: pointer)!
Item was changed:
----- Method: CoInterpreterStackPages>>whereIsMaybeStackThing: (in category 'debug printing') -----
whereIsMaybeStackThing: anOop
+ "If anOop is an address within the stack zone answer a string stating that, otherwise answer nil."
<returnTypeC: 'char *'>
(self oop: anOop
isGreaterThanOrEqualTo: (stackBasePlus1 - 1)
andLessThan: (self cCode: [pages]
inSmalltalk: [(self stackPageAt: 0) asUnsignedInteger])) ifTrue:
[^' is in the stack zone'].
^nil!
Item was added:
+ VMStructType subclass: #CogStackPage
+ instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage'
+ classVariableNames: ''
+ poolDictionaries: 'VMBasicConstants VMBytecodeConstants'
+ category: 'VMMaker-Interpreter'!
+
+ !CogStackPage commentStamp: 'eem 8/14/2015 12:06' prior: 0!
+ I am a class that helps organize the StackInterpreter's collection of stack pages. I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages or CoInterpreterStackPages instance.!
Item was added:
+ ----- Method: CogStackPage class>>alignedByteSize (in category 'translation') -----
+ alignedByteSize
+ ^self surrogateClass alignedByteSize!
Item was added:
+ ----- Method: CogStackPage class>>alignedByteSizeOf:forClient: (in category 'translation') -----
+ alignedByteSizeOf: anObject forClient: aVMClass
+ ^self surrogateClass alignedByteSize!
Item was added:
+ ----- Method: CogStackPage class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a StackPage struct."
+
+ self allInstVarNames do:
+ [:ivn|
+ ivn ~= 'stackPagesMemory' ifTrue:
+ [aBinaryBlock
+ value: ivn
+ value: (ivn = 'trace'
+ ifTrue: [#int]
+ ifFalse:
+ [(ivn endsWith: 'Page')
+ ifTrue: ['struct _StackPage *']
+ ifFalse: [#'char *']])]]!
Item was added:
+ ----- Method: CogStackPage class>>structTypeName (in category 'translation') -----
+ structTypeName
+ ^'StackPage' "Drop initial Cog or Interpreter"!
Item was added:
+ ----- Method: CogStackPage class>>surrogateClass (in category 'simulation only') -----
+ surrogateClass
+ ^BytesPerWord = 4
+ ifTrue: [CogStackPageSurrogate32]
+ ifFalse: [CogStackPageSurrogate64]!
Item was added:
+ ----- Method: CogStackPage>>address (in category 'simulation only') -----
+ address
+ <doNotGenerate>
+ ^baseAddress!
Item was added:
+ ----- Method: CogStackPage>>addressIsInPage: (in category 'testing') -----
+ addressIsInPage: address
+ <var: #address type: #'char *'>
+ "For assert-checking"
+ ^lastAddress < address and: [address < baseAddress]!
Item was added:
+ ----- Method: CogStackPage>>baseAddress (in category 'accessing') -----
+ baseAddress
+ ^baseAddress!
Item was added:
+ ----- Method: CogStackPage>>baseAddress: (in category 'accessing') -----
+ baseAddress: anAddress
+ ^baseAddress := anAddress!
Item was added:
+ ----- Method: CogStackPage>>baseFP (in category 'accessing') -----
+ baseFP
+ "Answer the value of baseFP"
+
+ ^ baseFP!
Item was added:
+ ----- Method: CogStackPage>>baseFP: (in category 'accessing') -----
+ baseFP: pointer "<Integer>"
+ "Set the value of baseFP"
+ self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit < pointer]]).
+ ^baseFP := pointer!
Item was added:
+ ----- Method: CogStackPage>>headFP (in category 'accessing') -----
+ headFP
+ "Answer the value of headFP"
+
+ ^headFP!
Item was added:
+ ----- Method: CogStackPage>>headFP: (in category 'accessing') -----
+ headFP: pointer "<Integer>"
+ "Set the value of headFP"
+ ^headFP := pointer!
Item was added:
+ ----- Method: CogStackPage>>headSP (in category 'accessing') -----
+ headSP
+ "Answer the value of headSP"
+
+ ^headSP!
Item was added:
+ ----- Method: CogStackPage>>headSP: (in category 'accessing') -----
+ headSP: pointer "<Integer>"
+ "Set the value of headSP"
+ ^headSP := pointer!
Item was added:
+ ----- Method: CogStackPage>>isFree (in category 'testing') -----
+ isFree
+ ^baseFP = 0!
Item was added:
+ ----- Method: CogStackPage>>lastAddress (in category 'accessing') -----
+ lastAddress
+ ^lastAddress!
Item was added:
+ ----- Method: CogStackPage>>lastAddress: (in category 'accessing') -----
+ lastAddress: anAddress
+ ^lastAddress := anAddress!
Item was added:
+ ----- Method: CogStackPage>>nextPage (in category 'accessing') -----
+ nextPage
+ "Answer the value of nextPage"
+
+ ^ nextPage!
Item was added:
+ ----- Method: CogStackPage>>nextPage: (in category 'accessing') -----
+ nextPage: anObject
+ "Set the value of nextPage"
+
+ ^nextPage := anObject!
Item was added:
+ ----- Method: CogStackPage>>prevPage (in category 'accessing') -----
+ prevPage
+ "Answer the value of prevPage"
+
+ ^ prevPage!
Item was added:
+ ----- Method: CogStackPage>>prevPage: (in category 'accessing') -----
+ prevPage: anObject
+ "Set the value of prevPage"
+
+ ^prevPage := anObject!
Item was added:
+ ----- Method: CogStackPage>>printOn: (in category 'printing') -----
+ printOn: aStream
+ <doNotGenerate>
+ super printOn: aStream.
+ aStream nextPut: $@; print: baseAddress; space.
+ self isFree
+ ifTrue: [aStream nextPutAll: 'free']
+ ifFalse: [aStream print: baseFP; nextPutAll: '<->'; print: headFP; space; nextPutAll: 'trace '; print: trace]!
Item was added:
+ ----- Method: CogStackPage>>realStackLimit (in category 'accessing') -----
+ realStackLimit
+ "Answer the value of realStackLimit"
+
+ ^ realStackLimit!
Item was added:
+ ----- Method: CogStackPage>>realStackLimit: (in category 'accessing') -----
+ realStackLimit: anObject
+ "Set the value of realStackLimit"
+
+ ^realStackLimit := anObject!
Item was added:
+ ----- Method: CogStackPage>>stackLimit (in category 'accessing') -----
+ stackLimit
+ "Answer the value of stackLimit"
+
+ ^ stackLimit!
Item was added:
+ ----- Method: CogStackPage>>stackLimit: (in category 'accessing') -----
+ stackLimit: anObject
+ "Set the value of stackLimit"
+
+ ^stackLimit := anObject!
Item was added:
+ ----- Method: CogStackPage>>trace (in category 'accessing') -----
+ trace
+ "Answer the page's trace state.
+ 0 = untraced. 1 = should be traced. 2 = has been traced.
+ -1 = invalid (for assertions)"
+ ^trace!
Item was added:
+ ----- Method: CogStackPage>>trace: (in category 'accessing') -----
+ trace: anInteger
+ "Set the page's trace state.
+ 0 = untraced. 1 = should be traced. 2 = has been traced.
+ -1 = invalid (for assertions)"
+ ^trace := anInteger!
Item was added:
+ CogClass subclass: #CogStackPages
+ instanceVariableNames: 'coInterpreter objectMemory pages mostRecentlyUsedPage overflowLimit bytesPerPage statNumMaps statPageCountWhenMappingSum'
+ classVariableNames: ''
+ poolDictionaries: 'VMBasicConstants'
+ category: 'VMMaker-Interpreter'!
+
+ !CogStackPages commentStamp: 'eem 8/14/2015 16:43' prior: 0!
+ I am a class that helps organize the StackInterpreter's collection of stack pages. I hold the set of stack pages represented by InterpreterStackPage instances/StackPage structs. The pages are held in a doubly-linked list that notionally has two heads:
+
+ mostRecentlyUsedPage-->used page<->used page<->used page<->used page<--leastRecentlyUsedPage
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page
+
+ In fact we don't need the least-recently-used page, and so it is only present conceptually. The point is that there is a possibly empty but contiguous sequence of free pages starting at mostRecentlyUsedPage nextPage. New pages are allocated preferentially from the free page next to the MRUP.
+ If there are no free pages then (effectively) the LRUP's frames are flushed to contexts and it is used instead.
+
+ I have two concrete classes, one for the StackInterpreter and one for the CoInterpreter.
+
+ Instance Variables
+ bytesPerPage: <Integer>
+ coInterpreter: <StackInterpreter>
+ mostRecentlyUsedPage: <CogStackPage>
+ objectMemory: <ObjectMemory|SpurMemoryManager>
+ overflowLimit: <Integer>
+ pages: <Array of: CogStackPage>
+ statNumMaps: <Integer>
+ statPageCountWhenMappingSum: <Integer>
+
+ bytesPerPage
+ - the size of a page in bytes
+
+ coInterpreter
+ - the interpreter the receiver is holding pages for
+
+ mostRecentlyUsedPage
+ - the most recently used stack page
+
+ objectMemory
+ - the objectMemory of the interpreter
+
+ overflowLimit
+ - the length in bytes of the portion of teh stack that can be used for frames before the page is judged to have overflowed
+
+ pages
+ - the collection of stack pages the receiver is managing
+
+ statNumMaps
+ - the number of mapStackPages calls
+
+ statPageCountWhenMappingSum:
+ - the sum of the number of in use pages at each mapStackPages, used to estimate the average number of in use pages at scavenge, which heavily influences scavenger performance
+ !
Item was added:
+ ----- Method: CogStackPages class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ aCCodeGenerator
+ var: #mostRecentlyUsedPage type: #'StackPage *';
+ var: #pages type: #'StackPage *'.
+ aCCodeGenerator
+ removeVariable: 'coInterpreter'; "These are simulation/debugging things only"
+ removeVariable: 'objectMemory' "These are simulation/debugging things only"!
Item was added:
+ ----- Method: CogStackPages>>allPagesFree (in category 'assertions') -----
+ allPagesFree
+ <doNotGenerate>
+ ^pages allSatisfy: [:page| (self isFree: page)]!
Item was added:
+ ----- Method: CogStackPages>>byteAt: (in category 'memory access') -----
+ byteAt: byteAddress "<Integer>"
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogStackPages>>countLivePageWhenMapping (in category 'accessing') -----
+ countLivePageWhenMapping
+ <inline: true>
+ statPageCountWhenMappingSum := statPageCountWhenMappingSum + 1!
Item was added:
+ ----- Method: CogStackPages>>countStackPagesMap (in category 'accessing') -----
+ countStackPagesMap
+ <inline: true>
+ statNumMaps := statNumMaps + 1!
Item was added:
+ ----- Method: CogStackPages>>extraStackBytes (in category 'initialization') -----
+ extraStackBytes
+ "See initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:
+ ``Because stack pages grow down...''"
+ ^objectMemory wordSize!
Item was added:
+ ----- Method: CogStackPages>>freeStackPage: (in category 'page access') -----
+ freeStackPage: aPage "<InterpreterStackPage>"
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+ <var: #aPage type: #'StackPage *'>
+ <inline: false>
+ self freeStackPageNoAssert: aPage.
+ self assert: self pageListIsWellFormed!
Item was added:
+ ----- Method: CogStackPages>>freeStackPageNoAssert: (in category 'page access') -----
+ freeStackPageNoAssert: aPage "<InterpreterStackPage>"
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+ <var: #aPage type: #'StackPage *'>
+ <returnTypeC: #void>
+ | prev |
+ <var: #prev type: #'StackPage *'>
+ aPage baseFP: 0.
+ aPage == mostRecentlyUsedPage ifTrue:
+ [mostRecentlyUsedPage := mostRecentlyUsedPage prevPage.
+ ^nil].
+ (prev := aPage prevPage) isFree ifTrue:
+ [^nil].
+ prev nextPage: aPage nextPage.
+ aPage nextPage prevPage: prev.
+ aPage nextPage: mostRecentlyUsedPage nextPage.
+ mostRecentlyUsedPage nextPage prevPage: aPage.
+ aPage prevPage: mostRecentlyUsedPage.
+ mostRecentlyUsedPage nextPage: aPage!
Item was added:
+ ----- Method: CogStackPages>>initialize (in category 'initialization') -----
+ initialize
+ "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
+ statNumMaps := statPageCountWhenMappingSum := 0!
Item was added:
+ ----- Method: CogStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
+ initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
+ "Initialize the stack pages. In the C VM theStackPages will be alloca'ed memory to hold the
+ stack pages on the C stack. In the simulator they are housed in the memory between the
+ cogMethodZone and the heap."
+ <returnTypeC: #void>
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogStackPages>>initializeWithByteSize:for: (in category 'initialization') -----
+ initializeWithByteSize: byteSize "<Integer>" for: anInterpreter "<CoInterpreter>" "^<Array of: <Integer>"
+ "Initialize the stackPages memory for simulation. Answer the base address of the memory."
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogStackPages>>isFree: (in category 'page access') -----
+ isFree: thePage
+ "This is an anachronism. Previously Slang couldn't generate the method correctly
+ from e.g. CogStackPageSurrogate>>isFree since Slang didn't do substitution on self.
+ Now it does, but there are still callers of isFree: so we keep this for simulation."
+ <doNotGenerate>
+ ^thePage baseFP = 0!
Item was added:
+ ----- Method: CogStackPages>>markStackPageLeastMostRecentlyUsed: (in category 'page access') -----
+ markStackPageLeastMostRecentlyUsed: page "<InterpreterStackPage>"
+ "This method is used to move a page to the end of the used pages.
+ This is to keep asserts checking pageListIsWellFormed happy."
+
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+
+ <var: #page type: #'StackPage *'>
+ <returnTypeC: #void>
+ | lastUsedPage |
+ <var: #lastUsedPage type: #'StackPage *'>
+ self assert: page = mostRecentlyUsedPage nextPage.
+ lastUsedPage := page nextPage.
+ [lastUsedPage isFree] whileTrue:
+ [lastUsedPage := lastUsedPage nextPage].
+ lastUsedPage nextPage = page ifTrue:
+ [^nil].
+ page prevPage nextPage: page nextPage.
+ page nextPage prevPage: page prevPage.
+ lastUsedPage prevPage nextPage: page.
+ page prevPage: lastUsedPage prevPage.
+ page nextPage: lastUsedPage.
+ lastUsedPage prevPage: page.
+ self assert: self pageListIsWellFormed!
Item was added:
+ ----- Method: CogStackPages>>markStackPageMostRecentlyUsed: (in category 'page access') -----
+ markStackPageMostRecentlyUsed: page "<InterpreterStackPage>"
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+ <var: #page type: #'StackPage *'>
+ <returnTypeC: #void>
+ page == mostRecentlyUsedPage ifTrue:
+ [^nil].
+ "Common case; making new page most recently used."
+ page prevPage == mostRecentlyUsedPage ifTrue:
+ [mostRecentlyUsedPage := page.
+ self assert: self pageListIsWellFormed.
+ ^nil].
+ page prevPage nextPage: page nextPage.
+ page nextPage prevPage: page prevPage.
+ mostRecentlyUsedPage nextPage prevPage: page.
+ page prevPage: mostRecentlyUsedPage.
+ page nextPage: mostRecentlyUsedPage nextPage.
+ mostRecentlyUsedPage nextPage: page.
+ mostRecentlyUsedPage := page.
+ self assert: self pageListIsWellFormed!
Item was added:
+ ----- Method: CogStackPages>>markStackPageNextMostRecentlyUsed: (in category 'page access') -----
+ markStackPageNextMostRecentlyUsed: page "<InterpreterStackPage>"
+ "This method is used to move a page to a position in the list such that it cannot
+ be deallocated when a new page is allocated, without changing the most recently
+ used page. There must be at least 3 pages in the system. So making the page
+ the MRU's prevPage is sufficient to ensure it won't be deallocated."
+
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+
+ <var: #page type: #'StackPage *'>
+ <returnTypeC: #void>
+ self assert: page ~~ mostRecentlyUsedPage.
+ page nextPage == mostRecentlyUsedPage ifTrue:
+ [^nil].
+ page prevPage nextPage: page nextPage.
+ page nextPage prevPage: page prevPage.
+ mostRecentlyUsedPage prevPage nextPage: page.
+ page prevPage: mostRecentlyUsedPage prevPage.
+ page nextPage: mostRecentlyUsedPage.
+ mostRecentlyUsedPage prevPage: page.
+ self assert: self pageListIsWellFormed!
Item was added:
+ ----- Method: CogStackPages>>memIndexFor: (in category 'page access') -----
+ memIndexFor: byteAddress
+ "Map an address into the stack zone into a word index into the slots in the stack zone."
+ <doNotGenerate>
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogStackPages>>mostRecentlyUsedPage (in category 'page access') -----
+ mostRecentlyUsedPage
+ <cmacro: '() GIV(mostRecentlyUsedPage)'>
+ <returnTypeC: #'StackPage *'> "this is to guide Slang's inliner"
+ ^mostRecentlyUsedPage!
Item was added:
+ ----- Method: CogStackPages>>newStackPage (in category 'page access') -----
+ newStackPage
+ "MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+ <returnTypeC: #'StackPage *'>
+ | lruOrFree |
+ <var: #lruOrFree type: #'StackPage *'>
+ lruOrFree := mostRecentlyUsedPage nextPage.
+ lruOrFree isFree ifTrue:
+ [^lruOrFree].
+ coInterpreter divorceFramesIn: lruOrFree.
+ ^lruOrFree!
Item was added:
+ ----- Method: CogStackPages>>overflowLimit (in category 'page access') -----
+ overflowLimit
+ ^overflowLimit!
Item was added:
+ ----- Method: CogStackPages>>pageIndexFor: (in category 'page access') -----
+ pageIndexFor: pointer "<Integer>"
+ "Answer the page index for a pointer into stack memory, i.e. the index
+ for the page the address is in. N.B. This is a zero-relative index."
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ self subclassResponsibility!
Item was added:
+ ----- Method: CogStackPages>>pageListIsWellFormed (in category 'assertions') -----
+ pageListIsWellFormed
+ "Answer if the stack page list is well-formed.
+ MRUP-->used page<->used page<->used page<->used page<--LRUP
+ ^ <-next-prev-> ^
+ | |
+ v <-prev-next-> v
+ free page<->free page<->free page<->free page"
+ | ok page count limit |
+ <inline: false>
+ <var: #page type: #'StackPage *'>
+ ok := true.
+ page := mostRecentlyUsedPage nextPage.
+ count := 1.
+ limit := coInterpreter numStkPages * 2.
+ [page isFree
+ and: [page ~= mostRecentlyUsedPage
+ and: [count <= limit]]] whileTrue:
+ [(self asserta: page nextPage prevPage == page) ifFalse:
+ [ok := false].
+ page := page nextPage.
+ count := count + 1].
+ [page ~= mostRecentlyUsedPage
+ and: [count <= limit]] whileTrue:
+ [(self asserta: page nextPage prevPage == page) ifFalse:
+ [ok := false].
+ (self asserta: page isFree not)
+ ifTrue:
+ [(self asserta: ((page addressIsInPage: page baseFP)
+ and: [page addressIsInPage: page headSP])) ifFalse:
+ [ok := false]]
+ ifFalse:
+ [ok := false].
+ page := page nextPage.
+ count := count + 1].
+ (self asserta: count = coInterpreter numStkPages) ifFalse:
+ [ok := false].
+ ^ok!
Item was added:
+ ----- Method: CogStackPages>>pages (in category 'accessing') -----
+ pages
+ <doNotGenerate>
+ ^pages!
Item was added:
+ ----- Method: CogStackPages>>setInterpreter: (in category 'initialization') -----
+ setInterpreter: anInterpreter
+ "Initialize the stackPages memory for simulation. To keep access monitoring
+ in one place we defer to the coInterpreter for accessing memory."
+ <doNotGenerate>
+ coInterpreter := anInterpreter.
+ objectMemory := coInterpreter objectMemory!
Item was added:
+ ----- Method: CogStackPages>>somePageHasHeadFrameFP: (in category 'assertions') -----
+ somePageHasHeadFrameFP: theFP
+ <doNotGenerate>
+ ^pages anySatisfy: [:page| page headFP = theFP]
+ !
Item was added:
+ ----- Method: CogStackPages>>stackPageAt: (in category 'page access') -----
+ stackPageAt: index
+ "Answer the page for a page index.
+ N.B. This is a zero-relative index."
+ <returnTypeC: #'StackPage *'>
+ <inline: true>
+ ^self stackPageAt: index pages: pages!
Item was added:
+ ----- Method: CogStackPages>>stackPageAt:pages: (in category 'page access') -----
+ stackPageAt: index pages: thePages
+ "Answer the page for a page index.
+ N.B. This is a zero-relative index."
+ <cmacro: '(index,pages) ((pages) + (index))'>
+ <returnTypeC: #'StackPage *'> "for Slang..."
+ ^thePages at: index + 1!
Item was added:
+ ----- Method: CogStackPages>>stackPageFor: (in category 'page access') -----
+ stackPageFor: pointer "<Integer>"
+ <inline: true>
+ <var: #pointer type: #'void *'>
+ <returnTypeC: #'StackPage *'>
+ ^self stackPageAt: (self pageIndexFor: pointer)!
Item was added:
+ ----- Method: CogStackPages>>statAverageLivePagesWhenMapping (in category 'statistics') -----
+ statAverageLivePagesWhenMapping
+ <returnTypeC: #double>
+ ^statPageCountWhenMappingSum asFloat / statNumMaps!
Item was added:
+ ----- Method: CogStackPages>>whereIsMaybeStackThing: (in category 'debug printing') -----
+ whereIsMaybeStackThing: anOop
+ "If anOop is an address within the stack zone answer a string stating that, otherwise answer nil."
+ <returnTypeC: 'char *'>
+ self subclassResponsibility!
Item was removed:
- VMStructType subclass: #InterpreterStackPage
- instanceVariableNames: 'stackLimit headSP headFP baseFP baseAddress realStackLimit lastAddress trace nextPage prevPage'
- classVariableNames: ''
- poolDictionaries: 'VMBasicConstants VMBytecodeConstants'
- category: 'VMMaker-Interpreter'!
-
- !InterpreterStackPage commentStamp: '<historical>' prior: 0!
- I am a class that helps organize the StackInterpreter's collection of stack pages. I represent the control block for a single stack page in the collection of stack pages represented by an InterpreterStackPages instance.!
Item was removed:
- ----- Method: InterpreterStackPage class>>alignedByteSize (in category 'translation') -----
- alignedByteSize
- ^self surrogateClass alignedByteSize!
Item was removed:
- ----- Method: InterpreterStackPage class>>alignedByteSizeOf:forClient: (in category 'translation') -----
- alignedByteSizeOf: anObject forClient: aVMClass
- ^self surrogateClass alignedByteSize!
Item was removed:
- ----- Method: InterpreterStackPage class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a StackPage struct."
-
- self allInstVarNames do:
- [:ivn|
- ivn ~= 'stackPagesMemory' ifTrue:
- [aBinaryBlock
- value: ivn
- value: (ivn = 'trace'
- ifTrue: [#int]
- ifFalse:
- [(ivn endsWith: 'Page')
- ifTrue: ['struct _StackPage *']
- ifFalse: [#'char *']])]]!
Item was removed:
- ----- Method: InterpreterStackPage class>>structTypeName (in category 'translation') -----
- structTypeName
- ^'StackPage' "Drop initial Cog or Interpreter"!
Item was removed:
- ----- Method: InterpreterStackPage class>>surrogateClass (in category 'simulation only') -----
- surrogateClass
- ^BytesPerWord = 4
- ifTrue: [CogStackPageSurrogate32]
- ifFalse: [CogStackPageSurrogate64]!
Item was removed:
- ----- Method: InterpreterStackPage>>address (in category 'simulation only') -----
- address
- <doNotGenerate>
- ^baseAddress!
Item was removed:
- ----- Method: InterpreterStackPage>>addressIsInPage: (in category 'testing') -----
- addressIsInPage: address
- <var: #address type: #'char *'>
- "For assert-checking"
- ^lastAddress < address and: [address < baseAddress]!
Item was removed:
- ----- Method: InterpreterStackPage>>baseAddress (in category 'accessing') -----
- baseAddress
- ^baseAddress!
Item was removed:
- ----- Method: InterpreterStackPage>>baseAddress: (in category 'accessing') -----
- baseAddress: anAddress
- ^baseAddress := anAddress!
Item was removed:
- ----- Method: InterpreterStackPage>>baseFP (in category 'accessing') -----
- baseFP
- "Answer the value of baseFP"
-
- ^ baseFP!
Item was removed:
- ----- Method: InterpreterStackPage>>baseFP: (in category 'accessing') -----
- baseFP: pointer "<Integer>"
- "Set the value of baseFP"
- self assert: (pointer = 0 or: [pointer < baseAddress and: [realStackLimit < pointer]]).
- ^baseFP := pointer!
Item was removed:
- ----- Method: InterpreterStackPage>>headFP (in category 'accessing') -----
- headFP
- "Answer the value of headFP"
-
- ^headFP!
Item was removed:
- ----- Method: InterpreterStackPage>>headFP: (in category 'accessing') -----
- headFP: pointer "<Integer>"
- "Set the value of headFP"
- ^headFP := pointer!
Item was removed:
- ----- Method: InterpreterStackPage>>headSP (in category 'accessing') -----
- headSP
- "Answer the value of headSP"
-
- ^headSP!
Item was removed:
- ----- Method: InterpreterStackPage>>headSP: (in category 'accessing') -----
- headSP: pointer "<Integer>"
- "Set the value of headSP"
- ^headSP := pointer!
Item was removed:
- ----- Method: InterpreterStackPage>>isFree (in category 'testing') -----
- isFree
- ^baseFP = 0!
Item was removed:
- ----- Method: InterpreterStackPage>>lastAddress (in category 'accessing') -----
- lastAddress
- ^lastAddress!
Item was removed:
- ----- Method: InterpreterStackPage>>lastAddress: (in category 'accessing') -----
- lastAddress: anAddress
- ^lastAddress := anAddress!
Item was removed:
- ----- Method: InterpreterStackPage>>nextPage (in category 'accessing') -----
- nextPage
- "Answer the value of nextPage"
-
- ^ nextPage!
Item was removed:
- ----- Method: InterpreterStackPage>>nextPage: (in category 'accessing') -----
- nextPage: anObject
- "Set the value of nextPage"
-
- ^nextPage := anObject!
Item was removed:
- ----- Method: InterpreterStackPage>>prevPage (in category 'accessing') -----
- prevPage
- "Answer the value of prevPage"
-
- ^ prevPage!
Item was removed:
- ----- Method: InterpreterStackPage>>prevPage: (in category 'accessing') -----
- prevPage: anObject
- "Set the value of prevPage"
-
- ^prevPage := anObject!
Item was removed:
- ----- Method: InterpreterStackPage>>printOn: (in category 'printing') -----
- printOn: aStream
- <doNotGenerate>
- super printOn: aStream.
- aStream nextPut: $@; print: baseAddress; space.
- self isFree
- ifTrue: [aStream nextPutAll: 'free']
- ifFalse: [aStream print: baseFP; nextPutAll: '<->'; print: headFP; space; nextPutAll: 'trace '; print: trace]!
Item was removed:
- ----- Method: InterpreterStackPage>>realStackLimit (in category 'accessing') -----
- realStackLimit
- "Answer the value of realStackLimit"
-
- ^ realStackLimit!
Item was removed:
- ----- Method: InterpreterStackPage>>realStackLimit: (in category 'accessing') -----
- realStackLimit: anObject
- "Set the value of realStackLimit"
-
- ^realStackLimit := anObject!
Item was removed:
- ----- Method: InterpreterStackPage>>stackLimit (in category 'accessing') -----
- stackLimit
- "Answer the value of stackLimit"
-
- ^ stackLimit!
Item was removed:
- ----- Method: InterpreterStackPage>>stackLimit: (in category 'accessing') -----
- stackLimit: anObject
- "Set the value of stackLimit"
-
- ^stackLimit := anObject!
Item was removed:
- ----- Method: InterpreterStackPage>>trace (in category 'accessing') -----
- trace
- "Answer the page's trace state.
- 0 = untraced. 1 = should be traced. 2 = has been traced.
- -1 = invalid (for assertions)"
- ^trace!
Item was removed:
- ----- Method: InterpreterStackPage>>trace: (in category 'accessing') -----
- trace: anInteger
- "Set the page's trace state.
- 0 = untraced. 1 = should be traced. 2 = has been traced.
- -1 = invalid (for assertions)"
- ^trace := anInteger!
Item was changed:
+ CogStackPages subclass: #InterpreterStackPages
+ instanceVariableNames: 'stackMemory indexOffset pageSizeInSlots'
- VMClass subclass: #InterpreterStackPages
- instanceVariableNames: 'interpreter objectMemory stackMemory indexOffset pages mostRecentlyUsedPage overflowLimit numPages pageSizeInSlots bytesPerPage'
classVariableNames: ''
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Interpreter'!
!InterpreterStackPages commentStamp: '<historical>' prior: 0!
I am a class that helps organize the StackInterpreter's collection of stack pages. I hold the set of stack pages represented by InterpreterStackPage instances/StackPage structs. The pages are held in a doubly-linked list that notionally has two heads:
mostRecentlyUsedPage-->used page<->used page<->used page<->used page<--leastRecentlyUsedPage
^ <-next-prev-> ^
| |
v <-prev-next-> v
free page<->free page<->free page<->free page
In fact we don't need the least-recently-used page, and so it is only present conceptually. The point is that there is a possibly empty but contiguous sequence of free pages starting at mostRecentlyUsedPage nextPage. New pages are allocated preferentially from the free page next to the MRUP.
If there are no free pages then (effectively) the LRUP's frames are flushed to contexts and it is used instead.!
Item was changed:
----- Method: InterpreterStackPages class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
aCCodeGenerator
var: #stackMemory type: 'char *';
+ removeVariable: 'indexOffset'; "These are simulation/debugging things only"
+ removeVariable: 'pageSizeInSlots' "These are simulation/debugging things only"!
- var: #mostRecentlyUsedPage type: 'StackPage *';
- var: #pages type: 'StackPage *'.
- aCCodeGenerator "These are simulation/debugging things only"
- removeVariable: 'interpreter';
- removeVariable: 'indexOffset';
- removeVariable: 'pageSizeInSlots';
- removeMethodForSelector: #memIndexFor:!
Item was removed:
- ----- Method: InterpreterStackPages>>allPagesFree (in category 'assertions') -----
- allPagesFree
- <doNotGenerate>
- ^pages allSatisfy: [:page| (self isFree: page)]!
Item was removed:
- ----- Method: InterpreterStackPages>>byteAt: (in category 'memory access') -----
- byteAt: byteAddress "<Integer>"
- self subclassResponsibility!
Item was changed:
----- Method: InterpreterStackPages>>extraStackBytes (in category 'initialization') -----
extraStackBytes
"See initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:
``Because stack pages grow down...''"
+ ^self cCode: [objectMemory wordSize] inSmalltalk: [0]!
- ^self cCode: 'BytesPerWord' inSmalltalk: [0]!
Item was removed:
- ----- Method: InterpreterStackPages>>freeStackPage: (in category 'page access') -----
- freeStackPage: aPage "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- <var: #aPage type: #'StackPage *'>
- self freeStackPageNoAssert: aPage.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: InterpreterStackPages>>freeStackPageNoAssert: (in category 'page access') -----
- freeStackPageNoAssert: aPage "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- | prev |
- <var: #aPage type: #'StackPage *'>
- <var: #prev type: #'StackPage *'>
- aPage baseFP: 0.
- aPage == mostRecentlyUsedPage ifTrue:
- [mostRecentlyUsedPage := mostRecentlyUsedPage prevPage.
- ^nil].
- "lack of type inferrence means ``self isFree: aPage prevPage''
- isn't turned into a direct field test; sigh..."
- prev := aPage prevPage.
- (self isFree: prev) ifTrue:
- [^nil].
- prev nextPage: aPage nextPage.
- aPage nextPage prevPage: prev.
- aPage nextPage: mostRecentlyUsedPage nextPage.
- mostRecentlyUsedPage nextPage prevPage: aPage.
- aPage prevPage: mostRecentlyUsedPage.
- mostRecentlyUsedPage nextPage: aPage!
Item was changed:
----- Method: InterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
"Initialize the stack pages. For testing I want stack addresses to be disjoint from
normal memory addresses so stack addresses are negative. The first address is
-pageSize bytes. So for example if there are 1024 bytes per page and 3 pages
then the pages are organized as
byte address: -1024 <-> -2047 | -2048 <-> -3071 | -3072 <-> -4096 |
page 3 page 2 page 1
mem index: 769 <-> 513 | 512 <-> 257 | 256 <-> 1 |
The byte address is the external address corresponding to a real address in the VM.
mem index is the index in the memory Array holding the stack, an index internal to
the stack pages. The first stack page allocated will be the last page in the array of pages
at the highest effective address. Its base address be -1024 and grow down towards -2047."
"The lFoo's are to get around the foo->variable scheme in the C call to allocStackPages below."
<var: #theStackPages type: #'char *'>
+ | numPages page structStackPageSize pageStructBase count |
- | page structStackPageSize pageStructBase count |
<var: #page type: #'StackPage *'>
<var: #pageStructBase type: #'char *'>
self cCode: ''
inSmalltalk:
[self assert: stackMemory size = stackSlots.
self assert: stackMemory == theStackPages].
stackMemory := theStackPages. "For initialization in the C code."
self cCode: '' inSmalltalk: [pageSizeInSlots := slotsPerPage].
+ structStackPageSize := coInterpreter sizeof: CogStackPage.
- structStackPageSize := interpreter sizeof: InterpreterStackPage.
bytesPerPage := slotsPerPage * objectMemory wordSize.
+ numPages := coInterpreter numStkPages.
- numPages := stackSlots // (slotsPerPage + (structStackPageSize / objectMemory wordSize)).
"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
push the stackPage array up one word to avoid the overlap. This word is extraStackBytes."
pageStructBase := theStackPages + (numPages * bytesPerPage) + objectMemory wordSize.
pages := self cCode: '(StackPage *)pageStructBase'
inSmalltalk:
[pageStructBase class.
+ (1 to: numPages) collect: [:i| CogStackPage new]].
- (1 to: numPages) collect: [:i| InterpreterStackPage new]].
"Simulation only. Since addresses are negative the offset is positive. To make all
stack addresses negative we make the offset a page more than it needs to be so the
address of the last slot in memory (the highest address in the stack, or its start) is
- pageByteSize
and the address of the first slot (the lowest address, or its end) is
- pageByteSize * (numPages + 1)"
self cCode: '' inSmalltalk: [indexOffset := (numPages + 1) * slotsPerPage].
"make sure there's enough headroom"
+ self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset
+ >= coInterpreter stackPageHeadroom.
- self assert: interpreter stackPageByteSize - interpreter stackLimitBytes - interpreter stackLimitOffset
- >= interpreter stackPageHeadroom.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
page
lastAddress: (self cCode: '(char *)theStackPages + (index * GIV(bytesPerPage))'
inSmalltalk: [(index * slotsPerPage - indexOffset) * objectMemory wordSize]);
baseAddress: (page lastAddress + bytesPerPage);
+ stackLimit: page baseAddress - coInterpreter stackLimitBytes;
- stackLimit: page baseAddress - interpreter stackLimitBytes;
realStackLimit: page stackLimit;
baseFP: 0;
nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
self cCode: ''
inSmalltalk:
[| lowestAddress highestAddress |
lowestAddress := (pages at: 1) lastAddress + objectMemory wordSize.
highestAddress := (pages at: numPages) baseAddress.
"see InterpreterStackPages>>longAt:"
self assert: lowestAddress // objectMemory wordSize + indexOffset = 1.
self assert: highestAddress // objectMemory wordSize + indexOffset = (numPages * slotsPerPage)].
"The overflow limit is the amount of stack to retain when moving frames from an overflowing
stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:"
page := self stackPageAt: 0.
overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
self assert: (self pageIndexFor: page baseAddress) == index.
self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * objectMemory wordSize)) == index.
self assert: (self stackPageFor: page baseAddress) == page.
self assert: (self stackPageFor: page stackLimit) == page.
self cCode: ''
inSmalltalk:
[| memIndex |
memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
== (memIndex + slotsPerPage - 1).
index < (numPages - 1) ifTrue:
[self assert: (self stackPageFor: page baseAddress + objectMemory wordSize) == (self stackPageAt: index + 1)]].
+ coInterpreter initializePageTraceToInvalid: page].
- interpreter initializePageTraceToInvalid: page].
mostRecentlyUsedPage := self stackPageAt: 0.
page := mostRecentlyUsedPage.
count := 0.
[| theIndex |
count := count + 1.
theIndex := self pageIndexFor: page baseAddress.
self assert: (self stackPageAt: theIndex) == page.
self assert: (self pageIndexFor: page baseAddress) == theIndex.
self assert: (self pageIndexFor: page stackLimit) == theIndex.
self assert: (self pageIndexFor: page lastAddress + objectMemory wordSize) == theIndex.
(page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
self assert: count == numPages.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: InterpreterStackPages>>initializeWithByteSize:for: (in category 'initialization') -----
initializeWithByteSize: byteSize "<Integer>" for: anInterpreter "<StackInterpreter>" "^<Array of: <Integer>"
+ "Initialize the stackPages memory for simulation. Answer the base address of the memory."
- "Initialize the stackPages memory for simulation."
<doNotGenerate>
+ coInterpreter := anInterpreter.
- interpreter := anInterpreter.
objectMemory := anInterpreter objectMemory.
^stackMemory := Array new: byteSize / objectMemory wordSize withAll: 0!
Item was removed:
- ----- Method: InterpreterStackPages>>isFree: (in category 'page access') -----
- isFree: thePage
- "This is an anachronism. Previously Slang couldn't generate the method correctly
- from e.g. InterpreterStackPage>>isFree since Slang didn't do substitution on self.
- Now it does, but there are still callers of isFree: so we keep this for simulation."
- <doNotGenerate>
- ^thePage baseFP = 0!
Item was removed:
- ----- Method: InterpreterStackPages>>markStackPageLeastMostRecentlyUsed: (in category 'page access') -----
- markStackPageLeastMostRecentlyUsed: page "<InterpreterStackPage>"
- "This method is used to move a page to the end of the used pages.
- This is to keep asserts checking pageListIsWellFormed happy."
-
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
-
- <var: #page type: #'StackPage *'>
- <returnTypeC: #void>
- | lastUsedPage |
- <var: #lastUsedPage type: #'StackPage *'>
- self assert: page = mostRecentlyUsedPage nextPage.
- lastUsedPage := page nextPage.
- [lastUsedPage isFree] whileTrue:
- [lastUsedPage := lastUsedPage nextPage].
- lastUsedPage nextPage = page ifTrue:
- [^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- lastUsedPage prevPage nextPage: page.
- page prevPage: lastUsedPage prevPage.
- page nextPage: lastUsedPage.
- lastUsedPage prevPage: page.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: InterpreterStackPages>>markStackPageMostRecentlyUsed: (in category 'page access') -----
- markStackPageMostRecentlyUsed: page "<InterpreterStackPage>"
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- <var: #page type: #'StackPage *'>
- page == mostRecentlyUsedPage ifTrue:
- [^nil].
- "Common case; making new page most recently used."
- page prevPage == mostRecentlyUsedPage ifTrue:
- [mostRecentlyUsedPage := page.
- self assert: self pageListIsWellFormed.
- ^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- mostRecentlyUsedPage nextPage prevPage: page.
- page prevPage: mostRecentlyUsedPage.
- page nextPage: mostRecentlyUsedPage nextPage.
- mostRecentlyUsedPage nextPage: page.
- mostRecentlyUsedPage := page.
- self assert: self pageListIsWellFormed!
Item was removed:
- ----- Method: InterpreterStackPages>>markStackPageNextMostRecentlyUsed: (in category 'page access') -----
- markStackPageNextMostRecentlyUsed: page "<InterpreterStackPage>"
- "This method is used to move a page to a position in the list such that it cannot
- be deallocated when a new page is allocated, without changing the most recently
- used page. There must be at least 3 pages in the system. So making the page
- the MRU's prevPage is sufficient to ensure it won't be deallocated."
-
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
-
- <var: #page type: #'StackPage *'>
- self assert: page ~~ mostRecentlyUsedPage.
- page nextPage == mostRecentlyUsedPage ifTrue:
- [^nil].
- page prevPage nextPage: page nextPage.
- page nextPage prevPage: page prevPage.
- mostRecentlyUsedPage prevPage nextPage: page.
- page prevPage: mostRecentlyUsedPage prevPage.
- page nextPage: mostRecentlyUsedPage.
- mostRecentlyUsedPage prevPage: page.
- self assert: self pageListIsWellFormed!
Item was changed:
----- Method: InterpreterStackPages>>memIndexFor: (in category 'page access') -----
memIndexFor: byteAddress
+ "Map an address into the stack zone into a word index into the slots in the stack zone."
+ <doNotGenerate>
^(self oopForPointer: byteAddress) // objectMemory wordSize + indexOffset!
Item was removed:
- ----- Method: InterpreterStackPages>>mostRecentlyUsedPage (in category 'page access') -----
- mostRecentlyUsedPage
- <cmacro: '() GIV(mostRecentlyUsedPage)'>
- <returnTypeC: #'StackPage *'> "this is to guide Slang's inliner"
- ^mostRecentlyUsedPage!
Item was removed:
- ----- Method: InterpreterStackPages>>overflowLimit (in category 'page access') -----
- overflowLimit
- ^overflowLimit!
Item was removed:
- ----- Method: InterpreterStackPages>>pageListIsWellFormed (in category 'assertions') -----
- pageListIsWellFormed
- "Answer if the stack page list is well-formed.
- MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- | ok page count limit |
- <inline: false>
- <var: #page type: #'StackPage *'>
- ok := true.
- page := mostRecentlyUsedPage nextPage.
- count := 1.
- limit := numPages * 2.
- [page isFree
- and: [page ~= mostRecentlyUsedPage
- and: [count <= limit]]] whileTrue:
- [(self asserta: page nextPage prevPage == page) ifFalse:
- [ok := false].
- page := page nextPage.
- count := count + 1].
- [page ~= mostRecentlyUsedPage
- and: [count <= limit]] whileTrue:
- [(self asserta: page nextPage prevPage == page) ifFalse:
- [ok := false].
- (self asserta: page isFree not)
- ifTrue:
- [(self asserta: ((page addressIsInPage: page baseFP)
- and: [page addressIsInPage: page headSP])) ifFalse:
- [ok := false]]
- ifFalse:
- [ok := false].
- page := page nextPage.
- count := count + 1].
- (self asserta: count = numPages) ifFalse:
- [ok := false].
- ^ok!
Item was removed:
- ----- Method: InterpreterStackPages>>setInterpreter: (in category 'initialization') -----
- setInterpreter: anInterpreter
- "Initialize the stackPages memory for simulation."
- <doNotGenerate>
- interpreter := anInterpreter.
- objectMemory := interpreter objectMemory!
Item was removed:
- ----- Method: InterpreterStackPages>>somePageHasHeadFrameFP: (in category 'assertions') -----
- somePageHasHeadFrameFP: theFP
- <doNotGenerate>
- ^pages anySatisfy: [:page| page headFP = theFP]
- !
Item was removed:
- ----- Method: InterpreterStackPages>>stackPageAt: (in category 'page access') -----
- stackPageAt: index
- "Answer the page for a page index.
- N.B. This is a zero-relative index."
- <returnTypeC: #'StackPage *'>
- ^self stackPageAt: index pages: pages!
Item was removed:
- ----- Method: InterpreterStackPages>>stackPageAt:pages: (in category 'page access') -----
- stackPageAt: index pages: thePages
- "Answer the page for a page index.
- N.B. This is a zero-relative index."
- <cmacro: '(index,pages) ((pages) + (index))'>
- <returnTypeC: #'StackPage *'> "for Slang..."
- ^thePages at: index + 1!
Item was removed:
- ----- Method: InterpreterStackPages>>stackPageClass (in category 'initialization') -----
- stackPageClass
- <doNotGenerate>
- ^InterpreterStackPage!
Item was removed:
- ----- Method: InterpreterStackPages>>stackPageFor: (in category 'page access') -----
- stackPageFor: pointer "<Integer>"
- <inline: true>
- <var: #pointer type: #'void *'>
- <returnTypeC: #'StackPage *'>
- ^self stackPageAt: (self pageIndexFor: pointer)!
Item was changed:
----- Method: InterpreterStackPages>>whereIsMaybeStackThing: (in category 'debug printing') -----
whereIsMaybeStackThing: anOop
+ "If anOop is an address within the stack zone answer a string stating that, otherwise answer nil."
<returnTypeC: 'char *'>
(self cCode:
[self oop: anOop isGreaterThanOrEqualTo: stackMemory andLessThan: pages]
inSmalltalk:
[(self memIndexFor: anOop) between: 1 and: stackMemory size]) ifTrue:
[^' is in the stack zone'].
^nil!
Item was changed:
----- Method: SimpleStackBasedCogit>>marshallAbsentReceiverSendArguments: (in category 'bytecode generators') -----
marshallAbsentReceiverSendArguments: numArgs
self assert: needsFrame.
self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
"Shuffle arguments if necessary and push receiver."
numArgs = 0
ifTrue:
[self PushR: ReceiverResultReg]
ifFalse:
[self MoveMw: 0 r: SPReg R: TempReg.
self PushR: TempReg.
2 to: numArgs do:
[:index|
+ self MoveMw: index * objectMemory wordSize r: SPReg R: TempReg.
- self MoveMw: index * BytesPerWord r: SPReg R: TempReg.
self MoveR: TempReg Mw: index - 1 * BytesPerWord r: SPReg].
self MoveR: ReceiverResultReg Mw: numArgs * BytesPerWord r: SPReg].!
Item was changed:
----- Method: StackInterpreter class>>ancilliaryClasses: (in category 'translation') -----
ancilliaryClasses: options
"Answer any extra classes to be included in the translation."
^{ self objectMemoryClass.
VMCallbackContext.
+ CogStackPages.
InterpreterStackPages.
+ CogStackPage }!
- InterpreterStackPage }!
Item was changed:
----- Method: StackInterpreter>>commonReturn (in category 'return bytecodes') -----
commonReturn
"Do an ^-return (return from method), checking for unwinds if this is a block activation.
Note: Assumed to be inlined into the dispatch loop."
<sharedCodeInCase: #returnReceiver>
| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
<var: #frameToReturnTo type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #newPage type: #'StackPage *'>
<var: #thePage type: #'StackPage *'>
"If this is a method simply return to the sender/caller."
(self iframeIsBlockActivation: localFP) ifFalse:
[^self commonCallerReturn].
"Since this is a block activation the closure is on the stack above any args and the frame."
closure := self pushedReceiverOrClosureOfFrame: localFP.
home := nil.
"Walk the closure's lexical chain to find the context or frame to return from (home)."
[closure ~= objectMemory nilObject] whileTrue:
[home := objectMemory followField: ClosureOuterContextIndex ofObject: closure.
closure := objectMemory followField: ClosureIndex ofObject: home].
"home is to be returned from provided there is no unwind-protect activation between
this frame and home's sender. Search for an unwind. findUnwindThroughContext:
will answer either the context for an unwind-protect activation or nilObj if the sender
cannot be found or 0 if no unwind is found but the sender is. We must update the
current page's headFrame pointers to enable the search to identify widowed contexts
correctly."
self writeBackHeadFramePointers.
self externalizeIPandSP.
unwindContextOrNilOrZero := self findUnwindThroughContext: home.
unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
["error: can't find home on chain; cannot return"
^self internalCannotReturn: localReturnValue].
unwindContextOrNilOrZero ~= 0 ifTrue:
[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
"Now we know home is on the sender chain.
We could be returning to either a context or a frame. Find out which."
contextToReturnTo := nil.
(self isMarriedOrWidowedContext: home)
ifTrue:
[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
theFP := self frameOfMarriedContext: home.
(self isBaseFrame: theFP)
ifTrue:
[contextToReturnTo := self frameCallerContext: theFP]
ifFalse:
[frameToReturnTo := self frameCallerFP: theFP]]
ifFalse:
[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
((objectMemory isContext: contextToReturnTo)
and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
contextToReturnTo := nil]].
"If returning to a context we must make a frame for it unless it is dead."
contextToReturnTo ~= nil ifTrue:
[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
frameToReturnTo == 0 ifTrue:
["error: home's sender is dead; cannot return"
^self internalCannotReturn: localReturnValue]].
"Now we have a frame to return to. If it is on a different page we must free intervening pages and
nil out intervening contexts. We must free intervening stack pages because if we leave the pages
to be divorced then their contexts will be divorced with intact senders and instruction pointers. This
code is similar to primitiveTerminateTo. We must move any frames on intervening pages above the
frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
self assert: stackPages pageListIsWellFormed.
newPage := stackPages stackPageFor: frameToReturnTo.
newPage ~~ stackPage ifTrue:
[| currentCtx thePage nextCntx |
currentCtx := self frameCallerContext: stackPage baseFP.
stackPages freeStackPage: stackPage.
[self assert: (objectMemory isContext: currentCtx).
(self isMarriedOrWidowedContext: currentCtx)
and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
[(self isMarriedOrWidowedContext: currentCtx)
ifTrue:
[thePage := stackPages stackPageFor: theFP.
theFP ~= thePage headFP ifTrue:
["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
+ self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: stackPages newStackPage].
- self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
currentCtx := self frameCallerContext: thePage baseFP.
stackPages freeStackPage: thePage]
ifFalse:
[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
self markContextAsDead: currentCtx.
currentCtx := nextCntx]].
self setStackPageAndLimit: newPage.
localSP := stackPage headSP.
localFP := stackPage headFP].
"Two cases. Returning to the top frame on a new page or an interior frame on the current page.
The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
localFP = frameToReturnTo
ifTrue: "pop the saved IP, push the return value and continue."
[localIP := self pointerForOop: self internalStackTop]
ifFalse:
[[callerFP := localFP.
localFP := self frameCallerFP: localFP.
localFP ~~ frameToReturnTo] whileTrue.
localIP := self frameCallerSavedIP: callerFP.
localSP := (self frameCallerSP: callerFP) - objectMemory wordSize].
self maybeReturnToMachineCodeFrame.
self setMethod: (self frameMethod: localFP).
self fetchNextBytecode.
self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: StackInterpreter>>computeStackZoneSize (in category 'initialization') -----
computeStackZoneSize
self cCode: [] inSmalltalk:
[stackPages ifNil:
[stackPages := self stackPagesClass new setInterpreter: self]].
+ ^numStackPages * ((self sizeof: CogStackPage) + self stackPageByteSize)
- ^numStackPages * ((self sizeof: InterpreterStackPage) + self stackPageByteSize)
+ stackPages extraStackBytes!
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 = 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.
- [newPage := self newStackPage.
theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
onCurrent
ifTrue:
[self setStackPageAndLimit: newPage.
framePointer := stackPage headFP.
stackPointer := stackPage headSP]
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>>externalSetStackPageAndPointersForSuspendedContextOfProcess: (in category 'frame access') -----
externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess
"Set stackPage, instructionPointer, framePointer and stackPointer for the suspendedContext of
aProcess, marrying the context if necessary, and niling the suspendedContext slot. This is used
on process switch to ensure a context has a stack frame and so can continue execution."
| newContext theFrame thePage newPage |
<inline: true>
<var: #theFrame type: #'char *'>
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
self assert: (objectMemory isContext: newContext).
(self isMarriedOrWidowedContext: newContext) ifTrue:
[self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)].
objectMemory
storePointerUnchecked: SuspendedContextIndex
ofObject: aProcess
withValue: objectMemory nilObject.
(self isStillMarriedContext: newContext)
ifTrue:
[theFrame := self frameOfMarriedContext: newContext.
thePage := stackPages stackPageFor: theFrame.
theFrame ~= thePage headFP ifTrue:
["explicit assignment of suspendedContext can cause switch to interior frame."
+ newPage := stackPages newStackPage.
- newPage := self newStackPage.
self moveFramesIn: thePage
through: (self findFrameAbove: theFrame inPage: thePage)
toPage: newPage.
stackPages markStackPageLeastMostRecentlyUsed: newPage].
self assert: thePage headFP = theFrame]
ifFalse:
[thePage := self makeBaseFrameFor: newContext.
theFrame := thePage baseFP].
self setStackPageAndLimit: thePage.
stackPointer := thePage headSP.
framePointer := thePage headFP.
(self isMachineCodeFrame: framePointer) ifFalse:
[self setMethod: (self iframeMethod: framePointer)].
instructionPointer := self popStack.
self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer!
Item was changed:
----- Method: StackInterpreter>>handleStackOverflow (in category 'message sending') -----
handleStackOverflow
"Check for stack overflow, moving frames to another stack if so."
| newPage theFP callerFP overflowLimitAddress overflowCount |
<var: #newPage type: #'StackPage *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #overflowLimitAddress type: #'char *'>
"After checkForInterrupts another event check may have been forced, setting both
stackLimit and stackPage stackLimit to all ones. So here we must check against
the real stackLimit, not the effective stackLimit."
stackPointer < stackPage realStackLimit ifFalse:
[^self].
self maybeTraceStackOverflow.
statStackOverflow := statStackOverflow + 1.
"The stack has overflowed this page. If the system is executing some recursive algorithm,
e.g. fibonacci, then the system could thrash overflowing the stack if the call soon returns
back to the current page. To avoid thrashing, since overflow is quite slow, we can move
more than one frame. The idea is to record which page has overflowed, and the first
time it overflows move one frame, the second time two frames, and so on. We move no
more frames than would leave the page half occupied."
theFP := framePointer.
stackPage = overflowedPage
ifTrue:
[overflowLimitAddress := stackPage baseAddress - stackPages overflowLimit.
overflowCount := extraFramesToMoveOnOverflow := extraFramesToMoveOnOverflow + 1.
[(overflowCount := overflowCount - 1) >= 0
and: [(callerFP := self frameCallerFP: theFP) < overflowLimitAddress
and: [(self isBaseFrame: callerFP) not]]] whileTrue:
[theFP := callerFP]]
ifFalse:
[overflowedPage := stackPage.
extraFramesToMoveOnOverflow := 0].
self ensureCallerContext: theFP.
+ newPage := stackPages newStackPage.
- newPage := self newStackPage.
self moveFramesIn: stackPage through: theFP toPage: newPage.
self setStackPageAndLimit: newPage.
framePointer := stackPage headFP.
stackPointer := stackPage headSP.
self isCog
ifFalse: "To overflow the stack this must be a new frame, but in Cog base frames are married."
[self assert: (self frameHasContext: framePointer) not.
self assert: (self validInstructionPointer: instructionPointer + 1
inMethod: method
framePointer: framePointer)]
ifTrue:
[self assert: (self validInstructionPointer: instructionPointer + 1
inFrame: framePointer).
self assert: ((self frameHasContext: framePointer) not
or: [objectMemory isContext: (self frameContext: framePointer)])]!
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 := stackPages newStackPage.
- 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 fetchPointer: ClosureIndex ofObject: aContext.
maybeClosure ~= objectMemory nilObject
ifTrue:
[(objectMemory isForwarded: maybeClosure) ifTrue:
[maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
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:
[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 followObjField: 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>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #'char *'>
+ stackPages countStackPagesMap.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP theIPPtr theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
+ stackPages countLivePageWhenMapping.
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 removed:
- ----- Method: StackInterpreter>>newStackPage (in category 'stack pages') -----
- newStackPage
- "MRUP-->used page<->used page<->used page<->used page<--LRUP
- ^ <-next-prev-> ^
- | |
- v <-prev-next-> v
- free page<->free page<->free page<->free page"
- | lruOrFree |
- <var: #lruOrFree type: #'StackPage *'>
- <returnTypeC: #'StackPage *'>
- lruOrFree := stackPages mostRecentlyUsedPage nextPage.
- (stackPages isFree: lruOrFree) ifTrue:
- [^lruOrFree].
- self divorceFramesIn: lruOrFree.
- ^lruOrFree!
Item was changed:
----- Method: StackInterpreter>>numStkPages (in category 'stack pages') -----
numStkPages
+ <inline: true>
^numStackPages!
Item was changed:
----- Method: StackInterpreter>>storeSenderOfFrame:withValue: (in category 'frame access') -----
storeSenderOfFrame: theFP withValue: anOop
"Set the sender of a frame. If the frame is a base frame then this is trivial;
merely store into the FoxCallerSavedIP/FoxCallerContext field. If not, then
split the stack at the frame, moving the frame and those hotter than it to a
new stack page. In the new stack page the frame will be the base frame
and storing trivial. Answer the possibly changed location of theFP."
| thePage onCurrentPage newPage theMovedFP |
<var: #theFP type: #'char *'>
<var: #thePage type: #'StackPage *'>
<var: #newPage type: #'StackPage *'>
<var: #theMovedFP type: #'char *'>
<returnTypeC: #'char *'>
(self isBaseFrame: theFP) ifTrue:
[self frameCallerContext: theFP put: anOop.
^theFP].
self ensureCallerContext: theFP.
thePage := stackPages stackPageFor: theFP.
self assert: stackPage = stackPages mostRecentlyUsedPage.
onCurrentPage := thePage = stackPage.
onCurrentPage ifFalse:
["Make sure the frame's page isn't divorced when a new page is allocated."
stackPages markStackPageNextMostRecentlyUsed: thePage].
+ newPage := stackPages newStackPage.
- newPage := self newStackPage.
theMovedFP := self moveFramesIn: thePage through: theFP toPage: newPage.
onCurrentPage
ifTrue: [self setStackPageAndLimit: newPage]
ifFalse: [stackPages markStackPageMostRecentlyUsed: newPage].
self assert: (self isBaseFrame: theMovedFP).
self frameCallerContext: theMovedFP put: anOop.
^theMovedFP!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)
More information about the Vm-dev
mailing list