Vm-dev January 2022

vm-dev@lists.squeakfoundation.org

15 participants
50 discussions

VM Maker: VMMaker.oscog-mt.3135.mcz
by commits＠source.squeak.org 11 Jan '22

11 Jan '22

Marcel Taeumel uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-mt.3135.mcz ==================== Summary ==================== Name: VMMaker.oscog-mt.3135 Author: mt Time: 11 January 2022, 12:20:29.464861 pm UUID: b93d7116-14bf-5543-8c8d-d06c66d5c1a5 Ancestors: VMMaker.oscog-eem.3134 Fixes an off-by-one bug in #loadZipEncoderFrom: and #primitiveZipSendBlock. Thanks to Florin Mateoc and Fabio Niephaus for reporting and testing this bug! See http://lists.squeakfoundation.org/pipermail/vm-dev/2022-January/037536.html =============== Diff against VMMaker.oscog-eem.3134 =============== Item was changed: ----- Method: DeflatePlugin>>determineSizeOfWriteStream: (in category 'primitive support') ----- determineSizeOfWriteStream: rcvr "Determine the inst size of the class above DeflateStream or ZipEncoder by looking for the first class whose inst size is less than 7." | class | class := interpreterProxy fetchClassOf: rcvr. [class ~= interpreterProxy nilObject and: [(interpreterProxy instanceSizeOf: class) >= 7]] whileTrue: [class := interpreterProxy superclassOf: class]. class = interpreterProxy nilObject ifTrue: [^false]. writeStreamInstSize := interpreterProxy instanceSizeOf: class. ^true + + "Possible classes of rcvr and (instSize) as of January 2022: + + ZipEncoder (8) <- WriteStream (5) + !! determineSizeOfWriteStream + primitiveZipSendBlock + + ZipWriteStream (20) <- DeflateStream (10) <- WriteStream (5) + !! determineSizeOfWriteStream: + primitiveDeflateBlock + + GZipWriteStream (20) <- ZipWriteStream (20) <- ... + "! - ! Item was changed: ----- Method: DeflatePlugin>>loadDeflateStreamFrom: (in category 'primitive support') ----- loadDeflateStreamFrom: rcvr | oop | <inline: false> ((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= 15]) ifFalse: [^false]. oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. (interpreterProxy isBytes: oop) ifFalse: [^false]. writeStreamInstSize = 0 ifTrue: [(self determineSizeOfWriteStream: rcvr) ifFalse: [^false]. "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source. discard it." (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 5) ifTrue: [writeStreamInstSize := 0. ^false]]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr. zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr." + "hashHead" oop := interpreterProxy fetchPointer: writeStreamInstSize + 0 ofObject: rcvr. ((interpreterProxy isWords: oop) and: [(interpreterProxy slotSizeOf: oop) = DeflateHashTableSize]) ifFalse: [^false]. zipHashHead := interpreterProxy firstIndexableField: oop. + + "hashTail" oop := interpreterProxy fetchPointer: writeStreamInstSize + 1 ofObject: rcvr. ((interpreterProxy isWords: oop) and: [(interpreterProxy slotSizeOf: oop) = DeflateWindowSize]) ifFalse: [^false]. zipHashTail := interpreterProxy firstIndexableField: oop. + zipHashValue := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr. zipBlockPos := interpreterProxy fetchInteger: writeStreamInstSize + 3 ofObject: rcvr. "zipBlockStart := interpreterProxy fetchInteger: writeStreamInstSize + 4 ofObject: rcvr." + + "literals" oop := interpreterProxy fetchPointer: writeStreamInstSize + 5 ofObject: rcvr. (interpreterProxy isBytes: oop) ifFalse: [^false]. zipLiteralSize := interpreterProxy slotSizeOf: oop. zipLiterals := interpreterProxy firstIndexableField: oop. + "distances" oop := interpreterProxy fetchPointer: writeStreamInstSize + 6 ofObject: rcvr. ((interpreterProxy isWords: oop) and: [(interpreterProxy slotSizeOf: oop) >= zipLiteralSize]) ifFalse: [^false]. zipDistances := interpreterProxy firstIndexableField: oop. + "literalFreq" oop := interpreterProxy fetchPointer: writeStreamInstSize + 7 ofObject: rcvr. ((interpreterProxy isWords: oop) and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxLiteralCodes]) ifFalse: [^false]. zipLiteralFreq := interpreterProxy firstIndexableField: oop. + "distanceFreq" oop := interpreterProxy fetchPointer: writeStreamInstSize + 8 ofObject: rcvr. ((interpreterProxy isWords: oop) and: [(interpreterProxy slotSizeOf: oop) = DeflateMaxDistanceCodes]) ifFalse: [^false]. zipDistanceFreq := interpreterProxy firstIndexableField: oop. zipLiteralCount := interpreterProxy fetchInteger: writeStreamInstSize + 9 ofObject: rcvr. zipMatchCount := interpreterProxy fetchInteger: writeStreamInstSize + 10 ofObject: rcvr. ^interpreterProxy failed not! Item was changed: ----- Method: DeflatePlugin>>loadZipEncoderFrom: (in category 'primitive support') ----- loadZipEncoderFrom: rcvr | oop | <inline: false> writeStreamInstSize = 0 ifTrue: [(self determineSizeOfWriteStream: rcvr) ifFalse: [^false]. "If the receiver wasn't valid then we derived writeStreamInstSize from an invalid source. discard it." (interpreterProxy slotSizeOf: rcvr) < (writeStreamInstSize + 3) ifTrue: [writeStreamInstSize := 0. ^false]]. ((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= (writeStreamInstSize + 3)]) ifFalse: [^false]. + + "collection" oop := interpreterProxy fetchPointer: 0 ofObject: rcvr. (interpreterProxy isBytes: oop) ifFalse: [^interpreterProxy primitiveFail]. zipCollection := interpreterProxy firstIndexableField: oop. zipCollectionSize := interpreterProxy byteSizeOf: oop. zipPosition := interpreterProxy fetchInteger: 1 ofObject: rcvr. zipReadLimit := interpreterProxy fetchInteger: 2 ofObject: rcvr. "zipWriteLimit := interpreterProxy fetchInteger: 3 ofObject: rcvr." + + zipBitBuf := interpreterProxy fetchInteger: writeStreamInstSize + 0 ofObject: rcvr. + zipBitPos := interpreterProxy fetchInteger: writeStreamInstSize + 1 ofObject: rcvr. - zipBitBuf := interpreterProxy fetchInteger: writeStreamInstSize + 1 ofObject: rcvr. - zipBitPos := interpreterProxy fetchInteger: writeStreamInstSize + 2 ofObject: rcvr. ^interpreterProxy failed not! Item was changed: ----- Method: DeflatePlugin>>primitiveZipSendBlock (in category 'primitives') ----- primitiveZipSendBlock | distTree litTree distStream litStream rcvr result | <export: true> interpreterProxy methodArgumentCount = 4 ifFalse:[^interpreterProxy primitiveFail]. distTree := interpreterProxy stackObjectValue: 0. litTree := interpreterProxy stackObjectValue: 1. distStream := interpreterProxy stackObjectValue: 2. litStream := interpreterProxy stackObjectValue: 3. rcvr := interpreterProxy stackObjectValue: 4. interpreterProxy failed ifTrue:[^nil]. (self loadZipEncoderFrom: rcvr) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: distTree) and:[ (interpreterProxy slotSizeOf: distTree) >= 2]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: litTree) and:[ (interpreterProxy slotSizeOf: litTree) >= 2]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: litStream) and:[ (interpreterProxy slotSizeOf: litStream) >= 3]) ifFalse:[^interpreterProxy primitiveFail]. ((interpreterProxy isPointers: distStream) and:[ (interpreterProxy slotSizeOf: distStream) >= 3]) ifFalse:[^interpreterProxy primitiveFail]. self cCode:'' inSmalltalk:[ zipMatchLengthCodes := CArrayAccessor on: ZipWriteStream matchLengthCodes. zipDistanceCodes := CArrayAccessor on: ZipWriteStream distanceCodes. zipExtraLengthBits := CArrayAccessor on: ZipWriteStream extraLengthBits. zipExtraDistanceBits := CArrayAccessor on: ZipWriteStream extraDistanceBits. zipBaseLength := CArrayAccessor on: ZipWriteStream baseLength. zipBaseDistance := CArrayAccessor on: ZipWriteStream baseDistance]. result := self sendBlock: litStream with: distStream with: litTree with: distTree. interpreterProxy failed ifFalse:[ interpreterProxy storeInteger: 1 ofObject: rcvr withValue: zipPosition. + interpreterProxy storeInteger: readStreamInstSize + 0 ofObject: rcvr withValue: zipBitBuf. + interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitPos. - interpreterProxy storeInteger: readStreamInstSize + 1 ofObject: rcvr withValue: zipBitBuf. - interpreterProxy storeInteger: readStreamInstSize + 2 ofObject: rcvr withValue: zipBitPos. ]. interpreterProxy failed ifFalse:[ interpreterProxy pop: 5. "rcvr + args" interpreterProxy pushInteger: result. ].! Item was changed: ----- Method: InflatePlugin>>determineSizeOfReadStream: (in category 'primitive support') ----- determineSizeOfReadStream: rcvr + "Determine the inst size of the class above InflateStream by - "Determine the inst size of the class above DeflateStream by looking for the first class whose inst size is less than 13." | class | class := interpreterProxy fetchClassOf: rcvr. [class ~= interpreterProxy nilObject and: [(interpreterProxy instanceSizeOf: class) >= 13]] whileTrue: [class := interpreterProxy superclassOf: class]. class = interpreterProxy nilObject ifTrue: [^false]. readStreamInstSize := interpreterProxy instanceSizeOf: class. + ^true + + "Possible classes of rcvr and (instSize) as of January 2022: + + FastInflateStream (14) <- InflateStream (14) <- ReadStream (4) + !! determineSizeOfReadStream: + primitiveInflateDecompressBlock + + GZipReadStream (14) <- FastInflateStream (14) <- ... + ZipReadStream (15) <- FastInflateStream (14) <- ... + ZLibReadStream (14) <- FastInflateStream (14) <- ... + "! - ^true!

1 0

VM Maker: VMMaker.oscog-eem.3134.mcz
by commits＠source.squeak.org 07 Jan '22

07 Jan '22

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3134.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3134 Author: eem Time: 6 January 2022, 3:09:35.534862 pm UUID: eaff35f9-c25a-44d9-9640-539e065e1970 Ancestors: VMMaker.oscog-eem.3133 CoInterpreter suspend: Correct the code for dealing with machine code embedded block activations. Alas the new suspend semantics do not work correctly with Virtend login (the lobby is reached but never populates). This is evidence that some images depend on the old semantics. Hence the semantics must be rewritten to be optional. This will happen soon. =============== Diff against VMMaker.oscog-eem.3133 =============== 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." + "The suspendedContext is in one of six states, hence six cases: + 1 & 2: single context with bytecode pc or single context with machine code pc + 3 & 4: married to machine code frame in embedded (v3) block or machine code frame in method/full block + 5 & 6: married to interpreter frame with saved ip or interpreter frame with pushed pc" | theMethod pc sp theIP theNewIP theFP thePage | self assert: (objectMemory isContext: suspendedContext). theMethod := objectMemory fetchPointer: MethodIndex ofObject: suspendedContext. + "cases 1 & 2" (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]). + "case 2" (pc := objectMemory integerValueOf: pc) < 0 ifTrue: "context with machine code pc; must map..." [pc := objectMemory integerValueOf: (self mustMapMachineCodePC: pc context: suspendedContext)]. theIP := theMethod + objectMemory baseHeaderSize + 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: "cases 3 & 4" + [| mcpc startBcpc cogMethod | - ifTrue: - [| mcpc maybeClosure startBcpc cogMethodForIP | mcpc := stackPages longAt: thePage headSP. "a machine code pc... it must be converted..." + cogMethod := self mframeCogMethod: theFP. + cogMethod cmType = CMBlock "case 3" + ifTrue: [self assert: (self frameStackedReceiver: theFP numArgs: cogMethod cmNumArgs) + = (objectMemory fetchPointer: ClosureIndex ofObject: suspendedContext). + startBcpc := self startPCOfClosure: (objectMemory fetchPointer: ClosureIndex ofObject: suspendedContext)] + ifFalse: [startBcpc := self startPCOfMethod: theMethod]. "case 4" + theIP := cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethod. - 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: "cases 5&6" - ifFalse: [theIP := stackPages longAt: thePage headSP. theIP = cogit ceReturnToInterpreterPC + ifTrue: "case 5" - 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: "case 6" - 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!

1 0

[OpenSmalltalk/opensmalltalk-vm] 8141dd: CogVM source as per VMMaker.oscog-eem.3133
by Eliot Miranda 05 Jan '22

05 Jan '22

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 8141dd272ce0afceb1e7b9b62fb9cb73e383f160 https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/8141dd272ce0afceb1… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2022-01-05 (Wed, 05 Jan 2022) Changed paths: M src/spur32.cog/cointerp.c M src/spur32.cog/cointerp.h M src/spur32.cog/gcc3x-cointerp.c M src/spur32.sista/cointerp.c M src/spur32.sista/cointerp.h M src/spur32.sista/gcc3x-cointerp.c M src/spur64.cog/cointerp.c M src/spur64.cog/cointerp.h M src/spur64.cog/gcc3x-cointerp.c M src/spur64.sista/cointerp.c M src/spur64.sista/cointerp.h M src/spur64.sista/gcc3x-cointerp.c M src/v3.cog/cointerp.c M src/v3.cog/cointerp.h M src/v3.cog/gcc3x-cointerp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.3133 CoInterpreter suspend: Deal with a single context with a machine code pc. Looks like the VM side of the suspend work is now complete.

1 0

VM Maker: VMMaker.oscog-eem.3133.mcz
by commits＠source.squeak.org 05 Jan '22

05 Jan '22

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3133.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3133 Author: eem Time: 5 January 2022, 11:46:59.51697 am UUID: 4a7f4038-9285-42ba-b1fd-b5621a072836 Ancestors: VMMaker.oscog-eem.3132 CoInterpreter suspend: Deal with a single context with a machine code pc. =============== Diff against VMMaker.oscog-eem.3132 =============== 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." | 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: pc) and: [(objectMemory integerValueOf: pc) > 0]). self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]). + (pc := objectMemory integerValueOf: pc) < 0 ifTrue: "context with machine code pc; must map..." + [pc := objectMemory integerValueOf: (self mustMapMachineCodePC: pc context: suspendedContext)]. + theIP := theMethod + objectMemory baseHeaderSize + pc - 1. - 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!

1 0

Re: [Vm-dev] ExtendedClipboardInterface and ClipboardExtendedPlugin state?
by Bernhard Pieber 04 Jan '22

04 Jan '22

Hi, Maybe this question is better asked on the vm-dev list. Does anyone know the status of the ClipboardExtendedPlugin? Happy New Year! Bernhard > Am 20.12.2021 um 09:38 schrieb Bernhard Pieber <bernhard(a)pieber.com>: > > Hi everyone, > > I tried to copy a form as PNG to the clipboard like this: > ExtendedClipboardInterface current addClipboardDataConvertFormToPNG: self imageForm > > This seems not to work correctly. If I paste it to TextEdit I get the binary data starting with PNG instead of the image itself. It looks as if the ClipboardExtendedPlugin is not loaded. The plugin seems to be in the current VM source (src/pugins/ClipboardExtendedPlugin), though. I am on macOS Big Sur 11.6.1. > > Should this work? I tried on Squeak 3.4, 4.6 and 5.3 but the ExtendedClipboardInterface is not loaded in these images. > > Cheers, > Bernhard

4 6

[OpenSmalltalk/opensmalltalk-vm] 9a7006: CogVM source as per VMMaker.oscog-eem.3132
by Eliot Miranda 03 Jan '22

03 Jan '22

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 9a7006f247285b91526c258ae0da0594f407ee3c https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/9a7006f247285b9152… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2022-01-03 (Mon, 03 Jan 2022) Changed paths: M src/spur32.cog.lowcode/cointerp.c M src/spur32.cog.lowcode/cointerp.h M src/spur32.cog.lowcode/gcc3x-cointerp.c M src/spur32.cog/cointerp.c M src/spur32.cog/cointerp.h M src/spur32.cog/cointerpmt.c M src/spur32.cog/cointerpmt.h M src/spur32.cog/gcc3x-cointerp.c M src/spur32.cog/gcc3x-cointerpmt.c M src/spur32.sista/cointerp.c M src/spur32.sista/cointerp.h M src/spur32.sista/gcc3x-cointerp.c M src/spur32.stack.lowcode/gcc3x-interp.c M src/spur32.stack.lowcode/interp.c M src/spur32.stack/gcc3x-interp.c M src/spur32.stack/interp.c M src/spur64.cog.lowcode/cointerp.c M src/spur64.cog.lowcode/cointerp.h M src/spur64.cog.lowcode/gcc3x-cointerp.c M src/spur64.cog/cointerp.c M src/spur64.cog/cointerp.h M src/spur64.cog/cointerpmt.c M src/spur64.cog/cointerpmt.h M src/spur64.cog/gcc3x-cointerp.c M src/spur64.cog/gcc3x-cointerpmt.c M src/spur64.sista/cointerp.c M src/spur64.sista/cointerp.h M src/spur64.sista/gcc3x-cointerp.c M src/spur64.stack.lowcode/gcc3x-interp.c M src/spur64.stack.lowcode/interp.c M src/spur64.stack/gcc3x-interp.c M src/spur64.stack/interp.c M src/v3.cog/cointerp.c M src/v3.cog/cointerp.h M src/v3.cog/gcc3x-cointerp.c M src/v3.stack/gcc3x-interp.c M src/v3.stack/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.3132 Interpreter: Have primitiveSuspend fail for unresumable processes. Beef up removeProcess:fromList: to follow forwarders in the list, allowing become on suspended processes (this weas definitely a bug), and have it fail if it encounters a link that doesn't look like a process. Rename backupProcess:toBlockingSendTo: to backupContext:toBlockingSendTo: because that's what it does and it saves an access Slang: provide an x ordinate in the accessorDepthTable to make it easier to lookup accessor depths

1 0

VM Maker: VMMaker.oscog-eem.3132.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

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!

1 0

VM Maker: VMMaker.oscog-eem.3131.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

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]!

1 0

VM Maker: VMMaker.oscog-eem.3130.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3130.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.3130 Author: eem Time: 3 January 2022, 11:32:37.958591 am UUID: 8816cfc7-c7cf-4ee0-88bf-da5d23785838 Ancestors: VMMaker.oscog-eem.3129 Interpreter: Have primitiveSuspend fail for unresumable processes. Beef up removeProcess:fromList: to follow forwarders in the list, allowing become on suspended processes (this weas definitely a bug), and have it nfail if it encounters a link that doesn't look like a process. Slang: provide an x ordinate in the accessorDepthTable to make it easier to lookup accessor depths =============== Diff against VMMaker.oscog-eem.3129 =============== Item was changed: ----- Method: CCodeGenerator>>arrayInitializerCalled:for:sizeString:type: (in category 'utilities') ----- arrayInitializerCalled: varName for: array sizeString: sizeStringOrNil type: cType "array is a literal array or a CArray on some array." ^String streamContents: [:s| | sequence lastLine index newLine atNewline | sequence := array isCollection ifTrue: [array] ifFalse: [array object]. lastLine := index := 0. newLine := [sequence size >= 20 ifTrue: [s cr; nextPutAll: '/*'; print: index; nextPutAll: '*/'; tab] ifFalse: [s crtab: 2]. lastLine := s position. atNewline := true]. s nextPutAll: cType; space; nextPutAll: varName; nextPut: $[. sizeStringOrNil ifNotNil: [s nextPutAll: sizeStringOrNil]. s nextPutAll: '] = '. sequence isString ifTrue: [s nextPutAll: (self cLiteralFor: sequence)] ifFalse: [| mixedSigns | "this is to align -ve and +ve integers nicely in the primitiveAccessorDepthTable" mixedSigns := (sequence allSatisfy: [:element| element isInteger]) and: [(sequence anySatisfy: [:element| element < 0]) and: [sequence anySatisfy: [:element| element > 0]]]. s nextPut: ${. + sequence size > 20 ifTrue: "this provides an x ordinate for lookup in the primitiveAccessorDepthTable" + [s cr; next: 2 put: $/; next: (sequence size log: 10) floor + 3 put: Character space. + 0 to: 19 do: + [:n| s space. n < 10 ifTrue: [s space]. s print: n]]. newLine value. sequence do: [:element| (mixedSigns and: [atNewline and: [element >= 0]]) ifTrue: [s space]. (mixedSigns and: [element < 0 and: [s peekLast = Character space]]) ifTrue: [s skip: -1]. s nextPutAll: (self cLiteralFor: element). index := index + 1] separatedBy: [atNewline := false. s nextPut: $,. ((s position - lastLine) >= 76 or: [(index \\ 20) = 0]) ifTrue: [newLine value] ifFalse: [s space]]. s crtab; nextPut: $}]]! 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 myList 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: - "Alas in Spur we need a read barrier" - myList := objectMemory followField: MyListIndex ofObject: process. - myList = objectMemory nilObject ifTrue: [^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 backupProcess: process toBlockingSendTo: myList. self pop: 1 thenPush: objectMemory nilObject] ifFalse: [self pop: 1 thenPush: myList]! Item was changed: ----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') ----- removeProcess: aProcess fromList: aList + "Attempt to remove a process from a linked list. Answer if the attempt succeeded." - "Remove a given process from a linked list. May fail if aProcess is not on the list." | firstLink lastLink nextLink tempLink | self deny: (objectMemory isForwarded: aProcess). self deny: (objectMemory isForwarded: aList). + "any process on the list could have been becomed, so use a read barrier..." + firstLink := objectMemory followField: FirstLinkIndex ofObject: aList. + lastLink := objectMemory followField: LastLinkIndex ofObject: aList. + aProcess = firstLink - firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList. - lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList. - self deny: (objectMemory isForwarded: firstLink). - self deny: (objectMemory isForwarded: lastLink). - aProcess = firstLink ifTrue: + [nextLink := objectMemory followField: NextLinkIndex ofObject: aProcess. - [nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess. - self deny: (objectMemory isForwarded: nextLink). objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink. + aProcess = lastLink ifTrue: - aProcess = lastLink ifTrue: [objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]] ifFalse: [tempLink := firstLink. + ["fail if any link doesn't look like a process..." + ((objectMemory isPointers: tempLink) + and: [(objectMemory numSlotsOf: tempLink) > MyListIndex]) ifFalse: - [self deny: (objectMemory isForwarded: tempLink). - tempLink = objectMemory nilObject ifTrue: [^false]. + nextLink := objectMemory followField: NextLinkIndex ofObject: tempLink. - nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink. nextLink = aProcess] whileFalse: + [tempLink := nextLink]. - [tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink]. nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess. objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink. + aProcess = lastLink ifTrue: - aProcess = lastLink ifTrue: [objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]]. objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject. ^true! 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 myList 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: - "Alas in Spur we need a read barrier" - myList := objectMemory followField: MyListIndex ofObject: process. - myList = objectMemory nilObject ifTrue: [^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 backupProcess: process toBlockingSendTo: myList. self pop: 1 thenPush: objectMemory nilObject] ifFalse: [self pop: 1 thenPush: myList]!

1 0

[OpenSmalltalk/opensmalltalk-vm] 1c8835: CogVM source as per VMMaker.oscog-eem.3129
by Eliot Miranda 03 Jan '22

03 Jan '22

Branch: refs/heads/Cog Home: https://github.com/OpenSmalltalk/opensmalltalk-vm Commit: 1c8835df08dde21c121dccdb2a62c7d38ece22fc https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/1c8835df08dde21c12… Author: Eliot Miranda <eliot.miranda(a)gmail.com> Date: 2022-01-02 (Sun, 02 Jan 2022) Changed paths: M src/spur32.cog.lowcode/cointerp.c M src/spur32.cog.lowcode/cointerp.h M src/spur32.cog.lowcode/gcc3x-cointerp.c M src/spur32.cog/cointerp.c M src/spur32.cog/cointerp.h M src/spur32.cog/cointerpmt.c M src/spur32.cog/cointerpmt.h M src/spur32.cog/gcc3x-cointerp.c M src/spur32.cog/gcc3x-cointerpmt.c M src/spur32.sista/cointerp.c M src/spur32.sista/cointerp.h M src/spur32.sista/gcc3x-cointerp.c M src/spur32.stack.lowcode/gcc3x-interp.c M src/spur32.stack.lowcode/interp.c M src/spur32.stack/gcc3x-interp.c M src/spur32.stack/interp.c M src/spur64.cog.lowcode/cointerp.c M src/spur64.cog.lowcode/cointerp.h M src/spur64.cog.lowcode/gcc3x-cointerp.c M src/spur64.cog/cointerp.c M src/spur64.cog/cointerp.h M src/spur64.cog/cointerpmt.c M src/spur64.cog/cointerpmt.h M src/spur64.cog/gcc3x-cointerp.c M src/spur64.cog/gcc3x-cointerpmt.c M src/spur64.sista/cointerp.c M src/spur64.sista/cointerp.h M src/spur64.sista/gcc3x-cointerp.c M src/spur64.stack.lowcode/gcc3x-interp.c M src/spur64.stack.lowcode/interp.c M src/spur64.stack/gcc3x-interp.c M src/spur64.stack/interp.c M src/v3.cog/cointerp.c M src/v3.cog/cointerp.h M src/v3.cog/gcc3x-cointerp.c M src/v3.stack/gcc3x-interp.c M src/v3.stack/interp.c Log Message: ----------- CogVM source as per VMMaker.oscog-eem.3129 Fix backing up the pc on wait when the process being suspended has an interpreter frame that has a bytecode pc on top of stack rather than the ceReturnToInterpreterPC. Fix printing the method field in printContext: (the oop was previously omitted).

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev January 2022