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)!
Hi Eliot,
I've noticed your recent changes in primitiveSuspend (primitives 88, 568 and 578).
#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.
From your explanation I understand Virtend etc. depend not only on the values returned by primitiveSuspend but primarily on the whole "non-backing", semaphore releasing suspend behavior; that means none of the new suspend primitives (568, 578) will work with Virtend and other images taking advantage of the old semantics - at least without potentially extensive rewrite.
If that is true I wonder why two new suspend versions differing by their return value.
Primitive suspend: revert the semantics of #88 to Andreas' revision in the early 2000's.
There's something else I don't understand:
This is Andreas's comment in Process >> offList (ar 12/7/2007): ``` "OBSOLETE. Process>>suspend will atomically reset myList if the process is suspended. There should never be a need to send #offList but some older users may not be aware of the changed semantics to suspend and may try the old hickadidoo seen here:
(suspendingList := process suspendingList) == nil ifTrue: [process == Processor activeProcess ifTrue: [process suspend]] ifFalse: [suspendingList remove: process ifAbsent:[]. process offList].
Usages like the above should be replaced by a simple 'process suspend' " ``` What "changed semantics" (on the 3rd line)?? Was there yet another suspend semantics before the current one?
In any case it seems to me Andreas consciously used the changed (i.e. our current, non-backing) semantics to remove processes from semaphores/mutexes and encouraged using #suspend to achieve that.
So I’ve started to suspect removing a process from a conditional variable may not have been a bug but an intentional design. Is there some generally accepted standard for #suspend? I personally prefer the "backing up" way but I've noticed Visual Age openly use this non-backing, semaphore releasing #suspend semantics while Visual Works use the backing up semantics implemented by primitives 568/578.
I have no way to verify my suspicion but you might be in a position to shed some light :)
I'm looking forward to hearing from you.
Best regards, Jaromir
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)!
Hi again,
apologies, I mixed things up a bit: suspending a process waiting on a Semaphore is a **no-op** in VA; they don't recognize blocked (i.e. conditionally suspended) as a distinct process state. It means VA can’t suspend e.g. the following process while in the wait:
p := [10 seconds wait] forkAt: Processor activePriority + 1
Sorry for the confusion. VA’s #suspend semantics is indeed different from Squeak’s.
However, I’ve found an absurd behavior of the following example (series of waits):
p := [1 to: 12 do: [: each | Transcript cr; show: 'waiting ', each. (Delay forSeconds: 2) wait] ] forkAt: Processor activePriority + 1
If you start the process p (do-it), it’ll start printing every 2 seconds, then execute `p resume` let’s say twice and then in order to suspend the process p you have to execute `p suspend` multiple times (at least 3 times) – as if resume "charged" the process against suspend :D And on top of that a few BCR errors may appear after some time, depending on how many times you executed #suspend.
I don’t think it’s #suspend’s problem; all three primitives behave the same. I think there’s a bug in #resume (prim 87). Its comment says: […] Fail if the receiver is already waiting in a queue (in a Semaphore or ProcessScheduler) […] But apparently in Squeak this is not happening; try these two examples:
Resume bug example 1: p := [Semaphore new wait] forkAt: Processor activePriority + 1. p resume. p isTerminated
example 2: p := [10 seconds wait] forkAt: Processor activePriority + 1. p resume. p isTerminated "answers true => a bug" "in 10 seconds a BCR error appears :("
This second example hints why the above example behaves so weird… There’s a Semaphore involved in Delay and it recharges every time after #resume is executed…
I guess a possible fix is to make #resume do nothing (or fail) when sending resume to a blocked process.
However, I’m a bit afraid it may be the same story as with #suspend – some apps may have used this “semantics” and fixing the may break them… But indeed I don’t know.
What do you think?
Tie the two changes together?
Notes: 1. For comparison: VW behaves as expected – an attempt to resume a blocked process results in resume’s failure. (for VA no problem exists because they don’t recognize a blocked process state as distinct from suspended).
2. At last I understand now what Andreas meant by the "changed semantics" of suspend – in earlier versions (prior 2006?) #suspend didn’t work on blocked or waiting processes… just on active ones. Later #suspend worked even on blocked, however with the current semantics (remove from the conditional variable).
Thanks for your patience if you’ve read this far :))
Best, Jaromir
From: Jaromir Matasmailto:mail@jaromir.net Sent: Sunday, February 13, 2022 16:49 To: vm-dev@lists.squeakfoundation.orgmailto:vm-dev@lists.squeakfoundation.org; Eliot Mirandamailto:eliot.miranda@gmail.com Subject: RE: [Vm-dev] VM Maker: VMMaker.oscog-eem.3151.mcz
Hi Eliot,
I've noticed your recent changes in primitiveSuspend (primitives 88, 568 and 578).
#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.
From your explanation I understand Virtend etc. depend not only on the values returned by primitiveSuspend but primarily on the whole "non-backing", semaphore releasing suspend behavior; that means none of the new suspend primitives (568, 578) will work with Virtend and other images taking advantage of the old semantics - at least without potentially extensive rewrite.
If that is true I wonder why two new suspend versions differing by their return value.
Primitive suspend: revert the semantics of #88 to Andreas' revision in the early 2000's.
There's something else I don't understand:
This is Andreas's comment in Process >> offList (ar 12/7/2007): ``` "OBSOLETE. Process>>suspend will atomically reset myList if the process is suspended. There should never be a need to send #offList but some older users may not be aware of the changed semantics to suspend and may try the old hickadidoo seen here:
(suspendingList := process suspendingList) == nil ifTrue: [process == Processor activeProcess ifTrue: [process suspend]] ifFalse: [suspendingList remove: process ifAbsent:[]. process offList].
Usages like the above should be replaced by a simple 'process suspend' " ``` What "changed semantics" (on the 3rd line)?? Was there yet another suspend semantics before the current one?
In any case it seems to me Andreas consciously used the changed (i.e. our current, non-backing) semantics to remove processes from semaphores/mutexes and encouraged using #suspend to achieve that.
So I’ve started to suspect removing a process from a conditional variable may not have been a bug but an intentional design. Is there some generally accepted standard for #suspend? I personally prefer the "backing up" way but I've noticed Visual Age openly use this non-backing, semaphore releasing #suspend semantics while Visual Works use the backing up semantics implemented by primitives 568/578.
I have no way to verify my suspicion but you might be in a position to shed some light :)
I'm looking forward to hearing from you.
Best regards, Jaromir
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)!
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).
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]]
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