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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.3132
Author: eem
Time: 3 January 2022, 11:57:10.980466 am
UUID: 6114bd2e-2ff4-4d49-83a7-91cbccd3cd45
Ancestors: VMMaker.oscog-eem.3131

Oops; commit the StackInterpreter's backupContext:toBlockingSendTo:, and fix the comment.

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

Item was changed:
  ----- Method: CoInterpreter>>backupContext:toBlockingSendTo: (in category 'process primitive support') -----
  backupContext: suspendedContext toBlockingSendTo: conditionVariable
+ 	"Support for primitiveSuspend.
+ 	 Assume suspendedContext is that of a process waiting on a condition variable.
+ 	 Backup the PC of suspendedContext to the send that entered the wait state.
+ 	 primitiveEnterCriticalSection pushes false for blocked waiters. false must be
+ 	 replaced by the condition variable."
- 	"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 added:
+ ----- Method: StackInterpreter>>backupContext:toBlockingSendTo: (in category 'process primitive support') -----
+ backupContext: suspendedContext toBlockingSendTo: conditionVariable
+ 	"Support for primitiveSuspend.
+ 	 Assume suspendedContext is that of a process waiting on a condition variable.
+ 	 Backup the PC of suspendedContext to the send that entered the wait state.
+ 	 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.
+ 	theIP := (stackPages longAt: thePage headSP) + 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]).
+ 	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: StackInterpreter>>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.
- 	 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.
- 	theIP := (stackPages longAt: thePage headSP) + 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]).
- 	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!