StackEvtInterpreter.st

'From Pharo1.3 of 16 June 2011 [Latest update: #13281] on 17 July 2011 at 10:44:32 pm'!
StackInterpreterPrimitives subclass: #StackEvtInterpreter
    instanceVariableNames: 'jmpBufExit'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'VMMaker-Interpreter'!
!StackEvtInterpreter commentStamp: 'golubovsky 7/9/2011 21:24' prior: 0!
This is a subclass of the StackInterpreter which implements the specifics of the Event-driven Cog Stack VM!


!StackEvtInterpreter methodsFor: 'callback support' stamp: 'golubovsky 7/12/2011 22:45'!
callbackEnter: callbackID
    "Callbacks are disabled in Event VM"
    <export: true>
    <var: #callbackID type: #'sqInt *'>
        [^false].! !


!StackEvtInterpreter methodsFor: 'initialization' stamp: 'golubovsky 7/11/2011 06:45'!
initStackPagesAndInterpret
    "Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
     we have a JIT its stack pointer will be on the native stack since alloca allocates
     memory on the stack. Certain thread systems use the native stack pointer as the
     frame ID so putting the stack anywhere else can confuse the thread system."

    "This method overrides its parent so that heartbeat is not initialized: EventVM does not
    have hartbeat."

    "This should be in its own initStackPages method but Slang can't inline
     C code strings."
    | stackPageBytes stackPagesBytes theStackMemory |
    <var: #theStackMemory type: #'void *'>
    stackPageBytes := self stackPageByteSize.
    stackPagesBytes := self computeStackZoneSize.
    theStackMemory := self
                        cCode: 'alloca(stackPagesBytes)'
                        inSmalltalk:
                            [stackPages := self stackPagesClass new.
                             stackPages initializeWithByteSize: stackPagesBytes for: self].
    stackPages
        initializeStack: theStackMemory
        numSlots: stackPagesBytes / BytesPerWord
        pageSize: stackPageBytes / BytesPerWord
        stackLimitOffset: self stackLimitOffset
        stackPageHeadroom: self stackPageHeadroom.

    "Once the stack pages are initialized we can continue to bootstrap the system."
    self loadInitialContext.
    self interpret.
    ^nil! !



!StackEvtInterpreter methodsFor: 'interpreter shell' stamp: 'golubovsky 7/13/2011 22:32'!
interpret
    "This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. When running in the context of a browser plugin VM, however, it must return control to the browser periodically. This should done only when the state of the currently running Squeak thread is safely stored in the object heap. Since this is the case at the moment that a check for interrupts is performed, that is when we return to the browser if it is time to do so. Interrupt checks happen quite frequently. The EventVM version of interpreter also has a special jmp_buf used to bail out of the interpreter once no processes are ready to run. If returned for no events available, return value is 0, and if returned as normal VM termination, return value is 1. The host program may use this information to determine when to loop"

    | result |
    <inline: false>
    "If stacklimit is zero then the stack pages have not been initialized."
    stackLimit = 0 ifTrue:
        [^self initStackPagesAndInterpret].
    "record entry time when running as a browser plug-in"
    self browserPluginInitialiseIfNeeded.
    "set up a jmp_buf to bail out when no processes are ready to run"
    result := self cCode: 'setjmp(jmpBufExit)'
                inSmalltalk:[jmpBufExit := [^self]. 0].
    result = 0 ifFalse:[^0].    "return 0 when suspended for an event"
    self internalizeIPandSP.
    self fetchNextBytecode.
    [true] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable].
    localIP := localIP - 1.  "undo the pre-increment of IP before returning"
    self externalizeIPandSP.
    ^1  "return 1 if normal VM termination"
! !


!StackEvtInterpreter methodsFor: 'process primitive support' stamp: 'golubovsky 7/17/2011 00:10'!
transferTo: newProc
    "Record a process to be awoken on the next interpreter cycle."
    "If such process is nil bail out of the interpreter"
    | activeContext sched oldProc |
    <inline: false>
    statProcessSwitch := statProcessSwitch + 1.
    self push: instructionPointer.
    self externalWriteBackHeadFramePointers.
    sched := self schedulerPointer.
    oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
    activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
    objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
    newProc == nil ifTrue:[
        self cCode:'longjmp(jmpBufExit, 1)'
                inSmalltalk:[jmpBufExit value].
    ].
    objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc.
    objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject.
    self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc.
    instructionPointer := self popStack
! !

!StackEvtInterpreter methodsFor: 'process primitive support' stamp: 'golubovsky 7/16/2011 21:54'!
wakeHighestPriority
    "Return the highest priority process that is ready to run.
     To save time looking at many empty lists before finding a
     runnable process the VM maintains a variable holding the
     highest priority runnable process.  If this variable is 0 then the
     VM does not know the highest priority and must search all lists."
    | schedLists p processList |
    schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
    p := highestRunnableProcessPriority = 0
            ifTrue: [objectMemory fetchWordLengthOf: schedLists]
            ifFalse: [highestRunnableProcessPriority].
    p := p - 1.
    "index of last indexable field"
    [processList := objectMemory fetchPointer: p ofObject: schedLists.
     self isEmptyList: processList] whileTrue:
        [(p := p - 1) < 0 ifTrue:
            [^nil]
        ].
    highestRunnableProcessPriority := p + 1.
    ^self removeFirstLinkOfList: processList! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StackEvtInterpreter class
    instanceVariableNames: ''!

!StackEvtInterpreter class methodsFor: 'translation' stamp: 'golubovsky 7/13/2011 06:19'!
declareCVarsIn: aCCodeGenerator
    "define the jmpbuf for bailing out of the interpreter: its definition will be added
    to the definitions made by the parent classes - no super call is necessary"
    aCCodeGenerator var: #jmpBufExit declareC: 'jmp_buf jmpBufExit'.! !