Vm-dev March 2024

vm-dev@lists.squeakfoundation.org

13 participants
32 discussions

[OpenSmalltalk/opensmalltalk-vm] use --whole-archive option instead of -whole-archive for solaris ld (PR #673)
by dcstes 19 Apr '24

19 Apr '24

I believe that the GNU link editor supports both single hyphen and double hyphen options -whole-archive and --whole-archive However the SUN (Solaris and SunOS and Illumos) link editor uses different names like "-z weakextract" Three is a GNU compatibility layer but the SUN link editor insists for GNU compatibility on the double hyphen format -whole-archive and --no-whole-archive David Stes You can view, comment on, or merge this pull request online at: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/673 -- Commit Summary -- * use --whole-archive option instead of -whole-archive for solaris ld -- File Changes -- M platforms/unix/config/Makefile.in (2) -- Patch Links -- https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/673.patch https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/673.diff -- Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/pull/673 You are receiving this because you are subscribed to this thread. Message ID: <OpenSmalltalk/opensmalltalk-vm/pull/673(a)github.com>

2 4

[OpenSmalltalk/opensmalltalk-vm] primitiveYield (167) interferes with temporal #priority: bumping (Issue #677)
by Marcel Taeumel 03 Apr '24

03 Apr '24

If a process runs alone at its original priority and bumps it higher temporarily, setting it back and yieling **will not** schedule processes above its original priority. Only if there are other processes running on that original (lower) priority. This seems to be an older optimization in `primitiveYield`. Here is an example: ```Smalltalk | flag p1 p2 | flag := Semaphore new. p1 := [ Processor activeProcess priority: 80. Transcript showln: 'P1 started!'. flag signal. "activate p2" Processor activeProcess priority: 45. Processor yield. "fails to schedule p2" Transcript showln: 'P1 finished!'.] newProcess. p1 priority: 45. p2 := [ Transcript showln: 'P2 started!'. flag wait. Transcript showln: 'P2 finished!'. ] newProcess. p2 priority: 50. p2 resume. p1 resume. ``` Expected transcript output: ``` P2 started! P1 started! P2 finished! P1 finished! ``` However, we get: ``` P2 started! P1 started! P1 finished! P2 finished! ``` It is only circumstantial that P2 finishes at all because the *Timer Interrupt Scheduler* (80) will be signaled eventually and then trigger P2 (50) finally. But P1 (45) has finished by then. This is not fair. We can show that it works as expected once another process works on the original priority (45): ```Smalltalk | flag p1 p2 p3 | flag := Semaphore new. p1 := [ p3 resume. Processor activeProcess priority: 80. Transcript showln: 'P1 started!'. flag signal. "activate p2" Processor activeProcess priority: 45. Processor yield. "fails to schedule p2" Transcript showln: 'P1 finished!'.] newProcess. p1 priority: 45. p3 := [ Transcript showln: 'P3 started!'. Transcript showln: 'P3 finished!'. ] newProcess. p3 priority: 45. p2 := [ Transcript showln: 'P2 started!'. flag wait. Transcript showln: 'P2 finished!'. ] newProcess. p2 priority: 50. p2 resume. p1 resume. ``` The output is as expected: ``` P2 started! P1 started! P2 finished! P3 started! P3 finished! P1 finished! ``` By skipping the P3 output, we get the expected order for P1 and P2: ``` P2 started! P1 started! P2 finished! P1 finished! ``` The optimization in `primitiveYield` reads: ```Smalltalk (self isEmptyList: processList) ifTrue: [^nil]. ``` And so `wakeHighestPriority` will not be called in time. But I think we should support temporal priority bumping this way. -- Reply to this email directly or view it on GitHub: https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/677 You are receiving this because you are subscribed to this thread. Message ID: <OpenSmalltalk/opensmalltalk-vm/issues/677(a)github.com>

5 9

MIDI on Mac VM
by Vanessa Freudenberg 30 Mar '24

30 Mar '24

A friend is trying to get this to work – is it supposed to work? > "SimpleMIDIPort primPortCount" evaluates to 0, even when I have a MIDI controller plugged in. And "SimpleMIDIPort openDefault" gives me a primitive failed error. Vanessa

5 5

VM Maker: VMMaker.threaded-LM.3357.mcz
by commits＠source.squeak.org 28 Mar '24

28 Mar '24

Leon Matthes uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.threaded-LM.3357.mcz ==================== Summary ==================== Name: VMMaker.threaded-LM.3357 Author: LM Time: 28 March 2024, 5:22:40.509386 pm UUID: d0e43d64-5f78-4973-9e58-fce4a39677d5 Ancestors: VMMaker.threaded-LM.3356 Very WIP version of the multithreaded VM that fixes several performance issues. Will explain when I get around to cleaning this up. =============== Diff against VMMaker.threaded-LM.3356 =============== Item was changed: ----- Method: CoInterpreterMT class>>initializePrimitiveTable (in category 'initialization') ----- initializePrimitiveTable super initializePrimitiveTable. PrimNumberRelinquishProcessor := 230. COGMTVM ifTrue: [(226 to: 229) do: [:pidx| self assert: (PrimitiveTable at: pidx + 1) = #primitiveFail]. PrimitiveTable at: 226 + 1 put: #primitiveGetOwnerLog; at: 227 + 1 put: #primitiveVMCurrentThreadId; at: 228 + 1 put: #primitiveProcessBoundThreadId; + at: 229 + 1 put: #primitiveProcessBindToThreadAffinity; + at: 190 put: #primitiveLogOwnerSwitch. "UGLY HACK: This is one of the old sound primitives"]! - at: 229 + 1 put: #primitiveProcessBindToThreadAffinity]! 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. 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." + cogThreadManager logOwnerSwitchTo: -5 successful: false. self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSCheckEvents! Item was changed: ----- Method: CoInterpreterMT>>checkForEventsMayContextSwitch: (in category 'process primitive support') ----- checkForEventsMayContextSwitch: mayContextSwitch "Check for possible interrupts and handle one if necessary. Answer if a context switch has occurred." | switched sema now | <inline: false> <var: #now type: #usqLong> self assertSaneThreadAndProcess. cogit assertCStackWellAligned. statCheckForEvents := statCheckForEvents + 1. "restore the stackLimit if it has been smashed." self restoreStackLimit. self externalWriteBackHeadFramePointers. self assert: stackPage = stackPages mostRecentlyUsedPage. "Allow the platform to do anything it needs to do synchronously." self ioSynchronousCheckForEvents. self checkCogCompiledCodeCompactionCalledFor. objectMemory needGCFlag ifTrue: ["sufficientSpaceAfterGC: runs the incremental GC and then, if not enough space is available, the fullGC." (objectMemory sufficientSpaceAfterGC: 0) ifFalse: [self setSignalLowSpaceFlagAndSaveProcess]]. mayContextSwitch ifFalse: [^false]. + + cogThreadManager logOwnerSwitchTo: -3 successful: false. switched := false. - self assert: deferThreadSwitch not. - deferThreadSwitch := true. (profileProcess ~= objectMemory nilObject or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue: [self zeroNextProfileTick. "Take a sample (if not already done so) for the profiler if it is active. This must be done before any of the synchronousSignals below or else we will attribute a pause in ioRelinquishProcessor to the newly activated process." profileProcess = objectMemory nilObject ifTrue: [profileProcess := self activeProcess. profileMethod := objectMemory nilObject]. "and signal the profiler semaphore if it is present" (profileSemaphore ~= objectMemory nilObject and: [self synchronousSignal: profileSemaphore]) ifTrue: [switched := true]]. self cppIf: #LRPCheck ifTrue: [self checkDeliveryOfLongRunningPrimitiveSignal ifTrue: [switched := true]]. objectMemory signalLowSpace ifTrue: [objectMemory signalLowSpace: false. "reset flag" sema := objectMemory splObj: TheLowSpaceSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. "inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't since the platform code may choose to call ioProcessEvents itself in various places." false ifTrue: [((now := self ioUTCMicroseconds) >= nextPollUsecs and: [inIOProcessEvents = 0]) ifTrue: [statIOProcessEvents := statIOProcessEvents + 1. inIOProcessEvents := inIOProcessEvents + 1. self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback" inIOProcessEvents > 0 ifTrue: [inIOProcessEvents := inIOProcessEvents - 1]. nextPollUsecs := now + 20000 "msecs to wait before next call to ioProcessEvents. Note that strictly speaking we might need to update 'now' at this point since ioProcessEvents could take a very long time on some platforms"]] ifFalse: [(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue: [statIOProcessEvents := statIOProcessEvents + 1. self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback" nextPollUsecs := now + 20000 "msecs to wait before next call to ioProcessEvents. Note that strictly speaking we might need to update 'now' at this point since ioProcessEvents could take a very long time on some platforms"]]. interruptPending ifTrue: [interruptPending := false. "reset interrupt flag" sema := objectMemory splObj: TheInterruptSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. nextWakeupUsecs ~= 0 ifTrue: [now >= nextWakeupUsecs ifTrue: [nextWakeupUsecs := 0. "set timer interrupt to 0 for 'no timer'" + cogThreadManager logOwnerSwitchTo: -4 successful: false. sema := objectMemory splObj: TheTimerSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]]. "signal any pending finalizations" pendingFinalizationSignals > 0 ifTrue: [pendingFinalizationSignals := 0. sema := objectMemory splObj: TheFinalizationSemaphore. (sema ~= objectMemory nilObject and: [self synchronousSignal: sema]) ifTrue: [switched := true]]. "signal all semaphores in semaphoresToSignal" self signalExternalSemaphores ifTrue: [switched := true]. - deferThreadSwitch := false. checkThreadActivation ifTrue: [checkThreadActivation := false. self cedeToHigherPriorityThreads]. "N.B. This may not return if we do switch." + cogThreadManager logOwnerSwitchTo: -2 successful: false. + "self threadSwitchIfNecessary: self activeProcess from: CSCheckEvents." - self threadSwitchIfNecessary: self activeProcess from: CSCheckEvents. ^switched! Item was added: + ----- Method: CoInterpreterMT>>primitiveLogOwnerSwitch (in category 'logging primitives') ----- + primitiveLogOwnerSwitch + + | vmOwnerValue | + vmOwnerValue := self stackIntegerValue: 0. + self successful ifFalse: [^ self]. + + cogThreadManager logOwnerSwitchTo: vmOwnerValue successful: false. + self methodReturnReceiver.! 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 := self popProcessWithTemporaryAffinity: vmThread index fromList: (objectMemory splObj: ProcessInExternalCodeTag)]. self assert: (myProc ~= objectMemory nilObject and: [activeProc ~= myProc]). (activeProc ~= objectMemory nilObject and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue: + [|myPriority activePriority| + "If the activeProcess doesn't have a context yet, it needs one from which we can resume later. - ["If the activeProcess doesn't have a context yet, it needs one from which we can resume later. This mostly only happens when a threadSwitchIfNecessary:from: ends up switching to a thread that's CTMUnavailable (this thread). See the comment in threadSwitchIfNecessary:from:" self ensureProcessHasContext: activeProc. + self putToSleep: activeProc yieldingIf: preemptionYields. + "TODO: The active process we just preempted may have a higher priority than we have!!!!!! + So we need to force an interrupt check and force that we actually check that the highest thread is running!! + For now, use an ugly hack!!" + activePriority := self quickFetchInteger: PriorityIndex ofObject: activeProc. + myPriority:= self quickFetchInteger: PriorityIndex ofObject: myProc. + activePriority > myPriority ifTrue: + [nextWakeupUsecs := self ioUTCMicroseconds. + self forceInterruptCheck.]]. - self putToSleep: activeProc yieldingIf: preemptionYields]. objectMemory storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject; storePointer: ActiveProcessIndex ofObject: sched withValue: myProc. self setTemporaryThreadAffinityOfProcess: myProc to: 0. 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. + + self forceInterruptCheck. - self assert: newMethod notNil ! Item was added: + ----- Method: CoInterpreterMT>>returnToExecutive:postContextSwitch: (in category 'as yet unclassified') ----- + returnToExecutive: inInterpreter postContextSwitch: switchedContext + + <inline: false> + switchedContext ifTrue: [self threadSwitchIfNecessary: self activeProcess from: CSSwitchIfNeccessary]. + + ^ super returnToExecutive: inInterpreter postContextSwitch: switchedContext! 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." + self tryToExecuteSmalltalk: vmThread. - 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]. 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 threadSwitchNecessary | 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. threadSwitchNecessary := (activeProcessAffined := newProcThreadAffinity ~= 0) and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcThreadAffinity) not]. threadSwitchNecessary ifFalse: [(self quickFetchInteger: PriorityIndex ofObject: newProc) < self getMaxWaitingPriority ifTrue: [checkThreadActivation := true. self forceInterruptCheck]. "We're done, no thread switch necessary" ^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 }]. "In most cases, we can just switch the thread here, without externalizing the stack pages. If the Processes context is nil, it's state is on the stack. As we're already done context switching, the new thread can just use the interpreter state as-is, without restoring the state from the context. tryToExecuteSmalltalk: already includes a check whether the SuspendedContext is nil. If it is, it leaves the interpreter state alone and just assumes it's correct. This is nice and fast. Otherwise it calls externalSetStackPageAndPointersForSuspendedContextOfProcess: to restore the interpreter state. There is however a special case. When we switch to a thread that is currently CTMUnavailable, that thread will need to restore its process when it tries to own the VM again. The check to restore the context has been moved there (in restoreVMStateFor:andFlags:), so that it only happens in that one case and not every time. In case there are other such special-cases later, adding a call to ensureProcessHasContext: here should fix it." newProcThreadAffinity < 0 ifTrue: [self assert: newProcThreadAffinity negated = cogThreadManager getVMOwner. + vmThread := cogThreadManager ensureUnoccupiedThread. - vmThread := cogThreadManager ensureWillingThread. self deny: vmThread index = cogThreadManager getVMOwner. + self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcThreadAffinity). + self assert: (vmThread vmThreadState = CTMAssignableOrInVM or: [vmThread vmThreadState = CTMInitializing])] - self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcThreadAffinity)] ifFalse: [vmThread := cogThreadManager vmThreadAt: newProcThreadAffinity. vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc). + self flag: 'TODO - This causes issues, the new thread doesn''t know that it needs to check whether there''s a higher-priority process to return to!!'. 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. This is new in the MT VM, and only happens when the primitiveRelinquishProcessor has been preempted. In that case the idle Process is not runnable and there is no Process to return to. By setting the activeProcess to nilObject, any threads woken by the heartbeat don't actually start running Smalltalk. This is then fixed when an AWOL thread comes back and restores its previous state." objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: objectMemory nilObject. cogThreadManager willingVMThread ifNotNil: [:vmThread| vmThread vmThreadState = CTMWantingOwnership ifTrue: [self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: sourceCode]]. "self error: 'scheduler could not find a runnable process'" "relinquishing := true". self returnToSchedulingLoopAndReleaseVMOrWakeThread: nil source: sourceCode]. "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"! - self threadSwitchIfNecessary: newProc from: sourceCode! Item was added: + ----- Method: CogThreadManager>>ensureUnoccupiedThread (in category 'scheduling') ----- + ensureUnoccupiedThread + | unoccupied newIndex | + unoccupied := self unoccupiedVMThread. + unoccupied ifNotNil: + [^unoccupied]. + 1 to: numThreads do: + [:index| + (self vmThreadAt: index) vmThreadState = CTMUninitialized ifTrue: + [self startThreadForThreadIndex: index. + ^self vmThreadAt: index]]. + self startThreadForThreadIndex: (newIndex := numThreads + 1). + ^self vmThreadAt: newIndex! Item was changed: ----- 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 ensureUnoccupiedThread. - willingThread := self ensureWillingThread. willingThread ifNotNil: [self returnToSchedulingLoopAndReleaseVMOrWakeThread: willingThread source: sourceIndex]]! Item was added: + ----- Method: CogThreadManager>>unoccupiedVMThread (in category 'thread set') ----- + unoccupiedVMThread + + "Answer a pointer to a live CogVMThread in an unoccupied state, + (other than the current owner if the VM is owned), or nil if none. + Specifically, do not answer any threads that actively want ownership. + Those have other work to do, so can't take over whatever it is we want to do right now." + <returnTypeC: #'CogVMThread *'> + <inline: false> + 1 to: numThreads do: + [:i| + (self vmOwnerIs: i) ifFalse: + [| thread | + thread := threads at: i. + thread vmThreadState = CTMAssignableOrInVM ifTrue: + [^ thread]]]. + ^ nil! 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: [(threadWantingVM isNil or: [threadWantingVM priority < thread priority]) ifTrue: [threadWantingVM := thread]]. thread vmThreadState = CTMAssignableOrInVM ifTrue: + "Threads that want ownership always have precedence over threads + that are simply assignable. The priority is only valid if the thread is + in the WantingOwnership state." + [threadWilling isNil ifTrue: - [(threadWilling isNil - or: [threadWilling priority < thread priority]) ifTrue: [threadWilling := thread]]]]. ^threadWantingVM ifNil: [threadWilling]! Item was added: + ----- Method: SpurMemoryManager>>printNewSpaceOops (in category 'debug printing') ----- + printNewSpaceOops + "useful for VM debugging" + <public> + <inline: false> + self allNewSpaceObjectsDo: [:objOop | coInterpreter shortPrintOop: objOop]! Item was changed: ----- Method: SqueakSSLPlugin>>primitiveCreate (in category 'primitives') ----- primitiveCreate "Primitive. Creates a new SSL session and returns its handle." + | handle vmHandle | - | handle | <export: true> interpreterProxy methodArgumentCount = 0 ifFalse:[^interpreterProxy primitiveFail]. + + vmHandle := interpreterProxy disownVM: DisownVMForThreading. handle := self cCode: 'sqCreateSSL()' inSmalltalk:[0]. + interpreterProxy ownVM: vmHandle. + handle = 0 ifTrue:[^interpreterProxy primitiveFail]. interpreterProxy pop: interpreterProxy methodArgumentCount+1. interpreterProxy pushInteger: handle. ! Item was changed: ----- Method: SqueakSSLPlugin>>primitiveDestroy (in category 'primitives') ----- primitiveDestroy "Primitive. Destroys an SSL session." + | handle result vmHandle | - | handle result | <export: true> interpreterProxy methodArgumentCount = 1 ifFalse:[^interpreterProxy primitiveFail]. handle := interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue:[^nil]. + + vmHandle := interpreterProxy disownVM: DisownVMForThreading. result := self cCode: 'sqDestroySSL(handle)' inSmalltalk:[handle. 0]. + interpreterProxy ownVM: vmHandle. + result = 0 ifTrue:[^interpreterProxy primitiveFail]. interpreterProxy pop: interpreterProxy methodArgumentCount. !

1 0

VM Maker: VMMaker.oscog-eem.3357.mcz
by commits＠source.squeak.org 26 Mar '24

26 Mar '24

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3357.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3357 Author: eem Time: 26 March 2024, 12:49:10.503904 pm UUID: 576f7ca7-be48-4c44-a578-9507029c4f49 Ancestors: VMMaker.oscog-eem.3356 Integrate VMMaker.threaded-LM.3344 through 3356. VMMaker.threaded-LM.3356 Author: LM (Leon Matthes) Time: 21 March 2024, 10:41:55 am Optimize threadSwitchIfNecessary:from: We only really need to marry the context when we pass the interpreter to a thread that schedules in its own process. Otherwise the thread can just take over the interpreter as-is. VMMaker.threaded-LM.3355 Time: 20 March 2024, 3:45:46 pm Fix a critical bug in threadSwitchIfNecessary:from: . If the activeProcess context was nil, it wasn't restored correctly. This has been fixed now. This has a problem though, as we need to marry the activeProcess context every time we do a thread switch, this can cause a lot of GCs, as we create a lot of context objects. Maybe we can fix this later? VMMaker.threaded-LM.3354 Time: 19 March 2024, 2:33:25 pm Increase Owner Log to 1Mi entries. Some small additional adjustments VMMaker.threaded-LM.3353 Time: 21 December 2023, 4:24:17 pm Do not make primitives pin themselves, rather check for pinned arguments as a condition for disowning. Also: Increase size of VM Owner Log to 100Ki entries. TODO: Make VMOwnerLog optional for release builds. VMMaker.threaded-LM.3352 Time: 11 December 2023, 6:49:53 pm Fix a critical issue that caused duplicate threads to be spawned. Binding two processes (or the same process twice) to the same thread caused it to spawn two threads for the same CogVMThread, which of course caused critical errors as both threads might think they were in fact the vm owner, which caused all kinds of issues. VMMaker.threaded-LM.3351 Time: 11 December 2023, 5:15:46 pm Use Micro instead of milli-seconds for logging VM owner switches VMMaker.threaded-LM.3350 Time: 11 December 2023, 5:12:31 pm Make sure the InterpreterProxy and friends follow the new ownVM/disownVM API. VMMaker.threaded-LM.3349 Time: 6 December 2023, 11:29:35 am Log VM owner switches and add primitive to query the log. VMMaker.threaded-LM.3348 Time: 23 November 2023, 5:07:58 pm Fix VMProfileLinuxSupportPlugin>>#primitiveExectuableModules 64-bit linux handles the linux-gate.so.1 differently which lead to memory-corruption due to the primitive expecting to filter out a single item. VMMaker.threaded-LM.3347 Time: 21 November 2023, 7:55:00 pm Add argument to ownVM to provide custom flags. Required for FFI callout flag when an exception occurs. VMMaker.threaded-LM.3346 Time: 14 November 2023, 4:11:25 pm Refactor pop operation to immediately remove MyList. VMMaker.threaded-LM.3345 Time: 14 November 2023, 1:59:11 pm No longer use the list of awol processes within CogVMThread. awol processes are now stored in the ProcessInExternalCodeTag. Also do some refactorings to get threadAffinity and temporaryThreadAffinity in line. VMMaker.threaded-LM.3344 Time: 9 November 2023, 5:33:02 pm Fix multiple issues with process switching 1. Processes became re-activated when suspended 2. AWOL processes were garbage-collected 3. AWOL processes were stored in the CogVMThread itself, causing realloc to move the CogVMThread struct. This invalidated the previously created pointers, including the handles returned from disownVM! =============== Diff against VMMaker.oscog-eem.3356 =============== Item was added: + ----- Method: AtomicValue>>+ (in category 'as yet unclassified') ----- + + aValue + + ^ self value + aValue.! Item was changed: ----- Method: CoInterpreterMT class>>ancilliaryClasses (in category 'translation') ----- ancilliaryClasses "Answer any extra classes to be included in the translation." + ^super ancilliaryClasses, { CogThreadManager. CogVMThread . CogVMOwnerLog }! - ^super ancilliaryClasses, { CogThreadManager. CogVMThread }! Item was changed: ----- Method: CoInterpreterMT class>>initializePrimitiveTable (in category 'initialization') ----- initializePrimitiveTable super initializePrimitiveTable. PrimNumberRelinquishProcessor := 230. COGMTVM ifTrue: + [(226 to: 229) do: - [(227 to: 229) do: [:pidx| self assert: (PrimitiveTable at: pidx + 1) = #primitiveFail]. PrimitiveTable + at: 226 + 1 put: #primitiveGetOwnerLog; at: 227 + 1 put: #primitiveVMCurrentThreadId; at: 228 + 1 put: #primitiveProcessBoundThreadId; + at: 229 + 1 put: #primitiveProcessBindToThreadAffinity]! - at: 229 + 1 put: #primitiveProcessBindToThreadId]! Item was removed: - ----- Method: CoInterpreterMT>>affinedThreadId: (in category 'process primitive support') ----- - affinedThreadId: threadIdField - "Answer the threadId of the thread threadIdField is temporarily bound to, or 0 if none." - ^(objectMemory isIntegerObject: threadIdField) - ifTrue: [(objectMemory integerValueOf: threadIdField) anyMask: 1 << ThreadIdShift - 1] - ifFalse: [0]! Item was added: + ----- Method: CoInterpreterMT>>bindProcess:toAffinity: (in category 'process primitive support') ----- + bindProcess: aProcess toAffinity: newAffinity + "Change a Process's thread binding and answer 0, otherwise answer a suitable error code. + Cases: + process is unbound & unaffined + affinity 0 nothing to do + affinity non-zero ensure thread and bind + process is affined (temporarily bound to a thread for the duration of a surrender of ownership) + affinity = affined index nothing to do + affinity = 0 nothing to do + affinity ~= 0 && affinity ~= affined index fail + process is bound (permanently bound to a thread) + affinity = bound index nothing to do + affinity ~= bound index set bound index" + | threadIdField currentAffinity temporaryAffinity | + processHasThreadAffinity ifFalse: + [^PrimErrUnsupported]. + + threadIdField := self threadAffinityFieldOf: aProcess. + currentAffinity := self threadAffinityOfThreadID: threadIdField. + temporaryAffinity := self temporaryAffinedThreadId: threadIdField. + + "If aProcess is affined (temporarily bound to) a thread then the operation can only + succeed if the newId is the same as that aProcess is affined to, or is zero (is unbinding)." + (self isTemporaryAffinedThreadId: threadIdField) ifTrue: + [(newAffinity = 0 or: [newAffinity = temporaryAffinity]) ifFalse: + [^PrimErrInappropriate]]. + + currentAffinity > 0 ifTrue: + [(self startThreadForThreadIndex: currentAffinity) ifFalse: + [^PrimErrLimitExceeded]]. + + self setThreadIdFieldOfProcess: aProcess toAffinity: newAffinity andTemporaryAffinity: temporaryAffinity. + ^nil! Item was removed: - ----- Method: CoInterpreterMT>>bindProcess:toId: (in category 'process primitive support') ----- - bindProcess: aProcess toId: newId - "Change a Process's thread binding and answer 0, otherwise answer a suitable error code. - Cases: - process is unbound & unaffined - affinity 0 nothing to do - affinity non-zero ensure thread and bind - process is affined (temporarily bound to a thread for the duration of a surrender of ownership) - affinity = affined index nothing to do - affinity = 0 nothing to do - affinity ~= 0 && affinity ~= affined index fail - process is bound (permanently bound to a thread) - affinity = bound index nothing to do - affinity ~= bound index set bound index" - | threadIdField ownerIndex affinedId | - processHasThreadAffinity ifFalse: - [^PrimErrUnsupported]. - - threadIdField := self threadAffinityFieldOf: aProcess. - ownerIndex := self ownerIndexOfThreadId: threadIdField. - - "If aProcess is affined (temporarily bound to) a thread then the operation can only - succeed if the newId is the same as that aProcess is affined to, or is zero (is unbinding)." - (self isAffinedThreadId: threadIdField) ifTrue: - [affinedId := self affinedThreadId: threadIdField. - (newId = 0 - or: [newId = affinedId]) ifTrue: - [self setThreadIdFieldOfProcess: aProcess to: newId << ThreadIdShift + affinedId. - ^nil]. - ^PrimErrInappropriate]. - - ownerIndex > 0 ifTrue: - [(self startThreadForThreadIndex: ownerIndex) ifFalse: - [^PrimErrLimitExceeded]]. - - self setThreadIdFieldOfProcess: aProcess to: newId << ThreadIdShift. - ^nil! Item was added: + ----- Method: CoInterpreterMT>>ensureProcessHasContext: (in category 'vm scheduling') ----- + ensureProcessHasContext: aProcess + + | activeContext | + (objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess) = objectMemory nilObject ifTrue: + [self assert: aProcess = self activeProcess. + "The instructionPointer is popped from the stack in 'externalSetStackPageAndPointersForSuspendedContextOfProcess:' " + self push: instructionPointer. + "We at least need to externalize the stack pointers to enable a thread switch..." + self externalWriteBackHeadFramePointers. + activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. + objectMemory storePointer: SuspendedContextIndex ofObject: aProcess withValue: activeContext].! Item was removed: - ----- Method: CoInterpreterMT>>isAffinedProcess: (in category 'process primitive support') ----- - isAffinedProcess: aProcess - ^self isAffinedThreadId: (self threadAffinityFieldValueOf: aProcess)! Item was removed: - ----- Method: CoInterpreterMT>>isAffinedThreadId: (in category 'process primitive support') ----- - isAffinedThreadId: threadIdField - "Answer if the threadId has the bits set indicating the thread it is temporarily bound to." - ^(self affinedThreadId: threadIdField) ~= 0! Item was added: + ----- Method: CoInterpreterMT>>isTemporaryAffinedProcess: (in category 'process primitive support') ----- + isTemporaryAffinedProcess: aProcess + ^self isTemporaryAffinedThreadId: (self threadAffinityFieldValueOf: aProcess)! Item was added: + ----- Method: CoInterpreterMT>>isTemporaryAffinedThreadId: (in category 'process primitive support') ----- + isTemporaryAffinedThreadId: threadIdField + "Answer if the threadId has the bits set indicating the thread it is temporarily bound to." + ^(self temporaryAffinedThreadId: threadIdField) ~= 0! Item was changed: ----- Method: CoInterpreterMT>>loadInitialContext (in category 'initialization') ----- loadInitialContext + | activeProc threadAffinity | - | activeProc | super loadInitialContext. activeProc := self activeProcess. + threadAffinity := self threadAffinityOfProcess: activeProc. + + self assert: (threadAffinity = 0 or: [threadAffinity = 1]). + self cCode: [] inSmalltalk: [self flag: #todoMT "Ensure we cannot save an image, where the 'activeProc' is affined to another thread!!"]. + + activeProcessAffined := threadAffinity ~= 0! - self assert: (self threadAffinityOfProcess: activeProc) = 0. - activeProcessAffined := (self threadAffinityOfProcess: activeProc) ~= 0! Item was changed: ----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') ----- ownVM: vmThreadHandle <public> <inline: false> <var: #vmThreadHandle type: #'void *'> + ^ self ownVM: vmThreadHandle withFlags: 0! - <var: #vmThread type: #'CogVMThread *'> - "This is the entry-point for plugins and primitives that wish to reacquire the VM after having - released it via disownVM or callbacks that want to acquire it without knowing their ownership - status. This call will block until the VM is owned by the current thread or an error occurs. - The argument should be the value answered by disownVM, or 0 for callbacks that don't know - if they have disowned or not. This is both an optimization to avoid having to query thread- - local storage for the current thread's index (since it can easily keep it in some local variable), - and a record of when an unbound process becomes affined to a thread for the dynamic - extent of some operation. - - Answer 0 if the current thread is known to the VM (and on return owns the VM). - Answer 1 if the current thread is unknown to the VM and takes ownership. - Answer -1 if the current thread is unknown to the VM and fails to take ownership." - | flags vmThread | - vmThread := self cCoerce: vmThreadHandle to: #'CogVMThread *'. - vmThread ifNil: - [^self ownVMFromUnidentifiedThread]. - - flags := vmThread disownFlags. - - (flags anyMask: DisownVMForProcessorRelinquish) 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." - relinquishing := false. - self sqLowLevelMFence]. - - vmThread := cogThreadManager acquireVMFor: vmThread. - disownCount := disownCount - 1. - - disowningVMThread ifNotNil: - [vmThread = disowningVMThread ifTrue: - [self assert: (vmThread cFramePointer isNil - or: [CFramePointer = vmThread cFramePointer and: [CStackPointer = vmThread cStackPointer]]). - self assert: self successful. - self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. - disowningVMThread := nil. - cogit recordEventTrace ifTrue: - [self recordTrace: TraceOwnVM thing: ConstOne source: 0]. - ^0]. "if not preempted we're done." - self preemptDisowningThread]. - - "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." - self restoreVMStateFor: vmThread andFlags: flags. - - cogit recordEventTrace ifTrue: - [self recordTrace: TraceOwnVM thing: ConstTwo source: 0]. - ^flags bitAnd: OwnVMForeignThreadFlag! Item was added: + ----- Method: CoInterpreterMT>>ownVM:withFlags: (in category 'vm scheduling') ----- + ownVM: vmThreadHandle withFlags: additionalFlags + <public> + <inline: false> + <var: #vmThreadHandle type: #'void *'> + <var: #vmThread type: #'CogVMThread *'> + "This is the entry-point for plugins and primitives that wish to reacquire the VM after having + released it via disownVM or callbacks that want to acquire it without knowing their ownership + status. This call will block until the VM is owned by the current thread or an error occurs. + The argument should be the value answered by disownVM, or 0 for callbacks that don't know + if they have disowned or not. This is both an optimization to avoid having to query thread- + local storage for the current thread's index (since it can easily keep it in some local variable), + and a record of when an unbound process becomes affined to a thread for the dynamic + extent of some operation. + + Answer 0 if the current thread is known to the VM (and on return owns the VM). + Answer 1 if the current thread is unknown to the VM and takes ownership. + Answer -1 if the current thread is unknown to the VM and fails to take ownership." + | flags vmThread | + vmThread := self cCoerce: vmThreadHandle to: #'CogVMThread *'. + vmThread ifNil: + [^self ownVMFromUnidentifiedThread]. + + self assert: vmThread = (cogThreadManager vmThreadAt: vmThread index). + + flags := vmThread disownFlags bitOr: additionalFlags. + + vmThread := cogThreadManager acquireVMFor: vmThread. + disownCount := disownCount - 1. + + (flags anyMask: DisownVMForProcessorRelinquish) 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." + relinquishing := false. + self sqLowLevelMFence]. + + disowningVMThread ifNotNil: + [vmThread = disowningVMThread ifTrue: + [self assert: (vmThread cFramePointer isNil + or: [CFramePointer = vmThread cFramePointer and: [CStackPointer = vmThread cStackPointer]]). + self assert: self successful. + self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. + disowningVMThread := nil. + cogit recordEventTrace ifTrue: + [self recordTrace: TraceOwnVM thing: ConstOne source: 0]. + ^0]. "if not preempted we're done." + self preemptDisowningThread]. + + "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." + self restoreVMStateFor: vmThread andFlags: flags. + + cogit recordEventTrace ifTrue: + [self recordTrace: TraceOwnVM thing: ConstTwo source: 0]. + ^flags bitAnd: OwnVMForeignThreadFlag! Item was removed: - ----- Method: CoInterpreterMT>>ownerIndexOfThreadId: (in category 'process primitive support') ----- - ownerIndexOfThreadId: threadId - ^(objectMemory isIntegerObject: threadId) - ifTrue: ["We need a signed shift here (>>>), as otherwise we lose the sign of the threadId." - (objectMemory integerValueOf: threadId) >>> ThreadIdShift] - ifFalse: [0]! Item was added: + ----- Method: CoInterpreterMT>>popProcessWithTemporaryAffinity:fromList: (in category 'process primitive support') ----- + popProcessWithTemporaryAffinity: anAffinity fromList: aList + "Find the first process from the list that is temporarily affined to the given affinity. + Remove this process from the list and return it. + This is used by the preempt/restore flow to find the process that is to be restored." + | firstLink lastLink nextLink tempLink theProcess | + self assert: (anAffinity ~= 0). + self deny: (objectMemory isForwarded: aList). + "any process on the list could have been becomed, so use a read barrier..." + firstLink := objectMemory followField: FirstLinkIndex ofObject: aList. + lastLink := objectMemory followField: LastLinkIndex ofObject: aList. + "fail if any link doesn't look like a process..." + ((objectMemory isPointers: firstLink) + and: [(objectMemory numSlotsOf: firstLink) > MyListIndex]) ifFalse: + [^ objectMemory nilObject]. + + (firstLink ~= objectMemory nilObject and: [(self temporaryAffinityOfProcess: firstLink) = anAffinity]) + ifTrue: + [theProcess := firstLink. + nextLink := objectMemory followField: NextLinkIndex ofObject: firstLink. + objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink. + firstLink = lastLink ifTrue: + [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]] + ifFalse: + [tempLink := firstLink. + [ + nextLink := objectMemory followField: NextLinkIndex ofObject: tempLink. + "fail if any link doesn't look like a process..." + ((objectMemory isPointers: nextLink) + and: [(objectMemory numSlotsOf: nextLink) > MyListIndex]) ifFalse: + [^ objectMemory nilObject]. + (self temporaryAffinityOfProcess: nextLink) = anAffinity] + whileFalse: [tempLink := nextLink]. + + theProcess := nextLink. + nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: nextLink. + objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink. + theProcess = lastLink ifTrue: + [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]]. + objectMemory + storePointerUnchecked: NextLinkIndex ofObject: theProcess withValue: objectMemory nilObject; + storePointerUnchecked: MyListIndex ofObject: theProcess withValue: objectMemory nilObject. + ^ theProcess! 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 := disowningVMThread. - preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread. disowningVMThread := nil. + + "Store the process in the ProcessInExternalCodeTag special object (a LinkedList). + This ensures: + - The process isn't garbage collected + - If the process is moved due to GC, we can still find it + - The process is available from inside the image + On restore we can use the temporaryThreadAffinity to find the last process that was disowned from the preempted thread. + This therefore creates a LIFO stack for each thread which are all interleaved in this one list." + self assert: (self isTemporaryAffinedProcess: activeProc) not. + self setTemporaryThreadAffinityOfProcess: activeProc to: preemptedThread index. + self addFirstLink: activeProc toList: (objectMemory splObj: ProcessInExternalCodeTag). + - (self threadAffinityOfProcess: activeProc) = 0 ifTrue: - [self setTemporaryThreadAffinityOfProcess: activeProc to: preemptedThread index bind: false]. preemptedThread newMethodOrNull: newMethod; argumentCount: argumentCount; inMachineCode: instructionPointer <= objectMemory startOfMemory! Item was added: + ----- Method: CoInterpreterMT>>primitiveGetOwnerLog (in category 'logging primitives') ----- + primitiveGetOwnerLog + "Write the owner log to the given ByteArray. + All members of the owner log struct are always written as defined by the C struct. + Return the number of instances of CogVMOwnerLog written into the ByteArray." + | logBuffer bufferPointer bytesCopied | + <export: true> + <var: #bufferPointer type: #'char *'> + argumentCount ~= 1 + ifTrue: [^ self primitiveFailFor: PrimErrBadNumArgs]. + + logBuffer := self stackTop. + ((objectMemory isNonImmediate: logBuffer) + and: [(objectMemory isPureBitsNonImm: logBuffer) + and: [(objectMemory numBytesOf: logBuffer) >= (OwnerLogSize * (self sizeof: CogVMOwnerLog))]]) + ifFalse: [^ self primitiveFailFor: PrimErrBadArgument]. + + bufferPointer := (self objectMemory firstFixedField: logBuffer). + bytesCopied := cogThreadManager copyLogTo: bufferPointer. + + self pop: argumentCount + 1 thenPushInteger: bytesCopied / (self sizeof: CogVMOwnerLog). + ! Item was added: + ----- Method: CoInterpreterMT>>primitiveProcessBindToThreadAffinity (in category 'process primitives') ----- + primitiveProcessBindToThreadAffinity + "Attempt to bind the receiver to the thread affinity of the argument or nil, where the receiver is a Process. + The thread affinity may be an integer where: + 0 - means no thread affinity, the process is free to run on any thread. + > 0 - positive values mean the process has to run on the thread with this specific index. + < 0 - negative values mean the process may run on on any thread **APART** from the thread + with the absolute value of the index. + + Usually values of 1, -1 and 0 are used. + Thread number 1 is the thread the VM started with. On some OSes this thread has special priviliges. + I.e. on macOS only thread 1 can make draw calls. + Therefore it is mostly important whether a thread must run on thread 1, must **not** run on thread 1 + or whether it doesn't care. + + If successful the VM will ensure that there is at least one compatible thread active." + | aProcess affinity waitingPriority activePriority | + <export: true> + self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]]. + processHasThreadAffinity ifFalse: + [^self primitiveFailFor: PrimErrUnsupported]. + affinity := self stackTop. + aProcess := self stackValue: 1. + ((affinity = objectMemory nilObject or: [(objectMemory isIntegerObject: affinity) + and: [affinity ~= (objectMemory integerObjectOf: 0)]]) + and: [(objectMemory isPointers: aProcess) + and: [(objectMemory slotSizeOf: aProcess) >= (ThreadIdIndex + 1)]]) ifFalse: + [^self primitiveFailFor: PrimErrBadArgument]. + affinity := affinity = objectMemory nilObject ifTrue: [0] ifFalse: [objectMemory integerValueOf: affinity]. + affinity abs >= cogThreadManager maxNumThreads ifTrue: + [^self primitiveFailFor: PrimErrLimitExceeded]. + + (self bindProcess: aProcess toAffinity: affinity) ifNotNil: + [:ec| ^self primitiveFailFor: ec]. + self methodReturnReceiver. + + waitingPriority := self getMaxWaitingPriority. + activePriority := self quickFetchInteger: PriorityIndex ofObject: aProcess. + affinity := self threadAffinityOfProcess: aProcess. + (aProcess = self activeProcess + and: [(activeProcessAffined := affinity ~= 0) + and: [(cogThreadManager vmOwnerIsCompatibleWith: affinity) not]]) ifTrue: + [activePriority < waitingPriority ifTrue: + [self reduceWaitingPriorityFrom: waitingPriority to: activePriority "TODO: Check if this is correct?"]. + self threadSwitchIfNecessary: aProcess from: CSThreadBind]! Item was removed: - ----- 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. - (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>>reduceWaitingPriorityFrom:to: (in category 'accessing') ----- reduceWaitingPriorityFrom: existingWaitingPriority to: newMaxPriority <var: #existing type: #int> | existing | self cCode: [existing := existingWaitingPriority] + inSmalltalk: [existing := AtomicValue newFrom: existingWaitingPriority.]. - inSmalltalk: [existing := AtomicValue new. - existing value: existingWaitingPriority.]. "This CPXCHG may fail, that's fine though, as there may have been another thread that increased the priority in the meantime. In that case that threads priority is the correct one to use." ^ self atomic: (self addressOf: maxWaitingPriority) _compare: (self addressOf: existing) _exchange_strong: newMaxPriority! Item was added: + ----- Method: CoInterpreterMT>>removeFirstProcessWithTemporaryAffinity:fromList: (in category 'process primitive support') ----- + removeFirstProcessWithTemporaryAffinity: anAffinity fromList: aList + + "Find the first process from the list that is temporarily affined to the given affinity. + Remove this process from the list and return it. + This is used by the preempt/restore flow to find the process that is to be restored." + | firstLink lastLink nextLink tempLink theProcess | + self assert: (anAffinity ~= 0). + self deny: (objectMemory isForwarded: aList). + "any process on the list could have been becomed, so use a read barrier..." + firstLink := objectMemory followField: FirstLinkIndex ofObject: aList. + lastLink := objectMemory followField: LastLinkIndex ofObject: aList. + (firstLink ~= objectMemory nilObject and: [(self temporaryAffinityOfProcess: firstLink) = anAffinity]) + ifTrue: + [theProcess := firstLink. + nextLink := objectMemory followField: NextLinkIndex ofObject: firstLink. + objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink. + firstLink = lastLink ifTrue: + [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]] + ifFalse: + [tempLink := firstLink. + ["fail if any link doesn't look like a process..." + ((objectMemory isPointers: tempLink) + and: [(objectMemory numSlotsOf: tempLink) > MyListIndex]) ifFalse: + [^false]. + nextLink := objectMemory followField: NextLinkIndex ofObject: tempLink. + nextLink ~= objectMemory nilObject and: [(self temporaryAffinityOfProcess: nextLink) = anAffinity]] + whileFalse: [tempLink := nextLink]. + + nextLink = objectMemory nilObject ifTrue: [^ false]. + + theProcess := nextLink. + nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: nextLink. + objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink. + theProcess = lastLink ifTrue: + [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]]. + objectMemory storePointerUnchecked: NextLinkIndex ofObject: theProcess withValue: objectMemory nilObject. + ^true! 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 := self popProcessWithTemporaryAffinity: vmThread index fromList: (objectMemory splObj: ProcessInExternalCodeTag)]. + + self assert: (myProc ~= objectMemory nilObject and: [activeProc ~= myProc]). - ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread]. - self assert: activeProc ~= myProc. (activeProc ~= objectMemory nilObject and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue: + ["If the activeProcess doesn't have a context yet, it needs one from which we can resume later. + This mostly only happens when a threadSwitchIfNecessary:from: ends up switching to a thread that's CTMUnavailable (this thread). + See the comment in threadSwitchIfNecessary:from:" + self ensureProcessHasContext: activeProc. + self putToSleep: activeProc yieldingIf: preemptionYields]. + - [self putToSleep: activeProc yieldingIf: preemptionYields]. - self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag). objectMemory + storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject; + storePointer: ActiveProcessIndex ofObject: sched withValue: myProc. + + self setTemporaryThreadAffinityOfProcess: myProc to: 0. - 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 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 added: + ----- Method: CoInterpreterMT>>setTemporaryThreadAffinityOfProcess:to: (in category 'process primitive support') ----- + setTemporaryThreadAffinityOfProcess: aProcess to: anIndex + "When a thread is disowned for threading, it will temporarily affine the process to itself. + Therefore we can make sure no one else accidentally tries to re-bind the process whilst it is AWOL." + | threadAffinity | + threadAffinity := self threadAffinityOfProcess: aProcess. + self setThreadIdFieldOfProcess: aProcess toAffinity: threadAffinity andTemporaryAffinity: anIndex.! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: CoInterpreterMT>>setThreadIdFieldOfProcess:to: (in category 'process primitive support') ----- - setThreadIdFieldOfProcess: aProcess to: threadIdField - | threadIdSlot | - threadIdSlot := threadIdField = 0 - ifTrue: [objectMemory nilObject] - ifFalse: [objectMemory integerObjectOf: threadIdField]. - objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadIdSlot! Item was added: + ----- Method: CoInterpreterMT>>setThreadIdFieldOfProcess:toAffinity:andTemporaryAffinity: (in category 'process primitive support') ----- + setThreadIdFieldOfProcess: aProcess toAffinity: threadAffinity andTemporaryAffinity: anIndex + | threadIdSlot bits | + self assert: anIndex >= 0. + self assert: anIndex <= cogThreadManager maxNumThreads. + self assert: threadAffinity >= cogThreadManager maxNumThreads negated. + self assert: threadAffinity <= cogThreadManager maxNumThreads. + + anIndex > 0 ifTrue: [self assert: (cogThreadManager threadIndex: anIndex isCompatibleWith: threadAffinity)]. + + bits := threadAffinity << ThreadIdShift + anIndex. + + threadIdSlot := bits = 0 + ifTrue: [objectMemory nilObject] + ifFalse: [objectMemory integerObjectOf: bits]. + objectMemory storePointerUnchecked: ThreadIdIndex ofObject: aProcess withValue: threadIdSlot! Item was added: + ----- Method: CoInterpreterMT>>temporaryAffinedThreadId: (in category 'process primitive support') ----- + temporaryAffinedThreadId: threadIdField + "Answer the threadId of the thread threadIdField is temporarily bound to, or 0 if none." + ^(objectMemory isIntegerObject: threadIdField) + ifTrue: [(objectMemory integerValueOf: threadIdField) bitAnd: 1 << ThreadIdShift - 1] + ifFalse: [0]! Item was added: + ----- Method: CoInterpreterMT>>temporaryAffinityOfProcess: (in category 'process primitive support') ----- + temporaryAffinityOfProcess: aProcess + <inline: false> "useful for debugging so don't inline" + "Answer the threadId of the thread threadIdField is temporarily bound to, or 0 if none." + ^ self temporaryAffinedThreadId: (self threadAffinityFieldOf: aProcess)! Item was changed: ----- Method: CoInterpreterMT>>threadAffinityFieldValueOf: (in category 'process primitive support') ----- threadAffinityFieldValueOf: aProcess + <inline: false> "Should not be inlined, as it's useful for debugging." ^processHasThreadAffinity ifTrue: [| field | field := objectMemory fetchPointer: ThreadIdIndex ofObject: aProcess. field = objectMemory nilObject ifTrue: [0] ifFalse: [objectMemory integerValueOf: field]] ifFalse: [0]! Item was changed: ----- Method: CoInterpreterMT>>threadAffinityOfProcess: (in category 'process primitive support') ----- threadAffinityOfProcess: aProcess + <inline: false> + "useful for debugging, so don't inline" + ^self threadAffinityOfThreadID: (self threadAffinityFieldOf: aProcess)! - ^self ownerIndexOfThreadId: (self threadAffinityFieldOf: aProcess)! Item was added: + ----- Method: CoInterpreterMT>>threadAffinityOfThreadID: (in category 'process primitive support') ----- + threadAffinityOfThreadID: threadId + ^(objectMemory isIntegerObject: threadId) + ifTrue: ["We need a signed shift here (>>>), as otherwise we lose the sign of the threadId." + (objectMemory integerValueOf: threadId) >>> ThreadIdShift] + ifFalse: [0]! 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 threadSwitchNecessary | - | newProcThreadAffinity 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. + threadSwitchNecessary := (activeProcessAffined := newProcThreadAffinity ~= 0) + and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcThreadAffinity) not]. + threadSwitchNecessary ifFalse: - ((activeProcessAffined := newProcThreadAffinity ~= 0) - and: [(cogThreadManager vmOwnerIsCompatibleWith: newProcThreadAffinity) not]) ifFalse: [(self quickFetchInteger: PriorityIndex ofObject: newProc) < self getMaxWaitingPriority ifTrue: [checkThreadActivation := true. self forceInterruptCheck]. + "We're done, no thread switch necessary" ^self]. "The current process is affined to a thread, but not to the current owner. So switch to that owner." + self cCode: [] inSmalltalk: - self cCode: '' inSmalltalk: [transcript ensureCr; f: 'threadSwitchIfNecessary: %08x from: %s(%d) owner %d -> %d\n' printf: { newProc. TraceSources at: sourceCode. sourceCode. cogThreadManager getVMOwner. newProcThreadAffinity }]. + "In most cases, we can just switch the thread here, without externalizing the stack pages. + If the Processes context is nil, it's state is on the stack. As we're already done context switching, + the new thread can just use the interpreter state as-is, without restoring the state from the context. + + tryToExecuteSmalltalk: already includes a check whether the SuspendedContext is nil. + If it is, it leaves the interpreter state alone and just assumes it's correct. + This is nice and fast. + Otherwise it calls externalSetStackPageAndPointersForSuspendedContextOfProcess: to restore the interpreter state. + + There is however a special case. When we switch to a thread that is currently CTMUnavailable, that thread will need + to restore its process when it tries to own the VM again. + The check to restore the context has been moved there (in restoreVMStateFor:andFlags:), so that it only happens in + that one case and not every time. + In case there are other such special-cases later, adding a call to ensureProcessHasContext: here should fix it." - "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 ifTrue: [self assert: newProcThreadAffinity negated = cogThreadManager getVMOwner. vmThread := cogThreadManager ensureWillingThread. self deny: vmThread index = cogThreadManager getVMOwner. self assert: (cogThreadManager threadIndex: vmThread index isCompatibleWith: newProcThreadAffinity)] ifFalse: [vmThread := cogThreadManager vmThreadAt: newProcThreadAffinity. 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. This + is new in the MT VM, and only happens when the primitiveRelinquishProcessor has been + preempted. In that case the idle Process is not runnable and there is no Process to return to. + By setting the activeProcess to nilObject, any threads woken by the heartbeat don't actually + start running Smalltalk. This is then fixed when an AWOL thread comes back and restores its + previous state." + objectMemory + storePointer: ActiveProcessIndex ofObject: sched withValue: objectMemory nilObject. + - 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'" + "relinquishing := true". + self returnToSchedulingLoopAndReleaseVMOrWakeThread: nil source: sourceCode]. - self returnToSchedulingLoopAndReleaseVMOrWakeThread: nil source: sourceCode]. "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 | self assert: (cogThreadManager vmOwnerIs: vmThread index). self assert: cogThreadManager ioGetThreadLocalThreadIndex = vmThread index. 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]. + "There is a special case here. + When the VM has relinquished, but then another thread finishes external code execution, there may no longer be a process to run. + However, the relinquishing flag may already have been reset by another thread that has owned the VM again." + activeProc = objectMemory nilObject + ifTrue: ["self warning: 'tryToExecuteSmalltalk: no active process!!'." + "relinquishing := true". + ^nil]. - activeProc = objectMemory nilObject ifTrue:[^nil]. threadAffinity := self threadAffinityOfProcess: activeProc. (cogThreadManager vmOwnerIsCompatibleWith: threadAffinity) ifTrue: [self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject. + "If we switch threads in threadSwitchIfNecessary:from:, the interpreter state is likely + already in the correct state. + In that case, there is no suspended context and nothing to restore. We can just continue + execution. + If there is a suspended context, assume that we need to restore the state from that." (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."! 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 newFrom: 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. checkThreadActivation := true. self forceInterruptCheck]! Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend "Primitive #88. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. The primitive returns the list the receiver was previously on. c.f. primitiveSuspendBackingUpV1,#568 & primitiveSuspendBackingUpV2,#578" | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [| inInterpreter | "We're going to switch process, either to an interpreted frame or a machine code frame. To know whether to return or enter machine code we have to know from whence we came. We could have come from the interpreter, either directly or via a machine code primitive. We could have come from machine code. The instructionPointer tells us where from:" self stackTopPut: objectMemory nilObject. inInterpreter := instructionPointer >= objectMemory startOfMemory. self transferTo: self wakeHighestPriority from: CSSuspend. ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. self stackTopPut: myList! Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveSuspendBackingUpV1 (in category 'process primitives') ----- primitiveSuspendBackingUpV1 "Primitive #568. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. If the list was not its run queue assume it was on some condition variable (Semaphore, Mutex) and back up its pc to the send that invoked the wait state the process entered. Hence when the process resumes it will reenter the wait state. Answer the list the receiver was previously on, unless it was the activeProcess, in which case answer nil. c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV2,#578" | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [| inInterpreter | "We're going to switch process, either to an interpreted frame or a machine code frame. To know whether to return or enter machine code we have to know from whence we came. We could have come from the interpreter, either directly or via a machine code primitive. We could have come from machine code. The instructionPointer tells us where from:" self stackTopPut: objectMemory nilObject. inInterpreter := instructionPointer >= objectMemory startOfMemory. self transferTo: self wakeHighestPriority from: CSSuspend. ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: [self backupContext: myContext toBlockingSendTo: myList]. self stackTopPut: myList! Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveSuspendBackingUpV2 (in category 'process primitives') ----- primitiveSuspendBackingUpV2 "Primitive #578. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. If the list was not its run queue assume it was on some condition variable (Semaphore, Mutex) and back up its pc to the send that invoked the wait state the process entered. Hence when the process resumes it will reenter the wait state. Answer the list the receiver was previously on iff it was not active and not blocked, otherwise answer nil. c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV1,#568, which always answer the list the process was on, even if blocked." <export: true> | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [| inInterpreter | "We're going to switch process, either to an interpreted frame or a machine code frame. To know whether to return or enter machine code we have to know from whence we came. We could have come from the interpreter, either directly or via a machine code primitive. We could have come from machine code. The instructionPointer tells us where from:" self stackTopPut: objectMemory nilObject. inInterpreter := instructionPointer >= objectMemory startOfMemory. self transferTo: self wakeHighestPriority from: CSSuspend. ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: [self backupContext: myContext toBlockingSendTo: myList. self stackTopPut: objectMemory nilObject] ifFalse: [self stackTopPut: myList]! Item was changed: CogClass subclass: #CogThreadManager (excessive size, no diff calculated) Item was changed: ----- Method: CogThreadManager class>>declareCVarsIn: (in category 'translation') ----- declareCVarsIn: cCodeGen cCodeGen removeVariable: 'coInterpreter'; removeVariable: 'cogit'; removeVariable: 'threadLocalStorage'; removeVariable: 'processorOwner'; removeVariable: 'registerStates'. cCodeGen var: #threads type: #'CogVMThread **'; var: #vmOSThread type: #sqOSThread; var: #vmOwner type: #'volatile atomic_int'; + var: #maxWaitingPriority type: #'volatile atomic_int'; + var: #ownerLog type: #'CogVMOwnerLog *'; + var: #ownerLogIndex type: #'volatile atomic_int'. - var: #maxWaitingPriority type: #'volatile atomic_int'. cCodeGen addHeaderFile: '<stdatomic.h>'! 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)" CTMUnknownOwner := -1. "Define the size of the stack of processes at time of disown/own." + AWOLProcessesIncrement := 4. + OwnerLogSize := 1024 * 1024 "1M entries for logging owner switches".! - AWOLProcessesIncrement := 4! Item was added: + ----- Method: CogThreadManager>>copyLogTo: (in category 'logging') ----- + copyLogTo: aPointer + | bufferPointer bytesCopied index startIndex bytesToCopy | + <var: #aPointer type: #'char *'> + <var: #bufferPointer type: #'char *'> + bufferPointer := aPointer. + index := self atomic_load: (self addressOf: ownerLogIndex). + bytesCopied := 0. + + + "NOTE: The ownerLogWrapped isn't synchronized atomically. + Therefore, if this primitive is called exactly when we start wrapping the very first time, we'll read the wrong value here. + However, as this is very unlikely, don't bother fixing this (yet)." + ownerLogWrapped ifTrue: [ |entriesToSpare| + "NOTE: The owner log is still written to whilst this primitive is running. + Therefore copy only 90% of the log, such that the remaining 10% can be spared + to still be written." + entriesToSpare := OwnerLogSize / 10. + startIndex := index + entriesToSpare min: (OwnerLogSize - 1). + bytesToCopy := (OwnerLogSize - startIndex) * (self sizeof: CogVMOwnerLog). + self memcpy: bufferPointer + _: ownerLog + startIndex + _: bytesToCopy. + bytesCopied := bytesCopied + bytesToCopy]. + + bytesToCopy := index * (self sizeof: CogVMOwnerLog). + self memcpy: bufferPointer + bytesCopied + _: ownerLog + _: bytesToCopy. + bytesCopied := bytesCopied + bytesToCopy. + ^ bytesCopied + ! Item was changed: ----- Method: CogThreadManager>>doTryLockVMOwnerTo: (in category 'Cogit lock implementation') ----- doTryLockVMOwnerTo: threadIndex "In the simulation, this is being called by #simulateTryLockVMOwnerTo:, in C this method will just be called directly. Returns true if the vmOwner has been successfully set to the given thread index." <inline: #always> <var: #expected type: #int> + | expected success | - | expected | expected := self cCode: 0 inSmalltalk: [AtomicValue newFrom: 0]. + success := (self atomic: (self addressOf: vmOwner) - ^ (self atomic: (self addressOf: vmOwner) _compare: (self addressOf: expected) _exchange_strong: threadIndex) or: ["We may already be vmOwner. The current vmOwner will be stored in expected. However, if an unknown owner is present, we cannot assume that's us!!" + expected = threadIndex and: [threadIndex ~= CTMUnknownOwner]]. + + self logOwnerSwitchTo: threadIndex successful: success. + ^ success! - expected = threadIndex and: [threadIndex ~= CTMUnknownOwner]]! Item was changed: ----- Method: CogThreadManager>>growThreadInfosToAtLeast: (in category 'thread set') ----- growThreadInfosToAtLeast: index "Grow the thread infos to at least index in numThreadsIncrement quanta." | newThreads newNumThreads | <var: #newThreads type: #'CogVMThread **'> <inline: false> memoryIsScarce ifTrue: [^false]. newNumThreads := index + numThreadsIncrement - 1 // numThreadsIncrement * numThreadsIncrement. newNumThreads >= self maxNumThreads ifTrue: [^false]. "Since 0 is not a valid index we allocate one extra CogVMThread and use 1-relative indices." newThreads := self cCode: 'realloc(GIV(threads), (newNumThreads + 1) * sizeof(CogVMThread *))' inSmalltalk: [(Array new: newNumThreads) replaceFrom: 1 to: numThreads with: threads startingAt: 1]. + + newThreads ifNil: [memoryIsScarce := true. ^ false]. - (newThreads notNil - and: [self populate: newThreads from: numThreads + 1 to: newNumThreads]) ifFalse: - [ - "TODO: This cannot free 'newThreads', as that's going to mean 'threads' is freed as well." - self abort. - self free: newThreads. - memoryIsScarce := true. - ^false]. threads := newThreads. + + (self populate: newThreads from: numThreads + 1 to: newNumThreads) + ifTrue: [numThreads := newNumThreads. + ^true] + ifFalse: ["Allocation of new threads may fail, even after the array has been moved. + If this is the case, simply do not increase the number of useable threads. + The old ones will still point to the right addresses, they'll just be in a new list + which technically has too much space, but that doesn't hurt anything." + memoryIsScarce := true. + ^false]. + ! - numThreads := newNumThreads. - ^true! Item was changed: ----- Method: CogThreadManager>>initialize (in category 'initialize-release') ----- initialize + "Initialize is only called in Smalltalk simulation, don't initialize anything here that's important for C. + For that use #startThreadSubsystem." numThreads := numThreadsIncrement := 0. + vmOwner := AtomicValue newFrom: 0. + - self cCode: [self atomic_store: (self addressOf: vmOwner) _: 0] - inSmalltalk: [vmOwner := AtomicValue newFrom: 0]. memoryIsScarce := false. "N.B. Do not initialize threadLocalStorage; leave this to ioInitThreadLocalThreadIndices". + registerStates := IdentityDictionary new.! - registerStates := IdentityDictionary new! Item was added: + ----- Method: CogThreadManager>>initializeOwnerLog (in category 'public api') ----- + initializeOwnerLog + "The owner log isn't actually used in Simulation, we just directly print everything, so we can leave those variables empty during simulation." + self cCode: [ownerLog := self calloc: OwnerLogSize _: (self sizeof: CogVMOwnerLog). + self atomic_store: (self addressOf: ownerLogIndex) _: 0. + ownerLogWrapped := false.].! Item was added: + ----- Method: CogThreadManager>>logOwnerSwitchTo:successful: (in category 'logging') ----- + logOwnerSwitchTo: newOwner successful: aBoolean + <inline: false> + self cCode: [self saveOwnerSwitchTo: newOwner successful: aBoolean] + inSmalltalk: [self printOwnerSwitchTo: newOwner successful: aBoolean].! 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 added: + ----- Method: CogThreadManager>>printOwnerSwitchTo:successful: (in category 'logging') ----- + printOwnerSwitchTo: newOwner successful: aBoolean + <doNotGenerate> + coInterpreter transcript + ensureCr; + f: 'VM Owner: %d :: %d -> %d %s\n' + printf: { coInterpreter ioMSecs. + self getVMOwner. + newOwner. + aBoolean ifTrue: ['ok'] ifFalse: ['FAILED'] }.! Item was removed: - ----- Method: CogThreadManager>>pushAWOLProcess:on: (in category 'public api') ----- - pushAWOLProcess: awolProcess on: vmThread - <var: #vmThread type: #'CogVMThread *'> - <returnTypeC: #'CogVMThread *'> - | cvt | - <var: #cvt type: #'CogVMThread *'> - cvt := vmThread. - self assert: (cvt awolProcIndex between: 0 and: cvt awolProcLength). - cvt awolProcIndex >= cvt awolProcLength ifTrue: - ["The realloc doesn't look like it grows but it does so by AWOLProcessesIncrement - entries because sizeof(CogVMThread) includes room for that many entries." - cvt := self cCode: 'realloc(cvt,sizeof(CogVMThread) + (sizeof(sqInt) * cvt->awolProcLength))' - inSmalltalk: [cvt growAWOLProcesses]. - threads at: vmThread index put: cvt. - cvt awolProcLength: cvt awolProcLength + AWOLProcessesIncrement]. - cvt awolProcesses at: cvt awolProcIndex put: awolProcess. - cvt awolProcIndex: cvt awolProcIndex + 1. - ^cvt! Item was added: + ----- Method: CogThreadManager>>saveOwnerSwitchTo:successful: (in category 'logging') ----- + saveOwnerSwitchTo: newOwner successful: aBoolean + <var: #logEntry type: 'CogVMOwnerLog *'> + <var: #currentIndex type: 'int'> + <var: #newIndex type: 'int'> + | currentIndex newIndex timestamp logEntry | + timestamp := coInterpreter ioUTCMicrosecondsNow. + currentIndex := self atomic_load: (self addressOf: ownerLogIndex). + self cCode: '' inSmalltalk: [currentIndex := AtomicValue newFrom: currentIndex]. + + [newIndex := currentIndex + 1 \\ OwnerLogSize. + self atomic: (self addressOf: ownerLogIndex) + _compare: (self addressOf: currentIndex) + _exchange_strong: newIndex] whileFalse: []. + + newIndex < currentIndex ifTrue: [ownerLogWrapped := true]. + logEntry := (self addressOf: (ownerLog at: (self cCode: [currentIndex] inSmalltalk: [currentIndex value]))). + logEntry + timestamp: timestamp; + successfulSwitch: aBoolean; + vmOwner: newOwner.! 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> + "This can only be used when we're the VM Owner. It shall not be used to gain ownership. + Make sure this is the case!!" + self assert: (self getVMOwner = -1 or: [self getVMOwner = self ioGetThreadLocalThreadIndex]). - self assert: (self getVMOwner = self ioGetThreadLocalThreadIndex or: [self getVMOwner = -1]). self assert: (self getVMOwner ~= indexOrZero). + self logOwnerSwitchTo: indexOrZero successful: true. - 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>>simulateTryLockVMOwnerTo: (in category 'simulation') ----- simulateTryLockVMOwnerTo: threadIndex "In the real VM this is a direct call of #tryLockVMOwnerTo:. In the simulation this is where register state is restored, simulating a thread switch. State is stored in saveRegisterStateForCurrentProcess (sent by disownVM:, ioWaitOnOSSemaphore: and ioTransferTimeslice). The code here and in saveRegisterStateForCurrentProcess allow us to avoid the expensive and complex MultiProcessor hack. The idea here is to save the register state around the invocation of tryLockVMOwnerTo:, and set the register state to that for the owner, changing the state if ownership has changed, restoring it if ownership has not changed." <doNotGenerate> self deny: threadIndex = 0. ^cogit withProcessorHaltedDo: [| previousOwner currentOwner processor result | processor := cogit processor. "After switching, the 'current' owner will be the 'previous' owner. Though the value will be the same, let's still introduce a second variable that we can use after the switch to make it more clear what's going on." previousOwner := currentOwner := self getVMOwner. "If we currently have a VM owner, the register state should be valid for that owner, otherwise it should be empty. It may be CTMUnknownOwner (-1), in that case it should also be empty." currentOwner > 0 ifTrue: [self assertValidStackPointersInState: processor registerState forIndex: currentOwner] ifFalse: [self assertEmptyRegisterStates: processor registerState]. result := self doTryLockVMOwnerTo: threadIndex. self assert: result = (threadIndex = self getVMOwner). result ifTrue: ["If we did actually change owners, assert that previously the processor was emtpy." previousOwner ~= self getVMOwner ifTrue: [self assertEmptyRegisterStates: processor registerState. self loadOrInitializeRegisterStateFor: threadIndex]]. + - - coInterpreter transcript - ensureCr; - f: 'tryLockVMOwner %d -> %d (%s) %s\n' - printf: { previousOwner. threadIndex. thisContext home sender selector. result ifTrue: ['ok'] ifFalse: ['FAILED'] }. self assertValidProcessorStackPointersForIndex: self getVMOwner. result]! Item was changed: ----- Method: CogThreadManager>>startThreadForThreadIndex: (in category 'scheduling') ----- startThreadForThreadIndex: index + self assert: index > 0. index > numThreads ifTrue: [(self growThreadInfosToAtLeast: index) ifFalse: [^false]]. ^self startThreadForThreadInfo: (self vmThreadAt: index)! Item was changed: ----- Method: CogThreadManager>>startThreadForThreadInfo: (in category 'scheduling') ----- startThreadForThreadInfo: vmThread <var: #vmThread type: #'CogVMThread *'> <inline: false> + vmThread vmThreadState ~= CTMUninitialized + ifTrue: [^true "Already started"]. + self assert: vmThread vmThreadState = CTMUninitialized. vmThread setVmThreadState: 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. self registerVMThread: vmThread. + vmThread setVmThreadState: CTMAssignableOrInVM. + + self initializeOwnerLog.! - vmThread setVmThreadState: CTMAssignableOrInVM! Item was added: + VMStructType subclass: #CogVMOwnerLog + instanceVariableNames: 'timestamp vmOwner successfulSwitch' + classVariableNames: '' + poolDictionaries: 'VMThreadingConstants' + category: 'VMMaker-Multithreading'! Item was added: + ----- Method: CogVMOwnerLog 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: #sqInt]! Item was added: + ----- Method: CogVMOwnerLog>>successfulSwitch (in category 'accessing') ----- + successfulSwitch + + ^ successfulSwitch! Item was added: + ----- Method: CogVMOwnerLog>>successfulSwitch: (in category 'accessing') ----- + successfulSwitch: anObject + + ^ successfulSwitch := anObject.! Item was added: + ----- Method: CogVMOwnerLog>>timestamp (in category 'accessing') ----- + timestamp + + ^ timestamp! Item was added: + ----- Method: CogVMOwnerLog>>timestamp: (in category 'accessing') ----- + timestamp: anObject + + ^ timestamp := anObject.! Item was added: + ----- Method: CogVMOwnerLog>>vmOwner (in category 'accessing') ----- + vmOwner + + ^ vmOwner! Item was added: + ----- Method: CogVMOwnerLog>>vmOwner: (in category 'accessing') ----- + vmOwner: anObject + + ^ vmOwner := anObject.! Item was removed: - ----- Method: CogVMSimulator>>bindProcess:toId: (in category 'multi-threading simulation switch') ----- - bindProcess: aProcess toId: newId - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #bindProcess:toId: - withArguments: {aProcess. newId} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was removed: - ----- Method: CogVMSimulator>>isAffinedProcess: (in category 'multi-threading simulation switch') ----- - isAffinedProcess: aProcess - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #isAffinedProcess: - withArguments: {aProcess} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was removed: - ----- Method: CogVMSimulator>>isAffinedThreadId: (in category 'multi-threading simulation switch') ----- - isAffinedThreadId: threadId - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #isAffinedThreadId: - withArguments: {threadId} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was added: + ----- Method: CogVMSimulator>>ownVM:withFlags: (in category 'multi-threading simulation switch') ----- + ownVM: vmThreadHandle withFlags: additionalFlags + "This method includes or excludes CoInterpreterMT methods as required. + Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" + + ^self perform: #ownVM:withFlags: + withArguments: {vmThreadHandle. additionalFlags} + inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was removed: - ----- Method: CogVMSimulator>>ownerIndexOfThreadId: (in category 'multi-threading simulation switch') ----- - ownerIndexOfThreadId: threadId - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #ownerIndexOfThreadId: - withArguments: {threadId} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was added: + ----- Method: CogVMSimulator>>primitiveProcessBindToThreadAffinity (in category 'multi-threading simulation switch') ----- + primitiveProcessBindToThreadAffinity + "This method includes or excludes CoInterpreterMT methods as required. + Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" + + ^self perform: #primitiveProcessBindToThreadAffinity + withArguments: {} + inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was removed: - ----- Method: CogVMSimulator>>primitiveProcessBindToThreadId (in category 'multi-threading simulation switch') ----- - primitiveProcessBindToThreadId - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #primitiveProcessBindToThreadId - withArguments: {} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])! Item was changed: VMStructType subclass: #CogVMThread + instanceVariableNames: 'index state priority osSemaphore osThread disownFlags newMethodOrNull argumentCount inMachineCode cStackPointer cFramePointer reenterThreadSchedulingLoop awolProcIndex awolProcLength awolProcesses' - instanceVariableNames: 'index state priority osSemaphore osThread disownFlags newMethodOrNull argumentCount inMachineCode cStackPointer cFramePointer awolProcIndex awolProcLength awolProcesses reenterThreadSchedulingLoop' classVariableNames: '' poolDictionaries: 'VMThreadingConstants' category: 'VMMaker-Multithreading'! !CogVMThread commentStamp: '<historical>' prior: 0! Instances of this class represent control blocks for native threads that cooperatively schedule the VM. See the class comment of CogThreadManager for full documentation. N.B. awolProcesses must be the last inst var.! 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 *']. - ['awolProcesses'] -> [{#sqInt. '[', CogThreadManager awolProcessesIncrement printString, ']'}]. ['cStackPointer'] -> [#usqIntptr_t]. ['cFramePointer'] -> [#usqIntptr_t]. ['osSemaphore'] -> ['sqOSSemaphore']. ['osThread'] -> ['sqOSThread']. ['reenterThreadSchedulingLoop'] -> ['jmp_buf']. ['state'] -> ['volatile atomic_int'] } otherwise: [#sqInt])]! Item was removed: - ----- Method: CogVMThread>>growAWOLProcesses (in category 'simulation only') ----- - growAWOLProcesses - <doNotGenerate> - awolProcesses setObject: awolProcesses object, (Array new: CogThreadManager awolProcessesIncrement)! Item was changed: ----- Method: CogVMThread>>initializeThreadState (in category 'initialize-release') ----- initializeThreadState "Unfortunately this cannot be inlined as Slang otherwise screws up the generation of the `atomic_store` call." <inline: false> "In comparision to #initialize, this is also called in C code to initialize the VMThread, not just in the Smalltalk simulation." self cCode: [] inSmalltalk: [state := AtomicValue new]. + self atomic_store: (self addressOf: self state) _: CTMUninitialized. + + self + cCode: [awolProcesses := self malloc: AWOLProcessesIncrement * (self sizeof: #sqInt)] + inSmalltalk: [awolProcesses := CArrayAccessor on: (Array new: AWOLProcessesIncrement)]. + awolProcIndex := 0. + awolProcLength := AWOLProcessesIncrement.! - self atomic_store: (self addressOf: self state) _: CTMUninitialized.! Item was changed: ----- Method: FilePlugin>>primitiveFileReadPinningAndDisowning (in category 'file primitives') ----- primitiveFileReadPinningAndDisowning "This version of primitiveFileRead is for garbage collectors that support pinning + and the multi-threaded VM. It actually does the own/disown dance if the bytearray is pinned." + | count startIndex array file slotSize elementSize bytesRead vmHandle | - and the multi-threaded VM. It actually does the own/disown dance." - | count startIndex array file slotSize elementSize bytesRead vmHandle wasPinned | <inline: true> <var: 'file' type: #'SQFile *'> <var: 'count' type: #'size_t'> <var: 'startIndex' type: #'size_t'> <var: 'slotSize' type: #'size_t'> <var: 'elementSize' type: #'size_t'> count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0). startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1). array := interpreterProxy stackValue: 2. file := self fileValueOf: (interpreterProxy stackValue: 3). + vmHandle := nil. (interpreterProxy failed "buffer can be any indexable words or bytes object except CompiledMethod" or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]. slotSize := interpreterProxy slotSizeOf: array. (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex]. - (wasPinned := interpreterProxy isPinned: array) ifFalse: - [array := interpreterProxy pinObject: array]. - vmHandle := interpreterProxy disownVM: DisownVMForThreading. "Note: adjust startIndex for zero-origin byte indexing" elementSize := slotSize = 0 ifTrue: [1] ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize]. + + (interpreterProxy isPinned: array) ifTrue: + [vmHandle := interpreterProxy disownVM: DisownVMForThreading]. bytesRead := self sqFile: file Read: count * elementSize Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *') At: startIndex - 1 * elementSize. + vmHandle ifNotNil: + [interpreterProxy ownVM: vmHandle]. + - interpreterProxy ownVM: vmHandle. - wasPinned ifFalse: - [interpreterProxy unpinObject: array]. interpreterProxy failed ifFalse: [interpreterProxy methodReturnInteger: bytesRead // elementSize] "answer # of elements read"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveFailForFFIException:at: (in category 'primitive support') ----- primitiveFailForFFIException: exceptionCode at: pc <var: 'exceptionCode' type: #usqLong> <var: 'pc' type: #usqInt> "Set PrimErrFFIException primitive failure and associated exceptionCode (a.k.a. secondaryErrorCode) and exceptionPC. Under control of the ffiExceptionResponse flag, if in a primitive with an error code and the inFFIFlags indicate we're in an FFI call, then fail the primitive. ffiExceptionResponse < 0 never fail ffiExceptionResponse = 0 fail if method has a primitive error code (default) ffiExceptionResponse > 0 always fail" <public> ((inFFIFlags noMask: DisownVMForFFICall) "i.e. not in an FFI call" or: [ffiExceptionResponse < 0]) ifTrue: "i.e. never fail" [^self]. secondaryErrorCode := self cCoerceSimple: exceptionCode to: #sqLong. exceptionPC := pc. primFailCode := PrimErrFFIException. (ffiExceptionResponse > 0 "always fail..." or: [(objectMemory isOopCompiledMethod: newMethod) and: [self methodUsesPrimitiveErrorCode: newMethod]]) ifTrue: + [self ownVM: nil withFlags: DisownVMForFFICall. "To take ownership but importantly to reset inFFIFlags" - [self ownVM: DisownVMForFFICall. "To take ownership but importantly to reset inFFIFlags" self activateFailingPrimitiveMethod]! Item was added: + ----- Method: InterpreterPrimitives>>primitiveProcessBindToThreadAffinity (in category 'process primitives') ----- + primitiveProcessBindToThreadAffinity + "Simulation only. Fail." + <doNotGenerate> + self primitiveFail! Item was removed: - ----- Method: InterpreterPrimitives>>primitiveProcessBindToThreadId (in category 'process primitives') ----- - primitiveProcessBindToThreadId - "Simulation only. Fail." - <doNotGenerate> - self primitiveFail! Item was added: + ----- Method: InterpreterPrimitives>>primitiveVMProfileThreadedSamplesInto (in category 'process primitives') ----- + primitiveVMProfileThreadedSamplesInto + "Primitive. + 0 args: Answer whether the VM Profiler is running or not. + 2 arg: Copy the sample data for the thread with the given index into the second + supplied argument, which must be a Bitmap of suitable size. + Answer the number of samples copied into the buffer." + | sampleBuffer running bufferSize numSamples threadIndex | + <var: #bufferSize type: #long> + "Initialize to shut up the warning about 'uninitialized variables' in Squeak" + running := 0. + bufferSize := 0. + self ioNewProfile: (self addressOf: running put: [:v| running := v]) + Status: (self addressOf: bufferSize put: [:v| bufferSize := v]). + argumentCount = 0 ifTrue: + [^self pop: 1 thenPushBool: running]. + argumentCount = 2 ifFalse: + [^self primitiveFailFor: PrimErrBadNumArgs]. + + threadIndex := self stackIntegerValue: 1. + + sampleBuffer := self stackValue: 0. + ((objectMemory isNonImmediate: sampleBuffer) + and: [(objectMemory isPureBitsNonImm: sampleBuffer) + and: [(objectMemory numBytesOf: sampleBuffer) >= (bufferSize * objectMemory wordSize)]]) ifFalse: + [^self primitiveFailFor: PrimErrBadArgument]. + + numSamples := self ioNewProfileThread: threadIndex SamplesInto: (objectMemory firstFixedField: sampleBuffer). + self methodReturnInteger: numSamples! Item was changed: ----- Method: InterpreterProxy>>disownVM: (in category 'FFI support') ----- disownVM: flags + <returnTypeC: #'void *'> ^self notYetImplementedError! Item was changed: ----- Method: InterpreterProxy>>ownVM: (in category 'FFI support') ----- + ownVM: handle + <var: #handle type: #'void*'> - ownVM: flags ^self notYetImplementedError! Item was changed: ----- Method: NewObjectMemory>>disownVM: (in category 'simulation only') ----- disownVM: flags + <returnTypeC: #'void*'> "hack around the CoInterpreter/ObjectMemory split refactoring" <doNotGenerate> ^coInterpreter disownVM: flags! Item was changed: ----- Method: NewObjectMemory>>ownVM: (in category 'simulation only') ----- + ownVM: handle - ownVM: flags "hack around the CoInterpreter/ObjectMemory split refactoring" <doNotGenerate> + <var: #handle type: #'void *'> + ^coInterpreter ownVM: handle! - ^coInterpreter ownVM: flags! Item was changed: ----- Method: SocketPlugin>>primitiveSocketCloseConnection: (in category 'primitives') ----- primitiveSocketCloseConnection: socket | s | + <var: #s type: #SocketPtr> + self primitive: 'primitiveSocketCloseConnection' parameters: #(Oop). - <var: #s type: 'SocketPtr '> - self primitive: 'primitiveSocketCloseConnection' - parameters: #(Oop). s := self socketValueOf: socket. + interpreterProxy failed ifFalse: + [self cppIf: COGMTVM + ifTrue: [self sqSocketCloseConnection: s isPinned: (interpreterProxy isPinned: socket)] + ifFalse: [self sqSocketCloseConnection: s]]! - interpreterProxy failed ifFalse: [ - self sqSocketCloseConnection: s]! Item was added: + ----- Method: SocketPlugin>>sqSocketCloseConnection:isPinned: (in category 'simulation') ----- + sqSocketCloseConnection: socketHandleCArray isPinned: isPinned + <private> + <option: #COGMTVM> + <inline: #always> + | result handle | + isPinned ifTrue: [handle := interpreterProxy disownVM: DisownVMForThreading]. + result := self sqSocketCloseConnection: socketHandleCArray. + isPinned ifTrue: [interpreterProxy ownVM: handle]. + ^ result! Item was changed: ----- Method: SpurMemoryManager>>disownVM: (in category 'simulation only') ----- disownVM: flags + <returnTypeC: #'void*'> "hack around the CoInterpreter/ObjectMemory split refactoring" <doNotGenerate> ^coInterpreter disownVM: flags! Item was changed: ----- Method: SpurMemoryManager>>ownVM: (in category 'simulation only') ----- + ownVM: handle - ownVM: flags "hack around the CoInterpreter/ObjectMemory split refactoring" <doNotGenerate> + <var: #handle type: #'void *'> + ^coInterpreter ownVM: handle! - ^coInterpreter ownVM: flags! Item was changed: ----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') ----- printOopsFrom: startAddress to: endAddress <public> "useful for VM debugging" | oop limit firstNonEntity inEmptySpace lastNonEntity | oop := self objectBefore: startAddress. limit := endAddress asUnsignedIntegerPtr min: endOfMemory. oop := oop ifNil: [startAddress] ifNotNil: [(self objectAfter: oop) = startAddress ifTrue: [startAddress] ifFalse: [oop]]. + inEmptySpace := false. - inEmptySpace := false. [self oop: oop isLessThan: limit] whileTrue: [self printEntity: oop. [oop := self objectAfter: oop. (self long64At: oop) = 0] whileTrue: [inEmptySpace ifFalse: [inEmptySpace := true. firstNonEntity := oop]. lastNonEntity := oop]. inEmptySpace ifTrue: [inEmptySpace := false. coInterpreter print: 'skipped empty space from '; printHexnp: firstNonEntity; print:' to '; printHexnp: lastNonEntity; cr. oop := self objectStartingAt: oop]]! 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 vmHandle canDisown | - | start srcLen dstLen srcOop dstOop handle srcPtr dstPtr result wasSrcPinned wasDestPinned vmHandle | <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. + canDisown := (interpreterProxy isPinned: srcOop) and: [interpreterProxy isPinned: dstOop]. + canDisown ifTrue: [vmHandle := interpreterProxy disownVM: DisownVMForThreading]. - vmHandle := interpreterProxy disownVM: DisownVMForThreading. + result := self sqConnectSSL: handle _: srcPtr _: srcLen _: dstPtr _: dstLen. + + canDisown ifTrue: [interpreterProxy ownVM: vmHandle]. - result := self cCode: 'sqConnectSSL(handle, srcPtr, srcLen, dstPtr, dstLen)' - inSmalltalk:[handle. srcPtr. srcLen. dstPtr. dstLen. -2]. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnInteger: result]! - 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.! Item was changed: ----- Method: StackInterpreter>>ownVM: (in category 'vm scheduling') ----- ownVM: threadIndexAndFlags <public> <inline: false> + ^ self ownVM: threadIndexAndFlags withFlags: 0! - "This is the entry-point for plugins and primitives that wish to reacquire the VM after having - released it via disownVM or callbacks that want to acquire it without knowing their ownership - status. While this exists for the threaded FFI VM we use it to reset newMethod and the - argumentCount after a callback. - - Answer -1 if the current thread is unknown to the VM and fails to take ownership." - <var: 'amInVMThread' declareC: 'extern sqInt amInVMThread(void)'> - self cppIf: COGMTVM - ifTrue: - [self amInVMThread ifFalse: - [^-1]]. - - self assert: ((objectMemory isOopCompiledMethod: newMethod) - and: [(self argumentCountOf: newMethod) = argumentCount]). - - threadIndexAndFlags = DisownVMForThreading ifTrue: - [^threadIndexAndFlags]. - - "Hack encodings of client state. We use non-immediates (bottom three bits clear) - for FFI/Plugin doing - save := self disownVM: FLAGS. ... callout ... self ownVM: save. - We use immediate integer (bottom bit 1) for callbacks doing - save := self ownVM: 0. ... callback ... self disownVM: save. return to C" - - "If DisownVMForFFICall this is from the FFI plugin and we're returning from a callout." - (threadIndexAndFlags anyMask: DisownVMForFFICall) ifTrue: - [inFFIFlags := 0. - ^threadIndexAndFlags]. - - "Otherwise this is a callback; stash newMethod on the stack and encode - argumentCount in the flags retrieved when the calback calls disownVM:." - self assert: primFailCode = 0. - self push: newMethod. - ^objectMemory integerObjectOf: argumentCount! Item was added: + ----- Method: StackInterpreter>>ownVM:withFlags: (in category 'vm scheduling') ----- + ownVM: threadIndexAndFlags withFlags: additionalFlags + <public> + <inline: false> + "This is the entry-point for plugins and primitives that wish to reacquire the VM after having + released it via disownVM or callbacks that want to acquire it without knowing their ownership + status. While this exists for the threaded FFI VM we use it to reset newMethod and the + argumentCount after a callback. + + Answer -1 if the current thread is unknown to the VM and fails to take ownership." + <var: 'amInVMThread' declareC: 'extern sqInt amInVMThread(void)'> + | flags | + flags := threadIndexAndFlags bitOr: additionalFlags. + self cppIf: COGMTVM + ifTrue: + [self amInVMThread ifFalse: + [^-1]]. + + self assert: ((objectMemory isOopCompiledMethod: newMethod) + and: [(self argumentCountOf: newMethod) = argumentCount]). + + "Hack encodings of client state. We use non-immediates (bottom three bits clear) + for FFI/Plugin doing + save := self disownVM: FLAGS. ... callout ... self ownVM: save. + We use immediate integer (bottom bit 1) for callbacks doing + save := self ownVM: 0. ... callback ... self disownVM: save. return to C" + + "If DisownVMForFFICall this is from the FFI plugin and we're returning from a callout." + (flags anyMask: DisownVMForFFICall) ifTrue: + [inFFIFlags := 0. + ^flags]. + + "Otherwise this is a callback; stash newMethod on the stack and encode + argumentCount in the flags retrieved when the calback calls disownVM:." + self assert: primFailCode = 0. + self push: newMethod. + ^objectMemory integerObjectOf: argumentCount! Item was changed: ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') ----- removeProcess: aProcess fromList: aList "Attempt to remove a process from a linked list. Answer if the attempt succeeded." | firstLink lastLink nextLink tempLink | self deny: (objectMemory isForwarded: aProcess). self deny: (objectMemory isForwarded: aList). "any process on the list could have been becomed, so use a read barrier..." firstLink := objectMemory followField: FirstLinkIndex ofObject: aList. lastLink := objectMemory followField: LastLinkIndex ofObject: aList. aProcess = firstLink ifTrue: [nextLink := objectMemory followField: NextLinkIndex ofObject: aProcess. objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink. aProcess = lastLink ifTrue: [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]] ifFalse: [tempLink := firstLink. ["fail if any link doesn't look like a process..." ((objectMemory isPointers: tempLink) and: [(objectMemory numSlotsOf: tempLink) > MyListIndex]) ifFalse: [^false]. nextLink := objectMemory followField: NextLinkIndex ofObject: tempLink. nextLink = aProcess] whileFalse: [tempLink := nextLink]. nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess. objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink. aProcess = lastLink ifTrue: [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]]. objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject. + objectMemory storePointerUnchecked: MyListIndex ofObject: aProcess withValue: objectMemory nilObject. ^true! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend "Primitive #88. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. The primitive returns the list the receiver was previously on. c.f. primitiveSuspendBackingUpV1,#568 & primitiveSuspendBackingUpV2,#578" | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [self stackTopPut: objectMemory nilObject. ^self transferTo: self wakeHighestPriority]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. self stackTopPut: myList! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSuspendBackingUpV1 (in category 'process primitives') ----- primitiveSuspendBackingUpV1 "Primitive #568. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. If the list was not its run queue assume it was on some condition variable (Semaphore, Mutex) and back up its pc to the send that invoked the wait state the process entered. Hence when the process resumes it will reenter the wait state. Answer the list the receiver was previously on, unless it was the activeProcess, in which case answer nil. c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV2,#578" | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [self stackTopPut: objectMemory nilObject. ^self transferTo: self wakeHighestPriority]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: [self backupContext: myContext toBlockingSendTo: myList]. self stackTopPut: myList! Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSuspendBackingUpV2 (in category 'process primitives') ----- primitiveSuspendBackingUpV2 "Primitive #578. Suspend the receiver, aProcess, such that it can be executed again by sending #resume. If the given process is not the active process, take it off its corresponding list. If the list was not its run queue assume it was on some condition variable (Semaphore, Mutex) and back up its pc to the send that invoked the wait state the process entered. Hence when the process resumes it will reenter the wait state. Answer the list the receiver was previously on iff it was not active and not blocked, otherwise answer nil. c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV1,#568, which always answer the list the process was on, even if blocked." <export: true> | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: [self stackTopPut: objectMemory nilObject. ^self transferTo: self wakeHighestPriority]. myList := objectMemory fetchPointer: MyListIndex ofObject: process. myContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: process. ((objectMemory isPointers: myList) and: [(objectMemory numSlotsOf: myList) > LastLinkIndex and: [(objectMemory isContext: myContext) and: [self isResumableContext: myContext]]]) ifFalse: [^self primitiveFailFor: PrimErrBadReceiver]. ok := self removeProcess: process fromList: myList. ok ifFalse: [^self primitiveFailFor: PrimErrOperationFailed]. - objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject. (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: [self backupContext: myContext toBlockingSendTo: myList. self stackTopPut: objectMemory nilObject] ifFalse: [self stackTopPut: myList]! Item was changed: ----- Method: VMProfileLinuxSupportPlugin>>primitiveExecutableModules (in category 'primitives') ----- primitiveExecutableModules "Answer an Array of pairs of strings for executable modules (the VM executable and loaded libraries). The first element in each pair is the filename of the module. The second element is either nil or the symlink's target, if the filename is a symlink." <export: true> | resultObj | numModules := 0. self dl_iterate_phdr: #countnummodules _: 0. resultObj := interpreterProxy instantiateClass: interpreterProxy classArray + indexableSize: numModules * 2. - indexableSize: numModules - 1 * 2. "skip the fake linux-gate.so.1" resultObj = 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrNoMemory]. interpreterProxy pushRemappableOop: resultObj. primErr := numModules := 0. self dl_iterate_phdr: #reapmodulesymlinks _: 0. resultObj := interpreterProxy popRemappableOop. primErr ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: primErr]. ^interpreterProxy methodReturnValue: resultObj! Item was changed: ----- Method: VMProfileLinuxSupportPlugin>>reap:module:symlinks: (in category 'iteration callbacks') ----- reap: info module: size symlinks: ignored "like reap:module:names:, but follows symlinks" <var: 'info' type: #'struct dl_phdr_info *'> <var: 'size' type: #'size_t'> <var: 'ignored' type: #'void *'> <returnTypeC: #int> | elfModuleName len moduleNameObj symLinkBuf | <var: 'elfModuleName' type: #'const char *'> <var: 'symLinkBuf' declareC: 'char symLinkBuf[PATH_MAX]'> elfModuleName := numModules > 0 ifTrue: [info dlpi_name] ifFalse: [self getAttributeString: 0]. (elfModuleName isNil or: [(len := self strlen: elfModuleName) = 0]) ifTrue: + [^0]. "skip the fake linux-gate.so.1 --- NOTE: On 64-bit linux this is linux-vdso.so.1 + and doesn't seem to appear as a zero-length/nullptr string!! + It also doesn't seem to hurt anything to leave it in the list." - [^0]. "skip the fake linux-gate.so.1" moduleNameObj := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. moduleNameObj = 0 ifTrue: [primErr := PrimErrNoMemory. ^1]. "stop iteration" self strncpy: (interpreterProxy arrayValueOf: moduleNameObj) _: elfModuleName _: len. "(char *)strncpy()" interpreterProxy storePointer: numModules ofObject: interpreterProxy topRemappableOop withValue: moduleNameObj. "now dereference the symlink, if it exists" self str: symLinkBuf cpy: elfModuleName. (len := self read: elfModuleName li: symLinkBuf nk: #'PATH_MAX') > 0 ifTrue: [moduleNameObj := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: len. moduleNameObj = 0 ifTrue: [primErr := PrimErrNoMemory. ^1]. "stop iteration" self strncpy: (interpreterProxy arrayValueOf: moduleNameObj) _: symLinkBuf _: len. "(char *)strncpy()" interpreterProxy storePointer: numModules + 1 ofObject: interpreterProxy topRemappableOop withValue: moduleNameObj] ifFalse: [interpreterProxy storePointer: numModules + 1 ofObject: interpreterProxy topRemappableOop withValue: interpreterProxy nilObject]. numModules := numModules + 2. ^0! Item was changed: SharedPool subclass: #VMThreadingConstants instanceVariableNames: '' + classVariableNames: 'AWOLProcessesIncrement CTMAssignableOrInVM CTMInitializing CTMUnavailable CTMUninitialized CTMUnknownOwner CTMWantingOwnership OwnerLogSize ThreadIdIndex ThreadIdShift' - classVariableNames: 'AWOLProcessesIncrement CTMAssignableOrInVM CTMInitializing CTMUnavailable CTMUninitialized CTMUnknownOwner 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].!

1 0

Re: [Cuis-dev] BMP Reader broken
by lewis＠mail.msen.com 23 Mar '24

23 Mar '24

Thanks Juan, I made the updates to the Smalltalk source (VMMaker and VMMaker.oscog packages) and pushed the generated C code to the github and SVN repositories. CC to the vm-dev list for info. Dave On 2024-03-18 18:16, Juan Vuletich via Cuis-dev wrote: > Hi Dave, > > On 3/18/2024 12:35 PM, lewis--- via Cuis-dev wrote: > > Hi Juan, > > On 2024-03-17 18:17, Juan Vuletich via Cuis-dev wrote: > > Hi Dave, > > On 3/16/2024 6:22 PM, lewis--- via Cuis-dev wrote:As I said in a > separate email, Vanessa found the origin of the problem, and the fix is > now at GitHub. > > Still, as you say, the primitive fails, both in Cuis and Squeak, but > only the first time it is called. The lines are read in reverse order, > so the line that is first copied is actually the last one. > > In #read24BmpLine:into:startingAt:width:, at the start of the fallback > code, I added this line: `{formBitsIndex+width. formBits size} print.`. > Then tried to load Hilaire's BMP. In the Transcript I got #(63601 > 63600). So, in BMPReadWriterPlugin.c, the lines that read: > > if (!(((formBitsIndex + width) <= formBitsSize) > && ((width * 3) <= pixelLineSize))) { > return primitiveFail(); > > should actually read > > if (!(((formBitsIndex + width - 1) <= formBitsSize) > && ((width * 3) <= pixelLineSize))) { > return primitiveFail(); > > and the primitive will not fail. > > It is a minor bug, with no practical consequences, so this is not > really important. But I found this while investigating the BMP read > failure, and I thought it was worth commenting. > > Thanks, > > The expression appears in both > BMPReadWriterPlugin>>primitiveRead24BmpLine and > BMPReadWriterPlugin>>primitiveWrite24BmpLine. Can you please confirm my > assumption that the same fix should be applied to both methods? Sorry > if this is obvious but I just want to be sure. > > Thanks! > > Dave Yep. Checking the code in both methods it is pretty clear that they are analogous. In any case, I did some quick testing, and in both cases the primitive fails exactly once and for the same value of the parameters. The tweak should be same in both cases. Thanks! -- Juan Vuletich cuis.st github.com/jvuletich researchgate.net/profile/Juan-Vuletich independent.academia.edu/JuanVuletich patents.justia.com/inventor/juan-manuel-vuletich linkedin.com/in/juan-vuletich-75611b3 twitter.com/JuanVuletich

2 1

[OpenSmalltalk/opensmalltalk-vm] 792705: Finish arg parsing work for embedded images on Win...
by Eliot Miranda 22 Mar '24

22 Mar '24

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 7927053bb7f97cd8bf1059712db17c2d400c53a4 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/7927053bb7f97cd8bf… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2024-03-22 (Fri, 22 Mar 2024) Changed paths: M platforms/win32/vm/sqWin32Main.c Log Message: ----------- Finish arg parsing work for embedded images on Windows. Don't attempt to open argv[1] as an image if there is an embedded image. To unsubscribe from these emails, change your notification settings at https://github.com/OpenSmalltalk/opensmalltalk-vm/settings/notifications

3 3

[OpenSmalltalk/opensmalltalk-vm] 5b3cef: Finish Windows image-as-a-resource code (still nee...
by Eliot Miranda 22 Mar '24

22 Mar '24

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 5b3cef5d9d78ff73865d513a21d996f8dad604fc https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/5b3cef5d9d78ff7386… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2024-03-21 (Thu, 21 Mar 2024) Changed paths: M platforms/win32/vm/sqWin32Main.c Log Message: ----------- Finish Windows image-as-a-resource code (still need to document the process for embedding). Now allow the resource to be called whatever (ResourceHacker uses the file name of the iamge minus extension, as uppercase, as a default). Check all RT_RCDATA type resources until checkImageHeaderFromBytesAndSize is satisfied. Fix argument parsing to allow for no arguments. Still have to allow additional arguments to be passed. Manana. To unsubscribe from these emails, change your notification settings at https://github.com/OpenSmalltalk/opensmalltalk-vm/settings/notifications

1 0

[OpenSmalltalk/opensmalltalk-vm] 8c6246: CogVM source as per VMMaker.oscog-eem.3356
by Eliot Miranda 22 Mar '24

22 Mar '24

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 8c6246a43a52b2eb12970cd94070ef639d43abb0 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8c6246a43a52b2eb12… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2024-03-21 (Thu, 21 Mar 2024) Changed paths: 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/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/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/cointerp.c M src/spur64.cog.lowcode/cointerp.h M src/spur64.cog.lowcode/gcc3x-cointerp.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/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/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.3356 Fix arithmetic parenthesis (rookie mistake) in checkImageHeaderFromBytes:AndSize: To unsubscribe from these emails, change your notification settings at https://github.com/OpenSmalltalk/opensmalltalk-vm/settings/notifications

1 0

VM Maker: VMMaker.oscog-eem.3356.mcz
by commits＠source.squeak.org 22 Mar '24

22 Mar '24

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3356.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3356 Author: eem Time: 21 March 2024, 10:12:03.650465 pm UUID: 0c302c6e-3779-4bd3-b396-e6a6b3a6a1d7 Ancestors: VMMaker.oscog-eem.3355 Fix arithmetic parenthesis (rookie mistake) in checkImageHeaderFromBytes:AndSize: =============== Diff against VMMaker.oscog-eem.3355 =============== Item was changed: ----- Method: StackInterpreter>>checkImageHeaderFromBytes:AndSize: (in category 'image save/restore') ----- checkImageHeaderFromBytes: bytes AndSize: totalSize "Support for embedded images. Check that the first few bytes of a potential header and answer if it looks like something the VM can load, The method checks the first three fields of the header (magic, header size & data size) & the total size. The magic number should be correct. The header size should be correct. The size of the data should be at least as long as the headerSize plus the data size in the header" <var: 'bytes' type: #'char *'> <public> | version headerSize dataSize | "Need at least headerSize bytes; no point going further if not..." totalSize < (objectMemory wordSize * 16) ifTrue: [^false]. version := self long32At: bytes. headerSize := self long32At: bytes + 4. dataSize := self longAt: bytes + 8. (self readableFormat: version) ifFalse: [(self readableFormat: version byteSwap32) ifFalse: [^false]. headerSize := objectMemory byteSwapped: headerSize. dataSize := objectMemory byteSwapped: dataSize]. + ^headerSize = (objectMemory wordSize * 16) - ^headerSize = objectMemory wordSize * 16 and: [totalSize >= (headerSize + dataSize)]!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev March 2024