Hi Eliot,
From: Eliot Mirandamailto:eliot.miranda@gmail.com Sent: Tuesday, February 22, 2022 18:28 To: Jaromir Matasmailto:mail@jaromir.net Subject: Re: [Vm-dev] VM Maker: VMMaker.oscog-eem.3151.mcz
Hi Jaromir,
On Feb 21, 2022, at 12:07 PM, Jaromir Matas mail@jaromir.net wrote: Hi Eliot,
I’d like to ask you what the plan with the revised suspend semantics is. At the moment prim 88 and #suspend are back to where they were and the new processSuspensionUnblocks flag only indicates the presence of the two new revised primitives (568, 578).
Once a release quality vm arrives then we can decide. Hopefully we will move to using either 568 or 578. But I cannot focus on this currently. I am digging myself out of a hole.
Thank you very much for your feedback! I’ve made #terminate work independently on the suspend semantics so I’ll post it now and adjust the complementing tests later based on the final VM. Thanks again,
Jaromir
In the JIT there are effectively two kinds of primitives, ones implemented by the JIT and ones written in C (generated from Slang). The JIT can dispatch C primitives much faster if they run on the Smalltalk stack, but it can only do this with certain simple primitives that don’t require a deep stack (the VM’s Smalltalk stack is made up of small pages, each with about 1k bytes of overhead, enough to run simple primitives).
I implemented a metadata scheme for names primitives that allows specifying that a primitive can run on the Smalltalk stack via the primitiveMetadata: pragma. I then started adding metadata to numbered primitives, but didn’t like the code. So I provided support to allow numbered primitives to use the primitiveMetadata: pragma, along with some simplifications to how much stats they JIT assigns before calling the C primitive. But I made a mistake and the resulting VM, while it seems to work ok in trunk Squeak, breaks Virtend.
So I’m currently starting off with the last known good source (3117 or thereabouts) and moving it in small steps towards the tip to find out what I broke. I’m close to having things fixed again. But u til I have that sorted out I cannot attend to suspend.
I’d like to send the following version of #terminate reflecting the recent changes to the Inbox but I’m waiting what the next step with #suspend will be. The code below is independent of the processSuspensionUnblocks flag or the primitive used (88, 568, 578) – works for all.
I’ve studied the ancient code in versions 1 thru 3.5 and admired the simplicity; the code below tries to follow the same structure but the semantics is more advanced. I’d appreciate of you could take a quick look and also share your plans regarding the new suspend primitives.
My best regards,
Jaromir
New terminate:
terminate "Stop the process that the receiver represents forever."
| context | self isActiveProcess ifTrue: [ context := thisContext. ^[context unwindTo: nil. self suspend] asContext jump].
[] ensure: [ | oldList | oldList := myList. self suspend. context := suspendedContext ifNil: [^self]. suspendedContext := [ context releaseCriticalSection: oldList; unwindTo: nil. self suspend] asContext. self priority: Processor activePriority + 1; resume]
Compare with 1999-2003 terminate:
terminate "Stop the process that the receiver represents forever."
| context | Processor activeProcess == self ifTrue: [thisContext unwindTo: nil. thisContext sender == nil ifFalse: [thisContext sender release]. thisContext removeSelf suspend] ifFalse: [myList == nil ifFalse: [myList remove: self ifAbsent: []. myList _ nil]. context _ suspendedContext. suspendedContext _ nil. context == nil ifFalse: [context unwindTo: nil]. (context ~~ nil and: [context sender ~~ nil]) ifTrue: [context sender release]]
Eliot _,,,^..^,,,_ (phone)
From: commits@source.squeak.orgmailto:commits@source.squeak.org Sent: Friday, February 11, 2022 1:36 To: vm-dev@lists.squeakfoundation.orgmailto:vm-dev@lists.squeakfoundation.org Subject: [Vm-dev] VM Maker: VMMaker.oscog-eem.3151.mcz
Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3151.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3151 Author: eem Time: 10 February 2022, 4:36:05.908056 pm UUID: ee3d31a3-ee4b-4205-87cc-be78d1879c79 Ancestors: VMMaker.oscog-eem.3150
Primitive suspend: revert the semantics of #88 to Andreas' revision in the early 2000's. #88 removes a process from a condition variable, allowing subsequently resumed processes to get past their condition variable. This is a bug, but there are images (noably Qwaq/Teleplace/Virtend) which depend on this behaviour. Provide #568 (primitiveSuspendBackingUpV1) which backs up a process waiting on a condition variable to the send that invoked the wait primitive, and which answers that list. Provide #578 (primitiveSuspendBackingUpV2) which backs up a process waiting on a condition variable to the send that invoked the wait primitive, but in which case answers nil. The presence of the three primitives is indicated by bit 5 of the cogVMFeatureFlags.
DeflatePlugin: the update primitives can run on the Smalltalk stack.
Add the FileDialogPlugin from Qwaq/Teleplace/Virtend.
=============== Diff against VMMaker.oscog-eem.3150 ===============
Item was changed: ----- Method: CoInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend + "Primitive #88. Suspend the receiver, aProcess, such that it can be executed again - "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. The primitive returns the list the receiver was previously on. + c.f. primitiveSuspendBackingUpV1,#568 & primitiveSuspendBackingUpV2,#578" - 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, - unless it was the activ eProcess, in which case 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 stackTopPut: objectMemory nilObject. - 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 stackTopPut: myList! - self assert: RevisedSuspend. - (RevisedSuspend - and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag]) ifTrue: - [self backupContext: myContext toBlockingSendTo: myList]. - self pop: 1 thenPush: myList!
Item was added: + ----- Method: CoInterpreterPrimitives>>primitiveSuspendBackingUpV1 (in category 'process primitives') ----- + primitiveSuspendBackingUpV1 + "Primitive #568. 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, + unless it was the activeProcess, in which case answer nil. + c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV2,#578" + | 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 stackTopPut: 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. + (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: + [self backupContext: myContext toBlockingSendTo: myList]. + self stackTopPut: myList!
Item was added: + ----- Method: CoInterpreterPrimitives>>primitiveSuspendBackingUpV2 (in category 'process primitives') ----- + primitiveSuspendBackingUpV2 + "Primitive #578. 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. + c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV1,#568, + which always answer the list the process was on, even if blocked." + <export: true> + | 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 stackTopPut: 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. + (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag + ifTrue: + [self backupContext: myContext toBlockingSendTo: myList. + self stackTopPut: objectMemory nilObject] + ifFalse: + [self stackTopPut: myList]!
Item was removed: - ----- Method: CoInterpreterPrimitives>>primitiveSuspendV2 (in category 'process primitives') ----- - primitiveSuspendV2 - "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. - c.f. primitiveSuspend, which always answers the list the process was on, if blocked." - <export: true> - | 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 pop: 1 thenPush: objectMemory nilObject] - ifFalse: - [self pop: 1 thenPush: myList]!
Item was changed: ----- Method: CogVMSimulator class>>initialize (in category 'class initialization') ----- initialize "These are primitives that alter the state of the stack. They are here simply for assert checking. After invocation the Cogit should not check for the expected stack delta when these primitives succeed, because the stack will usually have been modified." StackAlteringPrimitives := #( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch primitiveClone primitiveInstVarAt primitiveSlotAt "because these can cause code compactions..." primitiveEnterCriticalSection primitiveExitCriticalSection primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch + primitiveSignal primitiveWait primitiveResume primitiveYield + primitiveSuspend primitiveSuspendBackingUpV1 primitiveSuspendBackingUpV2 - primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveSuspendV2 primitiveYield primitiveExecuteMethodArgsArray primitiveExecuteMethod primitivePerform primitivePerformWithArgs primitivePerformInSuperclass primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs) asIdentitySet!
Item was changed: ----- Method: DeflatePlugin>>primitiveDeflateUpdateHashTable (in category 'primitives') ----- primitiveDeflateUpdateHashTable "Primitive. Update the hash tables after data has been moved by delta." - | delta table tableSize tablePtr entry | <export: true> + <primitiveMetadata: #(FastCPrimitive FastCPrimitiveAlignForFloatsFlag)> "Using AlignForFloats since the arithmetic is potentially vectorizable..." + | delta table tableSize tablePtr entry | <var: #tablePtr type:'int *'> - interpreterProxy methodArgumentCount = 2 - ifFalse:[^interpreterProxy primitiveFail]. delta := interpreterProxy stackIntegerValue: 0. + table := interpreterProxy stackValue: 1. - table := interpreterProxy stackObjectValue: 1. interpreterProxy failed ifTrue:[^nil]. + (interpreterProxy isWords: table) ifFalse: + [^interpreterProxy primitiveFail]. - (interpreterProxy isWords: table) - ifFalse:[^interpreterProxy primitiveFail]. tableSize := interpreterProxy slotSizeOf: table. tablePtr := interpreterProxy firstIndexableField: table. 0 to: tableSize-1 do:[:i| entry := tablePtr at: i. entry >= delta ifTrue:[tablePtr at: i put: entry - delta] ifFalse:[tablePtr at: i put: 0]]. + interpreterProxy pop: 2 "Leave rcvr on stack"! - interpreterProxy pop: 2. "Leave rcvr on stack"!
Item was changed: ----- Method: DeflatePlugin>>primitiveUpdateAdler32 (in category 'primitives') ----- primitiveUpdateAdler32 "Primitive. Update a 32bit CRC value." - | collection stopIndex startIndex length bytePtr s1 adler32 s2 b | <export: true> + <primitiveMetadata: #(FastCPrimitive FastCPrimitiveAlignForFloatsFlag)> "Using AlignForFloats since the arithmetic is potentially vectorizable..." + | collection stopIndex startIndex length bytePtr s1 adler32 s2 b | <var: #adler32 type:'unsigned int '> <var: #bytePtr type:'unsigned char *'> + collection := interpreterProxy stackValue: 0. - interpreterProxy methodArgumentCount = 4 - ifFalse:[^interpreterProxy primitiveFail]. - collection := interpreterProxy stackObjectValue: 0. stopIndex := interpreterProxy stackIntegerValue: 1. startIndex := interpreterProxy stackIntegerValue: 2. adler32 := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3). + interpreterProxy failed ifTrue: [^nil]. - interpreterProxy failed ifTrue:[^0]. ((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]]) ifFalse:[^interpreterProxy primitiveFail]. length := interpreterProxy byteSizeOf: collection. (stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail]. bytePtr := interpreterProxy firstIndexableField: collection. startIndex := startIndex - 1. stopIndex := stopIndex - 1. s1 := adler32 bitAnd: 16rFFFF. + s2 := adler32 >> 16 bitAnd: 16rFFFF. - s2 := (adler32 >> 16) bitAnd: 16rFFFF. startIndex to: stopIndex do:[:i| b := bytePtr at: i. s1 := (s1 + b) \ 65521. s2 := (s2 + s1) \ 65521. ]. adler32 := (s2 bitShift: 16) + s1. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: adler32)! - interpreterProxy - pop: 5 "args + rcvr" - thenPush: (interpreterProxy positive32BitIntegerFor: adler32)!
Item was changed: ----- Method: DeflatePlugin>>primitiveUpdateGZipCrc32 (in category 'primitives') ----- primitiveUpdateGZipCrc32 "Primitive. Update a 32bit CRC value." - | collection stopIndex startIndex crc length bytePtr | <export: true> + <primitiveMetadata: #(FastCPrimitive FastCPrimitiveAlignForFloatsFlag)> "Using AlignForFloats since the arithmetic is potentially vectorizable..." + | collection stopIndex startIndex crc length bytePtr | <var: #bytePtr type: #'unsigned char *'> + collection := interpreterProxy stackValue: 0. - interpreterProxy methodArgumentCount = 4 - ifFalse:[^interpreterProxy primitiveFail]. - collection := interpreterProxy stackObjectValue: 0. stopIndex := interpreterProxy stackIntegerValue: 1. startIndex := interpreterProxy stackIntegerValue: 2. crc := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 3). interpreterProxy failed ifTrue: [^self]. ((interpreterProxy isBytes: collection) and:[stopIndex >= startIndex and:[startIndex > 0]]) ifFalse:[^interpreterProxy primitiveFail]. length := interpreterProxy byteSizeOf: collection. (stopIndex <= length) ifFalse:[^interpreterProxy primitiveFail]. bytePtr := interpreterProxy firstIndexableField: collection. self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: GZipWriteStream crcTable]. startIndex := startIndex - 1. stopIndex := stopIndex - 1. startIndex to: stopIndex do: [:i| + crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: crc >> 8]. + interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: crc)! - crc := (zipCrcTable at: ((crc bitXor: (bytePtr at: i)) bitAnd: 255)) bitXor: (crc >> 8)]. - interpreterProxy - pop: 5 "args + rcvr" - thenPush: (interpreterProxy positive32BitIntegerFor: crc)!
Item was added: + InterpreterPlugin subclass: #FileDialogPlugin + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'VMMaker-Plugins'! + + !FileDialogPlugin commentStamp: '<historical>' prior: 0! + A plugin supporting various bits and pieces for native file dialogs.!
Item was added: + ----- Method: FileDialogPlugin class>>hasHeaderFile (in category 'compiling') ----- + hasHeaderFile + "If there is a single intrinsic header file to be associated with the plugin, here is where you want to flag" + ^true!
Item was added: + ----- Method: FileDialogPlugin class>>requiresPlatformFiles (in category 'compiling') ----- + requiresPlatformFiles + "default is ok for most, any plugin needing platform specific files must say so" + ^true!
Item was added: + ----- Method: FileDialogPlugin class>>simulatorClass (in category 'simulation') ----- + simulatorClass + ^FileDialogPluginSimulator!
Item was added: + ----- Method: FileDialogPlugin>>initialiseModule (in category 'initialize') ----- + initialiseModule + <export: true> + ^self fileDialogInitialize "inSmalltalk: true"!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogAddFilter (in category 'file dialogs') ----- + primitiveFileDialogAddFilter + "Primitive. Add a filter to an existing file dialog. + Arguments: + dlgHandle: Handle for the file dialog. + filterDesc: Description for the filter ('Text Files (*.txt)') + filterPattern: Filter pattern (*.txt) + Returns: Nothing." + | dlgHandle filterDesc filterPattern | + <export: true> + interpreterProxy methodArgumentCount = 3 ifFalse: + [^interpreterProxy primitiveFail]. + filterPattern := self stackEphemeralStringValue: 0. + filterDesc := self stackEphemeralStringValue: 1. + dlgHandle := self stackDialogHandle: 2. + interpreterProxy failed ifTrue: + [^self primitiveFailFor: PrimErrBadArgument]. + self fileDialogAddFilter: dlgHandle _: filterDesc _: filterPattern "inSmalltalk: filterPattern". + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogCallbackReturn (in category 'file dialogs') ----- + primitiveFileDialogCallbackReturn + "Primitive. Reap the return value from the dialog callback. + This is unimplemented (stubbed out) on all current platforms and so it is obsolete." + <export: true> + <legacy> + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogCreate (in category 'file dialogs') ----- + primitiveFileDialogCreate + "Primitive. Create a new file dialog handle and answer the result. + Arguments: None. + Return value: File dialog handle." + | dlgHandle | + <export: true> + interpreterProxy methodArgumentCount = 0 ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs]. + dlgHandle := self fileDialogCreate. + dlgHandle < 0 ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrOperationFailed]. + interpreterProxy methodReturnInteger: dlgHandle!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogDestroy (in category 'file dialogs') ----- + primitiveFileDialogDestroy + "Primitive. Hide/destroy the file dialog after it is done. + Arguments: + dlgHandle: Handle of the file dialog. + Return value: Nothing. + Notes: This primitive may fail if the dialog wasn't completed and platform + doesn't support destroying existing dialogs. Generally it is assumed that + the dialog has been closed by the user before calling this method." + | dlgHandle ok | + <export: true> + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFail]. + dlgHandle := self stackDialogHandle: 0. + interpreterProxy failed ifTrue:[^nil]. + ok := self fileDialogDestroy: dlgHandle "inSmalltalk: false". + ok ifFalse:[^interpreterProxy primitiveFail]. + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogDone (in category 'file dialogs') ----- + primitiveFileDialogDone + "Primitive. Answer whether the file dialog completed or not. + Arguments: + dlgHandle: Handle of the file dialog. + Return value: Boolean indicating whether the dialog completed." + | dlgHandle | + <export: true> + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFail]. + dlgHandle := self stackDialogHandle: 0. + interpreterProxy failed ifFalse: + [interpreterProxy methodReturnBool: (self fileDialogDone: dlgHandle)]!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogDoneSemaphore (in category 'file dialogs') ----- + primitiveFileDialogDoneSemaphore + "Primitive. Set the semaphore to be signaled when the file dialog completes. + Arguments: + dlgHandle: Handle of the file dialog. + semaIndex: External semaphore index. + Return value: Nothing." + | dlgHandle semaIndex | + <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. + semaIndex := interpreterProxy stackIntegerValue: 0. + dlgHandle := self stackDialogHandle: 1. + interpreterProxy failed ifTrue:[^nil]. + self fileDialogDoneSemaphore: dlgHandle _: semaIndex "inSmalltalk: semaIndex". + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogGetFilterIndex (in category 'file dialogs') ----- + primitiveFileDialogGetFilterIndex + "Primitive. Get the current filter index from one of the previously chosen filters. + Arguments: + dlgHandle: Handle for the file dialog. + Return value: Filter index." + | dlgHandle result | + <export: true> + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFail]. + dlgHandle := self stackDialogHandle: 0. + interpreterProxy failed ifTrue:[^nil]. + result := self fileDialogGetFilterIndex: dlgHandle "inSmalltalk: 0". + result = 0 ifTrue:[^interpreterProxy primitiveFail]. + interpreterProxy methodReturnInteger: result!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogGetResult (in category 'file dialogs') ----- + primitiveFileDialogGetResult + "Primitive. Retrieve the result of the file dialog. + Arguments: + dlgHandle: Handle of the file dialog. + Return value: String for choosen file, or nil if canceled" + | dlgHandle cString | + <export: true> + <var: 'cString' type: #'char *'> + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFail]. + dlgHandle := self stackDialogHandle: 0. + interpreterProxy failed ifFalse: + [cString := self fileDialogGetResult: dlgHandle. + interpreterProxy failed ifFalse: + [self methodReturnStringOrNil: cString]]!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogSetCallbackSemaphore (in category 'file dialogs') ----- + primitiveFileDialogSetCallbackSemaphore + "Primitive. Set the callback semaphore to be used for running modal dialogs. + This is unimplemented (stubbed out) on all current platforms and so it is obsolete." + <export: true> + <legacy> + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogSetFile (in category 'file dialogs') ----- + primitiveFileDialogSetFile + "Primitive. Set the initial file name/path for the dialog. + Arguments: + dlgHandle: Handle for the file dialog. + filePath: Initial path for open dialog + Returns: Nothing." + | dlgHandle filePath | + <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. + filePath := self stackEphemeralStringValue: 0. + dlgHandle := self stackDialogHandle: 1. + interpreterProxy failed ifTrue: + [^self primitiveFailFor: PrimErrBadArgument]. + self fileDialogSetFile: dlgHandle _: filePath "inSmalltalk: false". + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogSetFilterIndex (in category 'file dialogs') ----- + primitiveFileDialogSetFilterIndex + "Primitive. Set the current filter index from one of the previously chosen filters. + Arguments: + dlgHandle: Handle for the file dialog. + index: Current filter index. + Return value: Nothing." + | dlgHandle index | + <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. + index := interpreterProxy stackIntegerValue: 0. + dlgHandle := self stackDialogHandle: 1. + interpreterProxy failed ifFalse: + [self fileDialogSetFilterIndex: dlgHandle _: index "inSmalltalk: index". + interpreterProxy methodReturnReceiver]!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogSetLabel (in category 'file dialogs') ----- + primitiveFileDialogSetLabel + "Primitive. Set the label for the dialog. + Arguments: + dlgHandle: Handle for the file dialog. + dlgLabel: Dialog label. + Returns: Nothing." + | dlgHandle dlgLabel | + <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. + dlgLabel := self stackEphemeralStringValue: 0. + dlgHandle := self stackDialogHandle: 1. + interpreterProxy failed ifTrue: + [^self primitiveFailFor: PrimErrBadArgument]. + self fileDialogSetLabel: dlgHandle _: dlgLabel "inSmalltalk: dlgLabel". + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogSetProperty (in category 'file dialogs') ----- + primitiveFileDialogSetProperty + "Primitive. Set additional properties for a file dialog. + Arguments: + dlgHandle: Handle of the file dialog. + propName: Property name. + propValue: Boolean indication whether to turn it on or off. + Return value: Boolean, indicating whether the property is supported." + | dlgHandle propName propValue | + <export: true> + interpreterProxy methodArgumentCount = 3 ifFalse: + [^interpreterProxy primitiveFail]. + dlgHandle := self stackDialogHandle: 2. + propName := self stackEphemeralStringValue: 1. + propValue := self stackBooleanValue: 0. + interpreterProxy failed ifTrue: + [^self primitiveFailFor: PrimErrBadArgument]. + interpreterProxy methodReturnBool: (self fileDialogSetProperty: dlgHandle _: propName _: propValue)!
Item was added: + ----- Method: FileDialogPlugin>>primitiveFileDialogShow (in category 'file dialogs') ----- + primitiveFileDialogShow + "Primitive. Show the file dialog. + Arguments: + dlgHandle: Handle of the file dialog. + fSaveAs: Whether to show an 'open' or a 'save' style dialog. + Return value: Nothing." + | dlgHandle fSaveAs | + <export: true> + interpreterProxy methodArgumentCount = 2 ifFalse: + [^interpreterProxy primitiveFail]. + fSaveAs := self stackBooleanValue: 0. + dlgHandle := self stackDialogHandle: 1. + interpreterProxy failed ifTrue: + [^nil]. + (self fileDialogShow: dlgHandle _: fSaveAs) ifFalse: + [^interpreterProxy primitiveFail]. + interpreterProxy methodReturnReceiver!
Item was added: + ----- Method: FileDialogPlugin>>primitiveGetFileLocation (in category 'file dialogs') ----- + primitiveGetFileLocation + "Primitive. Query for a common file location. + Arguments: + location: String describing the common file location. + Return value: The path to the designated location. + Known locations: + 'home' - the user's home directory + 'desktop' - the user's desktop directory + + 'temp' - the temp directory to use + 'preferences' - the place to store (per user) app preferences + 'applications' - the directory for installing applications + 'fonts' - the directory to install fonts in the system + + 'documents' - the users documents folder + 'music' - the users default location for music + 'pictures' - the users default location for pictures + 'videos' - the users default location for videos + " + | location | + <export: true> + interpreterProxy methodArgumentCount = 1 ifFalse: + [^interpreterProxy primitiveFail]. + location := self stackEphemeralStringValue: 0. + interpreterProxy failed ifTrue: + [^self primitiveFailFor: PrimErrBadArgument]. + self methodReturnStringOrNil: (self fileDialogGetLocation: location)!
Item was added: + ----- Method: FileDialogPlugin>>stackDialogHandle: (in category 'support') ----- + stackDialogHandle: index + <returnTypeC: #int> + <inline: #always> + ^self cCoerce: (interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: index)) + to: #int!
Item was changed: ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants
super initializeMiscConstants. STACKVM := true.
+ RevisedSuspend := true. "primitiveSuspendBackingUpV1/2 no longer allow a process waiting on a condition variable to go past the condition variable" - RevisedSuspend := true. "primitiveSuspend no longer allows a process waiting on a condition variable to go past the condition variable"
"These flags identify a GC operation (& hence a reason to leak check), or just operations the leak checker can be run for." GCModeFull := 1. "stop-the-world global GC" GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental" GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented" GCModeBecome := 8. "v3 post-become sweeping/Spur forwarding" GCCheckImageSegment := 16. "just a flag for leak checking image segments" GCCheckFreeSpace := 32. "just a flag for leak checking free space; Spur only" GCCheckShorten := 64. "just a flag for leak checking object shortening operations; Spur only" GCCheckPrimCall := 128. "just a flag for leak checking external primitive calls"
StackPageTraceInvalid := -1. StackPageUnreached := 0. StackPageReachedButUntraced := 1. StackPageTraced := 2.
MillisecondClockMask := 16r1FFFFFFF. "Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)" MaxExternalPrimitiveTableSize := 4096. "entries"
FailImbalancedPrimitives := InitializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true]. EnforceAccessControl := InitializationOptions at: #EnforceAccessControl ifAbsent: [true].
ReturnToInterpreter := 1. "setjmp/longjmp code."
"Because of a hack with callbacks in the non-threaded VM they must not conflct with the VM's tag bits." DisownVMForFFICall := 16. DisownVMForThreading := 32 !
Item was changed: ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') ----- (excessive size, no diff calculated)
Item was changed: ----- Method: StackInterpreter>>getCogVMFeatureFlags (in category 'internal interpreter access') ----- getCogVMFeatureFlags "Answer an array of flags indicating various optional features of the Cog VM. If the bit is set then... Bit 0: supports two bytecode sets (MULTIPLEBYTECODESETS) Bit 1: supports immutablity (IMMUTABILITY) Bit 2: suffers from a UNIX setitimer signal-based heartbeat Bit 3: the VM provides cross-platform bit-identical floating point Bit 4: the VM can catch exceptions in FFI calls and answer them as primitive failures + Bit 5: the VM has suspend primitives 568 & 578 which back up a process to before the wait if it was waiting on a condition variable" - Bit 5: the suspend primitive backs up a process to before the wait if it was waiting on a condition variable" ^objectMemory integerObjectOf: (MULTIPLEBYTECODESETS ifTrue: [1] ifFalse: [0]) + (IMMUTABILITY ifTrue: [2] ifFalse: [0]) + (self cppIf: #'ITIMER_HEARTBEAT' ifTrue: [4] ifFalse: [0]) + (self cppIf: #'BIT_IDENTICAL_FLOATING_POINT' ifTrue: [8] ifFalse: [0]) + (self ioCanCatchFFIExceptions ifTrue: [16] ifFalse: [0]) + (RevisedSuspend ifTrue: [32] ifFalse: [0])!
Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') ----- primitiveSuspend + "Primitive #88. Suspend the receiver, aProcess, such that it can be executed again - "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. The primitive returns the list the receiver was previously on. + c.f. primitiveSuspendBackingUpV1,#568 & primitiveSuspendBackingUpV2,#578" - 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, - unless it was the activ eProcess, in which case answer nil." | process myList myContext ok | process := self stackTop. process = self activeProcess ifTrue: + [self stackTopPut: objectMemory nilObject. - [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 stackTopPut: myList! - self assert: RevisedSuspend. - (RevisedSuspend - and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag]) ifTrue: - [self backupContext: myContext toBlockingSendTo: myList]. - self pop: 1 thenPush: myList!
Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveSuspendBackingUpV1 (in category 'process primitives') ----- + primitiveSuspendBackingUpV1 + "Primitive #568. 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, + unless it was the activeProcess, in which case answer nil. + c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV2,#578" + | process myList myContext ok | + process := self stackTop. + process = self activeProcess ifTrue: + [self stackTopPut: 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. + (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag ifTrue: + [self backupContext: myContext toBlockingSendTo: myList]. + self stackTopPut: myList!
Item was added: + ----- Method: StackInterpreterPrimitives>>primitiveSuspendBackingUpV2 (in category 'process primitives') ----- + primitiveSuspendBackingUpV2 + "Primitive #578. 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. + c.f. primitiveSuspend,#88 & primitiveSuspendBackingUpV1,#568, + which always answer the list the process was on, even if blocked." + <export: true> + | process myList myContext ok | + process := self stackTop. + process = self activeProcess ifTrue: + [self stackTopPut: 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. + (objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag + ifTrue: + [self backupContext: myContext toBlockingSendTo: myList. + self stackTopPut: objectMemory nilObject] + ifFalse: + [self stackTopPut: myList]!
Item was removed: - ----- Method: StackInterpreterPrimitives>>primitiveSuspendV2 (in category 'process primitives') ----- - primitiveSuspendV2 - "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. - c.f. primitiveSuspend, which always answers the list the process was on, if blocked." - <export: true> - | 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 pop: 1 thenPush: objectMemory nilObject] - ifFalse: - [self pop: 1 thenPush: myList]!
Item was removed: - ----- Method: StackInterpreterSimulator>>primitiveSuspend (in category 'debugging traps') ----- - primitiveSuspend - "Catch errors before we start the whole morphic error process" - - "byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity" - "self stackTop = (objectMemory fetchPointer: FirstLinkIndex ofObject: (objectMemory splObj: TheFinalizationSemaphore)) ifTrue: - [self halt]." - ^ super primitiveSuspend!
Item was changed: ----- Method: VMMaker class>>generateVMPlugins (in category 'configurations') ----- generateVMPlugins ^VMMaker generatePluginsTo: self sourceTree, '/src' options: #() platformDir: self sourceTree, '/platforms' including:#(ADPCMCodecPlugin AsynchFilePlugin BalloonEnginePlugin B3DAcceleratorPlugin B3DEnginePlugin BMPReadWriterPlugin BitBltSimulation BochsIA32Plugin BochsX64Plugin GdbARMv6Plugin GdbARMv8Plugin CameraPlugin ClipboardExtendedPlugin CroquetPlugin DeflatePlugin DropPlugin "Cryptography Plugins:" DESPlugin DSAPlugin MD5Plugin SHA2Plugin + FileDialogPlugin "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin - "FT2Plugin" FFTPlugin FileCopyPlugin FilePlugin FileAttributesPlugin Float64ArrayPlugin FloatArrayPlugin FloatMathPlugin GeniePlugin HostWindowPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JPEGReadWriter2Plugin JPEGReaderPlugin JoystickTabletPlugin KlattSynthesizerPlugin LargeIntegersPlugin LocalePlugin MIDIPlugin MacMenubarPlugin Matrix2x3Plugin MiscPrimitivePlugin Mpeg3Plugin QuicktimePlugin RePlugin ScratchPlugin SecurityPlugin SerialPlugin SocketPlugin SoundCodecPlugin SoundGenerationPlugin SoundPlugin SqueakSSLPlugin StarSqueakPlugin ThreadedFFIPlugin ThreadedARM32FFIPlugin ThreadedARM64FFIPlugin ThreadedIA32FFIPlugin ThreadedX64SysVFFIPlugin ThreadedX64Win64FFIPlugin UnicodePlugin UnixAioPlugin UUIDPlugin UnixOSProcessPlugin Win32OSProcessPlugin VMProfileLinuxSupportPlugin VMProfileMacSupportPlugin WeDoPlugin XDisplayControlPlugin)!
vm-dev@lists.squeakfoundation.org
-
Jaromir Matas