Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- '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'.! !
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement