Hi,
I have sent in the past email to Eliot Miranda about an issue which I discovered in August 2021 (two years ago), and I thought to raise an issue here.
It is a Linux/UNIX patch issue with the behavior of the mmap() system call or library call as used by the OpenSmalltalk COG vm.
When way back in 2021 some changes were made for Linux ARM8 to the file saUnixSpurMemory.c I reported that this was breaking the Solaris 11.3 build. Curiously the Solaris 11.4 build was still working fine.
I think (I don't know) that perhaps the behavior of mmap() on Solaris 11.4 is slightly diferent than on 11.3, to match (perhaps) the Linux kernel behavior of mmap().
An idea that I have is to ask some UNIX guru's whether there exist a autoconf-archive (configure script) test or script to test the behavior of mmap() for portability.
However here I will just report what the issue is : since august 2021 I am building succesfully on Solaris with the following patch
```
--- opensmalltalk-vm-sun-v5.0.34/platforms/unix/vm/sqUnixSpurMemory.c Fri Aug 13 19:54:42 2021
+++ p0/opensmalltalk-vm-sun-v5.0.34/platforms/unix/vm/sqUnixSpurMemory.c Sun Aug 15 14:11:58 2021
@@ -277,16 +277,21 @@
{
void *hint = sbrk(0); // a hint of the lowest possible address for mmap
void *result;
+ char *address;
+ unsigned long alignment;
pageSize = getpagesize();
pageMask = ~(pageSize - 1);
+ alignment = max(pageSize,1024*1024);
+ address = (char *)(((usqInt)hint + alignment - 1) & ~(alignment - 1));
+
#if !defined(MAP_JIT)
# define MAP_JIT 0
#endif
*desiredSize = roundUpToPage(*desiredSize);
- result = mmap(hint, *desiredSize,
+ result = mmap(address, *desiredSize,
#if DUAL_MAPPED_CODE_ZONE
PROT_READ | PROT_EXEC,
#else
```
I really need Eliot's help on this.
Eliot : what I did was try to understand your code and you seem to make some alignment calculations on the desired memory location that you request through mmap().
I believe that the traditional UNIX mmap() or the Solaris 10 and Solaris 11.3 mmap() is reacting slightly differently to the requested memory "hint".
By some experimentatoin and debugging I found the above patch, which I wrote based on looking at your code and try to mirror the calculations that you are doing, which are not fully symmetric.
By copying some code, I discovered that with the above patch the build for both Solaris 11.3 and Solaris 11.4 are working fine again.
I think this is a general UNIX issue that could be of interest to all UNIX software.
If an autoconfigure autoconf-archive test would exist to test the behavior of mmap() then that could be dealt in all software that uses mmap() with anonymous memory mapping.
As far as I know the history of the mmap() call is that it originated in the world of Sun and Solaris and is since a very long time present in Linux as well, and I think some improvements in Linux where then backported to Solaris 11.4.
That would explain why the current OpenSmalltalk-VM code works fine on Solaris 11.4.
For reasons of portability to all flavors of UNIX and Linux, I think a configure build test for the code could benefit portability of your Cog VM.
Let us know please what you think. I could simply submit my patch as a patch to mainstream upstream OpenSmalltalk but I don't know your opinion about it.
And the way I have been using it as a platform specific patch (that I apply prior to the build on Solaris) is fine for me as well.
Regards,
David Stes
--
Reply to this email directly or view it on GitHub:
https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/665
You are receiving this because you are subscribed to this thread.
Message ID: <OpenSmalltalk/opensmalltalk-vm/issues/665(a)github.com>
In depth 1, the resulting bits will always be 0.<br>
It's not a big problem because rgbMul is just a bitAnd operation at this depth.<br>
So a quick workaround would be to detect the case in BitBltSimulation
destDepth = 1 ifTrue: [^self bitAnd: sourceWord with: destinationWord].
That would also accelerate the Bit BLock Transfer operation, so it's a good hack.
But there is more. What we want is multiply ratios in interval [0,1].
dstRatio * srcRatio
Our implementation is scaled ratio (scaled by `1 << nBits - 1`):
src := (srcRatio * scale) rounded.
dst := (dstRatio * scale) rounded.
So what we want is:
((dst/scale) * (src/scale) * scale) rounded
that is:
(dst*src / (1<<nBits-1)) rounded
Unfortunately, that's the other grief with the current implementation used for rounding:
(dst+1)*(src+1) - 1 >> nBits
It only equals correctly rounded operation for depths 2 and 4.
For rounding we might use:
(((dst/scale) * (src/scale) + 0.5) * scale) truncated.
that is expressed with truncated division:
dst*src + (scale+1//2) // scale
So here is a nicer formulation for doing the job at any depth (including 5bits rgb channels for 16 bits depth) with correctly rounded division:
aux := src * dst + (1 << (nBits - 1)). "add mid-scale for rounding"
result := aux << (nBits - 1) + aux << (nBits -1). "divide by scale"
This is because instead of dividing by scale, we can multiply by shifted inverse (sort of double precision), then shift right.
(2 to: 32) allSatisfy: [:nBits | (1 << (nBits * 2) / (1 << nBits - 1)) rounded = (1 << nBits + 1)].
Multiplying by this inverse is easy and cheap:
x * (1 << nBits + 1) = (x << nBits + x).
And then applying the right shift `>> (2 * nBits)` is equivalent to:
x >> nBits + x >> nBits.
We must first add 0.5 (scaled), that is `src * dst + (1 << (nBits -1))` - our formulation of aux, and we're done.
We verify:
{
(0 to: 1<<20-1) allSatisfy: [:i | (1<<9+i)>>10+ (1<<9+i)>>10 = (i/1023) rounded].
(0 to: 1<<18-1) allSatisfy: [:i | (1<<8+i)>>9+ (1<<8+i)>>9 = (i/511) rounded].
(0 to: 1<<16-1) allSatisfy: [:i | (1<<7+i)>>8+ (1<<7+i)>>8 = (i/255) rounded].
(0 to: 1<<14-1) allSatisfy: [:i | (1<<6+i)>>7+ (1<<6+i)>>7 = (i/127) rounded].
(0 to: 1<<12-1) allSatisfy: [:i | (1<<5+i)>>6+ (1<<5+i)>>6 = (i/63) rounded].
(0 to: 1<<10-1) allSatisfy: [:i | (1<<4+i)>>5+ (1<<4+i)>>5 = (i/31) rounded].
(0 to: 1<<8-1) allSatisfy: [:i | (1<<3+i)>>4+ (1<<3+i)>>4 = (i/15) rounded].
(0 to: 1<<6-1) allSatisfy: [:i | (1<<2+i)>>3+ (1<<2+i)>>3 = (i/7) rounded].
(0 to: 1<<4-1) allSatisfy: [:i | (1<<1+i)>>2+ (1<<1+i)>>2 = (i/3) rounded].
} allSatisfy: #yourself.
The nice thing is that above down-scaling operation can be multiplexed.<b>
Suppose that we have p groups of 2*nBits `M` holding square-scale multiplication of each channel concatenated in a double-Word-Mul.
doubleWordMul = Mp .... M5 M3 M1
Note we arrange to have odd channels in low word, and even channels in high word.
We first form a `groupMask` on a word with (p+1)/2 groups of nBits alternating all one `i` and all zero `o`, `oioi...ioi`.<br>
channelMask := 1 << nBits - 1.
groupMask := 0.
0 to: wordBits // (2 * nBits) do: [:i |
groupMask = groupMask << (2 * nBits) + channelMask].
Where wordBits is the number of bits in a word (usually we want to operate on 32 bits words in BitBlt).
We form the `doubleGroupMask` on a double-word with p groups of 2*nBits `oi`:
doubleGroupMask := groupMask >> nBits.
doubleGroupMask := doubleGroupMask << wordBits + groupMask.
And we perform the division by scale:
doubleWordMul := (doubleWordMul >> nBits bitAnd: doubleGroupMask) + doubleWord >> nBits bitAnd: doubleGroupMask.
At this stage we obtain a double word containing scaled multiplicands interleaved with groups of nBits zeros:
o mp ... o m3 o m1
Now the final result can be obtained by shifting back:
doubleWordMul >> (wordBits - nBits) + (doubleWordMul bitAnd: groupMask)
The only problem remaining is how to obtain the squared-scale multiplicands. It would be easy to form the alternate even-odd channels for each src and dst operands:
doubleWordSrc := src >> nBits bitAnd: groupMask.
doubleWordSrc := doubleWordSrc << wordBits + (src bitAnd: groupMask).
doubleWordDst := dst >> nBits bitAnd: groupMask.
doubleWordDst := doubleWordDst << wordBits + (dst bitAnd: groupMask).
we now get `o sp ... o s3 o s1` and `0 dp ... o d3 o d1`, but we would now need a SIMD integer multiplication operating on groups of 2*nBits in parallel... We don't have that, at least in portable C code. So we still have to emulate it with a loop.
half := 1 << (nBits - 1).
shift := 0.
doubleWordMul := 0
0 to: nChannels - 1 do: [:i |
doubleWordMul := doubleWordMul + (((doubleWordSrc >> shift bitAnd: channelMask) * (doubleWordSrc >> shift bitAnd: channelMask) + half) << shift).
shift := shift + nBits + nBits].
We know that each operation cannot overflow on upper neighbour group of 2*nBits, because the maximum value is:
(1<<nBits-1) squared + (1 << (nBits-1)) = 1 << (2*nBits) - (2*(1<<nBits)) + (1 << (nBits-1)) - 1
< (1 << (2*nBits) - 1)
It remains the odd case of 16 bits depth, which has 3 groups of 5 bits and a leading zero.
I believe that above algorithm works without splitting in two half-words...
To be tested.
We have gathered the pieces for a correctly rounded almost-multiplexed rgbMul.<br>
Somehow have our cake and eat it too.
--
Reply to this email directly or view it on GitHub:
https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/651
You are receiving this because you are subscribed to this thread.
Message ID: <OpenSmalltalk/opensmalltalk-vm/issues/651(a)github.com>
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3341.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3341
Author: eem
Time: 25 October 2023, 7:32:11.148397 pm
UUID: b983211d-2985-493f-bd38-f2fdc0744d9f
Ancestors: VMMaker.oscog-eem.3340
Integrate VMMaker.threaded-LM.3339, but do inline CogVMThread>>#initializeThreadState because the inlining bug has been fixed in VMMaker.oscog-eem.3340.
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.3340 ===============
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>>threadAffinityFieldValueOf: (in category 'process primitive support') -----
threadAffinityFieldValueOf: aProcess
^processHasThreadAffinity
ifTrue:
[| field |
field := objectMemory fetchPointer: ThreadIdIndex ofObject: aProcess.
+ (objectMemory isIntegerObject: field)
+ ifTrue: [objectMemory integerValueOf: field]
+ ifFalse: [0]]
- field = objectMemory nilObject
- ifTrue: [0]
- ifFalse: [objectMemory integerValueOf: field]]
ifFalse: [0]!
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
+ <inline: #always>
+ "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: 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:
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].!
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3340.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3340
Author: eem
Time: 25 October 2023, 7:26:14.908882 pm
UUID: a4e72b77-5223-444e-a9f0-1672fbd720f1
Ancestors: VMMaker.oscog-eem.3339
Slang: fix an inlining bug where inlined struct sends would have their receiver renamed to a parameter, causing the receivers to no longer be elided as required.
VMMaker: for convenience, allow classes as the keys and values of initializationOptions as well as symbols
=============== Diff against VMMaker.oscog-eem.3339 ===============
Item was added:
+ ----- Method: TMethod>>protectToBeExcludedReceiversForInlining (in category 'inlining support') -----
+ protectToBeExcludedReceiversForInlining
+ "Any struct sends whose receivers will be elided must not be renamed on inlining, as this could prevent their elision when code is generated. Instead, these receivers are renamed to 'self_in_inlined_method' to ensure they persist to be elided when code is generated."
+
+ parseTree nodesWithParentsDo:
+ [ :node :parent|
+ (node isVariable
+ and: [(node name beginsWith: 'self_in_')
+ and: [parent notNil
+ and: [parent isSend
+ and: [parent receiver == node]]]]) ifTrue:
+ [parent receiver: (TVariableNode new setName: #'self_in_inlined_method')]]!
Item was changed:
----- Method: TMethod>>renameVarsForInliningInto:except:in: (in category 'inlining support') -----
renameVarsForInliningInto: destMethod except: doNotRename in: aCodeGen
"Rename any variables that would clash with those of the destination method."
| destVars usedVars varMap newVarName |
destVars := aCodeGen globalsAsSet copy.
destVars addAll: destMethod locals.
destVars addAll: destMethod args.
usedVars := destVars copy. "keeps track of names in use"
usedVars addAll: args; addAll: locals.
varMap := Dictionary new: 100.
locals, args do:
[ :v |
((doNotRename includes: v) not
and: [destVars includes: v]) ifTrue:
[newVarName := self unusedNamePrefixedBy: v avoiding: usedVars.
varMap at: v put: newVarName]].
+ self protectToBeExcludedReceiversForInlining.
self renameVariablesUsing: varMap!
Item was added:
+ ----- Method: TSendNode>>nodeIsThisSendsStructReceiver: (in category 'inlining support') -----
+ nodeIsThisSendsStructReceiver: aTParseNode
+ selector == #'atomic_store:_:' ifTrue: [self halt].
+ ^aTParseNode == receiver
+ and: [receiver name beginsWith: 'self_in_']!
Item was changed:
----- Method: VMMaker>>options: (in category 'initialize') -----
options: anArrayOfPairs
self assert: anArrayOfPairs size even.
1 to: anArrayOfPairs size by: 2 do:
+ [:i|
+ [:key :value| optionsDictionary at: key put: value]
+ valueWithArguments:
+ ((i to: i + 1) collect:
+ [:j| | value |
+ value := anArrayOfPairs at: j.
+ self assert: (value isSymbol or: [value isBehavior and: [value isMeta not]]).
+ value isSymbol ifTrue: [value] ifFalse: [value name]])].
- [:i| | key |
- key := anArrayOfPairs at: i.
- self assert: key isSymbol.
- optionsDictionary at: key put: (anArrayOfPairs at: i + 1)].
"Now clear any stale/broken options in the actual InitializationOptions variable..."
VMClass initializeWithOptions: optionsDictionary!
Leon Matthes uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.threaded-LM.3343.mcz
==================== Summary ====================
Name: VMMaker.threaded-LM.3343
Author: LM
Time: 23 October 2023, 2:59:26.998963 pm
UUID: 96fd1f0a-297d-4008-a19c-049602ca872e
Ancestors: VMMaker.threaded-LM.3342
Fix thread switch accidentally disowning the VM which causes an incorrect preemption.
Allow thread switching during the SqueakSSL primitiveConnect.
Rename ownerIndex to threadAffinity.
=============== Diff against VMMaker.threaded-LM.3342 ===============
Item was changed:
StackInterpreterPrimitives subclass: #CoInterpreter
instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase primitiveMetadataTable lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName primCalloutIsExternal'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSTryToExecuteSmalltalk CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
category: 'VMMaker-JIT'!
!CoInterpreter commentStamp: 'eem 3/31/2020 18:56' prior: 0!
I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.
cogCodeSize
- the current size of the machine code zone
cogCompiledCodeCompactionCalledFor
- a variable set when the machine code zone runs out of space, causing a machine code zone compaction at the next available opportunity
cogMethodZone
- the manager for the machine code zone (instance of CogMethodZone)
cogit
- the JIT (co-jit) (instance of SimpleStackBasedCogit, StackToRegisterMappoingCogit, etc)
deferSmash
- a flag causing deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
deferredSmash
- a flag noting deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
desiredCogCodeSize
- the desred size of the machine code zone, set at startup or via primitiveVMParameter to be written at snapshot time
flagInterpretedMethods
- true if methods that are interpreted shoudl have their flag bit set (used to identity methods that are interpreted because they're unjittable for some reason)
gcMode
- the variable holding the gcMode, used to inform the cogit of how to scan the machine code zone for oops on GC
heapBase
- the address in memory of the base of the objectMemory's heap, which is immediately above the machine code zone
lastCoggableInterpretedBlockMethod
- a variable used to invoke the cogit for a block mehtod being invoked repeatedly in the interpreter
lastUncoggableInterpretedBlockMethod
- a variable used to avoid invoking the cogit for an unjittable method encountered on block evaluation
maxLiteralCountForCompile
- the variable controlling which methods to jit. methods with a literal count above this value will not be jitted (on the grounds that large methods are typically used for initialization, and take up a lot of space in the code zone)
minBackwardJumpCountForCompile
- the variable controlling when to attempt to jit a method being interpreted. If as many backward jumps as this occur, the current method will be jitted
primTraceLog
- a small array implementing a crcular buffer logging the last N primitive invocations, GCs, code compactions, etc used for crash reporting
primTraceLogIndex
- the index into primTraceLog of the next entry
reenterInterpreter
- the jmpbuf used to jmp back into the interpreter when transitioning from machine code to the interpreter
statCodeCompactionCount
- the count of machine code zone compactions
statCodeCompactionUsecs
- the total microseconds spent in machine code zone compactions
traceLog
- a log of various events, used in debugging
traceLogIndex
- the index into traceLog of the next entry
traceSources
- the names associated with the codes of events in traceLog
CFramePointer
- if in use, the value of the C frame pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CStackPointer
- the value of the C stack pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CReturnAddress
- the return address for the function call which invoked the interpreter at start-up. Using this as teh return address when entering the interpreter via ceInvokeInterpeter maintains a valid stack. Since this is effevtively a constant it does not need to be saved and restored once set.!
Item was changed:
----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
COGVM := true.
MinBackwardJumpCountForCompile := 40.
MaxNumArgs := 15.
PrimCallOnSmalltalkStack := 1. "Speed up simple external prims by avoiding stack switch"
PrimCallOnSmalltalkStackAlign2x := 2. "Align stack to a 2 x word size boundary, e.g. for MMX instructions etc"
PrimCallNeedsNewMethod := 4. "e.g. primitiveExternalCall and primitiveCalloutToFFI extract info from newMethod's first literal"
PrimCallMayEndureCodeCompaction := 8. "primitiveExternalCall and primitiveCalloutToFFI may invoke callbacks, hence may experience code compaction."
PrimCallCollectsProfileSamples := 16. "tells JIT to compile support for profiling primitives"
PrimCallIsExternalCall := 32. "Whether a primitive is not included in the VM, but loaded dynamically.
Hence it can only be called through a CallFullRT."
"Flags for use in primitiveMetadata: in external primitives, overlap with the PrimCallXXX flags above"
FastCPrimitiveFlag := 1. "a.k.a. PrimCallOnSmalltalkStack"
FastCPrimitiveAlignForFloatsFlag := 2. "a.k.a. PrimCallOnSmalltalkStackAlign2x"
"And to shift away the flags, to compute the accessor depth, use...
c.f. NullSpurMetadata in sq.h"
SpurPrimitiveAccessorDepthShift := 8.
SpurPrimitiveFlagsMask := 1 << SpurPrimitiveAccessorDepthShift - 1.
"the primitive trace log; a record of the last 256 named/external primitives or significant events invoked."
PrimTraceLogSize := 256. "Room for 256 selectors. Must be 256 because we use a byte to hold the index"
TraceBufferSize := 256 * 3. "Room for 256 events"
TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
TraceIsFromMachineCode := 1.
TraceIsFromInterpreter := 2.
CSCallbackEnter := 3.
CSCallbackLeave := 4.
CSEnterCriticalSection := 5.
CSExitCriticalSection := 6.
CSResume := 7.
CSSignal := 8.
CSSuspend := 9.
CSWait := 10.
CSYield := 11.
CSCheckEvents := 12.
CSThreadSchedulingLoop := 13.
CSOwnVM := 14.
CSThreadBind := 15.
CSSwitchIfNeccessary := 16.
+ CSTryToExecuteSmalltalk := 17.
TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
"this is simulation only"
RumpCStackSize := 4096!
Item was changed:
----- Method: CoInterpreterMT>>cedeToHigherPriorityThreads (in category 'process primitive support') -----
cedeToHigherPriorityThreads
"Invoked from checkForEventsMayContextSwitch: to switch threads if a thread
wanting to acquire the VM has higher priority than the active process."
| activeProc processAffinity activeContext activePriority activeThread vmThread waitingPriority |
<var: #activeThread type: #'CogVMThread *'>
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
activeProc := self activeProcess.
activePriority := self quickFetchInteger: PriorityIndex ofObject: activeProc.
+ processAffinity := self threadAffinityOfProcess: activeProc.
- processAffinity := self ownerIndexOfProcess: activeProc.
activeThread := cogThreadManager currentVMThread.
self assert: (cogThreadManager threadIndex: activeThread index isCompatibleWith: processAffinity).
waitingPriority := self getMaxWaitingPriority.
activeThread priority: activePriority.
vmThread := cogThreadManager
highestPriorityThreadIfHigherThan: activePriority
expectedMax: waitingPriority.
(vmThread isNil "no waiting thread of sufficiently high priority. Do not switch."
or: [vmThread = activeThread]) "The activeProcess needs to run on a different thread. Leave this to
threadSwitchIfNecessary:from: in checkForEventsMayContextSwitch:"
ifTrue:
[waitingPriority > activePriority ifTrue:
["We found no thread of sufficiently high priority, even though waitingPriority indicated there should be one.
So reduce the waiting priority back to the priority of the currently active process."
self reduceWaitingPriorityFrom: waitingPriority to: activePriority].
^self].
self assert: vmThread priority > activePriority.
self assert: vmThread ~= cogThreadManager currentVMThread.
self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
waitingPriority > vmThread priority ifTrue:
[self reduceWaitingPriorityFrom: waitingPriority to: vmThread priority].
statProcessSwitch := statProcessSwitch + 1.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: activeContext.
self ensurePushedInstructionPointer.
self externalWriteBackHeadFramePointers.
self putToSleep: activeProc yieldingIf: preemptionYields.
"Transcript cr; print: #cedeToHighestPriorityThreadIfHigherThan:; cr.
self printExternalHeadFrame.
self print: 'ip: '; printHex: self instructionPointer. Transcript cr; flush."
self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSCheckEvents!
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>
<returnTypeC: #'void *'>
| vmThread activeProc |
self assert: flags >= 0.
self assert: self successful.
+ self assert: (cogThreadManager vmOwnerIs: cogThreadManager ioGetThreadLocalThreadIndex).
+
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.
^nil].
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."
activeProc := self activeProcess.
activeProc ~= objectMemory nilObject
ifTrue: [disowningVMThread := vmThread.
vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).].
"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].
vmThread disownFlags: (flags bitOr: (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])).
cogThreadManager releaseVM.
^vmThread!
Item was changed:
----- Method: CoInterpreterMT>>isBoundProcess: (in category 'process primitive support') -----
isBoundProcess: aProcess
+ ^self isBoundThreadId: (self threadAffinityOfProcess: aProcess)!
- ^self isBoundThreadId: (self ownerIndexOfProcess: aProcess)!
Item was changed:
----- Method: CoInterpreterMT>>loadInitialContext (in category 'initialization') -----
loadInitialContext
| activeProc |
super loadInitialContext.
activeProc := self activeProcess.
+ self assert: (self threadAffinityOfProcess: activeProc) = 0.
+ activeProcessAffined := (self threadAffinityOfProcess: activeProc) ~= 0!
- self assert: (self ownerIndexOfProcess: activeProc) = 0.
- activeProcessAffined := (self ownerIndexOfProcess: activeProc) ~= 0!
Item was removed:
- ----- Method: CoInterpreterMT>>ownerIndexOfProcess: (in category 'process primitive support') -----
- ownerIndexOfProcess: aProcess
- ^self ownerIndexOfThreadId: (self threadAffinityFieldOf: aProcess)!
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 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.
+ (self threadAffinityOfProcess: activeProc) = 0 ifTrue:
+ [self setTemporaryThreadAffinityOfProcess: activeProc to: preemptedThread index bind: false].
- (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>>primitiveProcessBindToThreadId (in category 'process primitives') -----
primitiveProcessBindToThreadId
"Attempt to bind the receiver to the thread with the id of the argument or nil, where the receiver is a Process.
If successful the VM will ensure that there are at least id many threads active."
| aProcess id waitingPriority activePriority |
<export: true>
self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
processHasThreadAffinity ifFalse:
[^self primitiveFailFor: PrimErrUnsupported].
id := self stackTop.
aProcess := self stackValue: 1.
((id = objectMemory nilObject or: [(objectMemory isIntegerObject: id)
and: [id ~= (objectMemory integerObjectOf: 0)]])
and: [(objectMemory isPointers: aProcess)
and: [(objectMemory slotSizeOf: aProcess) >= (ThreadIdIndex + 1)]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
id := id = objectMemory nilObject ifTrue: [0] ifFalse: [objectMemory integerValueOf: id].
id abs >= cogThreadManager maxNumThreads ifTrue:
[^self primitiveFailFor: PrimErrLimitExceeded].
(self bindProcess: aProcess toId: id) ifNotNil:
[:ec| ^self primitiveFailFor: ec].
self methodReturnReceiver.
waitingPriority := self getMaxWaitingPriority.
activePriority := self quickFetchInteger: PriorityIndex ofObject: aProcess.
+ id := self threadAffinityOfProcess: aProcess.
- id := self ownerIndexOfProcess: aProcess.
(aProcess = self activeProcess
and: [(activeProcessAffined := id ~= 0)
and: [(cogThreadManager vmOwnerIsCompatibleWith: id) not]]) ifTrue:
[activePriority < waitingPriority ifTrue:
[self reduceWaitingPriorityFrom: waitingPriority to: activePriority "TODO: Check if this is correct?"].
self threadSwitchIfNecessary: aProcess from: CSThreadBind]!
Item was changed:
----- Method: CoInterpreterMT>>primitiveProcessBoundThreadId (in category 'process primitives') -----
primitiveProcessBoundThreadId
"Answer the receiver's current threadAffinity or nil, where the receiver is a Process.
If the threadAffinity is positive then the receiver is bound to the thread with that id.
If the threadAffinity is negative then the receiver is excluded from running on the thread with that id."
| aProcess id |
<export: true>
self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
processHasThreadAffinity ifFalse:
[^self primitiveFailFor: PrimErrUnsupported].
aProcess := self stackTop.
+ id := self threadAffinityOfProcess: aProcess.
- id := self ownerIndexOfProcess: aProcess.
self methodReturnValue: (id = 0
ifTrue: [objectMemory nilObject]
ifFalse: [objectMemory integerObjectOf: id])!
Item was changed:
----- Method: CoInterpreterMT>>restoreVMStateFor:andFlags: (in category 'vm scheduling') -----
restoreVMStateFor: vmThread andFlags: flags
"We've been preempted; we must restore state and update the threadId
in our process, and may have to put the active process to sleep."
| sched activeProc myProc |
sched := self schedulerPointer.
activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
(flags anyMask: OwnVMForeignThreadFlag)
ifTrue:
[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
myProc := objectMemory splObj: foreignCallbackProcessSlot.
self assert: myProc ~= objectMemory nilObject.
objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
self assert: activeProc ~= myProc.
(activeProc ~= objectMemory nilObject
and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
[self putToSleep: activeProc yieldingIf: preemptionYields].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
objectMemory
storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
"Only unaffine if the process was affined at this level and did not become bound in the interim."
((flags anyMask: ProcessUnaffinedOnDisown)
and: [(self isBoundProcess: myProc) not]) ifTrue:
+ [self setTemporaryThreadAffinityOfProcess: myProc to: 0 bind: false].
- [self setOwnerIndexOfProcess: myProc to: 0 bind: false].
self initPrimCall.
self cCode:
[self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc]
inSmalltalk:
["Bypass the no-offset stack depth check in the simulator's externalSetStackPageAndPointersForSuspendedContextOfProcess:"
super externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
"We're in ownVM:, hence in a primitive, hence need to include the argument count"
(self isMachineCodeFrame: framePointer) ifTrue:
[self maybeCheckStackDepth: vmThread argumentCount
sp: stackPointer
pc: instructionPointer]].
"If this primitive is called from machine code maintain the invariant that the return pc
of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
(vmThread inMachineCode
and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC].
newMethod := vmThread newMethodOrNull.
argumentCount := vmThread argumentCount.
vmThread newMethodOrNull: nil.
self cCode: '' inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: vmThread index.
self assert: ((range includes: vmThread cStackPointer) and: [range includes: vmThread cFramePointer])].
self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
self assert: newMethod notNil
!
Item was changed:
----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') -----
returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
| activeThread |
activeThread := cogThreadManager currentVMThread.
self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source.
vmThread
+ ifNotNil: [cogThreadManager wakeVMThread: vmThread]
+ ifNil: [cogit releaseVM "TODO: Do we need to saveRegisterStateForCurrentProcess here?"].
- ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index]
- ifNil: [cogit disownVM: DisownVMForThreading].
"I am not frightened of flying.
Any value will do. I don't mind.
Why should I be frightened of flying?
There's no reason for it."
self _longjmp: activeThread reenterThreadSchedulingLoop _: 1 !
Item was removed:
- ----- Method: CoInterpreterMT>>setOwnerIndexOfProcess:to:bind: (in category 'process primitive support') -----
- setOwnerIndexOfProcess: aProcess to: anIndex bind: bind
- | threadId |
- threadId := anIndex = 0
- ifTrue: [objectMemory nilObject]
- ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
- objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>setTemporaryThreadAffinityOfProcess:to:bind: (in category 'process primitive support') -----
+ setTemporaryThreadAffinityOfProcess: aProcess to: anIndex bind: bind
+ | threadId |
+ threadId := anIndex = 0
+ ifTrue: [objectMemory nilObject]
+ ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
+ objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>setThreadAffinityOfProcess:to:bind: (in category 'process primitive support') -----
+ setThreadAffinityOfProcess: aProcess to: anIndex bind: bind
+ | threadId |
+ threadId := anIndex = 0
+ ifTrue: [objectMemory nilObject]
+ ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
+ objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>threadAffinityOfProcess: (in category 'process primitive support') -----
+ threadAffinityOfProcess: aProcess
+ ^self ownerIndexOfThreadId: (self threadAffinityFieldOf: aProcess)!
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.
(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].
"tryToExecuteSmalltalk: may return if there's no runnable process.
Usually it doesn't return, but jumps straight back to the _setjmp at the top of this function,
so this is only reached in case there's no runnable process."
+ "TODO: Do we need to saveRegisterStateForCurrentProcess here?"
+ self releaseVM].
- 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."
+ | newProcThreadAffinity vmThread activeContext |
- | 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."
+ newProcThreadAffinity := self threadAffinityOfProcess: newProc.
+ ((activeProcessAffined := newProcThreadAffinity ~= 0)
+ and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcThreadAffinity) not]) ifFalse:
- newProcOwnerIndex := self ownerIndexOfProcess: newProc.
- ((activeProcessAffined := newProcOwnerIndex ~= 0)
- and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcOwnerIndex) not]) ifFalse:
[(self quickFetchInteger: PriorityIndex ofObject: newProc) < self getMaxWaitingPriority 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. newProcThreadAffinity }].
- 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]].
+ newProcThreadAffinity < 0
- newProcOwnerIndex < 0
ifTrue:
+ [self assert: newProcThreadAffinity negated = cogThreadManager getVMOwner.
- [self assert: newProcOwnerIndex negated = cogThreadManager getVMOwner.
vmThread := cogThreadManager ensureWillingThread.
self deny: vmThread index = cogThreadManager getVMOwner.
+ self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcThreadAffinity)]
- self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcOwnerIndex)]
ifFalse:
+ [vmThread := cogThreadManager vmThreadAt: newProcThreadAffinity.
- [vmThread := cogThreadManager vmThreadAt: newProcOwnerIndex.
vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc).
vmThread vmThreadState = CTMUnavailable ifTrue:
[vmThread setVmThreadState: 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:
[self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode]].
+ "self error: 'scheduler could not find a runnable process'"
+ self returnToSchedulingLoopAndReleaseVMOrWakeThread: nil 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: CoInterpreterMT>>tryToExecuteSmalltalk: (in category 'vm scheduling') -----
tryToExecuteSmalltalk: vmThread
"Attempt to run the current process, if it exists, on the given vmThread."
<var: #vmThread type: #'CogVMThread *'>
+ | activeProc threadAffinity |
- | dvmt activeProc ownerIndex |
- <var: #dvmt type: #'CogVMThread *'>
self assert: (cogThreadManager vmOwnerIs: vmThread index).
self assert: cogThreadManager ioGetThreadLocalThreadIndex = vmThread index.
+
- dvmt := disowningVMThread.
disowningVMThread
ifNil: [activeProc := self activeProcess]
ifNotNil:
[self preemptDisowningThread.
activeProc := self wakeHighestPriority.
activeProc
ifNil: [activeProc := objectMemory nilObject]
ifNotNil: [objectMemory
storePointerUnchecked: MyListIndex
ofObject: activeProc
withValue: objectMemory nilObject].
objectMemory
storePointer: ActiveProcessIndex
ofObject: self schedulerPointer
withValue: activeProc].
activeProc = objectMemory nilObject ifTrue:[^nil].
+ threadAffinity := self threadAffinityOfProcess: activeProc.
+ (cogThreadManager vmOwnerIsCompatibleWith: threadAffinity) ifTrue:
- ownerIndex := self ownerIndexOfProcess: activeProc.
- (ownerIndex = 0 or: [cogThreadManager vmOwnerIsCompatibleWith: ownerIndex]) ifTrue:
[self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
(objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc) ~= objectMemory nilObject ifTrue:
[self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc].
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[self deny: (self isMachineCodeFrame: framePointer).
instructionPointer := self iframeSavedIP: framePointer].
self enterSmalltalkExecutive.
"When we return here we should have already given up
the VM and so we cannot touch any interpreter state."
+ self error: 'NOTREACHED'.].
+ cogThreadManager returnToSchedulingLoopAndWakeThreadFor: threadAffinity source: CSTryToExecuteSmalltalk.
+ "This is only reached if the above call has failed, then ownership has not been transferred and we still need to release the VM."!
- "NOTREACHED"].
- cogThreadManager wakeVMThreadFor: ownerIndex!
Item was changed:
----- Method: CoInterpreterMT>>waitingPriorityIsAtLeast: (in category 'accessing') -----
waitingPriorityIsAtLeast: minPriority
"Set the maxWaitingPriority to at least minPriority on behalf
of a thread wanting to acquire the VM. If maxWaitingPriority
is increased, schedule a thread activation check asap."
<var: #currentWaitingPriority type: #int>
| currentWaitingPriority didIncrease |
self cCode: [currentWaitingPriority := self getMaxWaitingPriority.]
inSmalltalk: [currentWaitingPriority := AtomicValue new.
currentWaitingPriority value: self getMaxWaitingPriority].
didIncrease := false.
[(self cCode: [currentWaitingPriority] inSmalltalk: [currentWaitingPriority value]) >= minPriority
or: [didIncrease := self atomic: (self addressOf: maxWaitingPriority)
_compare: (self addressOf: currentWaitingPriority)
_exchange_strong: minPriority]] whileFalse.
didIncrease
+ ifTrue: [ self assert: (self cCode: [currentWaitingPriority] inSmalltalk: [currentWaitingPriority value]) < minPriority.
- ifTrue: [ self assert: currentWaitingPriority < minPriority.
checkThreadActivation := true.
self forceInterruptCheck]!
Item was added:
+ ----- Method: CogThreadManager>>returnToSchedulingLoopAndWakeThreadFor:source: (in category 'public api') -----
+ returnToSchedulingLoopAndWakeThreadFor: threadAffinity source: sourceIndex
+ "Transfer the VM to a thread that is compatible with the given affinity.
+ Called from a thread that finds the highest priority runnable process is bound
+ to the given affinity."
+ <returnTypeC: #void>
+ "Make sure we do actually need to wake a thread"
+ self assert: (self vmOwnerIsCompatibleWith: threadAffinity) not.
+ self assert: threadAffinity ~= 0.
+
+ ^ threadAffinity > 0
+ ifTrue: [self assert: (threadAffinity between: 1 and: numThreads).
+ self returnToSchedulingLoopAndReleaseVMOrWakeThread: (threads at: threadAffinity) source: sourceIndex]
+ ifFalse: [|willingThread|
+ self assert: (self getVMOwner = threadAffinity negated).
+ "We know the thread affinity is 'any thread other then this one!!'."
+ willingThread := self ensureWillingThread.
+ willingThread ifNotNil: [self returnToSchedulingLoopAndReleaseVMOrWakeThread: willingThread source: sourceIndex]]!
Item was changed:
----- Method: CogThreadManager>>setVMOwner: (in category 'public api') -----
setVMOwner: indexOrZero
"An ugly accessor used in only three cases:
1. by ownVMFromUnidentifiedThread when the VM is first locked to the thread id
of the unidentified thread, and then, once identified, to the thread's index.
2. by wakeVMThreadFor: used by the two-level scheduler to switch threads when
a Smalltalk process switch occurs to a process affined to another thread.
3. to release the VM (set the owner to zero)"
<inline: #always>
+ self assert: (self getVMOwner = self ioGetThreadLocalThreadIndex or: [self getVMOwner = -1]).
+ self assert: (self getVMOwner ~= indexOrZero).
- self assert: (self getVMOwner ~= 0 and: [self getVMOwner ~= indexOrZero]).
self cCode: '' inSmalltalk:
[coInterpreter transcript
ensureCr;
f: 'setVMOwner: %d -> %d (%s)\n'
printf: { self getVMOwner. indexOrZero. thisContext home sender selector }].
"TODO: We could make this a `release` ordering, which may perform better on ARM."
self atomic_store: (self addressOf: vmOwner) _: indexOrZero!
Item was changed:
----- Method: CogThreadManager>>threadIndex:isCompatibleWith: (in category 'public api-testing') -----
+ threadIndex: aThreadIndex isCompatibleWith: threadAffinity
+ "Test if threadAffinity is ok to run on a thread with the given index."
- threadIndex: aThreadIndex isCompatibleWith: processThreadId
- "Test if processThreadId is ok to run on a thread with the given index."
<inline: true>
self assert: aThreadIndex > 0.
+ ^threadAffinity = 0
+ or: [threadAffinity >= 0
+ ifTrue: [aThreadIndex = threadAffinity]
+ ifFalse: [aThreadIndex ~= threadAffinity negated]]!
- ^processThreadId = 0
- or: [processThreadId >= 0
- ifTrue: [aThreadIndex = processThreadId]
- ifFalse: [aThreadIndex ~= processThreadId negated]]!
Item was removed:
- ----- 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>
- self assert: (index between: 1 and: numThreads).
- ^ self wakeVMThread: (threads at: index).
- !
Item was removed:
- ----- Method: CogVMSimulator>>ownerIndexOfProcess: (in category 'multi-threading simulation switch') -----
- ownerIndexOfProcess: aProcess
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #ownerIndexOfProcess:
- withArguments: {aProcess}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>setOwnerIndexOfProcess:to:bind: (in category 'multi-threading simulation switch') -----
- setOwnerIndexOfProcess: aProcess to: anIndex bind: bind
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #setOwnerIndexOfProcess:to:bind:
- withArguments: {aProcess. anIndex. bind}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was changed:
----- 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 ~= anInteger
+ ifTrue: [currentState caseOf: {
+ [CTMUninitialized] -> [self assert: anInteger = CTMInitializing].
+ [CTMInitializing] -> [self assert: anInteger = CTMAssignableOrInVM].
+ [CTMAssignableOrInVM] -> [self assert: anInteger = CTMUnavailable].
+ [CTMUnavailable] -> [self assert: (anInteger = CTMAssignableOrInVM
+ or: [anInteger = CTMWantingOwnership])].
+ [CTMWantingOwnership] -> [self assert: anInteger = CTMAssignableOrInVM]
+ } otherwise: []].
- 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: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
primitiveConnect
"Primitive. Starts or continues a client handshake using the provided data.
Will eventually produce output to be sent to the server. Requires the host
name to be set for the session.
Returns:
> 0 - Number of bytes to be sent to the server
0 - Success. The connection is established.
-1 - More input is required.
< -1 - Other errors.
"
+ | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result wasSrcPinned wasDestPinned vmHandle |
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
<var: #srcPtr type: #'char *'>
<var: #dstPtr type: #'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
dstOop := interpreterProxy stackValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
srcOop := interpreterProxy stackValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
+
+ "Careful!! The object may move when being pinned!!"
+ (wasSrcPinned := interpreterProxy isPinned: srcOop)
+ ifFalse: [srcOop := interpreterProxy pinObject: srcOop].
+ (wasDestPinned := interpreterProxy isPinned: dstOop)
+ ifFalse: [dstOop := interpreterProxy pinObject: dstOop].
+
+ "Pinning may fail (only if we're out of memory)"
+ (srcOop isNil or: [dstOop isNil])
+ ifTrue: [^ interpreterProxy primitiveFail].
+
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
+
+ vmHandle := interpreterProxy disownVM: DisownVMForThreading.
+
result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
+
+ interpreterProxy ownVM: vmHandle.
+ wasSrcPinned ifFalse: [interpreterProxy unpinObject: srcOop].
+ wasDestPinned ifFalse: [interpreterProxy unpinObject: dstOop].
+
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
Leon Matthes uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.threaded-LM.3343.mcz
==================== Summary ====================
Name: VMMaker.threaded-LM.3343
Author: LM
Time: 23 October 2023, 2:59:26.998963 pm
UUID: 96fd1f0a-297d-4008-a19c-049602ca872e
Ancestors: VMMaker.threaded-LM.3342
Fix thread switch accidentally disowning the VM which causes an incorrect preemption.
Allow thread switching during the SqueakSSL primitiveConnect.
Rename ownerIndex to threadAffinity.
=============== Diff against VMMaker.threaded-LM.3342 ===============
Item was changed:
StackInterpreterPrimitives subclass: #CoInterpreter
instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase primitiveMetadataTable lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName primCalloutIsExternal'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSTryToExecuteSmalltalk CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
category: 'VMMaker-JIT'!
!CoInterpreter commentStamp: 'eem 3/31/2020 18:56' prior: 0!
I am a variant of the StackInterpreter that can co-exist with the Cog JIT. I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT. See CogMethod class's comment for method interoperability.
cogCodeSize
- the current size of the machine code zone
cogCompiledCodeCompactionCalledFor
- a variable set when the machine code zone runs out of space, causing a machine code zone compaction at the next available opportunity
cogMethodZone
- the manager for the machine code zone (instance of CogMethodZone)
cogit
- the JIT (co-jit) (instance of SimpleStackBasedCogit, StackToRegisterMappoingCogit, etc)
deferSmash
- a flag causing deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
deferredSmash
- a flag noting deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
desiredCogCodeSize
- the desred size of the machine code zone, set at startup or via primitiveVMParameter to be written at snapshot time
flagInterpretedMethods
- true if methods that are interpreted shoudl have their flag bit set (used to identity methods that are interpreted because they're unjittable for some reason)
gcMode
- the variable holding the gcMode, used to inform the cogit of how to scan the machine code zone for oops on GC
heapBase
- the address in memory of the base of the objectMemory's heap, which is immediately above the machine code zone
lastCoggableInterpretedBlockMethod
- a variable used to invoke the cogit for a block mehtod being invoked repeatedly in the interpreter
lastUncoggableInterpretedBlockMethod
- a variable used to avoid invoking the cogit for an unjittable method encountered on block evaluation
maxLiteralCountForCompile
- the variable controlling which methods to jit. methods with a literal count above this value will not be jitted (on the grounds that large methods are typically used for initialization, and take up a lot of space in the code zone)
minBackwardJumpCountForCompile
- the variable controlling when to attempt to jit a method being interpreted. If as many backward jumps as this occur, the current method will be jitted
primTraceLog
- a small array implementing a crcular buffer logging the last N primitive invocations, GCs, code compactions, etc used for crash reporting
primTraceLogIndex
- the index into primTraceLog of the next entry
reenterInterpreter
- the jmpbuf used to jmp back into the interpreter when transitioning from machine code to the interpreter
statCodeCompactionCount
- the count of machine code zone compactions
statCodeCompactionUsecs
- the total microseconds spent in machine code zone compactions
traceLog
- a log of various events, used in debugging
traceLogIndex
- the index into traceLog of the next entry
traceSources
- the names associated with the codes of events in traceLog
CFramePointer
- if in use, the value of the C frame pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CStackPointer
- the value of the C stack pointer on most recent entry to the interpreter after start-up or a callback. Used to establish the C stack when calling the run-time from generated machine code.
CReturnAddress
- the return address for the function call which invoked the interpreter at start-up. Using this as teh return address when entering the interpreter via ceInvokeInterpeter maintains a valid stack. Since this is effevtively a constant it does not need to be saved and restored once set.!
Item was changed:
----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
COGVM := true.
MinBackwardJumpCountForCompile := 40.
MaxNumArgs := 15.
PrimCallOnSmalltalkStack := 1. "Speed up simple external prims by avoiding stack switch"
PrimCallOnSmalltalkStackAlign2x := 2. "Align stack to a 2 x word size boundary, e.g. for MMX instructions etc"
PrimCallNeedsNewMethod := 4. "e.g. primitiveExternalCall and primitiveCalloutToFFI extract info from newMethod's first literal"
PrimCallMayEndureCodeCompaction := 8. "primitiveExternalCall and primitiveCalloutToFFI may invoke callbacks, hence may experience code compaction."
PrimCallCollectsProfileSamples := 16. "tells JIT to compile support for profiling primitives"
PrimCallIsExternalCall := 32. "Whether a primitive is not included in the VM, but loaded dynamically.
Hence it can only be called through a CallFullRT."
"Flags for use in primitiveMetadata: in external primitives, overlap with the PrimCallXXX flags above"
FastCPrimitiveFlag := 1. "a.k.a. PrimCallOnSmalltalkStack"
FastCPrimitiveAlignForFloatsFlag := 2. "a.k.a. PrimCallOnSmalltalkStackAlign2x"
"And to shift away the flags, to compute the accessor depth, use...
c.f. NullSpurMetadata in sq.h"
SpurPrimitiveAccessorDepthShift := 8.
SpurPrimitiveFlagsMask := 1 << SpurPrimitiveAccessorDepthShift - 1.
"the primitive trace log; a record of the last 256 named/external primitives or significant events invoked."
PrimTraceLogSize := 256. "Room for 256 selectors. Must be 256 because we use a byte to hold the index"
TraceBufferSize := 256 * 3. "Room for 256 events"
TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
TraceIsFromMachineCode := 1.
TraceIsFromInterpreter := 2.
CSCallbackEnter := 3.
CSCallbackLeave := 4.
CSEnterCriticalSection := 5.
CSExitCriticalSection := 6.
CSResume := 7.
CSSignal := 8.
CSSuspend := 9.
CSWait := 10.
CSYield := 11.
CSCheckEvents := 12.
CSThreadSchedulingLoop := 13.
CSOwnVM := 14.
CSThreadBind := 15.
CSSwitchIfNeccessary := 16.
+ CSTryToExecuteSmalltalk := 17.
TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
"this is simulation only"
RumpCStackSize := 4096!
Item was changed:
----- Method: CoInterpreterMT>>cedeToHigherPriorityThreads (in category 'process primitive support') -----
cedeToHigherPriorityThreads
"Invoked from checkForEventsMayContextSwitch: to switch threads if a thread
wanting to acquire the VM has higher priority than the active process."
| activeProc processAffinity activeContext activePriority activeThread vmThread waitingPriority |
<var: #activeThread type: #'CogVMThread *'>
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
activeProc := self activeProcess.
activePriority := self quickFetchInteger: PriorityIndex ofObject: activeProc.
+ processAffinity := self threadAffinityOfProcess: activeProc.
- processAffinity := self ownerIndexOfProcess: activeProc.
activeThread := cogThreadManager currentVMThread.
self assert: (cogThreadManager threadIndex: activeThread index isCompatibleWith: processAffinity).
waitingPriority := self getMaxWaitingPriority.
activeThread priority: activePriority.
vmThread := cogThreadManager
highestPriorityThreadIfHigherThan: activePriority
expectedMax: waitingPriority.
(vmThread isNil "no waiting thread of sufficiently high priority. Do not switch."
or: [vmThread = activeThread]) "The activeProcess needs to run on a different thread. Leave this to
threadSwitchIfNecessary:from: in checkForEventsMayContextSwitch:"
ifTrue:
[waitingPriority > activePriority ifTrue:
["We found no thread of sufficiently high priority, even though waitingPriority indicated there should be one.
So reduce the waiting priority back to the priority of the currently active process."
self reduceWaitingPriorityFrom: waitingPriority to: activePriority].
^self].
self assert: vmThread priority > activePriority.
self assert: vmThread ~= cogThreadManager currentVMThread.
self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer.
waitingPriority > vmThread priority ifTrue:
[self reduceWaitingPriorityFrom: waitingPriority to: vmThread priority].
statProcessSwitch := statProcessSwitch + 1.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: activeContext.
self ensurePushedInstructionPointer.
self externalWriteBackHeadFramePointers.
self putToSleep: activeProc yieldingIf: preemptionYields.
"Transcript cr; print: #cedeToHighestPriorityThreadIfHigherThan:; cr.
self printExternalHeadFrame.
self print: 'ip: '; printHex: self instructionPointer. Transcript cr; flush."
self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSCheckEvents!
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>
<returnTypeC: #'void *'>
| vmThread activeProc |
self assert: flags >= 0.
self assert: self successful.
+ self assert: (cogThreadManager vmOwnerIs: cogThreadManager ioGetThreadLocalThreadIndex).
+
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.
^nil].
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."
activeProc := self activeProcess.
activeProc ~= objectMemory nilObject
ifTrue: [disowningVMThread := vmThread.
vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).].
"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].
vmThread disownFlags: (flags bitOr: (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])).
cogThreadManager releaseVM.
^vmThread!
Item was changed:
----- Method: CoInterpreterMT>>isBoundProcess: (in category 'process primitive support') -----
isBoundProcess: aProcess
+ ^self isBoundThreadId: (self threadAffinityOfProcess: aProcess)!
- ^self isBoundThreadId: (self ownerIndexOfProcess: aProcess)!
Item was changed:
----- Method: CoInterpreterMT>>loadInitialContext (in category 'initialization') -----
loadInitialContext
| activeProc |
super loadInitialContext.
activeProc := self activeProcess.
+ self assert: (self threadAffinityOfProcess: activeProc) = 0.
+ activeProcessAffined := (self threadAffinityOfProcess: activeProc) ~= 0!
- self assert: (self ownerIndexOfProcess: activeProc) = 0.
- activeProcessAffined := (self ownerIndexOfProcess: activeProc) ~= 0!
Item was removed:
- ----- Method: CoInterpreterMT>>ownerIndexOfProcess: (in category 'process primitive support') -----
- ownerIndexOfProcess: aProcess
- ^self ownerIndexOfThreadId: (self threadAffinityFieldOf: aProcess)!
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 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.
+ (self threadAffinityOfProcess: activeProc) = 0 ifTrue:
+ [self setTemporaryThreadAffinityOfProcess: activeProc to: preemptedThread index bind: false].
- (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>>primitiveProcessBindToThreadId (in category 'process primitives') -----
primitiveProcessBindToThreadId
"Attempt to bind the receiver to the thread with the id of the argument or nil, where the receiver is a Process.
If successful the VM will ensure that there are at least id many threads active."
| aProcess id waitingPriority activePriority |
<export: true>
self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
processHasThreadAffinity ifFalse:
[^self primitiveFailFor: PrimErrUnsupported].
id := self stackTop.
aProcess := self stackValue: 1.
((id = objectMemory nilObject or: [(objectMemory isIntegerObject: id)
and: [id ~= (objectMemory integerObjectOf: 0)]])
and: [(objectMemory isPointers: aProcess)
and: [(objectMemory slotSizeOf: aProcess) >= (ThreadIdIndex + 1)]]) ifFalse:
[^self primitiveFailFor: PrimErrBadArgument].
id := id = objectMemory nilObject ifTrue: [0] ifFalse: [objectMemory integerValueOf: id].
id abs >= cogThreadManager maxNumThreads ifTrue:
[^self primitiveFailFor: PrimErrLimitExceeded].
(self bindProcess: aProcess toId: id) ifNotNil:
[:ec| ^self primitiveFailFor: ec].
self methodReturnReceiver.
waitingPriority := self getMaxWaitingPriority.
activePriority := self quickFetchInteger: PriorityIndex ofObject: aProcess.
+ id := self threadAffinityOfProcess: aProcess.
- id := self ownerIndexOfProcess: aProcess.
(aProcess = self activeProcess
and: [(activeProcessAffined := id ~= 0)
and: [(cogThreadManager vmOwnerIsCompatibleWith: id) not]]) ifTrue:
[activePriority < waitingPriority ifTrue:
[self reduceWaitingPriorityFrom: waitingPriority to: activePriority "TODO: Check if this is correct?"].
self threadSwitchIfNecessary: aProcess from: CSThreadBind]!
Item was changed:
----- Method: CoInterpreterMT>>primitiveProcessBoundThreadId (in category 'process primitives') -----
primitiveProcessBoundThreadId
"Answer the receiver's current threadAffinity or nil, where the receiver is a Process.
If the threadAffinity is positive then the receiver is bound to the thread with that id.
If the threadAffinity is negative then the receiver is excluded from running on the thread with that id."
| aProcess id |
<export: true>
self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
processHasThreadAffinity ifFalse:
[^self primitiveFailFor: PrimErrUnsupported].
aProcess := self stackTop.
+ id := self threadAffinityOfProcess: aProcess.
- id := self ownerIndexOfProcess: aProcess.
self methodReturnValue: (id = 0
ifTrue: [objectMemory nilObject]
ifFalse: [objectMemory integerObjectOf: id])!
Item was changed:
----- Method: CoInterpreterMT>>restoreVMStateFor:andFlags: (in category 'vm scheduling') -----
restoreVMStateFor: vmThread andFlags: flags
"We've been preempted; we must restore state and update the threadId
in our process, and may have to put the active process to sleep."
| sched activeProc myProc |
sched := self schedulerPointer.
activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
(flags anyMask: OwnVMForeignThreadFlag)
ifTrue:
[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
myProc := objectMemory splObj: foreignCallbackProcessSlot.
self assert: myProc ~= objectMemory nilObject.
objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
self assert: activeProc ~= myProc.
(activeProc ~= objectMemory nilObject
and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
[self putToSleep: activeProc yieldingIf: preemptionYields].
self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
objectMemory
storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
"Only unaffine if the process was affined at this level and did not become bound in the interim."
((flags anyMask: ProcessUnaffinedOnDisown)
and: [(self isBoundProcess: myProc) not]) ifTrue:
+ [self setTemporaryThreadAffinityOfProcess: myProc to: 0 bind: false].
- [self setOwnerIndexOfProcess: myProc to: 0 bind: false].
self initPrimCall.
self cCode:
[self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc]
inSmalltalk:
["Bypass the no-offset stack depth check in the simulator's externalSetStackPageAndPointersForSuspendedContextOfProcess:"
super externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
"We're in ownVM:, hence in a primitive, hence need to include the argument count"
(self isMachineCodeFrame: framePointer) ifTrue:
[self maybeCheckStackDepth: vmThread argumentCount
sp: stackPointer
pc: instructionPointer]].
"If this primitive is called from machine code maintain the invariant that the return pc
of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
(vmThread inMachineCode
and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
[self iframeSavedIP: framePointer put: instructionPointer.
instructionPointer := cogit ceReturnToInterpreterPC].
newMethod := vmThread newMethodOrNull.
argumentCount := vmThread argumentCount.
vmThread newMethodOrNull: nil.
self cCode: '' inSmalltalk:
[| range |
range := self cStackRangeForThreadIndex: vmThread index.
self assert: ((range includes: vmThread cStackPointer) and: [range includes: vmThread cFramePointer])].
self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
self assert: newMethod notNil
!
Item was changed:
----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') -----
returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source
<var: #vmThread type: #'CogVMThread *'>
<inline: false>
| activeThread |
activeThread := cogThreadManager currentVMThread.
self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source.
vmThread
+ ifNotNil: [cogThreadManager wakeVMThread: vmThread]
+ ifNil: [cogit releaseVM "TODO: Do we need to saveRegisterStateForCurrentProcess here?"].
- ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index]
- ifNil: [cogit disownVM: DisownVMForThreading].
"I am not frightened of flying.
Any value will do. I don't mind.
Why should I be frightened of flying?
There's no reason for it."
self _longjmp: activeThread reenterThreadSchedulingLoop _: 1 !
Item was removed:
- ----- Method: CoInterpreterMT>>setOwnerIndexOfProcess:to:bind: (in category 'process primitive support') -----
- setOwnerIndexOfProcess: aProcess to: anIndex bind: bind
- | threadId |
- threadId := anIndex = 0
- ifTrue: [objectMemory nilObject]
- ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
- objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>setTemporaryThreadAffinityOfProcess:to:bind: (in category 'process primitive support') -----
+ setTemporaryThreadAffinityOfProcess: aProcess to: anIndex bind: bind
+ | threadId |
+ threadId := anIndex = 0
+ ifTrue: [objectMemory nilObject]
+ ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
+ objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>setThreadAffinityOfProcess:to:bind: (in category 'process primitive support') -----
+ setThreadAffinityOfProcess: aProcess to: anIndex bind: bind
+ | threadId |
+ threadId := anIndex = 0
+ ifTrue: [objectMemory nilObject]
+ ifFalse: [objectMemory integerObjectOf: (anIndex << 1) + (bind ifTrue: [1] ifFalse: [0])].
+ objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadId!
Item was added:
+ ----- Method: CoInterpreterMT>>threadAffinityOfProcess: (in category 'process primitive support') -----
+ threadAffinityOfProcess: aProcess
+ ^self ownerIndexOfThreadId: (self threadAffinityFieldOf: aProcess)!
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.
(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].
"tryToExecuteSmalltalk: may return if there's no runnable process.
Usually it doesn't return, but jumps straight back to the _setjmp at the top of this function,
so this is only reached in case there's no runnable process."
+ "TODO: Do we need to saveRegisterStateForCurrentProcess here?"
+ self releaseVM].
- 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."
+ | newProcThreadAffinity vmThread activeContext |
- | 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."
+ newProcThreadAffinity := self threadAffinityOfProcess: newProc.
+ ((activeProcessAffined := newProcThreadAffinity ~= 0)
+ and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcThreadAffinity) not]) ifFalse:
- newProcOwnerIndex := self ownerIndexOfProcess: newProc.
- ((activeProcessAffined := newProcOwnerIndex ~= 0)
- and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcOwnerIndex) not]) ifFalse:
[(self quickFetchInteger: PriorityIndex ofObject: newProc) < self getMaxWaitingPriority 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. newProcThreadAffinity }].
- 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]].
+ newProcThreadAffinity < 0
- newProcOwnerIndex < 0
ifTrue:
+ [self assert: newProcThreadAffinity negated = cogThreadManager getVMOwner.
- [self assert: newProcOwnerIndex negated = cogThreadManager getVMOwner.
vmThread := cogThreadManager ensureWillingThread.
self deny: vmThread index = cogThreadManager getVMOwner.
+ self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcThreadAffinity)]
- self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcOwnerIndex)]
ifFalse:
+ [vmThread := cogThreadManager vmThreadAt: newProcThreadAffinity.
- [vmThread := cogThreadManager vmThreadAt: newProcOwnerIndex.
vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc).
vmThread vmThreadState = CTMUnavailable ifTrue:
[vmThread setVmThreadState: 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:
[self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode]].
+ "self error: 'scheduler could not find a runnable process'"
+ self returnToSchedulingLoopAndReleaseVMOrWakeThread: nil 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: CoInterpreterMT>>tryToExecuteSmalltalk: (in category 'vm scheduling') -----
tryToExecuteSmalltalk: vmThread
"Attempt to run the current process, if it exists, on the given vmThread."
<var: #vmThread type: #'CogVMThread *'>
+ | activeProc threadAffinity |
- | dvmt activeProc ownerIndex |
- <var: #dvmt type: #'CogVMThread *'>
self assert: (cogThreadManager vmOwnerIs: vmThread index).
self assert: cogThreadManager ioGetThreadLocalThreadIndex = vmThread index.
+
- dvmt := disowningVMThread.
disowningVMThread
ifNil: [activeProc := self activeProcess]
ifNotNil:
[self preemptDisowningThread.
activeProc := self wakeHighestPriority.
activeProc
ifNil: [activeProc := objectMemory nilObject]
ifNotNil: [objectMemory
storePointerUnchecked: MyListIndex
ofObject: activeProc
withValue: objectMemory nilObject].
objectMemory
storePointer: ActiveProcessIndex
ofObject: self schedulerPointer
withValue: activeProc].
activeProc = objectMemory nilObject ifTrue:[^nil].
+ threadAffinity := self threadAffinityOfProcess: activeProc.
+ (cogThreadManager vmOwnerIsCompatibleWith: threadAffinity) ifTrue:
- ownerIndex := self ownerIndexOfProcess: activeProc.
- (ownerIndex = 0 or: [cogThreadManager vmOwnerIsCompatibleWith: ownerIndex]) ifTrue:
[self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
(objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc) ~= objectMemory nilObject ifTrue:
[self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc].
instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
[self deny: (self isMachineCodeFrame: framePointer).
instructionPointer := self iframeSavedIP: framePointer].
self enterSmalltalkExecutive.
"When we return here we should have already given up
the VM and so we cannot touch any interpreter state."
+ self error: 'NOTREACHED'.].
+ cogThreadManager returnToSchedulingLoopAndWakeThreadFor: threadAffinity source: CSTryToExecuteSmalltalk.
+ "This is only reached if the above call has failed, then ownership has not been transferred and we still need to release the VM."!
- "NOTREACHED"].
- cogThreadManager wakeVMThreadFor: ownerIndex!
Item was changed:
----- Method: CoInterpreterMT>>waitingPriorityIsAtLeast: (in category 'accessing') -----
waitingPriorityIsAtLeast: minPriority
"Set the maxWaitingPriority to at least minPriority on behalf
of a thread wanting to acquire the VM. If maxWaitingPriority
is increased, schedule a thread activation check asap."
<var: #currentWaitingPriority type: #int>
| currentWaitingPriority didIncrease |
self cCode: [currentWaitingPriority := self getMaxWaitingPriority.]
inSmalltalk: [currentWaitingPriority := AtomicValue new.
currentWaitingPriority value: self getMaxWaitingPriority].
didIncrease := false.
[(self cCode: [currentWaitingPriority] inSmalltalk: [currentWaitingPriority value]) >= minPriority
or: [didIncrease := self atomic: (self addressOf: maxWaitingPriority)
_compare: (self addressOf: currentWaitingPriority)
_exchange_strong: minPriority]] whileFalse.
didIncrease
+ ifTrue: [ self assert: (self cCode: [currentWaitingPriority] inSmalltalk: [currentWaitingPriority value]) < minPriority.
- ifTrue: [ self assert: currentWaitingPriority < minPriority.
checkThreadActivation := true.
self forceInterruptCheck]!
Item was added:
+ ----- Method: CogThreadManager>>returnToSchedulingLoopAndWakeThreadFor:source: (in category 'public api') -----
+ returnToSchedulingLoopAndWakeThreadFor: threadAffinity source: sourceIndex
+ "Transfer the VM to a thread that is compatible with the given affinity.
+ Called from a thread that finds the highest priority runnable process is bound
+ to the given affinity."
+ <returnTypeC: #void>
+ "Make sure we do actually need to wake a thread"
+ self assert: (self vmOwnerIsCompatibleWith: threadAffinity) not.
+ self assert: threadAffinity ~= 0.
+
+ ^ threadAffinity > 0
+ ifTrue: [self assert: (threadAffinity between: 1 and: numThreads).
+ self returnToSchedulingLoopAndReleaseVMOrWakeThread: (threads at: threadAffinity) source: sourceIndex]
+ ifFalse: [|willingThread|
+ self assert: (self getVMOwner = threadAffinity negated).
+ "We know the thread affinity is 'any thread other then this one!!'."
+ willingThread := self ensureWillingThread.
+ willingThread ifNotNil: [self returnToSchedulingLoopAndReleaseVMOrWakeThread: willingThread source: sourceIndex]]!
Item was changed:
----- Method: CogThreadManager>>setVMOwner: (in category 'public api') -----
setVMOwner: indexOrZero
"An ugly accessor used in only three cases:
1. by ownVMFromUnidentifiedThread when the VM is first locked to the thread id
of the unidentified thread, and then, once identified, to the thread's index.
2. by wakeVMThreadFor: used by the two-level scheduler to switch threads when
a Smalltalk process switch occurs to a process affined to another thread.
3. to release the VM (set the owner to zero)"
<inline: #always>
+ self assert: (self getVMOwner = self ioGetThreadLocalThreadIndex or: [self getVMOwner = -1]).
+ self assert: (self getVMOwner ~= indexOrZero).
- self assert: (self getVMOwner ~= 0 and: [self getVMOwner ~= indexOrZero]).
self cCode: '' inSmalltalk:
[coInterpreter transcript
ensureCr;
f: 'setVMOwner: %d -> %d (%s)\n'
printf: { self getVMOwner. indexOrZero. thisContext home sender selector }].
"TODO: We could make this a `release` ordering, which may perform better on ARM."
self atomic_store: (self addressOf: vmOwner) _: indexOrZero!
Item was changed:
----- Method: CogThreadManager>>threadIndex:isCompatibleWith: (in category 'public api-testing') -----
+ threadIndex: aThreadIndex isCompatibleWith: threadAffinity
+ "Test if threadAffinity is ok to run on a thread with the given index."
- threadIndex: aThreadIndex isCompatibleWith: processThreadId
- "Test if processThreadId is ok to run on a thread with the given index."
<inline: true>
self assert: aThreadIndex > 0.
+ ^threadAffinity = 0
+ or: [threadAffinity >= 0
+ ifTrue: [aThreadIndex = threadAffinity]
+ ifFalse: [aThreadIndex ~= threadAffinity negated]]!
- ^processThreadId = 0
- or: [processThreadId >= 0
- ifTrue: [aThreadIndex = processThreadId]
- ifFalse: [aThreadIndex ~= processThreadId negated]]!
Item was removed:
- ----- 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>
- self assert: (index between: 1 and: numThreads).
- ^ self wakeVMThread: (threads at: index).
- !
Item was removed:
- ----- Method: CogVMSimulator>>ownerIndexOfProcess: (in category 'multi-threading simulation switch') -----
- ownerIndexOfProcess: aProcess
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #ownerIndexOfProcess:
- withArguments: {aProcess}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was removed:
- ----- Method: CogVMSimulator>>setOwnerIndexOfProcess:to:bind: (in category 'multi-threading simulation switch') -----
- setOwnerIndexOfProcess: aProcess to: anIndex bind: bind
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #setOwnerIndexOfProcess:to:bind:
- withArguments: {aProcess. anIndex. bind}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was changed:
----- 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 ~= anInteger
+ ifTrue: [currentState caseOf: {
+ [CTMUninitialized] -> [self assert: anInteger = CTMInitializing].
+ [CTMInitializing] -> [self assert: anInteger = CTMAssignableOrInVM].
+ [CTMAssignableOrInVM] -> [self assert: anInteger = CTMUnavailable].
+ [CTMUnavailable] -> [self assert: (anInteger = CTMAssignableOrInVM
+ or: [anInteger = CTMWantingOwnership])].
+ [CTMWantingOwnership] -> [self assert: anInteger = CTMAssignableOrInVM]
+ } otherwise: []].
- 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: SqueakSSLPlugin>>primitiveConnect (in category 'primitives') -----
primitiveConnect
"Primitive. Starts or continues a client handshake using the provided data.
Will eventually produce output to be sent to the server. Requires the host
name to be set for the session.
Returns:
> 0 - Number of bytes to be sent to the server
0 - Success. The connection is established.
-1 - More input is required.
< -1 - Other errors.
"
+ | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result wasSrcPinned wasDestPinned vmHandle |
- | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result |
<var: #srcPtr type: #'char *'>
<var: #dstPtr type: #'char *'>
<export: true>
interpreterProxy methodArgumentCount = 5
ifFalse:[^interpreterProxy primitiveFail].
dstOop := interpreterProxy stackValue: 0.
srcLen := interpreterProxy stackIntegerValue: 1.
start := interpreterProxy stackIntegerValue: 2.
srcOop := interpreterProxy stackValue: 3.
handle := interpreterProxy stackIntegerValue: 4.
interpreterProxy failed ifTrue:[^nil].
((start > 0 and:[srcLen >= 0])
and:[(interpreterProxy isBytes: srcOop)
and:[(interpreterProxy isBytes: dstOop)
and:[(interpreterProxy byteSizeOf: srcOop) >= (start + srcLen - 1)]]])
ifFalse:[^interpreterProxy primitiveFail].
+
+ "Careful!! The object may move when being pinned!!"
+ (wasSrcPinned := interpreterProxy isPinned: srcOop)
+ ifFalse: [srcOop := interpreterProxy pinObject: srcOop].
+ (wasDestPinned := interpreterProxy isPinned: dstOop)
+ ifFalse: [dstOop := interpreterProxy pinObject: dstOop].
+
+ "Pinning may fail (only if we're out of memory)"
+ (srcOop isNil or: [dstOop isNil])
+ ifTrue: [^ interpreterProxy primitiveFail].
+
srcPtr := interpreterProxy firstIndexableField: srcOop.
dstPtr := interpreterProxy firstIndexableField: dstOop.
srcPtr := srcPtr + start - 1.
dstLen := interpreterProxy byteSizeOf: dstOop.
+
+ vmHandle := interpreterProxy disownVM: DisownVMForThreading.
+
result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)'
inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2].
+
+ interpreterProxy ownVM: vmHandle.
+ wasSrcPinned ifFalse: [interpreterProxy unpinObject: srcOop].
+ wasDestPinned ifFalse: [interpreterProxy unpinObject: dstOop].
+
interpreterProxy failed ifTrue:[^nil].
interpreterProxy pop: interpreterProxy methodArgumentCount+1.
interpreterProxy pushInteger: result.!
The idea of bumping the version from Windows XP (0x0501) to Windows 8 (0x0602) came from the rather crude attempt to check for "if API exists" in sqWin32Main.c:
https://www.worldescortshub.com
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: ec421b99cf41fc5f2f5fb734b536d6233cdde809
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/ec421b99cf41fc5f2f…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2023-10-13 (Fri, 13 Oct 2023)
Changed paths:
M building/macos64ARMv8/common/Makefile.app
M building/macos64ARMv8/common/Makefile.vm
M building/macos64ARMv8/squeak.cog.spur/mvm
M building/macos64ARMv8/squeak.sista.spur/mvm
M building/macos64ARMv8/squeak.stack.spur/mvm
M building/macos64x64/common/Makefile.app
M building/macos64x64/common/Makefile.vm
M building/macos64x64/squeak.cog.spur/mvm
M building/macos64x64/squeak.sista.spur/mvm
M building/macos64x64/squeak.stack.spur/mvm
M src/plugins/FilePlugin/FilePlugin.c
M src/spur32.cog.lowcode/cogit.h
M src/spur32.cog.lowcode/cogitARMv5.c
M src/spur32.cog.lowcode/cogitIA32.c
M src/spur32.cog.lowcode/cointerp.c
M src/spur32.cog.lowcode/cointerp.h
M src/spur32.cog.lowcode/gcc3x-cointerp.c
M src/spur32.cog/cogit.h
M src/spur32.cog/cogitARMv5.c
M src/spur32.cog/cogitIA32.c
M src/spur32.cog/cointerp.c
M src/spur32.cog/cointerp.h
M src/spur32.cog/cointerpmt.c
M src/spur32.cog/cointerpmt.h
M src/spur32.cog/gcc3x-cointerp.c
M src/spur32.cog/gcc3x-cointerpmt.c
M src/spur32.sista/cogit.h
M src/spur32.sista/cogitARMv5.c
M src/spur32.sista/cogitIA32.c
M src/spur32.sista/cointerp.c
M src/spur32.sista/cointerp.h
M src/spur32.sista/gcc3x-cointerp.c
M src/spur32.stack.lowcode/gcc3x-interp.c
M src/spur32.stack.lowcode/interp.c
M src/spur32.stack/gcc3x-interp.c
M src/spur32.stack/interp.c
M src/spur32.stack/validImage.c
M src/spur64.cog.lowcode/cogit.h
M src/spur64.cog.lowcode/cogitARMv8.c
M src/spur64.cog.lowcode/cogitX64SysV.c
M src/spur64.cog.lowcode/cogitX64WIN64.c
M src/spur64.cog.lowcode/cointerp.c
M src/spur64.cog.lowcode/cointerp.h
M src/spur64.cog.lowcode/gcc3x-cointerp.c
M src/spur64.cog/cogit.h
M src/spur64.cog/cogitARMv8.c
M src/spur64.cog/cogitX64SysV.c
M src/spur64.cog/cogitX64WIN64.c
M src/spur64.cog/cointerp.c
M src/spur64.cog/cointerp.h
M src/spur64.cog/cointerpmt.c
M src/spur64.cog/cointerpmt.h
M src/spur64.cog/gcc3x-cointerp.c
M src/spur64.cog/gcc3x-cointerpmt.c
M src/spur64.sista/cogit.h
M src/spur64.sista/cogitARMv8.c
M src/spur64.sista/cogitX64SysV.c
M src/spur64.sista/cogitX64WIN64.c
M src/spur64.sista/cointerp.c
M src/spur64.sista/cointerp.h
M src/spur64.sista/gcc3x-cointerp.c
M src/spur64.stack.lowcode/gcc3x-interp.c
M src/spur64.stack.lowcode/interp.c
M src/spur64.stack/gcc3x-interp.c
M src/spur64.stack/interp.c
M src/spur64.stack/validImage.c
M src/v3.cog/cogit.h
M src/v3.cog/cogitARMv5.c
M src/v3.cog/cogitIA32.c
M src/v3.cog/cointerp.c
M src/v3.cog/cointerp.h
M src/v3.cog/gcc3x-cointerp.c
M src/v3.stack/gcc3x-interp.c
M src/v3.stack/interp.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3339
Now the MT vm is using C intrinsics there are no trampolines for the COGMTVM
configuration.
First mostly stable version of the Threaded FFI.
Most important changes are:
1. Use C11 atomic instructions for the vmOwner.
This simplifies the CPXCHG instruction and should make this a lot more resistant to breaking due to compiler optimizations.
2. Fix a critical bug when reentering the threadSchedulingLoop
Previously this used the wrong jmp_buf, therefore a thread that tried to return to its threadSchedulingLoop might end up in the threadSchedulingLoop of ANOTHER thread!
With these two changes in place, the VM runs mostly stable whilst switching between two threads in the spurreader image.
There are still some bugs to fix, especially in the scheduler, as well as synchronizing access to the threads variable.
But this is good progress for now.
Rename CoInterpreterMT's processHasThreadId inst var to processHasThreadAffinity in the wake of Kernel-eem.1523.
First commit of Leon Matthes' work to revive the threaded FFI (committed by eem on behalf of LM cuz of Monticello permissions on source.squeak.org).
Fix simulation so that the current processor register state reflects the current Smalltalk process. Eliot's first attempt was a bit broken. This approach of manually switching register states in tryLockVMOwnerTo: preserves fast simulation because we're not changing register state on every send to the processor object as was the case with the original MultiProcessor wrapper. Check for a missing register state by setting the register state for stack, frame & pc pointers to zero. Label the processes spawned by the simulation so they show up nicely in the process browser.
releaseVM was used several places where disownVM: should have been used.
Simplify cedeToHigherPriorityThreads; the VM can't be unowned when invoked.
Nuke some unneeded halts.
minor clean-up/commentary.
Help myself by documenting what the snapshotPrimitive answers (false for snapshot, true for resume).
Simplify SpurMemoryManager>>#sufficientSpaceAfterGC:. Nuke an unused link reg related utility in the Cogit. Add the CogVMSimulator's fklush method to the STackInterpreterSimulator to ensure that GC progress is printed immediately while simulating.
Build: upgrade the 64=bit macos Makefilews so they can build MT VMs. mvm in
squeak.*.spur dirs now takes a -T arg and builds with -DCOGMTVM=1 in build??mt
to SqueakMT*.app