[Vm-dev] VM Maker: VMMaker.oscog-eem.3132.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jan 3 19:57:23 UTC 2022
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!
More information about the Vm-dev
mailing list