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!
vm-dev@lists.squeakfoundation.org