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

commits at source.squeak.org commits at source.squeak.org
Mon Jan 3 19:40:06 UTC 2022


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

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

Name: VMMaker.oscog-eem.3131
Author: eem
Time: 3 January 2022, 11:39:57.008217 am
UUID: 9a5800ea-896c-482e-bf64-27a44c5c97c1
Ancestors: VMMaker.oscog-eem.3130

...and rename backupProcess:toBlockingSendTo: to backupContext:toBlockingSendTo: because that's what it does and it saves an access

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

Item was added:
+ ----- Method: CoInterpreter>>backupContext:toBlockingSendTo: (in category 'process primitive support') -----
+ backupContext: suspendedContext toBlockingSendTo: conditionVariable
+ 	"Assume aProcess is waiting on a condition variable.
+ 	 Backup the PC of aProcess to the send that entered the wait state.
+ 	 Since the PC at a send is not a susension point in machine code, this
+ 	 entails converting a machine code frame into an interpreter frame.
+ 	 primitiveEnterCriticalSection pushes false for blocked waiters. false
+ 	 must be replaced by the condition variable."
+ 
+ 	| theMethod pc sp theIP theNewIP theFP thePage |
+ 	self assert: (objectMemory isContext: suspendedContext).
+ 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: suspendedContext.
+ 	(self isSingleContext: suspendedContext) ifTrue:
+ 		[pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: suspendedContext.
+ 		 sp := objectMemory fetchPointer: StackPointerIndex ofObject: suspendedContext.
+ 		 self assert: ((objectMemory isIntegerObject: pc) and: [(objectMemory integerValueOf: pc) > 0]).
+ 		 self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]).
+ 		 theIP := theMethod + objectMemory baseHeaderSize + (objectMemory integerValueOf: pc) - 1.
+ 		 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
+ 		 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
+ 		 pc := theNewIP - theMethod - objectMemory baseHeaderSize + 1.
+ 		 objectMemory
+ 			storePointerUnchecked: InstructionPointerIndex
+ 			ofObject: suspendedContext
+ 			withValue: (objectMemory integerObjectOf: pc).
+ 		 sp := (objectMemory integerValueOf: sp) + ReceiverIndex. "implicitly converts to 0 relative"
+ 		 self assert: ((objectMemory fetchPointer: sp ofObject: suspendedContext) = objectMemory falseObject
+ 					or: [(objectMemory fetchPointer: sp ofObject: suspendedContext) = conditionVariable]).
+ 		 objectMemory storePointer: sp ofObject: suspendedContext withValue: conditionVariable.
+ 		 ^self].
+ 	self assert: (self isMarriedOrWidowedContext: suspendedContext).
+ 	self deny: (self isWidowedContextNoConvert: suspendedContext).
+ 	theFP := self frameOfMarriedContext: suspendedContext.
+ 	thePage := stackPages stackPageFor: theFP.
+ 	self deny: thePage = stackPage.
+ 	self assert: theFP = thePage headFP.
+ 	(self isMachineCodeFrame: theFP)
+ 		ifTrue:
+ 			[| mcpc maybeClosure startBcpc cogMethodForIP |
+ 			 mcpc := stackPages longAt: thePage headSP. "a machine code pc... it must be converted..."
+ 			 maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: suspendedContext.
+ 			 (maybeClosure ~= objectMemory nilObject
+ 			  and: [self isVanillaBlockClosure: maybeClosure])
+ 				ifTrue: [cogMethodForIP := self mframeHomeMethod: theFP.
+ 						startBcpc := self startPCOfClosure: maybeClosure]
+ 				ifFalse: [cogMethodForIP := self cCoerceSimple: (self mframeMethod: theFP) to: #'CogMethod *'.
+ 						startBcpc := self startPCOfMethod: theMethod].
+ 			 theIP := cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP.
+ 			 theIP := theIP + theMethod + objectMemory baseHeaderSize.
+ 			 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
+ 			 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
+ 			 self convertFrame: theFP toInterpreterFrame: theIP - theNewIP]
+ 		ifFalse:
+ 			[theIP := stackPages longAt: thePage headSP.
+ 			 theIP = cogit ceReturnToInterpreterPC
+ 				ifTrue:
+ 					[theIP := (self iframeSavedIP: theFP) + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
+ 					 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
+ 					 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
+ 					 self iframeSavedIP: theFP put: theNewIP - 1] "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
+ 				ifFalse:
+ 					[theIP := theIP + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
+ 					 self assert: (self validInstructionPointer: theIP inMethod: theMethod framePointer: theFP).
+ 					 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
+ 					 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
+ 					 stackPages longAt: thePage headSP put: theNewIP - 1]]. "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
+ 	self assert: ((stackPages longAt: thePage headSP + objectMemory wordSize) = objectMemory falseObject
+ 				or: [(stackPages longAt: thePage headSP + objectMemory wordSize) = conditionVariable]).
+ 	stackPages longAt: thePage headSP + objectMemory wordSize put: conditionVariable!

Item was removed:
- ----- Method: CoInterpreter>>backupProcess:toBlockingSendTo: (in category 'process primitive support') -----
- backupProcess: aProcess toBlockingSendTo: conditionVariable
- 	"Assume aProcess is waiting on a condition variable.
- 	 Backup the PC of aProcess to the send that entered the wait state.
- 	 Since the PC at a send is not a susension point in machine code, this
- 	 entails converting a machine code frame into an interpreter frame.
- 	 primitiveEnterCriticalSection pushes false for blocked waiters. false
- 	 must be replaced by the condition variable."
- 
- 	| context theMethod pc sp theIP theNewIP theFP thePage |
- 	context := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
- 	self assert: (objectMemory isContext: context).
- 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: context.
- 	(self isSingleContext: context) ifTrue:
- 		[pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: context.
- 		 sp := objectMemory fetchPointer: StackPointerIndex ofObject: context.
- 		 self assert: ((objectMemory isIntegerObject: pc) and: [(objectMemory integerValueOf: pc) > 0]).
- 		 self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]).
- 		 theIP := theMethod + objectMemory baseHeaderSize + (objectMemory integerValueOf: pc) - 1.
- 		 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
- 		 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
- 		 pc := theNewIP - theMethod - objectMemory baseHeaderSize + 1.
- 		 objectMemory
- 			storePointerUnchecked: InstructionPointerIndex
- 			ofObject: context
- 			withValue: (objectMemory integerObjectOf: pc).
- 		 sp := (objectMemory integerValueOf: sp) + ReceiverIndex. "implicitly converts to 0 relative"
- 		 self assert: ((objectMemory fetchPointer: sp ofObject: context) = objectMemory falseObject
- 					or: [(objectMemory fetchPointer: sp ofObject: context) = conditionVariable]).
- 		 objectMemory storePointer: sp ofObject: context withValue: conditionVariable.
- 		 ^self].
- 	self assert: (self isMarriedOrWidowedContext: context).
- 	self deny: (self isWidowedContextNoConvert: context).
- 	theFP := self frameOfMarriedContext: context.
- 	thePage := stackPages stackPageFor: theFP.
- 	self deny: thePage = stackPage.
- 	self assert: theFP = thePage headFP.
- 	(self isMachineCodeFrame: theFP)
- 		ifTrue:
- 			[| mcpc maybeClosure startBcpc cogMethodForIP |
- 			 mcpc := stackPages longAt: thePage headSP. "a machine code pc... it must be converted..."
- 			 maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: context.
- 			 (maybeClosure ~= objectMemory nilObject
- 			  and: [self isVanillaBlockClosure: maybeClosure])
- 				ifTrue: [cogMethodForIP := self mframeHomeMethod: theFP.
- 						startBcpc := self startPCOfClosure: maybeClosure]
- 				ifFalse: [cogMethodForIP := self cCoerceSimple: (self mframeMethod: theFP) to: #'CogMethod *'.
- 						startBcpc := self startPCOfMethod: theMethod].
- 			 theIP := cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP.
- 			 theIP := theIP + theMethod + objectMemory baseHeaderSize.
- 			 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
- 			 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
- 			 self convertFrame: theFP toInterpreterFrame: theIP - theNewIP]
- 		ifFalse:
- 			[theIP := stackPages longAt: thePage headSP.
- 			 theIP = cogit ceReturnToInterpreterPC
- 				ifTrue:
- 					[theIP := (self iframeSavedIP: theFP) + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
- 					 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
- 					 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
- 					 self iframeSavedIP: theFP put: theNewIP - 1] "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
- 				ifFalse:
- 					[theIP := theIP + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
- 					 self assert: (self validInstructionPointer: theIP inMethod: theMethod framePointer: theFP).
- 					 theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
- 					 self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
- 					 stackPages longAt: thePage headSP put: theNewIP - 1]]. "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
- 	self assert: ((stackPages longAt: thePage headSP + objectMemory wordSize) = objectMemory falseObject
- 				or: [(stackPages longAt: thePage headSP + objectMemory wordSize) = conditionVariable]).
- 	stackPages longAt: thePage headSP + objectMemory wordSize put: conditionVariable!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. 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."
  	| 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 pop: 1 thenPush: 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 assert: RevisedSuspend.
  	(RevisedSuspend
  	 and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag])
  		ifTrue:
+ 			[self backupContext: myContext toBlockingSendTo: myList.
- 			[self backupProcess: process toBlockingSendTo: myList.
  			 self pop: 1 thenPush: objectMemory nilObject]
  		ifFalse:
  			[self pop: 1 thenPush: myList]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
  primitiveSuspend
  	"Primitive. 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."
  	| process myList myContext ok |
  	process := self stackTop.
  	process = self activeProcess ifTrue:
  		[self pop: 1 thenPush: 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 assert: RevisedSuspend.
  	(RevisedSuspend
  	 and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag])
  		ifTrue:
+ 			[self backupContext: myContext toBlockingSendTo: myList.
- 			[self backupProcess: process toBlockingSendTo: myList.
  			 self pop: 1 thenPush: objectMemory nilObject]
  		ifFalse:
  			[self pop: 1 thenPush: myList]!



More information about the Vm-dev mailing list