[Vm-dev] VM Maker: VMMaker.oscog-eem.2866.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Oct 31 01:43:31 UTC 2020


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2866.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2866
Author: eem
Time: 30 October 2020, 6:43:21.049089 pm
UUID: 966fa589-237e-4e2f-a292-bb824bf3be58
Ancestors: VMMaker.oscog-eem.2865

Cogit simulation: Revert back to the simple simulateLeafCallOf:.  Neither handleCallOrJumpSimulationTrap: nor simulateLeafCallOf: have any business doing *anything* to the stack, unless handleCallOrJumpSimulationTrap: is mimicing a funciton activation, so *not* on invoking interpret through ceInvokeInterpreter/ceReturnToInterpreterTrampoline!

CoInterpreterMT: Some simplification and rationalization of the code.  Get rid of ceUnlockVMOwner.  Refactor the ReenterFoo exceptions under a common parent.  Add ReenterThreadSchedulingLoop to do just that.  Make sure primitiveFunctionPointer is saved/restored (needed for Spur; or is it since faling after disowning is more than questionable).

=============== Diff against VMMaker.oscog-eem.2865 ===============

Item was changed:
  CoInterpreterPrimitives subclass: #CoInterpreterMT
+ 	instanceVariableNames: 'cogThreadManager checkThreadActivation maxWaitingPriority foreignCallbackPriority deferThreadSwitch disowningVMThread foreignCallbackProcessSlot willNotThreadWarnCount activeProcessAffined relinquishing processHasThreadId noThreadingOfGUIThread reenterThreadSchedulingLoop'
- 	instanceVariableNames: 'cogThreadManager checkThreadActivation maxWaitingPriority foreignCallbackPriority deferThreadSwitch disowningVMThread disownCount foreignCallbackProcessSlot willNotThreadWarnCount activeProcessAffined relinquishing processHasThreadId noThreadingOfGUIThread reenterThreadSchedulingLoop'
  	classVariableNames: 'DisownFlagsShift DisownVMForProcessorRelinquish LockGUIThreadFlag LockGUIThreadShift OwnVMForeignThreadFlag ProcessUnaffinedOnDisown ReturnToThreadSchedulingLoop VMAlreadyOwnedHenceDoNotDisown'
  	poolDictionaries: 'VMThreadingConstants'
  	category: 'VMMaker-Multithreading'!

Item was changed:
+ ----- Method: CoInterpreterMT>>_longjmp:_: (in category 'simulation') -----
- ----- Method: CoInterpreterMT>>_longjmp:_: (in category 'cog jit support') -----
  _longjmp: aJumpBuf _: returnValue
  	"Hack simulation of _setjmp/_longjmp, intended to invoke the most minimal setjmp/longjmp
  	 pair available on the platform; no saving/restoring signal masks, no stack unwinding, etc.
  	 Signal the exception that simulates a longjmp back to the interpreter." 
  	<doNotGenerate>
  	self assert: aJumpBuf == reenterThreadSchedulingLoop.
  	aJumpBuf returnValue: returnValue; signal!

Item was removed:
- ----- Method: CoInterpreterMT>>assertCStackPointersBelongToCurrentVMOwner (in category 'simulation') -----
- assertCStackPointersBelongToCurrentVMOwner
- 	<doNotGenerate>
- 	| range |
- 	range := self cStackRangeForCurrentVMOwner.
- 	self assert: (range notNil "VM is owned"
- 				and: [(range includes: CStackPointer)
- 				and: [range includes: CFramePointer]])!

Item was changed:
  ----- Method: CoInterpreterMT>>assertSaneThreadAndProcess (in category 'debug support') -----
  assertSaneThreadAndProcess
  	<inline: true>
+ 	self assert: cogThreadManager vmIsOwned.
- 	self assert: cogThreadManager getVMOwner > 0.
  	self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM.
  	self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject!

Item was removed:
- ----- Method: CoInterpreterMT>>cStackRangeForCurrentVMOwner (in category 'simulation') -----
- cStackRangeForCurrentVMOwner
- 	<doNotGenerate>
- 	^self cStackRangeForThreadIndex: cogThreadManager getVMOwner!

Item was changed:
  ----- Method: CoInterpreterMT>>checkVMOwnershipFromHeartbeat (in category 'process primitive support') -----
  checkVMOwnershipFromHeartbeat
  	"Check whether the VM is unowned and needs to set a thread running to try and own it.
  	 Do not attempt this if the image doesn't have a threadId inst var in Process; the VM
  	 can't thread these images."
  	<inline: false>
  	self sqLowLevelMFence.
  	(processHasThreadId
+ 	 and: [cogThreadManager vmIsUnowned]) ifTrue:
- 	 and: [cogThreadManager getVMOwner = 0]) ifTrue:
  		[cogThreadManager ensureRunningVMThread: relinquishing]!

Item was changed:
  ----- Method: CoInterpreterMT>>disownVM: (in category 'vm scheduling') -----
  disownVM: flags
  	"Release the VM to other threads and answer the current thread's index.
  	 Currently valid flags:
  		DisownVMLockOutFullGC	- prevent fullGCs while this thread disowns the VM
  		DisownVMForFFICall			- informs the VM that it is entering an FFI call
  		DisownVMForThreading		- informs the VM that it is entering an FFI call etc during which threading should be permitted
  		OwnVMForeignThreadFlag	- indicates lowest-level entry from a foreign thread
  									- not to be used explicitly by clients
  									- only set by ownVMFromUnidentifiedThread
  		VMAlreadyOwnedHenceDoNotDisown
  									- indicates an ownVM from a callback was made when
  									  the vm was still owned.
  									- not to be used explicitly by clients
  									- only set by ownVMFromUnidentifiedThread
  
  	 This is the entry-point for plugins and primitives that wish to release the VM while
  	 performing some operation that may potentially block, and for callbacks returning
  	 back to some blocking operation.  If this thread does not reclaim the VM before-
  	 hand then when the next heartbeat occurs the thread manager will schedule a
  	 thread to acquire the VM which may start running the VM in place of this thread.
  
  	 N.B. Most of the state needed to resume after preemption is set in preemptDisowningThread."
  	<api>
  	<inline: false>
  	| vmThread result |
  	<var: #vmThread type: #'CogVMThread *'>
  	self assert: self successful.
  	cogit recordEventTrace ifTrue:
  		[self recordTrace: TraceDisownVM thing: (objectMemory integerObjectOf: flags) source: 0].
  	processHasThreadId ifFalse:
  		[willNotThreadWarnCount < 10 ifTrue:
  			[self print: 'warning: VM parameter 48 indicates Process doesn''t have threadId; VM will not thread'; cr.
  			 willNotThreadWarnCount := willNotThreadWarnCount + 1]].
  	vmThread := cogThreadManager currentVMThread.
  	(flags anyMask: VMAlreadyOwnedHenceDoNotDisown) ifTrue:
  		[disowningVMThread := vmThread.
  		 vmThread state: CTMUnavailable.
  		 ^0].
  	self cCode: ''
  		inSmalltalk:
  			[| range |
  			 range := self cStackRangeForThreadIndex: vmThread index.
  			 self assert: (range includes: CStackPointer).
  			 self assert: (range includes: CFramePointer)].
  	(flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
  		[| proc |
  		 (proc := objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject ifTrue:
  			[foreignCallbackPriority := self quickFetchInteger: PriorityIndex ofObject: proc].
  		 relinquishing := true.
  		 self sqLowLevelMFence].
  	(flags anyMask: DisownVMLockOutFullGC) ifTrue:
  		[objectMemory incrementFullGCLock].
  	(noThreadingOfGUIThread and: [self inGUIThread]) ifTrue:
  		[^vmThread index
  		 + LockGUIThreadFlag
  		 + (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])
  		 + (flags << DisownFlagsShift)].
- 	disownCount := disownCount + 1.
  	disowningVMThread := vmThread.
  	"self cr; cr; print: 'disownVM  Csp: '; printHex: vmThread cStackPointer; cr.
  	(0 to: 16 by: 4) do:
  		[:offset|
  		self print: ' *(esp+'; printNum: offset; print: ': '; printHex: (stackPages longAt: cogit processor sp + offset); cr].
  	cogit processor printIntegerRegistersOn: Transcript."
  
  	"OwnVMForeignThreadFlag indicates lowest-level of entry by a foreign
  	 thread. If that's where we are then release the vmThread.  Otherwise
  	 indicate the vmThread is off doing something outside of the VM."
  	(flags anyMask: OwnVMForeignThreadFlag)
  		ifTrue:
  			["I don't think this is quite right.  Josh's use case is creating some foreign thread and then registering
  			 it with the VM. That's not the same as binding a process to a foreign thread given that the foreign
  			 callback process is about to terminate anyway (it is returning from a callback here).  So do we need
  			 an additional concept, that of a vmThread being either of the set known to the VM or floating?"
  			self flag: 'issue with registering foreign threads with the VM'.
  			(self isBoundProcess: self activeProcess) ifFalse:
  				[cogThreadManager unregisterVMThread: vmThread]]
  		ifFalse: [vmThread state: CTMUnavailable].
  	result := vmThread index
  				+ (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])
  				+ (flags << DisownFlagsShift).
  	cogThreadManager releaseVM.
  	^result!

Item was removed:
- ----- Method: CoInterpreterMT>>enterSmalltalkExecutive (in category 'initialization') -----
- enterSmalltalkExecutive
- 	"Main entry-point into the interpreter at each execution level, where an
- 	 execution level is either the start of execution or reentry for a callback."
- 	<cmacro: '() enterSmalltalkExecutiveImplementation()'>
- 	"Simulation of the setjmp in enterSmalltalkExecutiveImplementation for reentry
- 	 into interpreter.  Simulation of the register state switch on thread switch."
- 	| vmo tlti thisActivationsSP thisActivationsFP retVal |
- 	[vmo := cogThreadManager getVMOwner.
- 	 tlti := cogThreadManager ioGetThreadLocalThreadIndex.
- 	 self assert: vmo = tlti.
- 	 thisActivationsSP := cogit processor sp.
- 	 thisActivationsFP := cogit processor fp.
- 	 retVal := [self enterSmalltalkExecutiveImplementation]
- 				on: ReenterInterpreter
- 				do: [:ex|
- 					vmo := cogThreadManager getVMOwner.
- 					tlti := cogThreadManager ioGetThreadLocalThreadIndex.
- 					self assert: (ex returnValue = ReturnToThreadSchedulingLoop
- 								 or: [vmo = tlti]).
- 					ex return: ex returnValue].
- 	 "We must cut back the stack pointers on return to mimic the longjmp."
- 	 cogit processor
- 		setFramePointer: thisActivationsFP
- 		stackPointer: thisActivationsSP.
- 	 retVal = ReturnToInterpreter] whileTrue!

Item was changed:
  ----- Method: CoInterpreterMT>>inGUIThread (in category 'vm scheduling') -----
  inGUIThread
  	"The first thread is assumed to be the GUI thread, the VM thread that expects to receive
  	 window events, etc.  This might appear to invite race conditions but it is only to be used
  	 to decide whether to not give up the VM from the GUI thread (see disownVM:)."
  	self assert: noThreadingOfGUIThread.
+ 	^cogThreadManager vmOwnerIs: 1!
- 	^cogThreadManager getVMOwner = 1!

Item was changed:
  ----- Method: CoInterpreterMT>>initialize (in category 'initialization') -----
  initialize
  	super initialize.
  	relinquishing := checkThreadActivation := deferThreadSwitch := false.
+ 	foreignCallbackPriority := maxWaitingPriority := willNotThreadWarnCount := 0!
- 	foreignCallbackPriority := maxWaitingPriority := disownCount := willNotThreadWarnCount := 0!

Item was changed:
  ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
+ 	"Override to mark the awolProcesses"
- 	"Mark and trace all oops in the interpreter's state."
- 	"Assume: All traced variables contain valid oops.
- 	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
- 	 only during message lookup and because createActualMessageTo will not
- 	 cause a GC these cannot change during message lookup."
- 	| oop |
  	<var: #vmThread type: #'CogVMThread *'>
- 	"Must mark stack pages first to initialize the per-page trace
- 	 flags for full garbage collect before any subsequent tracing."
- 	self markAndTraceStackPages: fullGCFlag.
- 	self markAndTraceTraceLog.
- 	self markAndTracePrimTraceLog.
- 	objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
- 	(objectMemory isImmediate: newMethod) ifFalse:
- 		[objectMemory markAndTrace: newMethod].
- 	self traceProfileState.
- 	tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
- 	tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
  
+ 	super markAndTraceInterpreterOops: fullGCFlag.
- 	1 to: objectMemory remapBufferCount do:
- 		[:i|
- 		oop := objectMemory remapBuffer at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[objectMemory markAndTrace: oop]].
  
- 	"Callback support - trace suspended callback list - will be made per-thread soon"
- 	1 to: jmpDepth do:
- 		[:i|
- 		oop := suspendedCallbacks at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[objectMemory markAndTrace: oop].
- 		oop := suspendedMethods at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[objectMemory markAndTrace: oop]].
- 
  	"Per-thread state; trace each thread's own newMethod and stack of awol processes."
  	1 to: cogThreadManager getNumThreads do:
  		[:i| | vmThread |
  		vmThread := cogThreadManager vmThreadAt: i.
+ 		vmThread state ifNotNil:
+ 			[vmThread newMethodOrNull ifNotNil:
- 		vmThread state notNil ifTrue:
- 			[vmThread newMethodOrNull notNil ifTrue:
  				[objectMemory markAndTrace: vmThread newMethodOrNull].
  			 0 to: vmThread awolProcIndex - 1 do:
+ 				[:j| objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
- 				[:j|
- 				objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!

Item was changed:
  ----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') -----
  ownVM: threadIndexAndFlags
  	<api>
  	<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.  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 0 if the current thread is known to 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."
+ 	| threadIndex flags vmThread |
- 	| threadIndex flags vmThread myProc activeProc sched |
- 	<var: #vmThread type: #'CogVMThread *'>
  	threadIndexAndFlags = 0 ifTrue:
  		[^self ownVMFromUnidentifiedThread].
+ 
  	threadIndex := threadIndexAndFlags bitAnd: ThreadIdMask.
  	flags := threadIndexAndFlags >> DisownFlagsShift.
+ 
  	(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.
- 		[relinquishing := false.
  		 self sqLowLevelMFence].
+ 
+ 	(flags anyMask: DisownVMLockOutFullGC) ifTrue:
+ 		[objectMemory decrementFullGCLock].
+ 
  	(threadIndexAndFlags anyMask: LockGUIThreadFlag) ifTrue:
  		[self assert: (noThreadingOfGUIThread and: [self inGUIThread]).
+ 		 self assert: disowningVMThread isNil.
- 		 self assert: disowningVMThread = nil.
- 		 (flags anyMask: DisownVMLockOutFullGC) ifTrue:
- 			[objectMemory decrementFullGCLock].
  		 cogit recordEventTrace ifTrue:
  			[self recordTrace: TraceOwnVM thing: ConstZero source: 0].
  		 ^0].
  
  	vmThread := cogThreadManager acquireVMFor: threadIndex.
- 	disownCount := disownCount - 1.
  
- 	(flags anyMask: DisownVMLockOutFullGC) ifTrue:
- 		[objectMemory decrementFullGCLock].
  	disowningVMThread ifNotNil:
  		[vmThread = disowningVMThread ifTrue:
+ 			[self cCode: '' inSmalltalk:
+ 					[| range | range := self cStackRangeForThreadIndex: threadIndex.
+ 					 self assert: ((range includes: CStackPointer) and: [range includes: CFramePointer])].
- 			[self cCode: ''
- 				inSmalltalk:
- 					[| range |
- 					 range := self cStackRangeForThreadIndex: threadIndex.
- 					 self assert: (range includes: CStackPointer).
- 					 self assert: (range includes: CFramePointer)].
  			 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 threadIndexAndFlags: threadIndexAndFlags.
+ 
- 	sched := self schedulerPointer.
- 	activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
- 	(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
- 		ifTrue:
- 			[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
- 			 myProc := objectMemory splObj: foreignCallbackProcessSlot.
- 			self assert: myProc ~= objectMemory nilObject.
- 			objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
- 		ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
- 	self assert: activeProc ~= myProc.
- 	(activeProc ~= objectMemory nilObject
- 	 and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
- 		[self putToSleep: activeProc yieldingIf: preemptionYields].
- 	self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
- 	objectMemory
- 		storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
- 		storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
- 	"Only unaffine if the process was affined at this level and did not become bound in the interim."
- 	((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
- 	 and: [(self isBoundProcess: myProc) not]) ifTrue:
- 		[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
- 	self initPrimCall.
- 	self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
- 	"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: threadIndex.
- 			 self assert: (range includes: vmThread cStackPointer).
- 			 self assert: (range includes: vmThread cFramePointer)].
- 	self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
- 	self assert: newMethod ~~ nil.
  	cogit recordEventTrace ifTrue:
  		[self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
  	^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CoInterpreterMT>>ownVMFromUnidentifiedThread (in category 'vm scheduling') -----
  ownVMFromUnidentifiedThread
  	"Attempt to take ownership from a thread that as yet doesn't know its index.
  	 This supports callbacks where the callback could originate from any thread.
  	
  	 Answer 0 if the owning thread is known to the VM.
  	 Answer 1 if the owning thread is unknown to the VM and now owns the VM.
  	 Answer -1 if the owning thread is unknown to the VM and fails to own the VM.
  	 Answer -2 if the owning thread is unknown to the VM and there is no foreign callback process installed."
  	| count threadIndex vmThread |
  	<var: #vmThread type: #'CogVMThread *'>
  	<inline: false>
  	(threadIndex := cogThreadManager ioGetThreadLocalThreadIndex) ~= 0 ifTrue:
  		[ "this is a callback from a known thread"
+ 		 (cogThreadManager vmOwnerIs: threadIndex) ifTrue: "the VM has not been disowned"
- 		 threadIndex = cogThreadManager getVMOwner ifTrue: "the VM has not been disowned"
  			[self assert: (disowningVMThread isNil or: [disowningVMThread = self currentVMThread]).
  			 disowningVMThread := nil.
  			 self currentVMThread state: CTMAssignableOrInVM.
  			 ^VMAlreadyOwnedHenceDoNotDisown].
  		 ^self ownVM: threadIndex].
  	foreignCallbackPriority = 0 ifTrue:
  		[^-2].
  	count := 0.
  	"If the current thread doesn't have an index it's new to the vm
  	 and we need to allocate a new threadInfo, failing if we can't.
  	 We also need a process in the foreignCallbackProcessSlot upon
  	 which to run the thread's eventual callback."
  	[[cogit tryLockVMToIndex: cogThreadManager ioCurrentOSThread] whileFalse:
  		[self waitingPriorityIsAtLeast: foreignCallbackPriority. 
  		cogThreadManager ioTransferTimeslice].
  	 (objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject] whileFalse:
  		[cogThreadManager releaseVM.
  		 (count := count + 1) > 1000 ifTrue:
  			[^-2].
  		 cogThreadManager ioMilliSleep: 1].
+ 
  	vmThread := cogThreadManager unusedThreadInfo.
  	"N.B.  Keep the VM locked anonymously so that we reserve the non-nil ForeignCallbackProcess
+ 	 for this thread, avoiding the race between competing foreign callbacks.  The acquireVMFor: in
+ 	 ownVM: will set the vmOwner to the actual index.  So only unlock on failure."
+ 	vmThread ifNil:
- 	for this thread, avoiding the race between competing foreign callbacks.  The acquireVMFor: in
- 	ownVM: will set the vmOwner to the actual index.  So only unlock on failure."
- 	vmThread isNil ifTrue:
  		[cogThreadManager releaseVM.
  		^-1].
  	cogThreadManager setVMOwner: vmThread index.
  	vmThread
  		state: CTMWantingOwnership;
  		priority: foreignCallbackPriority.
  	cogThreadManager registerVMThread: vmThread.
  	^self ownVM: vmThread index + OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CoInterpreterMT>>preemptDisowningThread (in category 'vm scheduling') -----
  preemptDisowningThread
  	"Set the relevant state for disowningVMThread so that it can resume after
  	 being preempted and set disowningVMThread to nil to indicate preemption.
  
  	 N.B.  This should only be sent from checkPreemptionOfDisowningThread.
  
  	 There are essentially four things to do.
  	 a)	save the VM's notion of the current C stack pointers; these are pointers
  		into a thread's stack and must be saved and restored in thread switch.
  	 b)	save the VM's notion of the current Smalltalk execution point.  This is
  		simply the suspend half of a process switch that saves the current context
  		in the current process.
  	 c)	add the process to the thread's set of AWOL processes so that the scheduler
  		won't try to run the process while the thread has disowned the VM.
  	 d)	save the in-primitive VM state, newMethod and argumentCount
  
  	 ownVM: will restore the VM context as of disownVM: from the above when it
  	 finds it has been preempted."
  
  	| activeProc activeContext preemptedThread |
  	<var: #preemptedThread type: #'CogVMThread *'>
  	<inline: false>
  	self assert: disowningVMThread notNil.
  	self assert: (disowningVMThread state = CTMUnavailable
  				or: [disowningVMThread state = CTMWantingOwnership]).
  	self cCode: ''
  		inSmalltalk:
  			[| range |
  			 range := self cStackRangeForThreadIndex: disowningVMThread index.
  			 self assert: (range includes: CStackPointer).
  			 self assert: (range includes: CFramePointer)].
  	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).
  	"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.
  	activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
  	objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: activeProc
  		withValue: activeContext.
  	"Since pushing the awol process may realloc disowningVMThread we need to reassign.
  	 But since we're going to nil disowningVMThread anyway we can assign to a local."
  	preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread.
  	disowningVMThread := nil.
  	preemptedThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).
  	(self ownerIndexOfProcess: activeProc) = 0
  		ifTrue: [self setOwnerIndexOfProcess: activeProc to: preemptedThread index bind: false]
  		ifFalse: [self assert: (self ownerIndexOfProcess: activeProc) = preemptedThread index].
  	preemptedThread
  		newMethodOrNull: newMethod;
  		argumentCount: argumentCount;
+ 		primitiveFunctionPointer: primitiveFunctionPointer;
  		inMachineCode: instructionPointer asUnsignedInteger <= objectMemory startOfMemory!

Item was changed:
  ----- Method: CoInterpreterMT>>primitiveProcessBindToThreadId (in category 'process primitives') -----
  primitiveProcessBindToThreadId
  	"Attempt to bind the receiver to the thread with the id of the argument or nil, where the receiver is a Process.
  	 If successful the VM will ensure that there are at least id many threads active."
  	| aProcess id ec |
  	<export: true>
  	self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
  	id := self stackTop.
  	aProcess := self stackValue: 1.
  	((id = objectMemory nilObject or: [(objectMemory isIntegerObject: id)
  										and: [(objectMemory integerValueOf: id) >= 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 >= cogThreadManager maxNumThreads ifTrue:
  		[^self primitiveFailFor: PrimErrLimitExceeded].
  	(ec := self bindProcess: aProcess toId: id) ~= 0 ifTrue:
  		[^self primitiveFailFor: ec].
  	(aProcess = self activeProcess
  	and: [(activeProcessAffined := id ~= 0)
+ 	and: [(cogThreadManager vmOwnerIs: id) not]]) ifTrue:
- 	and: [id ~= cogThreadManager getVMOwner]]) ifTrue:
  		[(self quickFetchInteger: PriorityIndex ofObject: aProcess) < maxWaitingPriority ifTrue:
  			[maxWaitingPriority = self quickFetchInteger: PriorityIndex ofObject: aProcess].
  		 checkThreadActivation := true.
  		 self forceInterruptCheck].
+ 	self methodReturnReceiver!
- 	self pop: argumentCount!

Item was changed:
  ----- Method: CoInterpreterMT>>primitiveVMCurrentThreadId (in category 'process primitives') -----
  primitiveVMCurrentThreadId
  	<export: true>
  	"Answer the VM's current thread's Id"
  	self cCode: [] inSmalltalk: [cogThreadManager isNil ifTrue: [^self primitiveFail]].
+ 	self methodReturnInteger: cogThreadManager getVMOwner!
- 	self pop: 1 thenPushInteger: cogThreadManager getVMOwner!

Item was added:
+ ----- Method: CoInterpreterMT>>restoreVMStateFor:threadIndexAndFlags: (in category 'vm scheduling') -----
+ restoreVMStateFor: vmThread threadIndexAndFlags: threadIndexAndFlags
+ 	"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.
+ 	(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
+ 		ifTrue:
+ 			[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
+ 			 myProc := objectMemory splObj: foreignCallbackProcessSlot.
+ 			self assert: myProc ~= objectMemory nilObject.
+ 			objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
+ 		ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
+ 	self assert: activeProc ~= myProc.
+ 	(activeProc ~= objectMemory nilObject
+ 	 and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
+ 		[self putToSleep: activeProc yieldingIf: preemptionYields].
+ 	self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
+ 	objectMemory
+ 		storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
+ 		storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
+ 	"Only unaffine if the process was affined at this level and did not become bound in the interim."
+ 	((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
+ 	 and: [(self isBoundProcess: myProc) not]) ifTrue:
+ 		[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
+ 	self initPrimCall.
+ 	self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
+ 	"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.
+ 	primitiveFunctionPointer := vmThread primitiveFunctionPointer.
+ 	vmThread newMethodOrNull: nil.
+ 	self cCode: '' inSmalltalk:
+ 		[| range |
+ 		 range := self cStackRangeForThreadIndex: vmThread index.
+ 		 self assert: ((range includes: vmThread cStackPointer) and: [range includes: vmThread cFramePointer])].
+ 	self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
+ 	self assert: newMethod notNil
+ !

Item was changed:
  ----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') -----
  returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source
  	<var: #vmThread type: #'CogVMThread *'>
  	<inline: false>
  	self cCode:
  			[self flag: 'this is just for debugging.  Note the current C stack pointers'.
  			 cogThreadManager currentVMThread
  				cStackPointer: CStackPointer;
  				cFramePointer: CFramePointer]
  		inSmalltalk:
+ 			[| range | range := self cStackRangeForThreadIndex: cogThreadManager getVMOwner.
+ 			 self assert: ((range includes: CStackPointer) and: [range includes: CFramePointer])].
- 			[| range |
- 			 range := self cStackRangeForThreadIndex: cogThreadManager getVMOwner.
- 			 self assert: (range includes: CStackPointer).
- 			 self assert: (range includes: CFramePointer)].
  	self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source.
  	vmThread
  		ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index]
  		ifNil: [cogThreadManager releaseVM].
  	"I am not frightened of flying.
  	 Any value will do.  I don't mind.
  	 Why should I be frightened of flying?
  	 There's no reason for it."
  	self _longjmp: reenterThreadSchedulingLoop _: 1 !

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 *'>
  	| attemptToRun |
  	<inline: false>
  	self _setjmp: reenterThreadSchedulingLoop.
  	[self assert: vmThread state = CTMAssignableOrInVM.
  	 attemptToRun := false.
+ 	 (cogThreadManager vmOwnerIs: vmThread index)
- 	 (cogThreadManager getVMOwner = vmThread index)
  		ifTrue: [attemptToRun := true]
  		ifFalse:
  			[(cogit tryLockVMToIndex: vmThread index) ifTrue:
  				["If relinquishing is true, then primitiveRelinquishProcessor has disowned the
  				  VM and only a returning call or callback should take ownership in that case."
  				 relinquishing
  					ifTrue: [cogThreadManager releaseVM]
  					ifFalse: [attemptToRun := true]]].
  	 attemptToRun ifTrue:
  		[self tryToExecuteSmalltalk: vmThread].
+ 	 (cogThreadManager vmOwnerIs: vmThread index) ifFalse:
- 	 (cogThreadManager testVMOwnerIs: vmThread index) ifFalse:
  		[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: to switch threads if the new process is bound or affined to some other thread."
+ 	| newProcThreadId vmThread activeContext |
+ 	self assert: (cogThreadManager vmOwnerIs: cogThreadManager ioGetThreadLocalThreadIndex).
- 	| newProcThreadId vmThread activeContext tlti vmo |
- 	<var: #vmThread type: #'CogVMThread *'>
- 	self cCode: []
- 		inSmalltalk:
- 			[vmo := cogThreadManager getVMOwner.
- 			 tlti := cogThreadManager ioGetThreadLocalThreadIndex.
- 			 self assert: vmo = tlti].
  	deferThreadSwitch ifTrue: [^self].
+ 
+ 	"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 t6hread wants the VM."
  	newProcThreadId := self ownerIndexOfProcess: newProc.
  	((activeProcessAffined := newProcThreadId ~= 0)
+ 	 and: [(cogThreadManager vmOwnerIs: newProcThreadId) not]) ifFalse:
+ 		[(self quickFetchInteger: PriorityIndex ofObject: newProc) < maxWaitingPriority ifTrue:
+ 			[checkThreadActivation := true.
+ 			 self forceInterruptCheck].
+ 		^self].
+ 
+ 	"The current process is affined to a thread, but not to the current owner.  So switch to that owner."
+ 	self cCode: '' inSmalltalk:
+ 		[self transcript ensureCr; nextPutAll: #threadSwitchIfNecessary:from:; space; print: newProc;
+ 						space; print: cogThreadManager getVMOwner; nextPutAll: '->'; print: newProcThreadId; cr; flush].
+ 	 "If the activeProcess doesn't have a context yet, it needs one from which the new thread can resume execution."
+ 	 (objectMemory fetchPointer: SuspendedContextIndex ofObject: newProc) = objectMemory nilObject ifTrue:
+ 		[self assert: newProc = self activeProcess.
+ 		 self push: instructionPointer.
+ 		 self externalWriteBackHeadFramePointers.
+ 		 activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
+ 		 objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: activeContext].
+ 
+ 	 vmThread := cogThreadManager vmThreadAt: newProcThreadId.
+ 	 vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc).
+ 	 vmThread state = CTMUnavailable ifTrue:
+ 		[vmThread state: CTMWantingOwnership].
+ 	 self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSSwitchIfNeccessary!
- 	 and: [newProcThreadId ~= cogThreadManager getVMOwner]) ifTrue:
- 		[self cCode: ''
- 			inSmalltalk:
- 				[self transcript ensureCr; nextPutAll: #threadSwitchIfNecessary:from:; space; print: newProc;
- 								space; print: vmo; nextPutAll: '->'; print: newProcThreadId; cr; flush].
- 		 "If primitiveProcessBindToThreadId has bound a process and indicated a thread
- 		  switch is necessary we'll come in here but the activeProcess won't have a
- 		  context yet, and it needs one from which the new thread can resume execution."
- 		 (objectMemory fetchPointer: SuspendedContextIndex ofObject: newProc) = objectMemory nilObject ifTrue:
- 			[self assert: newProc = self activeProcess.
- 			 self push: instructionPointer.
- 			 self externalWriteBackHeadFramePointers.
- 			 activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
- 			 objectMemory storePointer: SuspendedContextIndex ofObject: newProc withValue: activeContext].
- 		 vmThread := cogThreadManager vmThreadAt: newProcThreadId.
- 		 vmThread priority: (self quickFetchInteger: PriorityIndex ofObject: newProc).
- 		 vmThread state = CTMUnavailable ifTrue:
- 				[vmThread state: CTMWantingOwnership].
- 		 self returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: CSSwitchIfNeccessary].
- 	(self quickFetchInteger: PriorityIndex ofObject: newProc) < maxWaitingPriority ifTrue:
- 		[checkThreadActivation := true.
- 		 self forceInterruptCheck]!

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 *'>
  	| dvmt activeProc ownerIndex |
  	<var: #dvmt type: #'CogVMThread *'>
+ 	self assert: (cogThreadManager vmOwnerIs: vmThread index).
- 	self assert: cogThreadManager getVMOwner = vmThread index.
  	self assert: cogThreadManager ioGetThreadLocalThreadIndex = vmThread index.
  	dvmt := disowningVMThread.
  	disowningVMThread
  		ifNil: [activeProc := self activeProcess]
  		ifNotNil:
  			[self preemptDisowningThread.
  			 activeProc := self wakeHighestPriority.
  			 activeProc
  				ifNil: [activeProc := objectMemory nilObject]
  				ifNotNil: [objectMemory
  							storePointerUnchecked: MyListIndex
  							ofObject: activeProc
  							withValue: objectMemory nilObject].
  			 objectMemory
  				storePointer: ActiveProcessIndex
  				ofObject: self schedulerPointer
  				withValue: activeProc].
  	activeProc = objectMemory nilObject ifTrue:
  		[cogThreadManager releaseVM.
  		 ^nil].
  	ownerIndex := self ownerIndexOfProcess: activeProc.
+ 	(ownerIndex = 0 or: [cogThreadManager vmOwnerIs: ownerIndex]) ifTrue:
+ 		[self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
+ 		 (objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc) ~= objectMemory nilObject ifTrue:
+ 			[self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc].
+ 		 self enterSmalltalkExecutive.
+ 		 "When we return here we should have already given up
+ 		  the VM and so we cannot touch any interpreter state."
+ 		"NOTREACHED"].
+ 	cogThreadManager wakeVMThreadFor: ownerIndex!
- 	(ownerIndex = 0
- 	 or: [ownerIndex ~= 0 and: [ownerIndex = cogThreadManager getVMOwner]])
- 		ifTrue:
- 			[self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
- 			 (objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc) ~= objectMemory nilObject ifTrue:
- 				[self externalSetStackPageAndPointersForSuspendedContextOfProcess: activeProc].
- 			 self enterSmalltalkExecutive.
- 			 "When we return here we should have already given up
- 			  the VM and so we cannot touch any interpreter state."]
- 		ifFalse:
- 			[cogThreadManager wakeVMThreadFor: ownerIndex]!

Item was changed:
  ----- Method: CogIA32Compiler>>cpuid: (in category 'feature detection') -----
  cpuid: n
  	<doNotGenerate>
  	"This is simulation only invocation of the throw-away CPUID function generated to initialize cpuidWord0 and cpuidWord1"
+ 	cogit processor abiMarshalArg0: n in: objectMemory memory.
+ 	^cogit simulateLeafCallOf: cogit methodZoneBase!
- 	^cogit
- 		simulateLeafCallOf: cogit methodZoneBase
- 		marshaling: [cogit processor abiMarshalArg0: n in: objectMemory memory]!

Item was changed:
  ----- Method: CogIA32Compiler>>numLowLevelLockOpcodes (in category 'multi-threading') -----
  numLowLevelLockOpcodes
  	<inline: #always>
  	"ceTryLockVMOwner:
  		movl 4(%esp), %ecx
  		xorl %eax, %eax
+ 		lock cmpxchgl %ecx, %ds:&vmOwnerLock			N.B. lock cmpxchgq are two separate opcodes
- 		lock cmpxchgl %ecx, %ds:&vmOwnerLock
  		setz %al 
- 		ret
- 	ceUnlockVMOwner:
- 		xorl %eax, %eax
- 		movl %eax, %ds:&vmOwnerLock
- 		sfence
  		ret"
+ 	^6!
- 	^10!

Item was changed:
  ----- Method: CogThreadManager>>acquireVMFor: (in category 'public api') -----
  acquireVMFor: threadIndex
  	"Attempt to acquire the VM, eventually blocking until it becomes available.
  	 Spin until the maxWaitingPriority has been updated if it is lower than this thread's priority."
  	<returnTypeC: #'CogVMThread *'>
  	| vmThread |
  	<var: #vmThread type: #'CogVMThread *'>
  	self assert: threadIndex = self ioGetThreadLocalThreadIndex.
  	vmThread := self vmThreadAt: threadIndex.
  	self assert: (vmThread state = CTMUnavailable
  				or: [vmThread state = CTMWantingOwnership]).
  	(cogit tryLockVMOwner: threadIndex) ifFalse:
  		[vmThread state: CTMWantingOwnership.
+ 		 [(self vmOwnerIs: threadIndex)
+ 		  or: [cogit tryLockVMOwner: threadIndex]] whileFalse:
- 		 [cogit tryLockVMOwner: threadIndex] whileFalse:
  			[[coInterpreter getMaxWaitingPriority < vmThread priority] whileTrue:
  				[coInterpreter waitingPriorityIsAtLeast: vmThread priority].
+ 			 (self vmOwnerIs: threadIndex) ifFalse:
- 			 vmOwner ~= threadIndex ifTrue:
  				[self ioWaitOnOSSemaphore: (self addressOf: vmThread osSemaphore)]]].
  	vmOSThread := vmThread osThread.
  	vmThread state: CTMAssignableOrInVM.
  	^vmThread!

Item was removed:
- ----- Method: CogThreadManager>>assertProcessor:isInThread: (in category 'simulation') -----
- assertProcessor: aProcessorAlien isInThread: aProcess
- 	<doNotGenerate>
- 	self assert: processorOwner == aProcess!

Item was changed:
  ----- Method: CogThreadManager>>currentVMThread (in category 'public api') -----
  currentVMThread
- 	<returnTypeC: #'CogVMThread *'>
  	^self vmThreadAt: self getVMOwner!

Item was changed:
  ----- Method: CogThreadManager>>ensureRunningVMThread: (in category 'public api') -----
  ensureRunningVMThread: vmIsRelinquishing
  	"Called from checkVMOwnershipFromHeartbeat if the VM is unowned.
  	 Hence we are in the heartbeat thread.  The race is against that thread
  	 owning the VM and against foreign callbacks."
  	<returnTypeC: #void>
  	<var: #vmThread type: #'CogVMThread *'>
  	self willingVMThread ifNotNil:
  		[:vmThread|
  		 "If the VM is relinquishing the processor then only schedule a thread if it has work to do."
  		 (vmIsRelinquishing
  		  and: [vmThread state ~= CTMWantingOwnership]) ifTrue:
  			[^self].
  		 (cogit tryLockVMToIndex: vmThread index) ifFalse: "someone beat us to it..."
  			[^self].
  		 vmOSThread := vmThread osThread.
  		 "release the thread from its blocking loop"
  		 self ioSignalOSSemaphore: (self addressOf: vmThread osSemaphore).
  		 self ioTransferTimeslice.
  		 "self cCode: [coInterpreter print: 'ERVT signalled '; printNum: vmThread index; cr]."
  		 ^self].
  
  	"If the VM is relinquishing the processor then only schedule a thread if it has work to do
+ 	 (willingVMThread not nil above).
- 	 (willingVMThread not nil above.
  	 If we have failed to allocate thread storage before there is no point continuing to
  	 try to do so.  By this time we should have quite a few threads in the pool."
+ 	(vmIsRelinquishing or: [memoryIsScarce]) ifTrue:
+ 		[^self].
+ 	self unusedThreadInfo ifNotNil:
+ 		[:vmThread|
+ 		 (cogit tryLockVMOwner: vmThread index) ifTrue:
+ 			[(self startThreadForThreadInfo: vmThread) ifFalse:
- 	(vmIsRelinquishing or: [memoryIsScarce]) ifFalse:
- 		[self unusedThreadInfo ifNotNil:
- 			[:vmThread|
- 			 self setVMOwner: vmThread index.
- 			 (self startThreadForThreadInfo: vmThread) ifFalse:
  				[self releaseVM]]]!

Item was changed:
+ ----- Method: CogThreadManager>>getVMOSThread (in category 'public api-vm platform code') -----
- ----- Method: CogThreadManager>>getVMOSThread (in category 'public api') -----
  getVMOSThread
  	"This is for signalSemaphoreWithIndex in Cross/vm/sqExternalSemaphores.c"
  	<api>
  	<returnTypeC: #sqOSThread>
  	^vmOSThread!

Item was changed:
  ----- Method: CogThreadManager>>ioExitOSThread: (in category 'simulation') -----
  ioExitOSThread: anOSThread
  	<doNotGenerate>
  	"See platforms/Cross/vm/sq.h for the real definition."
+ 	| active |
+ 	active := Processor activeProcess == anOSThread.
+ 	self halt.
  	anOSThread terminate.
  	self ioReleaseOSThreadState: anOSThread!

Item was changed:
  ----- Method: CogThreadManager>>setVMOwner: (in category 'public api') -----
  setVMOwner: index
  	<inline: false>
- 	self flag: #revisit.
  	vmOwner := index.
  	self sqLowLevelMFence!

Item was changed:
  ----- Method: CogThreadManager>>startThreadSubsystem (in category 'public api') -----
  startThreadSubsystem
  	"Initialize the threading subsystem, aborting if there is an error."
  	| vmThread |
- 	<var: #vmThread type: #'CogVMThread *'>
  	<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'].
  	vmThread := threads at: 1.
  	vmThread state: CTMInitializing.
  	self registerVMThread: vmThread.
  	vmThread state: CTMAssignableOrInVM.
  	self setVMOwner: 1!

Item was removed:
- ----- Method: CogThreadManager>>testVMOwnerIs: (in category 'locking') -----
- testVMOwnerIs: index
- 	"Test what the vmOwner is from a process that may not be the current VM owner"
- 	| retryCount ownerIsIndex |
- 	self assert: index ~= 0.
- 	retryCount := 0.
- 	[cogit tryLockVMOwner: index] whileFalse:
- 		[(retryCount := retryCount + 1) > 10 ifTrue:
- 			[self ioTransferTimeslice]].
- 	ownerIsIndex := self getVMOwner = index.
- 	cogit unlockVMOwner.
- 	^ownerIsIndex!

Item was added:
+ ----- Method: CogThreadManager>>vmIsOwned (in category 'public api-testing') -----
+ vmIsOwned
+ 	"Answer if the vm is owned"
+ 	<inline: #always>
+ 	self sqLowLevelMFence.
+ 	^vmOwner > 0!

Item was added:
+ ----- Method: CogThreadManager>>vmIsUnowned (in category 'public api-testing') -----
+ vmIsUnowned
+ 	^self vmOwnerIs: 0!

Item was changed:
+ ----- Method: CogThreadManager>>vmOwnerAddress (in category 'Cogit lock implementation') -----
- ----- Method: CogThreadManager>>vmOwnerAddress (in category 'public api') -----
  vmOwnerAddress
  	<api> "NB. For the JIT only, so it can generate the lock & unlock functions."
  	<returnTypeC: #usqInt>
  	^self
  		cCode: [(self addressOf: vmOwner) asUnsignedInteger]
  		inSmalltalk: [cogit simulatedReadWriteVariableAddress: #vmOwnerFromMachineCode in: self]!

Item was changed:
+ ----- Method: CogThreadManager>>vmOwnerFromMachineCode (in category 'Cogit lock implementation') -----
- ----- Method: CogThreadManager>>vmOwnerFromMachineCode (in category 'simulation') -----
  vmOwnerFromMachineCode
  	<doNotGenerate>
  	^vmOwner!

Item was changed:
+ ----- Method: CogThreadManager>>vmOwnerFromMachineCode: (in category 'Cogit lock implementation') -----
- ----- Method: CogThreadManager>>vmOwnerFromMachineCode: (in category 'simulation') -----
  vmOwnerFromMachineCode: aValue
  	<doNotGenerate>
  	self assert: (aValue between: 0 and: numThreads).
  	vmOwner := aValue!

Item was added:
+ ----- Method: CogThreadManager>>vmOwnerIs: (in category 'public api-testing') -----
+ vmOwnerIs: index
+ 	"Test if the vmOwner is index."
+ 	<inline: #always>
+ 	self sqLowLevelMFence.
+ 	^vmOwner = index!

Item was changed:
  ----- Method: CogThreadManager>>vmThreadAt: (in category 'public api') -----
  vmThreadAt: index
+ 	self assert: (index between: 0 and: numThreads).
+ 	^index > 0 ifTrue: [threads at: index]!
- 	<returnTypeC: #'CogVMThread *'>
- 	self assert: (index between: 1 and: numThreads).
- 	^threads at: index!

Item was changed:
  ----- Method: CogThreadManager>>waitForWork: (in category 'public api') -----
  waitForWork: vmThread
  	"Wait for work."
  	<var: #vmThread type: #'CogVMThread *'>
  	<returnTypeC: #void>
  	self assert: vmThread state = CTMAssignableOrInVM.
+ 	self deny: (self vmOwnerIs: vmThread index).
- 	self assert: vmOwner ~= vmThread index.
  	self ioWaitOnOSSemaphore: (self addressOf: vmThread osSemaphore)!

Item was changed:
  ----- Method: CogThreadManager>>wakeVMThreadFor: (in category 'public api') -----
  wakeVMThreadFor: index
  	"Transfer the VM to the thread with index.  Called from a thread that finds the
  	 highest priority runnable process is bound to the thread with index index."
  	<returnTypeC: #void>
  	| vmThread |
+ 	self assert: (self vmIsOwned and: [(self vmOwnerIs: index) not]).
+ 	self assert: (index between: 1 and: numThreads).
- 	<var: #vmThread type: #'CogVMThread *'>
- 	self assert: (vmOwner > 0 and: [vmOwner ~= index]).
- 	self assert: index <= numThreads.
  	self setVMOwner: index.
  	vmThread := threads at: index.
+ 	vmThread state
+ 		ifNil: [self startThreadForThreadInfo: vmThread]
+ 		ifNotNil:
- 	vmThread state = nil
- 		ifTrue: [self startThreadForThreadInfo: vmThread]
- 		ifFalse:
  			[self assert: vmThread state = CTMWantingOwnership.
  			 self ioSignalOSSemaphore: (self addressOf: vmThread osSemaphore)].
  	self ioTransferTimeslice!

Item was changed:
  ----- Method: CogThreadManager>>willingVMThread (in category 'thread set') -----
  willingVMThread
  	"Answer a pointer to a live CogVMThread in any of the ``will do VM work''
  	 states (other than the current owner if the VM is owned), or nil if none.
  	 Preferentially answer threads wanting ownership."
  	<returnTypeC: #'CogVMThread *'>
  	| thread threadWantingVM threadWilling |
  	<inline: false>
- 	<var: #thread type: #'CogVMThread *'>
- 	<var: #threadWantingVM type: #'CogVMThread *'>
- 	<var: #threadWilling type: #'CogVMThread *'>
  	threadWantingVM := threadWilling := nil.
  	1 to: numThreads do:
  		[:i|
+ 		 (self vmOwnerIs: i) ifFalse:
- 		 i ~= vmOwner ifTrue:
  			[thread := threads at: i.
  			 thread state =  CTMWantingOwnership ifTrue:
  				[(threadWantingVM isNil
  				  or: [threadWantingVM priority < thread priority]) ifTrue:
  					[threadWantingVM := thread]].
  			 thread state =  CTMAssignableOrInVM ifTrue:
  				[(threadWilling isNil
  				  or: [threadWilling priority < thread priority]) ifTrue:
  					[threadWilling := thread]]]].
+ 	^threadWantingVM ifNil:
+ 		[threadWilling]!
- 	threadWantingVM ifNotNil:
- 		[^threadWantingVM].
- 	threadWilling ifNotNil:
- 		[^threadWilling].
- 	^nil!

Item was removed:
- ----- Method: CogVMSimulator>>assertCStackPointersBelongToCurrentVMOwner (in category 'multi-threading simulation switch') -----
- assertCStackPointersBelongToCurrentVMOwner
- 	"This method includes or excludes CoInterpreterMT methods as required.
- 	 Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
- 
- 	^self perform: #assertCStackPointersBelongToCurrentVMOwner
- 		withArguments: {}
- 		inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was removed:
- ----- Method: CogVMSimulator>>cStackRangeForCurrentVMOwner (in category 'multi-threading simulation switch') -----
- cStackRangeForCurrentVMOwner
- 	"This method includes or excludes CoInterpreterMT methods as required.
- 	 Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
- 
- 	^self perform: #cStackRangeForCurrentVMOwner
- 		withArguments: {}
- 		inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was changed:
  ----- Method: CogVMSimulator>>initialEnterSmalltalkExecutive (in category 'initialization') -----
  initialEnterSmalltalkExecutive
  	"Main entry-point into the interpreter at system start-up.
  	 Override to choose between the threaded and non-threaded versions and if threaded
  	 to ensure that the switch method overrides are up-to-date."
  	self ensureMultiThreadingOverridesAreUpToDate.
+ 	self assert: (cogit processor fp = CFramePointer and: [cogit processor sp = CStackPointer]).
  	^self perform: #initialEnterSmalltalkExecutive
  		withArguments: {}
  		inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was changed:
  VMStructType subclass: #CogVMThread
+ 	instanceVariableNames: 'index state priority osSemaphore osThread newMethodOrNull argumentCount primitiveFunctionPointer inMachineCode cStackPointer cFramePointer reenterInterpreter awolProcIndex awolProcLength awolProcesses'
- 	instanceVariableNames: 'index state priority osSemaphore osThread newMethodOrNull argumentCount inMachineCode cStackPointer cFramePointer reenterInterpreter awolProcIndex awolProcLength awolProcesses'
  	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 added:
+ ----- Method: CogVMThread>>primitiveFunctionPointer (in category 'accessing') -----
+ primitiveFunctionPointer
+ 	"Answer the value of primitiveFunctionPointer"
+ 
+ 	^primitiveFunctionPointer!

Item was added:
+ ----- Method: CogVMThread>>primitiveFunctionPointer: (in category 'accessing') -----
+ primitiveFunctionPointer: anObject
+ 	"Set the value of primitiveFunctionPointer"
+ 
+ 	^primitiveFunctionPointer := anObject!

Item was added:
+ ----- Method: CogVMThread>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream
+ 		nextPutAll: ' index: '; print: index;
+ 		nextPutAll: ' state: '; nextPutAll: (VMThreadingConstants keys
+ 											detect: [:k| k first == $C and: [(VMThreadingConstants classPool at: k) = state]]
+ 											ifNone: [state printString])!

Item was changed:
  ----- Method: CogX64Compiler>>detectFeatures (in category 'feature detection') -----
  detectFeatures
  	"Do a throw-away compilation to get at the cpuid info and initialize cpuidWord1
  	 N.B. All of MSVC, gcc & clang have intrinsics for this, so if you have the energy
  	 by all means reimplement as an #if _MSC_VER...#elif __GNUC__ #else ... saga."
  	| startAddress cpuid |
  	<var: 'cpuid' declareC: 'uintptr_t (*cpuid)(void)'>
  	startAddress := cogit methodZoneBase.
  	cogit allocateOpcodes: 10 bytecodes: 0.
  	cpuid := cogit cCoerceSimple: startAddress to: #'uintptr_t (*)(void)'.
  	cogit
  		PushR: RDX;
  		PushR: RCX;
  		PushR: RBX;
  		MoveCq: 16r80000001 R: RAX;
  		gen: CPUID;
  		MoveR: RCX R: RAX;
  		PopR: RBX;
  		PopR: RCX;
  		PopR: RDX;
  		RetN: 0.
  	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
  	cogit resetMethodZoneBase: startAddress.
+ 	self setCpuidWord1: (self cCode: 'cpuid()' inSmalltalk: [cogit simulateLeafCallOf: startAddress])!
- 	self setCpuidWord1: (self cCode: 'cpuid()' inSmalltalk: [cogit simulateLeafCallOf: startAddress marshaling: []])!

Item was changed:
  ----- Method: CogX64Compiler>>numLowLevelLockOpcodes (in category 'multi-threading') -----
  numLowLevelLockOpcodes
  	<inline: #always>
  	"ceTryLockVMOwner:
  		xorq %rax, %rax
  		movq &vmOwnerLock, %rsi
  		lock cmpxchgq %rdi, (%rsi) 			N.B. lock cmpxchgq are two separate opcodes
  		setz %alt
- 		ret
- 	 ceUnlockVMOwner:
- 		xorq %rax, %rax
- 		movq %rax, &vmOwnerLockFromMachineCode
- 		sfence
  		ret"
+ 	^6!
- 	^10!

Item was changed:
  CogClass subclass: #Cogit
(excessive size, no diff calculated)

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| backEnd |
  	backEnd := CogCompilerClass basicNew.
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetFP
  			declareC: 'usqIntptr_t (*ceGetFP)(void)';
  		var: #ceGetSP
  			declareC: 'usqIntptr_t (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceInvokeInterpret
  			declareC: 'void (*ceInvokeInterpret)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *';
  		var: 'enumeratingCogMethod' type: #'CogMethod *'.
  	
  	aCCodeGenerator
  		var: #ceTryLockVMOwner
+ 		declareC: '#if COGMTVM\uintptr_t (*ceTryLockVMOwner)(uintptr_t);\#endif'.
- 			declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(void)';
- 		var: #ceUnlockVMOwner
- 			declareC: 'void (*ceUnlockVMOwner)(void)\#endif /* COGMTVM */'.
  
  	backEnd numICacheFlushOpcodes > 0 ifTrue:
  		[aCCodeGenerator
  			var: #ceFlushICache
  				declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'].
  	aCCodeGenerator
  		var: #ceFlushDCache
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif';
  		var: #codeToDataDelta
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'.
  
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
  					fullBlockNoContextSwitchEntry fullBlockEntry
  					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #cPICPrototype type: #'CogMethod *';
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *';
  		declareVar: #methodZoneBase type: #usqInt.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
  	BytecodeSetHasDirectedSuperSend ifTrue:
  		[aCCodeGenerator
  			var: #directedSuperSendTrampolines
  				declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  			var: #directedSuperBindingSendTrampolines
  				declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
  	NewspeakVM ifTrue:
  		[aCCodeGenerator
  			var: #selfSendTrampolines
  				declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  			var: #dynamicSuperSendTrampolines
  				declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  			var: #implicitReceiverSendTrampolines
  				declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  			var: #outerSendTrampolines
  				declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
  	aCCodeGenerator
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #minValidCallAddress type: #'usqIntptr_t'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltalk generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'.
  	self declareFlagVarsAsByteIn: aCCodeGenerator!

Item was changed:
  ----- Method: Cogit>>ceCaptureCStackPointers (in category 'jit - api') -----
  ceCaptureCStackPointers
  	<api: 'extern void (*ceCaptureCStackPointers)()'>
  	<doNotGenerate>
  	| range |
  	coInterpreter isCurrentImageFacade ifTrue:
  		[^self].
+ 	self simulateLeafCallOf: ceCaptureCStackPointers.
- 	coInterpreter isThreadedVM ifFalse:
- 		[^self simulateLeafCallOf: ceCaptureCStackPointers marshaling: []].
  	thisContext sender selector == #generateStackPointerCapture ifTrue:
  		[^self].
+ 	coInterpreter isThreadedVM ifTrue:
+ 		[range := coInterpreter cStackRangeForThreadIndex: coInterpreter threadManager getVMOwner.
+ 		 self assert: (range notNil "VM is owned"
+ 					and: [(range includes: coInterpreter getCFramePointer)
+ 					and: [range includes: coInterpreter getCStackPointer]])]!
- 	range := coInterpreter cStackRangeForThreadIndex: coInterpreter threadManager getVMOwner.
- 	self assert: (range notNil "VM is owned"
- 				and: [(range includes: processor sp)
- 				and: [range includes: processor fp]]).
- 	coInterpreter setCFramePointer: processor fp setCStackPointer: processor sp!

Item was changed:
  ----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') -----
  generateVMOwnerLockFunctions
- 	| startAddress |
  	<inline: true>
+ 	self cppIf: COGMTVM ifTrue:
+ 		[| startAddress |
+ 		self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
+ 		self zeroOpcodeIndex.
+ 		startAddress := methodZoneBase.
+ 		backEnd generateLowLevelTryLock: coInterpreter vmOwnerAddress.
+ 		self outputInstructionsForGeneratedRuntimeAt: startAddress.
+ 		self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
+ 		ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'uintptr_t (*)(uintptr_t)']!
- 	self cppIf: COGMTVM
- 		ifTrue:
- 			[self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
- 			self zeroOpcodeIndex.
- 			startAddress := methodZoneBase.
- 			backEnd generateLowLevelTryLock: coInterpreter vmOwnerAddress.
- 			self outputInstructionsForGeneratedRuntimeAt: startAddress.
- 			self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
- 			ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
- 
- 			self zeroOpcodeIndex.
- 			initialPC := 0.
- 			endPC := numAbstractOpcodes - 1.
- 			startAddress := methodZoneBase.
- 			backEnd generateLowLevelUnlock: coInterpreter vmOwnerAddress.
- 			self outputInstructionsForGeneratedRuntimeAt: startAddress.
- 			self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress.
- 			ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  	<doNotGenerate>
  	| evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc |
  
  	"This is a hack fix before we revise the simulators.  When a jump call is made, the next
  	 pc is effectively the return address on the stack, not the instruction following the jump."
  	aProcessorSimulationTrap type == #jump ifTrue:
  		[processor hackFixNextPCOfJumpFor: aProcessorSimulationTrap using: objectMemory].
  
  	evaluable := simulatedTrampolines
  					at: aProcessorSimulationTrap address
  					ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  								in: simulatedTrampolines].
  	function := evaluable isBlock
  					ifTrue: ['aBlock; probably some plugin primitive']
  					ifFalse:
  						[evaluable receiver == backEnd ifTrue:
  							[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  						 evaluable selector].
  	memory := coInterpreter memory.
+ 	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret/ceReturnToInterpreterTrampoline and should discard all state back to enterSmalltalkExecutiveImplementation"
+ 		[false ifTrue:
+ 			[processor "No longer appropriate to do anything; this is a direct jump; the trampolines have done everything"
+ 				simulateJumpCallOf: aProcessorSimulationTrap address
+ 				memory: memory].
- 	function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret and should discard all state back to enterSmalltalkExecutiveImplementation"
- 		[processor
- 			simulateJumpCallOf: aProcessorSimulationTrap address
- 			memory: memory.
  		 self recordInstruction: {'(simulated jump call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory.
  		 coInterpreter reenterInterpreter.
  		 "NOTREACHED"
  		 self halt].
  	function ~~ #ceBaseFrameReturn: ifTrue:
  		[coInterpreter assertValidExternalStackPointers].
  	(backEnd wantsNearAddressFor: function) ifTrue:
  		[^self perform: function with: aProcessorSimulationTrap].
  	processor
  		simulateCallOf: aProcessorSimulationTrap address
  		nextpc: aProcessorSimulationTrap nextpc
  		memory: memory.
  	retpc := processor retpcIn: memory.
  	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  	savedFramePointer := coInterpreter framePointer.
  	savedStackPointer := coInterpreter stackPointer.
  	savedArgumentCount := coInterpreter argumentCount.
  	result := ["self halt: evaluable selector."
  		   	   clickConfirm ifTrue:
  			 	[(self confirm: 'skip run-time call?') ifFalse:
  					[clickConfirm := false. self halt]].
  			   evaluable valueWithArguments: (processor
  												postCallArgumentsNumArgs: evaluable numArgs
  												in: memory)]
  				on: ReenterMachineCode
  				do: [:ex| ex return: #continueNoReturn].
  			
  	coInterpreter assertValidExternalStackPointers.
  	"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  	 not called something that has built a frame, such as closure value or evaluate method, or
  	 switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  	(function beginsWith: 'primitive') ifTrue:
  		[coInterpreter primFailCode = 0
  			ifTrue: [(CogVMSimulator stackAlteringPrimitives includes: function) ifFalse:
  						["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
  						 (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
  							[self assert: savedFramePointer = coInterpreter framePointer.
  							 self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
  									= coInterpreter stackPointer]]]
  			ifFalse:
  				[self assert: savedFramePointer = coInterpreter framePointer.
  				 self assert: savedStackPointer = coInterpreter stackPointer]].
  	result ~~ #continueNoReturn ifTrue:
  		[self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
  		 processor simulateReturnIn: memory.
  		 self assert: processor pc = retpc.
  		 processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory].
  	self assert: (result isInteger "an oop result"
  			or: [result == coInterpreter
  			or: [result == objectMemory
  			or: [result == nil
  			or: [result == #continueNoReturn]]]]).
  	processor cResultRegister: (result
  								ifNil: [0]
  								ifNotNil: [result isInteger
  											ifTrue: [result]
  											ifFalse: [16rF00BA222]])!

Item was changed:
  ----- Method: Cogit>>simulateCeFlushDCacheFrom:to: (in category 'simulation only') -----
  simulateCeFlushDCacheFrom: start to: finish
  	<doNotGenerate>
+ 	processor abiMarshalArg0: start arg1: finish in: objectMemory memory.
+ 	self simulateLeafCallOf: ceFlushDCache!
- 	self simulateLeafCallOf: ceFlushDCache
- 		marshaling: [processor abiMarshalArg0: start arg1: finish in: objectMemory memory]!

Item was changed:
  ----- Method: Cogit>>simulateCeFlushICacheFrom:to: (in category 'simulation only') -----
  simulateCeFlushICacheFrom: start to: finish
  	<doNotGenerate>
+ 	processor abiMarshalArg0: start arg1: finish in: objectMemory memory.
+ 	self simulateLeafCallOf: ceFlushICache!
- 	self simulateLeafCallOf: ceFlushICache
- 		marshaling: [processor abiMarshalArg0: start arg1: finish in: objectMemory memory]!

Item was added:
+ ----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
+ simulateLeafCallOf: someFunction
+ 	"Simulate execution of machine code that leaf-calls someFunction,
+ 	 answering the result returned by someFunction."
+ 	"CogProcessorAlienInspector openFor: coInterpreter"
+ 	<doNotGenerate>
+ 	| priorSP priorPC priorLR spOnEntry bogusRetPC |
+ 	self recordRegisters.
+ 	priorSP := processor sp.
+ 	priorPC := processor pc.
+ 	priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
+ 	processor
+ 		simulateLeafCallOf: someFunction
+ 		nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
+ 		memory: coInterpreter memory.
+ 	spOnEntry := processor sp.
+ 	self recordInstruction: {'(simulated call of '. someFunction. ')'}.
+ 	^[[processor pc between: self class guardPageSize and: methodZone zoneEnd] whileTrue:
+ 		[[singleStep
+ 			ifTrue: [self recordProcessing.
+ 					self maybeBreakAt: processor pc.
+ 					processor
+ 						singleStepIn: coInterpreter memory
+ 						minimumAddress: guardPageSize
+ 						readOnlyBelow: methodZone zoneEnd]
+ 			ifFalse: [processor
+ 						runInMemory: coInterpreter memory
+ 						minimumAddress: guardPageSize
+ 						readOnlyBelow: methodZone zoneEnd]]
+ 			on: ProcessorSimulationTrap, Error
+ 			do: [:ex|
+ 				"Again this is a hack for the processor simulators not properly simulating returns to bogus addresses.
+ 				 In this case BochsX64Alien doesn't do the right thing."
+ 				processor pc = bogusRetPC ifTrue:
+ 					[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
+ 					 ^processor cResultRegister].
+ 				ex isProcessorSimulationTrap ifFalse:
+ 					[ex pass].
+ 				ex applyTo: self.
+ 				ex type == #return ifTrue:
+ 					[^processor cResultRegister]]].
+ 	processor pc = bogusRetPC ifTrue:
+ 		[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
+ 	processor cResultRegister]
+ 		ensure:
+ 			[processor sp: priorSP.
+ 			 processor pc: priorPC.
+ 			 priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was removed:
- ----- Method: Cogit>>simulateLeafCallOf:marshaling: (in category 'simulation only') -----
- simulateLeafCallOf: someFunction marshaling: marshallingBlock
- 	"Simulate execution of machine code that leaf-calls someFunction,
- 	 answering the result returned by someFunction."
- 	"CogProcessorAlienInspector openFor: coInterpreter"
- 	<doNotGenerate>
- 	| priorSP priorPC priorLR spOnEntry bogusRetPC |
- 	self recordRegisters.
- 	priorSP := processor sp.
- 	priorPC := processor pc.
- 	priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
- 	processor
- 		setFramePointer: coInterpreter getCFramePointer
- 		stackPointer: coInterpreter getCStackPointer.
- 	marshallingBlock value.
- 	processor
- 		simulateLeafCallOf: someFunction
- 		nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
- 		memory: coInterpreter memory.
- 	spOnEntry := processor sp.
- 	self recordInstruction: {'(simulated call of '. someFunction. ')'}.
- 	^[[processor pc between: self class guardPageSize and: methodZone zoneEnd] whileTrue:
- 		[[singleStep
- 			ifTrue: [self recordProcessing.
- 					self maybeBreakAt: processor pc.
- 					processor
- 						singleStepIn: coInterpreter memory
- 						minimumAddress: guardPageSize
- 						readOnlyBelow: methodZone zoneEnd]
- 			ifFalse: [processor
- 						runInMemory: coInterpreter memory
- 						minimumAddress: guardPageSize
- 						readOnlyBelow: methodZone zoneEnd]]
- 			on: ProcessorSimulationTrap, Error
- 			do: [:ex|
- 				"Again this is a hack for the processor simulators not properly simulating returns to bogus addresses.
- 				 In this case BochsX64Alien doesn't do the right thing."
- 				processor pc = bogusRetPC ifTrue:
- 					[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
- 					 ^processor cResultRegister].
- 				ex isProcessorSimulationTrap ifFalse:
- 					[ex pass].
- 				ex applyTo: self.
- 				ex type == #return ifTrue:
- 					[^processor cResultRegister]]].
- 	processor pc = bogusRetPC ifTrue:
- 		[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
- 	processor cResultRegister]
- 		ensure:
- 			[processor sp: priorSP.
- 			 processor pc: priorPC.
- 			 priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was changed:
  ----- Method: Cogit>>tryLockVMOwner: (in category 'multi-threading') -----
  tryLockVMOwner: value
  	<api>
  		"ceTryLockVMOwner does an atomic compare-and-swap of the lock
  		 with the argument and zero, setting the lock to value if it was zero. 
  		 It answers non-zero if the lock was zero."
  	<cmacro: '(value) ceTryLockVMOwner(value)'>
+ 	processor abiMarshalArg0: value in: objectMemory memory.
+ 	^0 ~= (self simulateLeafCallOf: ceTryLockVMOwner)!
- 	^0 ~= (self
- 				simulateLeafCallOf: ceTryLockVMOwner
- 				marshaling: [processor abiMarshalArg0: value in: objectMemory memory])!

Item was removed:
- ----- Method: Cogit>>unlockVMOwner (in category 'multi-threading') -----
- unlockVMOwner
- 	<api>
- 	<cmacro: '() ceUnlockVMOwner()'>
- 	^self simulateLeafCallOf: ceUnlockVMOwner marshaling: []!

Item was changed:
+ VMLongJumpSimulation subclass: #ReenterInterpreter
+ 	instanceVariableNames: ''
- Notification subclass: #ReenterInterpreter
- 	instanceVariableNames: 'returnValue'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!

Item was removed:
- ----- Method: ReenterInterpreter>>returnValue (in category 'accessing') -----
- returnValue
- 	"Answer the value of returnValue"
- 
- 	^ returnValue!

Item was removed:
- ----- Method: ReenterInterpreter>>returnValue: (in category 'accessing') -----
- returnValue: anObject
- 	"Set the value of returnValue"
- 
- 	returnValue := anObject!

Item was changed:
+ VMLongJumpSimulation subclass: #ReenterMachineCode
+ 	instanceVariableNames: ''
- Notification subclass: #ReenterMachineCode
- 	instanceVariableNames: 'returnValue'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!

Item was removed:
- ----- Method: ReenterMachineCode>>returnValue (in category 'accessing') -----
- returnValue
- 	"Answer the value of returnValue"
- 
- 	^ returnValue!

Item was removed:
- ----- Method: ReenterMachineCode>>returnValue: (in category 'accessing') -----
- returnValue: anObject
- 	"Set the value of returnValue"
- 
- 	returnValue := anObject!

Item was changed:
+ VMLongJumpSimulation subclass: #ReenterThreadSchedulingLoop
+ 	instanceVariableNames: ''
- Notification subclass: #ReenterThreadSchedulingLoop
- 	instanceVariableNames: 'returnValue'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!

Item was changed:
  ----- Method: SocketPluginSimulator>>sqResolverNameLookupResult (in category 'simulation') -----
  sqResolverNameLookupResult
  	"For now don't simulate the implicit semaphore."
  	addressForName ifNil: [^interpreterProxy primitiveFail].
+ 	self assert: (addressForName size >= 4 and: [addressForName size \\ 4 = 0]).
- 	self assert: addressForName size = 4.
  	"Effectively netAddressToInt: bytes"
  	^	((addressForName at: 4)) +
  		((addressForName at: 3) <<8) +
  		((addressForName at: 2) <<16) +
  		((addressForName at: 1) <<24)!

Item was changed:
  ----- Method: StackInterpreter>>_setjmp: (in category 'primitive support') -----
  _setjmp: aJumpBuf
  	"Hack simulation of _setjmp/_longjmp, intended to invoke the most minimal setjmp/longjmp
  	 pair available on the platform; no saving/restoring signal masks, no stack unwinding, etc." 
  	<doNotGenerate>
  	self assert: (#(ReenterInterpreter ReenterThreadSchedulingLoop) includes: aJumpBuf class name).
+ 	^aJumpBuf returnValue ifNil: [0]!
- 	^0!

Item was added:
+ Notification subclass: #VMLongJumpSimulation
+ 	instanceVariableNames: 'returnValue'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JITSimulation'!
+ 
+ !VMLongJumpSimulation commentStamp: 'eem 10/30/2020 10:24' prior: 0!
+ A VMLongJumpSimulation is an exception used to simulate a _setjmp:/_longjmp: pair.  An instance variable which is typed as a jmpbuf in the real VM holds onto a sub-instance of VMLongJumpSimulation. _longjmp:_: then sets its return value and signals it.  It is the responsibility of the holder of the inst var/sender of _setjmp: to provide an exception handler for the exception artound the point where _setjmp: is called.  See for example StackInterpreter>>enterSmalltalkExecutive that provides the exception handler and invoking enterSmalltalkExecutiveImplementation to do the real work. A macro in enterSmalltalkExecutive is used to arrange that in the real VM a mention of enterSmalltalkExecutive is replaced by a use of enterSmalltalkExecutiveImplementation.
+ 
+ Instance Variables
+ 	returnValue:		<Object>
+ 
+ returnValue
+ 	- the value to be "returned from" _setjmp:, sort-of.
+ !

Item was added:
+ ----- Method: VMLongJumpSimulation>>returnValue (in category 'accessing') -----
+ returnValue
+ 	"Answer the value of returnValue"
+ 
+ 	^ returnValue!

Item was added:
+ ----- Method: VMLongJumpSimulation>>returnValue: (in category 'accessing') -----
+ returnValue: anObject
+ 	"Set the value of returnValue"
+ 
+ 	returnValue := anObject!



More information about the Vm-dev mailing list