Leon Matthes uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.threaded-LM.3339.mcz
==================== Summary ====================
Name: VMMaker.threaded-LM.3339 Author: LM Time: 28 September 2023, 4:12:53.651627 pm UUID: 0d2d7578-99c6-415e-a3e4-bb64bc493a2a Ancestors: VMMaker.oscog-eem.3338
Make vmThread>>#state an atomic_int
For this to work in both Smalltalk and the generated C code, the #state and #state: accessors can no longer be used! Instead, the vmThreadState and setVmThreadState functions should be called. Otherwise the generation doesn't work out, as Slang can't handle the atomic_load and atomic_store in the accessors.
=============== Diff against VMMaker.oscog-eem.3338 ===============
Item was changed: ----- Method: CoInterpreterMT>>assertSaneThreadAndProcess (in category 'debug support') ----- assertSaneThreadAndProcess <inline: true> self assert: cogThreadManager vmIsOwned. + self assert: cogThreadManager currentVMThread vmThreadState = CTMAssignableOrInVM. - self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM. self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. cogThreadManager assertValidProcessorStackPointersForIndex: cogThreadManager getVMOwner!
Item was changed: ----- Method: CoInterpreterMT>>disownVM: (in category 'vm scheduling') ----- disownVM: flags "Release the VM to other threads and answer the current thread's index. Currently valid flags: DisownVMForFFICall - informs the VM that it is entering an FFI call DisownVMForThreading - informs the VM that it is entering code during which threading should be permitted OwnVMForeignThreadFlag - indicates lowest-level entry from a foreign thread - not to be used explicitly by clients - only set by ownVMFromUnidentifiedThread VMAlreadyOwnedHenceDoNotDisown - indicates an ownVM from a callback was made when the vm was still owned. - not to be used explicitly by clients - only set by ownVMFromUnidentifiedThread
This is the entry-point for plugins and primitives that wish to release the VM while performing some operation that may potentially block, and for callbacks returning back to some blocking operation. If this thread does not reclaim the VM before- hand then when the next heartbeat occurs the thread manager will schedule a thread to acquire the VM which may start running the VM in place of this thread.
N.B. Most of the state needed to resume after preemption is set in preemptDisowningThread." <public> <inline: false> | vmThread result | self assert: (flags >= 0 and: [flags < (1 bitShift: DisownFlagsShift)]). self assert: self successful. cogit recordEventTrace ifTrue: [self recordTrace: TraceDisownVM thing: (objectMemory integerObjectOf: flags) source: 0]. processHasThreadAffinity ifFalse: [willNotThreadWarnCount < 10 ifTrue: [self print: 'warning: VM parameter 48 indicates Process doesn''t have threadId; VM will not thread'; cr. willNotThreadWarnCount := willNotThreadWarnCount + 1]]. vmThread := cogThreadManager currentVMThread. (flags anyMask: VMAlreadyOwnedHenceDoNotDisown) ifTrue: [disowningVMThread := vmThread. + vmThread setVmThreadState: CTMUnavailable. - vmThread state: CTMUnavailable. ^0]. self assertCStackPointersBelongToCurrentThread. self assertValidNewMethodPropertyFlags. self cCode: '' inSmalltalk: [cogThreadManager saveRegisterStateForCurrentProcess. cogThreadManager clearRegisterStates.]. (flags anyMask: DisownVMForProcessorRelinquish) ifTrue: [| proc | (proc := objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject ifTrue: [foreignCallbackPriority := self quickFetchInteger: PriorityIndex ofObject: proc]. relinquishing := true. self sqLowLevelMFence]. disownCount := disownCount + 1. "If we're disowning the VM because there's no active process to run, there's nothing to preempt later, so don't indicate that there's a disowningVMThread that needs to be restored later." self activeProcess ~= objectMemory nilObject ifTrue: [disowningVMThread := vmThread].
"OwnVMForeignThreadFlag indicates lowest-level of entry by a foreign thread. If that's where we are then release the vmThread. Otherwise indicate the vmThread is off doing something outside of the VM." (flags anyMask: OwnVMForeignThreadFlag) ifTrue: ["I don't think this is quite right. Josh's use case is creating some foreign thread and then registering it with the VM. That's not the same as binding a process to a foreign thread given that the foreign callback process is about to terminate anyway (it is returning from a callback here). So do we need an additional concept, that of a vmThread being either of the set known to the VM or floating?" self flag: 'issue with registering foreign threads with the VM'. (self isBoundProcess: self activeProcess) ifFalse: [cogThreadManager unregisterVMThread: vmThread]] + ifFalse: [vmThread setVmThreadState: CTMUnavailable]. - ifFalse: [vmThread state: CTMUnavailable].
result := ((vmThread index bitShift: DisownFlagsShift) bitOr: (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])) bitOr: flags. cogThreadManager releaseVM. ^result!
Item was changed: ----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') ----- mapInterpreterOops "Map all oops in the interpreter's state to their new values during garbage collection or a become: operation." "Assume: All traced variables contain valid oops." <var: #vmThread type: #'CogVMThread *'> super mapInterpreterOops.
"Per-thread state; trace each thread's own newMethod and stack of awol processes." 1 to: cogThreadManager getNumThreads do: [:i| | vmThread | vmThread := cogThreadManager vmThreadAt: i. + vmThread vmThreadState ~= CTMUninitialized ifTrue: - vmThread state ifNotNil: [(vmThread newMethodOrNull notNil and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue: [vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)]. 0 to: vmThread awolProcIndex - 1 do: [:j| (objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue: [vmThread awolProcesses at: j put: (objectMemory remapObj: (vmThread awolProcesses at: j))]]]]!
Item was changed: ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') ----- markAndTraceInterpreterOops: fullGCFlag "Override to mark the awolProcesses" <var: #vmThread type: #'CogVMThread *'>
super markAndTraceInterpreterOops: fullGCFlag.
"Per-thread state; trace each thread's own newMethod and stack of awol processes." 1 to: cogThreadManager getNumThreads do: [:i| | vmThread | vmThread := cogThreadManager vmThreadAt: i. + vmThread vmThreadState ~= CTMUninitialized ifTrue: - vmThread state ifNotNil: [vmThread newMethodOrNull ifNotNil: [objectMemory markAndTrace: vmThread newMethodOrNull]. 0 to: vmThread awolProcIndex - 1 do: [:j| objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
Item was changed: ----- Method: CoInterpreterMT>>ownVMFromUnidentifiedThread (in category 'vm scheduling') ----- ownVMFromUnidentifiedThread "Attempt to take ownership from a thread that as yet doesn't know its index. This supports callbacks where the callback could originate from any thread. Answer 0 if the owning thread is known to the VM. Answer 1 if the owning thread is unknown to the VM and now owns the VM. Answer -1 if the owning thread is unknown to the VM and fails to own the VM. Answer -2 if the owning thread is unknown to the VM and there is no foreign callback process installed." | count threadIndex vmThread | <var: #vmThread type: #'CogVMThread *'> <inline: false> self cCode: [] inSmalltalk: [self halt: 'TODO: Implement processor register switching']. (threadIndex := cogThreadManager ioGetThreadLocalThreadIndex) ~= 0 ifTrue: [ "this is a callback from a known thread" (cogThreadManager vmOwnerIs: threadIndex) ifTrue: "the VM has not been disowned" [self assert: (disowningVMThread isNil or: [disowningVMThread = self currentVMThread]). disowningVMThread := nil. + self currentVMThread setVmThreadState: CTMAssignableOrInVM. - self currentVMThread state: CTMAssignableOrInVM. ^VMAlreadyOwnedHenceDoNotDisown]. ^self ownVM: threadIndex]. foreignCallbackPriority = 0 ifTrue: [^-2]. count := 0. "If the current thread doesn't have an index it's new to the vm and we need to allocate a new threadInfo, failing if we can't. We also need a process in the foreignCallbackProcessSlot upon which to run the thread's eventual callback." [[cogThreadManager tryLockVMOwnerTo: cogThreadManager ioCurrentOSThread asUnsignedInteger] whileFalse: [self waitingPriorityIsAtLeast: foreignCallbackPriority. cogThreadManager ioTransferTimeslice]. (objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject] whileFalse: [cogThreadManager releaseVM. (count := count + 1) > 1000 ifTrue: [^-2]. cogThreadManager ioMilliSleep: 1].
vmThread := cogThreadManager unusedThreadInfo. "N.B. Keep the VM locked anonymously so that we reserve the non-nil ForeignCallbackProcess for this thread, avoiding the race between competing foreign callbacks. The acquireVMFor: in ownVM: will set the vmOwner to the actual index. So only unlock on failure." vmThread ifNil: [cogThreadManager releaseVM. ^-1]. cogThreadManager setVMOwner: vmThread index. vmThread + setVmThreadState: CTMWantingOwnership; - state: CTMWantingOwnership; priority: foreignCallbackPriority. cogThreadManager registerVMThread: vmThread. ^self ownVM: vmThread index + OwnVMForeignThreadFlag!
Item was changed: ----- Method: CoInterpreterMT>>preemptDisowningThread (in category 'vm scheduling') ----- preemptDisowningThread "Set the relevant state for disowningVMThread so that it can resume after being preempted and set disowningVMThread to nil to indicate preemption.
N.B. This should only be sent from checkPreemptionOfDisowningThread.
There are essentially four things to do. a) save the VM's notion of the current C stack pointers; these are pointers into a thread's stack and must be saved and restored in thread switch. b) save the VM's notion of the current Smalltalk execution point. This is simply the suspend half of a process switch that saves the current context in the current process. c) add the process to the thread's set of AWOL processes so that the scheduler won't try to run the process while the thread has disowned the VM. d) save the in-primitive VM state, newMethod and argumentCount
ownVM: will restore the VM context as of disownVM: from the above when it finds it has been preempted."
| activeProc activeContext preemptedThread | <var: #preemptedThread type: #'CogVMThread *'> <inline: false> self assert: disowningVMThread notNil. + self assert: (disowningVMThread vmThreadState = CTMUnavailable + or: [disowningVMThread vmThreadState = CTMWantingOwnership]). - self assert: (disowningVMThread state = CTMUnavailable - or: [disowningVMThread state = CTMWantingOwnership]). self assertCStackPointersBelongToDisowningThread. cogit recordEventTrace ifTrue: [self recordTrace: TracePreemptDisowningThread thing: (objectMemory integerObjectOf: disowningVMThread index) source: 0]. disowningVMThread cStackPointer: CStackPointer. disowningVMThread cFramePointer: CFramePointer. activeProc := self activeProcess. self assert: (objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject. objectMemory storePointer: MyListIndex ofObject: activeProc withValue: (objectMemory splObj: ProcessInExternalCodeTag). activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: activeContext. "The instructionPointer must be pushed because the convention for inactive stack pages is that the instructionPointer is top of stack. We need to know if this primitive is called from machine code because the invariant that the return pc of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC must be maintained." self push: instructionPointer. self externalWriteBackHeadFramePointers. "Since pushing the awol process may realloc disowningVMThread we need to reassign. But since we're going to nil disowningVMThread anyway we can assign to a local." preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread. disowningVMThread := nil. preemptedThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc). (self ownerIndexOfProcess: activeProc) = 0 ifTrue: [self setOwnerIndexOfProcess: activeProc to: preemptedThread index bind: false]. preemptedThread newMethodOrNull: newMethod; argumentCount: argumentCount; inMachineCode: instructionPointer <= objectMemory startOfMemory!
Item was changed: ----- Method: CoInterpreterMT>>primitiveRelinquishProcessor (in category 'I/O primitives') ----- primitiveRelinquishProcessor "Relinquish the processor for up to the given number of microseconds. The exact behavior of this primitive is platform dependent. Override to check for waiting threads."
| microSecs threadIndexAndFlags currentCStackPointer currentCFramePointer | <var: #currentCStackPointer type: #'volatile usqIntptr_t'> <var: #currentCFramePointer type: #'volatile usqIntptr_t'> microSecs := self stackTop. (objectMemory isIntegerObject: microSecs) ifFalse: [^self primitiveFail]. self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. self assert: relinquishing not. "DO NOT allow relinquishing the processor while we are profiling since this may skew the time base for our measures (it may reduce processor speed etc). Instead we go full speed, therefore measuring the precise time we spend in the inner idle loop as a busy loop." nextProfileTick = 0 ifTrue: "Presumably we have nothing to do; this primitive is typically called from the background process. So we should /not/ try and activate any threads in the pool; they will waste cycles finding there is no runnable process, and will cause a VM abort if no runnable process is found. But we /do/ want to allow FFI calls that have completed, or callbacks a chance to get into the VM; they do have something to do. DisownVMForProcessorRelinquish indicates this." [currentCStackPointer := CStackPointer. currentCFramePointer := CFramePointer. threadIndexAndFlags := self disownVM: DisownVMForProcessorRelinquish. self assert: relinquishing. self ioRelinquishProcessorForMicroseconds: (objectMemory integerValueOf: microSecs). self assert: relinquishing. self ownVM: threadIndexAndFlags. self assert: relinquishing not. + self assert: cogThreadManager currentVMThread vmThreadState = CTMAssignableOrInVM. - self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM. self assert: currentCStackPointer = CStackPointer. self assert: currentCFramePointer = CFramePointer. "In simulation we allow ioRelinquishProcessorForMicroseconds: to fail so that we can arrange that the simulator responds to input events promptly. This *DOES NOT HAPPEN* in the real vm." self cCode: [] inSmalltalk: [primFailCode ~= 0 ifTrue: [^self]]]. self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. self pop: 1 "microSecs; leave rcvr on stack"!
Item was changed: ----- Method: CoInterpreterMT>>printAllStacks (in category 'debug printing') ----- printAllStacks "Print all the stacks of all running processes, including those that are currently suspended. Override to print the AWOL processes." super printAllStacks. self cr; print: 'awol processes'. 1 to: cogThreadManager getNumThreads do: [:i| | vmThread | vmThread := cogThreadManager vmThreadAt: i. + vmThread vmThreadState ~= CTMUninitialized ifTrue: - vmThread state ifNotNil: [vmThread awolProcIndex > 0 ifTrue: [self cr; print: 'thread '; printNum: i. 0 to: vmThread awolProcIndex - 1 do: [:j| self printProcessStack: (vmThread awolProcesses at: j)]]]]!
Item was changed: ----- Method: CoInterpreterMT>>threadSchedulingLoopImplementation: (in category 'vm scheduling') ----- threadSchedulingLoopImplementation: vmThread "Enter a loop attempting to run the VM with the highest priority process and blocking on the thread's OS semaphore when unable to run that process. We will return to this via threadSwitchIfNecessary:from: which is called in the middle of transferTo:from: once the active process has been stored in the scheduler." <var: #vmThread type: #'CogVMThread *'> <inline: false> self _setjmp: vmThread reenterThreadSchedulingLoop. + [self assert: vmThread vmThreadState = CTMAssignableOrInVM. - [self assert: vmThread state = CTMAssignableOrInVM. (cogThreadManager tryLockVMOwnerTo: vmThread index) ifTrue: ["Yay, we're the VM owner!!" "If relinquishing is true, then primitiveRelinquishProcessor has disowned the VM and only a returning call or callback should take ownership in that case." relinquishing ifFalse: [self tryToExecuteSmalltalk: vmThread]. self disownVM: DisownVMForThreading.]. cogThreadManager waitForWork: vmThread. true] whileTrue!
Item was changed: ----- Method: CoInterpreterMT>>threadSwitchIfNecessary:from: (in category 'process primitive support') ----- threadSwitchIfNecessary: newProc from: sourceCode "Invoked from transferTo:from: or primitiveProcessBindToThreadId to switch threads if the new process is bound or affined to some other thread." | newProcOwnerIndex vmThread activeContext | self assert: (cogThreadManager vmOwnerIs: cogThreadManager ioGetThreadLocalThreadIndex). deferThreadSwitch ifTrue: [^self].
cogThreadManager assertValidProcessorStackPointersForIndex: cogThreadManager getVMOwner.
"If the current process is unaffined or it is affined to the current thread we're ok to run, but we should yield asap if a higher-priority thread wants the VM." newProcOwnerIndex := self ownerIndexOfProcess: newProc. ((activeProcessAffined := newProcOwnerIndex ~= 0) and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcOwnerIndex) not]) ifFalse: [(self quickFetchInteger: PriorityIndex ofObject: newProc) < maxWaitingPriority ifTrue: [checkThreadActivation := true. self forceInterruptCheck]. ^self].
"The current process is affined to a thread, but not to the current owner. So switch to that owner." self cCode: '' inSmalltalk: [transcript ensureCr; f: 'threadSwitchIfNecessary: %08x from: %s(%d) owner %d -> %d\n' printf: { newProc. TraceSources at: sourceCode. sourceCode. cogThreadManager getVMOwner. newProcOwnerIndex }].
"We at least need to externalize the stack pointers to enable a thread switch..." (objectMemory fetchPointer: SuspendedContextIndex ofObject: newProc) = objectMemory nilObject ifTrue: [self assert: newProc = self activeProcess. self push: instructionPointer. self externalWriteBackHeadFramePointers. false ifTrue: "If the activeProcess doesn't have a context yet, it needs one from which the new thread can resume execution." [activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: activeContext]].
newProcOwnerIndex < 0 ifTrue: [self assert: newProcOwnerIndex negated = cogThreadManager getVMOwner. vmThread := cogThreadManager ensureWillingThread. self deny: vmThread index = cogThreadManager getVMOwner. self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcOwnerIndex)] ifFalse: [vmThread := cogThreadManager vmThreadAt: newProcOwnerIndex. vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc). + vmThread vmThreadState = CTMUnavailable ifTrue: + [vmThread setVmThreadState: CTMWantingOwnership]]. - vmThread state = CTMUnavailable ifTrue: - [vmThread state: CTMWantingOwnership]]. self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSSwitchIfNeccessary!
Item was changed: ----- Method: CoInterpreterMT>>transferTo:from: (in category 'process primitive support') ----- transferTo: newProc from: sourceCode "Record a process to be awoken on the next interpreter cycle. Override to potentially switch threads either if the new process is bound to another thread, or if there is no runnable process but there is a waiting thread. Note that the abort on no runnable process has beeen moved here from wakeHighestPriority." | sched oldProc activeContext | <inline: false> statProcessSwitch := statProcessSwitch + 1. self push: instructionPointer. self externalWriteBackHeadFramePointers. self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer. "ensureMethodIsCogged: in makeBaseFrameFor: in externalSetStackPageAndPointersForSuspendedContextOfProcess: below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice." instructionPointer := 0. sched := self schedulerPointer. oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched. self recordContextSwitchFrom: oldProc in: sourceCode. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + objectMemory wordSize. objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext.
newProc ifNil: ["Two possibilities. One, there is at least one thread waiting to own the VM in which case it should be activated. Two, there are no processes to run and so abort." cogThreadManager willingVMThread ifNotNil: [:vmThread| + vmThread vmThreadState = CTMWantingOwnership ifTrue: - vmThread state = CTMWantingOwnership ifTrue: [self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode]]. self error: 'scheduler could not find a runnable process'].
"Switch to the new process" objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc; storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject. self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc. "Finally thread switch if required" self threadSwitchIfNecessary: newProc from: sourceCode!
Item was changed: ----- Method: CogThreadManager class>>initialize (in category 'class initialization') ----- initialize "CogThreadManager initialize" + CTMUninitialized := 0. CTMInitializing := 1. CTMUnavailable := 2. "off doing its own thing and not available to run the VM, e.g. calling-out." CTMAssignableOrInVM := 3. "either owning the VM or blocked on its osSemaphore available for VM work" CTMWantingOwnership := 4. "with something specific to do in the VM (e.g. return a result from a call-out, make a call-back)"
"Define the size of the stack of processes at time of disown/own." AWOLProcessesIncrement := 4!
Item was changed: ----- Method: CogThreadManager>>acquireVMFor: (in category 'public api') ----- acquireVMFor: threadIndex "Attempt to acquire the VM, eventually blocking until it becomes available. Spin until the maxWaitingPriority has been updated if it is lower than this thread's priority." <returnTypeC: #'CogVMThread *'> | vmThread | <var: #vmThread type: #'CogVMThread *'> self assert: threadIndex = self ioGetThreadLocalThreadIndex. vmThread := self vmThreadAt: threadIndex. + self assert: (vmThread vmThreadState = CTMUnavailable + or: [vmThread vmThreadState = CTMWantingOwnership]). - self assert: (vmThread state = CTMUnavailable - or: [vmThread state = CTMWantingOwnership]). (self tryLockVMOwnerTo: threadIndex) + ifTrue: [vmThread setVmThreadState: CTMAssignableOrInVM] - ifTrue: [vmThread state: CTMAssignableOrInVM] ifFalse: + [vmThread setVmThreadState: CTMWantingOwnership. - [vmThread state: CTMWantingOwnership. [(self vmOwnerIs: threadIndex) or: [self tryLockVMOwnerTo: threadIndex]] whileFalse: [vmThread priority ifNotNil: [coInterpreter waitingPriorityIsAtLeast: vmThread priority]. (self vmOwnerIs: threadIndex) ifFalse: [self ioWaitOnOSSemaphore: (self addressOf: vmThread osSemaphore)]]]. coInterpreter assertProcessorStackPointersBelongToCurrentThread. vmOSThread := vmThread osThread. + vmThread setVmThreadState: CTMAssignableOrInVM. - vmThread state: CTMAssignableOrInVM. ^vmThread!
Item was changed: ----- Method: CogThreadManager>>ensureRunningVMThread: (in category 'public api') ----- ensureRunningVMThread: vmIsRelinquishing "Called from checkVMOwnershipFromHeartbeat if the VM is unowned. Hence we are in the heartbeat thread. The race is against that thread owning the VM and against foreign callbacks." <returnTypeC: #void> <var: #vmThread type: #'CogVMThread *'> self willingVMThread ifNotNil: + [:vmThread| | threadState | + threadState := vmThread vmThreadState. - [:vmThread| "If the VM is relinquishing the processor then only schedule a thread if it has work to do." (vmIsRelinquishing + and: [threadState ~= CTMWantingOwnership]) ifTrue: - and: [vmThread state ~= CTMWantingOwnership]) ifTrue: [^self]. + self assert: ((threadState = CTMAssignableOrInVM + or: [threadState = CTMInitializing]) + or: [threadState = CTMWantingOwnership]). - self assert: ((vmThread state = CTMAssignableOrInVM - or: [vmThread state = CTMInitializing]) - or: [vmThread state = CTMWantingOwnership]). (self tryLockVMOwnerTo: vmThread index) ifFalse: "someone beat us to it..." [^self]. vmOSThread := vmThread osThread. "release the thread from its blocking loop" self ioSignalOSSemaphore: (self addressOf: vmThread osSemaphore). self ioTransferTimeslice. "self cCode: [coInterpreter print: 'ERVT signalled '; printNum: vmThread index; cr]." ^self].
"If the VM is relinquishing the processor then only schedule a thread if it has work to do (willingVMThread not nil above). If we have failed to allocate thread storage before there is no point continuing to try to do so. By this time we should have quite a few threads in the pool." (vmIsRelinquishing or: [memoryIsScarce]) ifTrue: [^self]. self unusedThreadInfo ifNotNil: [:vmThread| (self tryLockVMOwnerTo: vmThread index) ifTrue: [(self startThreadForThreadInfo: vmThread) ifFalse: [self releaseVM]]]!
Item was changed: ----- Method: CogThreadManager>>ensureWillingThread (in category 'scheduling') ----- ensureWillingThread | willingThread newIndex | willingThread := self willingVMThread. willingThread ifNotNil: [^willingThread]. 1 to: numThreads do: [:index| + (self vmThreadAt: index) vmThreadState = CTMUninitialized ifTrue: - (self vmThreadAt: index) state ifNil: [self startThreadForThreadIndex: index. ^self vmThreadAt: index]]. self startThreadForThreadIndex: (newIndex := numThreads + 1). ^self vmThreadAt: newIndex!
Item was changed: ----- Method: CogThreadManager>>highestPriorityThreadIfHigherThan:expectedMax: (in category 'public api') ----- highestPriorityThreadIfHigherThan: activePriority expectedMax: maxPriority "Answer the first vmThread waiting to acquire the VM that is of higher priority than activePriority, or answer nil if none. If there is a higher priority thread then set the coInterpreter's maxWaitingPriority to either the priority of the next highest priority vmThread, or to 0 if none is waiting." <returnTypeC: #'CogVMThread *'> | vmThread highest nextHighest | <var: #vmThread type: #'CogVMThread *'> <var: #highest type: #'CogVMThread *'> <var: #nextHighest type: #'CogVMThread *'> highest := nextHighest := nil. "To make this fair we could remember the last index at which we found the highest and start the search at the following index." 1 to: numThreads do: [:i| vmThread := threads at: i. + vmThread vmThreadState = CTMWantingOwnership ifTrue: - vmThread state = CTMWantingOwnership ifTrue: [self assert: vmThread priority <= maxPriority. highest isNil ifTrue: [highest := vmThread] ifFalse: [vmThread priority > highest priority ifTrue: [nextHighest := highest. highest := vmThread] ifFalse: [nextHighest isNil ifTrue: [nextHighest := vmThread] ifFalse: [vmThread priority > nextHighest priority ifTrue: [nextHighest := vmThread]]]]]]. highest isNil ifTrue: [^nil].
highest priority <= activePriority ifTrue: [^nil]. coInterpreter setMaxWaitingPriorityTo: (nextHighest isNil ifTrue: [0] ifFalse: [nextHighest priority]). ^highest!
Item was changed: ----- Method: CogThreadManager>>populate:from:to: (in category 'thread set') ----- populate: vmThreadPointers from: start to: finish "Populate vmThreadPointers with vmThreads over the given range." <var: #vmThreadPointers type: #'CogVMThread **'> | nThreads vmThreads | <var: #vmThreads type: #'CogVMThread *'> <var: #vmThread type: #'CogVMThread *'> <inline: true> nThreads := finish - start + 1. vmThreads := self cCode: [self calloc: nThreads _: (self sizeof: CogVMThread)] inSmalltalk: [CArrayAccessor on: ((1 to: nThreads) collect: [:ign| CogVMThread new])]. vmThreads ifNil: [^false]. "Since 0 is not a valid index, in C we allocate one extra CogVMThread and use 1-relative indices." self cCode: [start = 1 ifTrue: [vmThreadPointers at: 0 put: nil]] inSmalltalk: []. start to: finish do: [:i| | vmThread | vmThread := self addressOf: (vmThreads at: i - start). + vmThread initializeThreadState. (self ioNewOSSemaphore: (self addressOf: vmThread osSemaphore put: [:sem| vmThread osSemaphore: sem])) ~= 0 ifTrue: [start to: i - 1 do: [:j| vmThread := self addressOf: (vmThreads at: j - start). self ioDestroyOSSemaphore: (self addressOf: vmThread osSemaphore)]. self free: vmThreads. ^false]. vmThreadPointers at: i put: vmThread. vmThread awolProcLength: AWOLProcessesIncrement. vmThread index: i. self cCode: [] inSmalltalk: [vmThread reenterThreadSchedulingLoop: ReenterThreadSchedulingLoop new]]. ^true!
Item was changed: ----- Method: CogThreadManager>>registerVMThread: (in category 'scheduling') ----- registerVMThread: vmThread "Register the current thread in the set of threads, initializing the supplied vmThread and setting the thread's thread block index there-to." <var: #vmThread type: #'CogVMThread *'> <returnTypeC: #'CogVMThread *'> + self assert: ((vmThread vmThreadState = CTMInitializing + or: [vmThread vmThreadState = CTMWantingOwnership]) and: [vmThread osThread isNil]). - self assert: ((vmThread state = CTMInitializing - or: [vmThread state = CTMWantingOwnership]) and: [vmThread osThread isNil]). vmThread osThread: self ioCurrentOSThread. self ioSetThreadLocalThreadIndex: vmThread index. self assert: self ioGetThreadLocalThreadIndex = vmThread index. ^vmThread!
Item was changed: ----- Method: CogThreadManager>>startThreadForThreadInfo: (in category 'scheduling') ----- startThreadForThreadInfo: vmThread <var: #vmThread type: #'CogVMThread *'> <inline: false> + self assert: vmThread vmThreadState = CTMUninitialized. + vmThread setVmThreadState: CTMInitializing. - self assert: vmThread state isNil. - vmThread state: CTMInitializing. "self cCode: '' inSmalltalk: [coInterpreter transcript cr; nextPutAll: 'starting VM thread '; print: vmThread index; flush. (thisContext home stackOfSize: 10) do: [:ctxt| coInterpreter transcript cr; print: ctxt; flush]]." (self ioNewOS: (self cCoerce: #startVMThread: to: 'void (*)(void*)') Thread: vmThread) = 0 ifTrue: [self ioTransferTimeslice. ^true]. memoryIsScarce := true. "self cCode: [coInterpreter print: 'ERVT failed to spawn so memory is scarce'; cr]" ^false!
Item was changed: ----- Method: CogThreadManager>>startThreadSubsystem (in category 'public api') ----- startThreadSubsystem "Initialize the threading subsystem, aborting if there is an error." | vmThread | <inline: false> self assert: threads = nil. vmOSThread := self ioCurrentOSThread. numThreadsIncrement := (self ioNumProcessors max: 2) min: 16. (self growThreadInfosToAtLeast: numThreadsIncrement * 2) ifFalse: [self error: 'no memory to start thread system']. self atomic_store: (self addressOf: vmOwner) _: 1. vmThread := threads at: self getVMOwner. + vmThread setVmThreadState: CTMInitializing. - vmThread state: CTMInitializing. self registerVMThread: vmThread. + vmThread setVmThreadState: CTMAssignableOrInVM! - vmThread state: CTMAssignableOrInVM!
Item was changed: ----- Method: CogThreadManager>>startVMThread: (in category 'scheduling') ----- startVMThread: vmThread "Start a VM thread that will attempt to acquire the VM and proceed to run the VM, taking processes from the runnable process queue." <returnTypeC: #void> <var: #vmThread type: #'CogVMThread *'> + self assert: vmThread vmThreadState = CTMInitializing. self registerVMThread: vmThread. + vmThread setVmThreadState: CTMAssignableOrInVM. - vmThread state: CTMAssignableOrInVM. coInterpreter threadSchedulingLoop: vmThread!
Item was changed: ----- Method: CogThreadManager>>unregisterVMThread: (in category 'scheduling') ----- unregisterVMThread: vmThread "Unegister the current thread in the set of threads." <var: #vmThread type: #'CogVMThread *'> + self assert: (vmThread vmThreadState ~= CTMUninitialized + and: [vmThread vmThreadState ~= CTMInitializing]). - self assert: (vmThread state ~= nil - and: [vmThread state ~= CTMInitializing]). vmThread + initializeThreadState; - state: nil; osThread: nil. self ioSetThreadLocalThreadIndex: 0!
Item was changed: ----- Method: CogThreadManager>>unusedThreadInfo (in category 'thread set') ----- unusedThreadInfo "Answer a pointer to an unused CogVMThread, growing the sequence if necessary." <returnTypeC: #'CogVMThread *'> | vmThread index | <var: #vmThread type: #'CogVMThread *'> 1 to: numThreads do: [:i| vmThread := threads at: i. self assert: vmThread index = i. + vmThread vmThreadState = CTMUninitialized ifTrue: - vmThread state isNil ifTrue: [^vmThread]]. index := numThreads + 1. (self growThreadInfosToAtLeast: numThreads + numThreadsIncrement) ifFalse: [^nil]. ^threads at: index!
Item was changed: ----- Method: CogThreadManager>>waitForWork: (in category 'public api') ----- waitForWork: vmThread "Wait for work." <var: #vmThread type: #'CogVMThread *'> <returnTypeC: #void> + vmThread setVmThreadState: CTMAssignableOrInVM. - vmThread state: CTMAssignableOrInVM. self deny: (self vmOwnerIs: vmThread index). self ioWaitOnOSSemaphore: (self addressOf: vmThread osSemaphore)!
Item was changed: ----- Method: CogThreadManager>>wakeVMThreadFor: (in category 'public api') ----- wakeVMThreadFor: index "Transfer the VM to the thread with index. Called from a thread that finds the highest priority runnable process is bound to the thread with index index." <returnTypeC: #void> + | vmThread threadState | - | vmThread | self assert: (self vmIsOwned and: [(self vmOwnerIs: index) not]). self assert: (index between: 1 and: numThreads). vmThread := threads at: index.
"Instead of going through a #disownVM: call, directly set the new VM owner. This has the advantage of avoiding a race for the different threads to become the new VM owner. In Simulation, this means we need to simulate a thread-switch." self cCode: [] inSmalltalk: [ self saveRegisterStateForCurrentProcess. self loadOrInitializeRegisterStateFor: index]. self setVMOwner: index.
+ threadState := vmThread vmThreadState. + threadState = CTMUninitialized + ifTrue: [self startThreadForThreadInfo: vmThread] + ifFalse: + [self assert: ((threadState = CTMWantingOwnership + or: [threadState = CTMAssignableOrInVM]) + or: [threadState = CTMInitializing]). - vmThread state - ifNil: [self startThreadForThreadInfo: vmThread] - ifNotNil: - [self assert: ((vmThread state = CTMWantingOwnership - or: [vmThread state = CTMAssignableOrInVM]) - or: [vmThread state = CTMInitializing]). self ioSignalOSSemaphore: (self addressOf: vmThread osSemaphore)]. self ioTransferTimeslice!
Item was changed: ----- Method: CogThreadManager>>willingVMThread (in category 'thread set') ----- willingVMThread "Answer a pointer to a live CogVMThread in any of the ``will do VM work'' states (other than the current owner if the VM is owned), or nil if none. Preferentially answer threads wanting ownership." <returnTypeC: #'CogVMThread *'> | thread threadWantingVM threadWilling | <inline: false> threadWantingVM := threadWilling := nil. 1 to: numThreads do: [:i| (self vmOwnerIs: i) ifFalse: [thread := threads at: i. + thread vmThreadState = CTMWantingOwnership ifTrue: - thread state = CTMWantingOwnership ifTrue: [(threadWantingVM isNil or: [threadWantingVM priority < thread priority]) ifTrue: [threadWantingVM := thread]]. + thread vmThreadState = CTMAssignableOrInVM ifTrue: - thread state = CTMAssignableOrInVM ifTrue: [(threadWilling isNil or: [threadWilling priority < thread priority]) ifTrue: [threadWilling := thread]]]]. ^threadWantingVM ifNil: [threadWilling]!
Item was changed: ----- Method: CogVMThread class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogVMThread struct."
self allInstVarNames do: [:ivn| aBinaryBlock value: ivn value: (ivn caseOf: { ['awolProcesses'] -> [{#sqInt. '[', CogThreadManager awolProcessesIncrement printString, ']'}]. ['cStackPointer'] -> [#usqIntptr_t]. ['cFramePointer'] -> [#usqIntptr_t]. ['osSemaphore'] -> ['sqOSSemaphore']. ['osThread'] -> ['sqOSThread']. + ['reenterThreadSchedulingLoop'] -> ['jmp_buf']. + ['state'] -> ['volatile atomic_int'] } - ['reenterThreadSchedulingLoop'] -> ['jmp_buf'] } otherwise: [#sqInt])]!
Item was added: + ----- Method: CogVMThread>>initializeThreadState (in category 'initialize-release') ----- + initializeThreadState + "Unfortunately this cannot be inlined as Slang otherwise screws up the generation of the `atomic_store` call." + <inline: false> + "In comparision to #initialize, this is also called in C code to initialize the VMThread, not just in the Smalltalk simulation." + self cCode: [] inSmalltalk: [state := AtomicValue new]. + self atomic_store: (self addressOf: self state) _: CTMUninitialized.!
Item was added: + ----- Method: CogVMThread>>setVmThreadState: (in category 'accessing') ----- + setVmThreadState: anInteger + "Unfortunately this cannot be inlined by Slang, as the generation otherwise screws + up the atomic_store operation." + <inline: false> + |currentState| + currentState := self vmThreadState. + currentState caseOf: { + [CTMUninitialized] -> [self assert: anInteger = CTMInitializing]. + } otherwise: []. + + "The actual meat of the operation. The previous checks are only for debugging." + self atomic_store: (self addressOf: self state) _: anInteger.!
Item was changed: ----- Method: CogVMThread>>state (in category 'accessing') ----- state - "Answer the value of state"
^ state!
Item was removed: - ----- Method: CogVMThread>>state: (in category 'accessing') ----- - state: anObject - "Set the value of state" - - ^state := anObject!
Item was added: + ----- Method: CogVMThread>>vmThreadState (in category 'accessing') ----- + vmThreadState + "Unfortunately this cannot be inlined by Slang, as the generation otherwise screws + up the atomic_load operation." + <inline: false> + ^ self atomic_load: (self addressOf: self state)!
Item was changed: ----- Method: ObjectMemory>>num32BitUnitsOf: (in category 'object access') ----- num32BitUnitsOf: objOop "Answer the number of 32-bit units in the given non-immediate object. N..B. Rounds down 8-bit units, so a 7 byte object has 1 32-bit unit. Does not adjust the size of contexts by stackPointer." ^(self numBytesOf: objOop) >> 2!
Item was changed: SharedPool subclass: #VMThreadingConstants instanceVariableNames: '' + classVariableNames: 'AWOLProcessesIncrement CTMAssignableOrInVM CTMInitializing CTMUnavailable CTMUninitialized CTMWantingOwnership ThreadIdIndex ThreadIdShift' - classVariableNames: 'AWOLProcessesIncrement CTMAssignableOrInVM CTMInitializing CTMUnavailable CTMWantingOwnership ThreadIdIndex ThreadIdShift' poolDictionaries: '' category: 'VMMaker-Multithreading'!
!VMThreadingConstants commentStamp: '<historical>' prior: 0! VMThreadingConstants ensureClassPool. CogThreadManager classPool keys do: [:k| VMThreadingConstants classPool declare: k from: CogThreadManager classPool]. CoInterpreterMT classPool keys do: [:k| VMThreadingConstants classPool declare: k from: CoInterpreterMT classPool].!