From commits at source.squeak.org Sat May 1 05:09:24 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 05:09:24 0000 Subject: [squeak-dev] The Trunk: Morphic-ct.1768.mcz Message-ID: Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1768.mcz ==================== Summary ==================== Name: Morphic-ct.1768 Author: ct Time: 30 April 2021, 8:02:20.035293 pm UUID: 2c143938-6557-0b42-973c-6453d49680cf Ancestors: Morphic-mt.1767 Fixes a GrafPort bug when drawing round rectangle frames. In the past, the horizontal segments were too wide. Original snippet to reproduce (provided by Marcel, mt): morph := Morph new. morph extent: 500 at 500; borderWidth: 50; borderColor: Color red; cornerStyle: #rounded; cornerRadius: 20; yourself. morph openInHand. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: GrafPort>>frameRoundRect:radius:borderWidth: (in category 'drawing support') ----- frameRoundRect: aRectangle radius: radius borderWidth: borderWidth | nextY outer nextOuterX ovalDiameter rectExtent rectOffset rectX rectY rectWidth rectHeight ovalRadius ovalRect innerRadius innerDiameter innerRect inner nextInnerX wp | aRectangle area <= 0 ifTrue: [^ self]. ovalDiameter := (radius * 2) asPoint min: aRectangle extent. (ovalDiameter x <= 0 or:[ovalDiameter y <= 0]) ifTrue:[ ^self fillRect: aRectangle offset: 0 at 0. ]. "force diameter to be even - this simplifies lots of stuff" ovalRadius := (ovalDiameter x // 2) @ (ovalDiameter y // 2). (ovalRadius x <= 0 or:[ovalRadius y <= 0]) ifTrue:[ ^self fillRect: aRectangle offset: 0 at 0. ]. wp := borderWidth asPoint. ovalDiameter := ovalRadius * 2. innerRadius := ovalRadius - borderWidth max: 0 at 0. innerDiameter := innerRadius * 2. rectExtent := aRectangle extent - ovalDiameter. rectWidth := rectExtent x. rectHeight := rectExtent y. rectOffset := aRectangle origin + ovalRadius. rectX := rectOffset x. rectY := rectOffset y. ovalRect := 0 at 0 extent: ovalDiameter. innerRect := 0 at 0 extent: innerDiameter. height := 1. outer := EllipseMidpointTracer new on: ovalRect. inner := EllipseMidpointTracer new on: innerRect. nextY := ovalRadius y. 1 to: (wp y min: nextY) do:[:i| nextOuterX := outer stepInY. width := nextOuterX * 2 + rectWidth. destX := rectX - nextOuterX. destY := rectY - nextY. self copyBits. destY := rectY + nextY + rectHeight - 1. self copyBits. nextY := nextY - 1. ]. [nextY > 0] whileTrue:[ nextOuterX := outer stepInY. nextInnerX := inner stepInY. destX := rectX - nextOuterX. destY := rectY - nextY. width := nextOuterX - nextInnerX. self copyBits. destX := rectX + nextInnerX + rectWidth. self copyBits. destX := rectX - nextOuterX. destY := rectY + nextY + rectHeight-1. self copyBits. destX := rectX + nextInnerX + rectWidth. self copyBits. nextY := nextY - 1. ]. destX := aRectangle left. destY := rectOffset y. height := rectHeight. width := wp x. self copyBits. destX := aRectangle right - width. self copyBits. innerRadius y = 0 ifTrue:[ destX := aRectangle left + wp x. destY := rectY. + width := aRectangle width - (wp x * 2). - width := rectWidth. height := wp y - ovalRadius y. self copyBits. destY := aRectangle bottom - wp y. self copyBits. ].! From commits at source.squeak.org Sat May 1 06:25:29 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 06:25:29 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.122.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.122.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.122 Author: mt Time: 1 May 2021, 8:25:28.22519 am UUID: 6c3424fd-34f9-f44e-b109-3e27c0690885 Ancestors: FFI-Kernel-mt.121 Adds check to separate integer types from float types. There already is #isIntegerType. For example, callback handles can use this to choose between integer-registers and float-registers easily based on argument types. =============== Diff against FFI-Kernel-mt.121 =============== Item was added: + ----- Method: ExternalStructureType>>isFloatType (in category 'testing') ----- + isFloatType + "Overwritten to not raise an error for struct types." + + ^ false! Item was added: + ----- Method: ExternalType>>isFloatType (in category 'testing') ----- + isFloatType + "Return true if the receiver is a built-in float type" + | type | + type := self atomicType. + ^type = FFITypeSingleFloat or: [type = FFITypeDoubleFloat]! From commits at source.squeak.org Sat May 1 06:27:57 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 06:27:57 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.6.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.6.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.6 Author: mt Time: 1 May 2021, 8:27:57.27619 am UUID: d17398f2-ff43-0945-aa04-e00bf7b6e0ae Ancestors: FFI-Callbacks-mt.5 Adds register lookup for dynamic callback evaluation. Based on the assumption that a callback context is only used once per callback. =============== Diff against FFI-Callbacks-mt.5 =============== Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." + | byteOffset args intArgs intPos floatArgs floatPos | - | offset args | - offset := 1. - args := Array new: argumentTypes size. + handle := callbackContext stackPtr getHandle. + type := callbackContext stackPtr contentType. + byteOffset := 1. + + intArgs := callbackContext integerArguments. + intPos := 0. + floatArgs := callbackContext floatArguments. + floatPos := 0. + + args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data | argType := argumentTypes at: argIndex. + + "1) Try to read arguments from registers." + data := (intPos < intArgs size and: [argType isPointerType or: [argType isIntegerType]]) + ifTrue: [intPos := intPos + 1. intArgs at: intPos] + ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) + ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. + + "2) If nothing was read, read the argument from the stack." + data ifNil: [ + data := argType handle: handle at: byteOffset. + byteOffset := byteOffset + + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. + + args at: argIndex put: data]. - data := argType handle: handle at: offset. - args at: argIndex put: data. - "Move the offset. Consider the byte-alignment?" - offset := offset + ((type byteSize max: argType byteSize) roundUpTo: type byteSize)]. - ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_ARM32: (in category 'callback - evaluators') ----- evaluateDynamic_ARM32: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + callbackContext integerArguments size: 4. + callbackContext floatArguments size: 8. - | intRegArgs floatRegArgs stackPtr | - intRegArgs := callbackContext intRegArgs. - intRegArgs size: 4. - floatRegArgs := callbackContext floatRegArgs. - floatRegArgs size: 8. - - stackPtr := callbackContext stackPtr. - - self assert: [argumentTypes size <= intRegArgs size]. - - self setArgData: intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_ARM64: (in category 'callback - evaluators') ----- evaluateDynamic_ARM64: callbackContext "Set handle to access arguments as most appropriate for the ABI. ARMv8 with AArch64." + + callbackContext integerArguments size: 8. + callbackContext floatArguments size: 8. - - | intRegArgs floatRegArgs stackPtr | - intRegArgs := callbackContext intRegArgs. - intRegArgs size: 8. - floatRegArgs := callbackContext floatRegArgs. - floatRegArgs size: 8. - - stackPtr := callbackContext stackPtr. - - self assert: [argumentTypes size <= intRegArgs size]. - - self setArgData: intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_IA32: (in category 'callback - evaluators') ----- evaluateDynamic_IA32: callbackContext "Set handle to access arguments as most appropriate for the ABI. For x86 (i.e. IA32) it is the stack pointer." + - + callbackContext integerArguments size: 0. + callbackContext floatArguments size: 0. - self setArgData: callbackContext stackPtr. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_X64: (in category 'callback - evaluators') ----- evaluateDynamic_X64: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + callbackContext integerArguments size: 6. + callbackContext floatArguments size: 8. - | intRegArgs floatRegArgs stackPtr | - intRegArgs := callbackContext intRegArgs. - intRegArgs size: 6. - floatRegArgs := callbackContext floatRegArgs. - floatRegArgs size: 8. - - stackPtr := callbackContext stackPtr. - - self assert: [argumentTypes size <= intRegArgs size]. - - self setArgData: intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_X64Win64: (in category 'callback - evaluators') ----- evaluateDynamic_X64Win64: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + + callbackContext integerArguments size: 4. + callbackContext floatArguments size: 4. - - | intRegArgs floatRegArgs stackPtr | - intRegArgs := callbackContext intRegArgs. - intRegArgs size: 4. - floatRegArgs := callbackContext floatRegArgs. - floatRegArgs size: 4. - - stackPtr := callbackContext stackPtr. - - self assert: [argumentTypes size <= intRegArgs size]. - - self setArgData: intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ExternalStructure subclass: #FFICallbackContext + instanceVariableNames: 'floatArguments integerArguments' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'FFICallbackConstants' category: 'FFI-Callbacks'! !FFICallbackContext commentStamp: 'mt 4/30/2021 11:32' prior: 0! A callback context is a data structure prepared from the VM for accessing the callback's arguments. See FFICallback >> #thunkEntryAddress. !!!!!! BE AWARE that the actual location of argument values in this structure depend on the current ABI (i.e. 'Application Binary Interface'). See FFIPlatformDescription to access the current ABI.! Item was added: + ----- Method: FFICallbackContext>>floatArguments (in category 'callback arguments') ----- + floatArguments + "Cache proxy to the list of float arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size." + + ^ floatArguments ifNil: [ + floatArguments := self floatRegArgs]! Item was added: + ----- Method: FFICallbackContext>>integerArguments (in category 'callback arguments') ----- + integerArguments + "Cache proxy to the list of integer arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size." + + ^ integerArguments ifNil: [ + integerArguments := self intRegArgs]! From Das.Linux at gmx.de Sat May 1 06:54:21 2021 From: Das.Linux at gmx.de (Tobias Pape) Date: Sat, 1 May 2021 08:54:21 +0200 Subject: [squeak-dev] Dictionary >> #at:ifAbsentPut:ifPresentPut: In-Reply-To: <1619825198885-0.post@n4.nabble.com> References: <8d6d63a2257344c7853cbf45603de7cb@student.hpi.uni-potsdam.de> <1619825198885-0.post@n4.nabble.com> Message-ID: > On 1. May 2021, at 01:26, stlutz wrote: > > Christoph Thiede wrote > What do you think, should we copy this into the Trunk? > Personally, I'd get good use out of at:ifPresentPut: and at:ifPresentPut:ifAbsentPut:. > I seriously considered adding them as extensions in a couple of projects. > Christoph Thiede wrote > Also, I'm not sure about the order of arguments. > The pattern other selectors in Squeak follow is present first, absent second. > We should probably keep to that pattern. > Tobias Pape wrote > I find it a bit too specific for trunk. > It's quite an edge case... > FWIW I encountered this case quite a few times over the years. > It's essentially always a concern when storing and updating value objects in dictionaries. Temporary variables are not your enemy. Or even: (foo hasKey: 'abc') ifTrue: [foo at: 'abc' put: 'def'] Updating existing values really does not need shortcuts. Initial defaults are another thing, but I think ifPresentPut: is a malpattern… Best regards -Tobias > Levente Uzonyi wrote > If wanted to have a special method for that case, I would try to look up the key only once. > +1 > > Stephan > Sent from the Squeak - Dev mailing list archive at Nabble.com. > From commits at source.squeak.org Sat May 1 07:06:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 07:06:55 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.7.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.7.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.7 Author: mt Time: 1 May 2021, 9:06:54.87419 am UUID: 1094c754-1e24-d342-8822-31dce676cd6a Ancestors: FFI-Callbacks-mt.6 Fixes regression. I forgot to resolve materialize pointers from integers when reading intRegArgs. (For debugging, adds #mostRecent shortcut to FFICallbackContext class.) =============== Diff against FFI-Callbacks-mt.6 =============== Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | + | argType data isPointer | - | argType data | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." + data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) - data := (intPos < intArgs size and: [argType isPointerType or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. + data + ifNotNil: [ "1b) Materialize pointers from integers." + isPointer ifTrue: [ + self flag: #designSmell. "mt: If we had a way to set, for example, double** as container type and double* as content type for intArgs, we would not have to construct the correct external object here but already had it." + self flag: #discuss. "mt: Should we resolve atomic types? That is, double* to an actual float object etc? Well, for pointers to external structures (unions, ...) it would make sense to provide an actual instance of that structure to the callback... If so, we just need to send #value below." + data := (ExternalData + fromHandle: (ExternalAddress fromInteger: data) + type: argType) size: 1; "value; " yourself]] + ifNil: [ "2) If nothing was read, read the argument from the stack." + data := argType handle: handle at: byteOffset. + byteOffset := byteOffset + + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. - "2) If nothing was read, read the argument from the stack." - data ifNil: [ - data := argType handle: handle at: byteOffset. - byteOffset := byteOffset - + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was added: + ----- Method: FFICallbackContext class>>mostRecent (in category 'instance lookup') ----- + mostRecent + + ^ FFICallbackMemory mostRecentCallbackContext! From commits at source.squeak.org Sat May 1 07:32:35 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 07:32:35 0000 Subject: [squeak-dev] FFI Inbox: FFI-Callbacks-mt.8.mcz Message-ID: A new version of FFI-Callbacks was added to project FFI Inbox: http://source.squeak.org/FFIinbox/FFI-Callbacks-mt.8.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.8 Author: mt Time: 1 May 2021, 9:32:35.005521 am UUID: c855a635-3cb2-1543-bb07-5c9d637df03d Ancestors: FFI-Callbacks-mt.7 In callbacks. resolve one level of indirection so that callbacks can directly work with atomic values or instances of external structures. This might conflict with the current lack of support for n-ary pointer types. =============== Diff against FFI-Callbacks-mt.7 =============== Item was changed: ----- Method: FFICallback class>>exampleCqsort (in category 'examples') ----- exampleCqsort "Call the libc qsort function (which requires a callback)." "FFICallback exampleCqsort" "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" | type cb rand nElements sizeofDouble values orig sort libcName knownLibcNames fn | knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll'). libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'. libcName = 0 ifTrue: [^ self]. libcName := knownLibcNames at: libcName. rand := Random new. type := ExternalType double. sizeofDouble := type byteSize. nElements := 10. values := ExternalData fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. values size: nElements. "Fetch a local copy of the external data." orig := values collect: [:each | each]. "Construct the callback structure." cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | + Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}). - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). self halt. + (arg1 - arg2) sign]. - (a - b) sign]. "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );" fn := ExternalLibraryFunction name: 'qsort' module: libcName callType: ExternalLibraryFunction callTypeCDecl returnType: ExternalType void argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). "Invoke!!" fn invokeWith: values "getHandle" with: nElements with: sizeofDouble with: cb thunk "getHandle". sort := values collect: [:each | each]. values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback class>>exampleCqsortThree (in category 'examples') ----- exampleCqsortThree "Call the libc qsort function (which requires a callback)." " FFICallback exampleCqsortThree " "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" | type rand nElements sizeofDouble values orig sort cb | rand := Random new. type := ExternalType double. sizeofDouble := type byteSize. nElements := 10. values := ExternalData fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. values size: nElements. "Fetch a local copy of the external data." orig := values collect: [:each | each]. "Construct the callback structure." cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | + Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}). - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). self halt. + (arg1 - arg2) sign]. - (a - b) sign]. "Invoke!!" self cdeclQsort: values with: nElements with: sizeofDouble with: cb thunk. sort := values collect: [:each | each]. values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback class>>exampleCqsortTwo (in category 'examples') ----- exampleCqsortTwo "Call the libc qsort function (which requires a callback)." " FFICallback exampleCqsortTwo " "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" | type rand nElements sizeofDouble values orig sort | rand := Random new. type := ExternalType double. sizeofDouble := type byteSize. nElements := 10. values := ExternalData fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. values size: nElements. "Fetch a local copy of the external data." orig := values collect: [:each | each]. "Invoke!!" self qsort: values with: nElements with: sizeofDouble with: [ :arg1 :arg2 | + Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}). - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). self halt. + (arg1 - arg2) sign]. - (a - b) sign]. sort := values collect: [:each | each]. values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Materialize pointers from integers." isPointer ifTrue: [ self flag: #designSmell. "mt: If we had a way to set, for example, double** as container type and double* as content type for intArgs, we would not have to construct the correct external object here but already had it." - self flag: #discuss. "mt: Should we resolve atomic types? That is, double* to an actual float object etc? Well, for pointers to external structures (unions, ...) it would make sense to provide an actual instance of that structure to the callback... If so, we just need to send #value below." data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) + type: argType) value ]] - type: argType) size: 1; "value; " yourself]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := argType handle: handle at: byteOffset. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! From commits at source.squeak.org Sat May 1 08:22:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 08:22:08 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.123.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.123.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.123 Author: mt Time: 1 May 2021, 10:22:08.119394 am UUID: 8a1725e7-90a1-2348-9e01-3ce391c4036f Ancestors: FFI-Kernel-mt.122 Given that we usually talk to external types or external structures (and unions ...) where #allocate: is the current pattern to prepare a list of such things, use #allocateExternal: to allocate external memory, not internal object memory. While this conflicts with ExternalAddress class #allocate:, clients might not notice because they should usually not deal with the difference between handles being either ByteArray or ExternalAddress (or atomics). I suppose. Let #free for handles being ExternAdress also null that address. Maybe we could establish a common prototype for a null-address? (Removes duplicate #isExternalAddress.) =============== Diff against FFI-Kernel-mt.122 =============== Item was removed: - ----- Method: ByteArray>>isExternalAddress (in category '*FFI-Kernel-testing') ----- - isExternalAddress - "Return true if the receiver describes the address of an object in the outside world" - ^false! Item was added: + ----- Method: ExternalStructure class>>allocateExternal: (in category 'instance creation') ----- + allocateExternal: anInteger + "Create an ExternalData with enough room for storing an array of size anInteger of such structure. Don't forget to free the allocated memory!!!!!!" + ^self externalType allocateExternal: anInteger! Item was changed: ----- Method: ExternalStructure>>free (in category 'initialize-release') ----- free "Free the handle pointed to by the receiver" + + handle isExternalAddress + ifTrue: [handle free; beNull] + ifFalse: [handle := nil].! - (handle ~~ nil and:[handle isExternalAddress]) ifTrue:[handle free]. - handle := nil.! Item was added: + ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- + allocateExternal: anInteger + "Allocate space for containing an array of size anInteger of this dataType" + + | handle | + handle := ExternalAddress allocate: self byteSize * anInteger. + ^(ExternalData fromHandle: handle type: self) size: anInteger! From commits at source.squeak.org Sat May 1 08:24:13 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 08:24:13 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.9.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.9.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.9 Author: mt Time: 1 May 2021, 10:24:12.802394 am UUID: 937a46d5-7f6d-9344-8165-515cc5a54b55 Ancestors: FFI-Callbacks-mt.7 Restructure callback examples. Adds a fourth example that sorts integers. Complements FFI-Kernel-mt.123. =============== Diff against FFI-Callbacks-mt.7 =============== Item was removed: - ----- Method: FFICallback class>>exampleCqsort (in category 'examples') ----- - exampleCqsort - "Call the libc qsort function (which requires a callback)." - "FFICallback exampleCqsort" - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type cb rand nElements sizeofDouble values orig sort libcName knownLibcNames fn | - - knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll'). - libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'. - libcName = 0 ifTrue: [^ self]. - libcName := knownLibcNames at: libcName. - - rand := Random new. - type := ExternalType double. - sizeofDouble := type byteSize. - nElements := 10. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - values size: nElements. - "Fetch a local copy of the external data." - orig := values collect: [:each | each]. - - "Construct the callback structure." - cb := FFICallback - signature: '' - "signature: #(int 'double*' 'double*')" - block: [ :arg1 :arg2 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (a - b) sign]. - - "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );" - fn := ExternalLibraryFunction - name: 'qsort' module: libcName - callType: ExternalLibraryFunction callTypeCDecl - returnType: ExternalType void - argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). - - "Invoke!!" - fn invokeWith: values "getHandle" with: nElements with: sizeofDouble with: cb thunk "getHandle". - - sort := values collect: [:each | each]. - values getHandle free. - ^orig -> sort! Item was added: + ----- Method: FFICallback class>>exampleCqsort01 (in category 'examples') ----- + exampleCqsort01 + "Call the libc qsort function (which requires a callback)." + "FFICallback exampleCqsort01" + "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" + + | type cb rand nElements sizeofDouble values orig sort libcName knownLibcNames fn | + + knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll'). + libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'. + libcName = 0 ifTrue: [^ self]. + libcName := knownLibcNames at: libcName. + + rand := Random new. + type := ExternalType double. + sizeofDouble := type byteSize. + nElements := 10. + values := ExternalData + fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) + type: type asPointerType. + "Initialize external data and set size for enumeration." + 1 to: nElements do: [:i| values at: i put: rand next]. + values size: nElements. + "Fetch a local copy of the external data." + orig := values collect: [:each | each]. + + "Construct the callback structure." + cb := FFICallback + signature: '' + "signature: #(int 'double*' 'double*')" + block: [ :arg1 :arg2 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (a - b) sign]. + + "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );" + fn := ExternalLibraryFunction + name: 'qsort' module: libcName + callType: ExternalLibraryFunction callTypeCDecl + returnType: ExternalType void + argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). + + "Invoke!!" + fn invokeWith: values "getHandle" with: nElements with: sizeofDouble with: cb thunk "getHandle". + + sort := values collect: [:each | each]. + values getHandle free. + ^orig -> sort! Item was added: + ----- Method: FFICallback class>>exampleCqsort02 (in category 'examples') ----- + exampleCqsort02 + "Call the libc qsort function (which requires a callback)." + " + FFICallback exampleCqsort02 + " + "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" + + | type rand nElements sizeofDouble values orig sort | + + rand := Random new. + type := ExternalType double. + sizeofDouble := type byteSize. + nElements := 10. + values := ExternalData + fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) + type: type asPointerType. + "Initialize external data and set size for enumeration." + 1 to: nElements do: [:i| values at: i put: rand next]. + values size: nElements. + "Fetch a local copy of the external data." + orig := values collect: [:each | each]. + + "Invoke!!" + self + qsort: values with: nElements with: sizeofDouble + with: [ :arg1 :arg2 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (a - b) sign]. + + sort := values collect: [:each | each]. + values getHandle free. + ^orig -> sort! Item was added: + ----- Method: FFICallback class>>exampleCqsort03 (in category 'examples') ----- + exampleCqsort03 + "Call the libc qsort function (which requires a callback)." + " + FFICallback exampleCqsort03 + " + "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" + + | type rand nElements sizeofDouble values orig sort cb | + + rand := Random new. + type := ExternalType double. + sizeofDouble := type byteSize. + nElements := 10. + values := ExternalData + fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) + type: type asPointerType. + "Initialize external data and set size for enumeration." + 1 to: nElements do: [:i| values at: i put: rand next]. + values size: nElements. + "Fetch a local copy of the external data." + orig := values collect: [:each | each]. + + "Construct the callback structure." + cb := FFICallback + signature: '' + "signature: #(int 'double*' 'double*')" + block: [ :arg1 :arg2 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (a - b) sign]. + + + "Invoke!!" + self + cdeclQsort: values with: nElements with: sizeofDouble + with: cb thunk. + + sort := values collect: [:each | each]. + values getHandle free. + ^orig -> sort! Item was added: + ----- Method: FFICallback class>>exampleCqsort04 (in category 'examples') ----- + exampleCqsort04 + " + FFICallback exampleCqsort04 + " + + | type in out fn cb | + type := ExternalType int32_t. + in := type allocateExternal: 10. + 1 to: in size do: [:each | + in at: each put: 100 atRandom]. + + cb := FFICallback + signature: '' + "signature: #(int 'double*' 'double*')" + block: [ :arg1 :arg2 | + | a b | + a := arg1 signedLongAt: 1. + b := arg2 signedLongAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + "self halt." + (a - b) sign]. + + fn := ExternalLibraryFunction + name: 'qsort' module: 'msvcrt.dll' + callType: ExternalLibraryFunction callTypeCDecl + returnType: ExternalType void + argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). + + "Invoke!!" + fn + invokeWith: in "getHandle" + with: in size + with: in contentType byteSize + with: cb thunk "getHandle". + + out := in collect: [:each | each]. + in free. + ^ out! Item was removed: - ----- Method: FFICallback class>>exampleCqsortThree (in category 'examples') ----- - exampleCqsortThree - "Call the libc qsort function (which requires a callback)." - " - FFICallback exampleCqsortThree - " - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type rand nElements sizeofDouble values orig sort cb | - - rand := Random new. - type := ExternalType double. - sizeofDouble := type byteSize. - nElements := 10. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - values size: nElements. - "Fetch a local copy of the external data." - orig := values collect: [:each | each]. - - "Construct the callback structure." - cb := FFICallback - signature: '' - "signature: #(int 'double*' 'double*')" - block: [ :arg1 :arg2 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (a - b) sign]. - - - "Invoke!!" - self - cdeclQsort: values with: nElements with: sizeofDouble - with: cb thunk. - - sort := values collect: [:each | each]. - values getHandle free. - ^orig -> sort! Item was removed: - ----- Method: FFICallback class>>exampleCqsortTwo (in category 'examples') ----- - exampleCqsortTwo - "Call the libc qsort function (which requires a callback)." - " - FFICallback exampleCqsortTwo - " - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type rand nElements sizeofDouble values orig sort | - - rand := Random new. - type := ExternalType double. - sizeofDouble := type byteSize. - nElements := 10. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - values size: nElements. - "Fetch a local copy of the external data." - orig := values collect: [:each | each]. - - "Invoke!!" - self - qsort: values with: nElements with: sizeofDouble - with: [ :arg1 :arg2 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (a - b) sign]. - - sort := values collect: [:each | each]. - values getHandle free. - ^orig -> sort! From commits at source.squeak.org Sat May 1 09:01:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 09:01:07 0000 Subject: [squeak-dev] FFI Inbox: FFI-Callbacks-mt.10.mcz Message-ID: A new version of FFI-Callbacks was added to project FFI Inbox: http://source.squeak.org/FFIinbox/FFI-Callbacks-mt.10.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.10 Author: mt Time: 1 May 2021, 11:01:07.42119 am UUID: f1cd0f2a-9e6b-ec40-9d68-d2a72e0ad829 Ancestors: FFI-Callbacks-mt.9 Maybe, at some point, we will be able to configure blocks as FFI callbacks more conveniently. Here is an example of how to invoke the block with example objects to derive the signature to be used for FFI. (Not working; just a sketch) =============== Diff against FFI-Callbacks-mt.9 =============== Item was added: + ----- Method: BlockClosure>>signature: (in category '*FFI-Callbacks') ----- + signature: signature + + ^ FFICallback + signature: signature + block: self! Item was added: + ----- Method: BlockClosure>>signatureByValue: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 + + ^ self signatureByValueWithArguments: {arg1}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 + + ^ self signatureByValueWithArguments: {arg1. arg2}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 value: arg4 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3. arg4}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 value: arg4 value: arg5 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3. arg4. arg5}! Item was added: + ----- Method: BlockClosure>>signatureByValueWithArguments: (in category '*FFI-Callbacks') ----- + signatureByValueWithArguments: someObjects + + | result signature | + self flag: #todo. "mt: Consider #wordSize, the use of (non-atomic) ExternalStructure or ExternalData as arguments etc. This unsafe mapping from smalltalk objects ot external types might be related to the ongoing discussion on how to improve type checks in the Squeak FFI plugin. See http://forum.world.st/FFI-Inbox-FFI-Kernel-nice-119-mcz-tp5118848.html" + + result := self valueWithArguments: someObjects. + signature := Array streamContents: [:s | + {result}, someObjects do: [:each | + each isInteger ifTrue: [ s nextPut: 'int32_t' ]. + each isFloat ifTrue: [ s nextPut: 'double' ]. + "..." + ]]. + + self flag: #pointerOrNot. "mt: While it might be hidden in Squeak, the call must now whether to pass the arguments by value or by reference." + self notYetImplemented. + + ^ FFICallback + signature: signature + block: self! From commits at source.squeak.org Sat May 1 10:06:10 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 10:06:10 0000 Subject: [squeak-dev] The Trunk: Tools-mt.1054.mcz Message-ID: Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1054.mcz ==================== Summary ==================== Name: Tools-mt.1054 Author: mt Time: 1 May 2021, 12:06:08.609299 pm UUID: 9da21c77-f717-ab4c-b024-42dfbe629f2e Ancestors: Tools-mt.1053 Adds preference and means to embed a transcript in workspaces. Thanks to Jaromir (jar) for the idea! The preference is disabled by default. =============== Diff against Tools-mt.1053 =============== Item was changed: StringHolder subclass: #Workspace instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables shouldStyle environment' + classVariableNames: 'DeclareVariablesAutomatically EmbedTranscript LookupPools ShouldStyle' - classVariableNames: 'DeclareVariablesAutomatically LookupPools ShouldStyle' poolDictionaries: '' category: 'Tools-Base'! !Workspace commentStamp: 'fbs 6/2/2012 20:46' prior: 0! A Workspace is a text area plus a lot of support for executable code. It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute: Workspace open A workspace can have its own variables, called "workspace variables", to hold intermediate results. For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10. Additionally, in Morphic, a workspace can gain access to morphs that are on the screen. If acceptDroppedMorphs is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph. This functionality is toggled with the window-wide menu of a workspace. The instance variables of this class are: bindings - holds the workspace variables for this workspace acceptDroppedMorphs - whether dropped morphs should create new variables! Item was added: + ----- Method: Workspace class>>embedTranscript (in category 'preferences') ----- + embedTranscript + + ^ EmbedTranscript ifNil: [ false ]! Item was added: + ----- Method: Workspace class>>embedTranscript: (in category 'preferences') ----- + embedTranscript: aBoolean + + EmbedTranscript := aBoolean.! Item was added: + ----- Method: Workspace>>buildTranscriptWith: (in category 'toolbuilder') ----- + buildTranscriptWith: builder + + | textSpec | + textSpec := builder pluggableTextSpec new. + textSpec + model: Transcript; + menu: #codePaneMenu:shifted:. + ^ textSpec! Item was added: + ----- Method: Workspace>>buildWith: (in category 'toolbuilder') ----- + buildWith: builder + + ^ self class embedTranscript + ifTrue: [self buildWorkspaceTranscriptWith: builder] + ifFalse: [super buildWith: builder]! Item was added: + ----- Method: Workspace>>buildWorkspaceTranscriptWith: (in category 'toolbuilder') ----- + buildWorkspaceTranscriptWith: builder + + | windowSpec | + windowSpec := self buildWindowWith: builder specs: { + (0.0 @ 0.0 corner: 1.0 @ 0.6) -> [self buildCodePaneWith: builder]. + (0.0 @ 0.6 corner: 1.0 @ 1.0) -> [self buildTranscriptWith: builder]. + }. + ^builder build: windowSpec! From christoph.thiede at student.hpi.uni-potsdam.de Sat May 1 12:00:44 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 1 May 2021 07:00:44 -0500 (CDT) Subject: [squeak-dev] False merge conflicts In-Reply-To: <4d76345a822b417187517284683875f7@student.hpi.uni-potsdam.de> References: <4d76345a822b417187517284683875f7@student.hpi.uni-potsdam.de> Message-ID: <1619870444842-0.post@n4.nabble.com> Nevermind, this one was a false alert, though it took me way too much to realize this. In my image, I already had recategorized this method, but in the Trunk, it is still uncategorized. Thus the merge conflict. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sat May 1 12:01:41 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 12:01:41 0000 Subject: [squeak-dev] The Inbox: Compiler-ct.459.mcz Message-ID: A new version of Compiler was added to project The Inbox: http://source.squeak.org/inbox/Compiler-ct.459.mcz ==================== Summary ==================== Name: Compiler-ct.459 Author: ct Time: 1 May 2021, 2:01:39.875973 pm UUID: be6611f2-9aec-cd49-91be-43ac1fec67ca Ancestors: Compiler-nice.458 Recategorizes OutOfScopeNotification>>#defaultAction =============== Diff against Compiler-nice.458 =============== Item was changed: + ----- Method: OutOfScopeNotification>>defaultAction (in category 'priv handling') ----- - ----- Method: OutOfScopeNotification>>defaultAction (in category 'as yet unclassified') ----- defaultAction ^false! From christoph.thiede at student.hpi.uni-potsdam.de Sat May 1 12:04:26 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 1 May 2021 07:04:26 -0500 (CDT) Subject: [squeak-dev] The Inbox: Compiler-ct.459.mcz In-Reply-To: References: Message-ID: <1619870666446-0.post@n4.nabble.com> By the way, I think we have a few category names in the image that are really unnecessarily complicated and could be renamed. For instance, on Exception, 'exceptionBuilder', 'exceptionDescription', and 'priv handling', and on its class side, 'exceptionInstantiator' and 'exceptionSelector'. These are counter examples of good category names in my opinion. Do you think it would be possible and worth renaming them? Or is this too much noise? Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sat May 1 12:12:22 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 12:12:22 0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1769.mcz Message-ID: A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1769.mcz ==================== Summary ==================== Name: Morphic-ct.1769 Author: ct Time: 1 May 2021, 2:12:17.510389 pm UUID: aa271c07-344a-324a-afe4-3950d6c00839 Ancestors: Morphic-mt.1767 Make SystemWindow's paneColor more robust against missing models. Avoid translucent color. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: SystemWindow>>paneColor (in category 'colors') ----- paneColor | cc | (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc]. (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse]. + cc ifNil: [cc := paneMorphs + detect: [:morph | morph color isTransparent not] + ifFound: [:morph | morph color asNontranslucentColor] + ifNone: [nil]]. - cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]. cc ifNil: [cc := self defaultColor]. self paneColor: cc. ^cc! From commits at source.squeak.org Sat May 1 12:41:57 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 12:41:57 0000 Subject: [squeak-dev] The Inbox: Monticello-ct.746.mcz Message-ID: A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-ct.746.mcz ==================== Summary ==================== Name: Monticello-ct.746 Author: ct Time: 1 May 2021, 2:41:51.667049 pm UUID: 6079f513-f9db-2245-9e92-878ae823e5ee Ancestors: Monticello-nice.745 Fixes and cleans up snapshot creation in MCVersionHistoryBrowser. Instead of scanning the global repository group for a version, ask the current package for its specific repository group. Make sure to always pass the package. Nuke unused instvar repositoryGroup. =============== Diff against Monticello-nice.745 =============== Item was changed: MCTool subclass: #MCVersionHistoryBrowser + instanceVariableNames: 'ancestry index package infos' - instanceVariableNames: 'ancestry index repositoryGroup package infos' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCVersionHistoryBrowser>>repositoryGroup (in category 'accessing') ----- repositoryGroup + + ^ self package workingCopy repositoryGroup! - ^ MCRepositoryGroup default! Item was changed: ----- Method: MCVersionInspector>>history (in category 'accessing') ----- history + (MCVersionHistoryBrowser new + package: self version package; + ancestry: self versionInfo) show! - (MCVersionHistoryBrowser new ancestry: self versionInfo) show! From commits at source.squeak.org Sat May 1 13:59:02 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 13:59:02 0000 Subject: [squeak-dev] The Trunk: Monticello-ct.746.mcz Message-ID: Marcel Taeumel uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.746.mcz ==================== Summary ==================== Name: Monticello-ct.746 Author: ct Time: 1 May 2021, 2:41:51.667049 pm UUID: 6079f513-f9db-2245-9e92-878ae823e5ee Ancestors: Monticello-nice.745 Fixes and cleans up snapshot creation in MCVersionHistoryBrowser. Instead of scanning the global repository group for a version, ask the current package for its specific repository group. Make sure to always pass the package. Nuke unused instvar repositoryGroup. =============== Diff against Monticello-nice.745 =============== Item was changed: MCTool subclass: #MCVersionHistoryBrowser + instanceVariableNames: 'ancestry index package infos' - instanceVariableNames: 'ancestry index repositoryGroup package infos' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCVersionHistoryBrowser>>repositoryGroup (in category 'accessing') ----- repositoryGroup + + ^ self package workingCopy repositoryGroup! - ^ MCRepositoryGroup default! Item was changed: ----- Method: MCVersionInspector>>history (in category 'accessing') ----- history + (MCVersionHistoryBrowser new + package: self version package; + ancestry: self versionInfo) show! - (MCVersionHistoryBrowser new ancestry: self versionInfo) show! From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 14:44:01 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 14:44:01 +0000 Subject: [squeak-dev] The Trunk: Tests-nice.458.mcz In-Reply-To: <11BF7E9C-D582-4F50-84BF-49802524BBBE@rowledge.org> References: <8c3676cc5b4f43b390ea6f67ae7087aa@student.hpi.uni-potsdam.de> <985F8BA7-BDE9-4BD3-8A9C-9F1883E5FDFC@rowledge.org> , <11BF7E9C-D582-4F50-84BF-49802524BBBE@rowledge.org> Message-ID: <0728aa39e12548979d59c1cf67b40be7@student.hpi.uni-potsdam.de> > But not putting some new thing into Trunk until the cycle is complete seems like a helpful idea. Why do you think this? :-) Quite the contrary, I would rather have said that as soon as a new tool is in the Trunk, the chances become higher that someone actually uses it ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von tim Rowledge Gesendet: Samstag, 1. Mai 2021 01:40:11 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Tests-nice.458.mcz > On 2021-04-30, at 11:06 AM, Thiede, Christoph wrote: > > > Tools to help workflow are always welcome; lack of them almost always results in potentially good ideas getting lost in the mire. (Think traits, for example) > > And how can we fight this development? Better visibility/PR? :-) The ideal - you know, that situation that we all pretend to aim for but never get close to achieving - would be that if one creates a new facility (traits, environments, private methods, any sort of abstracting trick) you also create tools and additions to existing tools that make it easy to use the new idea. And until you do, it does not get added to Trunk. Obviously I'm not demanding that the individual must necessarily do this; solving these kinds of problem is what a community ought to be good for. But not putting some new thing into Trunk until the cycle is complete seems like a helpful idea. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Useful random insult:- Cackles a lot, but I ain't seen no eggs yet. -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Sat May 1 14:57:51 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Sat, 1 May 2021 16:57:51 +0200 Subject: [squeak-dev] False merge conflicts In-Reply-To: <1619870444842-0.post@n4.nabble.com> References: <4d76345a822b417187517284683875f7@student.hpi.uni-potsdam.de> <1619870444842-0.post@n4.nabble.com> Message-ID: Hi Christoph, yes we consider meta information like categories as editions and thus conflicts, and IMO it's a good thing because categories bring a bit of added value that we don't want to lose. A pity that I didn't see that those methods were miss-categorized, maybe it's not visually obvious when using message tracer... Le sam. 1 mai 2021 à 14:00, Christoph Thiede a écrit : > > Nevermind, this one was a false alert, though it took me way too much to > realize this. In my image, I already had recategorized this method, but in > the Trunk, it is still uncategorized. Thus the merge conflict. :-) > > Best, > Christoph > > > > ----- > Carpe Squeak! > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 16:04:53 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 16:04:53 +0000 Subject: [squeak-dev] False merge conflicts In-Reply-To: References: <4d76345a822b417187517284683875f7@student.hpi.uni-potsdam.de> <1619870444842-0.post@n4.nabble.com>, Message-ID: <226ec759680942ab99f81e148b265959@student.hpi.uni-potsdam.de> Hi Nicolas, yes, it's only confusing because we don't have meta information for the author of a recategorization. Even though I see that this would likely be overengineering. :-) > A pity that I didn't see that those methods were miss-categorized, maybe it's not visually obvious when using message tracer... Hmm, would it be a good idea to highlight the unclassified category in browsers using bold/italic font? I've also been thinking for some time about displaying a small kind of dashboard in the SaveVersionDialog which could things such as: "slips" (halts/flags/Transcript) in code, uncategorized methods, and maybe even more things such as linter results (SwaLint) or test results. But this might be a performance problem and I guess that not everyone would like it ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Nicolas Cellier Gesendet: Samstag, 1. Mai 2021 16:57:51 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] False merge conflicts Hi Christoph, yes we consider meta information like categories as editions and thus conflicts, and IMO it's a good thing because categories bring a bit of added value that we don't want to lose. A pity that I didn't see that those methods were miss-categorized, maybe it's not visually obvious when using message tracer... Le sam. 1 mai 2021 à 14:00, Christoph Thiede a écrit : > > Nevermind, this one was a false alert, though it took me way too much to > realize this. In my image, I already had recategorized this method, but in > the Trunk, it is still uncategorized. Thus the merge conflict. :-) > > Best, > Christoph > > > > ----- > Carpe Squeak! > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 16:23:20 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 16:23:20 +0000 Subject: [squeak-dev] The Trunk: Tools-mt.1054.mcz In-Reply-To: References: Message-ID: <9400082788904c389b852b189b8fd4c0@student.hpi.uni-potsdam.de> Nice idea! :-) Hmm ... in my Trunk image, the text is not added to the embedded transcript, but it gets an orange triangle. When I debug the test, it works again. Any ideas why? And should we maybe make this preference available for individual workspaces through the window menu, analogously to the shout setting? And one more thought: Do we still want the Transcript to be global? If Transcript was properly scoped, e.g. using an exception or a dynamic variable, we could also make transcript messages triggered from a workspace exclusive for the embedded transcript. What do you think? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Samstag, 1. Mai 2021 12:06:10 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Tools-mt.1054.mcz Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1054.mcz ==================== Summary ==================== Name: Tools-mt.1054 Author: mt Time: 1 May 2021, 12:06:08.609299 pm UUID: 9da21c77-f717-ab4c-b024-42dfbe629f2e Ancestors: Tools-mt.1053 Adds preference and means to embed a transcript in workspaces. Thanks to Jaromir (jar) for the idea! The preference is disabled by default. =============== Diff against Tools-mt.1053 =============== Item was changed: StringHolder subclass: #Workspace instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables shouldStyle environment' + classVariableNames: 'DeclareVariablesAutomatically EmbedTranscript LookupPools ShouldStyle' - classVariableNames: 'DeclareVariablesAutomatically LookupPools ShouldStyle' poolDictionaries: '' category: 'Tools-Base'! !Workspace commentStamp: 'fbs 6/2/2012 20:46' prior: 0! A Workspace is a text area plus a lot of support for executable code. It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute: Workspace open A workspace can have its own variables, called "workspace variables", to hold intermediate results. For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10. Additionally, in Morphic, a workspace can gain access to morphs that are on the screen. If acceptDroppedMorphs is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph. This functionality is toggled with the window-wide menu of a workspace. The instance variables of this class are: bindings - holds the workspace variables for this workspace acceptDroppedMorphs - whether dropped morphs should create new variables! Item was added: + ----- Method: Workspace class>>embedTranscript (in category 'preferences') ----- + embedTranscript + + ^ EmbedTranscript ifNil: [ false ]! Item was added: + ----- Method: Workspace class>>embedTranscript: (in category 'preferences') ----- + embedTranscript: aBoolean + + EmbedTranscript := aBoolean.! Item was added: + ----- Method: Workspace>>buildTranscriptWith: (in category 'toolbuilder') ----- + buildTranscriptWith: builder + + | textSpec | + textSpec := builder pluggableTextSpec new. + textSpec + model: Transcript; + menu: #codePaneMenu:shifted:. + ^ textSpec! Item was added: + ----- Method: Workspace>>buildWith: (in category 'toolbuilder') ----- + buildWith: builder + + ^ self class embedTranscript + ifTrue: [self buildWorkspaceTranscriptWith: builder] + ifFalse: [super buildWith: builder]! Item was added: + ----- Method: Workspace>>buildWorkspaceTranscriptWith: (in category 'toolbuilder') ----- + buildWorkspaceTranscriptWith: builder + + | windowSpec | + windowSpec := self buildWindowWith: builder specs: { + (0.0 @ 0.0 corner: 1.0 @ 0.6) -> [self buildCodePaneWith: builder]. + (0.0 @ 0.6 corner: 1.0 @ 1.0) -> [self buildTranscriptWith: builder]. + }. + ^builder build: windowSpec! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 16:26:53 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 16:26:53 +0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1586.mcz In-Reply-To: References: <96876dfbbb014187a83bee99f8819c5a@student.hpi.uni-potsdam.de> <84a83a66744e4fbd83de179f73b10b1f@student.hpi.uni-potsdam.de> <2b963e0e1d1c4eedaf2639846a3ef32a@student.hpi.uni-potsdam.de> <6b97ba33768846ebbf0544950bc570e4@student.hpi.uni-potsdam.de> <,> , Message-ID: > Any statistics on clicking on ByteStrings? Not yet. A Trunk-wide telemetry program might help. :-) Apart from that, I think that I would use the feature more often if it was accessible via keyboard. > Who would ever want to keep the browser open after saving that source code? What's done is done. :-D Not if you work in short feedback cycles, I guess ... ("Inspect - not what I wanted - close again. Think two seconds - no, I need this indeed - inspect again". Also known as "fiddling around". I do this very often ...) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Dienstag, 27. April 2021 16:59:12 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1586.mcz Hi Christoph. > With the new attribute, a workflow no longer needs to make this assumption. I am not talking about changing people. I hypothesized existing workflows. :-) What are people doing now and how can we avoid disrupting existing knowledge and expectations. Well, I am trying to treat this as a new feature, knowing that you have been using it for quite some time now. Any statistics on clicking on ByteStrings? > Please don't introduce self-destroying objects in Squeak! :-) Who would ever want to keep the browser open after saving that source code? What's done is done. :-D Best, Marcel Am 26.04.2021 20:28:21 schrieb Thiede, Christoph : Hi Marcel, > I would expect that, in such a scenario, print-it would rarely be used. You are arguing from the status quo where printed-it (print-itted?) results are effectively lost for further observation. With the new attribute, a workflow no longer needs to make this assumption. I would rather think of these attributes as notebook-like cell outputs. Unless a user wants to reuse the result in another expression from within the same text field, he or she is not required to use any variables at all. In contexts without workspace bindings (such as inspectors), this is even the only way now to persist object results. Thus, speaking generally, users could indeed rely on print-its for costly operations as of now. :-) > Hmmm... we might want to remove that interactive print-it text after the user has clicked on it :-) Please don't introduce self-destroying objects in Squeak! :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 18:53:40 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1586.mcz Hi all, please note that "CMD+0" will immediately remove that text action after the print-it (CMD+P) if you want to use it for something else. :-) Best, Marcel Am 25.04.2021 19:43:40 schrieb Jakob Reschke : Hi all, So visual consistency for Christoph means: all results are highlighted(/click-inspectable). Whereas for Marcel it means: all complex/interesting results are highlighted/click-inspectable. What does everyone else think about this? I sometimes wish that the print-it results in the workspace would be treated differently than the text that I typed myself. Highlighting them (link or otherwise) could help to spot the frontier between expression and result after some more actions, but would otherwise not help me much. When I intended to use the printed result in my next expression, highlighting it as a result would be inappropriate, but I rarely ever want to do this. For most complex objects, this is not even possible because their print strings are not Smalltalk expressions. But I cannot use a non-Smalltalk expression with a link on it in my next expression either, so the feature does not help me in that case anyway. (What I would rather need is a "put this into a variable" command, kind of a refactoring operation for the Workspace.) If I wanted to send further messages to a returned 'String' I would most likely move it onto its own line for convenient Cmd-p/i first anyway, I would not keep it to the right of the expression that evaluated to the 'String'. With this reasoning, I would rather lean towards Christoph's interpretation now. (Also I believe it does not hurt so much if one can also inspect the primitive results.) But I have not used the feature in practice so far, so I will let some time pass for now. Kind regards, Jakob Am Sa., 24. Apr. 2021 um 17:43 Uhr schrieb Marcel Taeumel : > > Hi Jakob, > > thanks for summarizing our arguments. :-) I would rather try to avoid another preference just to configure this preference. ;-) Maybe we can keep the uniform appearance for clickable text actions. I am surprised that DoItActions look different. > > Hey Christoph, > > a simple list of exclusions is not complex. Especially since it reflects stable language (and system) properties. I do appreciate your onward pursue of "perfect consistency." However, the system is full of trade-offs because it serves a rather broad audience. > > I am also in favor of visual consistency for this feature. By only showing it for actually interesting object structures, we actually achieve consistency for those structures. Having it also for primitives would spoil the usefulness of this feature. People might think they found something interesting -- to then be disappointed that it is just a flat string. > > Optimizing this feature for MCVersionName?! A domain-specific subclass of String? Well, I consider this design rather unfortunate. In such a case, on might be better of to favor composition over inheritance. That's an anti-pattern. Please do not do that in your projects. :-) ... I suspect an optimization for a database ... not sure. Chris? > > Hi all, > > here is again the list of objects I think we should exclude from having a text action on their print-it result: > > ByteString > ByteSymbol > Number > Boolean > UndefinedObject > > If you find concrete arguments (and examples) against elements on this list, please step forward and name them. :-) > > Reducing visual clutter is worth a few lines of extra source code. > > Best, > Marcel > > Am 24.04.2021 15:42:08 schrieb Thiede, Christoph : > > Hi Jakob, Hi Marcel, > > > thank you for reviving this discussion! :-) > > > > Christoph, when you inspect your MCVersionNames, do you already know that these are version names or do you inspect them to find out what they are? ("What is this, a String or an MCVersionName?") > > > Definitively also the latter. > > > While the type check might not be really necessary, avoiding visual clutter can be a good thing. > > -1 from my side here. :-) I see little value in adding complexity - and possibly confusion - in order to "simplify" the appearance - in my opinion, the clutter would become even larger if in some cases, the result is blue, and in other cases, it isn't. I would rank (visual) consistency the highest here. We are introducing an additional classification here ("is primitive/is literal/is non-sense?") that is non-trivial as we can see from this discussion, and such heuristics feels a little bit like "too much AI" for a general-purpose system like Squeak/Smalltalk, at least to me. > > > How about allowing to turn off the highlighting of the result? I mean, make it still clickable, but do not paint it blue. > > This might be a trade-off for me, but on the other hand, the logic is still cluttered. And the explorability is impeded ... > > Best, > Christoph > > ________________________________ > Von: Squeak-dev im Auftrag von Jakob Reschke > Gesendet: Samstag, 24. April 2021 11:43:06 > An: The general-purpose Squeak developers list > Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1586.mcz > > Hi Christoph, hi Marcel, > > Am Di., 20. Apr. 2021 um 08:58 Uhr schrieb Marcel Taeumel > : > > > > Hi Christoph, > > > > > [...] subclasses of ByteString can be indeed non-trivial. This applies to MCVersionName, for example > > > > You are mixing up object structure with structured information. The latter needs interpretation by some other means. Squeak's inspector cannot provide such means of interpretation such as for URLs in strings. > > > > I am struggling to understand how your arguments address each other > person's concerns. Did I understand your points correctly: > > - Christoph wants to get rid of the type check. He argues that > sometimes even for the objects with "primitive" structure you may want > to get the link. For example, MCVersionName loses its type information > when printed, so when you would inspect the result, you would get a > String instead of an MCVersionName. The other example is when you want > to track identity. Indeed, sometimes it is useful to check whether one > String is the same as another one retrieved (inspected) from somewhere > else. I do this regularly in Squot when debugging the capturing and > materialization (although seldom for Strings at this time because for > these it already works as expected). > > - Marcel says that the links are unnecessary for what are essentially > value objects that are not complex enough to need inspection beyond > just looking at the print string. Supposedly, one can just reevaluate > the result or the expression. Adding the links there produces visual > clutter and is distracting. Inspecting an MCVersionName would reveal > no further information about the object than the print string does > (that is, except for the type!). > > Christoph, when you inspect your MCVersionNames, do you already know > that these are version names or do you inspect them to find out what > they are? ("What is this, a String or an MCVersionName?") > > I fully agree with Marcel on the immediates and singletons (true, > false, nil, Symbols). While the type check might not be really > necessary, avoiding visual clutter can be a good thing. Tradeoff is > with having the special case in the code. > > Unfortunately(?), Strings in Squeak/Smalltalk are not quite value > objects, since they are mutable, can be used as buffers, etc. Depends > on the application. > > On the other hand, Points are mostly used as value objects, but did > not get the special case treatment. Though strictly, technically > speaking, they are not different from Strings in this regard. > > Inspecting the result string or the revaluating the original > expression to do so is only safe if it does not provoke side effects. > For Marcel's selection of classes, there are no side effects of > reevaluating the result string. But reevaluating the original > expression might not be free of side effects. I guess you would not > reevaluate the expression to inspect an immediate or singleton, but > for those objects that do have object identity, such as Strings, or > where the type of the result is not obvious, MCVersionName, you might > want to do that. > > How about allowing to turn off the highlighting of the result? I mean, > make it still clickable, but do not paint it blue. Then there would be > no visual clutter, and if you know that the feature is there (and you > have subsequently turned off the preference, for example), you would > also not easily forget that you can use it. > > Kind regards, > Jakob > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Sat May 1 16:29:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 16:29:01 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.124.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.124.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.124 Author: mt Time: 1 May 2021, 6:29:01.295408 pm UUID: 7c619637-8c9f-5648-b752-5043a9a455c9 Ancestors: FFI-Kernel-mt.123 Removes deprecated collection interface from ExternalData. Nukes unused instVar 'fieldTypes' in structure types. I could not remember what I planned to do with it. Could not find it on squeak-dev either. Extends print-string for external types with byteSize and byteAlignment. It does not look too noisy. I hope it will help remind programmers about the bytes they are working with. Well, if it becomes too noisy, we could make it a preference. =============== Diff against FFI-Kernel-mt.123 =============== Item was removed: - ----- Method: ExternalData>>collectWithIndex: (in category 'enumerating') ----- - collectWithIndex: elementAndIndexBlock - "See SequenceableCollection >> #collectWithIndex:." - - ^ self collectWithIndex: elementAndIndexBlock! Item was removed: - ----- Method: ExternalData>>doWithIndex: (in category 'enumerating') ----- - doWithIndex: elementAndIndexBlock - "See SequenceableCollection >> #doWithIndex:." - - self withIndexDo: elementAndIndexBlock.! Item was changed: ExternalType subclass: #ExternalStructureType + instanceVariableNames: '' - instanceVariableNames: 'fieldTypes' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalStructureType commentStamp: 'mt 6/18/2020 08:54' prior: 0! I am specializing types for external structures. While compiledSpec and referentClass are still paramount when the FFI plugin is processing FFI calls, this specialization can help untangle in-image processing of external structures and their data. In terms of plugin compatibility, you could still use instances of ExternalType as, for example, argument types in ExternalFunction -- given that compiledSpec and referentClass are correct. Argument coercing in FFI calls would still work. However, you could no longer use in-image facilities such as #readFieldAt: / #writeFieldAt:width, which is used for generating struct-field accessors. And the dynamic access through #handle:at: / #handle:at:put: would fail. Also, #printOn: would not be very helpful anymore. So, having this specialization of ExternalType for ExternalStructure helps packaging code. :-) Of course, this type can also be used for ExternalUnion, ExternalPackagedStructure, and ExternalTypeAlias.! Item was changed: ----- Method: ExternalStructureType>>printOn: (in category 'printing') ----- printOn: aStream self isTypeAlias ifTrue: [ aStream nextPutAll: referentClass name. aStream nextPutAll: '~>'; print: self originalType. self isEmpty ifTrue: [aStream nextPutAll: ' ???']. ^ self]. referentClass == nil ifTrue:[aStream nextPutAll: ''] ifFalse:[ + super printOn: aStream. - aStream nextPutAll: referentClass name. self isEmpty ifTrue: [aStream nextPutAll: ' { void }']].! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: (referentClass ifNil: [self atomicTypeName] ifNotNil: [referentClass name]). + self isPointerType ifTrue: [aStream nextPut: $*]. + + aStream + space; + nextPut: $(; + nextPutAll: self byteSize asString; + space; + nextPutAll: self byteAlignment asString; + nextPut: $).! - self isPointerType ifTrue: [aStream nextPut: $*].! From commits at source.squeak.org Sat May 1 16:32:23 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 1 May 2021 16:32:23 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.22.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.22.mcz ==================== Summary ==================== Name: FFI-Tools-mt.22 Author: mt Time: 1 May 2021, 6:32:23.937408 pm UUID: 6c3060d1-8b56-c74a-99be-d36a04e838cb Ancestors: FFI-Tools-mt.21 Adds interface to enumerate fields (name and type) in structure types. Use that interface to show more structure in ObjectExplorer on such types. I could not really decide on whether to prepend or append those new fields in the object explorer. For a larger structure type, you might have to scroll down to discover the basic "compiledSpec" etc. ... =============== Diff against FFI-Tools-mt.21 =============== Item was added: + ----- Method: ExternalStructureType>>allTypesDo:seen: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: aBlock seen: seenObjects + "Overridden to support cyclic typedefs." + + (seenObjects ifAbsentAdd: self) ifFalse: [^ self]. + super allTypesDo: aBlock seen: seenObjects.! Item was changed: ----- Method: ExternalStructureType>>explorerContents (in category '*FFI-Tools') ----- explorerContents + | basicExplorerFields originalTypeField fieldTypeFields | - | basicExplorerFields originalTypeField | basicExplorerFields := super explorerContents. + + self isTypeAlias ifTrue: [ + originalTypeField := ObjectExplorerWrapper + with: self originalType + name: '_originalType' + model: self. + ^ {originalTypeField}, basicExplorerFields]. + + fieldTypeFields := Array streamContents: [:s | + self typesDo: [:type :fieldName | + s nextPut: (ObjectExplorerWrapper + with: type + name: (fieldName ifNil: ['__'] ifNotNil: ['_', fieldName]) + model: self)]]. + + ^ fieldTypeFields, basicExplorerFields! - self isTypeAlias ifFalse: [^ basicExplorerFields]. - originalTypeField := ObjectExplorerWrapper - with: self originalType - name: '_originalType' - model: self. - ^ {originalTypeField}, basicExplorerFields! Item was added: + ----- Method: ExternalStructureType>>typesDo: (in category '*FFI-Tools-enumerating') ----- + typesDo: block + + self assert: [self isPointerType not]. + self assert: [self referentClass notNil]. + + (self isTypeAlias + ifTrue: [ + "Add a custom role to emphasize it in #allTypes." + {{#'_aliasFor' . self referentClass fields second}}] + ifFalse: [self referentClass fields]) + do: [:spec | + | fieldName typeName type | + fieldName := spec first. + typeName := spec second. + type := ExternalType typeNamed: typeName. + block cull: type cull: fieldName].! Item was added: + ----- Method: ExternalType>>allTypes (in category '*FFI-Tools-enumerating') ----- + allTypes + + ^ Array streamContents: [:s | + self allTypesDo: [:type :fieldName | + s nextPut: fieldName -> type]]! Item was added: + ----- Method: ExternalType>>allTypesDo: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: block + + self allTypesDo: block seen: IdentitySet new.! Item was added: + ----- Method: ExternalType>>allTypesDo:seen: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: aBlock seen: seenObjects + + self typesDo: [:type :fieldName | + aBlock cull: type cull: fieldName. + type allTypesDo: aBlock seen: seenObjects].! Item was added: + ----- Method: ExternalType>>types (in category '*FFI-Tools-enumerating') ----- + types + + ^ Array streamContents: [:s | + self typesDo: [:type :fieldName | s nextPut: fieldName -> type]]! Item was added: + ----- Method: ExternalType>>typesDo: (in category '*FFI-Tools-enumerating') ----- + typesDo: block + + self isPointerType + ifTrue: [ self asNonPointerType typesDo: block ] + ifFalse: [ "Atomic. There are no more types here." ].! From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 16:52:08 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 16:52:08 +0000 Subject: [squeak-dev] The Trunk: MorphicTests-nice.75.mcz In-Reply-To: References: <,> <232ff796ffbc4528a61a3bdd3ecc88c8@student.hpi.uni-potsdam.de>, Message-ID: <81e3ceb1829743e6828a9625b128f10d@student.hpi.uni-potsdam.de> Hi Marcel, > The use of "Preferences" would add a dependency to System, for example. I think this is bearable because Preferences is indeed a manager for preferences of all kinds. Also, from a practical perspective, I doubt that we will be ever able to unload System from a Squeak image. :-) > In this case, a "during:" mechanism would not work because #setUp and #tearDown are called by the SUnit "framework" :-) Maybe SUnit could provide some configurable way for this. Yeah, that's a common problem ... I could imagine two possible solutions for this problem: 1. Override #performTest and wrap it with all your executeAround-logic. I do this quite often, but it does not really feel elegant to me ... 2. We could add something like #wrap: to the TestCase interface. Example: setUp super setUp. self wrap: [:block | Preferences restoreAfter: block]. Model useColorfulWindows: true. ... See also Context >> #wrap: here: https://github.com/LinqLover/SimulationStudio/blob/5a0ddad75130e947a270bc6dd0ab7e3b0aa4e562/packages/SimulationStudio-Base.package/Context.extension/instance/wrap..st What do you think, can I send something like this to the inbox? :-) > In System-ct.1119, I do not like the overuse of symbols and meta-programming in client code (e.g. a test's #setUp). In preferences, the entire construction of a key for pragma preferences feels like an ugly hack. Agreed. :-) At least these symbols are a private implementation detail of Preferences. > SUnit could just snapshot all their values before the test and reset them after. Interesting approach. :-) But I think we could only do this if all preferences were consistently implemented with dynamic scoping - it would be too confusing if you edited your preferences while a test debugger remains opened in your image, and after closing the debugger, your changes to these preferences were lost. This, again, would require a stronger framework for managing preferences (one that does not delegate the control of their values to the defining classes), so in the end, I guess this is not feasible for us without major breaking changes ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 18:36:35 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: MorphicTests-nice.75.mcz Hi Christoph. > we already have #setPreference:toValue:during: on Preferences class Hmm... I think that I am reluctant to use the "Preferences" interface for pragma preferences, which have the benefit of directly showing the domain they are used for. The use of "Preferences" would add a dependency to System, for example. In this case, a "during:" mechanism would not work because #setUp and #tearDown are called by the SUnit "framework" :-) Maybe SUnit could provide some configurable way for this. In System-ct.1119, I do not like the overuse of symbols and meta-programming in client code (e.g. a test's #setUp). In preferences, the entire construction of a key for pragma preferences feels like an ugly hack. Hmm... actually, pragma preferences and other Preferences are easily accessible. SUnit could just snapshot all their values before the test and reset them after. The values are mostly primitive, immutable objects. An extra reference to them would suffice. A test's #setUp code could do what it wants to do and then rely on the implicit reset of all preferences in #tearDown. Hmm.... Best, Marcel Am 25.04.2021 20:23:27 schrieb Thiede, Christoph : Hi Marcel, we already have #setPreference:toValue:during: on Preferences class. I also had to remember this proposal + discussion: The Inbox: System-ct.1119.mcz Your counter-proposal with the preferences sandbox also sounds interesting, we could do this as well. (Just now, I am wondering whether preferences should be process-local ... But that's enough stuff for its own discussion. :-)) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 15. April 2021 09:39:57 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: MorphicTests-nice.75.mcz Hi Nicolas. Thanks. We might want to think about a more generic way to specify system-wide preferences for tests. Maybe a new feature in TestCase (or SUnit). While I would never want to change such preferences in a specific test, I also see that the setUp-way (with that extra "reset" instVar) is quite cumbersome. Best, Marcel Am 14.04.2021 19:14:23 schrieb commits at source.squeak.org : Nicolas Cellier uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-nice.75.mcz ==================== Summary ==================== Name: MorphicTests-nice.75 Author: nice Time: 14 April 2021, 7:14:06.997889 pm UUID: d87c50dd-4e44-5242-9120-37e0452ca781 Ancestors: MorphicTests-eem.74 Fix loss of useRetractableScrollBars preference =============== Diff against MorphicTests-eem.74 =============== Item was changed: ----- Method: TableLayoutTest>>setUp (in category 'running') ----- setUp super setUp. - reset := { ([:enable | [self useRetractableScrollBars: enable]] value: self useRetractableScrollBars) + }. + self useRetractableScrollBars: false! - in: [:block | self useRetractableScrollBars: false]. - }.! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 16:56:20 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 16:56:20 +0000 Subject: [squeak-dev] Wrote a little about OnScreenKeyboardMorph In-Reply-To: References: <045abb52-2eed-408f-972b-88926f3bc5b4@email.android.com> <8d40b92d-8be3-7a4c-1037-01c8d7fcc9ac@leastfixedpoint.com> , Message-ID: <5329b70fe4cd49f9806fa655695a4f19@student.hpi.uni-potsdam.de> Hi Marcel, except for the ' ? ' part, which is really hacky, I like the general idea. +1 for integrating this into Trunk. :-) (In a later step, we could even recognize the touch/tablet mode from the host system if supported - e.g. in Windows 10 or SqueakJS and automatically adjust the Squeak appearance ...) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 18:07:23 An: squeak-dev Betreff: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Hey Tony, here is a quick hack that shows how to add more space to fight that "fat finger problem". :-D [cid:6abdabe5-6d1f-4d4f-abdf-f258c9951079] Best, Marcel Am 26.04.2021 17:06:42 schrieb Marcel Taeumel : > It just needs capability-security, better image management, > nested VMs... a few minor details :-) All these people with their feature requests ... ;-D Best, Marcel Am 26.04.2021 12:54:03 schrieb Tony Garnock-Jones : On 4/25/21 7:14 PM, Christoph Thiede wrote: > Cool stuff! I wish we could also use this on Android. :-) Me too. Smalltalk is (close to) what Android could have been... It just needs capability-security, better image management, nested VMs... a few minor details :-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 179614 bytes Desc: image.png URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:10:15 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:10:15 +0000 Subject: [squeak-dev] The Trunk: Morphic-eem.1719.mcz In-Reply-To: References: <804594dd36de4be1b92d4dbecaaeb973@student.hpi.uni-potsdam.de> <,> , Message-ID: <147974e060b0423b925f2a8b7b6d8803@student.hpi.uni-potsdam.de> Hi Marcel, thanks for your review, I will notify you if I identify any regressions. :-) But your metaprogramming approach from Morphic-mt.1761 ... To be honest, I cannot really say that I would like it. Such magic can be very hard to debug, explore, extend, etc. IMHO, in Smalltalk, we can do better. :-) Instead, I believe an explicit method that to turn off #reuseWindows temporarily would be a better option. If #browseMethodFull is used too frequently, maybe we could wrap it into a new selector #browseMethodFullNew? Looking at the current solution, I would even prefer a (kind of global) variable that temporarily holds a Model/Browser instance that does not want to reused - for instance: ----- Method: SystemWindow>>anyOpenWindowLikeMeIn: (in category 'open/close') ----- anyOpenWindowLikeMeIn: aPasteUpMorph | requestor | self class reuseWindows ifFalse: [ ^ Array empty ]. requestor := Model currentRequestorNotToBeReused. ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 10:03:32 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-eem.1719.mcz Hi Christoph, I somewhat integrated your proposed changes into Trunk. :-) Browser >> #representsSameBrowseeAs: SearchBar >> #smartSearch:in: SystemWindow >> #anyOpenWindowLikeMeIn: Note that a tool's buttons can typically be used to duplicate the tool if desired. Thus, it is not an option to just remove the "hierarchy" button, for example, if it interferes with the "re-use windows" preference -- which you proposed. Also, by just hacking into #browseMethodFull for Browser, you omit all the other possible paths that might interfere with that preference. Well, preference settings might have other side effects, yet, if one would want to do that (e.g., in tests), you must put it into the ensure context: ^ [systemWindow reuseWindows: false. super browseMethodFull] ensure: [systemWindow reuseWindows: previous] Anyway -- instead -- I added the constraint that the requesting window should not be considered as a re-use candidate. With our current tool architecture, I had to resort to meta programming (i.e. context checking). I hope that you won't notice any performance glitches. (Took be about 1.5 hours.) Best, Marcel Am 25.04.2021 22:36:47 schrieb Thiede, Christoph : Hi all, please find the attached changeset which fixes the regression of the smart search bar not honoring the #reuseWindows preference. Also, I added a proper implementation of #reuseWindows for browsers. Please review and/or merge! :-) Best, Christoph PS: What is packages at lists.squeakfoundation.org and why is it being cc'ed in this conversation? ________________________________ Von: Squeak-dev im Auftrag von Chris Muller Gesendet: Freitag, 5. Februar 2021 22:19:13 An: The general-purpose Squeak developers list Cc: packages at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Morphic-eem.1719.mcz Hi Christoph! I thought this feature seemed reminiscent of Reuse Windows as well. The method to hook in each Model subclass (as needed) is #representsSameBrowseeAs:. Looking at that, you can see that simply making your code pane temporarily dirty, an additional window will be spawned. I mention that because Reuse Windows is fantastic and I hate to see your experience with it ruined over something so trivial. :) You do also have the green duplicate halo. People are happy to use "non-standard" UI features in other IDE's, but there seems to be an aversion to people using halos in Squeak. I could be wrong about that, but I find the duplicate halo useful quite often. - Chris On Thu, Feb 4, 2021 at 7:14 PM Thiede, Christoph > wrote: Hi Eliot, could you please honor the "SystemWindow reuseWindows" here? I have turned that preference off in my image because I actually use to accept a class name multiple times in the search bar in order to open multiple windows - for instance, to view different protocols of the same class side-by-side. It would be great if this would work soon again ... :-) Best, Christoph ________________________________ Von: Squeak-dev > im Auftrag von commits at source.squeak.org > Gesendet: Donnerstag, 4. Februar 2021 03:38:15 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-eem.1719.mcz Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1719.mcz ==================== Summary ==================== Name: Morphic-eem.1719 Author: eem Time: 3 February 2021, 6:38:11.11355 pm UUID: ffb981b1-7c53-4fbe-b6f4-4c8f27c79f5a Ancestors: Morphic-mt.1718 Make SearchBar>>#smartSearch:in: search existing browsers for a class name being searched for, bringing the first such browser to the front and selecting the class. This allows one to find classes in browsers either when one has very many, or when one is using multi-window browsers containing many many classes. =============== Diff against Morphic-mt.1718 =============== Item was added: + ----- Method: Browser>>displayClass: (in category '*Morphic-Menus-DockingBar-accessing') ----- + displayClass: aClass + "Assuming the receiver has answered true to isDisplayingClass:, come to the front and select the given class." + | index | + index := self multiWindowIndexForClassName: aClass. + index ~= 0 ifTrue: + [multiWindowState selectWindowIndex: index]. + self selectClass: aClass! Item was added: + ----- Method: Browser>>isDisplayingClass: (in category '*Morphic-Menus-DockingBar-accessing') ----- + isDisplayingClass: aClass + | className | + className := aClass name. + (self multiWindowIndexForClassName: className) ~= 0 ifTrue: [^true]. + ^selectedClassName = className! Item was added: + ----- Method: Browser>>multiWindowIndexForClassName: (in category '*Morphic-Menus-DockingBar-accessing') ----- + multiWindowIndexForClassName: className + "Answer the index of a browser displaying className in multiWindowState, if any. + Otherwise answer zero." + multiWindowState ifNil: [^0]. + multiWindowState models withIndexDo: + [:browser :index| + browser selectedClassName = className ifTrue: [^index]]. + ^0! Item was changed: ----- Method: SearchBar>>smartSearch:in: (in category 'searching') ----- smartSearch: text in: morph "Take the user input and perform an appropriate search" | input newContents | self removeResultsWidget. input := text asString ifEmpty:[^self]. self class useSmartSearch ifFalse: [^ ToolSet default browseMessageNames: input]. + (Symbol findInterned: input) ifNotNil: + [:symbol| input := symbol]. "If it is a global or a full class name, browse that class." + (Smalltalk bindingOf: input) ifNotNil: + [:assoc| | class | + class := (assoc value isBehavior ifTrue:[assoc value] ifFalse:[assoc value class]) theNonMetaClass. + Project current world submorphs do: + [:windowMorph| + (windowMorph isSystemWindow + and: [(windowMorph model isKindOf: Browser) + and: [windowMorph model isDisplayingClass: class]]) ifTrue: + [windowMorph beKeyWindow. + ^windowMorph model displayClass: class]]. + ^ToolSet browse: class selector: nil]. - (Smalltalk bindingOf: input) ifNotNil:[:assoc| | global | - global := assoc value. - ^ToolSet browse: (global isBehavior ifTrue:[global] ifFalse:[global class]) selector: nil]. "If it is a symbol and there are implementors of it, browse those implementors." Symbol hasInterned: input ifTrue: [:selector | (SystemNavigation new allImplementorsOf: selector) ifNotEmpty:[:list| ^SystemNavigation new browseMessageList: list name: 'Implementors of ' , input]]. "If it starts uppercase, browse classes if any. Otherwise, just search for messages." + input first isUppercase ifTrue: + [(UIManager default classFromPattern: input withCaption: '') + ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil]. + newContents := input, ' -- not found.'. + self searchTerm: newContents. + self selection: (input size+1 to: newContents size). + self currentHand newKeyboardFocus: morph textMorph. + ^ self]. + + "Default to browse message names..." + ToolSet default browseMessageNames: input! - input first isUppercase - ifTrue: [ - (UIManager default classFromPattern: input withCaption: '') - ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil] - ifNil: [ - newContents := input, ' -- not found.'. - self searchTerm: newContents. - self selection: (input size+1 to: newContents size). - self currentHand newKeyboardFocus: morph textMorph. - ^ self]] - ifFalse: [ - ToolSet default browseMessageNames: input].! -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Sat May 1 17:23:09 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 1 May 2021 12:23:09 -0500 (CDT) Subject: [squeak-dev] The Trunk: Tools-mt.1054.mcz In-Reply-To: <9400082788904c389b852b189b8fd4c0@student.hpi.uni-potsdam.de> References: <9400082788904c389b852b189b8fd4c0@student.hpi.uni-potsdam.de> Message-ID: <1619889789263-0.post@n4.nabble.com> Hi Marcel, thanks, I love it! It saves me a lot of clicking when bringing the Workspace and Transcript to the front or rearranging them :) Christoph Thiede wrote > Nice idea! :-) > > And should we maybe make this preference available for individual > workspaces through the window menu, analogously to the shout setting? I'd like that too - that's where I looked for the new preference first :) Thanks again, best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:26:04 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:26:04 +0000 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: <9A701758-83CA-46E0-81C9-A9E04C05DDDF@rowledge.org> References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> , <9A701758-83CA-46E0-81C9-A9E04C05DDDF@rowledge.org> Message-ID: <09d43cd508794b389ebf1be8c27b5eaa@student.hpi.uni-potsdam.de> Hi all, first of all, I'd like to remind kindly of my original changeset. All the other ideas are exciting as well, but maybe we can maintain a better overview if we return to our roots of trunk-based development ... :-) > - drag a method into a MessageTrace browser and thus add implementors of that message to the stack. Hm, is this maybe stuff for a new tool? The proposal reminds me a bit of Vivide, did you try it out? :-) > > Here is what I would expect from a multi-selection list: > > - simple click clears and sets the entire selection to a single element > > - shift+click adds a range to the selection starting from the current element to the clicked one > > - ctrl+click toggles the selection state of a single element > > - click-drag drags whatever is currently selected > > Outside of Squeak that would be my expectations as well. Ctrl click may open the halo instead... > > I can also understand that Chris would be sad to see range selection without the need for touching the keyboard go away. I often use that in the TestRunner to select some but not all test case classes of a package. Pretty much my thoughts. That does mean that I understand Marcel's arguments, too, but it might indeed interrupt many people's workflows, including mine - I use the "laid-back select" very often in various changes tools. New preference? :P > > > - Nothing to do with d&d, but how about a very simple way to add notes to methods in a browser? I'm thinking here of using a messagetrace browser and wanting to add little (pop-up?) notes to remind me of any points I notice as I follow the messages up and down. Why was I looking at this? What is it related to? All that stuff it is so easy to forget a week later when you start climbing back up the rabbit hole you fell into. > > > > Why not simply send Object>>#todo, and include a comment next to it? > > No little pop-ups please! > > I don't want to *edit* the code for this, I want to *annotate* it in the context of the tool I am using. > > One might make a plausible argument that this is not a message tracer anymore; whatever. I suggest that it would be a useful tool. Have you taken a look at CodeTalk? I would be surprised if it still worked today, but the idea seems not completely new. But regarding your argument of separating logic and comments, I'm not sure whether I understand your motivation correctly. When would it be helpful for you not to treat them together? Code documents our intentions and approaches, and if something was wrong or to do with the code, I would also want to check in these thoughts together with the code ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von tim Rowledge Gesendet: Freitag, 30. April 2021 19:02:14 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) > On 2021-04-30, at 1:19 AM, Marcel Taeumel wrote: > > Hmm... it is unusual that a normal click can also select a range. Usually, one would expect to use SHIFT+CLICK to do so, which you can actually do too. :-D I suppose that behavior originates from that older multi-selection list, where a simple click changes the selection state of a single element.... which is also quite unusual given today's widgets in other GUI frameworks. > > Here is what I would expect from a multi-selection list: > - simple click clears and sets the entire selection to a single element > - shift+click adds a range to the selection starting from the current element to the clicked one > - ctrl+click toggles the selection state of a single element > - click-drag drags whatever is currently selected Pretty much what I'd prefer too. I accept there are plausible 'better' approaches but the daily reality is that having a system reasonably close to (what passes for) normal would be simpler to work with. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: SEXI: Sign EXtend Integer ________________________________ Von: Squeak-dev im Auftrag von Jakob Reschke Gesendet: Freitag, 30. April 2021 11:37 Uhr An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) Outside of Squeak that would be my expectations as well. Ctrl click may open the halo instead... I can also understand that Chris would be sad to see range selection without the need for touching the keyboard go away. I often use that in the TestRunner to select some but not all test case classes of a package. Marcel Taeumel > schrieb am Fr., 30. Apr. 2021, 10:20: Hmm... it is unusual that a normal click can also select a range. Usually, one would expect to use SHIFT+CLICK to do so, which you can actually do too. :-D I suppose that behavior originates from that older multi-selection list, where a simple click changes the selection state of a single element.... which is also quite unusual given today's widgets in other GUI frameworks. Here is what I would expect from a multi-selection list: - simple click clears and sets the entire selection to a single element - shift+click adds a range to the selection starting from the current element to the clicked one - ctrl+click toggles the selection state of a single element - click-drag drags whatever is currently selected Best, Marcel Am 28.04.2021 23:47:24 schrieb tim Rowledge >: > On 2021-04-28, at 12:18 PM, Chris Muller wrote: > > Hi Tim, > >> - all the other browsers ought to support the drag stuff too. I see some do, but the messagetrace doesn't appear to. > > "The drag stuff" tells me you don't have a firm grip on the purpose > and scope of the use-cases. MessageTrace uses swipe to select > multiple methods. It's rightly confined to what you trace, DnD > outside its browser doesn't make sense for tracing. I mildly disagree. Dragging *out* would make sense in various ways. To open another browser, for example. To drop into a text view (where I'd quite like to get the method's reference pasted, perhaps with shift held the method source. Right now we get a not very useful 'compiledMethodBunchOfDigits') or a FileBrowser. > >> - drag a method into a MessageTrace browser and thus add implementors of that message to the stack. > > That would result in multiple, unrelated Trace's all in the one > window. I don't understand why you'd want to do that. I can imagine having a use for a message trace open on several related methods that do not specifically tie together. Maybe #at: & #at:put: would be an example. This would be using a message tracer as a way of gathering methods together as part of thinking about refactorings or extensions. > >> - Nothing to do with d&d, but how about a very simple way to add notes to methods in a browser? I'm thinking here of using a messagetrace browser and wanting to add little (pop-up?) notes to remind me of any points I notice as I follow the messages up and down. Why was I looking at this? What is it related to? All that stuff it is so easy to forget a week later when you start climbing back up the rabbit hole you fell into. > > Why not simply send Object>>#todo, and include a comment next to it? > No little pop-ups please! I don't want to *edit* the code for this, I want to *annotate* it in the context of the tool I am using. One might make a plausible argument that this is not a message tracer anymore; whatever. I suggest that it would be a useful tool. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim "Bother" said Pooh, as he realised Piglet was undercooked. -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:31:40 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:31:40 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: References: Message-ID: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + + ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + + ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + + DualChangeSorter open.! Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu | latestMethodChanges latestClassChanges| latestMethodChanges := (Array streamContents: [:s | ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | s nextPut: { dateAndTime. method. changeType. category }]]) sorted: [:a :b | a first >= b first]. 1 to: (10 min: latestMethodChanges size) do: [:index | | spec method | spec := latestMethodChanges at: index. method := spec second. menu addItem: [:item | item contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ; target: ToolSet; balloonText: spec third asString; icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]); arguments: {method}]]. latestClassChanges := (Array streamContents: [:s | ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category | "We are not interested in classes whose method's did only change." changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]]) sorted: [:a :b | a first >= b first]. latestClassChanges ifNotEmpty: [menu addLine]. 1 to: (10 min: latestClassChanges size) do: [:index | | spec class | spec := latestClassChanges at: index. class := spec second. menu addItem: [:item | item contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ; target: ToolSet; balloonText: (spec third sorted joinSeparatedBy: Character space); icon: ((spec third includesAnyOf: #(remove addedThenRemoved)) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ (spec third includes: #add) ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]); arguments: {class}]]. + + menu defaultTarget: self. + menu addTranslatedList: #( + - + ('Browse current change set' browseChangeSet) + ('Browse changed methods' browseChangedMethods) + - + ('Simple Change Sorter' browseChanges) + ('Dual Change Sorter' browseChangesDual)). + + + ! - - menu addLine; addItem: [:item | - item - contents: 'Browse current change set...' translated; - target: self; - selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:33:28 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:33:28 +0000 Subject: [squeak-dev] The Trunk: Tests-nice.459.mcz In-Reply-To: References: , Message-ID: (General note: I think we should use #flag: for code like this. This seems to be the most likely chance to me that any further volunteer will find and resolve the defect if we forget it. :-)) ________________________________ Von: Squeak-dev im Auftrag von Nicolas Cellier Gesendet: Donnerstag, 29. April 2021 22:53:49 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Tests-nice.459.mcz Hmm no, this does not solve anything. It happened to work once or twice, but no more... It's impossible to debug, some doesNotUnderstand: occurs that install and set state to #inactive, but debugger interacts and is causing more doesNotUnderstand: Le jeu. 29 avr. 2021 à 22:30, a écrit : > > Nicolas Cellier uploaded a new version of Tests to project The Trunk: > http://source.squeak.org/trunk/Tests-nice.459.mcz > > ==================== Summary ==================== > > Name: Tests-nice.459 > Author: nice > Time: 29 April 2021, 10:30:03.551961 pm > UUID: 67799656-9640-e447-b665-6f74573e3716 > Ancestors: Tests-nice.458 > > For some reason, ImageSegmentTest>>testContextsShouldBeWritableToaFile interact badly with progress bar, resulting in a context that cannotReturn: > Workaround by temporarily suppressing progress. > > =============== Diff against Tests-nice.458 =============== > > Item was changed: > ----- Method: ImageSegmentTest>>testContextsShouldBeWritableToaFile (in category 'tests') ----- > testContextsShouldBeWritableToaFile > "This should not throw an exception" > + [NativeImageSegment new > - NativeImageSegment new > copyFromRoots: {thisContext. thisContext copyStack} sizeHint: 100; > extract; > writeToFile: 'ContextChain'; > + yourself] on: ProgressInitiationException do: [:e | e resumeSuppressingProgress] > - yourself > > "TODO: write assertions showing that something meaningful actually happened." > > "TODO: bring them back in again"! > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:36:03 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:36:03 +0000 Subject: [squeak-dev] The Trunk: System-mt.1231.mcz In-Reply-To: References: Message-ID: Hi Marcel, my FreshTrunk(tm) image (which I only save right after installing updates) has been looking like this for a few weeks: [cid:b5dc1e53-c4a2-466b-aaae-da7e4f5d979b] How can we fix this, and how can we avoid future incidents like this one? Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 29. April 2021 11:03:47 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: System-mt.1231.mcz Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1231.mcz ==================== Summary ==================== Name: System-mt.1231 Author: mt Time: 29 April 2021, 11:03:42.969891 am UUID: af06a9e1-6280-0649-820c-f6c89ef25640 Ancestors: System-mt.1230 Removes autogenerated pref accessors, which are now under "*autogenerated - ...". =============== Diff against System-mt.1230 =============== Item was removed: - ----- Method: Preferences class>>alwaysShowConnectionVocabulary (in category 'standard queries') ----- - alwaysShowConnectionVocabulary - ^ self - valueOfFlag: #alwaysShowConnectionVocabulary - ifAbsent: [false]! Item was removed: - ----- Method: Preferences class>>useSmartLabels (in category 'standard queries') ----- - useSmartLabels - ^ self - valueOfFlag: #useSmartLabels - ifAbsent: [false]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 42113 bytes Desc: pastedImage.png URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:50:53 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:50:53 +0000 Subject: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) In-Reply-To: References: , Message-ID: Hi Marcel, following observations for your first question: * Key strokes for characters such as $+, $#, $ß, $?, or $- yield "Squeak1" or "Squeak2" in my image. * Combinations such as "dead circumflex , space" that print a $^ on my Qwertz system are displayed as pure "space" in the tool. * Ctrl + Alt + E (types $€), Ctrl + Alt + 7 (types ${), Alt + (NumPlus , Num2, Num0) (types $ ), etc. are printed as "E", "7", "0", etc. only. Regarding your remaining questions, I cannot really add much value to this because I have never dealt with this before. But there weren't any WTF moments. :-) What about different keyboard layouts such as QWERTZ/QWERTY/AWERTY etc.? What about virtual ways to enter characters (e.g. tools for special characters, emojipads, etc.). How do you make sure that these virtual keys are mapped correctly to their physical equivalents? Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Mittwoch, 28. April 2021 12:02 Uhr An: squeak-dev Betreff: Re: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) Hi all! Here is a small update. Please find attached the changeset. Updates: - Adds KeyboardEvent >> #keyCode (via new inst-var) - Logs the last key-down event to attach virtual-key codes to key-stroke events; see HandMorph >> #generateKeyboardEvent: - Simplifies KeyboardEvent >> #key - Show event repetition in KeyboardExecizer [cid:64f61a46-f546-4de3-8792-45bd873a11f5] Major questions: 1. Does it work on your machine? 2. What are your thoughts on KeyboardEvent >> #key? 3. What are your thoughts on KeyboardEvent >> #keyCode? 4. Do you understand KeyboardEvent >> #physicalKey #virtualKey #physicalModifiers #virtualModifiers ? Happy testing! Best, Marcel P.S.: Don't forget about the X11 key (scan?) codes. ^__^ I haven't had the time to look into the VM plugin yet. Am 27.04.2021 16:40:56 schrieb Marcel Taeumel : Hi all! Please find attached a changeset that adds mapping tables for virtual keys (or scan codes) for macOS, X11, and Windows. You can find them in EventSensor class >> #virtualKeysOn* You can try out if they work through the KeyboardExerciser. Please take a look at the balloon text (i.e. tool tip) to better understand the data. There is also a new preference: [x] Simplify Virtual-key codes ... because of Windows who dares to couple codes to the input language (e.g. US vs. DE), which Squeak knows nothing about. macOS is better in this regard. :-) Biggest mess is on Linux/X11. For key-down/up events, the Linux VM delivers actual character codes instead of scan codes, which makes a basic mapping to physical keys almost impossible. See EventSensor class >> #virtualKeysOnX11. We MUST fix that! Please. Somebody. Can I haz scan codes? ^__^ *** [cid:4d3dcc25-f68b-4238-a5a7-bf997a213c69] *** The good news: KeyboardEvent >> #key (and UserInputEvent >> #modifiers) now gives you cross-platform stable information about physical keys to be used in keyboard handlers. Yes, for both key-stroke and key-down/up events. Or at least, that is the plan. That's why it would be great if you could help testing! :-) Why key-stroke events too? Aren't they for typing text only? 1. Almost all keyboard shortcuts in current Squeak are based on key-stroke events. 2. Using the #keyCharacter is tricky because SHIFT changes lower-case to upper-case, which makes "anEvent shiftPressed" hard to understand. 3. CTRL combinations might not do the expected thing. How would you handle CTRL+C? The #keyCharacter could arrive as $c or Character enter. See the preference "Map non-printable characters to printable characters. Now, #key will always answer $C in such a case. Regardless of that preference. Can't we just use #keyCharacter in key-down/up events? No. Those are undefined. Never do that. key-down/up events carry virtual-key codes in their #keyValue. We might want to change #keyCharacter to answer "nil" for those events. *** Q: What is a "physical key" or "physical modifier"? A: The label that can be presented to the user so that he or she feels at home when using Squeak. Thus, looks platform-specific. Q: What is a "virtual key" or "virtual modifier"? A: The information to be processed in your application's key handlers. Thus, looks platform-independent. If you have still no clue how to talk to keyboard events, please read the commentary in KeyboardEvent >> #checkCommandKey. *** Happy testing! :-) And thank you all in advance! Best, Marcel P.S.: You might want to disable the preference "synthesize mouse-wheel events from keyboard-events" to get CTRL+ArrowUp and CTRL+ArrowDown ;-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57922 bytes Desc: image.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 62612 bytes Desc: image.png URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 1 17:53:20 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 1 May 2021 17:53:20 +0000 Subject: [squeak-dev] The Inbox: Collections-ul.933.mcz In-Reply-To: References: , Message-ID: Hi Levente, so what is now the official interface for creating a valid collection of any kind of a certain size n? Shall we always use #ofSize:? Is this something that should be documented in the release notes? Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Dienstag, 27. April 2021 17:07:18 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Collections-ul.933.mcz +1 I suppose =) It's faster then: [OrderedCollection streamContents: [:s | s nextPut: #apple]] bench BEFORE: '2,630,000 per second. 380 nanoseconds per run. 16.13677 % GC time.' AFTER: '3,990,000 per second. 251 nanoseconds per run. 15.89682 % GC time.' Best, Marcel Am 31.03.2021 02:19:03 schrieb commits at source.squeak.org : Levente Uzonyi uploaded a new version of Collections to project The Inbox: http://source.squeak.org/inbox/Collections-ul.933.mcz ==================== Summary ==================== Name: Collections-ul.933 Author: ul Time: 31 March 2021, 2:17:52.141067 am UUID: b290ad2c-2ed0-4d46-b2fe-12545bf5f31c Ancestors: Collections-ul.932 - use #ofSize: instead of #new: in SequenceableCollection class >> new:streamContents:, so that it creates a stream on a non-empty collection even if the receiver is OrderedCollection. =============== Diff against Collections-ul.932 =============== Item was changed: ----- Method: SequenceableCollection class>>new:streamContents: (in category 'stream creation') ----- new: newSize streamContents: blockWithArg | stream originalContents | + stream := WriteStream on: (self ofSize: newSize). - stream := WriteStream on: (self new: newSize). blockWithArg value: stream. originalContents := stream originalContents. + ^originalContents size = stream position + ifTrue: [ originalContents ] + ifFalse: [ stream contents ]! - originalContents size = stream position - ifTrue: [ ^originalContents ] - ifFalse: [ ^stream contents ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: From christoph.thiede at student.hpi.uni-potsdam.de Sat May 1 19:19:24 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 1 May 2021 14:19:24 -0500 (CDT) Subject: [squeak-dev] The Trunk: EToys-mt.445.mcz In-Reply-To: References: Message-ID: <1619896764137-0.post@n4.nabble.com> Hi Marcel, it's a pity to see the little nice BroomMorph go away from the Trunk. :-( Can't we move it to MorphicExtras or Etoys instead? Apart from that, the objects tool looks a bit empty now: Best, Christoph PS: That's valid HTML. Nabble ruined my message. ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From Marcel.Taeumel at hpi.de Sun May 2 10:54:14 2021 From: Marcel.Taeumel at hpi.de (Taeumel, Marcel) Date: Sun, 2 May 2021 10:54:14 +0000 Subject: [squeak-dev] Wrote a little about OnScreenKeyboardMorph In-Reply-To: <5329b70fe4cd49f9806fa655695a4f19@student.hpi.uni-potsdam.de> References: <045abb52-2eed-408f-972b-88926f3bc5b4@email.android.com> <8d40b92d-8be3-7a4c-1037-01c8d7fcc9ac@leastfixedpoint.com> , , <5329b70fe4cd49f9806fa655695a4f19@student.hpi.uni-potsdam.de> Message-ID: Ah, no. All of it is a hack. That should not be in Trunk in this form. ________________________________ From: Squeak-dev on behalf of Thiede, Christoph Sent: Saturday, May 1, 2021 6:56:20 PM To: squeak-dev Subject: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Hi Marcel, except for the ' ? ' part, which is really hacky, I like the general idea. +1 for integrating this into Trunk. :-) (In a later step, we could even recognize the touch/tablet mode from the host system if supported - e.g. in Windows 10 or SqueakJS and automatically adjust the Squeak appearance ...) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 18:07:23 An: squeak-dev Betreff: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Hey Tony, here is a quick hack that shows how to add more space to fight that "fat finger problem". :-D [cid:6abdabe5-6d1f-4d4f-abdf-f258c9951079] Best, Marcel Am 26.04.2021 17:06:42 schrieb Marcel Taeumel : > It just needs capability-security, better image management, > nested VMs... a few minor details :-) All these people with their feature requests ... ;-D Best, Marcel Am 26.04.2021 12:54:03 schrieb Tony Garnock-Jones : On 4/25/21 7:14 PM, Christoph Thiede wrote: > Cool stuff! I wish we could also use this on Android. :-) Me too. Smalltalk is (close to) what Android could have been... It just needs capability-security, better image management, nested VMs... a few minor details :-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 179614 bytes Desc: image.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 179614 bytes Desc: image.png URL: From commits at source.squeak.org Sun May 2 12:51:18 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 2 May 2021 12:51:18 0000 Subject: [squeak-dev] The Inbox: Tests-jar.461.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.461.mcz ==================== Summary ==================== Name: Tests-jar.461 Author: jar Time: 2 May 2021, 2:51:16.847089 pm UUID: 651bce1b-31e0-aa41-8178-47c312752c8b Ancestors: Tests-nice.460 Test #outer in combination with #resignalAs =============== Diff against Tests-nice.460 =============== Item was added: + ----- Method: ExceptionTester>>doubleOuterResignalAsTest (in category 'tests') ----- + doubleOuterResignalAsTest + "ExceptionTester new doubleOuterResignalAsTest" + + [[self doSomething. + MyResumableTestError signal. + self doYetAnotherThing] + on: MyResumableTestError + do: [:ex | ex outer. self doSomethingExceptional]. self doSomethingElse] + on: MyResumableTestError + do: [:ex | ex resignalAs: MyTestNotification] + ! Item was added: + ----- Method: ExceptionTester>>doubleOuterResignalAsTestResults (in category 'tests') ----- + doubleOuterResignalAsTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testDoubleOuterResignalAs (in category 'tests - ExceptionTester') ----- + testDoubleOuterResignalAs + self assertSuccess: (ExceptionTester new runTest: #doubleOuterResignalAsTest ) ! From commits at source.squeak.org Sun May 2 12:56:30 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 2 May 2021 12:56:30 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1398.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1398.mcz ==================== Summary ==================== Name: Kernel-jar.1398 Author: jar Time: 2 May 2021, 2:56:26.972089 pm UUID: 9398993d-726c-8747-bde6-506318c4f898 Ancestors: Kernel-nice.1397 Fix a bug in #resignalAs causing an incorrect evaluation of resignalAs in combination with #outer. Complemented with a test in Tests-jar.461 (Inbox) To illustrate the bug try: | x | x:=''. [ [1/0. x:=x,'1'] on: ZeroDivide do: [:ex | ex outer. x:=x,'2']. x:=x,'3' ] on: ZeroDivide do: [:ex | ex resignalAs: Notification]. x answers: ---> '2' currently - incorrect ---> '13' after the fix =============== Diff against Kernel-nice.1397 =============== Item was changed: ----- Method: Exception>>resignalAs: (in category 'handling') ----- resignalAs: replacementException + "Signal an alternative exception in place of the receiver. + Unwind to signalContext before signalling the replacement exception" - "Signal an alternative exception in place of the receiver." + signalContext resumeEvaluating: [replacementException signal]! - self resumeEvaluating: [replacementException signal]! From commits at source.squeak.org Sun May 2 13:12:41 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 2 May 2021 13:12:41 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1399.mcz ==================== Summary ==================== Name: Kernel-jar.1399 Author: jar Time: 2 May 2021, 3:12:37.830089 pm UUID: d288b516-c6f1-ce43-9061-2220422b8ab4 Ancestors: Kernel-jar.1398 Fix inconsistent implementation of an explicit and an implicit exception return. I'd like to return to my original proposal in http://forum.world.st/The-Inbox-Kernel-nice-1391-mcz-tp5129040p5129084.html. The problem then was a bug in #outer that confused me. The bug has been fixed and the original proposal in my opinion makes sense again - to unify how the two kinds of exception return are implemented. Theoretically it's possible to change the #return definition in the future and then the two returns would diverge. =============== Diff against Kernel-jar.1398 =============== Item was changed: ----- Method: Context>>handleSignal: (in category 'private-exceptions') ----- handleSignal: exception "Sent to handler (on:do:) contexts only. Execute the handler action block" | val | "just a marker, fail and execute the following" exception privHandlerContext: self contextTag. self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed" val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler]. + exception return: val "return from exception handlerContext if not otherwise directed in handle block"! - self return: val "return from self if not otherwise directed in handle block"! From m at jaromir.net Sun May 2 13:18:13 2021 From: m at jaromir.net (Jaromir Matas) Date: Sun, 2 May 2021 08:18:13 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-nice.1391.mcz In-Reply-To: <1619617702062-0.post@n4.nabble.com> References: <1619292720661-0.post@n4.nabble.com> <1619617702062-0.post@n4.nabble.com> Message-ID: <1619961493946-0.post@n4.nabble.com> Hi I'd like to return to my original proposal above in http://forum.world.st/The-Inbox-Kernel-nice-1391-mcz-tp5129040p5129084.html. There was a bug in #outer that confused me and I withdrew the proposal. The bug has been fixed and the original proposal in my opinion makes sense again - to unify how the two kinds of exception return are implemented. Theoretically it's possible to change #return definition in the future and then the two returns would diverge. The proposed change is in http://forum.world.st/The-Inbox-Kernel-jar-1399-mcz-td5129370.html: Context>>handleSignal: (in category 'private-exceptions') ----- handleSignal: exception "Sent to handler (on:do:) contexts only. Execute the handler action block" | val | "just a marker, fail and execute the following" exception privHandlerContext: self contextTag. self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed" val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler]. + exception return: val "return from exception handlerContext if not otherwise directed in handle block"! - self return: val "return from self if not otherwise directed in handle block"! ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sun May 2 13:36:26 2021 From: m at jaromir.net (Jaromir Matas) Date: Sun, 2 May 2021 08:36:26 -0500 (CDT) Subject: [squeak-dev] The Trunk: Kernel-nice.1394.mcz In-Reply-To: References: Message-ID: <1619962586071-0.post@n4.nabble.com> Hi Nicolas, This is a huge work! :) I've suggested a tiny change of #resignalAs in http://forum.world.st/The-Inbox-Kernel-jar-1398-mcz-td5129369.html: I think the exception should unwind straight to the signal context before resignalling. Resuming would break the #outer behavior - also see the test in http://forum.world.st/The-Inbox-Tests-jar-461-mcz-td5129368.html. If you approve the change, Exception>>resumeEvaluating will become obsolete and could be removed. Thanks, Jaromir commits-2 wrote > Item was changed: > ----- Method: Exception>>resignalAs: (in category 'handling') ----- > resignalAs: replacementException > "Signal an alternative exception in place of the receiver." > > + self resumeEvaluating: [replacementException signal]! > - self reactivateHandlers. > - self resumeUnchecked: replacementException signal! > > > Item was added: > + ----- Method: Exception>>resumeEvaluating: (in category 'handling') > ----- > + resumeEvaluating: aBlock > + "Return result of evaluating aBlock as the value of #signal, unless this > was called after an #outer message, then return resumptionValue as the > value of #outer. > + The block is only evaluated after unwinding the stack." > + > + | ctxt | > + outerContext ifNil: [ > + signalContext returnEvaluating: aBlock > + ] ifNotNil: [ > + ctxt := outerContext. > + outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" > + ctxt returnEvaluating: aBlock > + ]. > + ! ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From jakres+squeak at gmail.com Sun May 2 13:38:26 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Sun, 2 May 2021 15:38:26 +0200 Subject: [squeak-dev] The Inbox: Compiler-ct.459.mcz In-Reply-To: <1619870666446-0.post@n4.nabble.com> References: <1619870666446-0.post@n4.nabble.com> Message-ID: I guess these names come from the ANSI standard, which defines protocols "exceptionBuilder", "exceptionDescription", "exceptionInstantiator", and "exceptionSelector" (with this camel case naming). Otherwise I see no problem in renaming them, since for now these are just words. Am Sa., 1. Mai 2021 um 14:04 Uhr schrieb Christoph Thiede : > > By the way, I think we have a few category names in the image that are really > unnecessarily complicated and could be renamed. For instance, on Exception, > 'exceptionBuilder', 'exceptionDescription', and 'priv handling', and on its > class side, 'exceptionInstantiator' and 'exceptionSelector'. These are > counter examples of good category names in my opinion. > > Do you think it would be possible and worth renaming them? Or is this too > much noise? > > Best, > Christoph > > > > ----- > Carpe Squeak! > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From jakres+squeak at gmail.com Sun May 2 13:42:45 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Sun, 2 May 2021 15:42:45 +0200 Subject: [squeak-dev] The Trunk: Tests-nice.458.mcz In-Reply-To: <11BF7E9C-D582-4F50-84BF-49802524BBBE@rowledge.org> References: <8c3676cc5b4f43b390ea6f67ae7087aa@student.hpi.uni-potsdam.de> <985F8BA7-BDE9-4BD3-8A9C-9F1883E5FDFC@rowledge.org> <11BF7E9C-D582-4F50-84BF-49802524BBBE@rowledge.org> Message-ID: Maybe tool building is still considered to be too much trouble. No RAD tools etc. Marcel, did you get some insights on this one? Am Sa., 1. Mai 2021 um 01:40 Uhr schrieb tim Rowledge : > > > > > On 2021-04-30, at 11:06 AM, Thiede, Christoph wrote: > > > > > Tools to help workflow are always welcome; lack of them almost always results in potentially good ideas getting lost in the mire. (Think traits, for example) > > > > And how can we fight this development? Better visibility/PR? :-) > > The ideal - you know, that situation that we all pretend to aim for but never get close to achieving - would be that if one creates a new facility (traits, environments, private methods, any sort of abstracting trick) you also create tools and additions to existing tools that make it easy to use the new idea. And until you do, it does not get added to Trunk. > > Obviously I'm not demanding that the individual must necessarily do this; solving these kinds of problem is what a community ought to be good for. But not putting some new thing into Trunk until the cycle is complete seems like a helpful idea. > > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Useful random insult:- Cackles a lot, but I ain't seen no eggs yet. > > > From Christoph.Thiede at student.hpi.uni-potsdam.de Sun May 2 13:44:49 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sun, 2 May 2021 13:44:49 +0000 Subject: [squeak-dev] Wrote a little about OnScreenKeyboardMorph In-Reply-To: References: <045abb52-2eed-408f-972b-88926f3bc5b4@email.android.com> <8d40b92d-8be3-7a4c-1037-01c8d7fcc9ac@leastfixedpoint.com> , , <5329b70fe4cd49f9806fa655695a4f19@student.hpi.uni-potsdam.de>, Message-ID: But if we could refactor it ... :-) ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Sonntag, 2. Mai 2021 12:54:14 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Ah, no. All of it is a hack. That should not be in Trunk in this form. ________________________________ From: Squeak-dev on behalf of Thiede, Christoph Sent: Saturday, May 1, 2021 6:56:20 PM To: squeak-dev Subject: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Hi Marcel, except for the ' ? ' part, which is really hacky, I like the general idea. +1 for integrating this into Trunk. :-) (In a later step, we could even recognize the touch/tablet mode from the host system if supported - e.g. in Windows 10 or SqueakJS and automatically adjust the Squeak appearance ...) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 18:07:23 An: squeak-dev Betreff: Re: [squeak-dev] Wrote a little about OnScreenKeyboardMorph Hey Tony, here is a quick hack that shows how to add more space to fight that "fat finger problem". :-D [cid:6abdabe5-6d1f-4d4f-abdf-f258c9951079] Best, Marcel Am 26.04.2021 17:06:42 schrieb Marcel Taeumel : > It just needs capability-security, better image management, > nested VMs... a few minor details :-) All these people with their feature requests ... ;-D Best, Marcel Am 26.04.2021 12:54:03 schrieb Tony Garnock-Jones : On 4/25/21 7:14 PM, Christoph Thiede wrote: > Cool stuff! I wish we could also use this on Android. :-) Me too. Smalltalk is (close to) what Android could have been... It just needs capability-security, better image management, nested VMs... a few minor details :-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 179614 bytes Desc: image.png URL: From jakres+squeak at gmail.com Sun May 2 13:48:14 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Sun, 2 May 2021 15:48:14 +0200 Subject: [squeak-dev] False merge conflicts In-Reply-To: <226ec759680942ab99f81e148b265959@student.hpi.uni-potsdam.de> References: <4d76345a822b417187517284683875f7@student.hpi.uni-potsdam.de> <1619870444842-0.post@n4.nabble.com> <226ec759680942ab99f81e148b265959@student.hpi.uni-potsdam.de> Message-ID: Am Sa., 1. Mai 2021 um 18:05 Uhr schrieb Thiede, Christoph : > > Hmm, would it be a good idea to highlight the unclassified category in browsers using bold/italic font? > Put an exclamation sign on it, like the green and red bubbles for test methods. Or one of the flag icons (from flag:, halt, break) to signal unfinished work. > > I've also been thinking for some time about displaying a small kind of dashboard in the SaveVersionDialog which could things such as: "slips" (halts/flags/Transcript) in code, uncategorized methods, and maybe even more things such as linter results (SwaLint) or test results. But this might be a performance problem and I guess that not everyone would like it ... > Would this be possible as an extension package that everyone can load if they want it? From christoph.thiede at student.hpi.uni-potsdam.de Sun May 2 17:30:30 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sun, 2 May 2021 12:30:30 -0500 (CDT) Subject: [squeak-dev] SimulationSideEffectWarning (was: The Trunk: Kernel-nice.1386.mcz) In-Reply-To: <5c6fa64b87f04f4b8f6d2332255d5859@student.hpi.uni-potsdam.de> References: <1618578607101-0.post@n4.nabble.com> <1618578968761-0.post@n4.nabble.com> <5c6fa64b87f04f4b8f6d2332255d5859@student.hpi.uni-potsdam.de> Message-ID: <1619976630055-0.post@n4.nabble.com> Hi all, I just wanted to pick up this item from my list again and add a SimulationSideEffectWarning (I think this is a better name than my former proposal, EscapeFromSimulationWarning) to #doPrimitive:method:receiver:args:. As discussed below, it should allow pedantic clients of the simulator to avoid situations in which the code to be executed escapes from the control of the simulator, e.g. when it uses #fork. On the other hand, unaware clients such as the debugger should not be disturbed by unimportant warnings. However, critical attempts should still be reported, i.e. when a debugger reaches a simulation guard (primitive 19). However, I'm not yet sure in which exact situations the warning should be caught/suppressed and in which not. Here is a list of possible situations: - Use the stepping buttons in a debugger: SUPPRESS (except simulation guard) - Return entered value in a debugger: SUPPRESS (except simulation guard) - Terminate a process: SUPPRESS - Context class >> #trace.../#tally...: NOTIFY - MessageTally: NOTIFY - Context class >> #runSimulated:: NOTIFY - Morphic "debug action" (of a button, menu item, etc.): SUPPRESS - Debug it: SUPPRESS (what about simulation guards?) - (external project) SimulationStudio/Sandbox: NOTIFY (!) Based on this collection, I considered adding a handler in the public Process selectors for debugging (protocols: *System-debugging and 'changing suspended state'). This would also emphasize the different roles of Context and Process in the debugging machinery (Process also holds the responsibility for process-faithful debugging). Still, there is one edge case that would violate this rule: Imagine a subclass of Debugger that would be side-effect aware, i.e. care about EscapeFromSimulationWarnings. Since the debugger only talks to the Process, it would not be able to handle these warnings following my proposal from above. This is not only a fictive experiment but I'm indeed considering a SandboxDebugger at the moment which would actually need this. For this concrete case, of course, I could hack my exception handler into my Context subclass, too, but the existence of this example makes we wonder whether my proposal from above is actually useful. What is your opinion on this matter? Would you agree to my list of aware and non-aware simulation clients? When do you think we should suppress EscapeFromSimulationWarnings and when not? Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From nicolas.cellier.aka.nice at gmail.com Sun May 2 19:26:44 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Sun, 2 May 2021 21:26:44 +0200 Subject: [squeak-dev] The Trunk: Kernel-nice.1394.mcz In-Reply-To: <1619962586071-0.post@n4.nabble.com> References: <1619962586071-0.post@n4.nabble.com> Message-ID: Hi Jaromir, Le dim. 2 mai 2021 à 15:36, Jaromir Matas a écrit : > > Hi Nicolas, > > This is a huge work! :) I've suggested a tiny change of #resignalAs in > http://forum.world.st/The-Inbox-Kernel-jar-1398-mcz-td5129369.html: I think > the exception should unwind straight to the signal context before > resignalling. Resuming would break the #outer behavior - also see the test > in http://forum.world.st/The-Inbox-Tests-jar-461-mcz-td5129368.html. > Ah yes, absolutely, I did not take enough time to think of it. Indentation is a bit misleading, but the test is good. Thanks for it! > If you approve the change, Exception>>resumeEvaluating will become obsolete > and could be removed. > Sure, we should do so ASAP, less code = me happier :) > Thanks, > Jaromir No, thank you! > > > commits-2 wrote > > Item was changed: > > ----- Method: Exception>>resignalAs: (in category 'handling') ----- > > resignalAs: replacementException > > "Signal an alternative exception in place of the receiver." > > > > + self resumeEvaluating: [replacementException signal]! > > - self reactivateHandlers. > > - self resumeUnchecked: replacementException signal! > > > > > > Item was added: > > + ----- Method: Exception>>resumeEvaluating: (in category 'handling') > > ----- > > + resumeEvaluating: aBlock > > + "Return result of evaluating aBlock as the value of #signal, unless this > > was called after an #outer message, then return resumptionValue as the > > value of #outer. > > + The block is only evaluated after unwinding the stack." > > + > > + | ctxt | > > + outerContext ifNil: [ > > + signalContext returnEvaluating: aBlock > > + ] ifNotNil: [ > > + ctxt := outerContext. > > + outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" > > + ctxt returnEvaluating: aBlock > > + ]. > > + ! > > > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From commits at source.squeak.org Sun May 2 19:29:52 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 2 May 2021 19:29:52 0000 Subject: [squeak-dev] The Trunk: Kernel-jar.1398.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1398.mcz ==================== Summary ==================== Name: Kernel-jar.1398 Author: jar Time: 2 May 2021, 2:56:26.972089 pm UUID: 9398993d-726c-8747-bde6-506318c4f898 Ancestors: Kernel-nice.1397 Fix a bug in #resignalAs causing an incorrect evaluation of resignalAs in combination with #outer. Complemented with a test in Tests-jar.461 (Inbox) To illustrate the bug try: | x | x:=''. [ [1/0. x:=x,'1'] on: ZeroDivide do: [:ex | ex outer. x:=x,'2']. x:=x,'3' ] on: ZeroDivide do: [:ex | ex resignalAs: Notification]. x answers: ---> '2' currently - incorrect ---> '13' after the fix =============== Diff against Kernel-nice.1397 =============== Item was changed: ----- Method: Exception>>resignalAs: (in category 'handling') ----- resignalAs: replacementException + "Signal an alternative exception in place of the receiver. + Unwind to signalContext before signalling the replacement exception" - "Signal an alternative exception in place of the receiver." + signalContext resumeEvaluating: [replacementException signal]! - self resumeEvaluating: [replacementException signal]! From commits at source.squeak.org Sun May 2 19:30:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 2 May 2021 19:30:55 0000 Subject: [squeak-dev] The Trunk: Tests-jar.461.mcz Message-ID: Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-jar.461.mcz ==================== Summary ==================== Name: Tests-jar.461 Author: jar Time: 2 May 2021, 2:51:16.847089 pm UUID: 651bce1b-31e0-aa41-8178-47c312752c8b Ancestors: Tests-nice.460 Test #outer in combination with #resignalAs =============== Diff against Tests-nice.460 =============== Item was added: + ----- Method: ExceptionTester>>doubleOuterResignalAsTest (in category 'tests') ----- + doubleOuterResignalAsTest + "ExceptionTester new doubleOuterResignalAsTest" + + [[self doSomething. + MyResumableTestError signal. + self doYetAnotherThing] + on: MyResumableTestError + do: [:ex | ex outer. self doSomethingExceptional]. self doSomethingElse] + on: MyResumableTestError + do: [:ex | ex resignalAs: MyTestNotification] + ! Item was added: + ----- Method: ExceptionTester>>doubleOuterResignalAsTestResults (in category 'tests') ----- + doubleOuterResignalAsTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testDoubleOuterResignalAs (in category 'tests - ExceptionTester') ----- + testDoubleOuterResignalAs + self assertSuccess: (ExceptionTester new runTest: #doubleOuterResignalAsTest ) ! From nicolas.cellier.aka.nice at gmail.com Sun May 2 19:55:59 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Sun, 2 May 2021 21:55:59 +0200 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: Message-ID: Le dim. 2 mai 2021 à 15:12, a écrit : > > A new version of Kernel was added to project The Inbox: > http://source.squeak.org/inbox/Kernel-jar.1399.mcz > > ==================== Summary ==================== > > Name: Kernel-jar.1399 > Author: jar > Time: 2 May 2021, 3:12:37.830089 pm > UUID: d288b516-c6f1-ce43-9061-2220422b8ab4 > Ancestors: Kernel-jar.1398 > > Fix inconsistent implementation of an explicit and an implicit exception return. > > I'd like to return to my original proposal in http://forum.world.st/The-Inbox-Kernel-nice-1391-mcz-tp5129040p5129084.html. The problem then was a bug in #outer that confused me. The bug has been fixed and the original proposal in my opinion makes sense again - to unify how the two kinds of exception return are implemented. Theoretically it's possible to change the #return definition in the future and then the two returns would diverge. > Maybe it has a virtue of making the return more explicit. Currently, behavior differs only if someone refines OwnException>>return: OwnException>>return: anObject self logReturn: anObject. ^super return: anObject I wonder what would be the expectations of someone using implicit return: howMany := [self countTheThings] on: OwnException do: [:exc | -1 "error condition"] Shall above construction logReturn: or not? Currently it doesn't. You are proposing that it does... I have no strong opinion. Votes? > =============== Diff against Kernel-jar.1398 =============== > > Item was changed: > ----- Method: Context>>handleSignal: (in category 'private-exceptions') ----- > handleSignal: exception > "Sent to handler (on:do:) contexts only. > Execute the handler action block" > > | val | > "just a marker, fail and execute the following" > exception privHandlerContext: self contextTag. > self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed" > val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler]. > + exception return: val "return from exception handlerContext if not otherwise directed in handle block"! > - self return: val "return from self if not otherwise directed in handle block"! > > From m at jaromir.net Sun May 2 20:43:10 2021 From: m at jaromir.net (Jaromir Matas) Date: Sun, 2 May 2021 15:43:10 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: Message-ID: <1619988190941-0.post@n4.nabble.com> Hi Nicolas, Nicolas Cellier wrote > Maybe it has a virtue of making the return more explicit. > Currently, behavior differs only if someone refines OwnException>>return: > OwnException>>return: anObject > self logReturn: anObject. > ^super return: anObject > I wonder what would be the expectations of someone using implicit return: > howMany := [self countTheThings] on: OwnException do: [:exc | -1 > "error condition"] > Shall above construction logReturn: or not? > Currently it doesn't. > You are proposing that it does... > I have no strong opinion. > Votes? Thanks; I don't have a strong opinion either, I just incline towards unifying; it happened to me a couple of times during debugging the two returns behaved differently which irritated me :) Your example even shows a real use case... it didn't occur to me. ANSI doesn't provide a guideline either: Implicit: If the evaluation of the exception action returns normally (as if it had returned from the #value: message), the value returned from the exception action is returned as the value of the #on:do: message that created the handler. Explicit: return: returnValue The returnValue is returned as the value of the protected block of the active exception handler. Another example: Cuis uses a modified Exception>>#return definition which means the modification applies only to the explicit behavior (the difference is insignificant but it's there). Thanks again, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From leves at caesar.elte.hu Sun May 2 23:43:51 2021 From: leves at caesar.elte.hu (Levente Uzonyi) Date: Mon, 3 May 2021 01:43:51 +0200 (CEST) Subject: [squeak-dev] The Inbox: Collections-ul.933.mcz In-Reply-To: References: , Message-ID: Hi Christoph, On Sat, 1 May 2021, Thiede, Christoph wrote: > > Hi Levente, > > > so what is now the official interface for creating a valid collection of any kind of a certain size n? Shall we always use #ofSize:? Is this something that should be documented in the release notes? There's no such interface for "a valid collection of any kind", and it's not possible to create one, because we have many different collections with different properties. For that reason, Collection doesn't implement #new:, however it inherits the method from Behavior, but that is not ideal. #new: is actually there to support variable classes, so it works well for ArrayedCollections, which are variable classes. Some collections, like Set, Heap, Dictionary, etc. use it to take a desired initial capacity. Unfortunately, OrderedCollection also follows that pattern. Some collections cannot implement #new:, like Interval or CharacterSet. To answer your question, for ArrayedCollections, the method you asked about is #new:. OrderedCollection is a resizable ArrayedCollection: the collection an OrderedCollection encapsulates (array) is always an ArrayedCollection. Its API is similar to ArrayedCollection's but it is not exactly the same. #new: is different. As I wrote in another email recently, #new: could have been implemented to create a non-empty collection unless the argument is 0. But for some reason it wasn't. #ofSize:, according to its method comment, was created to work around that difference: "Create a new collection of size n with nil as its elements. This method exists because OrderedCollection new: n creates an empty collection, not one of size n." IMO the best would be to eliminate that difference, but it may be too late now, because that would involve breaking all programs having the snippet OrderedCollection new: x There are 97 potential methods with that pattern in my Trunk image (two of those are false positives: the implementors of #ofSize:): CurrentReadOnlySourceFiles cacheDuring: [ | regex | regex := ('({1})\\s+new\\:' format: { (OrderedCollection withAllSubclasses collect: #name) joinSeparatedBy: '|' }) asRegex. SystemNavigation browseAllSelect: [ :method | regex search: method getSource asString ] ]. Levente > > > Best, > > Christoph > > _________________________________________________________________________________________________________________________________________________________________________________________________________________________________ > Von: Squeak-dev im Auftrag von Taeumel, Marcel > Gesendet: Dienstag, 27. April 2021 17:07:18 > An: squeak-dev > Betreff: Re: [squeak-dev] The Inbox: Collections-ul.933.mcz   > +1 I suppose =) > It's faster then: > > [OrderedCollection streamContents: [:s | s nextPut: #apple]] bench   > > BEFORE: '2,630,000 per second. 380 nanoseconds per run. 16.13677 % GC time.' > AFTER: '3,990,000 per second. 251 nanoseconds per run. 15.89682 % GC time.' > > Best, > Marcel > > Am 31.03.2021 02:19:03 schrieb commits at source.squeak.org : > > Levente Uzonyi uploaded a new version of Collections to project The Inbox: > http://source.squeak.org/inbox/Collections-ul.933.mcz > > ==================== Summary ==================== > > Name: Collections-ul.933 > Author: ul > Time: 31 March 2021, 2:17:52.141067 am > UUID: b290ad2c-2ed0-4d46-b2fe-12545bf5f31c > Ancestors: Collections-ul.932 > > - use #ofSize: instead of #new: in SequenceableCollection class >> new:streamContents:, so that it creates a stream on a non-empty collection even if the receiver is OrderedCollection. > > =============== Diff against Collections-ul.932 =============== > > Item was changed: > ----- Method: SequenceableCollection class>>new:streamContents: (in category 'stream creation') ----- > new: newSize streamContents: blockWithArg > > | stream originalContents | > + stream := WriteStream on: (self ofSize: newSize). > - stream := WriteStream on: (self new: newSize). > blockWithArg value: stream. > originalContents := stream originalContents. > + ^originalContents size = stream position > + ifTrue: [ originalContents ] > + ifFalse: [ stream contents ]! > - originalContents size = stream position > - ifTrue: [ ^originalContents ] > - ifFalse: [ ^stream contents ]! > > > > From marcel.taeumel at hpi.de Mon May 3 08:27:31 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 3 May 2021 10:27:31 +0200 Subject: [squeak-dev] The Trunk: Morphic-eem.1719.mcz In-Reply-To: <147974e060b0423b925f2a8b7b6d8803@student.hpi.uni-potsdam.de> References: <804594dd36de4be1b92d4dbecaaeb973@student.hpi.uni-potsdam.de> <,> <,> <147974e060b0423b925f2a8b7b6d8803@student.hpi.uni-potsdam.de> Message-ID: Hi Christoph, hi all. Let me add some more details about my reasoning behind Morphic-mt.1761. First of all, let me explain the "code smells" that I found in the changeset: 1. Relying on the overly specific entry point Browser class >> #browseMethodFull. 2. Adapting HierarchyBrowser probably because of the first smell, breaking existing behavior. 3. Implicitly adding (and thus "simulating") a dynamic variable via set-and-ensure. *** I noticed that the role of a "requestor" is participating in the "Reuse windows" preference. I am familiar with this role in the sense that model-view communication (e.g. PluggableListMorph to Browser) uses it to some extent. So, instead of being focused on who should not see that preference (i.e. hacking global state), it makes sense to design its intentions more clearly. In my opinion, that's the better object-oriented design. It's more robust. Now, a safe way to pass a requestor along is as message argument. See Morph >> #mouseLeave: and EventHandler >> #mouseLeave:fromMorph: as an example. However, this role might emerge only later in the design process. Then you have the problem of old code relying on the existing interface. What then? A dynamically scoped variable might help. Yet, dynamic scope can be challenging to maintain. Especially when having the notion of an ever-running image (object memory), which is highly state-based, dynamic scope can be easily messed up. Any object could choose to reset (and rely on) the scope for its own purpose. That's dangerous. Faulty behavior might become difficult to trace and understand without the right tools. Even with the right tools, the underlying design might have become accidentally more complex than it needs to be. In Morphic, we have the dynamically scoped ActiveWorld(Variable), ActiveHand(Variable), and ActiveEvent(Variable) to support scenarios where one of those basic objects is not available in a messages send. For examples, browse senders of #currentEvent or #currentWorld. Unfortunately, we have to take care that only well-defined places reset this scope. Such managing of global contracts can be quite effortful. ... The user interrupt (i.e. CMD+Dot) comes to mind. It must work; the system must stay responsive. Let's treat the use of a dynamic variable as "forward scope." There is another way. A way that avoids the risks of not knowing what might happen within that scope through sends to come. Instead, we can take a look at thisContext, which allows reasoning about the current scope "backwards" and "at rest." Is a query over thisContext always a solution to a missing argument in the message send? Surely not. We are lucky enough to benefit from some inherent properties of the Morphic design: 1. Single UI process 2. Little use of deferred UI messages; no use of other async UI request via promises etc. 3. Clear user model through morph composition; whole-parts hierarchy visible in pixels To sum up my intentions behind Morphic-mt.1761, I looked for a way to implement the role of a "requestor" for the "Reuse windows" preference as concise (!) as possible -- at a single place to reduce the cost of future maintenance. After pondering the pros and cons of "global state", "dynamic forward scope", and "resting backward scope" in Morphic, I decided to apply meta programming to look into thisContext to figure out the current "requestor." Given that the solution is at a single place (!), I think that future adjustments will remain manageable. If - at some point - Morphic's properties would change and hence not allow the current approach, I would keep looking for a way to clearly implement the role of a "requestor." At worst, the "reuse windows" preference might just not be supported under some circumstances. I would never risk hacking the entire system just for some edge case. Yet, I stay confident. We will find a way. If it would mean to re-design #openInWorld: to always supply a requestor, we should do it, maybe by adding #openInWorld:from:. And clearly mark the missing requestor as "discouraged" because you would loose certain effects (or preferences). Well, this takes time and patience. Until then, let's just keep this little piece of meta-programming to look up thisContext in SystemWindow >> #anyOpenWindowLikeMeIn:. Maybe add an extra flag to emphasize it a little bit more. To be able to quickly find it once we have a better solution for it. *** TL;DR: For the Squeak system, dynamic scope is only a little bit better than relying on global state. At best, all required information are in the message arguments. The next better thing is receiver state (i.e. instVars). After that, it gets tricky. Remember that singletons (e.g. SystemWindow class >> #topWindow) are global state, too. Happy squeaking! :-) Best, Marcel Am 01.05.2021 19:10:25 schrieb Thiede, Christoph : Hi Marcel, thanks for your review, I will notify you if I identify any regressions. :-) But your metaprogramming approach from Morphic-mt.1761 ... To be honest, I cannot really say that I would like it. Such magic can be very hard to debug, explore, extend, etc. IMHO, in Smalltalk, we can do better. :-) Instead, I believe an explicit method that to turn off #reuseWindows temporarily would be a better option. If #browseMethodFull is used too frequently, maybe we could wrap it into a new selector #browseMethodFullNew? Looking at the current solution, I would even prefer a (kind of global) variable that temporarily holds a Model/Browser instance that does not want to reused - for instance: ----- Method: SystemWindow>>anyOpenWindowLikeMeIn: (in category 'open/close') ----- anyOpenWindowLikeMeIn: aPasteUpMorph | requestor | self class reuseWindows ifFalse: [ ^ Array empty ]. requestor := Model currentRequestorNotToBeReused. ... Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 26. April 2021 10:03:32 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-eem.1719.mcz   Hi Christoph, I somewhat integrated your proposed changes into Trunk. :-) Browser >> #representsSameBrowseeAs: SearchBar >> #smartSearch:in: SystemWindow >> #anyOpenWindowLikeMeIn: Note that a tool's buttons can typically be used to duplicate the tool if desired. Thus, it is not an option to just remove the "hierarchy" button, for example, if it interferes with the "re-use windows" preference -- which you proposed. Also, by just hacking into #browseMethodFull for Browser, you omit all the other possible paths that might interfere with that preference. Well, preference settings might have other side effects, yet, if one would want to do that (e.g., in tests), you must put it into the ensure context: ^ [systemWindow reuseWindows: false. super browseMethodFull] ensure: [systemWindow reuseWindows: previous] Anyway -- instead -- I added the constraint that the requesting window should not be considered as a re-use candidate. With our current tool architecture, I had to resort to meta programming (i.e. context checking). I hope that you won't notice any performance glitches. (Took be about 1.5 hours.) Best, Marcel Am 25.04.2021 22:36:47 schrieb Thiede, Christoph : Hi all, please find the attached changeset which fixes the regression of the smart search bar not honoring the #reuseWindows preference. Also, I added a proper implementation of #reuseWindows for browsers. Please review and/or merge! :-) Best, Christoph PS: What is packages at lists.squeakfoundation.org and why is it being cc'ed in this conversation? Von: Squeak-dev im Auftrag von Chris Muller Gesendet: Freitag, 5. Februar 2021 22:19:13 An: The general-purpose Squeak developers list Cc: packages at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Morphic-eem.1719.mcz   Hi Christoph! I thought this feature seemed reminiscent of Reuse Windows as well.  The method to hook in each Model subclass (as needed) is #representsSameBrowseeAs:.  Looking at that, you can see that simply making your code pane temporarily dirty, an additional window will be spawned.  I mention that because Reuse Windows is fantastic and I hate to see your experience with it ruined over something so trivial.  :) You do also have the green duplicate halo.  People are happy to use "non-standard" UI features in other IDE's, but there seems to be an aversion to people using halos in Squeak.  I could be wrong about that, but I find the duplicate halo useful quite often.  - Chris On Thu, Feb 4, 2021 at 7:14 PM Thiede, Christoph wrote: Hi Eliot, could you please honor the "SystemWindow reuseWindows" here? I have turned that preference off in my image because I actually use to accept a class name multiple times in the search bar in order to open multiple windows - for instance, to view different protocols of the same class side-by-side. It would be great if this would work soon again ... :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org [mailto:commits at source.squeak.org] Gesendet: Donnerstag, 4. Februar 2021 03:38:15 An: squeak-dev at lists.squeakfoundation.org [mailto:squeak-dev at lists.squeakfoundation.org]; packages at lists.squeakfoundation.org [mailto:packages at lists.squeakfoundation.org] Betreff: [squeak-dev] The Trunk: Morphic-eem.1719.mcz   Eliot Miranda uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-eem.1719.mcz [http://source.squeak.org/trunk/Morphic-eem.1719.mcz] ==================== Summary ==================== Name: Morphic-eem.1719 Author: eem Time: 3 February 2021, 6:38:11.11355 pm UUID: ffb981b1-7c53-4fbe-b6f4-4c8f27c79f5a Ancestors: Morphic-mt.1718 Make SearchBar>>#smartSearch:in: search existing browsers for a class name being searched for, bringing the first such browser to the front and selecting the class.  This allows one to find classes in browsers either when one has very many, or when one is using multi-window browsers containing many many classes. =============== Diff against Morphic-mt.1718 =============== Item was added: + ----- Method: Browser>>displayClass: (in category '*Morphic-Menus-DockingBar-accessing') ----- + displayClass: aClass +        "Assuming the receiver has answered true to isDisplayingClass:, come to the front and select the given class." +        | index | +        index := self multiWindowIndexForClassName: aClass. +        index  ~= 0 ifTrue: +                [multiWindowState selectWindowIndex: index]. +        self selectClass: aClass! Item was added: + ----- Method: Browser>>isDisplayingClass: (in category '*Morphic-Menus-DockingBar-accessing') ----- + isDisplayingClass: aClass +        | className | +        className := aClass name. +        (self multiWindowIndexForClassName: className) ~= 0 ifTrue: [^true]. +        ^selectedClassName = className! Item was added: + ----- Method: Browser>>multiWindowIndexForClassName: (in category '*Morphic-Menus-DockingBar-accessing') ----- + multiWindowIndexForClassName: className +        "Answer the index of a browser displaying className in multiWindowState, if any. +         Otherwise answer zero." +        multiWindowState ifNil: [^0]. +        multiWindowState models withIndexDo: +                [:browser :index| +                browser selectedClassName = className ifTrue: [^index]]. +        ^0! Item was changed:   ----- Method: SearchBar>>smartSearch:in: (in category 'searching') -----   smartSearch: text in: morph          "Take the user input and perform an appropriate search"          | input newContents |          self removeResultsWidget.          input := text asString ifEmpty:[^self].          self class useSmartSearch ifFalse: [^ ToolSet default browseMessageNames: input].   +        (Symbol findInterned: input) ifNotNil: +                [:symbol| input := symbol].          "If it is a global or a full class name, browse that class." +        (Smalltalk bindingOf: input) ifNotNil: +                [:assoc| | class | +                class := (assoc value isBehavior ifTrue:[assoc value] ifFalse:[assoc value class]) theNonMetaClass. +                Project current world submorphs do: +                        [:windowMorph| +                         (windowMorph isSystemWindow +                          and: [(windowMorph model isKindOf: Browser) +                          and: [windowMorph model isDisplayingClass: class]]) ifTrue: +                                [windowMorph beKeyWindow. +                                 ^windowMorph model displayClass: class]]. +                ^ToolSet browse: class selector: nil]. -        (Smalltalk bindingOf: input) ifNotNil:[:assoc| | global | -                global := assoc value. -                ^ToolSet browse: (global isBehavior ifTrue:[global] ifFalse:[global class]) selector: nil].                   "If it is a symbol and there are implementors of it, browse those implementors."          Symbol hasInterned: input ifTrue: [:selector |                  (SystemNavigation new allImplementorsOf: selector) ifNotEmpty:[:list|                          ^SystemNavigation new                                  browseMessageList: list                                  name: 'Implementors of ' , input]].            "If it starts uppercase, browse classes if any. Otherwise, just search for messages." +        input first isUppercase ifTrue: +                [(UIManager default classFromPattern: input withCaption: '') +                        ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil]. +                newContents := input, ' -- not found.'. +                self searchTerm: newContents. +                self selection: (input size+1 to: newContents size). +                self currentHand newKeyboardFocus: morph textMorph. +                ^ self]. + +        "Default to browse message names..." +        ToolSet default browseMessageNames: input! -        input first isUppercase -                ifTrue: [ -                        (UIManager default classFromPattern: input withCaption: '') -                                ifNotNil:[:aClass| ^ToolSet browse: aClass selector: nil] -                                ifNil: [ -                                        newContents := input, ' -- not found.'. -                                        self searchTerm: newContents. -                                        self selection: (input size+1 to: newContents size). -                                        self currentHand newKeyboardFocus: morph textMorph. -                                        ^ self]] -                ifFalse: [ -                        ToolSet default browseMessageNames: input].! -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Mon May 3 08:59:16 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 3 May 2021 10:59:16 +0200 Subject: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) In-Reply-To: References: <,> Message-ID: Hi Christoph, thanks for your thoughts. There might be a need for some clarification, especially the difference between "key character" and "(virtual) key". First of all, the visuals of the KeyboardExerciser do not match writing tools but physical keyboards. While you can explore the input event and take a look at #keyCharacter, I suggest you use a workspace to try whether you can still type and write characters as you need. Second, dead keys such as the circumflex mainly affect #keyCharacter because they should help you type characters in your writing tool. Regarding physical keys and their presses, dead keys are rather inconvenient. You would have to press them twice to register a single key-down event. Now back to the virtual keys and key codes. You raised the question about different keyboard layouts. At best, the operating system would abstract virtual-key codes (i.e. keyboard layout) from input language (e.g. US, DE). So, on QWERTZ with DE, you will get key-code for Q, W, E, R, T, Z and on QWERTY with US you get ... Y.  If you lie about your physical layout for more convenient typing, it becomes tricky. The user is not aware of the labels on the physical keys but relies on the virtual abstraction. So, pressing the key labeled "Z" while thinking about Y and then getting the key-code for Z might be surprising. That's why Windows relies on the user to tell which kind of keyboard she has attached. After wall, the operating system does not use a camera to check the physical world itself. Hehe. At the end of the day, we have to rely on the user telling the truth to the operating system about the layout of the physical keyboard. Luckily, modern operating systems separate keyboard layout from input language for spelling correction etc. For example, I have QWERTZ also configured for English, not just German. That's why DVORAK can work. You just have to tell your operating system that your keyboard has the DVORAK layout. It's nothing Squeak has to take care of. Best, Marcel Am 01.05.2021 19:51:04 schrieb Thiede, Christoph : Hi Marcel, following observations for your first question: * Key strokes for characters such as $+, $#, $ß, $?, or $- yield "Squeak1" or "Squeak2" in my image. * Combinations such as "dead circumflex , space" that print a $^ on my Qwertz system are displayed as pure "space" in the tool. * Ctrl + Alt + E (types $€), Ctrl + Alt + 7 (types ${), Alt + (NumPlus , Num2, Num0) (types $ ), etc. are printed as "E", "7", "0", etc. only. Regarding your remaining questions, I cannot really add much value to this because I have never dealt with this before. But there weren't any WTF moments. :-) What about different keyboard layouts such as QWERTZ/QWERTY/AWERTY etc.? What about virtual ways to enter characters (e.g. tools for special characters, emojipads, etc.). How do you make sure that these virtual keys are mapped correctly to their physical equivalents? Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Mittwoch, 28. April 2021 12:02 Uhr An: squeak-dev Betreff: Re: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-)   Hi all! Here is a small update. Please find attached the changeset. Updates: - Adds KeyboardEvent >> #keyCode (via new inst-var) - Logs the last key-down event to attach virtual-key codes to key-stroke events; see HandMorph >> #generateKeyboardEvent: - Simplifies KeyboardEvent >> #key - Show event repetition in KeyboardExecizer Major questions: 1. Does it work on your machine? 2. What are your thoughts on KeyboardEvent >> #key? 3. What are your thoughts on KeyboardEvent >> #keyCode? 4. Do you understand KeyboardEvent >> #physicalKey #virtualKey #physicalModifiers #virtualModifiers ? Happy testing! Best, Marcel P.S.: Don't forget about the X11 key (scan?) codes. ^__^ I haven't had the time to look into the VM plugin yet. Am 27.04.2021 16:40:56 schrieb Marcel Taeumel : Hi all! Please find attached a changeset that adds mapping tables for virtual keys (or scan codes) for macOS, X11, and Windows. You can find them in EventSensor class >> #virtualKeysOn* You can try out if they work through the KeyboardExerciser. Please take a look at the balloon text (i.e. tool tip) to better understand the data. There is also a new preference: [x] Simplify Virtual-key codes ... because of Windows who dares to couple codes to the input language (e.g. US vs. DE), which Squeak knows nothing about. macOS is better in this regard. :-) Biggest mess is on Linux/X11. For key-down/up events, the Linux VM delivers actual character codes instead of scan codes, which makes a basic mapping to physical keys almost impossible. See EventSensor class >> #virtualKeysOnX11. We MUST fix that! Please. Somebody. Can I haz scan codes? ^__^ *** *** The good news: KeyboardEvent >> #key (and UserInputEvent >> #modifiers) now gives you cross-platform stable information about physical keys to be used in keyboard handlers. Yes, for both key-stroke and key-down/up events. Or at least, that is the plan. That's why it would be great if you could help testing! :-) Why key-stroke events too? Aren't they for typing text only? 1. Almost all keyboard shortcuts in current Squeak are based on key-stroke events. 2. Using the #keyCharacter is tricky because SHIFT changes lower-case to upper-case, which makes "anEvent shiftPressed" hard to understand. 3. CTRL combinations might not do the expected thing. How would you handle CTRL+C? The #keyCharacter could arrive as $c or Character enter. See the preference "Map non-printable characters to printable characters. Now, #key will always answer $C in such a case. Regardless of that preference. Can't we just use #keyCharacter in key-down/up events? No. Those are undefined. Never do that. key-down/up events carry virtual-key codes in their #keyValue. We might want to change #keyCharacter to answer "nil" for those events. *** Q: What is a "physical key" or "physical modifier"? A: The label that can be presented to the user so that he or she feels at home when using Squeak. Thus, looks platform-specific. Q: What is a "virtual key" or "virtual modifier"? A: The information to be processed in your application's key handlers. Thus, looks platform-independent. If you have still no clue how to talk to keyboard events, please read the commentary in KeyboardEvent >> #checkCommandKey. *** Happy testing! :-) And thank you all in advance! Best, Marcel P.S.: You might want to disable the preference "synthesize mouse-wheel events from keyboard-events" to get CTRL+ArrowUp and CTRL+ArrowDown ;-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57922 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 62612 bytes Desc: not available URL: From marcel.taeumel at hpi.de Mon May 3 09:11:15 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 3 May 2021 11:11:15 +0200 Subject: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) In-Reply-To: References: <,> Message-ID: ...maybe one more thought. The information behind USB HID devices does not reveal information about localization, maybe also because the same buttons may be used for different layouts. Take DE vs. UK as an example. Just the ink on the buttons is different: https://en.wikipedia.org/wiki/QWERTZ https://en.wikipedia.org/wiki/File:German-Keyboard-Layout-T2-Version1-large.png https://en.wikipedia.org/wiki/QWERTY https://en.wikipedia.org/wiki/File:KB_United_Kingdom.svg (https://stackoverflow.com/questions/39388141/send-language-layout-from-usb-hid-keyboard) Best, Marcel Am 03.05.2021 10:59:16 schrieb Marcel Taeumel : Hi Christoph, thanks for your thoughts. There might be a need for some clarification, especially the difference between "key character" and "(virtual) key". First of all, the visuals of the KeyboardExerciser do not match writing tools but physical keyboards. While you can explore the input event and take a look at #keyCharacter, I suggest you use a workspace to try whether you can still type and write characters as you need. Second, dead keys such as the circumflex mainly affect #keyCharacter because they should help you type characters in your writing tool. Regarding physical keys and their presses, dead keys are rather inconvenient. You would have to press them twice to register a single key-down event. Now back to the virtual keys and key codes. You raised the question about different keyboard layouts. At best, the operating system would abstract virtual-key codes (i.e. keyboard layout) from input language (e.g. US, DE). So, on QWERTZ with DE, you will get key-code for Q, W, E, R, T, Z and on QWERTY with US you get ... Y.  If you lie about your physical layout for more convenient typing, it becomes tricky. The user is not aware of the labels on the physical keys but relies on the virtual abstraction. So, pressing the key labeled "Z" while thinking about Y and then getting the key-code for Z might be surprising. That's why Windows relies on the user to tell which kind of keyboard she has attached. After wall, the operating system does not use a camera to check the physical world itself. Hehe. At the end of the day, we have to rely on the user telling the truth to the operating system about the layout of the physical keyboard. Luckily, modern operating systems separate keyboard layout from input language for spelling correction etc. For example, I have QWERTZ also configured for English, not just German. That's why DVORAK can work. You just have to tell your operating system that your keyboard has the DVORAK layout. It's nothing Squeak has to take care of. Best, Marcel Am 01.05.2021 19:51:04 schrieb Thiede, Christoph : Hi Marcel, following observations for your first question: * Key strokes for characters such as $+, $#, $ß, $?, or $- yield "Squeak1" or "Squeak2" in my image. * Combinations such as "dead circumflex , space" that print a $^ on my Qwertz system are displayed as pure "space" in the tool. * Ctrl + Alt + E (types $€), Ctrl + Alt + 7 (types ${), Alt + (NumPlus , Num2, Num0) (types $ ), etc. are printed as "E", "7", "0", etc. only. Regarding your remaining questions, I cannot really add much value to this because I have never dealt with this before. But there weren't any WTF moments. :-) What about different keyboard layouts such as QWERTZ/QWERTY/AWERTY etc.? What about virtual ways to enter characters (e.g. tools for special characters, emojipads, etc.). How do you make sure that these virtual keys are mapped correctly to their physical equivalents? Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Mittwoch, 28. April 2021 12:02 Uhr An: squeak-dev Betreff: Re: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-)   Hi all! Here is a small update. Please find attached the changeset. Updates: - Adds KeyboardEvent >> #keyCode (via new inst-var) - Logs the last key-down event to attach virtual-key codes to key-stroke events; see HandMorph >> #generateKeyboardEvent: - Simplifies KeyboardEvent >> #key - Show event repetition in KeyboardExecizer Major questions: 1. Does it work on your machine? 2. What are your thoughts on KeyboardEvent >> #key? 3. What are your thoughts on KeyboardEvent >> #keyCode? 4. Do you understand KeyboardEvent >> #physicalKey #virtualKey #physicalModifiers #virtualModifiers ? Happy testing! Best, Marcel P.S.: Don't forget about the X11 key (scan?) codes. ^__^ I haven't had the time to look into the VM plugin yet. Am 27.04.2021 16:40:56 schrieb Marcel Taeumel : Hi all! Please find attached a changeset that adds mapping tables for virtual keys (or scan codes) for macOS, X11, and Windows. You can find them in EventSensor class >> #virtualKeysOn* You can try out if they work through the KeyboardExerciser. Please take a look at the balloon text (i.e. tool tip) to better understand the data. There is also a new preference: [x] Simplify Virtual-key codes ... because of Windows who dares to couple codes to the input language (e.g. US vs. DE), which Squeak knows nothing about. macOS is better in this regard. :-) Biggest mess is on Linux/X11. For key-down/up events, the Linux VM delivers actual character codes instead of scan codes, which makes a basic mapping to physical keys almost impossible. See EventSensor class >> #virtualKeysOnX11. We MUST fix that! Please. Somebody. Can I haz scan codes? ^__^ *** *** The good news: KeyboardEvent >> #key (and UserInputEvent >> #modifiers) now gives you cross-platform stable information about physical keys to be used in keyboard handlers. Yes, for both key-stroke and key-down/up events. Or at least, that is the plan. That's why it would be great if you could help testing! :-) Why key-stroke events too? Aren't they for typing text only? 1. Almost all keyboard shortcuts in current Squeak are based on key-stroke events. 2. Using the #keyCharacter is tricky because SHIFT changes lower-case to upper-case, which makes "anEvent shiftPressed" hard to understand. 3. CTRL combinations might not do the expected thing. How would you handle CTRL+C? The #keyCharacter could arrive as $c or Character enter. See the preference "Map non-printable characters to printable characters. Now, #key will always answer $C in such a case. Regardless of that preference. Can't we just use #keyCharacter in key-down/up events? No. Those are undefined. Never do that. key-down/up events carry virtual-key codes in their #keyValue. We might want to change #keyCharacter to answer "nil" for those events. *** Q: What is a "physical key" or "physical modifier"? A: The label that can be presented to the user so that he or she feels at home when using Squeak. Thus, looks platform-specific. Q: What is a "virtual key" or "virtual modifier"? A: The information to be processed in your application's key handlers. Thus, looks platform-independent. If you have still no clue how to talk to keyboard events, please read the commentary in KeyboardEvent >> #checkCommandKey. *** Happy testing! :-) And thank you all in advance! Best, Marcel P.S.: You might want to disable the preference "synthesize mouse-wheel events from keyboard-events" to get CTRL+ArrowUp and CTRL+ArrowDown ;-) -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57922 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 62612 bytes Desc: not available URL: From commits at source.squeak.org Mon May 3 10:03:43 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 10:03:43 0000 Subject: [squeak-dev] The Inbox: Tests-jar.462.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.462.mcz ==================== Summary ==================== Name: Tests-jar.462 Author: jar Time: 3 May 2021, 12:03:40.642808 pm UUID: b9dfb879-cfe4-ea46-96c4-fa620bd984c8 Ancestors: Tests-jar.461 Fix indentation of #doubleOuterResignalAsTest. I hope it's right this time :) =============== Diff against Tests-jar.461 =============== Item was changed: ----- Method: ExceptionTester>>doubleOuterResignalAsTest (in category 'tests') ----- doubleOuterResignalAsTest "ExceptionTester new doubleOuterResignalAsTest" [[self doSomething. MyResumableTestError signal. self doYetAnotherThing] on: MyResumableTestError + do: [:ex | ex outer. self doSomethingExceptional]. + self doSomethingElse] + on: MyResumableTestError + do: [:ex | ex resignalAs: MyTestNotification] - do: [:ex | ex outer. self doSomethingExceptional]. self doSomethingElse] - on: MyResumableTestError - do: [:ex | ex resignalAs: MyTestNotification] ! From m at jaromir.net Mon May 3 10:13:08 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 3 May 2021 05:13:08 -0500 (CDT) Subject: [squeak-dev] The Trunk: Kernel-nice.1394.mcz In-Reply-To: References: <1619962586071-0.post@n4.nabble.com> Message-ID: <1620036788988-0.post@n4.nabble.com> Hi Nicolas, Nicolas Cellier wrote > Indentation is a bit misleading, but the test is good. > Thanks for it! Yes, I struggled with the indentation :) There's a fix in the inbox now. None of the present tests actually checks where the execution continues after #return (explicit or implicit) so I couldn't plagiarize ;) I hope my indentation is right this time. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Mon May 3 11:52:05 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 11:52:05 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.125.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.125.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.125 Author: mt Time: 3 May 2021, 1:52:04.145757 pm UUID: 831195f6-e82e-1f4a-9a73-70b0e085459e Ancestors: FFI-Kernel-mt.124 Fixes a regression in the print-string for external functions. Adds #typeName to reduce some code duplication. =============== Diff against FFI-Kernel-mt.124 =============== Item was changed: ----- Method: ExternalFunction>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPut:$<; nextPutAll: self callingConventionString; nextPutAll:': '. { 'threaded' } with: { FFICallFlagThreaded } do: [:modifier :flag| (flags anyMask: flag) ifTrue: [aStream nextPutAll: modifier; space]]. + aStream nextPutAll: argTypes first typeName; space. - aStream print: argTypes first; space. self name == nil ifTrue:[aStream nextPutAll:'(*) '] ifFalse:[aStream print: self name asString; space]. aStream nextPut:$(. 2 to: argTypes size do:[:i| + aStream nextPutAll: (argTypes at: i) typeName. - aStream print: (argTypes at: i). i < argTypes size ifTrue:[aStream space]]. aStream nextPut:$). self module == nil ifFalse:[ aStream space; nextPutAll:'module: '; print: self module asString. ]. self errorCodeName == nil ifFalse:[ aStream space; nextPutAll:'error: '; nextPutAll: self errorCodeName. ]. aStream nextPut:$>! Item was changed: ----- Method: ExternalStructureType>>printOn: (in category 'printing') ----- printOn: aStream self isTypeAlias ifTrue: [ + aStream nextPutAll: self typeName. - aStream nextPutAll: referentClass name. aStream nextPutAll: '~>'; print: self originalType. self isEmpty ifTrue: [aStream nextPutAll: ' ???']. ^ self]. referentClass == nil ifTrue:[aStream nextPutAll: ''] ifFalse:[ super printOn: aStream. self isEmpty ifTrue: [aStream nextPutAll: ' { void }']].! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream + aStream nextPutAll: self typeName. - aStream nextPutAll: (referentClass ifNil: [self atomicTypeName] ifNotNil: [referentClass name]). - self isPointerType ifTrue: [aStream nextPut: $*]. aStream space; nextPut: $(; nextPutAll: self byteSize asString; space; nextPutAll: self byteAlignment asString; nextPut: $).! Item was added: + ----- Method: ExternalType>>typeName (in category 'accessing') ----- + typeName + + ^ String streamContents: [:stream | + stream nextPutAll: (referentClass + ifNil: [self atomicTypeName] + ifNotNil: [referentClass name]). + self isPointerType + ifTrue: [stream nextPut: $*]]! From m at jaromir.net Mon May 3 12:40:47 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 3 May 2021 07:40:47 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1619988190941-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> Message-ID: <1620045647256-0.post@n4.nabble.com> Actually, I guess the question can be reduced to: Is /[] on: Exception do: []/ only a shortcut for /[] on: Exception do: [:ex | ex return] / or are they two distinct structures? If the answer is yes, we might even write: handleSignal: exception "Sent to handler (on:do:) contexts only. Execute the handler action block" "just a marker, fail and execute the following" exception privHandlerContext: self contextTag. "set exception's handlerContext" self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed" [exception return: (self fireHandlerActionForSignal: exception)] ensure: [self reactivateHandler] "return from exception's handlerContext if not otherwise directed in the handler action block" ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Mon May 3 13:52:06 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 3 May 2021 08:52:06 -0500 (CDT) Subject: [squeak-dev] The Trunk: Kernel-nice.1394.mcz In-Reply-To: References: <1619962586071-0.post@n4.nabble.com> Message-ID: <1620049926319-0.post@n4.nabble.com> Hi Nicolas, >> If you approve the change, Exception>>resumeEvaluating will become >> obsolete >> and could be removed. >> > Sure, we should do so ASAP, less code = me happier :) I overlooked your use of #resumeEvaluating in ProgressInitiationException... so can't be removed. In that case #resumeEvaluating should probably incorporate the fix for #outer behavior as per #resumeUnchecked. resumeEvaluating: aBlock "Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer. The block is only evaluated after unwinding the stack." | ctxt | outerContext ifNil: [ signalContext returnEvaluating: aBlock ] ifNotNil: [ ctxt := outerContext. outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" --add----> handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" ctxt returnEvaluating: aBlock ]. To avoid code duplication it might make sense to just run #resumeUnchecked through #resumeEvaluating like this: resumeUnchecked: resumptionValue self resumeEvaluating: [resumptionValue] best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Mon May 3 14:54:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 14:54:42 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.22.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.22.mcz ==================== Summary ==================== Name: FFI-Tests-mt.22 Author: mt Time: 3 May 2021, 4:54:41.730479 pm UUID: a156622d-6212-3c45-9f7a-7c8017118210 Ancestors: FFI-Tests-mt.21 Big refactoring of FFI tests: - Adds message categories for FFITestLibrary - Replicates all tests in FFIPluginTests to also test invocation through library and construction as ExternalLibraryFunction. See FFIPluginConstrutedTests and FFIPluginLibraryTests. - Extracts tests about structures (and unions etc.) that do not need the test-plugin to ExternalStructureTests - In field definitions, replace all uses of "short/long/longlong" with "int16_t/int32_t/int64_t" for improved readability - Fixes the definitions that actually rely on c_long because they use "long" in the "sqFFITestFuncs.c" - Compiles instance-side methods in FFITestLibrary as needed, see FFIPluginLibraryTests >> #invoke:withArguments:. Note that, for simplicity, the new design of the FFIPluginTests hierarchy requires the class-side methods in FFITestLibrary to match the C function names. Arguments can be attached with "with:". See all implementors of #invoke:withArguments: to learn more. If you want to improve readability over those C names, use either method comments or the actual test selector. See #testUnsignedIntegerRange as an example. =============== Diff against FFI-Tests-mt.21 =============== Item was added: + TestCase subclass: #ExternalStructureTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! Item was added: + ----- Method: ExternalStructureTests>>test01AccessingUnion (in category 'tests') ----- + test01AccessingUnion + + | ufi | + ufi := FFITestUfi new. + ufi i1: 2. + self assert: 2 equals: ufi i1. + ufi f1: 1.0. + self assert: 1.0 equals: ufi f1. + self assert: 1.0 asIEEE32BitWord equals: ufi i1. + ufi i1: 2.0 asIEEE32BitWord. + self assert: 2.0 equals: ufi f1.! Item was added: + ----- Method: ExternalStructureTests>>test02AccessingStructure (in category 'tests') ----- + test02AccessingStructure + + | pt | + pt := FFITestPoint2 new. + pt x: 10; y: 20. + self assert: 10 equals: pt x. + self assert: 20 equals: pt y.! Item was added: + ----- Method: ExternalStructureTests>>test03AccessingExternalData (in category 'tests') ----- + test03AccessingExternalData + + | somePoints firstPoint | + somePoints := FFITestPoint2 allocate: 5. + self assert: 5 equals: somePoints size. + firstPoint := somePoints at: 1. + self assert: 0 at 0 equals: firstPoint asPoint. + firstPoint setX: 2 setY: 3. + self assert: 2 at 3 equals: firstPoint asPoint.! Item was added: + ----- Method: ExternalTypeTests>>testAtomicTypeNameByType (in category 'tests') ----- + testAtomicTypeNameByType + + AtomicTypeNames do: [:symbol | | typeName | + typeName := symbol. + self + assert: typeName + equals: (ExternalType typeNamed: typeName) typeName; + assert: typeName + equals: (AtomicTypes at: typeName) typeName. + typeName := (AtomicTypes at: symbol) asPointerType typeName. + self + assert: typeName + equals: (ExternalType typeNamed: typeName) typeName].! Item was added: + FFIPluginTests subclass: #FFIPluginConstructedTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! Item was added: + ----- Method: FFIPluginConstructedTests class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + ^ true! Item was added: + ----- Method: FFIPluginConstructedTests>>expectedFailures (in category 'failures') ----- + expectedFailures + "We can actually call that one function with 20 arguments. :-)" + + ^ super expectedFailures copyWithout: #testMixedDoublesAndLongsSum! Item was added: + ----- Method: FFIPluginConstructedTests>>invoke:withArguments: (in category 'support') ----- + invoke: functionName withArguments: someObjects + "Use primitive 117 to invoke the call, not 120." + + | prototype externalFunction | + prototype := (FFITestLibrary class >> (self lookupSelector: functionName numArgs: someObjects size)) externalLibraryFunction. + externalFunction := ExternalLibraryFunction + name: functionName module: prototype module + callType: prototype flags returnType: prototype argTypes first + argumentTypes: prototype argTypes allButFirst. + ^ externalFunction invokeWithArguments: someObjects! Item was added: + FFIPluginTests subclass: #FFIPluginLibraryTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! Item was added: + ----- Method: FFIPluginLibraryTests class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + ^ true! Item was added: + ----- Method: FFIPluginLibraryTests>>invoke:withArguments: (in category 'support') ----- + invoke: functionName withArguments: someObjects + "Use an instance of the library. Compile class-side methods to instance-side methods as needed." + + | selector library | + selector := self lookupSelector: functionName numArgs: someObjects size. + library := FFITestLibrary new. + + (library respondsTo: selector) ifFalse: [ | signature source prototype | + "1) Build method signature." + signature := String streamContents: [:s | | index | + index := 0. selector do: [:char | s nextPut: char. + char = $: ifTrue: [ index := index + 1. + s space; nextPutAll: 'arg'; nextPutAll: index asString; space]]]. + "2) Construct method source." + prototype := library class class compiledMethodAt: selector. + source := '{1}\ {2}\ \ {3}\ ^ self externalCallFailed' withCRs + format: { + signature. + '"This method was automatically generated. See {1}>>{2}"' + format: {prototype methodClass. prototype selector}. + prototype externalLibraryFunction copy + setModule: nil; printString }. + "3) Compile instance-side FFI call in library." + library class compile: source classified: '*autogenerated - primitives']. + + ^ library perform: selector withArguments: someObjects! Item was changed: TestCase subclass: #FFIPluginTests + instanceVariableNames: 'heapObject' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Tests'! !FFIPluginTests commentStamp: '' prior: 0! SUnitized tests for the FFI (mostly the plugin side)! Item was added: + ----- Method: FFIPluginTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + testIntAliasCallReturnIntAlias "return-type coercing failed" + testIntCallReturnIntAlias "return-type coercing failed" + testMixedDoublesAndLongsSum "more than 15 method args needed" + testSumStructSslf4 "some overflow issue, maybe expected")! Item was added: + ----- Method: FFIPluginTests>>invoke: (in category 'support') ----- + invoke: selector + + ^ self invoke: selector withArguments: #()! Item was added: + ----- Method: FFIPluginTests>>invoke:with: (in category 'support') ----- + invoke: selector with: arg1 + + ^ self invoke: selector withArguments: {arg1}! Item was added: + ----- Method: FFIPluginTests>>invoke:with:with: (in category 'support') ----- + invoke: selector with: arg1 with: arg2 + + ^ self invoke: selector withArguments: {arg1. arg2}! Item was added: + ----- Method: FFIPluginTests>>invoke:with:with:with: (in category 'support') ----- + invoke: selector with: arg1 with: arg2 with: arg3 + + ^ self invoke: selector withArguments: {arg1. arg2. arg3}! Item was added: + ----- Method: FFIPluginTests>>invoke:with:with:with:with: (in category 'support') ----- + invoke: selector with: arg1 with: arg2 with: arg3 with: arg4 + + ^ self invoke: selector withArguments: {arg1. arg2. arg3. arg4}! Item was added: + ----- Method: FFIPluginTests>>invoke:with:with:with:with:with: (in category 'support') ----- + invoke: selector with: arg1 with: arg2 with: arg3 with: arg4 with: arg5 + + ^ self invoke: selector withArguments: {arg1. arg2. arg3. arg4. arg5}! Item was added: + ----- Method: FFIPluginTests>>invoke:withArguments: (in category 'support') ----- + invoke: functionName withArguments: someObjects + + ^ FFITestLibrary + perform: (self lookupSelector: functionName numArgs: someObjects size) + withArguments: someObjects! Item was added: + ----- Method: FFIPluginTests>>lookupSelector:numArgs: (in category 'support') ----- + lookupSelector: functionName numArgs: numArgs + + ^ Symbol lookup: ( + numArgs > 0 + ifFalse: [functionName] + ifTrue: [ + functionName, ':' + , (Array new: (numArgs min: 15) - 1 withAll: 'with:') join])! Item was added: + ----- Method: FFIPluginTests>>tearDown (in category 'running') ----- + tearDown + + heapObject ifNotNil: [heapObject free].! Item was added: + ----- Method: FFIPluginTests>>test4IntSum (in category 'tests - atomics') ----- + test4IntSum + + | result n interval | + n := 4. + interval := 1 - n * n to: n * n by: 2 * n + 1. + result := self invoke: 'ffiTest4IntSum' withArguments: interval asArray. + self assert: interval sum equals: result! Item was changed: + ----- Method: FFIPluginTests>>test8IntSum (in category 'tests - atomics') ----- - ----- Method: FFIPluginTests>>test8IntSum (in category 'tests') ----- test8IntSum + + | result n interval | + n := 8. - "Test using generic FFI spec" - | result meth n interval | - meth := ExternalLibraryFunction - name:'ffiTest8IntSum' module: FFITestLibrary moduleName - callType: 0 returnType: ExternalType long - argumentTypes: (Array new: (n := 8) withAll: ExternalType long). interval := 1 - n * n to: n * n by: 2 * n + 1. + result := self invoke: 'ffiTest8IntSum' withArguments: interval asArray. - result := meth invokeWithArguments: interval asArray. self assert: interval sum equals: result! Item was changed: + ----- Method: FFIPluginTests>>test8LongLongSum (in category 'tests - atomics') ----- - ----- Method: FFIPluginTests>>test8LongLongSum (in category 'tests') ----- test8LongLongSum + + | result n interval | + n := 8. - "Test using generic FFI spec" - | result meth n interval | - meth := ExternalLibraryFunction - name:'ffiTest8LongLongSum' module: FFITestLibrary moduleName - callType: 0 returnType: ExternalType signedLongLong - argumentTypes: (Array new: (n := 8) withAll: ExternalType signedLongLong). interval := 1 - n * n << 32 + (1 - n * n) to: n * n - n << 32 + (3 * n * n) by: 2 * n << 32 + (3 * n). + result := self invoke: 'ffiTest8LongLongSum' withArguments: interval asArray. - result := meth invokeWithArguments: interval asArray. self assert: interval sum equals: result! Item was added: + ----- Method: FFIPluginTests>>test8LongSum (in category 'tests - atomics') ----- + test8LongSum + + | result n interval | + n := 8. + interval := 1 - n * n to: n * n by: 2 * n + 1. + result := self invoke: 'ffiTest8longSum' withArguments: interval asArray. + self assert: interval sum equals: result! Item was removed: - ----- Method: FFIPluginTests>>testAccessingUnion (in category 'tests - union') ----- - testAccessingUnion - | ufi | - ufi := FFITestUfi new. - ufi i1: 2. - self assert: 2 equals: ufi i1. - ufi f1: 1.0. - self assert: 1.0 equals: ufi f1. - self assert: 1.0 asIEEE32BitWord equals: ufi i1. - ufi i1: 2.0 asIEEE32BitWord. - self assert: 2.0 equals: ufi f1.! Item was added: + ----- Method: FFIPluginTests>>testBoolsToInts (in category 'tests - other') ----- + testBoolsToInts + + | result | + result := FFITestLibrary ffiTestBool: true with: false with: true with: false. + self assert: result. + result := FFITestLibrary ffiTestBool: -1 with: 1 with: 0 with: 0. + self deny: result. + result := FFITestLibrary ffiTestBool: false with: false with: true with: true. + self deny: result.! Item was added: + ----- Method: FFIPluginTests>>testChars (in category 'tests - atomics') ----- + testChars + + | result | + result := self invoke: 'ffiTestChars' with: $A with: 65 with: 65.0 with: true. + self assert: result isCharacter. + self assert: result asciiValue = 130.! Item was removed: - ----- Method: FFIPluginTests>>testConstructedCharCall (in category 'tests') ----- - testConstructedCharCall - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiTestChars' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType char - argumentTypes: (Array new: 4 withAll: ExternalType char). - result := meth invokeWith: $A with: 65 with: 65.0 with: true. - self assert: result isCharacter. - self assert: 130 equals: result asciiValue! Item was removed: - ----- Method: FFIPluginTests>>testConstructedDoubleCall (in category 'tests') ----- - testConstructedDoubleCall - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiTestDoubles' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType double - argumentTypes: (Array new: 2 withAll: ExternalType double). - result := meth invokeWithArguments: (Array with: 41 with: true). - self assert: 42.0 equals: result! Item was removed: - ----- Method: FFIPluginTests>>testConstructedFloatCall (in category 'tests') ----- - testConstructedFloatCall - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiTestFloats' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType float - argumentTypes: (Array new: 2 withAll: ExternalType float). - result := meth invokeWith: $A with: 65.0. - self assert: 130.0 equals: result! Item was removed: - ----- Method: FFIPluginTests>>testConstructedIntCall (in category 'tests') ----- - testConstructedIntCall - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiTestInts' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType signedLong - argumentTypes: (Array new: 4 withAll: ExternalType signedLong). - result := meth invokeWith: $A with: 65 with: 65.0 with: true. - self assert: 130 equals: result! Item was removed: - ----- Method: FFIPluginTests>>testConstructedPrintString (in category 'tests') ----- - testConstructedPrintString - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiPrintString' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType string - argumentTypes: (Array with: ExternalType string). - result := meth invokeWith:'Hello World!!'. - self assert: 'Hello World!!' equals: result! Item was removed: - ----- Method: FFIPluginTests>>testConstructedShortCall (in category 'tests') ----- - testConstructedShortCall - "Test using generic FFI spec" - | result meth | - meth := ExternalLibraryFunction - name:'ffiTestShorts' module: FFITestLibrary moduleName - callType: ExternalFunction callTypeCDecl returnType: ExternalType short - argumentTypes: (Array new: 4 withAll: ExternalType short). - result := meth invokeWithArguments: (Array with: $A with: 65 with: 65.0 with: true). - self assert: 130 equals: result! Item was added: + ----- Method: FFIPluginTests>>testDoubles (in category 'tests - atomics') ----- + testDoubles + + | result | + result := self invoke: 'ffiTestDoubles' with: $A with: 65.0. + self assert: 130.0 equals: result. + result := self invoke: 'ffiTestDoubles' with: 41 with: true. + self assert: 42.0 equals: result.! Item was added: + ----- Method: FFIPluginTests>>testDoubles14 (in category 'tests - atomics') ----- + testDoubles14 + + | result n args | + n := 14. + args := (123.456789 to: 3.210987 * 13 + 123.456789 by: 3.210987) asArray first: n. + result := self invoke: 'ffiTestDoubles14' withArguments: args. + self assert: args sum equals: result! Item was added: + ----- Method: FFIPluginTests>>testDoubles9 (in category 'tests - atomics') ----- + testDoubles9 + + | result | + result := self invoke: 'ffiTestDoubles9' withArguments: #(1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0). + self assert: 45.0 equals: result! Item was added: + ----- Method: FFIPluginTests>>testFloats (in category 'tests - atomics') ----- + testFloats + + | result | + result :=self invoke: 'ffiTestFloats' with: $A with: 65.0. + self assert: 130.0 equals: result.! Item was added: + ----- Method: FFIPluginTests>>testFloats13 (in category 'tests - atomics') ----- + testFloats13 + + | result n args | + n := 13. + args := (123.456 to: 3.21 * 13 + 123.456 by: 3.21) asArray first: n. + result := self invoke: 'ffiTestFloats13' withArguments: args. + self assert: (result between: args sum - 0.0005 and: args sum + 0.0005)! Item was removed: - ----- Method: FFIPluginTests>>testFloats13Sum (in category 'tests') ----- - testFloats13Sum - "Test using generic FFI spec" - | result meth n args | - meth := ExternalLibraryFunction - name:'ffiTestFloats13' module: FFITestLibrary moduleName - callType: 0 returnType: ExternalType float - argumentTypes: (Array new: (n := 13) withAll: ExternalType float). - args := (123.456 to: 3.21 * 13 + 123.456 by: 3.21) asArray first: 13. - result := meth invokeWithArguments: args. - self assert: (result between: args sum - 0.0005 and: args sum + 0.0005)! Item was added: + ----- Method: FFIPluginTests>>testFloats14 (in category 'tests - atomics') ----- + testFloats14 + + | result n args | + n := 14. + args := (123.456 to: 3.21 * 13 + 123.456 by: 3.21) asArray first: n. + result := self invoke: 'ffiTestFloats14' withArguments: args. + self assert: (result between: args sum - 0.0005 and: args sum + 0.0005)! Item was added: + ----- Method: FFIPluginTests>>testFloats7 (in category 'tests - atomics') ----- + testFloats7 + + | result n args | + n := 7. + args := (123.456 to: 3.21 * 13 + 123.456 by: 3.21) asArray first: n. + result := self invoke: 'ffiTestFloats7' withArguments: args. + self assert: (result between: args sum - 0.0005 and: args sum + 0.0005)! Item was removed: - ----- Method: FFIPluginTests>>testGenericBoolCall (in category 'tests') ----- - testGenericBoolCall - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestBool: true with: false with: true with: false. - self assert: result.! Item was removed: - ----- Method: FFIPluginTests>>testGenericBoolCall2 (in category 'tests') ----- - testGenericBoolCall2 - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestBool: false with: false with: true with: true. - self deny: result.! Item was removed: - ----- Method: FFIPluginTests>>testGenericBoolCall3 (in category 'tests') ----- - testGenericBoolCall3 - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestBool: -1 with: 1 with: 0 with: 0. - self deny: result.! Item was removed: - ----- Method: FFIPluginTests>>testGenericCharCall (in category 'tests') ----- - testGenericCharCall - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestChar: $A with: 65 with: 65.0 with: true. - self assert: result isCharacter. - self assert: result asciiValue = 130.! Item was removed: - ----- Method: FFIPluginTests>>testGenericDoubleCall (in category 'tests') ----- - testGenericDoubleCall - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestDoubles: $A with: 65.0. - self assert: result = 130.0! Item was removed: - ----- Method: FFIPluginTests>>testGenericDoubleCall2 (in category 'tests') ----- - testGenericDoubleCall2 - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestDoubles9: 1.0 d: 2.0 d: 3.0 d: 4.0 d: 5.0 d: 6.0 d: 7.0 d: 8.0 d: 9.0. - self assert: result = 45.0! Item was removed: - ----- Method: FFIPluginTests>>testGenericFloatCall (in category 'tests') ----- - testGenericFloatCall - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestFloats: $A with: 65.0. - self assert: result = 130.0! Item was removed: - ----- Method: FFIPluginTests>>testGenericIntCall (in category 'tests') ----- - testGenericIntCall - "Test using generic FFI spec" - | result | - self flag: #ffiLongVsInt. - result := FFITestLibrary ffiTestInt: $A with: 65 with: 65.0 with: true. - self assert: result = 130.! Item was removed: - ----- Method: FFIPluginTests>>testGenericLongCall (in category 'tests') ----- - testGenericLongCall - "Test using generic FFI spec" - | result | - self flag: #ffiLongVsInt. - result := FFITestLibrary ffiTestLong: $A with: 65 with: 65.0 with: true. - self assert: result = 130.! Item was removed: - ----- Method: FFIPluginTests>>testGenericMixedDoublesIntAndStruct (in category 'tests') ----- - testGenericMixedDoublesIntAndStruct - "Test using generic FFI spec" - | result i struct | - i := 42. - struct := FFITestPoint4 new. - struct x: 1. struct y: 2. struct z: 3. struct w: 4. - result := FFITestLibrary ffiTestMixedDoublesIntAndStruct: 1.0 d: 2.0 d: 3.0 d: 4.0 d: 5.0 d: 6.0 d: 7.0 d: 8.0 d: 9.0 i: 42 s: struct. - self assert: (result closeTo: 45.0 + 42 + 10) ! Item was removed: - ----- Method: FFIPluginTests>>testGenericMixedFloatsAndDouble (in category 'tests') ----- - testGenericMixedFloatsAndDouble - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestMixedFloatsAndDouble: 1.2 with: 3.4 with: 5.6 with: 7.8. - self assert: (result closeTo: 1.2 + 3.4 + 5.6 + 7.8) ! Item was removed: - ----- Method: FFIPluginTests>>testGenericPrintString (in category 'tests') ----- - testGenericPrintString - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiPrintString:'Hello World!!'. - self assert: result = 'Hello World!!'.! Item was removed: - ----- Method: FFIPluginTests>>testGenericShortCall (in category 'tests') ----- - testGenericShortCall - "Test using generic FFI spec" - | result | - result := FFITestLibrary ffiTestShort: $A with: 65 with: 65.0 with: true. - self assert: result = 130.! Item was changed: ----- Method: FFIPluginTests>>testIntAliasCallReturnIntAlias (in category 'tests - type alias') ----- testIntAliasCallReturnIntAlias | result | result := FFITestLibrary + ffiTestIntAlias4IntAliasSum: (FFITestIntAlias fromHandle: 1) - ffiTestIntAlias4IntSum: (FFITestIntAlias fromHandle: 1) with: (FFITestIntAlias fromHandle: 2) with: (FFITestIntAlias fromHandle: 3) with: (FFITestIntAlias fromHandle: 4). self assert: (result isKindOf: FFITestIntAlias); assert: 10 equals: result value.! Item was added: + ----- Method: FFIPluginTests>>testInts (in category 'tests - atomics') ----- + testInts + + | result | + result := self invoke: 'ffiTestInts' with: $A with: 65 with: 65.0 with: true. + self assert: $A asInteger + 65 equals: result. + ! Item was added: + ----- Method: FFIPluginTests>>testInts8 (in category 'tests - other') ----- + testInts8 + + | result n interval | + n := 8. + interval := 1 - n * n to: n * n by: 2 * n + 1. + result := self invoke: 'ffiTestInts8' withArguments: interval asArray. + self assert: 42 equals: result! Item was removed: - ----- Method: FFIPluginTests>>testLibraryCharCall (in category 'tests - library') ----- - testLibraryCharCall - "Test using call from ExternalLibrary" - | result | - result := FFITestLibrary new ffiTestChar: $A with: 65 with: 65.0 with: true. - self assert: result isCharacter. - self assert: result asciiValue = 130.! Item was removed: - ----- Method: FFIPluginTests>>testLibraryDoubleCall (in category 'tests - library') ----- - testLibraryDoubleCall - "Test using call from ExternalLibrary" - | result | - result := FFITestLibrary new ffiTestDoubles: $A with: 65.0. - self assert: result = 130.0! Item was removed: - ----- Method: FFIPluginTests>>testLibraryFloatCall (in category 'tests - library') ----- - testLibraryFloatCall - "Test using call from ExternalLibrary" - | result | - result := FFITestLibrary new ffiTestFloats: $A with: 65.0. - self assert: result = 130.0! Item was removed: - ----- Method: FFIPluginTests>>testLibraryIntCall (in category 'tests - library') ----- - testLibraryIntCall - "Test using call from ExternalLibrary" - | result | - result := FFITestLibrary new ffiTestInt: $A with: 65 with: 65.0 with: true. - self assert: result = 130.! Item was removed: - ----- Method: FFIPluginTests>>testLibraryPrintString (in category 'tests - library') ----- - testLibraryPrintString - "Test using call from ExternalLibrary" - | result | - result := FFITestLibrary new ffiPrintString:'Hello World!!'. - self assert: result = 'Hello World!!'.! Item was added: + ----- Method: FFIPluginTests>>testLongLong (in category 'tests - atomics') ----- + testLongLong + "Test passing and returning longlongs" + | long1 long2 long3 | + long1 := 16r123456789012. + long2 := (-1 << 31). + long3 := self invoke: 'ffiTestLongLong' with: long1 with: long2. + self assert: (long1 + long2) equals: long3.! Item was added: + ----- Method: FFIPluginTests>>testLongLong8 (in category 'tests - atomics') ----- + testLongLong8 + + | long1 long2 bytes result | + bytes := (1 to: 8) asArray. + long1 := 16r123456789012. + long2 := (-1 << 31). + result := self invoke: 'ffiTestLongLong8' withArguments: bytes, { long1 . long2 }. + self assert: (bytes sum + long1 + long2) equals: result.! Item was added: + ----- Method: FFIPluginTests>>testLongLong8a1 (in category 'tests - atomics') ----- + testLongLong8a1 + + | long1 long2 bytes result | + bytes := (1 to: 9) asArray. + long1 := 16r123456789012. + long2 := (-1 << 31). + result := self invoke: 'ffiTestLongLong8a1' withArguments: bytes, { long1 . long2 }. + self assert: (bytes sum + long1 + long2) equals: result.! Item was added: + ----- Method: FFIPluginTests>>testLongLong8a2 (in category 'tests - atomics') ----- + testLongLong8a2 + + | long1 long2 bytes result | + bytes := (1 to: 10) asArray. + long1 := 16r123456789012. + long2 := (-1 << 31). + result := self invoke: 'ffiTestLongLong8a2' withArguments: bytes, { long1 . long2 }. + self assert: (bytes sum + long1 + long2) equals: result.! Item was changed: + ----- Method: FFIPluginTests>>testLongLongA1 (in category 'tests - atomics') ----- - ----- Method: FFIPluginTests>>testLongLongA1 (in category 'tests') ----- testLongLongA1 "Test passing a char and two longlongs." + + | byte long1 long2 result | - | byte long1 long2 long3 | byte := 42. long1 := 16r123456789012. long2 := (-1 << 31). + result := self invoke: 'ffiTestLongLonga1' with: byte with: long1 with: long2. + self assert: (byte + long1 + long2) equals: result.! - long3 := FFITestLibrary ffiTestLongLongA1: byte with: long1 with: long2. - self assert: long3 = (byte + long1 + long2)! Item was added: + ----- Method: FFIPluginTests>>testLongLongA2 (in category 'tests - atomics') ----- + testLongLongA2 + + | byte1 byte2 long1 long2 result | + byte1 := 3. + byte2 := 4. + long1 := 16r123456789012. + long2 := (-1 << 31). + result := self invoke: 'ffiTestLongLonga2' with: byte1 with: byte2 with: long1 with: long2. + self assert: (byte1 + byte2 + long1 + long2) equals: result.! Item was changed: + ----- Method: FFIPluginTests>>testLongLongA3 (in category 'tests - atomics') ----- - ----- Method: FFIPluginTests>>testLongLongA3 (in category 'tests') ----- testLongLongA3 "Test passing a char, a longlong, and another char." + | byte1 long1 byte2 result | - | byte1 long1 byte2 long2 | byte1 := 3. long1 := 16r123456789012. byte2 := 4. + result := self invoke: 'ffiTestLongLonga3' with: byte1 with: long1 with: byte2. + self assert: (byte1 + long1 + byte2) equals: result.! - long2 := FFITestLibrary ffiTestLongLongA3: byte1 with: long1 with: byte2. - self assert: long2 = (byte1 + long1 + byte2)! Item was removed: - ----- Method: FFIPluginTests>>testLongLongs (in category 'tests') ----- - testLongLongs - "Test passing and returning longlongs" - | long1 long2 long3 | - long1 := 16r123456789012. - long2 := (-1 << 31). - long3 := FFITestLibrary ffiTestLongLong: long1 with: long2. - self assert: long3 = (long1 + long2)! Item was added: + ----- Method: FFIPluginTests>>testLongLongs8 (in category 'tests - other') ----- + testLongLongs8 + + | result n interval | + n := 8. + interval := 1 - n * n << 32 + (1 - n * n) to: n * n - n << 32 + (3 * n * n) by: 2 * n << 32 + (3 * n). + result := self invoke: 'ffiTestLongLongs8' withArguments: interval asArray. + self assert: 42 equals: result! Item was changed: + ----- Method: FFIPluginTests>>testMixedDoublesAndLongsSum (in category 'tests - atomics') ----- - ----- Method: FFIPluginTests>>testMixedDoublesAndLongsSum (in category 'tests') ----- testMixedDoublesAndLongsSum + + | result n args | + n := 20. - "Test using generic FFI spec" - | result meth n args | - meth := ExternalLibraryFunction - name:'ffiTestMixedDoublesAndLongs' module: FFITestLibrary moduleName - callType: 0 returnType: ExternalType double - argumentTypes: ((1 to: (n := 20)) collect:[:i| i odd ifTrue: [ExternalType double] ifFalse: [ExternalType c_long]]). args := (1 to: n) collect: [:i| i odd ifTrue: [(i // 2) odd ifTrue: [123.456 * (10 raisedTo: i)] ifFalse: [-654.321 * (10 raisedTo: i)]] ifFalse: [(i // 2) odd ifTrue: [54321 * i] ifFalse: [-54321 * i]]]. + result := self invoke: 'ffiTestMixedDoublesAndLongs' withArguments: args asArray. - result := meth invokeWithArguments: args asArray. self assert: args sum equals: result! Item was added: + ----- Method: FFIPluginTests>>testMixedDoublesIntAndStruct (in category 'tests - atomics') ----- + testMixedDoublesIntAndStruct + + | result i struct | + i := 42. + struct := FFITestPoint4 new. + struct x: 1. struct y: 2. struct z: 3. struct w: 4. + result := self + invoke: 'ffiTestMixedDoublesIntAndStruct' + withArguments: { 1.0 . 2.0 . 3.0 . 4.0 . 5.0 . 6.0 . 7.0 . 8.0 . 9.0 . 42 . struct }. + self assert: (result closeTo: 45.0 + 42 + 10).! Item was added: + ----- Method: FFIPluginTests>>testMixedFloatsAndDouble (in category 'tests - atomics') ----- + testMixedFloatsAndDouble + + | result | + result := self invoke: 'ffiTestMixedFloatsAndDouble' with: 1.2 with: 3.4 with: 5.6 with: 7.8. + self assert: (result closeTo: 1.2 + 3.4 + 5.6 + 7.8) ! Item was changed: ----- Method: FFIPluginTests>>testMixedIntAndStruct (in category 'tests - structure') ----- testMixedIntAndStruct "Test passing an integer and two structures." | i1 pt1 pt2 result | i1 := 42. pt1 := FFITestPoint2 new. pt1 x: 3. pt1 y: 4. pt2 := FFITestPoint2 new. pt2 x: 5. pt2 y: 6. + result := self invoke: 'ffiTestMixedIntAndStruct' with: i1 with: pt1 with: pt2. + self assert: 60 equals: result.! - result := FFITestLibrary ffiTestMixedIntAndStruct: i1 with: pt1 with: pt2. - self assert: result = 60.! Item was changed: ----- Method: FFIPluginTests>>testMixedIntAndStruct2 (in category 'tests - structure') ----- testMixedIntAndStruct2 "Test passing an integer and two structures." | i1 pt1 result | i1 := 42. pt1 := FFITestPoint4 new. pt1 x: 3. pt1 y: 4. pt1 z: 5. pt1 w: 6. + result := self invoke: 'ffiTestMixedIntAndStruct2' with: i1 with: pt1. + self assert: 60 equals: result.! - result := FFITestLibrary ffiTestMixedIntAndStruct2: i1 with: pt1. - self assert: result = 60.! Item was changed: ----- Method: FFIPluginTests>>testMixedIntAndStruct3 (in category 'tests - structure') ----- testMixedIntAndStruct3 "Test passing an integer and a small structure." | i1 pt1 result | i1 := 42. pt1 := FFISmallStruct1 new. pt1 x: 3. pt1 y: 4. + result := self invoke: 'ffiTestMixedIntAndStruct3' with: i1 with: pt1. + self assert: 49 equals: result.! - result := FFITestLibrary ffiTestMixedIntAndStruct3: i1 with: pt1. - self assert: result = 49! Item was changed: ----- Method: FFIPluginTests>>testPoint2 (in category 'tests - structure') ----- testPoint2 "Test passing and returning up of structures >32bit and <= 64 bit" | pt1 pt2 pt3 | pt1 := FFITestPoint2 new. pt1 x: 1. pt1 y: 2. pt2 := FFITestPoint2 new. pt2 x: 3. pt2 y: 4. + pt3 := self invoke: 'ffiTestStruct64' with: pt1 with: pt2. - pt3 := FFITestLibrary ffiTestPoint2: pt1 with: pt2. self assert: pt3 x = 4. self assert: pt3 y = 6.! Item was changed: ----- Method: FFIPluginTests>>testPoint4 (in category 'tests - structure') ----- testPoint4 "Test passing and returning up of structures > 64 bit" | pt1 pt2 pt3 | pt1 := FFITestPoint4 new. pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. pt2 := FFITestPoint4 new. pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := self invoke: 'ffiTestStructBig' with: pt1 with: pt2. - pt3 := FFITestLibrary ffiTestPoint4: pt1 with: pt2. self assert: pt3 x = 6. self assert: pt3 y = 8. self assert: pt3 z = 10. self assert: pt3 w = 12.! Item was added: + ----- Method: FFIPluginTests>>testPoint4Bigger (in category 'tests - structure') ----- + testPoint4Bigger + "Test passing and returning up of structures > 64 bit" + | pt1 pt2 pt3 | + pt1 := FFITestPoint4 new. + pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. + pt2 := FFITestPoint4 new. + pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := self invoke: 'ffiTestStructBigger' with: pt1 with: pt2. + self assert: pt3 x equals: pt1 x. + self assert: pt3 y equals: pt1 y. + self assert: pt3 z equals: pt1 z. + self assert: pt3 w equals: pt1 w. + self assert: pt3 r equals: pt2 x. + self assert: pt3 s equals: pt2 y. + self assert: pt3 t equals: pt2 z. + self assert: pt3 u equals: pt2 w. + ! Item was changed: ----- Method: FFIPluginTests>>testPointers (in category 'tests - structure') ----- testPointers "Test passing and returning of pointers to structs" | pt1 pt2 pt3 | pt1 := FFITestPoint4 new. pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. pt2 := FFITestPoint4 new. pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := heapObject := self invoke: 'ffiTestPointers' with: pt1 with: pt2. - pt3 := FFITestLibrary ffiTestPointers: pt1 with: pt2. self assert: pt3 x = 6. self assert: pt3 y = 8. self assert: pt3 z = 10. self assert: pt3 w = 12.! Item was added: + ----- Method: FFIPluginTests>>testPrintString (in category 'tests - other') ----- + testPrintString + + | result | + result := self invoke: 'ffiPrintString' with: 'Hello World!!'. + self assert: result = 'Hello World!!'.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructPassingUnionUfdUdSi2 (in category 'tests - union') ----- testReturnStructPassingUnionUfdUdSi2 "Test returning struct made from 2 unions" | ufd udSi2 sUfdUdSi2 | + ufd := self invoke: 'ffiTestInitUfd_d' with: Float pi. + udSi2 := self invoke: 'ffiTestInitUdSi2_ii' with: 1 with: 2. + sUfdUdSi2 := self invoke: 'ffiTestInitSUfdUdSi2' with: ufd with: udSi2. - ufd := FFITestLibrary ffiTestInitUfdWithDouble: Float pi. - udSi2 := FFITestLibrary ffiTestInitUdSi2WithInt: 1 int: 2. - sUfdUdSi2 := FFITestLibrary ffiTestInitSUfd: ufd udSi2: udSi2. self assert: Float pi equals: sUfdUdSi2 ufd1 d1. self assert: 1 equals: sUfdUdSi2 udSii2 sii1 i1. self assert: 2 equals: sUfdUdSi2 udSii2 sii1 i2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructPassingUnionUfdUfi (in category 'tests - union') ----- testReturnStructPassingUnionUfdUfi "Test returning struct made from 2 unions" | ufd ufi sUfdUfi | + ufd := self invoke: 'ffiTestInitUfd_d' with: Float pi. + ufi := self invoke: 'ffiTestInitUfi_i' with: 1. + sUfdUfi := self invoke: 'ffiTestInitSUfdUfi' with: ufd with: ufi. - ufd := FFITestLibrary ffiTestInitUfdWithDouble: Float pi. - ufi := FFITestLibrary ffiTestInitUfiWithInt: 1. - sUfdUfi := FFITestLibrary ffiTestInitSUfd: ufd ufi: ufi. self assert: Float pi equals: sUfdUfi ufd1 d1. self assert: 1 equals: sUfdUfi ufi2 i1.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSSdi5 (in category 'tests - structure') ----- testReturnStructSSdi5 "Test returning struct with five struct double int (64 + 32 bits)" | ssdi5 | + ssdi5 := self invoke: 'ffiTestReturnSSdi5'. - ssdi5 := FFITestLibrary ffiTestReturnSSdi5. self assert: ssdi5 sdi1 d1 = 1.0. self assert: ssdi5 sdi2 d1 = 2.0. self assert: ssdi5 sdi3 d1 = 3.0. self assert: ssdi5 sdi4 d1 = 4.0. self assert: ssdi5 sdi5 d1 = 5.0. self assert: ssdi5 sdi1 i2 = 1. self assert: ssdi5 sdi2 i2 = 2. self assert: ssdi5 sdi3 i2 = 3. self assert: ssdi5 sdi4 i2 = 4. self assert: ssdi5 sdi5 i2 = 5.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSd2 (in category 'tests - structure') ----- testReturnStructSd2 "Test returning struct with two double" | sd2 | + sd2 := self invoke: 'ffiTestReturnSd2'. - sd2 := FFITestLibrary ffiTestReturnSd2. self assert: sd2 d1 = 1.0. self assert: sd2 d2 = 2.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSdi (in category 'tests - structure') ----- testReturnStructSdi "Test returning struct double int (64 + 32 bits)" | sdi | + sdi := self invoke: 'ffiTestReturnSdi'. - sdi := FFITestLibrary ffiTestReturnSdi. self assert: sdi d1 = 1.0. self assert: sdi i2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSf2 (in category 'tests - structure') ----- testReturnStructSf2 "Test returning struct with two float" | sf2 | + sf2 := self invoke: 'ffiTestReturnSf2'. - sf2 := FFITestLibrary ffiTestReturnSf2. self assert: sf2 f1 = 1.0. self assert: sf2 f2 = 2.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSf2d (in category 'tests - structure') ----- testReturnStructSf2d "Test returning struct with two float one double" | sf2d | + sf2d := self invoke: 'ffiTestReturnSf2d'. - sf2d := FFITestLibrary ffiTestReturnSf2d. self assert: sf2d f1 = 1.0. self assert: sf2d f2 = 2.0. self assert: sf2d d3 = 3.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSf4 (in category 'tests - structure') ----- testReturnStructSf4 "Test returning struct with four float" | sf4 | + sf4 := self invoke: 'ffiTestReturnSf4'. - sf4 := FFITestLibrary ffiTestReturnSf4. self assert: sf4 f1 = 1.0. self assert: sf4 f2 = 2.0. self assert: sf4 f3 = 3.0. self assert: sf4 f4 = 4.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSfdf (in category 'tests - structure') ----- testReturnStructSfdf "Test returning struct with float double float" | sfdf | + sfdf := self invoke: 'ffiTestReturnSfdf'. - sfdf := FFITestLibrary ffiTestReturnSfdf. self assert: sfdf f1 = 1.0. self assert: sfdf d2 = 2.0. self assert: sfdf f3 = 3.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSfi (in category 'tests - structure') ----- testReturnStructSfi "Test returning struct with float int (32 + 32 bits)" | sfi | + sfi := self invoke: 'ffiTestReturnSfi'. - sfi := FFITestLibrary ffiTestReturnSfi. self assert: sfi f1 = 1.0. self assert: sfi i2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSi2 (in category 'tests - structure') ----- testReturnStructSi2 "Test returning struct with two int (32 bits)" | si2 | + si2 := self invoke: 'ffiTestReturnSi2'. - si2 := FFITestLibrary ffiTestReturnSi2. self assert: si2 i1 = 1. self assert: si2 i2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSl2 (in category 'tests - structure') ----- testReturnStructSl2 "Test returning struct with two long long int (64 bits)" | sl2 | + sl2 := self invoke: 'ffiTestReturnSl2'. - sl2 := FFITestLibrary ffiTestReturnSl2. self assert: sl2 l1 = 1. self assert: sl2 l2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSs2 (in category 'tests - structure') ----- testReturnStructSs2 "Test returning struct with two short int (16 bits)" | ss2 | + ss2 := self invoke: 'ffiTestReturnSs2'. - ss2 := FFITestLibrary ffiTestReturnSs2. self assert: ss2 s1 = 1. self assert: ss2 s2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSs2i (in category 'tests - structure') ----- testReturnStructSs2i "Test returning struct with two short int (16 bits) one int (32 bits)" | ss2i | + ss2i := self invoke: 'ffiTestReturnSs2i'. - ss2i := FFITestLibrary ffiTestReturnSs2i. self assert: ss2i s1 = 1. self assert: ss2i s2 = 2. self assert: ss2i i3 = 3.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSs4 (in category 'tests - structure') ----- testReturnStructSs4 "Test returning struct with four short int (16 bits)" | ss4 | + ss4 := self invoke: 'ffiTestReturnSs4'. - ss4 := FFITestLibrary ffiTestReturnSs4. self assert: ss4 s1 = 1. self assert: ss4 s2 = 2. self assert: ss4 s3 = 3. self assert: ss4 s4 = 4.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsSsf (in category 'tests - structure') ----- testReturnStructSsSsf "Test returning struct with short and sub structure short-float" | ssSsf | + ssSsf := self invoke: 'ffiTestReturnSsSsf'. - ssSsf := FFITestLibrary ffiTestReturnSsSsf. self assert: ssSsf s1 = 1. self assert: ssSsf ssf2 s1 = 2. self assert: ssSsf ssf2 f2 = 3.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsSsi (in category 'tests - structure') ----- testReturnStructSsSsi "Test returning struct with short and sub structure short-int" | ssSsi | + ssSsi := self invoke: 'ffiTestReturnSsSsi'. - ssSsi := FFITestLibrary ffiTestReturnSsSsi. self assert: ssSsi s1 = 1. self assert: ssSsi ssi2 s1 = 2. self assert: ssSsi ssi2 i2 = 3.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsf (in category 'tests - structure') ----- testReturnStructSsf "Test returning struct with short float (16 + 32 bits)" | ssf | + ssf := self invoke: 'ffiTestReturnSsf'. - ssf := FFITestLibrary ffiTestReturnSsf. self assert: ssf s1 = 1. self assert: ssf f2 = 2.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsi (in category 'tests - structure') ----- testReturnStructSsi "Test returning struct with short int (16 + 32 bits)" | ssi | + ssi := self invoke: 'ffiTestReturnSsi'. - ssi := FFITestLibrary ffiTestReturnSsi. self assert: ssi s1 = 1. self assert: ssi i2 = 2.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsis (in category 'tests - structure') ----- testReturnStructSsis "Test returning struct with short int short (16 + 32 + 16 bits)" | ssis | + ssis := self invoke: 'ffiTestReturnSsis'. - ssis := FFITestLibrary ffiTestReturnSsis. self assert: ssis s1 = 1. self assert: ssis i2 = 2. self assert: ssis s3 = 3.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSslf (in category 'tests - structure') ----- testReturnStructSslf "Test returning struct with short longlong float (16 + 64 + 32 bits)" | sslf | + sslf := self invoke: 'ffiTestReturnSslf'. - sslf := FFITestLibrary ffiTestReturnSslf. self assert: sslf s1 = 1. self assert: sslf l2 = 2. self assert: sslf f3 = 3.0.! Item was changed: ----- Method: FFIPluginTests>>testReturnStructSsls (in category 'tests - structure') ----- testReturnStructSsls "Test returning struct with short longlong short (16 + 64 + 16 bits)" | ssls | + ssls := self invoke: 'ffiTestReturnSsls'. - ssls := FFITestLibrary ffiTestReturnSsls. self assert: ssls s1 = 1. self assert: ssls l2 = 2. self assert: ssls s3 = 3.! Item was changed: ----- Method: FFIPluginTests>>testReturnUnionUdSi2 (in category 'tests - union') ----- testReturnUnionUdSi2 "Test returning union with double or 2 int (64 or 64 bits)" | udSi2 | + udSi2 := self invoke: 'ffiTestInitUdSi2_d' with: Float pi. - udSi2 := FFITestLibrary ffiTestInitUdSi2WithDouble: Float pi. self assert: Float pi equals: udSi2 d1. self assert: (Float pi basicAt: 1) equals: udSi2 sii1 i2. "Assume Little Endianness" self assert: (Float pi basicAt: 2) equals: udSi2 sii1 i1. + udSi2 := self invoke: 'ffiTestInitUdSi2_ii' with: 1 with: 2. - udSi2 := FFITestLibrary ffiTestInitUdSi2WithInt: 1 int: 2. self assert: 1 equals: udSi2 sii1 i1. self assert: 2 equals: udSi2 sii1 i2.! Item was changed: ----- Method: FFIPluginTests>>testReturnUnionUfd (in category 'tests - union') ----- testReturnUnionUfd "Test returning union with float or double (32 or 64 bits)" | ufd | + ufd := self invoke: 'ffiTestInitUfd_f' with: 1.0. - ufd := FFITestLibrary ffiTestInitUfdWithFloat: 1.0. self assert: 1.0 equals: ufd f1. + ufd := self invoke: 'ffiTestInitUfd_d' with: 2.0. - ufd := FFITestLibrary ffiTestInitUfdWithDouble: 2.0. self assert: 2 equals: ufd d1.! Item was changed: ----- Method: FFIPluginTests>>testReturnUnionUfi (in category 'tests - union') ----- testReturnUnionUfi "Test returning union with float or int (32 or 32 bits)" | ufi | + ufi := self invoke: 'ffiTestInitUfi_f' with: 1.0. - ufi := FFITestLibrary ffiTestInitUfiWithFloat: 1.0. self assert: 1.0 equals: ufi f1. self assert: 1.0 asIEEE32BitWord equals: ufi i1. + ufi := self invoke: 'ffiTestInitUfi_i' with: 2. - ufi := FFITestLibrary ffiTestInitUfiWithInt: 2. self assert: 2 equals: ufi i1.! Item was added: + ----- Method: FFIPluginTests>>testShorts (in category 'tests - atomics') ----- + testShorts + + | result | + result := self invoke: 'ffiTestShorts' with: $A with: 65 with: 65.0 with: true. + self assert: 130 equals: result.! Item was changed: ----- Method: FFIPluginTests>>testSmallStructureReturn (in category 'tests - structure') ----- testSmallStructureReturn "Test returning small structures (<4 bytes) which are returned in a register on some platforms." | pt1 | + pt1 := self invoke: 'ffiTestSmallStructReturn'. - pt1 := FFITestLibrary ffiTestSmallStructReturn. self assert: pt1 x = 3. self assert: pt1 y = 4.! Item was changed: ----- Method: FFIPluginTests>>testSumStructSSdi5 (in category 'tests - structure') ----- testSumStructSSdi5 "Test passing a structure larger than 8 eighbytes" | sdi1 sdi2 sdi3 sdi4 sdi5 ssdi5 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. sdi3 := FFITestSdi new. sdi3 d1: 0.125; i2: 3. sdi4 := FFITestSdi new. sdi4 d1: 2.0; i2: 1. sdi5 := FFITestSdi new. sdi5 d1: 4.0; i2: 2. ssdi5 := FFITestSSdi5 new. ssdi5 sdi1: sdi1; sdi2: sdi2; sdi3: sdi3; sdi4: sdi4; sdi5: sdi5. + sum := self invoke: 'ffiTestSumSSdi5' with: ssdi5. - sum := FFITestLibrary ffiTestSumStructSdi5: ssdi5. self assert: 0.5 + 16r12345678 + 0.25 + 16r01234567 + 0.125 + 3 + 2.0 + 1 + 4.0 + 2 equals: sum! Item was added: + ----- Method: FFIPluginTests>>testSumStructSUfdUdsi2 (in category 'tests - structure') ----- + testSumStructSUfdUdsi2 + "Sum up the double parts of two unions in a struct. We have to malloc because we cannot (yet?) share parts of byte arrays between structures." + + | sUfdUdsi2 sum | + sUfdUdsi2 := heapObject := FFITestSUfdUdSi2 externalNew. + sUfdUdsi2 ufd1 d1: 123.456. + sUfdUdsi2 udSii2 d1: 456.123. + sum := self invoke: 'ffiTestSumSUfdUdSi2_d' with: sUfdUdsi2. + self assert: 123.456 + 456.123 equals: sum.! Item was added: + ----- Method: FFIPluginTests>>testSumStructSUfdUfi (in category 'tests - structure') ----- + testSumStructSUfdUfi + "Sum up the float parts of two unions in a struct. We have to malloc because we cannot (yet?) share parts of byte arrays between structures." + + | sUfdUdsi2 result expected | + sUfdUdsi2 := heapObject := FFITestSUfdUfi externalNew. + sUfdUdsi2 ufd1 f1: 123.456. + sUfdUdsi2 ufi2 f1: 456.123. + result := self invoke: 'ffiTestSumSUfdUfi_f' with: sUfdUdsi2. + expected := 123.456 + 456.123. + self assert: (result between: expected - 0.0005 and: expected + 0.0005).! Item was changed: ----- Method: FFIPluginTests>>testSumStructSdi (in category 'tests - structure') ----- testSumStructSdi "Test passing structure double int" | sdi sum | sdi := FFITestSdi new. sdi d1: 0.5; i2: 16r12345678. + sum := self invoke: 'ffiTestSumSdi' with: sdi. - sum := FFITestLibrary ffiTestSumSdi: sdi. self assert: 0.5 + 16r12345678 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSdi2 (in category 'tests - structure') ----- testSumStructSdi2 "Test passing 2 structure double int" | sdi1 sdi2 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. + sum := self invoke: 'ffiTestSumSdi_2' with: sdi1 with: sdi2. - sum := FFITestLibrary ffiTestSumSdi: sdi1 sdi: sdi2. self assert: 0.5 + 16r12345678 + 0.25 + 16r01234567 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSdi4 (in category 'tests - structure') ----- testSumStructSdi4 "Test passing 4 structure double int" | sdi1 sdi2 sdi3 sdi4 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. sdi3 := FFITestSdi new. sdi3 d1: 0.125; i2: 3. sdi4 := FFITestSdi new. sdi4 d1: 2.0; i2: 1. + sum := self invoke: 'ffiTestSumSdi_4' with: sdi1 with: sdi2 with: sdi3 with: sdi4. - sum := FFITestLibrary ffiTestSumSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4. self assert: 0.5 + 16r12345678 + 0.25 + 16r01234567 + 0.125 + 3 + 2.0 + 1 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSfd (in category 'tests - structure') ----- testSumStructSfd "Test passing structure float double" | sfd sum | sfd := FFITestSfd new. sfd f1: 0.5; d2: 305419896.0. + sum := self invoke: 'ffiTestSumSfd' with: sfd. - sum := FFITestLibrary ffiTestSumSfd: sfd. self assert: 0.5 + 305419896.0 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSfd2 (in category 'tests - structure') ----- testSumStructSfd2 "Test passing 2 structure float double " | sfd1 sfd2 sum | sfd1 := FFITestSfd new. sfd1 f1: 0.5; d2: 305419896.0. sfd2 := FFITestSfd new. sfd2 f1: 0.25; d2: 19088743.0. + sum := self invoke: 'ffiTestSumSfd_2' with: sfd1 with: sfd2. - sum := FFITestLibrary ffiTestSumSfd: sfd1 sfd: sfd2. self assert: 0.5 + 305419896.0 + 0.25 + 19088743.0 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSfd4 (in category 'tests - structure') ----- testSumStructSfd4 "Test passing 4 structure float double" | sfd1 sfd2 sfd3 sfd4 sum | sfd1 := FFITestSfd new. sfd1 f1: 0.5; d2: 305419896.0. sfd2 := FFITestSfd new. sfd2 f1: 0.25; d2: 19088743.0. sfd3 := FFITestSfd new. sfd3 f1: 0.125; d2: 3. sfd4 := FFITestSfd new. sfd4 f1: 2.0; d2: 1. + sum := self invoke: 'ffiTestSumSfd_4' with: sfd1 with: sfd2 with: sfd3 with: sfd4. - sum := FFITestLibrary ffiTestSumSfd: sfd1 sfd: sfd2 sfd: sfd3 sfd: sfd4. self assert: 0.5 + 305419896.0 + 0.25 + 19088743.0 + 0.125 + 3.0 + 2.0 + 1.0 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumStructSslf (in category 'tests - structure') ----- testSumStructSslf "Test passing structure short long float" | sslf sum | sslf := FFITestSslf new. sslf s1: -32768; l2: 16r1234560000; f3: 65536.0. + sum := self invoke: 'ffiTestSumSslf' with: sslf. - sum := FFITestLibrary ffiTestSumSslf: sslf. self assert: -32768 + 16r1234560000 + 65536.0 equals: sum! Item was added: + ----- Method: FFIPluginTests>>testSumStructSslf2 (in category 'tests - structure') ----- + testSumStructSslf2 + "Test passing structure short long float" + | sslf1 sslf2 sum | + sslf1 := FFITestSslf new. + sslf1 s1: -32768; l2: 16r123456789012; f3: 65536.0. + sslf2 := FFITestSslf new. + sslf2 s1: 32767; l2: (-1 << 31); f3: -65536.0. + sum := self invoke: 'ffiTestSumSslf_2' with: sslf1 with: sslf2. + self + assert: sslf1 s1 + sslf1 l2 + sslf1 f3 + sslf2 s1 + sslf2 l2 + sslf2 f3 + equals: sum! Item was added: + ----- Method: FFIPluginTests>>testSumStructSslf4 (in category 'tests - structure') ----- + testSumStructSslf4 + "Test passing structure short long float" + | sslf1 sslf2 sslf3 sslf4 sum | + sslf1 := FFITestSslf new. + sslf1 s1: -32768; l2: 16r123456789012; f3: 65536.0. + sslf2 := FFITestSslf new. + sslf2 s1: 32767; l2: (-1 << 31); f3: -65536.0. + sslf3 := FFITestSslf new. + sslf3 s1: 1; l2: 16r123456789012; f3: 123.456. + sslf4 := FFITestSslf new. + sslf4 s1: 2; l2: (-1 << 31); f3: 456.123. + sum := self invoke: 'ffiTestSumSslf_2' with: sslf1 with: sslf2. + self + assert: sslf1 s1 + sslf1 l2 + sslf1 f3 + sslf2 s1 + sslf2 l2 + sslf2 f3 + + sslf3 s1 + sslf3 l2 + sslf3 f3 + sslf4 s1 + sslf4 l2 + sslf4 f3 + equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumdWithStructSdi4 (in category 'tests - structure') ----- testSumdWithStructSdi4 "Test passing 4 structure double int" | sdi1 sdi2 sdi3 sdi4 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. sdi3 := FFITestSdi new. sdi3 d1: 0.125; i2: 3. sdi4 := FFITestSdi new. sdi4 d1: 2.0; i2: 1. + sum := self invoke: 'ffiTestSumdWithSdi_4' with: 5.0 with: sdi1 with: sdi2 with: sdi3 with: sdi4. - sum := FFITestLibrary ffiTestSumd: 5.0 withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4. self assert: 5.0 + 0.5 + 16r12345678 + 0.25 + 16r01234567 + 0.125 + 3 + 2.0 + 1 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumdiWithStructSdi4 (in category 'tests - structure') ----- testSumdiWithStructSdi4 "Test passing 4 structure double int" | sdi1 sdi2 sdi3 sdi4 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. sdi3 := FFITestSdi new. sdi3 d1: 0.125; i2: 3. sdi4 := FFITestSdi new. sdi4 d1: 2.0; i2: 1. + sum := self invoke: 'ffiTestSumdiWithSdi_4' withArguments: { 5.0 . 6 . sdi1 . sdi2 . sdi3 . sdi4 }. - sum := FFITestLibrary ffiTestSumd: 5.0 i: 6 withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4. self assert: 5.0 + 6 + 0.5 + 16r12345678 + 0.25 + 16r01234567 + 0.125 + 3 + 2.0 + 1 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumfWithStructSfd4 (in category 'tests - structure') ----- testSumfWithStructSfd4 "Test passing 4 structure float double" | sfd1 sfd2 sfd3 sfd4 sum | sfd1 := FFITestSfd new. sfd1 f1: 0.5; d2: 305419896.0. sfd2 := FFITestSfd new. sfd2 f1: 0.25; d2: 19088743.0. sfd3 := FFITestSfd new. sfd3 f1: 0.125; d2: 3. sfd4 := FFITestSfd new. sfd4 f1: 2.0; d2: 1. + sum := self invoke: 'ffiTestSumfWithSfd_4' with: 5.0 with: sfd1 with: sfd2 with: sfd3 with: sfd4. - sum := FFITestLibrary ffiTestSumf: 5.0 withSfd: sfd1 sfd: sfd2 sfd: sfd3 sfd: sfd4. self assert: 5.0 + 0.5 + 305419896.0 + 0.25 + 19088743.0 + 0.125 + 3.0 + 2.0 + 1.0 equals: sum! Item was changed: ----- Method: FFIPluginTests>>testSumiWithStructSdi4 (in category 'tests - structure') ----- testSumiWithStructSdi4 "Test passing 4 structure double int" | sdi1 sdi2 sdi3 sdi4 sum | sdi1 := FFITestSdi new. sdi1 d1: 0.5; i2: 16r12345678. sdi2 := FFITestSdi new. sdi2 d1: 0.25; i2: 16r01234567. sdi3 := FFITestSdi new. sdi3 d1: 0.125; i2: 3. sdi4 := FFITestSdi new. sdi4 d1: 2.0; i2: 1. + sum := self invoke: 'ffiTestSumiWithSdi_4' with: 5 with: sdi1 with: sdi2 with: sdi3 with: sdi4. - sum := FFITestLibrary ffiTestSumi: 5 withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4. self assert: 5 + 0.5 + 16r12345678 + 0.25 + 16r01234567 + 0.125 + 3 + 2.0 + 1 equals: sum! Item was removed: - ----- Method: FFIPluginTests>>testUintRange (in category 'tests') ----- - testUintRange - "Simple test for making sure the FFI can call certain numbers in the uint range." - | result | - self flag: #ffiLongVsInt. - self shouldnt:[result := FFITestLibrary ffiTestUint: 3894967296 "1<<32-4e8 " with: 3894967296 with: 3103854339 with: 3103854339] raise: Error. - self should: result = -8e8.! Item was removed: - ----- Method: FFIPluginTests>>testUlongRange (in category 'tests') ----- - testUlongRange - "Simple test for making sure the FFI can call certain numbers in the ulong range. - Note: since primitive is using unsigned int under the hood, avoid an integer overflow by choosing appropriate unsigned values. - Note: only first two parameters are added" - | result | - self flag: #ffiLongVsInt. - self shouldnt:[result := FFITestLibrary ffiTestUlong: 3894967296 "1<<32-4e8 " with: 3894967296 with: 3103854339 with: 3103854339] raise: Error. - self should: result = -8e8.! Item was added: + ----- Method: FFIPluginTests>>testUnsignedIntegerRange (in category 'tests - other') ----- + testUnsignedIntegerRange + "Simple test for making sure the FFI can call certain numbers in the uint range. Note that only the first two parameters are summed up." + + | result arg1 arg2 arg3 arg4 | + arg1 := arg2 := 3894967296 "1<<32-4e8". + arg3 := arg4 := 3103854339. + result := FFITestLibrary ffiTestUint: arg1 with: arg2 with: arg3 with: arg4. + self assert: -8e8 "due to overflow" equals: result.! Item was changed: ----- Method: FFITestBiggerStruct class>>fields (in category 'field definition') ----- fields "FFITestBiggerStruct defineFields" ^#( + (x 'int64_t') + (y 'int64_t') + (z 'int64_t') + (w 'int64_t') + (r 'int64_t') + (s 'int64_t') + (t 'int64_t') + (u 'int64_t'))! - (x 'longlong') - (y 'longlong') - (z 'longlong') - (w 'longlong') - (r 'longlong') - (s 'longlong') - (t 'longlong') - (u 'longlong'))! Item was changed: + ----- Method: FFITestLibrary class>>ffiPrintString: (in category 'other') ----- - ----- Method: FFITestLibrary class>>ffiPrintString: (in category 'primitives') ----- ffiPrintString: aString + " + FFITestLibrary ffiPrintString: 'Hello' + " - "FFITestLibrary ffiPrintString: 'Hello'" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTest4IntAliasSum:with:with:with: (in category 'primitives - type alias') ----- - ffiTest4IntAliasSum: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" - - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTest4IntSum:with:with:with: (in category 'atomic - int32_t') ----- - ----- Method: FFITestLibrary class>>ffiTest4IntSum:with:with:with: (in category 'primitives - long vs. int') ----- ffiTest4IntSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + - - self flag: #ffiLongVsInt. ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTest4LongSum:with:with:with: (in category 'primitives - long vs. int') ----- - ffiTest4LongSum: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTest4LongSum: 1 with: 2 with: 3 with: 4" - - self flag: #ffiLongVsInt. - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTest8IntSum:with:with:with:with:with:with:with: (in category 'atomic - int32_t') ----- - ----- Method: FFITestLibrary class>>ffiTest8IntSum:with:with:with:with:with:with:with: (in category 'primitives - long vs. int') ----- ffiTest8IntSum: c1 with: c2 with: c3 with: c4 with: c5 with: c6 with: c7 with: c8 "FFITestLibrary ffiTest8IntSum: 1 with: 2 with: 3 with: 4 with: 5 with: 6 with: 7 with: 8" + - - self flag: #ffiLongVsInt. ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTest8LongLongSum:with:with:with:with:with:with:with: (in category 'atomic - int64_t') ----- + ffiTest8LongLongSum: long1 with: long2 with: long3 with: long4 with: long5 with: long6 with: long7 with: long8 + + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTest8LongSum:with:with:with:with:with:with:with: (in category 'primitives - long vs. int') ----- - ffiTest8LongSum: c1 with: c2 with: c3 with: c4 with: c5 with: c6 with: c7 with: c8 - "FFITestLibrary ffiTest8LongSum: 1 with: 2 with: 3 with: 4 with: 5 with: 6 with: 7 with: 8" - - self flag: #ffiLongVsInt. - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTest8longSum:with:with:with:with:with:with:with: (in category 'atomic - c_long') ----- + ffiTest8longSum: c1 with: c2 with: c3 with: c4 with: c5 with: c6 with: c7 with: c8 + "FFITestLibrary ffiTest8LongSum: 1 with: 2 with: 3 with: 4 with: 5 with: 6 with: 7 with: 8" + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestBool:with:with:with: (in category 'atomic - bool') ----- - ----- Method: FFITestLibrary class>>ffiTestBool:with:with:with: (in category 'primitives') ----- ffiTestBool: b1 with: b2 with: b3 with: b4 "FFITestLibrary ffiTestBool: true with: false with: true with: false" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestChar:with:with:with: (in category 'primitives') ----- - ffiTestChar: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTestChar: $A with: 65 with: 65.0 with: true" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestChars:with:with:with: (in category 'atomic - char') ----- + ffiTestChars: c1 with: c2 with: c3 with: c4 + "Answers c1 + c2 as Character. + FFITestLibrary ffiTestChars: $A with: 32 with: 0 with: 0 + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestDoubles14:with:with:with:with:with:with:with:with:with:with:with:with:with: (in category 'atomic - floats') ----- + ffiTestDoubles14: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 with: f8 with: f9 with: f10 with: f11 with: f12 with: f13 with: f14 + + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestDoubles9:d:d:d:d:d:d:d:d: (in category 'primitives') ----- - ffiTestDoubles9: f1 d: f2 d: f3 d: f4 d: f5 d: f6 d: f7 d: f8 d: f9 - "FFITestLibrary ffiTestDoubles9: 1.0 d: 2.0 d: 3.0 d: 4.0 d: 5.0 d: 6.0 d: 7.0 d: 8.0 d: 9.0" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestDoubles9:with:with:with:with:with:with:with:with: (in category 'atomic - floats') ----- + ffiTestDoubles9: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 with: f8 with: f9 + "FFITestLibrary ffiTestDoubles9: 1.0 with: 2.0 with: 3.0 with: 4.0 with: 5.0 with: 6.0 with: 7.0 with: 8.0 with: 9.0" + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestDoubles:with: (in category 'atomic - floats') ----- - ----- Method: FFITestLibrary class>>ffiTestDoubles:with: (in category 'primitives') ----- ffiTestDoubles: f1 with: f2 "FFITestLibrary ffiTestDoubles: $A with: 65.0" ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFloats13:with:with:with:with:with:with:with:with:with:with:with:with: (in category 'atomic - floats') ----- + ffiTestFloats13: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 with: f8 with: f9 with: f10 with: f11 with: f12 with: f13 + + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFloats14:with:with:with:with:with:with:with:with:with:with:with:with:with: (in category 'atomic - floats') ----- + ffiTestFloats14: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 with: f8 with: f9 with: f10 with: f11 with: f12 with: f13 with: f14 + + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFloats7:with:with:with:with:with:with: (in category 'atomic - floats') ----- + ffiTestFloats7: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 + + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestFloats:with: (in category 'atomic - floats') ----- - ----- Method: FFITestLibrary class>>ffiTestFloats:with: (in category 'primitives') ----- ffiTestFloats: f1 with: f2 "FFITestLibrary ffiTestFloats: $A with: 65.0" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitSUfd:udSi2: (in category 'primitives') ----- - ffiTestInitSUfd: ufd udSi2: udSi2 - "FFITestLibrary FFITestInitSUfd: ... udSi2: .." - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitSUfd:ufi: (in category 'primitives') ----- - ffiTestInitSUfd: ufd ufi: ufi - "FFITestLibrary ffiTestInitSUfd: ... ufi: .." - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitSUfdUdSi2:with: (in category 'structure - init') ----- + ffiTestInitSUfdUdSi2: ufd with: udSi2 + "FFITestLibrary ffiTestInitSUfdUdSi2: ... with: .." + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitSUfdUfi:with: (in category 'structure - init') ----- + ffiTestInitSUfdUfi: ufd with: ufi + "FFITestLibrary ffiTestInitSUfdUfi: ... with: .." + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUdSi2WithDouble: (in category 'primitives') ----- - ffiTestInitUdSi2WithDouble: d - "FFITestLibrary ffiTestInitUdSi2WithDouble: 1.0" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUdSi2WithInt:int: (in category 'primitives') ----- - ffiTestInitUdSi2WithInt: i1 int: i2 - "FFITestLibrary ffiTestInitUdSi2WithInt: 1 int: 2" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUdSi2_d: (in category 'structure - init') ----- + ffiTestInitUdSi2_d: d + "FFITestLibrary ffiTestInitUdSi2_d: 1.0" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUdSi2_ii:with: (in category 'structure - init') ----- + ffiTestInitUdSi2_ii: i1 with: i2 + "FFITestLibrary ffiTestInitUdSi2_ii: 1 with: 2" + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUfdWithDouble: (in category 'primitives') ----- - ffiTestInitUfdWithDouble: d - "FFITestLibrary ffiTestInitUfdWithDouble: 1.0" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUfdWithFloat: (in category 'primitives') ----- - ffiTestInitUfdWithFloat: f - "FFITestLibrary ffiTestInitUfdWithFloat: 1.0" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUfd_d: (in category 'structure - init') ----- + ffiTestInitUfd_d: d + "FFITestLibrary ffiTestInitUfd_d: 1.0" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUfd_f: (in category 'structure - init') ----- + ffiTestInitUfd_f: f + "FFITestLibrary ffiTestInitUfd_f: 1.0" + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUfiWithFloat: (in category 'primitives') ----- - ffiTestInitUfiWithFloat: f - "FFITestLibrary ffiTestInitUfiWithFloat: 1.0" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInitUfiWithInt: (in category 'primitives') ----- - ffiTestInitUfiWithInt: i - "FFITestLibrary ffiTestInitUfiWithInt: 2" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUfi_f: (in category 'structure - init') ----- + ffiTestInitUfi_f: f + "FFITestLibrary ffiTestInitUfi_f: 1.0" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInitUfi_i: (in category 'structure - init') ----- + ffiTestInitUfi_i: i + "FFITestLibrary ffiTestInitUfi_i: 2" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInt4IntAliasSum:with:with:with: (in category 'type alias') ----- + ffiTestInt4IntAliasSum: c1 with: c2 with: c3 with: c4 + "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestInt:with:with:with: (in category 'primitives - long vs. int') ----- - ffiTestInt: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTestInt: $A with: 65 with: 65.0 with: true" - - self flag: #ffiLongVsInt. - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntAliasSum:with:with:with: (in category 'type alias') ----- - ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntAliasSum:with:with:with: (in category 'primitives - type alias') ----- ffiTestIntAlias4IntAliasSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntSum:with:with:with: (in category 'type alias') ----- - ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntSum:with:with:with: (in category 'primitives - type alias') ----- ffiTestIntAlias4IntSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInts8:with:with:with:with:with:with:with: (in category 'atomic - int32_t') ----- + ffiTestInts8: c1 with: c2 with: c3 with: c4 with: c5 with: c6 with: c7 with: c8 + "Always answers 42." + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestInts:with:with:with: (in category 'atomic - int32_t') ----- + ffiTestInts: c1 with: c2 with: c3 with: c4 + "Adds c1 + c2" + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestLong:with:with:with: (in category 'primitives - long vs. int') ----- - ffiTestLong: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTestLong: $A with: 65 with: 65.0 with: true" - - self flag: #ffiLongVsInt. - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLong8:with:with:with:with:with:with:with:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLong8: char1 with: char2 with: char3 with: char4 with: char5 with: char6 with: char7 with: char8 with: long1 with: long2 + + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLong8a1:with:with:with:with:with:with:with:with:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLong8a1: char1 with: char2 with: char3 with: char4 with: char5 with: char6 with: char7 with: char8 with: char9 with: long1 with: long2 + + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLong8a2:with:with:with:with:with:with:with:with:with:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLong8a2: char1 with: char2 with: char3 with: char4 with: char5 with: char6 with: char7 with: char8 with: char9 with: char10 with: long1 with: long2 + + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestLongLong:with: (in category 'atomic - int64_t') ----- - ----- Method: FFITestLibrary class>>ffiTestLongLong:with: (in category 'primitives') ----- ffiTestLongLong: long1 with: long2 "FFITestLibrary ffiTestLongLong: 3 with: 4" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestLongLongA1:with:with: (in category 'primitives') ----- - ffiTestLongLongA1: byte with: long1 with: long2 - "FFITestLibrary ffiTestLongLongA1: 3 with: 4 with: 5" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestLongLongA3:with:with: (in category 'primitives') ----- - ffiTestLongLongA3: byte1 with: long1 with: byte2 - "FFITestLibrary ffiTestLongLongA3: 3 with: 4 with: 5" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLonga1:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLonga1: byte with: long1 with: long2 + "FFITestLibrary ffiTestLongLongA1: 3 with: 4 with: 5" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLonga2:with:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLonga2: byte1 with: byte2 with: long1 with: long2 + + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLonga3:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLonga3: byte1 with: long1 with: byte2 + "FFITestLibrary ffiTestLongLonga3: 3 with: 4 with: 5" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestLongLongs8:with:with:with:with:with:with:with: (in category 'atomic - int64_t') ----- + ffiTestLongLongs8: long1 with: long2 with: long3 with: long4 with: long5 with: long6 with: long7 with: long8 + "Always answers 42." + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestMixedDoublesAndLongs:with:with:with:with:with:with:with:with:with:with:with:with:with:with: (in category 'atomic') ----- + ffiTestMixedDoublesAndLongs: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 "with: arg16 with: arg17 with: arg18 with: arg19 with: arg20" + + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestMixedDoublesIntAndStruct:d:d:d:d:d:d:d:d:i:s: (in category 'primitives') ----- - ffiTestMixedDoublesIntAndStruct: f1 d: f2 d: f3 d: f4 d: f5 d: f6 d: f7 d: f8 d: f9 i: i1 s: s1 - "FFITestLibrary ffiTestMixedDoublesIntAndStruct: 1.0 d: 2.0 d: 3.0 d: 4.0 d: 5.0 d: 6.0 d: 7.0 d: 8.0 d: 9.0 i: 42 - s: (FFITestPoint4 new x: 3; y: 4; z: 5; w:6)" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestMixedDoublesIntAndStruct:with:with:with:with:with:with:with:with:with:with: (in category 'structure') ----- + ffiTestMixedDoublesIntAndStruct: f1 with: f2 with: f3 with: f4 with: f5 with: f6 with: f7 with: f8 with: f9 with: i1 with: s1 + " + FFITestLibrary ffiTestMixedDoublesIntAndStruct: 1.0 + with: 2.0 with: 3.0 with: 4.0 with: 5.0 + with: 6.0 with: 7.0 with: 8.0 with: 9.0 with: 42 + with: (FFITestPoint4 new x: 3; y: 4; z: 5; w:6) + " + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestMixedFloatsAndDouble:with:with:with: (in category 'atomic') ----- - ----- Method: FFITestLibrary class>>ffiTestMixedFloatsAndDouble:with:with:with: (in category 'primitives') ----- ffiTestMixedFloatsAndDouble: f1 with: d1 with: f2 with: f3 "FFITestLibrary ffiTestMixedFloatsAndDouble: 1.2 with: 3.4 with: 5.6 with: 7.8" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct2:with: (in category 'structure') ----- - ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct2:with: (in category 'primitives') ----- ffiTestMixedIntAndStruct2: i with: pt4 "FFITestLibrary ffiTestMixedIntAndStruct2: 2 with: (FFITestPoint4 new x: 3; y: 4; z: 5; w:6)" + - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct3:with: (in category 'structure') ----- - ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct3:with: (in category 'primitives') ----- ffiTestMixedIntAndStruct3: i with: anFFISmallStruct1 "FFITestLibrary ffiTestMixedIntAndStruct3: 2 with: (FFISmallStruct1 new x: 3; y: 4)" + - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct:with:with: (in category 'structure') ----- - ----- Method: FFITestLibrary class>>ffiTestMixedIntAndStruct:with:with: (in category 'primitives') ----- ffiTestMixedIntAndStruct: i with: pt1 with: pt2 "FFITestLibrary ffiTestMixedIntAndStruct: 2 with: (FFITestPoint2 new x: 3; y: 4) with: (FFITestPoint2 new x: 5; y: 6)" + - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestPoint2:with: (in category 'primitives') ----- - ffiTestPoint2: pt1 with: pt2 - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestPoint4:with: (in category 'primitives') ----- - ffiTestPoint4: pt1 with: pt2 - - ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestPointers:with: (in category 'structure - points') ----- - ----- Method: FFITestLibrary class>>ffiTestPointers:with: (in category 'primitives') ----- ffiTestPointers: pt1 with: pt2 + "Allocates the result. Needs to be free'd after calling." ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSSdi5 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSSdi5 (in category 'primitives') ----- ffiTestReturnSSdi5 "FFITestLibrary ffiTestReturnSSdi5" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSd2 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSd2 (in category 'primitives') ----- ffiTestReturnSd2 "FFITestLibrary ffiTestReturnSd2" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSdi (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSdi (in category 'primitives') ----- ffiTestReturnSdi "FFITestLibrary ffiTestReturnSdi" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSf2 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSf2 (in category 'primitives') ----- ffiTestReturnSf2 "FFITestLibrary ffiTestReturnSf2" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSf2d (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSf2d (in category 'primitives') ----- ffiTestReturnSf2d "FFITestLibrary ffiTestReturnSf2d" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSf4 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSf4 (in category 'primitives') ----- ffiTestReturnSf4 "FFITestLibrary ffiTestReturnSf4" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSfd (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSfd (in category 'primitives') ----- ffiTestReturnSfd "FFITestLibrary ffiTestReturnSfd" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSfdf (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSfdf (in category 'primitives') ----- ffiTestReturnSfdf "FFITestLibrary ffiTestReturnSfdf" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSfi (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSfi (in category 'primitives') ----- ffiTestReturnSfi "FFITestLibrary ffiTestReturnSfi" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSi2 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSi2 (in category 'primitives') ----- ffiTestReturnSi2 "FFITestLibrary ffiTestReturnSi2" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSl2 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSl2 (in category 'primitives') ----- ffiTestReturnSl2 "FFITestLibrary ffiTestReturnSl2" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSs2 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSs2 (in category 'primitives') ----- ffiTestReturnSs2 "FFITestLibrary ffiTestReturnSs2" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSs2i (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSs2i (in category 'primitives') ----- ffiTestReturnSs2i "FFITestLibrary ffiTestReturnSs2i" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSs4 (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSs4 (in category 'primitives') ----- ffiTestReturnSs4 "FFITestLibrary ffiTestReturnSs4" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsSsf (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsSsf (in category 'primitives') ----- ffiTestReturnSsSsf "FFITestLibrary ffiTestReturnSsSsf" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsSsi (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsSsi (in category 'primitives') ----- ffiTestReturnSsSsi "FFITestLibrary ffiTestReturnSsSsi" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsf (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsf (in category 'primitives') ----- ffiTestReturnSsf "FFITestLibrary ffiTestReturnSsf" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsi (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsi (in category 'primitives') ----- ffiTestReturnSsi "FFITestLibrary ffiTestReturnSsi" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsis (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsis (in category 'primitives') ----- ffiTestReturnSsis "FFITestLibrary ffiTestReturnSsis" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSslf (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSslf (in category 'primitives') ----- ffiTestReturnSslf "FFITestLibrary ffiTestReturnSslf" ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestReturnSsls (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestReturnSsls (in category 'primitives') ----- ffiTestReturnSsls "FFITestLibrary ffiTestReturnSsls" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestShort:with:with:with: (in category 'primitives') ----- - ffiTestShort: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTestShort: $A with: 65 with: 65.0 with:1" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestShorts:with:with:with: (in category 'atomic - int16_t') ----- + ffiTestShorts: c1 with: c2 with: c3 with: c4 + "Answers c1 + c2. + FFITestLibrary ffiTestShorts: 1 with: 2 with: 3 with: 4" + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestSmallStructReturn (in category 'structure - return') ----- - ----- Method: FFITestLibrary class>>ffiTestSmallStructReturn (in category 'primitives') ----- ffiTestSmallStructReturn "FFITestLibrary ffiTestSmallStructReturn" ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestStruct64:with: (in category 'structure - points') ----- + ffiTestStruct64: pt1 with: pt2 + "pt1 + pt2" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestStructBig:with: (in category 'structure - points') ----- + ffiTestStructBig: pt1 with: pt2 + "pt1 + pt2" + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestStructBigger:with: (in category 'structure - points') ----- + ffiTestStructBigger: pt1 with: pt2 + "Copies the values of pt1 to x, y, z, w and pt2 to r, s, t, u in the resulting struct." + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumOfDoubleFromSUfdUdsi2: (in category 'primitives') ----- - ffiTestSumOfDoubleFromSUfdUdsi2: sUfdUfi - "FFITestLibrary ffiTestSumOfFloatFromSUfdUdSi2: (FFITestLibrary ...)" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumOfFloatFromSUfdUfi: (in category 'primitives') ----- - ffiTestSumOfFloatFromSUfdUfi: sUfdUfi - "FFITestLibrary ffiTestSumOfFloatFromSUfdUfi: (FFITestLibrary ...)" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSSdi5: (in category 'structure - sums') ----- + ffiTestSumSSdi5: structSdi5 + " + FFITestLibrary ffiTestSumSSdi5: FFITestLibrary ffiTestReturnSSdi5 + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSUfdUdSi2_d: (in category 'structure - sums') ----- + ffiTestSumSUfdUdSi2_d: sUfdUfi + " + FFITestLibrary ffiTestSumOfFloatFromSUfdUdSi2: (FFITestLibrary ...) + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSUfdUfi_f: (in category 'structure - sums') ----- + ffiTestSumSUfdUfi_f: sUfdUfi + " + FFITestLibrary ffiTestSumSUfdUfi_f: (FFITestLibrary ...) + " + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestSumSdi: (in category 'structure - sums') ----- - ----- Method: FFITestLibrary class>>ffiTestSumSdi: (in category 'primitives') ----- ffiTestSumSdi: sdi + " + FFITestLibrary ffiTestSumSdi: FFITestLibrary ffiTestReturnSdi + " - "FFITestLibrary ffiTestSumSdi: FFITestLibrary ffiTestReturnSdi" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSdi:sdi: (in category 'primitives') ----- - ffiTestSumSdi: sdi1 sdi: sdi2 - "FFITestLibrary ffiTestSumSdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSdi:sdi:sdi:sdi: (in category 'primitives') ----- - ffiTestSumSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4 - "FFITestLibrary ffiTestSumSdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSdi_2:with: (in category 'structure - sums') ----- + ffiTestSumSdi_2: sdi1 with: sdi2 + " + FFITestLibrary + ffiTestSumSdi_2: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSdi_4:with:with:with: (in category 'structure - sums') ----- + ffiTestSumSdi_4: sdi1 with: sdi2 with: sdi3 with: sdi4 + " + FFITestLibrary + ffiTestSumSdi_4: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + " + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestSumSfd: (in category 'structure - sums') ----- - ----- Method: FFITestLibrary class>>ffiTestSumSfd: (in category 'primitives') ----- ffiTestSumSfd: sfd + " + FFITestLibrary ffiTestSumSfd: FFITestLibrary ffiTestReturnSfd + " - "FFITestLibrary ffiTestSumSfd: FFITestLibrary ffiTestReturnSfd" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSfd:sfd: (in category 'primitives') ----- - ffiTestSumSfd: sfd1 sfd: sfd2 - "FFITestLibrary ffiTestSumSfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSfd:sfd:sfd:sfd: (in category 'primitives') ----- - ffiTestSumSfd: sfd1 sfd: sfd2 sfd: sfd3 sfd: sfd4 - "FFITestLibrary ffiTestSumSfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSfd_2:with: (in category 'structure - sums') ----- + ffiTestSumSfd_2: sfd1 with: sfd2 + " + FFITestLibrary + ffiTestSumSfd_2: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSfd_4:with:with:with: (in category 'structure - sums') ----- + ffiTestSumSfd_4: sfd1 with: sfd2 with: sfd3 with: sfd4 + " + FFITestLibrary + ffiTestSumSfd_4: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + " + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestSumSslf: (in category 'structure - sums') ----- - ----- Method: FFITestLibrary class>>ffiTestSumSslf: (in category 'primitives') ----- ffiTestSumSslf: sslf + " + FFITestLibrary ffiTestSumSslf: FFITestLibrary ffiTestReturnSslf + " - "FFITestLibrary ffiTestSumSslf: FFITestLibrary ffiTestReturnSslf" ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSslf:sslf: (in category 'primitives') ----- - ffiTestSumSslf: sslf1 sslf: sslf2 - "FFITestLibrary ffiTestSumSslf: FFITestLibrary ffiTestReturnSslf sslf: FFITestLibrary ffiTestReturnSslf" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumSslf:sslf:sslf:sslf: (in category 'primitives') ----- - ffiTestSumSslf: sslf1 sslf: sslf2 sslf: sslf3 sslf: sslf4 - "FFITestLibrary ffiTestSumSslf: FFITestLibrary ffiTestReturnSslf sslf: FFITestLibrary ffiTestReturnSslf sslf: FFITestLibrary ffiTestReturnSslf sslf: FFITestLibrary ffiTestReturnSslf" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSslf_2:with: (in category 'structure - sums') ----- + ffiTestSumSslf_2: sslf1 with: sslf2 + " + FFITestLibrary + ffiTestSumSslf_2: FFITestLibrary ffiTestReturnSslf + with: FFITestLibrary ffiTestReturnSslf + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumSslf_4:with:with:with: (in category 'structure - sums') ----- + ffiTestSumSslf_4: sslf1 with: sslf2 with: sslf3 with: sslf4 + " + FFITestLibrary + ffiTestSumSslf_4: FFITestLibrary ffiTestReturnSslf + with: FFITestLibrary ffiTestReturnSslf + with: FFITestLibrary ffiTestReturnSslf + with: FFITestLibrary ffiTestReturnSslf + " + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumStructSdi5: (in category 'primitives') ----- - ffiTestSumStructSdi5: structSdi5 - "FFITestLibrary ffiTestSumStructSdi5: FFITestLibrary ffiTestReturnSSdi5" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumd:i:withSdi:sdi:sdi:sdi: (in category 'primitives') ----- - ffiTestSumd: aDouble i: anInt withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4 - "FFITestLibrary ffiTestSumd: 4.0 i: 3 withSdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumd:withSdi:sdi:sdi:sdi: (in category 'primitives') ----- - ffiTestSumd: aDouble withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4 - "FFITestLibrary ffiTestSumd: 4.0 withSdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumdWithSdi_4:with:with:with:with: (in category 'structure - sums') ----- + ffiTestSumdWithSdi_4: aDouble with: sdi1 with: sdi2 with: sdi3 with: sdi4 + " + FFITestLibrary + ffiTestSumdWithSdi_4: 4.0 + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + " + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumdiWithSdi_4:with:with:with:with:with: (in category 'structure - sums') ----- + ffiTestSumdiWithSdi_4: aDouble with: anInt with: sdi1 with: sdi2 with: sdi3 with: sdi4 + " + FFITestLibrary + ffiTestSumdiWithSdi_4: 4.0 + with: 3 + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + " + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumf:withSfd:sfd:sfd:sfd: (in category 'primitives') ----- - ffiTestSumf: aFloat withSfd: sfd1 sfd: sfd2 sfd: sfd3 sfd: sfd4 - "FFITestLibrary ffiTestSumf: 0.5 withSfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd sfd: FFITestLibrary ffiTestReturnSfd" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumfWithSfd_4:with:with:with:with: (in category 'structure - sums') ----- + ffiTestSumfWithSfd_4: aFloat with: sfd1 with: sfd2 with: sfd3 with: sfd4 + " + FFITestLibrary + ffiTestSumf: 0.5 + with: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + with: FFITestLibrary ffiTestReturnSfd + " + + ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestSumi:withSdi:sdi:sdi:sdi: (in category 'primitives') ----- - ffiTestSumi: anInt withSdi: sdi1 sdi: sdi2 sdi: sdi3 sdi: sdi4 - "FFITestLibrary ffiTestSumi: 3 withSdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi sdi: FFITestLibrary ffiTestReturnSdi" - - ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestSumiWithSdi_4:with:with:with:with: (in category 'structure - sums') ----- + ffiTestSumiWithSdi_4: anInt with: sdi1 with: sdi2 with: sdi3 with: sdi4 + " + FFITestLibrary + ffiTestSumiWithSdi_4: 3 + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + with: FFITestLibrary ffiTestReturnSdi + " + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestUint:with:with:with: (in category 'atomic - uint32_t') ----- - ----- Method: FFITestLibrary class>>ffiTestUint:with:with:with: (in category 'primitives - long vs. int') ----- ffiTestUint: c1 with: c2 with: c3 with: c4 + "Answers c1 + c2. Repurpose ffiTestInts to check uint32_t range." + - "FFITestLibrary ffiTestUint: 3103854339 with: 3103854339 with: 3103854339 with: 3103854339" - - self flag: #ffiLongVsInt. ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary class>>ffiTestUlong:with:with:with: (in category 'primitives - long vs. int') ----- - ffiTestUlong: c1 with: c2 with: c3 with: c4 - "FFITestLibrary ffiTestUlong: 3103854339 with: 3103854339 with: 3103854339 with: 3103854339" - - self flag: #ffiLongVsInt. - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiPrintString: (in category 'primitives') ----- - ffiPrintString: aString - "FFITestLibrary new ffiPrintString: 'Hello'" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiTestChar:with:with:with: (in category 'primitives') ----- - ffiTestChar: c1 with: c2 with: c3 with: c4 - "FFITestLibrary new ffiTestChar: $A with: 65 with: 65.0 with: true" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiTestDoubles:with: (in category 'primitives') ----- - ffiTestDoubles: f1 with: f2 - "FFITestLibrary new ffiTestDoubles: $A with: 65.0" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiTestFloats:with: (in category 'primitives') ----- - ffiTestFloats: f1 with: f2 - "FFITestLibrary new ffiTestFloats: $A with: 65.0" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiTestInt:with:with:with: (in category 'primitives') ----- - ffiTestInt: c1 with: c2 with: c3 with: c4 - "FFITestLibrary new ffiTestInt: $A with: 65 with: 65.0 with: $A" - - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLibrary>>ffiTestShort:with:with:with: (in category 'primitives') ----- - ffiTestShort: c1 with: c2 with: c3 with: c4 - "FFITestLibrary new ffiTestShort: $A with: 65 with: 65.0 with: $A" - - ^self externalCallFailed! Item was changed: ----- Method: FFITestMisalignedCompoundStruct class>>fields (in category 'field definition') ----- fields "FFITestMisalignedCompoundStruct defineFields" ^#( + (s1 'int16_t') "short" - (s1 #short) (s2 'FFITestMisalignedStruct') )! Item was changed: ----- Method: FFITestMisalignedStruct class>>fields (in category 'field definition') ----- fields "FFITestMisalignedStruct defineFields" ^#( + (s1 'int16_t') "short" + (i1 'int32_t') - (s1 #short) - (i1 #long) )! Item was changed: ----- Method: FFITestPoint2 class>>fields (in category 'field definition') ----- fields "FFITestPoint2 defineFields" ^#( + (x 'int32_t') + (y 'int32_t') - (x 'long') - (y 'long') )! Item was added: + ----- Method: FFITestPoint2>>asPoint (in category 'converting') ----- + asPoint + + ^ self x @ self y! Item was added: + ----- Method: FFITestPoint2>>setX:setY: (in category 'initialization') ----- + setX: xValue setY: yValue. + + self x: xValue. + self y: yValue.! Item was changed: ----- Method: FFITestPoint4 class>>fields (in category 'field definition') ----- fields "FFITestPoint4 defineFields" ^#( + (x 'int32_t') + (y 'int32_t') + (z 'int32_t') + (w 'int32_t') - (x 'long') - (y 'long') - (z 'long') - (w 'long') )! Item was changed: ----- Method: FFITestSdi class>>fields (in category 'field definition') ----- fields "FFITestSdi defineFields" ^#( (d1 'double') + (i2 'int32_t') - (i2 'long') )! Item was changed: ----- Method: FFITestSfi class>>fields (in category 'field definition') ----- fields "FFITestSfi defineFields" ^#( (f1 'float') + (i2 'int32_t') - (i2 'long') )! Item was changed: ----- Method: FFITestSi2 class>>fields (in category 'field definition') ----- fields "FFITestSi2 defineFields" ^#( + (i1 'int32_t') + (i2 'int32_t') - (i1 'long') - (i2 'long') )! Item was changed: ----- Method: FFITestSl2 class>>fields (in category 'field definition') ----- fields "FFITestSl2 defineFields" ^#( + (l1 'int64_t') "longlong" + (l2 'int64_t') "longlong" - (l1 'longlong') - (l2 'longlong') )! Item was changed: ----- Method: FFITestSs2 class>>fields (in category 'field definition') ----- fields "FFITestSs2 defineFields" ^#( + (s1 'int16_t') "short" + (s2 'int16_t') "short" - (s1 'short') - (s2 'short') )! Item was changed: ----- Method: FFITestSs2i class>>fields (in category 'field definition') ----- fields "FFITestSs2i defineFields" ^#( + (s1 'int16_t') "short" + (s2 'int16_t') "short" + (i3 'int32_t') - (s1 'short') - (s2 'short') - (i3 'long') )! Item was changed: ----- Method: FFITestSs4 class>>fields (in category 'field definition') ----- fields "FFITestSs4 defineFields" ^#( + (s1 'int16_t') "short" + (s2 'int16_t') "short" + (s3 'int16_t') "short" + (s4 'int16_t') "short" - (s1 'short') - (s2 'short') - (s3 'short') - (s4 'short') )! Item was changed: ----- Method: FFITestSsSsf class>>fields (in category 'field definition') ----- fields "FFITestSsSsf defineFields" ^#( + (s1 'int16_t') "short" - (s1 'short') (ssf2 'FFITestSsf') )! Item was changed: ----- Method: FFITestSsSsi class>>fields (in category 'field definition') ----- fields "FFITestSsSsi defineFields" ^#( + (s1 'int16_t') "short" + (ssi2 FFITestSsi) - (s1 'short') - (ssi2 'FFITestSsi') )! Item was changed: ----- Method: FFITestSsf class>>fields (in category 'field definition') ----- fields "FFITestSsf defineFields" ^#( + (s1 'int16_t') "short" - (s1 'short') (f2 'float') )! Item was changed: ----- Method: FFITestSsi class>>fields (in category 'field definition') ----- fields "FFITestSsi defineFields" ^#( + (s1 'int16_t') "short" + (i2 'int32_t') - (s1 'short') - (i2 'long') )! Item was changed: ----- Method: FFITestSsis class>>fields (in category 'field definition') ----- fields "FFITestSsis defineFields" ^#( + (s1 'int16_t') "short" + (i2 'int32_t') + (s3 'int16_t') "short" - (s1 'short') - (i2 'long') - (s3 'short') )! Item was changed: ----- Method: FFITestSslf class>>fields (in category 'field definition') ----- fields "FFITestSslf defineFields" ^#( + (s1 'int16_t') "short" + (l2 'int64_t') "longlong" - (s1 'short') - (l2 'longlong') (f3 'float') )! Item was changed: ----- Method: FFITestSsls class>>fields (in category 'field definition') ----- fields "FFITestSsls defineFields" ^#( + (s1 'int16_t') "short" + (l2 'int64_t') "longlong" + (s3 'int16_t') "short" - (s1 'short') - (l2 'longlong') - (s3 'short') )! Item was changed: ----- Method: FFITestUfi class>>fields (in category 'field definition') ----- fields "FFITestUfi defineFields" ^#( (f1 'float') + (i1 'int32_t') - (i1 'long') )! Item was changed: ----- Method: FFITypeNameTests>>testAtomicChar (in category 'tests') ----- testAtomicChar self flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestChars:with:with:with:) - assert: (self argTypesAt: #ffiTestChar:with:with:with:) equals: (Array new: 5 withAll: ExternalType char).! Item was changed: ----- Method: FFITypeNameTests>>testAtomicInt (in category 'tests') ----- testAtomicInt self flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) - assert: (self argTypesAt: #ffiTestInt:with:with:with:) equals: (Array new: 5 withAll: ExternalType int).! Item was changed: ----- Method: FFITypeNameTests>>testAtomicLong (in category 'tests') ----- testAtomicLong self flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) - assert: (self argTypesAt: #ffiTestLong:with:with:with:) equals: (Array new: 5 withAll: ExternalType long).! Item was changed: ----- Method: FFITypeNameTests>>testAtomicUlong (in category 'tests') ----- testAtomicUlong self flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst - assert: (self argTypesAt: #ffiTestUlong:with:with:with:) allButFirst equals: (Array new: 4 withAll: ExternalType ulong).! Item was changed: ----- Method: FFITypeNameTests>>testStruct (in category 'tests') ----- testStruct self + assert: (self argTypesAt: #ffiTestStruct64:with:) - assert: (self argTypesAt: #ffiTestPoint2:with:) equals: (Array new: 3 withAll: FFITestPoint2 externalType).! From commits at source.squeak.org Mon May 3 16:53:54 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 16:53:54 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.126.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.126.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.126 Author: mt Time: 3 May 2021, 6:53:53.131479 pm UUID: efa27be5-2153-1c47-b30f-b8d9ca10b1c8 Ancestors: FFI-Kernel-mt.125 Adds a transparent way to write into composite structures that reside in object memory: #writer. (Name is up for discussion, especially since the namespace for custom structs is limited.) Adds #zeroMemory to remove information from internal or external memory. Fixes regression in ExternalData >> #free. Adds sanity checks to ExternalStructure #new and #externalNew, which both made no sense for type aliases. =============== Diff against FFI-Kernel-mt.125 =============== Item was added: + ----- Method: ByteArray>>zeroMemory (in category '*FFI-Kernel') ----- + zeroMemory + + self atAllPut: 0.! Item was added: + ----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel') ----- + zeroMemory: numBytes + + 1 to: numBytes do: [:index | + self byteAt: index put: 0].! Item was added: + ProtoObject subclass: #ByteArrayWriter + instanceVariableNames: 'byteOffset byteSize byteArray' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! + + !ByteArrayWriter commentStamp: 'mt 5/3/2021 17:44' prior: 0! + I am a transparent wrapper over byte-array handles to allow access and manipulation just like through an external address.! Item was added: + ----- Method: ByteArrayWriter class>>on: (in category 'instance creation') ----- + on: handle + + self assert: [handle isInternalMemory]. + ^ self new setArray: handle! Item was added: + ----- Method: ByteArrayWriter>>doesNotUnderstand: (in category 'system primitives') ----- + doesNotUnderstand: aMessage + + | selector args | + selector := aMessage selector. + args := aMessage arguments. + args size caseOf: { + [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. + [ 2 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args second > byteSize + ifTrue: [self errorSubscriptBounds: args first + args second] ] + ifFalse: [(selector endsWith: 'put:') ifTrue: [ + args at: 1 put: args first + byteOffset ]] ]. + [ 3 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args third > byteSize + ifTrue: [self errorSubscriptBounds: args first + args third]]] + } otherwise: []. + ^ aMessage sendTo: byteArray! Item was added: + ----- Method: ByteArrayWriter>>errorSubscriptBounds: (in category 'initialization') ----- + errorSubscriptBounds: index + + Error signal: 'subscript is out of bounds: ' , index printString.! Item was added: + ----- Method: ByteArrayWriter>>setArray: (in category 'initialization') ----- + setArray: aByteArray + + byteArray := aByteArray. + byteOffset := 0. + byteSize := aByteArray size.! Item was added: + ----- Method: ByteArrayWriter>>setArray:offset:size: (in category 'initialization') ----- + setArray: aByteArray offset: aByteOffset size: aByteSize + + byteArray := aByteArray. + byteOffset := aByteOffset. + byteSize := aByteSize. + + (byteOffset + byteSize > byteArray size) + ifTrue: [self errorSubscriptBounds: byteOffset + byteSize].! Item was added: + ----- Method: ByteArrayWriter>>structAt:length: (in category 'accessing') ----- + structAt: newByteOffset length: newLength + + ^ ByteArrayWriter new + setArray: byteArray + offset: byteOffset + newByteOffset - 1 + size: newLength! Item was added: + ----- Method: ByteArrayWriter>>structAt:put:length: (in category 'accessing') ----- + structAt: newByteOffset put: value length: newLength + + (newByteOffset + newLength > byteSize) + ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. + + ^ byteArray + structAt: byteOffset + newByteOffset - 1 + put: value + length: newLength! Item was added: + ----- Method: Character class>>zero (in category '*FFI-Kernel') ----- + zero + "See ExternalStructure >> #zeroMemory." + + ^ $0! Item was added: + ----- Method: ExternalAddress>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "We need length information in bytes." + self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>free (in category 'initialize-release') ----- + free + + super free. + size := nil.! Item was added: + ----- Method: ExternalData>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "Remove all information but keep the memory allocated." + + self sizeCheck. + + handle isExternalAddress + ifTrue: [handle zeroMemory: self size * self contentType byteSize] + ifFalse: [ "ByteArray" handle zeroMemory].! Item was changed: ----- Method: ExternalStructure class>>externalNew (in category 'instance creation') ----- externalNew "Create an instance of the receiver on the external heap" + + ^ self fromHandle: (self externalType isTypeAliasForAtomic + ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] + ifFalse: [ + self externalType isTypeAliasForPointer + ifTrue: [ByteArray new: self byteSize] + ifFalse: [ExternalAddress allocate: self byteSize]])! - ^self fromHandle: (ExternalAddress allocate: self byteSize)! Item was changed: ----- Method: ExternalStructure class>>new (in category 'instance creation') ----- new + ^self fromHandle: (self externalType isTypeAliasForAtomic + ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] + ifFalse: [ByteArray new: self byteSize]).! - ^self fromHandle: (ByteArray new: self byteSize)! Item was added: + ----- Method: ExternalStructure class>>newZero (in category 'instance creation') ----- + newZero + + ^ self new + zeroMemory; + yourself! Item was added: + ----- Method: ExternalStructure>>writer (in category 'accessing') ----- + writer + + ^ handle isInternalMemory + "Wrap handle into helper to address offsets in the byte array." + ifTrue: [self class fromHandle: (ByteArrayWriter on: handle)] + "Either alias-to-atomic or already in external memory." + ifFalse: [self]! Item was added: + ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "Remove all information but keep the memory allocated." + + handle isExternalAddress + ifTrue: [handle zeroMemory: self externalType byteSize] + ifFalse: [handle isInternalMemory + ifTrue: [handle zeroMemory] + ifFalse: [ + "Alias-to-atomic type." + handle := handle class zero]].! From commits at source.squeak.org Mon May 3 16:57:25 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 16:57:25 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.23.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.23.mcz ==================== Summary ==================== Name: FFI-Tests-mt.23 Author: mt Time: 3 May 2021, 6:57:25.250479 pm UUID: d282dcac-b99c-7a46-a154-b47378bca82a Ancestors: FFI-Tests-mt.22 Complements FFI-Kernel-mt.126 =============== Diff against FFI-Tests-mt.22 =============== Item was changed: TestCase subclass: #ExternalStructureTests + instanceVariableNames: 'heapObject' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Tests'! Item was added: + ----- Method: ExternalStructureTests>>tearDown (in category 'running') ----- + tearDown + + heapObject ifNotNil: [heapObject free].! Item was added: + ----- Method: ExternalStructureTests>>test04AccessingInternalMemory (in category 'tests') ----- + test04AccessingInternalMemory + "Check whether we can use a ByteArrayWriter to fill structures." + + | composite | + composite := FFITestSUfdUdSi2 new. + + self assert: composite ~~ composite writer. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self deny: 3.5 equals: composite ufd1 f1. + composite writer ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self deny: 42 equals: composite udSii2 sii1 i1. + composite writer udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: ExternalStructureTests>>test05AccessingExternalMemory (in category 'tests') ----- + test05AccessingExternalMemory + "Check whether we will stick to the ExternalAddress to fill structures." + + | composite | + composite := heapObject := FFITestSUfdUdSi2 externalNew. + heapObject zeroMemory. + + self assert: composite == composite writer. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: ExternalStructureTests>>test06AccessingTypeAliasForAtomic (in category 'tests') ----- + test06AccessingTypeAliasForAtomic + + | char | + self should: [FFITestCharAlias new] raise: Error. + char := FFITestCharAlias fromHandle: $C. + self assert: $C equals: char value. + char value: $A. + self assert: $A equals: char value. + char zeroMemory. + self assert: $0 equals: char value.! Item was added: + ExternalTypeAlias subclass: #FFITestCharAlias + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestCharAlias class>>originalTypeName (in category 'type alias') ----- + originalTypeName + + ^ 'char'! From marcel.taeumel at hpi.de Mon May 3 17:01:20 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 3 May 2021 19:01:20 +0200 Subject: [squeak-dev] FFI: FFI-Kernel-mt.126.mcz In-Reply-To: References: Message-ID: Hi all! Sorry for the feature-mix in this commit. Please let me know whether those are good names: #writer #zeroMemory I know "ZeroMemory(...)" from the win32-API. And "writer" is just small enough to squeeze it in when changing a composite struct: composite := FFITestSUfdUdSi2 new. "object memory / byte array" composite writer udSii2 sii1 i1: 42. Best, Marcel Am 03.05.2021 18:54:03 schrieb commits at source.squeak.org : Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.126.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.126 Author: mt Time: 3 May 2021, 6:53:53.131479 pm UUID: efa27be5-2153-1c47-b30f-b8d9ca10b1c8 Ancestors: FFI-Kernel-mt.125 Adds a transparent way to write into composite structures that reside in object memory: #writer. (Name is up for discussion, especially since the namespace for custom structs is limited.) Adds #zeroMemory to remove information from internal or external memory. Fixes regression in ExternalData >> #free. Adds sanity checks to ExternalStructure #new and #externalNew, which both made no sense for type aliases. =============== Diff against FFI-Kernel-mt.125 =============== Item was added: + ----- Method: ByteArray>>zeroMemory (in category '*FFI-Kernel') ----- + zeroMemory + + self atAllPut: 0.! Item was added: + ----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel') ----- + zeroMemory: numBytes + + 1 to: numBytes do: [:index | + self byteAt: index put: 0].! Item was added: + ProtoObject subclass: #ByteArrayWriter + instanceVariableNames: 'byteOffset byteSize byteArray' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! + + !ByteArrayWriter commentStamp: 'mt 5/3/2021 17:44' prior: 0! + I am a transparent wrapper over byte-array handles to allow access and manipulation just like through an external address.! Item was added: + ----- Method: ByteArrayWriter class>>on: (in category 'instance creation') ----- + on: handle + + self assert: [handle isInternalMemory]. + ^ self new setArray: handle! Item was added: + ----- Method: ByteArrayWriter>>doesNotUnderstand: (in category 'system primitives') ----- + doesNotUnderstand: aMessage + + | selector args | + selector := aMessage selector. + args := aMessage arguments. + args size caseOf: { + [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. + [ 2 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args second > byteSize + ifTrue: [self errorSubscriptBounds: args first + args second] ] + ifFalse: [(selector endsWith: 'put:') ifTrue: [ + args at: 1 put: args first + byteOffset ]] ]. + [ 3 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args third > byteSize + ifTrue: [self errorSubscriptBounds: args first + args third]]] + } otherwise: []. + ^ aMessage sendTo: byteArray! Item was added: + ----- Method: ByteArrayWriter>>errorSubscriptBounds: (in category 'initialization') ----- + errorSubscriptBounds: index + + Error signal: 'subscript is out of bounds: ' , index printString.! Item was added: + ----- Method: ByteArrayWriter>>setArray: (in category 'initialization') ----- + setArray: aByteArray + + byteArray := aByteArray. + byteOffset := 0. + byteSize := aByteArray size.! Item was added: + ----- Method: ByteArrayWriter>>setArray:offset:size: (in category 'initialization') ----- + setArray: aByteArray offset: aByteOffset size: aByteSize + + byteArray := aByteArray. + byteOffset := aByteOffset. + byteSize := aByteSize. + + (byteOffset + byteSize > byteArray size) + ifTrue: [self errorSubscriptBounds: byteOffset + byteSize].! Item was added: + ----- Method: ByteArrayWriter>>structAt:length: (in category 'accessing') ----- + structAt: newByteOffset length: newLength + + ^ ByteArrayWriter new + setArray: byteArray + offset: byteOffset + newByteOffset - 1 + size: newLength! Item was added: + ----- Method: ByteArrayWriter>>structAt:put:length: (in category 'accessing') ----- + structAt: newByteOffset put: value length: newLength + + (newByteOffset + newLength > byteSize) + ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. + + ^ byteArray + structAt: byteOffset + newByteOffset - 1 + put: value + length: newLength! Item was added: + ----- Method: Character class>>zero (in category '*FFI-Kernel') ----- + zero + "See ExternalStructure >> #zeroMemory." + + ^ $0! Item was added: + ----- Method: ExternalAddress>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "We need length information in bytes." + self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>free (in category 'initialize-release') ----- + free + + super free. + size := nil.! Item was added: + ----- Method: ExternalData>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "Remove all information but keep the memory allocated." + + self sizeCheck. + + handle isExternalAddress + ifTrue: [handle zeroMemory: self size * self contentType byteSize] + ifFalse: [ "ByteArray" handle zeroMemory].! Item was changed: ----- Method: ExternalStructure class>>externalNew (in category 'instance creation') ----- externalNew "Create an instance of the receiver on the external heap" + + ^ self fromHandle: (self externalType isTypeAliasForAtomic + ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] + ifFalse: [ + self externalType isTypeAliasForPointer + ifTrue: [ByteArray new: self byteSize] + ifFalse: [ExternalAddress allocate: self byteSize]])! - ^self fromHandle: (ExternalAddress allocate: self byteSize)! Item was changed: ----- Method: ExternalStructure class>>new (in category 'instance creation') ----- new + ^self fromHandle: (self externalType isTypeAliasForAtomic + ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] + ifFalse: [ByteArray new: self byteSize]).! - ^self fromHandle: (ByteArray new: self byteSize)! Item was added: + ----- Method: ExternalStructure class>>newZero (in category 'instance creation') ----- + newZero + + ^ self new + zeroMemory; + yourself! Item was added: + ----- Method: ExternalStructure>>writer (in category 'accessing') ----- + writer + + ^ handle isInternalMemory + "Wrap handle into helper to address offsets in the byte array." + ifTrue: [self class fromHandle: (ByteArrayWriter on: handle)] + "Either alias-to-atomic or already in external memory." + ifFalse: [self]! Item was added: + ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') ----- + zeroMemory + "Remove all information but keep the memory allocated." + + handle isExternalAddress + ifTrue: [handle zeroMemory: self externalType byteSize] + ifFalse: [handle isInternalMemory + ifTrue: [handle zeroMemory] + ifFalse: [ + "Alias-to-atomic type." + handle := handle class zero]].! -------------- next part -------------- An HTML attachment was scrubbed... URL: From jakres+squeak at gmail.com Mon May 3 17:10:03 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Mon, 3 May 2021 19:10:03 +0200 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1620045647256-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> Message-ID: Let's look into the ANSI standard, because there is not much more that we have as a guideline: Message return "Nil is return[ed] as the value of the protected block of the active exception handler. Before returning, the exception environment and the evaluation context are restored to the same states that were in effect when the active handler was created using #on:do:. Restoring the evaluation context may result in the execution of #ensure: or #ifCurtailed: termination blocks." Message signal "If the evaluation of the exception action returns normally (as if it had returned from the #value: message), the handler environment is restored and the value returned from the exception action is returned as the value of the #on:do: message that created the handler. Before returning, any active #ensure: or #ifCurtailed: termination blocks created during evaluation of the receiver of the #on:do: message are evaluated." Since an empty block evaluates to nil, it seems that the intention is that both on: Error do: [] and on: Error do: [:e | e return] have the same effect. I am not sure if it is intentional that they wrote "may" with regards to the termination blocks for return, whereas they did not for signal. Specializing return: further is not covered by the standard, of course. One could argue that the return: message should not be sent to the Exception object when the exception action returns normally because that is not what it says in the specification of signal, and signal is not redefined by redefining return:. If we do send return: to the Exception, some code might come to rely on this implementation-specific behavior, just like the original ProgressNotificationException handling relied on the implementation of handler de/activation. Am Mo., 3. Mai 2021 um 14:40 Uhr schrieb Jaromir Matas : > > Actually, I guess the question can be reduced to: > > Is > > /[] on: Exception do: []/ > > only a shortcut for > > /[] on: Exception do: [:ex | ex return] / > > or are they two distinct structures? > > If the answer is yes, we might even write: > > handleSignal: exception > "Sent to handler (on:do:) contexts only. > Execute the handler action block" > > "just a marker, fail and execute the following" > exception privHandlerContext: self contextTag. "set exception's > handlerContext" > self deactivateHandler. "Prevent re-entering the action block, unless it is > explicitely rearmed" > [exception return: (self fireHandlerActionForSignal: exception)] ensure: > [self reactivateHandler] > "return from exception's handlerContext if not otherwise directed in the > handler action block" > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From commits at source.squeak.org Mon May 3 18:41:52 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 3 May 2021 18:41:52 0000 Subject: [squeak-dev] The Trunk: Kernel-nice.1399.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1399.mcz ==================== Summary ==================== Name: Kernel-nice.1399 Author: nice Time: 3 May 2021, 8:41:29.262256 pm UUID: 90c075cb-6d99-844c-8e53-e697592fe7a1 Ancestors: Kernel-jar.1398 Apply Jaromir fix for nested outed to resumeEvaluating:. Let resumeUnchecked: rely on resumeEvaluating: in order to avoid code duplication. Document the (tempAt: 2/tempAt: 2 put:) used in unwinding. =============== Diff against Kernel-jar.1398 =============== Item was changed: ----- Method: Context>>resumeEvaluating: (in category 'controlling') ----- resumeEvaluating: aBlock "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: aBlock value to: self]. ctxt := thisContext. [ ctxt := ctxt findNextUnwindContextUpTo: self. ctxt isNil ] whileFalse: [ (ctxt tempAt: 2) ifNil:[ + "(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed: + or any other method marked with " ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: self. ^ aBlock value ! Item was changed: ----- Method: Exception>>resumeEvaluating: (in category 'handling') ----- resumeEvaluating: aBlock "Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer. The block is only evaluated after unwinding the stack." | ctxt | outerContext ifNil: [ signalContext returnEvaluating: aBlock ] ifNotNil: [ ctxt := outerContext. outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" + handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" ctxt returnEvaluating: aBlock ]. ! Item was changed: ----- Method: Exception>>resumeUnchecked: (in category 'handling') ----- resumeUnchecked: resumptionValue "Return resumptionValue as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer." + ^self resumeEvaluating: [resumptionValue]! - | ctxt | - outerContext ifNil: [ - signalContext return: resumptionValue - ] ifNotNil: [ - ctxt := outerContext. - outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" - handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" - ctxt return: resumptionValue - ]. - ! From nicolas.cellier.aka.nice at gmail.com Mon May 3 18:46:55 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 3 May 2021 20:46:55 +0200 Subject: [squeak-dev] The Trunk: Kernel-nice.1394.mcz In-Reply-To: <1620049926319-0.post@n4.nabble.com> References: <1619962586071-0.post@n4.nabble.com> <1620049926319-0.post@n4.nabble.com> Message-ID: Good analysis, thanks, and done ! Le lun. 3 mai 2021 à 15:52, Jaromir Matas a écrit : > > Hi Nicolas, > > >> If you approve the change, Exception>>resumeEvaluating will become > >> obsolete > >> and could be removed. > >> > > > Sure, we should do so ASAP, less code = me happier :) > > I overlooked your use of #resumeEvaluating in ProgressInitiationException... > so can't be removed. > > In that case #resumeEvaluating should probably incorporate the fix for > #outer behavior as per #resumeUnchecked. > > resumeEvaluating: aBlock > "Return result of evaluating aBlock as the value of #signal, unless this > was called after an #outer message, then return resumptionValue as the value > of #outer. > The block is only evaluated after unwinding the stack." > > | ctxt | > outerContext ifNil: [ > signalContext returnEvaluating: aBlock > ] ifNotNil: [ > ctxt := outerContext. > outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" > --add----> handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" > ctxt returnEvaluating: aBlock > ]. > > To avoid code duplication it might make sense to just run #resumeUnchecked > through #resumeEvaluating like this: > > resumeUnchecked: resumptionValue > > self resumeEvaluating: [resumptionValue] > > best, > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From m at jaromir.net Mon May 3 21:59:39 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 3 May 2021 16:59:39 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> Message-ID: <1620079179703-0.post@n4.nabble.com> Hi Jakob, > One could argue that the return: message should not be sent to > the Exception object when the exception action returns normally > because that is not what it says in the specification of signal, and > signal is not redefined by redefining return:. Yes! I like this argument. I reopened this issue because it happened to me that the two types of return didn't return to the same context - it means one exception behaved as if it had two different handler contexts (it was caused by a bug in #outer implementation and it's fixed now). I think both returns should at least return to the same handler context if nothing else. For lack of a more realistic scenario look at this example: | x | x:=''. [ [1/0] on: ZeroDivide do: [:ex | ex signal. ex return]. "handler 1" x:=x,'1' ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" x:=x,'2'. x ----> answers '2' correctly because the active handler is handler 2. However, if you replace ex return in handler 1 by the implicit return, it all of a sudden answers '12' ! It's because #handleSignal invoked for handler 1 returns to self (= handler 1) instead of to the exception's handlerContext (=handler 2). So actually, we don't need to send return to the exception to fix this, it would suffice to use just the exception's handler context to return to - what do you think? Here's what I mean: handleSignal: exception "Sent to handler (on:do:) contexts only. Execute the handler action block" | val | "just a marker, fail and execute the following" exception privHandlerContext: self contextTag. self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed" val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler]. ----> exception privHandlerContext return: val "return from exception's handlerContext if not otherwise directed in the handler action block" ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Tue May 4 07:54:27 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 07:54:27 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.127.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.127.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.127 Author: mt Time: 4 May 2021, 9:54:26.141881 am UUID: 143e5c5b-ccff-9143-823d-4d6657005d2c Ancestors: FFI-Kernel-mt.126 Makes extra type checks optional, disabled by default. (This feature more care because some checks are wrong. Thanks to Ron for reporting this!) (Also fixes Character zero, which should actually be the NUL character.) =============== Diff against FFI-Kernel-mt.126 =============== Item was changed: ----- Method: Character class>>zero (in category '*FFI-Kernel') ----- zero "See ExternalStructure >> #zeroMemory." + ^ Character value: 0! - ^ $0! Item was changed: ----- Method: ExternalStructureType>>checkType (in category 'external structure') ----- checkType + self class extraTypeChecks ifFalse: [^ self]. + self assert: [self isPointerType not] description: 'Convert to ExternalType to use this feature'. referentClass ifNil: [self error: 'Unknown structure type']. self isEmpty ifTrue: [self error: 'Empty structure']. ! Item was changed: ----- Method: ExternalStructureType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." | result | + self checkType. - self - assert: [self isPointerType not] - description: 'Use ExternalStructure to use this feature.'. - referentClass ifNil: [self error: 'Unknown structure type']. - self isEmpty ifTrue: [self error: 'Empty structure']. - result := self isAtomic ifTrue: [ handle "alias to atomic" perform: (AtomicSelectors at: self atomicType) with: byteOffset] ifFalse: [ handle "regular struct or alias to struct or alias to pointer" structAt: byteOffset length: self byteSize]. ^ referentClass fromHandle: result! Item was changed: ----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + self checkType. - self - assert: [self isPointerType not] - description: 'Use ExternalType to use this feature.'. - - referentClass ifNil: [self error: 'Unknown structure type']. - self isEmpty ifTrue: [self error: 'Empty structure']. self isAtomic ifTrue: [ "alias to atomic" self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." ^ handle perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol with: byteOffset with: value getHandle] ifFalse: [ "regular struct or alias to struct or alias to pointer" self assert: [value externalType == self]. ^ handle structAt: byteOffset put: value getHandle length: self byteSize].! Item was changed: ----- Method: ExternalStructureType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName "this is an aliased structure type" "expect the value have that structure type with either byte array or external address as handle" self checkType. ^ String streamContents: [:s | + self class extraTypeChecks ifTrue: [ + s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab. s nextPutAll:'handle := ', valueName,' getHandle']! Item was changed: ----- Method: ExternalStructureType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self checkType. ^String streamContents:[:s| self isAtomic ifTrue: [ "alias to atomic" + self class extraTypeChecks ifTrue: [ + self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." s nextPutAll:'handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll: ' getHandle'] ifFalse: [ "regular struct or alias to struct or alias to pointer" + self class extraTypeChecks ifTrue: ["expect either byte array or external address as handle" + s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - "expect either byte array or external address as handle" - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab. self isTypeAliasForPointer ifFalse: [ s nextPutAll:'handle structAt: '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle'; nextPutAll:' length: '; print: self byteSize; nextPutAll:'.'] ifTrue: [ s nextPutAll:'handle pointerAt: '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle asExternalPointer'; nextPutAll:' length: '; print: self byteSize; nextPutAll:'.']]].! Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' + classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes' - classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes StructTypes' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects. Instance variables: compiledSpec Compiled specification of the external type referentClass Class type of argument required referencedType Associated (non)pointer type with the receiver byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed. Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following: FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits. FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly. [Note: Other combinations may be allowed in the future] ! Item was added: + ----- Method: ExternalType class>>extraTypeChecks (in category 'preferences') ----- + extraTypeChecks + + ^ExtraTypeChecks ifNil:[false]! Item was added: + ----- Method: ExternalType class>>extraTypeChecks: (in category 'preferences') ----- + extraTypeChecks: aBoolean + + ExtraTypeChecks = aBoolean ifTrue: [^ self]. + + ExtraTypeChecks := aBoolean. + + Cursor wait showWhile: [ + "Recompile all compiled artifacts." + ExternalStructure defineAllFields].! Item was changed: ----- Method: ExternalType>>checkType (in category 'external structure') ----- checkType + self class extraTypeChecks ifFalse: [^ self]. + (self isPointerType not and: [referentClass notNil]) ifTrue: [self error: 'Must convert to ExternalStructureType before use']. self assert: [self isStructureType not] description: 'Convert to ExternalStructureType to use this feature'.! Item was changed: ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName self checkType. ^ String streamContents: [:s | self isPointerType ifFalse: [ "this is an aliased atomic non-pointer type" + self class extraTypeChecks ifTrue: [ + self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." s nextPutAll:'handle := ', valueName, '.'] ifTrue: [ "this is an aliased pointer type" + self class extraTypeChecks ifTrue: ["expect the value to be a structure/union/alias/data with an external address as handle" + s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - "expect the value to be a structure/union/alias/data with an external address as handle" - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab. s nextPutAll:'handle := ', valueName,' getHandle asByteArrayPointer']]! Item was changed: ----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self checkType. ^ String streamContents: [:s | self isPointerType ifFalse: [ "Atomic value" + self class extraTypeChecks ifTrue: [ + self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." s nextPutAll:'handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName] ifTrue: [ "Pointer to structure, union, type alias, or external data." + self class extraTypeChecks ifTrue: [ + s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab. s nextPutAll:'handle pointerAt: '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle'; nextPutAll: ' length: '; print: self byteSize; nextPutAll: '.']]! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. "Split up types for external structures from atomic types." ExternalType resetAllStructureTypes. + "Re-generate all field accessors because type checks are now controlled by a new preference." - "Re-generate all field accessors because there are now type checks, too." ExternalStructure defineAllFields. '! From commits at source.squeak.org Tue May 4 08:57:24 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 08:57:24 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.23.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.23.mcz ==================== Summary ==================== Name: FFI-Tools-mt.23 Author: mt Time: 4 May 2021, 10:57:22.658881 am UUID: 1c015fd1-e56d-a84a-b4c8-5987e99cbcbd Ancestors: FFI-Tools-mt.22 In object explorers, change the repersentation of compiledSpec to better reflect its intentions. I suppose. :-) Note that compiledSpec is a WordArray. I changed the appearance of the words in the array to distinguish atomic type, type flags, byte size, and start/end of embedded structs. =============== Diff against FFI-Tools-mt.22 =============== Item was added: + ObjectExplorerWrapper subclass: #CompiledSpecWrapper + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'FFIConstants' + category: 'FFI-Tools'! Item was added: + ----- Method: CompiledSpecWrapper>>contents (in category 'accessing') ----- + contents + + ^ self object isInteger ifTrue: [#()] ifFalse: [ "WordArray" + Array streamContents: [:s | + self object withIndexDo: [:word :index | + s nextPut: (self class + with: word + name: index printString + model: self model)]]]! Item was added: + ----- Method: CompiledSpecWrapper>>objectString (in category 'accessing') ----- + objectString + + ^ self object isInteger + ifFalse: [self printWordArray] + ifTrue: [self printWordArrayElement]! Item was added: + ----- Method: CompiledSpecWrapper>>print:base:group:length: (in category 'printing') ----- + print: integer base: base group: group length: length + + ^ String streamContents: [:stream | + | label | + label := integer printStringBase: base. + label := label padded: #left to: length with: $0. + (1 to: label size by: group) + do: [:index | + 1 to: group do: [:gIndex | + stream nextPut: (label at: index + gIndex - 1)]] + separatedBy: [stream space]]! Item was added: + ----- Method: CompiledSpecWrapper>>printWordArray (in category 'printing') ----- + printWordArray + + ^ String streamContents: [:stream | + stream nextPutAll: '16r ['. + self object + do: [:word | stream nextPutAll: (self print: word base: 16 group: 2 length: 8)] + separatedBy: [stream nextPutAll: ' | ']. + stream nextPut: $] ]! Item was added: + ----- Method: CompiledSpecWrapper>>printWordArrayElement (in category 'printing') ----- + printWordArrayElement + + ^ String streamContents: [:stream | + + | atomicType externalType byteSize isStructStart isStructEnd isHeader | + atomicType := (self object bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift. + externalType := (self object bitAnd: 16rFF0000) >> (FFIAtomicTypeShift - 8). + byteSize := (self object bitAnd: FFIStructSizeMask). + + isHeader := self itemName = '1'. + isStructStart := isHeader not and: [(self object anyMask: FFIFlagStructure) and: [byteSize ~= 0]]. + isStructEnd := (self object anyMask: FFIFlagStructure) and: [byteSize = 0]. + + stream + nextPutAll: (atomicType asString padded: #left to: 2 with: Character space); + nextPutAll: ' | '; + nextPutAll: (self print: externalType base: 2 group: 4 length: 8); + nextPutAll: ' | '; + nextPutAll: (self print: byteSize base: 16 group: 2 length: 4); + nextPutAll: ' ('; + nextPutAll: byteSize asString; + nextPutAll: ' bytes)'. + isHeader ifTrue: [stream nextPutAll: ' --- HEADER']. + isStructStart ifTrue: [stream nextPutAll: ' --- STRUCT START']. + isStructEnd ifTrue: [stream nextPutAll: ' --- STRUCT END']].! Item was added: + ----- Method: ExternalType>>explorerContents (in category '*FFI-Tools') ----- + explorerContents + + | basicExplorerFields | + basicExplorerFields := super explorerContents. + basicExplorerFields do: [:explorerField | + explorerField itemName = 'compiledSpec' ifTrue: [ + explorerField changeClassTo: CompiledSpecWrapper]]. + ^ basicExplorerFields! From marcel.taeumel at hpi.de Tue May 4 08:59:33 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Tue, 4 May 2021 10:59:33 +0200 Subject: [squeak-dev] FFI: FFI-Tools-mt.23.mcz In-Reply-To: References: Message-ID: Am 04.05.2021 10:57:32 schrieb commits at source.squeak.org : Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.23.mcz ==================== Summary ==================== Name: FFI-Tools-mt.23 Author: mt Time: 4 May 2021, 10:57:22.658881 am UUID: 1c015fd1-e56d-a84a-b4c8-5987e99cbcbd Ancestors: FFI-Tools-mt.22 In object explorers, change the repersentation of compiledSpec to better reflect its intentions. I suppose. :-) Note that compiledSpec is a WordArray. I changed the appearance of the words in the array to distinguish atomic type, type flags, byte size, and start/end of embedded structs. =============== Diff against FFI-Tools-mt.22 =============== Item was added: + ObjectExplorerWrapper subclass: #CompiledSpecWrapper + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'FFIConstants' + category: 'FFI-Tools'! Item was added: + ----- Method: CompiledSpecWrapper>>contents (in category 'accessing') ----- + contents + + ^ self object isInteger ifTrue: [#()] ifFalse: [ "WordArray" + Array streamContents: [:s | + self object withIndexDo: [:word :index | + s nextPut: (self class + with: word + name: index printString + model: self model)]]]! Item was added: + ----- Method: CompiledSpecWrapper>>objectString (in category 'accessing') ----- + objectString + + ^ self object isInteger + ifFalse: [self printWordArray] + ifTrue: [self printWordArrayElement]! Item was added: + ----- Method: CompiledSpecWrapper>>print:base:group:length: (in category 'printing') ----- + print: integer base: base group: group length: length + + ^ String streamContents: [:stream | + | label | + label := integer printStringBase: base. + label := label padded: #left to: length with: $0. + (1 to: label size by: group) + do: [:index | + 1 to: group do: [:gIndex | + stream nextPut: (label at: index + gIndex - 1)]] + separatedBy: [stream space]]! Item was added: + ----- Method: CompiledSpecWrapper>>printWordArray (in category 'printing') ----- + printWordArray + + ^ String streamContents: [:stream | + stream nextPutAll: '16r ['. + self object + do: [:word | stream nextPutAll: (self print: word base: 16 group: 2 length: 8)] + separatedBy: [stream nextPutAll: ' | ']. + stream nextPut: $] ]! Item was added: + ----- Method: CompiledSpecWrapper>>printWordArrayElement (in category 'printing') ----- + printWordArrayElement + + ^ String streamContents: [:stream | + + | atomicType externalType byteSize isStructStart isStructEnd isHeader | + atomicType := (self object bitAnd: FFIAtomicTypeMask) >> FFIAtomicTypeShift. + externalType := (self object bitAnd: 16rFF0000) >> (FFIAtomicTypeShift - 8). + byteSize := (self object bitAnd: FFIStructSizeMask). + + isHeader := self itemName = '1'. + isStructStart := isHeader not and: [(self object anyMask: FFIFlagStructure) and: [byteSize ~= 0]]. + isStructEnd := (self object anyMask: FFIFlagStructure) and: [byteSize = 0]. + + stream + nextPutAll: (atomicType asString padded: #left to: 2 with: Character space); + nextPutAll: ' | '; + nextPutAll: (self print: externalType base: 2 group: 4 length: 8); + nextPutAll: ' | '; + nextPutAll: (self print: byteSize base: 16 group: 2 length: 4); + nextPutAll: ' ('; + nextPutAll: byteSize asString; + nextPutAll: ' bytes)'. + isHeader ifTrue: [stream nextPutAll: ' --- HEADER']. + isStructStart ifTrue: [stream nextPutAll: ' --- STRUCT START']. + isStructEnd ifTrue: [stream nextPutAll: ' --- STRUCT END']].! Item was added: + ----- Method: ExternalType>>explorerContents (in category '*FFI-Tools') ----- + explorerContents + + | basicExplorerFields | + basicExplorerFields := super explorerContents. + basicExplorerFields do: [:explorerField | + explorerField itemName = 'compiledSpec' ifTrue: [ + explorerField changeClassTo: CompiledSpecWrapper]]. + ^ basicExplorerFields! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 69103 bytes Desc: not available URL: From jakres+squeak at gmail.com Tue May 4 09:46:42 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Tue, 4 May 2021 11:46:42 +0200 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1620079179703-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> Message-ID: Oh well, I am not even sure whether sending both resume and then return to the Exception is even well-defined behavior according to the standard. Since return is specified referring to the "active exception handler", it should return from the on: do: handler 1 in your example. So I would in fact expect to get '12' in both cases. Handler 2 is no longer active after the resume. Am Mo., 3. Mai 2021 um 23:59 Uhr schrieb Jaromir Matas : > > Hi Jakob, > > > One could argue that the return: message should not be sent to > > the Exception object when the exception action returns normally > > because that is not what it says in the specification of signal, and > > signal is not redefined by redefining return:. > > Yes! I like this argument. I reopened this issue because it happened to me > that the two types of return didn't return to the same context - it means > one exception behaved as if it had two different handler contexts (it was > caused by a bug in #outer implementation and it's fixed now). I think both > returns should at least return to the same handler context if nothing else. > > For lack of a more realistic scenario look at this example: > > | x | > x:=''. > [ > [1/0] on: ZeroDivide do: [:ex | ex signal. ex return]. "handler 1" > x:=x,'1' > ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" > x:=x,'2'. > x > > ----> answers '2' correctly because the active handler is handler 2. > > However, if you replace ex return in handler 1 by the implicit return, it > all of a sudden answers '12' ! It's because #handleSignal invoked for > handler 1 returns to self (= handler 1) instead of to the exception's > handlerContext (=handler 2). > > So actually, we don't need to send return to the exception to fix this, it > would suffice to use just the exception's handler context to return to - > what do you think? Here's what I mean: > > handleSignal: exception > "Sent to handler (on:do:) contexts only. > Execute the handler action block" > > | val | > "just a marker, fail and execute the following" > exception privHandlerContext: self contextTag. > self deactivateHandler. "Prevent re-entering the action block, unless it is > explicitely rearmed" > val := [self fireHandlerActionForSignal: exception] ensure: [self > reactivateHandler]. > ----> exception privHandlerContext return: val > "return from exception's handlerContext if not otherwise directed in the > handler action block" > > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From commits at source.squeak.org Tue May 4 10:22:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 10:22:49 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.128.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.128.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.128 Author: mt Time: 4 May 2021, 12:22:47.736881 pm UUID: b1af22ec-1c21-a544-82f7-af8466544ab9 Ancestors: FFI-Kernel-mt.127 Renames byte-array writer to read-writer because it can improve reading by avoiding intermediate copies. Fixes and refactors #from:to: in ExternalData to support ByteArrayReadWriter by just re-using #structAt:length:, which works as expected on ByteArray and ExternalAddress. Signal an exception when trying to instantiate external data without a type. Adds some common accessors known from sequenceable collections to external data to help write more compact tests. =============== Diff against FFI-Kernel-mt.127 =============== Item was changed: SystemOrganization addCategory: #'FFI-Kernel'! + SystemOrganization addCategory: #'FFI-Kernel-Support'! Item was added: + ProtoObject subclass: #ByteArrayReadWriter + instanceVariableNames: 'byteOffset byteSize byteArray' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !ByteArrayReadWriter commentStamp: 'mt 5/3/2021 17:44' prior: 0! + I am a transparent wrapper over byte-array handles to allow access and manipulation just like through an external address.! Item was added: + ----- Method: ByteArrayReadWriter class>>on: (in category 'instance creation') ----- + on: handle + "Wraps the given handle into a read-writer. Avoid double-wrapping." + + self assert: [handle isInternalMemory]. + + ^ (thisContext objectClass: handle) == self + ifTrue: [handle] + ifFalse: [self new setArray: handle]! Item was added: + ----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') ----- + doesNotUnderstand: aMessage + + | selector args | + selector := aMessage selector. + args := aMessage arguments. + args size caseOf: { + [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. + [ 2 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args second > byteSize + ifTrue: [self errorSubscriptBounds: args first + args second] ] + ifFalse: [(selector endsWith: 'put:') ifTrue: [ + args at: 1 put: args first + byteOffset ]] ]. + [ 3 ] -> [ (selector endsWith: 'length:') + ifTrue: [ + args at: 1 put: args first + byteOffset. + args first + args third > byteSize + ifTrue: [self errorSubscriptBounds: args first + args third]]] + } otherwise: []. + ^ aMessage sendTo: byteArray! Item was added: + ----- Method: ByteArrayReadWriter>>errorSubscriptBounds: (in category 'initialization') ----- + errorSubscriptBounds: index + + Error signal: 'subscript is out of bounds: ' , index printString.! Item was added: + ----- Method: ByteArrayReadWriter>>setArray: (in category 'initialization') ----- + setArray: aByteArray + + byteArray := aByteArray. + byteOffset := 0. + byteSize := aByteArray size.! Item was added: + ----- Method: ByteArrayReadWriter>>setArray:offset:size: (in category 'initialization') ----- + setArray: aByteArray offset: aByteOffset size: aByteSize + + byteArray := aByteArray. + byteOffset := aByteOffset. + byteSize := aByteSize. + + (byteOffset + byteSize > byteArray size) + ifTrue: [self errorSubscriptBounds: byteOffset + byteSize].! Item was added: + ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'accessing') ----- + structAt: newByteOffset length: newLength + + ^ ByteArrayReadWriter new + setArray: byteArray + offset: byteOffset + newByteOffset - 1 + size: newLength! Item was added: + ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'accessing') ----- + structAt: newByteOffset put: value length: newLength + + (newByteOffset + newLength > byteSize) + ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. + + ^ byteArray + structAt: byteOffset + newByteOffset - 1 + put: value + length: newLength! Item was removed: - ProtoObject subclass: #ByteArrayWriter - instanceVariableNames: 'byteOffset byteSize byteArray' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Kernel'! - - !ByteArrayWriter commentStamp: 'mt 5/3/2021 17:44' prior: 0! - I am a transparent wrapper over byte-array handles to allow access and manipulation just like through an external address.! Item was removed: - ----- Method: ByteArrayWriter class>>on: (in category 'instance creation') ----- - on: handle - - self assert: [handle isInternalMemory]. - ^ self new setArray: handle! Item was removed: - ----- Method: ByteArrayWriter>>doesNotUnderstand: (in category 'system primitives') ----- - doesNotUnderstand: aMessage - - | selector args | - selector := aMessage selector. - args := aMessage arguments. - args size caseOf: { - [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. - [ 2 ] -> [ (selector endsWith: 'length:') - ifTrue: [ - args at: 1 put: args first + byteOffset. - args first + args second > byteSize - ifTrue: [self errorSubscriptBounds: args first + args second] ] - ifFalse: [(selector endsWith: 'put:') ifTrue: [ - args at: 1 put: args first + byteOffset ]] ]. - [ 3 ] -> [ (selector endsWith: 'length:') - ifTrue: [ - args at: 1 put: args first + byteOffset. - args first + args third > byteSize - ifTrue: [self errorSubscriptBounds: args first + args third]]] - } otherwise: []. - ^ aMessage sendTo: byteArray! Item was removed: - ----- Method: ByteArrayWriter>>errorSubscriptBounds: (in category 'initialization') ----- - errorSubscriptBounds: index - - Error signal: 'subscript is out of bounds: ' , index printString.! Item was removed: - ----- Method: ByteArrayWriter>>setArray: (in category 'initialization') ----- - setArray: aByteArray - - byteArray := aByteArray. - byteOffset := 0. - byteSize := aByteArray size.! Item was removed: - ----- Method: ByteArrayWriter>>setArray:offset:size: (in category 'initialization') ----- - setArray: aByteArray offset: aByteOffset size: aByteSize - - byteArray := aByteArray. - byteOffset := aByteOffset. - byteSize := aByteSize. - - (byteOffset + byteSize > byteArray size) - ifTrue: [self errorSubscriptBounds: byteOffset + byteSize].! Item was removed: - ----- Method: ByteArrayWriter>>structAt:length: (in category 'accessing') ----- - structAt: newByteOffset length: newLength - - ^ ByteArrayWriter new - setArray: byteArray - offset: byteOffset + newByteOffset - 1 - size: newLength! Item was removed: - ----- Method: ByteArrayWriter>>structAt:put:length: (in category 'accessing') ----- - structAt: newByteOffset put: value length: newLength - - (newByteOffset + newLength > byteSize) - ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. - - ^ byteArray - structAt: byteOffset + newByteOffset - 1 - put: value - length: newLength! Item was added: + ----- Method: ExternalData class>>fromHandle: (in category 'instance creation') ----- + fromHandle: aHandle + "We need type information. See #fromHandle:type:" + self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>eighth (in category 'accessing - convenience') ----- + eighth + + ^ self at: 8! Item was added: + ----- Method: ExternalData>>fifth (in category 'accessing - convenience') ----- + fifth + + ^ self at: 5! Item was added: + ----- Method: ExternalData>>first (in category 'accessing - convenience') ----- + first + + ^ self at: 1! Item was added: + ----- Method: ExternalData>>fourth (in category 'accessing - convenience') ----- + fourth + + ^ self at: 4! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." | byteOffset numElements byteSize newType | ((1 > firstIndex) or: [size notNil and: [lastIndex > size]]) ifTrue: [^ self errorSubscriptBounds: lastIndex]. byteOffset := ((firstIndex-1) * self contentType byteSize)+1. + numElements := lastIndex - firstIndex + 1 max: 0. - numElements := lastIndex - firstIndex + 1. byteSize := numElements * self contentType byteSize. "For portions of a null-terminated C string, change the type from char* to byte* to avoid confusion." newType := self containerType = ExternalType string ifTrue: [ExternalType byte asPointerType] ifFalse: [self containerType "No change"]. + ^ (ExternalData + fromHandle: (handle structAt: byteOffset length: byteSize) + type: newType) size: numElements; yourself! - ^ lastIndex < firstIndex - ifTrue: [ - handle isExternalAddress - ifTrue: [(ExternalData - fromHandle: handle + (byteOffset - 1) "Keep pointer." - type: newType) size: 0; yourself] - ifFalse: [(ExternalData - fromHandle: #[] "Empty memory" - type: newType) size: 0; yourself]] - ifFalse: [ - handle isExternalAddress - ifTrue: [(ExternalData - fromHandle: handle + (byteOffset - 1) - type: newType) size: numElements; yourself] - ifFalse: [(ExternalData - fromHandle: (handle copyFrom: byteOffset to: byteOffset+byteSize-1) - type: newType) size: numElements; yourself]]! Item was added: + ----- Method: ExternalData>>ninth (in category 'accessing - convenience') ----- + ninth + + ^ self at: 9! Item was added: + ----- Method: ExternalData>>second (in category 'accessing - convenience') ----- + second + + ^ self at: 2! Item was added: + ----- Method: ExternalData>>seventh (in category 'accessing - convenience') ----- + seventh + + ^ self at: 7! Item was added: + ----- Method: ExternalData>>sixth (in category 'accessing - convenience') ----- + sixth + + ^ self at: 6! Item was added: + ----- Method: ExternalData>>third (in category 'accessing - convenience') ----- + third + + ^ self at: 3! Item was added: + ----- Method: ExternalData>>writer (in category 'accessing') ----- + writer + "Overwritten to preserve type and size." + handle isInternalMemory ifFalse: [^ self]. + + ^ (self class + fromHandle: (ByteArrayReadWriter on: handle) + type: type) size: size; yourself! Item was added: + ----- Method: ExternalStructure>>reader (in category 'accessing') ----- + reader + + ^ self writer! Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer ^ handle isInternalMemory "Wrap handle into helper to address offsets in the byte array." + ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)] - ifTrue: [self class fromHandle: (ByteArrayWriter on: handle)] "Either alias-to-atomic or already in external memory." ifFalse: [self]! From commits at source.squeak.org Tue May 4 10:23:33 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 10:23:33 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.24.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.24.mcz ==================== Summary ==================== Name: FFI-Tests-mt.24 Author: mt Time: 4 May 2021, 12:23:31.205881 pm UUID: 1baeb097-81ea-2345-8bb8-b100fdb55983 Ancestors: FFI-Tests-mt.23 More tests. Complements FFI-Kernel-mt.128 =============== Diff against FFI-Tests-mt.23 =============== Item was added: + ----- Method: ExternalStructureTests>>test01FromToInternal (in category 'tests - external data') ----- + test01FromToInternal + "Access a sub-range in the external data. Internal memory will be copied if not accessed through a read-writer." + + | points portion | + points := FFITestPoint2 allocate: 5. + portion := points from: 2 to: 3. + self assert: portion getHandle isInternalMemory. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer early enough..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion := points writer from: 2 to: 3. + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + points zeroMemory. + portion := points reader from: 2 to: 3. + portion writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Both #reader and #writer used. No worries." + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: ExternalStructureTests>>test02FromToExternal (in category 'tests - external data') ----- + test02FromToExternal + "Access a sub-range in the external data. External memory will not be copied." + + | points portion | + points := heapObject := FFITestPoint2 allocateExternal: 5. + points zeroMemory. + + portion := points from: 2 to: 3. + self assert: portion getHandle isExternalAddress. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: ExternalStructureTests>>test03CopyFromExternalToInternal (in category 'tests - external data') ----- + test03CopyFromExternalToInternal + + | points copy | + points := FFITestPoint2 allocateExternal: 5. + points zeroMemory. + self assert: points getHandle isExternalAddress. + + copy := points copyFrom: 2 to: 3. + self assert: copy getHandle isInternalMemory. + + "We need a writer to modify internal memory." + copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + + "Check that we did not touch the external memory." + self + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: ExternalStructureTests>>test04CopyFromInternalToInternal (in category 'tests - external data') ----- + test04CopyFromInternalToInternal + + | points copy | + points := FFITestPoint2 allocate: 5. + self assert: points getHandle isInternalMemory. + + copy := points copyFrom: 2 to: 3. + self assert: copy getHandle isInternalMemory. + + "We need a writer to modify internal memory." + copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + + "Check that we did not touch the original." + self + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was changed: ----- Method: ExternalStructureTests>>test06AccessingTypeAliasForAtomic (in category 'tests') ----- test06AccessingTypeAliasForAtomic | char | self should: [FFITestCharAlias new] raise: Error. char := FFITestCharAlias fromHandle: $C. self assert: $C equals: char value. char value: $A. self assert: $A equals: char value. char zeroMemory. + self assert: 0 equals: char value asInteger.! - self assert: $0 equals: char value.! From commits at source.squeak.org Tue May 4 14:41:17 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 14:41:17 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.129.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.129.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.129 Author: mt Time: 4 May 2021, 4:41:16.129881 pm UUID: 3f7ca6ff-5440-8242-8b9f-d21f6255163a Ancestors: FFI-Kernel-mt.128 Fixes a minor glitch in the byte-array read-writer. =============== Diff against FFI-Kernel-mt.128 =============== Item was added: + ----- Method: ByteArrayReadWriter>>perform:with: (in category 'message handling') ----- + perform: aSymbol with: anObject + "Needed because of AtomicSelectors. See ExternalType >> #handle:at:." + + + ^ self perform: aSymbol withArguments: { anObject }! Item was added: + ----- Method: ByteArrayReadWriter>>perform:with:with: (in category 'message handling') ----- + perform: aSymbol with: firstObject with: secondObject + "Needed because of AtomicSelectors. See ExternalType >> #handle:at:put:." + + + ^ self perform: aSymbol withArguments: { firstObject. secondObject }! Item was changed: ----- Method: ByteArrayReadWriter>>setArray: (in category 'initialization') ----- setArray: aByteArray + self setArray: aByteArray offset: 0 size: aByteArray size.! - byteArray := aByteArray. - byteOffset := 0. - byteSize := aByteArray size.! From commits at source.squeak.org Tue May 4 14:43:43 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 14:43:43 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.24.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.24.mcz ==================== Summary ==================== Name: FFI-Tools-mt.24 Author: mt Time: 4 May 2021, 4:43:42.172881 pm UUID: 411d91ef-c5dc-3643-b69f-8c9620d93201 Ancestors: FFI-Tools-mt.23 Make use of the byte-array writer to conveniently explore composite structures along with proper support for do-it. Both of which is fine for heap objects but challenging for handles that are byte arrays. =============== Diff against FFI-Tools-mt.23 =============== Item was changed: ----- Method: ExternalObjectHandleWrapper>>objectString (in category 'accessing') ----- objectString + | label handle | + label := super objectString. + handle := self getHandle. - self getHandle class == ExternalAddress ifTrue: [^ super objectString]. - self getHandle class == ByteArray ifTrue: [^ super objectString]. + handle isExternalAddress ifTrue: [^ label]. + handle isInternalMemory ifTrue: [ + ^ (thisContext objectClass: handle) == ByteArrayReadWriter + ifFalse: [label] + ifTrue: [ | begin end | + label :=(thisContext object: handle instVarAt: 3) printString. + label := label copyFrom: 3 to: (label size - 1). + begin := (thisContext object: handle instVarAt: 1) + 1. + end := begin + (thisContext object: handle instVarAt: 2) - 1. + String streamContents: [:stream | + stream nextPutAll: '#[ '. + (label findTokens: ' ' "#[0 0 0 0 0]") withIndexDo: [:token :index | + (index between: begin and: end) + ifTrue: [stream nextPutAll: token] + ifFalse: ["Skip byte info" stream nextPut: $.]. + stream space]. + stream nextPutAll: ']'. + ]]]. + "Type aliases to atomic types store primitive Smalltalk objects in their handle. Indicate that role of actually being a handle for the FFI plugin with a small prefix." + ^ '-> ', label! - ^ '-> ', super objectString! Item was added: + ----- Method: ExternalStructure>>explore (in category '*FFI-Tools') ----- + explore + "Sneak in a reader so that do-its will work better from the obeject explorer." + + self reader perform: #explore withArguments: #() inSuperclass: ExternalObject.! From commits at source.squeak.org Tue May 4 14:51:44 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 14:51:44 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.130.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.130.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.130 Author: mt Time: 4 May 2021, 4:51:43.338881 pm UUID: 5c667740-5577-4541-876e-0be05657a18c Ancestors: FFI-Kernel-mt.129 Adds (simple?) support for array types such as char[12] or MyStruct[5]. Note that there is no plugin support for array types, which means that: 1. All FFI calls denoting array types will be passed as pointer type 2. Return types might work with atomic arrays (e.g. char[12]) but definitely not with struct arrays because the plugin will just give you a new instance of your struct with the handle, thus omitting the size information. Still, now you can finally embed array types in your struct definition: typedef struct { double d1; int32_t[5] a5i2; } FFITestSdA5i :-) More open tasks: - Array types are not cached and created on-demand. See #arrayTypeNamed: for placing a cache. - #typedef (in Tools) is not yet supported. =============== Diff against FFI-Kernel-mt.129 =============== Item was added: + ExternalType subclass: #ExternalArrayType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'as yet unclassified') ----- + newTypeForContentType: contentType size: numElements + "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" + + | type pointerType headerWord byteSize | + contentType ifNil: [^ nil]. + numElements < 0 ifTrue: [^ nil]. + + self + assert: [contentType isPointerType not] + description: 'No support for pointers as content type yet!!'. + + type := self basicNew. + pointerType := ExternalType basicNew. + + "1) Regular type" + byteSize := numElements * contentType byteSize. + self assert: [byteSize <= FFIStructSizeMask]. + headerWord := contentType headerWord copy. + headerWord := headerWord bitClear: FFIStructSizeMask. + headerWord := headerWord bitOr: byteSize. + type + setReferencedType: pointerType; + compiledSpec: (WordArray with: headerWord); + byteAlignment: contentType byteAlignment; + setReferentClass: contentType referentClass. + + "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." + pointerType + setReferencedType: type; + compiledSpec: contentType asPointerType compiledSpec copy; + byteAlignment: contentType asPointerType byteAlignment; + setReferentClass: contentType asPointerType referentClass. + + ^ type! Item was added: + ----- Method: ExternalArrayType>>checkType (in category 'external structure') ----- + checkType + + self class extraTypeChecks ifFalse: [^ self]. + + self + assert: [self isPointerType not] + description: 'Convert to ExternalType to use this feature'.! Item was added: + ----- Method: ExternalArrayType>>contentType (in category 'accessing') ----- + contentType + + ^ ExternalType typeNamed: super typeName! Item was added: + ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." + + self checkType. + + ^ (ExternalData + fromHandle: (handle structAt: byteOffset length: self byteSize) + type: self contentType) size: self size; yourself! Item was added: + ----- Method: ExternalArrayType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + + self checkType. + + handle + structAt: byteOffset + put: value getHandle + length: self byteSize.! Item was added: + ----- Method: ExternalArrayType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ true! Item was added: + ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. + Private. Used for field definition only." + + self checkType. + + ^ String streamContents:[:s | + s nextPutAll:'^ (ExternalData fromHandle: (handle structAt: '; + print: byteOffset; + nextPutAll: ' length: '; + print: self byteSize; + nextPutAll: ') type: '. + + self contentType isAtomic + ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName] + ifFalse: [s nextPutAll: self contentType typeName, ' externalType']. + + s nextPutAll: ') size: '; print: self size; nextPutAll: '; yourself']! Item was added: + ----- Method: ExternalArrayType>>size (in category 'accessing') ----- + size + "Answers the number of elements for this array type." + + ^ self byteSize / self contentType byteSize! Item was added: + ----- Method: ExternalArrayType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + aStream + nextPut: $(; + nextPutAll: ExternalType name; space; + nextPutAll: #arrayTypeNamed:; space; + store: self typeName; + nextPut: $).! Item was added: + ----- Method: ExternalArrayType>>typeName (in category 'accessing') ----- + typeName + + ^ String streamContents: [:stream | + stream + nextPutAll: super typeName; + nextPut: $[; + nextPutAll: self size asString; + nextPut: $]]! Item was added: + ----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') ----- + writeFieldArgName + + ^ 'anExternalData_', self contentType typeName, self size! Item was added: + ----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + self checkType. + + ^ String streamContents:[:s | + s nextPutAll:'handle structAt: '; + print: byteOffset; + nextPutAll: ' put: '; + nextPutAll: valueName; + nextPutAll: ' getHandle length: '; + print: self byteSize]! Item was added: + ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') ----- + arrayTypeNamed: typeName + "Lookup fails if content type is not present." + + | contentType | + self flag: #todo. "mt: Cache array types?" + + (contentType := self typeNamed: (typeName copyFrom: 1 to: (typeName indexOf: $[) - 1)) + ifNil: [^ nil]. + + ^ self newTypeNamed: typeName! Item was added: + ----- Method: ExternalType class>>newTypeForContentType:size: (in category 'instance creation') ----- + newTypeForContentType: contentType size: numElements + + ^ ExternalArrayType newTypeForContentType: contentType size: numElements! Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName + "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." + + | structClass contentType contentTypeName numElements | - - | structClass | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. + + aTypeName last == $] ifTrue: [ + "array type, e.g., char[50]" + contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1. + contentType := (self typeNamed: contentTypeName) "Create new if not already there." + ifNil: [self newTypeNamed: contentTypeName]. + numElements := ((aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger) + ifNil: [0]. + ^ self + newTypeForContentType: contentType + size: numElements]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. ^ structClass ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName "Supports pointer-type lookup for both atomic and structure types. Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'" + | isPointerType isArrayType actualTypeName type | + isArrayType := false. - | isPointerType actualTypeName type | (isPointerType := typeName last == $*) ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] + ifFalse: [(isArrayType := typeName last == $]) + ifFalse: [actualTypeName := typeName]]. - ifFalse: [actualTypeName := typeName]. + isArrayType + ifTrue: [^ self arrayTypeNamed: typeName]. + (Symbol lookup: actualTypeName) ifNotNil: [:sym | actualTypeName := sym]. type := (self atomicTypeNamed: actualTypeName) ifNil: [self structTypeNamed: actualTypeName]. ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was added: + ----- Method: ExternalType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was changed: ----- Method: Parser>>externalType: (in category '*FFI-Kernel') ----- externalType: descriptorClass "Parse and return an external type" + | xType typeName isArrayType | - | xType typeName | typeName := here. "Note that pointer token is not yet parsed!!" + self advance. + (isArrayType := self matchToken: $[) + ifTrue: [ + typeName := typeName, '[', here, ']'. + self advance. + self matchToken: $]]. (xType := descriptorClass typeNamed: typeName) ifNil: [ "Raise an error if user is there" self interactive ifTrue: [^nil]. "otherwise go over it silently -- use an unknown struct type" + xType := descriptorClass newTypeNamed: typeName]. + isArrayType ifTrue: [ + self flag: #todo. "mt: We must send arrays as pointers." + xType := xType asPointerType]. - xType := descriptorClass newTypeNamed: here]. - self advance. ^ (self matchToken: #*) ifTrue:[xType asPointerType] ifFalse:[(self matchToken: #**) ifTrue: [xType asPointerToPointerType] ifFalse: [xType]]! From commits at source.squeak.org Tue May 4 14:52:21 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 14:52:21 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.25.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.25.mcz ==================== Summary ==================== Name: FFI-Tests-mt.25 Author: mt Time: 4 May 2021, 4:52:20.680881 pm UUID: 7168c581-7b46-2243-bc64-c48a504ce87c Ancestors: FFI-Tests-mt.24 More tests. Complements FFI-Kernel-mt.130 =============== Diff against FFI-Tests-mt.24 =============== Item was added: + ----- Method: ExternalStructureTests>>test07AccessingArrays (in category 'tests') ----- + test07AccessingArrays + + | data | + data := FFITestSdA5i new. + self assert: data a5i2 first equals: 0. + data writer a5i2 at: 1 put: 42. + self assert: data a5i2 first equals: 42. + + data := heapObject := FFITestSdA5i externalNew. + data zeroMemory. + self assert: data a5i2 first equals: 0. + data a5i2 at: 1 put: 42. + self assert: data a5i2 first equals: 42.! Item was added: + ----- Method: FFITestLibrary class>>ffiTestArrayType (in category 'mocks') ----- + ffiTestArrayType + + + ^ self externalCallFailed ! Item was added: + ExternalStructure subclass: #FFITestSdA5i + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestSdA5i class>>fields (in category 'as yet unclassified') ----- + fields + " + FFITestSdA5i defineFields + " + ^ #( + (d1 'double') + (a5i2 'int32_t[5]') + )! Item was added: + ----- Method: FFITypeNameTests>>testArray (in category 'tests') ----- + testArray + + (self argTypesAt: #ffiTestArrayType) do: [:type | + self + assert: type isPointerType; + deny: type isArrayType; + assert: type asNonPointerType isArrayType; + assert: type asNonPointerType size >= 0]! From commits at source.squeak.org Tue May 4 14:52:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 14:52:47 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.25.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.25.mcz ==================== Summary ==================== Name: FFI-Tools-mt.25 Author: mt Time: 4 May 2021, 4:52:46.043881 pm UUID: 231205aa-3bb9-7142-a9d3-e3b1e52e121d Ancestors: FFI-Tools-mt.24 Shout support for array types. Complements FFI-Kernel-mt.130 =============== Diff against FFI-Tools-mt.24 =============== Item was changed: ----- Method: SHParserST80>>parseExternalCall (in category '*FFI-Tools') ----- parseExternalCall self addRangeType: #externalFunctionCallingConvention. [self scanNext. ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil] whileTrue. self failUnless: currentToken notNil. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]. + currentToken = '[' + ifTrue: ["array types return" + self scanPast: #externalCallType. + [currentTokenFirst ~= $]] + whileTrue: [ + self failUnless: currentTokenFirst isDigit. + self scanPast: #externalCallType]. + self scanPast: #externalCallType]. currentTokenFirst isDigit ifTrue: [self scanPast: #integer] ifFalse: [ self failUnless: currentTokenFirst == $'. self parseString]. self failUnless: currentTokenFirst == $(. self scanPast: #leftParenthesis. [currentTokenFirst ~= $)] whileTrue: [ self failUnless: currentToken notNil. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]]. self scanPast: #rightParenthesis. currentToken = 'module:' ifTrue: [ self scanPast: #module. self parseStringOrSymbol ]. currentToken = 'error:' ifTrue: [ self scanPast: #primitive. "there's no rangeType for error" self currentTokenType == #name ifTrue: [ self parseTemporary: #patternTempVar ] ifFalse: [ self parseStringOrSymbol ] ]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! From marcel.taeumel at hpi.de Tue May 4 14:54:40 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Tue, 4 May 2021 16:54:40 +0200 Subject: [squeak-dev] FFI: FFI-Kernel-mt.130.mcz In-Reply-To: References: Message-ID: Am 04.05.2021 16:51:53 schrieb commits at source.squeak.org : Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.130.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.130 Author: mt Time: 4 May 2021, 4:51:43.338881 pm UUID: 5c667740-5577-4541-876e-0be05657a18c Ancestors: FFI-Kernel-mt.129 Adds (simple?) support for array types such as char[12] or MyStruct[5]. Note that there is no plugin support for array types, which means that: 1. All FFI calls denoting array types will be passed as pointer type 2. Return types might work with atomic arrays (e.g. char[12]) but definitely not with struct arrays because the plugin will just give you a new instance of your struct with the handle, thus omitting the size information. Still, now you can finally embed array types in your struct definition: typedef struct { double d1; int32_t[5] a5i2; } FFITestSdA5i :-) More open tasks: - Array types are not cached and created on-demand. See #arrayTypeNamed: for placing a cache. - #typedef (in Tools) is not yet supported. =============== Diff against FFI-Kernel-mt.129 =============== Item was added: + ExternalType subclass: #ExternalArrayType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'as yet unclassified') ----- + newTypeForContentType: contentType size: numElements + "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" + + | type pointerType headerWord byteSize | + contentType ifNil: [^ nil]. + numElements < 0 ifTrue: [^ nil]. + + self + assert: [contentType isPointerType not] + description: 'No support for pointers as content type yet!!'. + + type := self basicNew. + pointerType := ExternalType basicNew. + + "1) Regular type" + byteSize := numElements * contentType byteSize. + self assert: [byteSize <= FFIStructSizeMask]. + headerWord := contentType headerWord copy. + headerWord := headerWord bitClear: FFIStructSizeMask. + headerWord := headerWord bitOr: byteSize. + type + setReferencedType: pointerType; + compiledSpec: (WordArray with: headerWord); + byteAlignment: contentType byteAlignment; + setReferentClass: contentType referentClass. + + "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." + pointerType + setReferencedType: type; + compiledSpec: contentType asPointerType compiledSpec copy; + byteAlignment: contentType asPointerType byteAlignment; + setReferentClass: contentType asPointerType referentClass. + + ^ type! Item was added: + ----- Method: ExternalArrayType>>checkType (in category 'external structure') ----- + checkType + + self class extraTypeChecks ifFalse: [^ self]. + + self + assert: [self isPointerType not] + description: 'Convert to ExternalType to use this feature'.! Item was added: + ----- Method: ExternalArrayType>>contentType (in category 'accessing') ----- + contentType + + ^ ExternalType typeNamed: super typeName! Item was added: + ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." + + self checkType. + + ^ (ExternalData + fromHandle: (handle structAt: byteOffset length: self byteSize) + type: self contentType) size: self size; yourself! Item was added: + ----- Method: ExternalArrayType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + + self checkType. + + handle + structAt: byteOffset + put: value getHandle + length: self byteSize.! Item was added: + ----- Method: ExternalArrayType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ true! Item was added: + ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. + Private. Used for field definition only." + + self checkType. + + ^ String streamContents:[:s | + s nextPutAll:'^ (ExternalData fromHandle: (handle structAt: '; + print: byteOffset; + nextPutAll: ' length: '; + print: self byteSize; + nextPutAll: ') type: '. + + self contentType isAtomic + ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName] + ifFalse: [s nextPutAll: self contentType typeName, ' externalType']. + + s nextPutAll: ') size: '; print: self size; nextPutAll: '; yourself']! Item was added: + ----- Method: ExternalArrayType>>size (in category 'accessing') ----- + size + "Answers the number of elements for this array type." + + ^ self byteSize / self contentType byteSize! Item was added: + ----- Method: ExternalArrayType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + aStream + nextPut: $(; + nextPutAll: ExternalType name; space; + nextPutAll: #arrayTypeNamed:; space; + store: self typeName; + nextPut: $).! Item was added: + ----- Method: ExternalArrayType>>typeName (in category 'accessing') ----- + typeName + + ^ String streamContents: [:stream | + stream + nextPutAll: super typeName; + nextPut: $[; + nextPutAll: self size asString; + nextPut: $]]! Item was added: + ----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') ----- + writeFieldArgName + + ^ 'anExternalData_', self contentType typeName, self size! Item was added: + ----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + self checkType. + + ^ String streamContents:[:s | + s nextPutAll:'handle structAt: '; + print: byteOffset; + nextPutAll: ' put: '; + nextPutAll: valueName; + nextPutAll: ' getHandle length: '; + print: self byteSize]! Item was added: + ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') ----- + arrayTypeNamed: typeName + "Lookup fails if content type is not present." + + | contentType | + self flag: #todo. "mt: Cache array types?" + + (contentType := self typeNamed: (typeName copyFrom: 1 to: (typeName indexOf: $[) - 1)) + ifNil: [^ nil]. + + ^ self newTypeNamed: typeName! Item was added: + ----- Method: ExternalType class>>newTypeForContentType:size: (in category 'instance creation') ----- + newTypeForContentType: contentType size: numElements + + ^ ExternalArrayType newTypeForContentType: contentType size: numElements! Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName + "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." + + | structClass contentType contentTypeName numElements | - - | structClass | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. + + aTypeName last == $] ifTrue: [ + "array type, e.g., char[50]" + contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1. + contentType := (self typeNamed: contentTypeName) "Create new if not already there." + ifNil: [self newTypeNamed: contentTypeName]. + numElements := ((aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger) + ifNil: [0]. + ^ self + newTypeForContentType: contentType + size: numElements]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. ^ structClass ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName "Supports pointer-type lookup for both atomic and structure types. Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'" + | isPointerType isArrayType actualTypeName type | + isArrayType := false. - | isPointerType actualTypeName type | (isPointerType := typeName last == $*) ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] + ifFalse: [(isArrayType := typeName last == $]) + ifFalse: [actualTypeName := typeName]]. - ifFalse: [actualTypeName := typeName]. + isArrayType + ifTrue: [^ self arrayTypeNamed: typeName]. + (Symbol lookup: actualTypeName) ifNotNil: [:sym | actualTypeName := sym]. type := (self atomicTypeNamed: actualTypeName) ifNil: [self structTypeNamed: actualTypeName]. ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was added: + ----- Method: ExternalType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was changed: ----- Method: Parser>>externalType: (in category '*FFI-Kernel') ----- externalType: descriptorClass "Parse and return an external type" + | xType typeName isArrayType | - | xType typeName | typeName := here. "Note that pointer token is not yet parsed!!" + self advance. + (isArrayType := self matchToken: $[) + ifTrue: [ + typeName := typeName, '[', here, ']'. + self advance. + self matchToken: $]]. (xType := descriptorClass typeNamed: typeName) ifNil: [ "Raise an error if user is there" self interactive ifTrue: [^nil]. "otherwise go over it silently -- use an unknown struct type" + xType := descriptorClass newTypeNamed: typeName]. + isArrayType ifTrue: [ + self flag: #todo. "mt: We must send arrays as pointers." + xType := xType asPointerType]. - xType := descriptorClass newTypeNamed: here]. - self advance. ^ (self matchToken: #*) ifTrue:[xType asPointerType] ifFalse:[(self matchToken: #**) ifTrue: [xType asPointerToPointerType] ifFalse: [xType]]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 249232 bytes Desc: not available URL: From m at jaromir.net Tue May 4 18:06:07 2021 From: m at jaromir.net (Jaromir Matas) Date: Tue, 4 May 2021 13:06:07 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> Message-ID: <1620151567783-0.post@n4.nabble.com> Hi Jakob, Jakob Reschke wrote > Oh well, I am not even sure whether sending both resume and then > return to the Exception is even well-defined behavior according to the > standard. I'd say yes - e.g. in case of #outer. Jakob Reschke wrote > Since return is specified referring to the "active exception handler", > it should return from the on: do: handler 1 in your example. So I > would in fact expect to get '12' in both cases. Handler 2 is no longer > active after the resume. Great point! So now we have another question: what does it mean to re-signal an exception that has already been signaled? (This is NOT the same as #resignalAs) ANSI doesn't seem to be against this kind of re-signaling an existing exception. Here's what it says about #resume: " Message: resume If the current exception action was activated as the result of sending the message #outer to the receiver, return a resumption value as the value of the #outer message. If the receiver is a resumable exception a resumption value is returned as the value of the message that signaled the receiver. " So you're right we should expect '12' as a result rather than just '2'. Your interpretation seems to be consistent with the specification of #outer. I checked other implementations but each of them provides different answers :D (except Pharo). I used this modified test example: | x | x:=''. [ [1/0. x:=x,'B'] on: ZeroDivide do: [:ex | ex signal. x:=x,'A'. ex return]. "handler 1" x:=x,'1' ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" x:=x,'2'. x Squeak/Pharo: answer inconsistently 'A2' or 'A12' depending on whether the return is explicit or implicit. VW: answers 'A12' - as a proper #outer (funny - their #outer answers 'A2' which is wrong) VA: answers 'A2' - totally flawed Cuis raises an exception; re-signaling is simply prohibited :) One more argument and then I'll leave it :) If you try the following example where #return is replaced by #resume, Squeak (and Pharo and VA) will fail completely raising a cannot return error: | x | x:=''. [ [1/0. x:=x,'B'] on: ZeroDivide do: [:ex | ex signal. x:=x,'A'. ex resume]. "handler 1" x:=x,'1' ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" x:=x,'2'. x VW however answers 'AB12' which is also consistent with the #outer specification. I'd say it should be safe to implement this semantics, i.e. #outer semantics for re-signaling, even if it's not explicitly mentioned in ANSI. I've even found a real use of re-signaling an exception in the trunk - see DiskProxy>>comeFullyUpOnReload: So my final suggestion is to define the behavior for re-signaling as equivalent to #outer, to become consistent and avoid apparently incorrect answers in above mentioned examples (I'm aware this is 99.9% academic indeed): Exception>>signal "Ask ContextHandlers in the sender chain to handle this signal. The default is to execute and return my defaultAction." -----> signalContext ifNotNil: [^self outer]. "re-signalling an already signalled exception is equivalent to sending #outer" signalContext := thisContext contextTag. ^(thisContext nextHandlerContextForSignal: self) handleSignal: self best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From jakres+squeak at gmail.com Tue May 4 19:10:54 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Tue, 4 May 2021 21:10:54 +0200 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1620151567783-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> Message-ID: Hi Jaromir, Thank you for this survey! At least we can take away that we will not hurt portability much by changing anything here... Am Di., 4. Mai 2021 um 20:06 Uhr schrieb Jaromir Matas : > > One more argument and then I'll leave it :) If you try the following example > where #return is replaced by #resume, Squeak (and Pharo and VA) will fail > completely raising a cannot return error: > > | x | > x:=''. > [ > [1/0. x:=x,'B'] on: ZeroDivide do: [:ex | ex signal. x:=x,'A'. ex resume]. > "handler 1" > x:=x,'1' > ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" > x:=x,'2'. > x > For non-resumable exceptions, this would be okay (although the error should not read "Cannot return"). However, since ZeroDivide is explicitly resumable, this is a bug. :-) > So my final suggestion is to define the behavior for re-signaling as > equivalent to #outer Makes total sense to me. Kind regards, Jakob From nicolas.cellier.aka.nice at gmail.com Tue May 4 20:03:48 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Tue, 4 May 2021 22:03:48 +0200 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> Message-ID: Waouh, you're exploring dark corners ;) Le mar. 4 mai 2021 à 21:11, Jakob Reschke a écrit : > > Hi Jaromir, > > Thank you for this survey! At least we can take away that we will not > hurt portability much by changing anything here... > > Am Di., 4. Mai 2021 um 20:06 Uhr schrieb Jaromir Matas : > > > > One more argument and then I'll leave it :) If you try the following example > > where #return is replaced by #resume, Squeak (and Pharo and VA) will fail > > completely raising a cannot return error: > > > > | x | > > x:=''. > > [ > > [1/0. x:=x,'B'] on: ZeroDivide do: [:ex | ex signal. x:=x,'A'. ex resume]. > > "handler 1" > > x:=x,'1' > > ] on: ZeroDivide do: [:ex | ex resume]. "handler 2" > > x:=x,'2'. > > x > > > > For non-resumable exceptions, this would be okay (although the error > should not read "Cannot return"). However, since ZeroDivide is > explicitly resumable, this is a bug. :-) > > > So my final suggestion is to define the behavior for re-signaling as > > equivalent to #outer > > Makes total sense to me. > +1 too, it should be fairly easy to implement (just check for nil signalContext or not in signal) > Kind regards, > Jakob > From m at jaromir.net Tue May 4 20:23:36 2021 From: m at jaromir.net (Jaromir Matas) Date: Tue, 4 May 2021 15:23:36 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> Message-ID: <1620159816089-0.post@n4.nabble.com> ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Tue May 4 20:29:59 2021 From: m at jaromir.net (Jaromir Matas) Date: Tue, 4 May 2021 15:29:59 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> Message-ID: <1620160199818-0.post@n4.nabble.com> Nicolas Cellier wrote > Waouh, you're exploring dark corners ;) Hi, yeah... found some skeletons :) I'll send a fix to the Inbox closing the second issue (re-signalling) and I'll leave the first question open, i.e. whether the following two are equivalent or distinct: [] on: Exception do: [ 42 ] [] on: Exception do: [:ex | ex return: 42 ] Thanks, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Tue May 4 20:35:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 20:35:11 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1400.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1400.mcz ==================== Summary ==================== Name: Kernel-jar.1400 Author: jar Time: 4 May 2021, 10:35:06.700121 pm UUID: 048df236-d26f-434e-964d-7707b8f2a9a8 Ancestors: Kernel-nice.1397 Fix a bug causing a cannot return error when re-signalling an already signalled exception. The fix makes re-signalling equivalent to sending #outer. Examples follow. Discussion see http://forum.world.st/The-Inbox-Kernel-jar-1399-mcz-tp5129370p5129434.html =============== Diff against Kernel-nice.1397 =============== Item was changed: ----- Method: Exception>>signal (in category 'signaling') ----- signal "Ask ContextHandlers in the sender chain to handle this signal. The default is to execute and return my defaultAction." + signalContext ifNotNil: [^self outer]. "re-signalling an already signalled exception is equivalent to sending #outer" signalContext := thisContext contextTag. ^(thisContext nextHandlerContextForSignal: self) handleSignal: self! From commits at source.squeak.org Tue May 4 20:38:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 20:38:39 0000 Subject: [squeak-dev] The Inbox: Tests-jar.463.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.463.mcz ==================== Summary ==================== Name: Tests-jar.463 Author: jar Time: 4 May 2021, 10:38:35.775101 pm UUID: a4e8dc9c-bba1-9f4b-ab76-2f31178142aa Ancestors: Tests-jar.462 Complement inbox/Kernel-jar.1400.mcz Add re-signalling test, add outer test =============== Diff against Tests-jar.462 =============== Item was added: + ----- Method: ExceptionTester>>simpleOuterDoubleResumeTest (in category 'signaledException tests') ----- + simpleOuterDoubleResumeTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse"] + on: MyTestNotification + do: [:ex | ex outer. self doYetAnotherThing. ex resume]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleOuterDoubleResumeTestResults (in category 'signaledException results') ----- + simpleOuterDoubleResumeTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleResignalDoubleResumeTest (in category 'signaledException tests') ----- + simpleResignalDoubleResumeTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse"] + on: MyTestNotification + do: [:ex | ex signal. self doYetAnotherThing. ex resume]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleResignalDoubleResumeTestResults (in category 'signaledException results') ----- + simpleResignalDoubleResumeTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testSimpleOuterDoubleResume (in category 'tests - ExceptionTester') ----- + testSimpleOuterDoubleResume + self assertSuccess: (ExceptionTester new runTest: #simpleOuterDoubleResumeTest ) ! Item was added: + ----- Method: ExceptionTests>>testSimpleResignalDoubleResume (in category 'tests - ExceptionTester') ----- + testSimpleResignalDoubleResume + self assertSuccess: (ExceptionTester new runTest: #simpleResignalDoubleResumeTest ) ! From commits at source.squeak.org Tue May 4 20:48:28 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 20:48:28 0000 Subject: [squeak-dev] The Trunk: Kernel-jar.1400.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1400.mcz ==================== Summary ==================== Name: Kernel-jar.1400 Author: jar Time: 4 May 2021, 10:35:06.700121 pm UUID: 048df236-d26f-434e-964d-7707b8f2a9a8 Ancestors: Kernel-nice.1397 Fix a bug causing a cannot return error when re-signalling an already signalled exception. The fix makes re-signalling equivalent to sending #outer. Examples follow. Discussion see http://forum.world.st/The-Inbox-Kernel-jar-1399-mcz-tp5129370p5129434.html =============== Diff against Kernel-nice.1397 =============== Item was changed: ----- Method: Exception>>signal (in category 'signaling') ----- signal "Ask ContextHandlers in the sender chain to handle this signal. The default is to execute and return my defaultAction." + signalContext ifNotNil: [^self outer]. "re-signalling an already signalled exception is equivalent to sending #outer" signalContext := thisContext contextTag. ^(thisContext nextHandlerContextForSignal: self) handleSignal: self! From commits at source.squeak.org Tue May 4 20:49:28 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 20:49:28 0000 Subject: [squeak-dev] The Trunk: Tests-jar.462.mcz Message-ID: Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-jar.462.mcz ==================== Summary ==================== Name: Tests-jar.462 Author: jar Time: 3 May 2021, 12:03:40.642808 pm UUID: b9dfb879-cfe4-ea46-96c4-fa620bd984c8 Ancestors: Tests-jar.461 Fix indentation of #doubleOuterResignalAsTest. I hope it's right this time :) =============== Diff against Tests-jar.461 =============== Item was changed: ----- Method: ExceptionTester>>doubleOuterResignalAsTest (in category 'tests') ----- doubleOuterResignalAsTest "ExceptionTester new doubleOuterResignalAsTest" [[self doSomething. MyResumableTestError signal. self doYetAnotherThing] on: MyResumableTestError + do: [:ex | ex outer. self doSomethingExceptional]. + self doSomethingElse] + on: MyResumableTestError + do: [:ex | ex resignalAs: MyTestNotification] - do: [:ex | ex outer. self doSomethingExceptional]. self doSomethingElse] - on: MyResumableTestError - do: [:ex | ex resignalAs: MyTestNotification] ! From commits at source.squeak.org Tue May 4 20:49:41 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 4 May 2021 20:49:41 0000 Subject: [squeak-dev] The Trunk: Tests-jar.463.mcz Message-ID: Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-jar.463.mcz ==================== Summary ==================== Name: Tests-jar.463 Author: jar Time: 4 May 2021, 10:38:35.775101 pm UUID: a4e8dc9c-bba1-9f4b-ab76-2f31178142aa Ancestors: Tests-jar.462 Complement inbox/Kernel-jar.1400.mcz Add re-signalling test, add outer test =============== Diff against Tests-jar.462 =============== Item was added: + ----- Method: ExceptionTester>>simpleOuterDoubleResumeTest (in category 'signaledException tests') ----- + simpleOuterDoubleResumeTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse"] + on: MyTestNotification + do: [:ex | ex outer. self doYetAnotherThing. ex resume]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleOuterDoubleResumeTestResults (in category 'signaledException results') ----- + simpleOuterDoubleResumeTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleResignalDoubleResumeTest (in category 'signaledException tests') ----- + simpleResignalDoubleResumeTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse"] + on: MyTestNotification + do: [:ex | ex signal. self doYetAnotherThing. ex resume]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleResignalDoubleResumeTestResults (in category 'signaledException results') ----- + simpleResignalDoubleResumeTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testSimpleOuterDoubleResume (in category 'tests - ExceptionTester') ----- + testSimpleOuterDoubleResume + self assertSuccess: (ExceptionTester new runTest: #simpleOuterDoubleResumeTest ) ! Item was added: + ----- Method: ExceptionTests>>testSimpleResignalDoubleResume (in category 'tests - ExceptionTester') ----- + testSimpleResignalDoubleResume + self assertSuccess: (ExceptionTester new runTest: #simpleResignalDoubleResumeTest ) ! From eliot.miranda at gmail.com Wed May 5 01:07:50 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Tue, 4 May 2021 18:07:50 -0700 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1620160199818-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> <1620160199818-0.post@n4.nabble.com> Message-ID: On Tue, May 4, 2021 at 1:30 PM Jaromir Matas wrote: > Nicolas Cellier wrote > > Waouh, you're exploring dark corners ;) > > Hi, yeah... found some skeletons :) > > I'll send a fix to the Inbox closing the second issue (re-signalling) and > I'll leave the first question open, i.e. whether the following two are > equivalent or distinct: > > [] on: Exception do: [ 42 ] > [] on: Exception do: [:ex | ex return: 42 ] > I've always assumed/understood that the two are equivalent. Phrasing the question the other way around, in what ways would anyone expect [] on: Exception do: [ 42 ] [] on: Exception do: [:ex | ex return: 42 ] to differ? > Thanks, > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Wed May 5 01:11:22 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Tue, 4 May 2021 18:11:22 -0700 Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: <1620160199818-0.post@n4.nabble.com> References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> <1620160199818-0.post@n4.nabble.com> Message-ID: On Tue, May 4, 2021 at 1:30 PM Jaromir Matas wrote: > Nicolas Cellier wrote > > Waouh, you're exploring dark corners ;) > > Hi, yeah... found some skeletons :) > > I'll send a fix to the Inbox closing the second issue (re-signalling) and > I'll leave the first question open, i.e. whether the following two are > equivalent or distinct: > > [] on: Exception do: [ 42 ] > [] on: Exception do: [:ex | ex return: 42 ] > I've always assumed/understood that the two are equivalent. To be more precise I've always assumed/understood that the first is short-hand for the second. That somewhere in the exception system there is code like exception return: (handlerBlock cull: exception) so that if the handler block returns a value the exception is sent return: with its value. Phrasing the question the other way around, in what ways would anyone expect [] on: Exception do: [ 42 ] [] on: Exception do: [:ex | ex return: 42 ] to differ? > Thanks, > > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > > -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Wed May 5 15:54:02 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 15:54:02 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.131.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.131.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.131 Author: mt Time: 5 May 2021, 5:54:00.906784 pm UUID: be0b9c3a-044c-fd46-926a-f0350ddcd315 Ancestors: FFI-Kernel-mt.130 Adds housekeeping for array types, which is necessary to update their byteSize as dependent struct types change. Adds the notion of a #contentType to ExternalType to complement ArrayType >> #contentType. At the moment, it is just useful for 1-level pointers (e.g. char*) or pointers of array types (e.g. the pointer type for char[10]). Once we have a better way to encode and distinguish n-dimensional containers, we should adapt the implementation of #contentType. =============== Diff against FFI-Kernel-mt.130 =============== Item was changed: ExternalType subclass: #ExternalArrayType + instanceVariableNames: 'size' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! Item was changed: + ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- - ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'as yet unclassified') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" + | type pointerType headerWord byteSize | - | type pointerType headerWord byteSize | - contentType ifNil: [^ nil]. - numElements < 0 ifTrue: [^ nil]. - self assert: [contentType isPointerType not] description: 'No support for pointers as content type yet!!'. + self + assert: [contentType byteSize > 0] + description: 'Invalid byte size!!'. + + self + assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not] + description: 'Array type already exists. Use #typeNamed: to access it.'. + + type := self "ExternalArrayType" basicNew. - type := self basicNew. pointerType := ExternalType basicNew. "1) Regular type" byteSize := numElements * contentType byteSize. self assert: [byteSize <= FFIStructSizeMask]. + headerWord := contentType headerWord. - headerWord := contentType headerWord copy. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: contentType byteAlignment; + setReferentClass: contentType referentClass; + setSize: numElements. - setReferentClass: contentType referentClass. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: contentType asPointerType compiledSpec copy; byteAlignment: contentType asPointerType byteAlignment; setReferentClass: contentType asPointerType referentClass. + + "3) Remember this new array type." + ArrayTypes + at: contentType typeName -> numElements + put: type. + - ^ type! Item was changed: + ----- Method: ExternalArrayType>>contentType (in category 'external data') ----- - ----- Method: ExternalArrayType>>contentType (in category 'accessing') ----- contentType + "Overwritten because array types have their content type as part of their non-pointer type." + - ^ ExternalType typeNamed: super typeName! Item was added: + ----- Method: ExternalArrayType>>newReferentClass: (in category 'private') ----- + newReferentClass: classOrNil + "The class I'm referencing has changed, which affects arrays of structs. Update my byteSize." + + | newByteSize newHeaderWord | + (referentClass := classOrNil) + ifNil: [ "my class has been removed - make me empty" + compiledSpec := WordArray with: self class structureSpec. + byteAlignment := 1] + ifNotNil: [ "my class has been changed - update my compiledSpec" + newHeaderWord := referentClass compiledSpec first. + newByteSize := size * (newHeaderWord bitAnd: FFIStructSizeMask). + newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask. + newHeaderWord := newHeaderWord bitOr: newByteSize. + compiledSpec := WordArray with: newHeaderWord. + byteAlignment := referentClass byteAlignment].! Item was added: + ----- Method: ExternalArrayType>>setSize: (in category 'private') ----- + setSize: numElements + + size := numElements.! Item was changed: ----- Method: ExternalArrayType>>size (in category 'accessing') ----- size "Answers the number of elements for this array type." + ^ size! - ^ self byteSize / self contentType byteSize! Item was changed: ----- Method: ExternalData>>containerType (in category 'accessing - types') ----- containerType + ^ (size isNil or: [type isVoid]) + ifTrue: [type] + ifFalse: [self contentType asArrayType: size]! - ^ type! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- contentType + ^ type contentType! - self flag: #todo. "mt: For n-ary pointer types, we typically just want to reducy arity by one." - ^ type asNonPointerType! Item was added: + ----- Method: ExternalStructureType>>newReferentClass: (in category 'private') ----- + newReferentClass: classOrNil + "The class I'm referencing has changed. Update my spec." + + (referentClass := classOrNil) + ifNil: [ "my class has been removed - make me 'struct { void }'" + compiledSpec := WordArray with: self class structureSpec. + byteAlignment := 1] + ifNotNil: [ "my class has been changed - update my compiledSpec" + compiledSpec := referentClass compiledSpec. + byteAlignment := referentClass byteAlignment].! Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' + classVariableNames: 'ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes' - classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects. Instance variables: compiledSpec Compiled specification of the external type referentClass Class type of argument required referencedType Associated (non)pointer type with the receiver byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed. Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following: FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits. FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly. [Note: Other combinations may be allowed in the future] ! Item was added: + ----- Method: ExternalType class>>arrayTypeFor:size: (in category 'instance lookup') ----- + arrayTypeFor: contentType size: numElements + "Lookup fails if content type is not present." + + | key | + key := contentType typeName -> numElements. + ^ (ArrayTypes at: key ifAbsent: [nil]) + ifNil: [ + ArrayTypes removeKey: key ifAbsent: []. + self + newTypeForContentType: contentType + size: numElements]! Item was changed: ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') ----- arrayTypeNamed: typeName + "Answers an array type for the content type and size specified in the typeName, e.g. char[10] or MyStruct[5]. Lookup fails silently (i.e. nil) if content type does not exist." - "Lookup fails if content type is not present." + | arraySpec | + arraySpec := self parseArrayTypeName: typeName. + arraySpec second ifNil: [ ^ nil "content type unknown" ]. + arraySpec third ifNil: [arraySpec at: 3 put: 0]. - | contentType | - self flag: #todo. "mt: Cache array types?" + ^ self + arrayTypeFor: arraySpec second + size: arraySpec third! - (contentType := self typeNamed: (typeName copyFrom: 1 to: (typeName indexOf: $[) - 1)) - ifNil: [^ nil]. - - ^ self newTypeNamed: typeName! Item was changed: ----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') ----- cleanupUnusedTypes + "In the lookup table for struct types and array types, remove keys to types no longer present.. + + ExternalType cleanupUnusedTypes + " + Smalltalk garbageCollect. + StructTypes keys do: [:key | + (StructTypes at: key) ifNil: [ + [StructTypes removeKey: key]]]. + ArrayTypes keys do: [:key | + (ArrayTypes at: key) ifNil: [ + [ArrayTypes removeKey: key]]].! - "ExternalType cleanupUnusedTypes" - | value | - Smalltalk garbageCollect. - StructTypes keys do:[:key| - value := StructTypes at: key. - value == nil ifTrue:[StructTypes removeKey: key ifAbsent:[]]].! Item was changed: ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') ----- initializeStructureTypes "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size." StructTypes ifNil: [ StructTypes := WeakValueDictionary new]. + ArrayTypes ifNil: [ + ArrayTypes := WeakValueDictionary new]. self cleanupUnusedTypes. StructTypes valuesDo:[:structType | structType "asNonPointerType" compiledSpec: (WordArray with: self structureSpec); byteAlignment: nil. structType asPointerType compiledSpec: (WordArray with: self pointerSpec); + byteAlignment: nil]. + ArrayTypes valuesDo: [:arrayType | + arrayType + compiledSpec: (WordArray with: (arrayType headerWord bitClear: FFIStructSizeMask)); + byteAlignment: nil. + arrayType asPointerType + compiledSpec: (WordArray with: self pointerSpec); byteAlignment: nil].! Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." + | structClass arraySpec | - | structClass contentType contentTypeName numElements | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. + aTypeName last == $] ifTrue: [ "array type, e.g., char[50]" + arraySpec := self parseArrayTypeName: aTypeName. + arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)]. + arraySpec third ifNil: [arraySpec at: 3 put: 0]. - aTypeName last == $] ifTrue: [ - "array type, e.g., char[50]" - contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1. - contentType := (self typeNamed: contentTypeName) "Create new if not already there." - ifNil: [self newTypeNamed: contentTypeName]. - numElements := ((aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger) - ifNil: [0]. ^ self + newTypeForContentType: arraySpec second + size: arraySpec third]. - newTypeForContentType: contentType - size: numElements]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. ^ structClass ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') ----- noticeModificationOf: aClass "A subclass of ExternalStructure has been redefined. Clean out any obsolete references to its type." + + aClass withAllSubclassesDo: [:cls | | typeName | + typeName := cls name. + (StructTypes at: typeName ifAbsent: []) + ifNotNil: [:type | + type newReferentClass: cls. + type asPointerType newReferentClass: cls]. + ArrayTypes keysAndValuesDo: [:nameSpec :arrayType | + nameSpec key = typeName "content type" ifTrue: [ + arrayType newReferentClass: cls. + arrayType asPointerType newReferentClass: cls]]]! - | type | - aClass isBehavior ifFalse:[^nil]. "how could this happen?" - aClass withAllSubclassesDo:[:cls| - type := StructTypes at: cls name ifAbsent:[nil]. - type == nil ifFalse:[ - type newReferentClass: cls. - type asPointerType newReferentClass: cls]. - ].! Item was changed: ----- Method: ExternalType class>>noticeRenamingOf:from:to: (in category 'housekeeping') ----- noticeRenamingOf: aClass from: oldName to: newName "An ExternalStructure has been renamed from oldName to newName. Keep our type names in sync." + + (StructTypes at: oldName ifAbsent:[nil]) + ifNotNil: [:type | StructTypes at: newName put: type]. + StructTypes removeKey: oldName ifAbsent: []. + + ArrayTypes keys do: [:nameSpec | + nameSpec key = oldName ifTrue: [ + nameSpec key: newName]]. + ArrayTypes rehash.! - | type | - type := StructTypes at: oldName ifAbsent:[nil]. - type == nil ifFalse:[StructTypes at: newName put: type]. - StructTypes removeKey: oldName ifAbsent:[].! Item was added: + ----- Method: ExternalType class>>parseArrayTypeName: (in category 'private') ----- + parseArrayTypeName: aTypeName + + | contentTypeName contentType numElements | + contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1. + contentType := self typeNamed: contentTypeName. + numElements := (aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger. + ^ { contentTypeName . contentType . numElements }! Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes." AtomicTypes := nil. StructTypes := nil. + ArrayTypes := nil. self initializeDefaultTypes. self resetAllStructureTypes.! Item was changed: ----- Method: ExternalType class>>resetAllStructureTypes (in category 'housekeeping') ----- resetAllStructureTypes "Warning: This call is only required if you change the container for StructTypes!! Note that (2) and (3) can be swapped but that puts unnecessary pressure on the GC." StructTypes := nil. + ArrayTypes := nil. "1) Initialize the container for structure types." self initializeStructureTypes. "2) Recompile all FFI calls to create and persist structure types." self recompileAllLibraryFunctions. "3) Update all structure types' spec and alignment." ExternalStructure compileAllFields. ! Item was added: + ----- Method: ExternalType>>asArrayType: (in category 'converting') ----- + asArrayType: numElements + + ^ self class arrayTypeFor: self size: numElements! Item was added: + ----- Method: ExternalType>>contentType (in category 'external data') ----- + contentType + + | result | + self + assert: [self isPointerType] + description: 'Content type is only defined for pointer types!!'. + + result := self asNonPointerType. + ^ result isArrayType + ifTrue: [result contentType] + ifFalse: [result]! Item was changed: ----- Method: ExternalType>>newReferentClass: (in category 'private') ----- + newReferentClass: classOrNil - newReferentClass: aClass "The class I'm referencing has changed. Update my spec." + + referentClass := classOrNil. + self assert: [referentClass isNil or: [self isAtomic not and: [self isPointerType]]].! - referentClass := aClass. - self isPointerType ifTrue:[^self]. "for pointers only the referentClass changed" - referentClass == nil ifTrue:[ - "my class has been removed - make me 'struct { void }'" - compiledSpec := WordArray with: self class structureSpec. - byteAlignment := 1. - ] ifFalse:[ - "my class has been changed - update my compiledSpec" - compiledSpec := referentClass compiledSpec. - byteAlignment := referentClass byteAlignment. - ].! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. + "Adds housekeeping for array types." - "Split up types for external structures from atomic types." ExternalType resetAllStructureTypes. "Re-generate all field accessors because type checks are now controlled by a new preference." ExternalStructure defineAllFields. '! From commits at source.squeak.org Wed May 5 16:05:30 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 16:05:30 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.132.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.132.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.132 Author: mt Time: 5 May 2021, 6:05:28.168784 pm UUID: 99688c3a-95e7-2a4f-abcc-de6aafa6cca0 Ancestors: FFI-Kernel-mt.131 Adds missing #pointerAt:put: to ExternalData, which might still be useful if you want to access "arrays" of pointers (e.g. char**) manually via void*. pointers := (ExternalType typeNamed: 'void*') allocate: 20. pointers at: 1. "answers ExternalAddress; NULL pointer" Fixes an off-by-one issue in byte-array read-writer. Make it possible to copy any external structure/data to object memory via #copy. That is, avoid having too many proxies to external memory, which bears the risk of double-free or memory leaks. One could actually allocate new external memory, but ... :-/ nums := ExternalType int32_t allocateExternal: 10. local := nums copy. nums free. local explore. Depending on the state of your memory, you might get some interesting numbers in this example. :-D See #zeroMemory. =============== Diff against FFI-Kernel-mt.131 =============== Item was added: + ----- Method: ByteArrayReadWriter>>copy (in category 'copying') ----- + copy + + ^ byteArray copyFrom: byteOffset + 1 to: byteOffset + byteSize ! Item was changed: ----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') ----- doesNotUnderstand: aMessage | selector args | selector := aMessage selector. args := aMessage arguments. args size caseOf: { [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. [ 2 ] -> [ (selector endsWith: 'length:') ifTrue: [ args at: 1 put: args first + byteOffset. + (args first + args second - 1) > byteSize - args first + args second > byteSize ifTrue: [self errorSubscriptBounds: args first + args second] ] ifFalse: [(selector endsWith: 'put:') ifTrue: [ args at: 1 put: args first + byteOffset ]] ]. [ 3 ] -> [ (selector endsWith: 'length:') ifTrue: [ args at: 1 put: args first + byteOffset. + (args first + args third - 1) > byteSize - args first + args third > byteSize ifTrue: [self errorSubscriptBounds: args first + args third]]] } otherwise: []. ^ aMessage sendTo: byteArray! Item was changed: ----- Method: ExternalData>>copyFrom:to: (in category 'accessing') ----- copyFrom: firstIndex to: lastIndex + ^ (self from: firstIndex to: lastIndex) copy! - ^ (self from: firstIndex to: lastIndex) getExternalData! Item was added: + ----- Method: ExternalData>>pointerAt: (in category 'accessing - pointers') ----- + pointerAt: index + + | byteOffset | + byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. + + self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." + ^ handle pointerAt: byteOffset + + " + self assert: [self contentType isPointerType]. + ^ self at: index + "! Item was added: + ----- Method: ExternalData>>pointerAt:put: (in category 'accessing - pointers') ----- + pointerAt: index put: value + + | byteOffset | + byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. + + self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." + ^ handle pointerAt: byteOffset put: value + + " + self assert: [self contentType isPointerType]. + ^ self at: index put: value + "! Item was added: + ----- Method: ExternalStructure>>postCopy (in category 'copying') ----- + postCopy + "Copy external memory into object memory to not loose track of what to #free and what not. It's safer this way." + + handle isExternalAddress + ifTrue: [handle := self asExternalData getExternalData getHandle] + ifFalse: [handle := handle copy. "Materializes byte-array read-writer section if any"].! From commits at source.squeak.org Wed May 5 16:06:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 16:06:42 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.26.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.26.mcz ==================== Summary ==================== Name: FFI-Tools-mt.26 Author: mt Time: 5 May 2021, 6:06:41.168784 pm UUID: cfe5c5f6-84c7-d740-a043-250ae7c3e53e Ancestors: FFI-Tools-mt.25 Minor UI fix, which affects object explorers on compiled specs. =============== Diff against FFI-Tools-mt.25 =============== Item was added: + ----- Method: CompiledSpecWrapper>>hasContents (in category 'accessing') ----- + hasContents + + ^ self object isInteger not! From commits at source.squeak.org Wed May 5 16:07:52 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 16:07:52 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.26.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.26.mcz ==================== Summary ==================== Name: FFI-Tests-mt.26 Author: mt Time: 5 May 2021, 6:07:51.408784 pm UUID: 591e208f-d61f-dc4e-a9d0-80bb2279824a Ancestors: FFI-Tests-mt.25 More tests :-) =============== Diff against FFI-Tests-mt.25 =============== Item was added: + ----- Method: ExternalStructureTests>>test01CopyStructure (in category 'tests - external structure') ----- + test01CopyStructure + + | original copy | + original := FFITestPoint2 new. + original setX: 1 setY: 2. + + copy := original copy. + self assert: original getHandle ~~ copy getHandle. + + copy setX: 3 setY: 4. + self assert: 1 at 2 equals: original asPoint. + self assert: 3 at 4 equals: copy asPoint.! Item was added: + ----- Method: ExternalStructureTests>>test02CopyStructureFromExternal (in category 'tests - external structure') ----- + test02CopyStructureFromExternal + + | original copy | + original := heapObject := FFITestPoint2 externalNew. + original setX: 1 setY: 2. + + copy := original copy. + self assert: copy getHandle isInternalMemory. + + copy setX: 3 setY: 4. + self assert: 1 at 2 equals: original asPoint. + self assert: 3 at 4 equals: copy asPoint.! Item was added: + ----- Method: ExternalTypeTests>>testArrayTypesForAtomics (in category 'tests') ----- + testArrayTypesForAtomics + + self + should: [ExternalType void asArrayType: 5] + raise: Error. + + AtomicTypeNames keysInOrder allButFirst "void" do: [:index | + | atomicType arrayType | + atomicType := AtomicTypes at: (AtomicTypeNames at: index). + arrayType := atomicType asArrayType: 5. + self assert: arrayType isArrayType. + self assert: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self assert: 5 equals: arrayType size].! Item was added: + ----- Method: ExternalTypeTests>>testArrayTypesForStructs (in category 'tests') ----- + testArrayTypesForStructs + + { + FFITestPoint2. + FFITestSdi. + FFITestUfd. + FFITestIntAlias. + FFITestCompoundStruct. + } do: [:structClass | + | arrayType | + arrayType := structClass externalType asArrayType: 5. + self assert: arrayType isArrayType. + self deny: arrayType isPointerType. + self assert: 5 equals: arrayType size].! Item was changed: ----- Method: FFITestIntAlias class>>originalTypeName (in category 'type alias') ----- originalTypeName + " + self defineFields + " + ^ 'int32_t'! - - ^ 'int'! From commits at source.squeak.org Wed May 5 16:22:09 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 16:22:09 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.133.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.133.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.133 Author: mt Time: 5 May 2021, 6:22:06.654784 pm UUID: 5b4d9432-d53c-424d-9d60-7e9dd5c7ce64 Ancestors: FFI-Kernel-mt.132 Since empty array types such as char[] are not actually supported, e.g., in struct defs, disallow them for now to not deceive users trying to work with them and then wonder about strange results. =============== Diff against FFI-Kernel-mt.132 =============== Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self assert: [contentType isPointerType not] description: 'No support for pointers as content type yet!!'. self + assert: [numElements > 0] + description: 'Empty array types are not supported!!'. + + self assert: [contentType byteSize > 0] description: 'Invalid byte size!!'. self assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not] description: 'Array type already exists. Use #typeNamed: to access it.'. type := self "ExternalArrayType" basicNew. pointerType := ExternalType basicNew. "1) Regular type" byteSize := numElements * contentType byteSize. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: contentType byteAlignment; setReferentClass: contentType referentClass; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: contentType asPointerType compiledSpec copy; byteAlignment: contentType asPointerType byteAlignment; setReferentClass: contentType asPointerType referentClass. "3) Remember this new array type." ArrayTypes at: contentType typeName -> numElements put: type. ^ type! Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." | structClass arraySpec | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. aTypeName last == $] ifTrue: [ "array type, e.g., char[50]" arraySpec := self parseArrayTypeName: aTypeName. arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)]. - arraySpec third ifNil: [arraySpec at: 3 put: 0]. ^ self newTypeForContentType: arraySpec second size: arraySpec third]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. ^ structClass ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. "Adds housekeeping for array types." + ExternalType resetAllStructureTypes.. - ExternalType resetAllStructureTypes. "Re-generate all field accessors because type checks are now controlled by a new preference." ExternalStructure defineAllFields. '! From commits at source.squeak.org Wed May 5 16:23:02 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 16:23:02 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.27.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.27.mcz ==================== Summary ==================== Name: FFI-Tests-mt.27 Author: mt Time: 5 May 2021, 6:23:00.940784 pm UUID: c4413cf7-61cb-8f49-bac0-82bb8eb8650c Ancestors: FFI-Tests-mt.26 Complements FFI-Kernel-mt.133 =============== Diff against FFI-Tests-mt.26 =============== Item was added: + ----- Method: ExternalTypeTests>>testArrayTypesEmpty (in category 'tests') ----- + testArrayTypesEmpty + + self + should: [ExternalType char asArrayType: 0] + raise: Error; + should: [ExternalType typeNamed: 'char[]'] + raise: Error; + should: [ExternalType typeNamed: 'char[0]'] + raise: Error.! Item was changed: ----- Method: ExternalTypeTests>>testArrayTypesForStructs (in category 'tests') ----- testArrayTypesForStructs + self assert: (ExternalType typeNamed: 'UnknownStruct[5]') isNil. + self + should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] + raise: Error. { FFITestPoint2. FFITestSdi. FFITestUfd. FFITestIntAlias. FFITestCompoundStruct. } do: [:structClass | | arrayType | arrayType := structClass externalType asArrayType: 5. self assert: arrayType isArrayType. self deny: arrayType isPointerType. self assert: 5 equals: arrayType size].! Item was changed: ----- Method: FFITestLibrary class>>ffiTestArrayType (in category 'mocks') ----- ffiTestArrayType + "Just a mock. Not sure whether there will ever be call signatures using array types ... isn't this pass-by-pointer anyway?" + + - - ^ self externalCallFailed ! Item was changed: ----- Method: FFITypeNameTests>>testArray (in category 'tests') ----- testArray (self argTypesAt: #ffiTestArrayType) do: [:type | self assert: type isPointerType; deny: type isArrayType; assert: type asNonPointerType isArrayType; + assert: type asNonPointerType size > 0]! - assert: type asNonPointerType size >= 0]! From commits at source.squeak.org Wed May 5 17:00:03 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 5 May 2021 17:00:03 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.134.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.134.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.134 Author: mt Time: 5 May 2021, 7:00:01.584784 pm UUID: 2737ad22-4c7e-9645-9837-93f0319dc31c Ancestors: FFI-Kernel-mt.133 Allocate! Clarify what is actually possible to allocate through an external type. (I think it would be nice to have some kind of mapping between atomic types and a representative. Maybe a mapping to a class to call #zero on.) =============== Diff against FFI-Kernel-mt.133 =============== Item was added: + ----- Method: ExternalArrayType>>allocate (in category 'external data') ----- + allocate + + ^ self contentType allocate: self size! Item was added: + ----- Method: ExternalArrayType>>allocate: (in category 'external data') ----- + allocate: anInteger + "No support for n-dimensional containers." + self notYetImplemented.! Item was added: + ----- Method: ExternalArrayType>>allocateExternal (in category 'external data') ----- + allocateExternal + + ^ self contentType allocateExternal: self size! Item was added: + ----- Method: ExternalArrayType>>allocateExternal: (in category 'external data') ----- + allocateExternal: anInteger + "No support for n-dimensional containers." + self notYetImplemented.! Item was added: + ----- Method: ExternalType>>allocate (in category 'external data') ----- + allocate + "Allocate a single representative for this type." + + referentClass ifNotNil: [ + "Allocate bytes for the struct." + ^ referentClass new]. + + self isPointerType ifTrue: [ + "Allocate bytes for a pointer." + ^ ExternalType void asPointerType allocate: 1]. + + "Answer an object representing the atomic type." + self notYetImplemented.! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- allocate: anInteger "Allocate space for containing an array of size anInteger of this dataType" | handle | + self + assert: [self isPointerType not or: [self isVoid]] + description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; + assert: [self byteSize > 0] + description: 'Invalid byte size.'. + handle := ByteArray new: self byteSize * anInteger. ^(ExternalData fromHandle: handle type: self) size: anInteger! Item was added: + ----- Method: ExternalType>>allocateExternal (in category 'external data') ----- + allocateExternal + "Allocate a single representative for this type." + + referentClass ifNotNil: [ + "Allocate bytes for the struct." + ^ referentClass externalNew]. + + self isPointerType ifTrue: [ + "Allocate bytes for a pointer." + ^ ExternalType void asPointerType allocateExternal: 1]. + + "Answer an object representing the atomic type." + self notYetImplemented.! Item was changed: ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- allocateExternal: anInteger "Allocate space for containing an array of size anInteger of this dataType" | handle | + self + assert: [self isPointerType not or: [self isVoid]] + description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; + assert: [self byteSize > 0] + description: 'Invalid byte size.'. + handle := ExternalAddress allocate: self byteSize * anInteger. ^(ExternalData fromHandle: handle type: self) size: anInteger! From tim at rowledge.org Wed May 5 17:08:42 2021 From: tim at rowledge.org (tim Rowledge) Date: Wed, 5 May 2021 10:08:42 -0700 Subject: [squeak-dev] Remember to vote! Message-ID: <87319736-9A3D-4A41-BF4B-14C4DFC6CA48@rowledge.org> Remember to vote. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim fibula: noun, 'a small lie' From tim at rowledge.org Wed May 5 17:55:12 2021 From: tim at rowledge.org (tim Rowledge) Date: Wed, 5 May 2021 10:55:12 -0700 Subject: [squeak-dev] Remember to vote! In-Reply-To: <87319736-9A3D-4A41-BF4B-14C4DFC6CA48@rowledge.org> References: <87319736-9A3D-4A41-BF4B-14C4DFC6CA48@rowledge.org> Message-ID: > On 2021-05-05, at 10:08 AM, tim Rowledge wrote: > > Remember to vote. Ah, in case it wasn't obvious, that's voting for the Squeak board. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: RDR: Rotate Disk Right From m at jaromir.net Thu May 6 07:31:39 2021 From: m at jaromir.net (Jaromir Matas) Date: Thu, 6 May 2021 02:31:39 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1399.mcz In-Reply-To: References: <1619988190941-0.post@n4.nabble.com> <1620045647256-0.post@n4.nabble.com> <1620079179703-0.post@n4.nabble.com> <1620151567783-0.post@n4.nabble.com> <1620160199818-0.post@n4.nabble.com> Message-ID: <1620286299920-0.post@n4.nabble.com> Hi Eliot, Eliot Miranda-2 wrote > I've always assumed/understood that the two are equivalent. To be more > precise I've always assumed/understood that the first is short-hand for > the > second. That somewhere in the exception system there is code like > > exception return: (handlerBlock cull: exception) > > so that if the handler block returns a value the exception is sent return: > with its value. That was the idea behind this post. Currently there's no such code and so the two structures are distinct and can provide two different results as Jakob showed earlier. However, as Jakob showed too, ANSI probably does allow for such interpretation. I wish it didn't :) The current implementation doesn't even guarantee the two forms of return will return to the same context as was the case with #outer and re-signaling bugs fixed earlier. So I suggested to at least avoid that and modify the code to an equivalent of: exception handlerContext return: (handlerBlock cull: exception) Eliot Miranda-2 wrote > Phrasing the question the other way around, in what ways would anyone > expect > > [] on: Exception do: [ 42 ] > [] on: Exception do: [:ex | ex return: 42 ] > > to differ? Can't think of any... I considered them synonymous. Thanks a lot for your opinion. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From Patrick.Rein at hpi.de Thu May 6 12:54:51 2021 From: Patrick.Rein at hpi.de (Rein, Patrick) Date: Thu, 6 May 2021 12:54:51 +0000 Subject: [squeak-dev] Remember to vote! In-Reply-To: References: <87319736-9A3D-4A41-BF4B-14C4DFC6CA48@rowledge.org>, Message-ID: <2829568ed1ef49e3b1f095f1683f8f12@hpi.de> Yes to what Tim said! Find your ballot emails and vote! :) Election closes tomorrow evening at 19.00 UTC. Make sure your vote gets in on time. In case you opted in to receiving the ballot and are registered as a voter but have not yet received an email, please let me know and we will sort it out! Best wishes, Patrick ________________________________________ From: Squeak-dev on behalf of tim Rowledge Sent: Wednesday, May 5, 2021 7:55:12 PM To: The general-purpose Squeak developers list Subject: Re: [squeak-dev] Remember to vote! > On 2021-05-05, at 10:08 AM, tim Rowledge wrote: > > Remember to vote. Ah, in case it wasn't obvious, that's voting for the Squeak board. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: RDR: Rotate Disk Right From commits at source.squeak.org Thu May 6 13:21:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 13:21:07 0000 Subject: [squeak-dev] The Trunk: Installer-Core-mt.440.mcz Message-ID: Marcel Taeumel uploaded a new version of Installer-Core to project The Trunk: http://source.squeak.org/trunk/Installer-Core-mt.440.mcz ==================== Summary ==================== Name: Installer-Core-mt.440 Author: mt Time: 6 May 2021, 3:21:07.381189 pm UUID: 4906fd3d-9eff-e841-afc5-0a75e5a9b4b6 Ancestors: Installer-Core-mt.439 Renames default branch for Git tools from "master" to "latest-release". Leave hints to "develop" branch for the brave among us. :-) master == latest-release ~~ develop =============== Diff against Installer-Core-mt.439 =============== Item was changed: ----- Method: Installer class>>installGitInfrastructure (in category 'scripts') ----- installGitInfrastructure | priorSetting | "for INIFileTest>>#testComplexRead" priorSetting := Scanner allowUnderscoreAsAssignment. + [Scanner allowUnderscoreAsAssignment: true. - Scanner allowUnderscoreAsAssignment: true. (Smalltalk at: #Metacello) new baseline: 'Squot'; + repository: 'github://hpi-swa/Squot:latest-release/src'; + "repository: 'github://hpi-swa/Squot:develop/src';" - repository: 'github://hpi-swa/Squot:master/src'; load. + ] ensure: [Scanner allowUnderscoreAsAssignment: priorSetting] - Scanner allowUnderscoreAsAssignment: priorSetting ! From commits at source.squeak.org Thu May 6 16:08:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 16:08:39 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.135.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.135.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.135 Author: mt Time: 6 May 2021, 6:08:39.437981 pm UUID: 7983191d-5e85-ca45-8d1a-b2fa02060f31 Ancestors: FFI-Kernel-mt.134 Bugfixes: - out-of-bounds check in byte-array read-writer (still under construction, though) - !! access to signed bytes through external address !! =============== Diff against FFI-Kernel-mt.134 =============== Item was changed: ----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') ----- doesNotUnderstand: aMessage | selector args | selector := aMessage selector. args := aMessage arguments. args size caseOf: { [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. [ 2 ] -> [ (selector endsWith: 'length:') ifTrue: [ args at: 1 put: args first + byteOffset. + (args first + args second - 1) > (byteOffset + byteSize) + ifTrue: [self errorSubscriptBounds: args first + args second - 1] ] - (args first + args second - 1) > byteSize - ifTrue: [self errorSubscriptBounds: args first + args second] ] ifFalse: [(selector endsWith: 'put:') ifTrue: [ args at: 1 put: args first + byteOffset ]] ]. [ 3 ] -> [ (selector endsWith: 'length:') ifTrue: [ args at: 1 put: args first + byteOffset. + (args first + args third - 1) > (byteSize + byteSize) + ifTrue: [self errorSubscriptBounds: args first + args third - 1]]] - (args first + args third - 1) > byteSize - ifTrue: [self errorSubscriptBounds: args first + args third]]] } otherwise: []. ^ aMessage sendTo: byteArray! Item was changed: ----- Method: ExternalAddress>>byteAt: (in category 'accessing') ----- byteAt: byteOffset + "Overwritten to to through a different primitive since the receiver describes data in the outside world." + + ^ self integerAt: byteOffset size: 1 signed: false! - "Go through a different primitive since the receiver describes data in the outside world" - ^self unsignedByteAt: byteOffset! Item was changed: ----- Method: ExternalAddress>>byteAt:put: (in category 'accessing') ----- byteAt: byteOffset put: value + "Overwritten to go through a different primitive since the receiver describes data in the outside world." + + ^ self integerAt: byteOffset put: value size: 1 signed: false! - "Go through a different primitive since the receiver describes data in the outside world" - ^self unsignedByteAt: byteOffset put: value! Item was added: + ----- Method: ExternalAddress>>signedByteAt: (in category 'accessing') ----- + signedByteAt: byteOffset + "Overwritten to go through a different primitive since the receiver describes data in the outside world." + + ^ self integerAt: byteOffset size: 1 signed: true! Item was added: + ----- Method: ExternalAddress>>signedByteAt:put: (in category 'accessing') ----- + signedByteAt: byteOffset put: value + "Overwritten to go through a different primitive since the receiver describes data in the outside world." + + ^ self integerAt: byteOffset put: value size: 1 signed: true! From commits at source.squeak.org Thu May 6 16:12:41 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 16:12:41 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.136.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.136.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.136 Author: mt Time: 6 May 2021, 6:12:41.055981 pm UUID: 21c0b95f-4fab-ca48-ae73-fcc01f01bdb4 Ancestors: FFI-Kernel-mt.135 Clean up #allocate interface on external types: - Re-direct #new and #externalNew to make those messages available to domain-specific structs. - Always zero allocated external memory for safe use through tools. - Remove obsolete #newZero, which is rather new and was not yet used anywhere. =============== Diff against FFI-Kernel-mt.135 =============== Item was added: + ----- Method: ExternalStructure class>>allocate (in category 'instance creation') ----- + allocate + + ^self externalType allocate! Item was added: + ----- Method: ExternalStructure class>>allocateExternal (in category 'instance creation') ----- + allocateExternal + + ^ self externalType allocateExternal! Item was changed: ----- Method: ExternalStructure class>>externalNew (in category 'instance creation') ----- externalNew "Create an instance of the receiver on the external heap" + ^ self allocateExternal! - ^ self fromHandle: (self externalType isTypeAliasForAtomic - ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] - ifFalse: [ - self externalType isTypeAliasForPointer - ifTrue: [ByteArray new: self byteSize] - ifFalse: [ExternalAddress allocate: self byteSize]])! Item was changed: ----- Method: ExternalStructure class>>new (in category 'instance creation') ----- new + + ^ self allocate! - ^self fromHandle: (self externalType isTypeAliasForAtomic - ifTrue: [self error: 'This is an alias-for-atomic type. You must use #fromHandle:'] - ifFalse: [ByteArray new: self byteSize]).! Item was removed: - ----- Method: ExternalStructure class>>newZero (in category 'instance creation') ----- - newZero - - ^ self new - zeroMemory; - yourself! Item was changed: ----- Method: ExternalType>>allocate (in category 'external data') ----- allocate "Allocate a single representative for this type." - referentClass ifNotNil: [ - "Allocate bytes for the struct." - ^ referentClass new]. - self isPointerType ifTrue: [ + self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - "Allocate bytes for a pointer." ^ ExternalType void asPointerType allocate: 1]. + ^ (self allocate: 1) first! - "Answer an object representing the atomic type." - self notYetImplemented.! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- + allocate: numElements + "Allocate space for containing an array of numElements of this dataType" - allocate: anInteger - "Allocate space for containing an array of size anInteger of this dataType" | handle | self assert: [self isPointerType not or: [self isVoid]] description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; assert: [self byteSize > 0] description: 'Invalid byte size.'. + handle := ByteArray new: self byteSize * numElements. + ^(ExternalData fromHandle: handle type: self) size: numElements! - handle := ByteArray new: self byteSize * anInteger. - ^(ExternalData fromHandle: handle type: self) size: anInteger! Item was changed: ----- Method: ExternalType>>allocateExternal (in category 'external data') ----- allocateExternal + "Allocate a single representative for this type in external memory." - "Allocate a single representative for this type." - - referentClass ifNotNil: [ - "Allocate bytes for the struct." - ^ referentClass externalNew]. + | result | self isPointerType ifTrue: [ + self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - "Allocate bytes for a pointer." ^ ExternalType void asPointerType allocateExternal: 1]. + "By design, aliased pointers are stored as byte array." + self isTypeAliasForPointer ifTrue: [^ self allocate]. + + ^ [(result := self allocateExternal: 1) first] + ensure: [ + "Atomics and alias-to-atomic are immediately available in object memory. We thus must free the external memory to avoid leaks." + self isStructureType ifFalse: [result free]]! - "Answer an object representing the atomic type." - self notYetImplemented.! Item was changed: ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- + allocateExternal: numElements + "Allocate space for containing an array of numElements of this type. Note that we zero the memory for safe use. If you do not need that, please use ExternalAddress class >> #allocate: directly. BE AWARE that structs can have pointers tools automatically follow and thus risking a SEGFAULT and hence VM CRASH for uninitalized memory." - allocateExternal: anInteger - "Allocate space for containing an array of size anInteger of this dataType" | handle | self assert: [self isPointerType not or: [self isVoid]] description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; assert: [self byteSize > 0] description: 'Invalid byte size.'. + handle := ExternalAddress allocate: self byteSize * numElements. + ^(ExternalData fromHandle: handle type: self) + size: numElements; + zeroMemory; + yourself! - handle := ExternalAddress allocate: self byteSize * anInteger. - ^(ExternalData fromHandle: handle type: self) size: anInteger! From commits at source.squeak.org Thu May 6 16:14:29 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 16:14:29 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.28.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.28.mcz ==================== Summary ==================== Name: FFI-Tests-mt.28 Author: mt Time: 6 May 2021, 6:14:29.484981 pm UUID: 5f1d805b-3654-e04c-85d5-efb697127cbf Ancestors: FFI-Tests-mt.27 More tests. Favor #allocateExternal over #externalNew. No need to #zeroMemory in several tests. Complements FFI-Kernel-mt.136. =============== Diff against FFI-Tests-mt.27 =============== Item was changed: ----- Method: ExternalStructureTests>>test02CopyStructureFromExternal (in category 'tests - external structure') ----- test02CopyStructureFromExternal | original copy | + original := heapObject := FFITestPoint2 allocateExternal. - original := heapObject := FFITestPoint2 externalNew. original setX: 1 setY: 2. copy := original copy. self assert: copy getHandle isInternalMemory. copy setX: 3 setY: 4. self assert: 1 at 2 equals: original asPoint. self assert: 3 at 4 equals: copy asPoint.! Item was changed: ----- Method: ExternalStructureTests>>test02FromToExternal (in category 'tests - external data') ----- test02FromToExternal "Access a sub-range in the external data. External memory will not be copied." | points portion | points := heapObject := FFITestPoint2 allocateExternal: 5. - points zeroMemory. portion := points from: 2 to: 3. self assert: portion getHandle isExternalAddress. portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. self assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } equals: (points collect: [:each | each asPoint]).! Item was changed: ----- Method: ExternalStructureTests>>test03CopyFromExternalToInternal (in category 'tests - external data') ----- test03CopyFromExternalToInternal | points copy | points := FFITestPoint2 allocateExternal: 5. - points zeroMemory. self assert: points getHandle isExternalAddress. copy := points copyFrom: 2 to: 3. self assert: copy getHandle isInternalMemory. "We need a writer to modify internal memory." copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). "Check that we did not touch the external memory." self assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } equals: (points collect: [:each | each asPoint]).! Item was changed: ----- Method: ExternalStructureTests>>test04AccessingInternalMemory (in category 'tests') ----- test04AccessingInternalMemory "Check whether we can use a ByteArrayWriter to fill structures." | composite | + composite := FFITestSUfdUdSi2 allocate. - composite := FFITestSUfdUdSi2 new. self assert: composite ~~ composite writer. self assert: 0.0 equals: composite ufd1 f1. composite ufd1 f1: 3.5. self deny: 3.5 equals: composite ufd1 f1. composite writer ufd1 f1: 3.5. self assert: 3.5 equals: composite ufd1 f1. self assert: 0 equals: composite udSii2 sii1 i1. composite udSii2 sii1 i1: 42. self deny: 42 equals: composite udSii2 sii1 i1. composite writer udSii2 sii1 i1: 42. self assert: 42 equals: composite udSii2 sii1 i1.! Item was changed: ----- Method: ExternalStructureTests>>test05AccessingExternalMemory (in category 'tests') ----- test05AccessingExternalMemory "Check whether we will stick to the ExternalAddress to fill structures." | composite | + composite := heapObject := FFITestSUfdUdSi2 allocateExternal. - composite := heapObject := FFITestSUfdUdSi2 externalNew. - heapObject zeroMemory. self assert: composite == composite writer. self assert: 0.0 equals: composite ufd1 f1. composite ufd1 f1: 3.5. self assert: 3.5 equals: composite ufd1 f1. self assert: 0 equals: composite udSii2 sii1 i1. composite udSii2 sii1 i1: 42. self assert: 42 equals: composite udSii2 sii1 i1.! Item was changed: ----- Method: ExternalStructureTests>>test06AccessingTypeAliasForAtomic (in category 'tests') ----- test06AccessingTypeAliasForAtomic | char | + char := FFITestCharAlias new. + self assert: 0 equals: char value asInteger. - self should: [FFITestCharAlias new] raise: Error. - char := FFITestCharAlias fromHandle: $C. - self assert: $C equals: char value. char value: $A. self assert: $A equals: char value. char zeroMemory. self assert: 0 equals: char value asInteger.! Item was changed: ----- Method: ExternalStructureTests>>test07AccessingArrays (in category 'tests') ----- test07AccessingArrays | data | + data := FFITestSdA5i allocate. - data := FFITestSdA5i new. self assert: data a5i2 first equals: 0. data writer a5i2 at: 1 put: 42. self assert: data a5i2 first equals: 42. + data := heapObject := FFITestSdA5i allocateExternal. - data := heapObject := FFITestSdA5i externalNew. - data zeroMemory. self assert: data a5i2 first equals: 0. data a5i2 at: 1 put: 42. self assert: data a5i2 first equals: 42.! Item was changed: TestCase subclass: #ExternalTypeTests + instanceVariableNames: 'heapObject' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'ExternalType' category: 'FFI-Tests'! Item was added: + ----- Method: ExternalTypeTests>>tearDown (in category 'running') ----- + tearDown + + heapObject ifNotNil: [heapObject free].! Item was added: + ----- Method: ExternalTypeTests>>testAllocateAtomics (in category 'tests') ----- + testAllocateAtomics + + self should: [ExternalType void allocate] raise: Error. + self assert: false equals: ExternalType bool allocate. + + self assert: 0 equals: ExternalType int8_t "sbyte" allocate. + self assert: 0 equals: ExternalType uint8_t "byte" allocate. + + self assert: 0 equals: ExternalType uint16_t "ushort" allocate. + self assert: 0 equals: ExternalType int16_t "short" allocate. + + self assert: 0 equals: ExternalType uint32_t "ulong" allocate. + self assert: 0 equals: ExternalType int32_t "long" allocate. + + self assert: 0 equals: ExternalType uint64_t "ulonglong" allocate. + self assert: 0 equals: ExternalType int64_t "longlong" allocate. + + self assert: Character null equals: ExternalType schar allocate. + self assert: Character null equals: ExternalType char allocate. + + self assert: 0.0 equals: ExternalType float allocate. + self assert: 0.0 equals: ExternalType double allocate.! Item was added: + ----- Method: ExternalTypeTests>>testAllocateAtomicsExternal (in category 'tests') ----- + testAllocateAtomicsExternal + + self should: [ExternalType void allocateExternal] raise: Error. + self assert: false equals: ExternalType bool allocateExternal. + + self assert: 0 equals: ExternalType int8_t "sbyte" allocateExternal. + self assert: 0 equals: ExternalType uint8_t "byte" allocateExternal. + + self assert: 0 equals: ExternalType uint16_t "ushort" allocateExternal. + self assert: 0 equals: ExternalType int16_t "short" allocateExternal. + + self assert: 0 equals: ExternalType uint32_t "ulong" allocateExternal. + self assert: 0 equals: ExternalType int32_t "long" allocateExternal. + + self assert: 0 equals: ExternalType uint64_t "ulonglong" allocateExternal. + self assert: 0 equals: ExternalType int64_t "longlong" allocateExternal. + + self assert: Character null equals: ExternalType schar allocateExternal. + self assert: Character null equals: ExternalType char allocateExternal. + + self assert: 0.0 equals: ExternalType float allocateExternal. + self assert: 0.0 equals: ExternalType double allocateExternal.! Item was added: + ----- Method: ExternalTypeTests>>testAllocateStructs (in category 'tests') ----- + testAllocateStructs + + | struct | + struct := FFITestPoint2 allocate. + self assert: 0 equals: struct x. + self assert: 0 equals: struct y. + + struct := FFITestSd2 allocate. + self assert: 0.0 equals: struct d1. + self assert: 0.0 equals: struct d2. + + struct := FFITestSsSsf allocate. + self assert: 0 equals: struct s1. + self assert: 0 equals: struct ssf2 s1. + self assert: 0.0 equals: struct ssf2 f2. + + struct := FFITestUfd allocate. + self assert: 0.0 equals: struct d1. + self assert: 0.0 equals: struct f1.! Item was added: + ----- Method: ExternalTypeTests>>testAllocateStructsExternal (in category 'tests') ----- + testAllocateStructsExternal + + | struct | + struct := heapObject := FFITestPoint2 allocateExternal. + self assert: 0 equals: struct x. + self assert: 0 equals: struct y. + + struct := heapObject := FFITestSd2 allocateExternal. + self assert: 0.0 equals: struct d1. + self assert: 0.0 equals: struct d2. + + struct := heapObject := FFITestSsSsf allocateExternal. + self assert: 0 equals: struct s1. + self assert: 0 equals: struct ssf2 s1. + self assert: 0.0 equals: struct ssf2 f2. + + struct := heapObject := FFITestUfd allocateExternal. + self assert: 0.0 equals: struct d1. + self assert: 0.0 equals: struct f1.! Item was changed: ----- Method: FFIPluginTests>>testSumStructSUfdUdsi2 (in category 'tests - structure') ----- testSumStructSUfdUdsi2 + "Sum up the double parts of two unions in a struct." - "Sum up the double parts of two unions in a struct. We have to malloc because we cannot (yet?) share parts of byte arrays between structures." | sUfdUdsi2 sum | + sUfdUdsi2 := heapObject := FFITestSUfdUdSi2 allocateExternal. - sUfdUdsi2 := heapObject := FFITestSUfdUdSi2 externalNew. sUfdUdsi2 ufd1 d1: 123.456. sUfdUdsi2 udSii2 d1: 456.123. sum := self invoke: 'ffiTestSumSUfdUdSi2_d' with: sUfdUdsi2. self assert: 123.456 + 456.123 equals: sum.! Item was changed: ----- Method: FFIPluginTests>>testSumStructSUfdUfi (in category 'tests - structure') ----- testSumStructSUfdUfi + "Sum up the float parts of two unions in a struct." - "Sum up the float parts of two unions in a struct. We have to malloc because we cannot (yet?) share parts of byte arrays between structures." | sUfdUdsi2 result expected | + sUfdUdsi2 := heapObject := FFITestSUfdUfi allocateExternal. - sUfdUdsi2 := heapObject := FFITestSUfdUfi externalNew. sUfdUdsi2 ufd1 f1: 123.456. sUfdUdsi2 ufi2 f1: 456.123. result := self invoke: 'ffiTestSumSUfdUfi_f' with: sUfdUdsi2. expected := 123.456 + 456.123. self assert: (result between: expected - 0.0005 and: expected + 0.0005).! From commits at source.squeak.org Thu May 6 17:05:29 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:05:29 0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz Message-ID: Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed: ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') ----- explorerContents ^#( ('hexadecimal' 16 2) ('octal' 8 3) ('binary' 2 4)) collect: [ :each | | label group | group := each third. + label := self abs printStringBase: each second. - label := self printStringBase: each second. label := label padded: #left to: (label size roundUpTo: group) with: $0. label := String streamContents: [:s | + self negative ifTrue: [s nextPutAll: '- ']. (1 to: label size by: group) do: [:index | 1 to: group do: [:gIndex | s nextPut: (label at: index + gIndex - 1)]] separatedBy: [s space]]. ObjectExplorerWrapper with: label name: each first translated model: self ]! From commits at source.squeak.org Thu May 6 17:11:12 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:11:12 0000 Subject: [squeak-dev] The Trunk: Tools-mt.1055.mcz Message-ID: Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1055.mcz ==================== Summary ==================== Name: Tools-mt.1055 Author: mt Time: 6 May 2021, 7:11:08.881981 pm UUID: 9b30ecaa-fce5-b44c-af74-25a25f1eb5f8 Ancestors: Tools-mt.1054 Adds a new hook to Inspector and ObjectExplorer. Objects-under-inspection/exploration can intervene when the tool window is about to close. Yes, this is a hook for "FFI-Tools" where I want to inform the user about external memory/address and ask whether to free it. :-) Other possible uses include notifications for the last instance of a server (e.g. socket) or other resource. Everywhere where the GC might bite you because you loose your last precious reference with unwanted side-effects. =============== Diff against Tools-mt.1054 =============== Item was added: + ----- Method: BasicInspector>>objectOkToClose (in category 'user interface - window') ----- + objectOkToClose + "No extra interaction with the object in the basic inspector:" + + ^ true! Item was added: + ----- Method: Inspector>>objectOkToClose (in category 'user interface - window') ----- + objectOkToClose + + ^ (self object respondsTo: #inspectorOkToClose) + ==> [(self object perform: #inspectorOkToClose) == true]! Item was changed: ----- Method: Inspector>>okToClose (in category 'user interface - window') ----- okToClose + "Check custom fields and give the object-under-inspection a chance to react. Maybe this explorer is an important reference to the object and the user needs to be informed about this fact." + ^ super okToClose + and: [self okToDiscardCustomFields + and: [self objectOkToClose]]! - ^ super okToClose and: [self okToDiscardCustomFields]! Item was added: + ----- Method: ObjectExplorer>>okToClose (in category 'user interface') ----- + okToClose + "Give the object-under-exploration a chance to react. Maybe this explorer is an important reference to the object and the user needs to be informed about this fact." + + ^ super okToClose + and: [(self rootObject respondsTo: #explorerOkToClose) + ==> [(self rootObject perform: #explorerOkToClose) == true]]! From commits at source.squeak.org Thu May 6 17:15:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:15:39 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.137.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.137.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.137 Author: mt Time: 6 May 2021, 7:15:39.236981 pm UUID: 2cd24707-c5c7-d24e-aa5f-70eae222e880 Ancestors: FFI-Kernel-mt.136 Prevent users from accessing type information for a generic ExternalData class. It makes no sense if you don't have a concrete type at hand. Adds the missing extra-type-check pref check for dynamic data access in external types. =============== Diff against FFI-Kernel-mt.136 =============== Item was changed: ----- Method: ExternalData class>>byteAlignment (in category 'external type') ----- byteAlignment + self shouldNotImplement.! - ^ self externalType byteAlignment! Item was changed: ----- Method: ExternalData class>>byteSize (in category 'external type') ----- byteSize + + self shouldNotImplement.! - - ^ self externalType byteSize! Item was changed: ----- Method: ExternalData class>>compiledSpec (in category 'external type') ----- compiledSpec + self shouldNotImplement.! - ^ self externalType compiledSpec! Item was changed: ----- Method: ExternalData class>>externalType (in category 'external type') ----- externalType - "Without having concrete external data, we can only tell that some void* will be in charge." + self shouldNotImplement.! - ^ ExternalType void asPointerType! Item was changed: ----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." self checkType. self isAtomic ifTrue: [ "alias to atomic" + self class extraTypeChecks ifTrue: [ + self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." ^ handle perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol with: byteOffset with: value getHandle] ifFalse: [ "regular struct or alias to struct or alias to pointer" + self class extraTypeChecks ifTrue: [ + self assert: [value externalType == self]]. - self assert: [value externalType == self]. ^ handle structAt: byteOffset put: value getHandle length: self byteSize].! Item was changed: ----- Method: ExternalType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." self checkType. self isPointerType ifFalse: [ "set atomic value" + self class extraTypeChecks ifTrue: [ + self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types." handle perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol with: byteOffset with: value] ifTrue: [ "set pointer to struct/union/alias" + self class extraTypeChecks ifTrue: [ + self assert: [value externalType == self]]. - self assert: [value externalType == self]. handle pointerAt: byteOffset put: value getHandle length: self byteSize].! From commits at source.squeak.org Thu May 6 17:19:25 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:19:25 0000 Subject: [squeak-dev] The Inbox: Collections-ct.944.mcz Message-ID: A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ct.944.mcz ==================== Summary ==================== Name: Collections-ct.944 Author: ct Time: 6 May 2021, 7:19:19.626252 pm UUID: ff2ccbdf-62a6-9040-ba1a-5c7ae932a1c9 Ancestors: Collections-mt.943 Fixes a slip in HtmlReadWriter when encountering an empty CSS value. Note that according to W3C, empty CSS values are not permitted, but let's not make our converter fail for such a trivial reason, in particular since I met such a tag in the wild. Also, the check already exists anyway. :-) =============== Diff against Collections-mt.943 =============== Item was changed: ----- Method: HtmlReadWriter>>mapContainerTag: (in category 'mapping') ----- mapContainerTag: aTag | result styleStart styleEnd styleAttributes | result := OrderedCollection new. styleStart := (aTag findString: 'style="' ) + 7. styleStart <= 7 ifTrue: [^#()]. styleEnd := (aTag findString: '"' startingAt: styleStart) - 1. styleAttributes := (aTag copyFrom: styleStart to: styleEnd) subStrings: ';'. styleAttributes do: [:ea | |keyValue key value| keyValue := (ea subStrings: ':') collect: [:s | s withBlanksTrimmed]. key := keyValue first asLowercase. - value := keyValue second. keyValue size = 2 ifTrue: [ + value := keyValue second. key = 'color' ifTrue: [result add: (TextColor color: (Color fromString: value))]. (key beginsWith: 'font') ifTrue: [ (value includesSubstring: 'bold') ifTrue: [result add: TextEmphasis bold]. (value includesSubstring: 'italic') ifTrue: [result add: TextEmphasis italic]]]]. ^ result! From commits at source.squeak.org Thu May 6 17:20:13 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:20:13 0000 Subject: [squeak-dev] The Inbox: CollectionsTests-ct.356.mcz Message-ID: A new version of CollectionsTests was added to project The Inbox: http://source.squeak.org/inbox/CollectionsTests-ct.356.mcz ==================== Summary ==================== Name: CollectionsTests-ct.356 Author: ct Time: 6 May 2021, 7:20:08.135252 pm UUID: 90971275-bb93-b244-b0a2-bf8e0d682308 Ancestors: CollectionsTests-nice.354 Adjusts test for Collections-ct.944 (empty CSS value). =============== Diff against CollectionsTests-nice.354 =============== Item was changed: ----- Method: HtmlReadWriterTest>>test13SpanTag (in category 'tests') ----- test13SpanTag { + 'Hello, World!!'. - 'Hello, World!!'. 'Hello, World!!' asText addAttribute: (TextColor color: Color yellow); + addAttribute: TextEmphasis bold} pairsDo: [:expectedHtml :expectedText | - addAttribute: (TextEmphasis bold). - } pairsDo: [:expectedHtml :expectedText | - self convertHtml: expectedHtml. self assert: expectedText string equals: text string. self assert: expectedText runs equals: text runs]! From commits at source.squeak.org Thu May 6 17:24:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:24:07 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.138.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.138.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.138 Author: mt Time: 6 May 2021, 7:24:07.692981 pm UUID: 9ca79170-aa43-3a48-bed3-ece1a118acc2 Ancestors: FFI-Kernel-mt.137 Adds a way to transparently access #byteSize for instances of structs, unions, external data. Well, I am not happy with adding #byteSize to ExternalStructure because it removes one possible name for domain-specific structs. The actual issue is that -- in ExternalData -- we have no "container type" for containers with unknown sizes. While we do use pointer types (e.g. "byte*") at the moment, their byteSize (i.e. the word size, 8 for 64-bit) is not what we are looking for. Those "containers" have an unknown byteSize regarding their contents. Note that even an empty array type (e.g. byte[0]) would not work because ne would need to encode "unknown" and not "empty". Just like whether the "size" instVar in ExternalData is "nil" or "0". It has a different meaning. Anyway, this solution is good enough at the moment. =============== Diff against FFI-Kernel-mt.137 =============== Item was added: + ----- Method: ExternalData>>byteSize (in category 'accessing') ----- + byteSize + "Answer how many bytes the receiver manages." + + self sizeCheck. + + ^ handle isExternalAddress + ifTrue: [self size * self contentType byteSize] + ifFalse: [ "ByteArray" handle size]! Item was changed: ----- Method: ExternalData>>externalType (in category 'accessing - types') ----- externalType + ^ self containerType! - ^ type! Item was added: + ----- Method: ExternalStructure>>byteSize (in category 'accessing') ----- + byteSize + "Answer the number of bytes managed by the receiver." + + ^ self externalType byteSize! From commits at source.squeak.org Thu May 6 17:27:57 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:27:57 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.27.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.27.mcz ==================== Summary ==================== Name: FFI-Tools-mt.27 Author: mt Time: 6 May 2021, 7:27:57.081981 pm UUID: f737b5e5-71dd-604e-bce6-e42a9f4fc08d Ancestors: FFI-Tools-mt.26 For external data with a specific size (i.e. known array type), list all elements just like in an explorer on a collection. When closing explorer/inspector, ask users whether to free external memory if any allocated. =============== Diff against FFI-Tools-mt.26 =============== Item was changed: ----- Method: ExternalData>>explorerContentsStructFields (in category '*FFI-Tools') ----- explorerContentsStructFields "In case some data interpretation omitted to convert char*, which is a (null-terminated) C string, to Smalltalk string." + + size notNil ifTrue: [ + ^ self withIndexCollect: [:each :index | + ObjectExplorerWrapper + with: each + name: index printString + model: self]]. ^ (self isNull not and: [self containerType = ExternalType string]) ifFalse: [#()] ifTrue: [ {ObjectExplorerWrapper with: self fromCString name: 'as C string' model: self}]! Item was added: + ----- Method: ExternalStructure>>explorerOkToClose (in category '*FFI-Tools') ----- + explorerOkToClose + "We are being explored and that explorer wants to close. If we point to external memory, ask the user whether we should free it to avoid leaks." + + (handle isExternalAddress and: [handle isNull not]) ifTrue: [ + (Project uiManager + confirm: ('There are {1} bytes addressed.
Do you want to free the allocated memory?' + translated format: { + [self byteSize] ifError: ['an unknown number of']. }) asTextFromHtml + orCancel: [^ false] + title: 'External Address Detected' translated) + ifTrue: [self free]]. + + ^ true! Item was added: + ----- Method: ExternalStructure>>inspectorOkToClose (in category '*FFI-Tools') ----- + inspectorOkToClose + + ^ self explorerOkToClose! From commits at source.squeak.org Thu May 6 17:57:51 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 17:57:51 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.28.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.28.mcz ==================== Summary ==================== Name: FFI-Tools-mt.28 Author: mt Time: 6 May 2021, 7:57:49.985981 pm UUID: baed18b3-7684-634c-b285-691d551be27c Ancestors: FFI-Tools-mt.27 Make the label for handles accessed via byte-array read-writer more readable by summarizing skipped bytes to a number instead of dots after a certain threshold, which is 16 bytes at the moment. =============== Diff against FFI-Tools-mt.27 =============== Item was changed: ----- Method: ExternalObjectHandleWrapper>>objectString (in category 'accessing') ----- objectString + | label handle skipLimit | - | label handle | label := super objectString. handle := self getHandle. + skipLimit := 16. handle isExternalAddress ifTrue: [^ label]. handle isInternalMemory ifTrue: [ ^ (thisContext objectClass: handle) == ByteArrayReadWriter ifFalse: [label] + ifTrue: [ | begin end tokens | + label :=(thisContext object: handle instVarAt: 3) "byteArray" printString. - ifTrue: [ | begin end | - label :=(thisContext object: handle instVarAt: 3) printString. label := label copyFrom: 3 to: (label size - 1). + begin := (thisContext object: handle instVarAt: 1) "byteOffset" + 1. + end := begin - 1 + (thisContext object: handle instVarAt: 2) "byteSize". - begin := (thisContext object: handle instVarAt: 1) + 1. - end := begin + (thisContext object: handle instVarAt: 2) - 1. String streamContents: [:stream | stream nextPutAll: '#[ '. + tokens := label findTokens: ' ' "#[0 0 0 0 0]". + begin > skipLimit ifTrue: [ + stream nextPutAll: '. . ', (begin - 1) asString, ' bytes . . '. + tokens := tokens allButFirst: begin - 1. + end := end - begin + 1. begin := 1]. + (1 to: end) do: [:index | | token | + token := tokens at: index. + index >= begin - (label findTokens: ' ' "#[0 0 0 0 0]") withIndexDo: [:token :index | - (index between: begin and: end) ifTrue: [stream nextPutAll: token] ifFalse: ["Skip byte info" stream nextPut: $.]. stream space]. + (tokens size - end + 1) > skipLimit ifTrue: [ + stream nextPutAll: '. . ', (tokens size - end) asString, ' bytes . . '. + tokens := tokens allButLast: tokens size - end. + end := tokens size]. + (tokens size - end) timesRepeat: [ + "Skip byte info" stream nextPut: $.. + stream space]. stream nextPutAll: ']'. ]]]. "Type aliases to atomic types store primitive Smalltalk objects in their handle. Indicate that role of actually being a handle for the FFI plugin with a small prefix." ^ '-> ', label! From marcel.taeumel at hpi.de Thu May 6 18:00:07 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Thu, 6 May 2021 20:00:07 +0200 Subject: [squeak-dev] FFI: FFI-Tools-mt.28.mcz In-Reply-To: References: Message-ID: Am 06.05.2021 19:57:59 schrieb commits at source.squeak.org : Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.28.mcz ==================== Summary ==================== Name: FFI-Tools-mt.28 Author: mt Time: 6 May 2021, 7:57:49.985981 pm UUID: baed18b3-7684-634c-b285-691d551be27c Ancestors: FFI-Tools-mt.27 Make the label for handles accessed via byte-array read-writer more readable by summarizing skipped bytes to a number instead of dots after a certain threshold, which is 16 bytes at the moment. =============== Diff against FFI-Tools-mt.27 =============== Item was changed: ----- Method: ExternalObjectHandleWrapper>>objectString (in category 'accessing') ----- objectString + | label handle skipLimit | - | label handle | label := super objectString. handle := self getHandle. + skipLimit := 16. handle isExternalAddress ifTrue: [^ label]. handle isInternalMemory ifTrue: [ ^ (thisContext objectClass: handle) == ByteArrayReadWriter ifFalse: [label] + ifTrue: [ | begin end tokens | + label :=(thisContext object: handle instVarAt: 3) "byteArray" printString. - ifTrue: [ | begin end | - label :=(thisContext object: handle instVarAt: 3) printString. label := label copyFrom: 3 to: (label size - 1). + begin := (thisContext object: handle instVarAt: 1) "byteOffset" + 1. + end := begin - 1 + (thisContext object: handle instVarAt: 2) "byteSize". - begin := (thisContext object: handle instVarAt: 1) + 1. - end := begin + (thisContext object: handle instVarAt: 2) - 1. String streamContents: [:stream | stream nextPutAll: '#[ '. + tokens := label findTokens: ' ' "#[0 0 0 0 0]". + begin > skipLimit ifTrue: [ + stream nextPutAll: '. . ', (begin - 1) asString, ' bytes . . '. + tokens := tokens allButFirst: begin - 1. + end := end - begin + 1. begin := 1]. + (1 to: end) do: [:index | | token | + token := tokens at: index. + index >= begin - (label findTokens: ' ' "#[0 0 0 0 0]") withIndexDo: [:token :index | - (index between: begin and: end) ifTrue: [stream nextPutAll: token] ifFalse: ["Skip byte info" stream nextPut: $.]. stream space]. + (tokens size - end + 1) > skipLimit ifTrue: [ + stream nextPutAll: '. . ', (tokens size - end) asString, ' bytes . . '. + tokens := tokens allButLast: tokens size - end. + end := tokens size]. + (tokens size - end) timesRepeat: [ + "Skip byte info" stream nextPut: $.. + stream space]. stream nextPutAll: ']'. ]]]. "Type aliases to atomic types store primitive Smalltalk objects in their handle. Indicate that role of actually being a handle for the FFI plugin with a small prefix." ^ '-> ', label! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 95621 bytes Desc: not available URL: From marcel.taeumel at hpi.de Thu May 6 18:26:33 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Thu, 6 May 2021 20:26:33 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> Message-ID: > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) [http://www.hpi.de/] Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz [http://source.squeak.org/trunk/Morphic-mt.1767.mcz] ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + +        ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + +        ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + +        DualChangeSorter open.! Item was changed:   ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') -----   listChangesOn: menu            | latestMethodChanges latestClassChanges|          latestMethodChanges := (Array streamContents: [:s |                  ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category |                          s nextPut: { dateAndTime. method. changeType. category }]])                          sorted: [:a :b | a first >= b first].            1 to: (10 min: latestMethodChanges size) do: [:index | | spec method |                  spec := latestMethodChanges at: index.                  method := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ;                                  target: ToolSet;                                  balloonText: spec third asString;                                  icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [                                          spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]);                                  selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]);                                  arguments: {method}]].                                           latestClassChanges := (Array streamContents: [:s |                  ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category |                          "We are not interested in classes whose method's did only change."                          changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]])                          sorted: [:a :b | a first >= b first].            latestClassChanges ifNotEmpty: [menu addLine].          1 to: (10 min: latestClassChanges size) do: [:index | | spec class |                  spec := latestClassChanges at: index.                  class := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ;                                  target: ToolSet;                                  balloonText: (spec third sorted joinSeparatedBy: Character space);                                  icon: ((spec third includesAnyOf: #(remove addedThenRemoved))                                          ifTrue: [MenuIcons smallDeleteIcon]                                          ifFalse: [                                                  (spec third includes: #add)                                                          ifTrue: [MenuIcons smallNewIcon]                                                          ifFalse: [MenuIcons blankIcon]]);                                  selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]);                                  arguments: {class}]]. +        +        menu defaultTarget: self. +        menu addTranslatedList: #( +                - +                ('Browse current change set'            browseChangeSet) +                ('Browse changed methods'               browseChangedMethods) +                - +                ('Simple Change Sorter'                         browseChanges) +                ('Dual Change Sorter'                                   browseChangesDual)). + + + ! -                                -        menu addLine; addItem: [:item | -                item -                        contents: 'Browse current change set...' translated; -                        target: self; -                        selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Thu May 6 18:32:24 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Thu, 6 May 2021 20:32:24 +0200 Subject: [squeak-dev] The Inbox: Morphic-ct.1769.mcz In-Reply-To: References: Message-ID: > Avoid translucent color. Why? I did cut out the drop shadow. Translucent windows colors look so cool! :-D Am 01.05.2021 14:12:32 schrieb commits at source.squeak.org : A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1769.mcz ==================== Summary ==================== Name: Morphic-ct.1769 Author: ct Time: 1 May 2021, 2:12:17.510389 pm UUID: aa271c07-344a-324a-afe4-3950d6c00839 Ancestors: Morphic-mt.1767 Make SystemWindow's paneColor more robust against missing models. Avoid translucent color. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: SystemWindow>>paneColor (in category 'colors') ----- paneColor | cc | (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc]. (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse]. + cc ifNil: [cc := paneMorphs + detect: [:morph | morph color isTransparent not] + ifFound: [:morph | morph color asNontranslucentColor] + ifNone: [nil]]. - cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]. cc ifNil: [cc := self defaultColor]. self paneColor: cc. ^cc! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57317 bytes Desc: not available URL: From commits at source.squeak.org Thu May 6 20:08:33 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 20:08:33 0000 Subject: [squeak-dev] The Inbox: Collections-ct.945.mcz Message-ID: A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ct.945.mcz ==================== Summary ==================== Name: Collections-ct.945 Author: ct Time: 6 May 2021, 10:08:28.643835 pm UUID: 4a526dd8-6418-c44f-aa41-3de63a54b393 Ancestors: Collections-mt.943 Makes HtmlReadWriter robust against HTML5 void tags. As opposed to XHTML tags, they need to be closed manually. In the past, HTML strings such as the following failed with an "error: this stack is empty": '' asTextFromHtml This problem is now solved by ignoring void tags in #processEndTag:. =============== Diff against Collections-mt.943 =============== Item was added: + ----- Method: HtmlReadWriter>>isVoidTag: (in category 'testing') ----- + isVoidTag: aTag + + ^ self voidTags includes: aTag! Item was changed: ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') ----- processEndTag: aTag | index tagName | index := count - offset. tagName := aTag copyFrom: 3 to: aTag size - 1. + - (self isTagIgnored: tagName) ifTrue: [^ self]. + (self isVoidTag: tagName) ifTrue: [^ self]. tagName = 'code' ifTrue: [self mapCloseCodeTag]. tagName = 'pre' ifTrue: [self breakLines: true]. + - self processRunStackTop. + - runStack pop. + runStack top at: 2 put: index + 1! - runStack top at: 2 put: index + 1.! Item was removed: - ----- Method: HtmlReadWriter>>processEndTagEagerly: (in category 'reading') ----- - processEndTagEagerly: aTag - "Not all tags need an end tag. Simulate that here." - - (aTag beginsWith: ''].! Item was changed: ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') ----- processStartTag: aTag + | tagName index | + tagName := (aTag copyWithoutAll: '') copyUpTo: Character space. + (self isTagIgnored: tagName) ifTrue: [^ self]. + - | index | - (self isTagIgnored: aTag) ifTrue: [^ self]. - index := count - offset. + + tagName = 'br' ifTrue: [ - - aTag = '
' ifTrue: [ self addCharacter: Character cr. ^ self]. + + tagName = 'img' ifTrue: [ - - (aTag beginsWith: ', we should simulate the closing tag because in case of HTML5 there won't be any." + (self isVoidTag: tagName) ifTrue: [self processEndTag: tagName]! - runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1 . index + 1}). - - "For tags such as , we should simulate the closing tag because there won't be any." - self processEndTagEagerly: aTag.! Item was added: + ----- Method: HtmlReadWriter>>voidTags (in category 'accessing') ----- + voidTags + "Tags that are empty and won't be closed in HTML5." + + ^ #(#img)! From commits at source.squeak.org Thu May 6 20:10:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 20:10:53 0000 Subject: [squeak-dev] The Inbox: CollectionsTests-ct.357.mcz Message-ID: A new version of CollectionsTests was added to project The Inbox: http://source.squeak.org/inbox/CollectionsTests-ct.357.mcz ==================== Summary ==================== Name: CollectionsTests-ct.357 Author: ct Time: 6 May 2021, 10:10:49.328835 pm UUID: 4127e94a-ff43-c34b-937d-0760d63c4226 Ancestors: CollectionsTests-nice.354 Adds test for Collections-ct.945 (empty end tag ). =============== Diff against CollectionsTests-nice.354 =============== Item was added: + ----- Method: HtmlReadWriterTest>>test17EmptyEndImgTag (in category 'tests') ----- + test17EmptyEndImgTag + "Empty end tags are disallowed in XHTML but required in HTML5." + + self convertHtml: 'az'. + self assert: ({$a. Character value: 1. $z} as: String) equals: text string. + self assert: (RunArray new: 3 withAll: #()) equals: text runs! From commits at source.squeak.org Thu May 6 20:16:26 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 20:16:26 0000 Subject: [squeak-dev] The Inbox: Collections-ct.946.mcz Message-ID: A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-ct.946.mcz ==================== Summary ==================== Name: Collections-ct.946 Author: ct Time: 6 May 2021, 10:16:21.568835 pm UUID: bccb3d02-408c-0a49-8276-6900a779892c Ancestors: Collections-mt.943 Makes HtmlReadWriter robust against invalid CSS colors. CSS is too complex to be covered completely in our simple HTML parser. For example, the following failed before: 'hi' asTextFromHtml. =============== Diff against Collections-mt.943 =============== Item was changed: ----- Method: HtmlReadWriter>>mapContainerTag: (in category 'mapping') ----- mapContainerTag: aTag | result styleStart styleEnd styleAttributes | result := OrderedCollection new. + styleStart := (aTag findString: 'style="') + 7. + styleStart <= 7 ifTrue: [^ #()]. - styleStart := (aTag findString: 'style="' ) + 7. - styleStart <= 7 ifTrue: [^#()]. styleEnd := (aTag findString: '"' startingAt: styleStart) - 1. styleAttributes := (aTag copyFrom: styleStart to: styleEnd) subStrings: ';'. + styleAttributes do: [:ea | | keyValue key value | - styleAttributes do: [:ea | |keyValue key value| keyValue := (ea subStrings: ':') collect: [:s | s withBlanksTrimmed]. key := keyValue first asLowercase. value := keyValue second. keyValue size = 2 ifTrue: [ + key = 'color' ifTrue: [ | color | + color := [Color fromString: value] ifError: [nil]. + color ifNotNil: [result add: (TextColor color: color)]]. - key = 'color' ifTrue: [result add: (TextColor color: (Color fromString: value))]. (key beginsWith: 'font') ifTrue: [ + (value includesSubstring: 'bold') ifTrue: [result add: TextEmphasis bold]. + (value includesSubstring: 'italic') ifTrue: [result add: TextEmphasis italic]]]]. - (value includesSubstring: 'bold') - ifTrue: [result add: TextEmphasis bold]. - (value includesSubstring: 'italic') - ifTrue: [result add: TextEmphasis italic]]]]. ^ result! From christoph.thiede at student.hpi.uni-potsdam.de Thu May 6 20:27:57 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Thu, 6 May 2021 22:27:57 +0200 Subject: [squeak-dev] [ENH] isSeparator Message-ID: Hi all, here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be identified correctly now, too. Please review and merge! :-) Best, Christoph ["isSeparator.cs.gz"] -------------- next part -------------- A non-text attachment was scrubbed... Name: isSeparator.cs.gz Type: application/octet-stream Size: 436 bytes Desc: not available URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Thu May 6 20:30:56 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Thu, 6 May 2021 20:30:56 +0000 Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: Message-ID: Hi all, here is another tiny changeset, depending on isSeparator.cs: withAllBlanksTrimmed.cs uses the encoding-aware #isSeparator implementation to trim all kinds of spaces correctly from a string. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Donnerstag, 6. Mai 2021 22:27:57 An: squeak-dev at lists.squeakfoundation.org Betreff: [squeak-dev] [ENH] isSeparator Hi all, here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be identified correctly now, too. Please review and merge! :-) Best, Christoph ["isSeparator.cs.gz"] -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: withAllBlanksTrimmed.1.cs URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Thu May 6 20:32:40 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Thu, 6 May 2021 20:32:40 +0000 Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: , Message-ID: Community support: Inlined changesets --- isSeparator.1.cs --- 'From Squeak6.0alpha of 29 April 2021 [latest update: #20483] on 6 May 2021 at 10:21:24 pm'! !Character methodsFor: 'testing' stamp: 'ct 5/6/2021 21:41'! isSeparator "Answer whether the receiver is a separator such as space, cr, tab, line feed, or form feed." ^ self encodedCharSet isSeparator: self! ! !EncodedCharSet class methodsFor: 'character classification' stamp: 'ct 5/6/2021 21:46'! isSeparator: char "Answer whether char has the code of a separator in this encoding." ^ self isSeparatorCode: char charCode! ! !EncodedCharSet class methodsFor: 'character classification' stamp: 'ct 5/6/2021 21:39'! isSeparatorCode: anInteger "Answer whether anInteger is the code of a separator." ^ Character separators includesCode: anInteger! ! !Unicode class methodsFor: 'character classification' stamp: 'ct 5/6/2021 21:51'! isSeparatorCode: charCode | cat | cat := self generalCategoryOf: charCode. ^ cat = Cc or: [cat >= Zl and: [cat <= Zs]]! ! ------ --- withAllBlanksTrimmed.1.cs --- 'From Squeak6.0alpha of 29 April 2021 [latest update: #20483] on 6 May 2021 at 10:24:39 pm'! !String methodsFor: 'converting' stamp: 'ct 5/6/2021 21:56'! withBlanksTrimmed "Return a copy of the receiver from which leading and trailing blanks have been trimmed." | first last | first := (self findFirst: [:character | character isSeparator not]). first = 0 ifTrue: [^ '']. "no non-separator character" last := self findLast: [:character | character isSeparator not]. last = 0 ifTrue: [last := self size]. (first = 1 and: [last = self size]) ifTrue: [^ self copy]. ^ self copyFrom: first to: last! ! !StringTest methodsFor: 'tests - converting' stamp: 'ct 5/6/2021 22:00'! testWithBlanksTrimmed | s | self assert: ' abc d ' withBlanksTrimmed = 'abc d'. self assert: 'abc d ' withBlanksTrimmed = 'abc d'. self assert: ' abc d' withBlanksTrimmed = 'abc d'. self assert: (((0 to: 255) collect: [:each | each asCharacter] thenSelect: [:each | each isSeparator]) as: String) withBlanksTrimmed = ''. self assert: '¬†nbsps around¬†' withBlanksTrimmed = 'nbsps around'. s := 'abcd'. self assert: s withBlanksTrimmed = s. self assert: s withBlanksTrimmed ~~ s! ! !Text methodsFor: 'converting' stamp: 'ct 5/6/2021 21:57'! withBlanksTrimmed "Return a copy of the receiver from which leading and trailing blanks have been trimmed." | first last | first := string findFirst: [:character | character isSeparator not]. first = 0 ifTrue: [^ '']. "no non-separator character" last := string findLast: [:character | character isSeparator not]. last = 0 ifTrue: [last := self size]. (first = 1 and: [last = self size]) ifTrue: [^ self copy]. ^ self copyFrom: first to: last! ! ------ ________________________________ Von: Thiede, Christoph Gesendet: Donnerstag, 6. Mai 2021 22:30:56 An: squeak-dev at lists.squeakfoundation.org Betreff: AW: [squeak-dev] [ENH] isSeparator Hi all, here is another tiny changeset, depending on isSeparator.cs: withAllBlanksTrimmed.cs uses the encoding-aware #isSeparator implementation to trim all kinds of spaces correctly from a string. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Donnerstag, 6. Mai 2021 22:27:57 An: squeak-dev at lists.squeakfoundation.org Betreff: [squeak-dev] [ENH] isSeparator Hi all, here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be identified correctly now, too. Please review and merge! :-) Best, Christoph ["isSeparator.cs.gz"] -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Thu May 6 20:33:32 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 20:33:32 0000 Subject: [squeak-dev] The Inbox: PackageInfo-Base-ct.75.mcz Message-ID: A new version of PackageInfo-Base was added to project The Inbox: http://source.squeak.org/inbox/PackageInfo-Base-ct.75.mcz ==================== Summary ==================== Name: PackageInfo-Base-ct.75 Author: ct Time: 6 May 2021, 10:33:29.313835 pm UUID: 97e1ecda-b56a-1b44-bfa6-0e80ddc30e9f Ancestors: PackageInfo-Base-nice.74 Adds PackageInfo >> #unregister analogously to existing #register. =============== Diff against PackageInfo-Base-nice.74 =============== Item was removed: - (PackageInfo named: 'PackageInfo-Base') preamble: '"below, add code to be run before the loading of this package" - PackageOrganizer default - unregisterPackageNamed: ''PackageInfo''; - unregisterPackageNamed: ''ToolBuilder''; - unregisterPackageNamed: ''Morphic-TrueType'''! Item was added: + ----- Method: PackageInfo>>unregister (in category 'registering') ----- + unregister + + Environment current packageOrganizer unregisterPackage: self! From commits at source.squeak.org Thu May 6 20:46:23 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 20:46:23 0000 Subject: [squeak-dev] The Inbox: Graphics-ct.449.mcz Message-ID: A new version of Graphics was added to project The Inbox: http://source.squeak.org/inbox/Graphics-ct.449.mcz ==================== Summary ==================== Name: Graphics-ct.449 Author: ct Time: 6 May 2021, 10:46:15.911809 pm UUID: 52f12efc-da63-0d44-a252-72bc5f89b6c7 Ancestors: Graphics-mt.448 Proposal: Adds Form >> #scaledBy: that scales a form by a certain factor. I identified half a dozen of senders of #scaledToSize: in the Trunk each of which has reinvented this wheel. =============== Diff against Graphics-mt.448 =============== Item was added: + ----- Method: Form>>scaledBy: (in category 'scaling, rotation') ----- + scaledBy: factor + "Answer a version of the receiver which is scaled by factor, which can be a number or point." + + (factor closeTo: 1) ifTrue: [^ self]. + ^ self scaledToSize: (self extent * factor) rounded! From Christoph.Thiede at student.hpi.uni-potsdam.de Thu May 6 20:48:35 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Thu, 6 May 2021 20:48:35 +0000 Subject: [squeak-dev] The Inbox: Graphics-ct.449.mcz In-Reply-To: References: Message-ID: If you merge this proposal, please consider merging the attached changeset as well, which eliminates the duplication from the mentioned senders. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 22:46:23 An: squeak-dev at lists.squeakfoundation.org Betreff: [squeak-dev] The Inbox: Graphics-ct.449.mcz A new version of Graphics was added to project The Inbox: http://source.squeak.org/inbox/Graphics-ct.449.mcz ==================== Summary ==================== Name: Graphics-ct.449 Author: ct Time: 6 May 2021, 10:46:15.911809 pm UUID: 52f12efc-da63-0d44-a252-72bc5f89b6c7 Ancestors: Graphics-mt.448 Proposal: Adds Form >> #scaledBy: that scales a form by a certain factor. I identified half a dozen of senders of #scaledToSize: in the Trunk each of which has reinvented this wheel. =============== Diff against Graphics-mt.448 =============== Item was added: + ----- Method: Form>>scaledBy: (in category 'scaling, rotation') ----- + scaledBy: factor + "Answer a version of the receiver which is scaled by factor, which can be a number or point." + + (factor closeTo: 1) ifTrue: [^ self]. + ^ self scaledToSize: (self extent * factor) rounded! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: scaledToSize-senders.1.cs URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Thu May 6 20:59:10 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Thu, 6 May 2021 20:59:10 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de>, Message-ID: <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de> > So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? This, of course, would only work if the list could only grow at its end. But I see your point ... I often have a similar situation with the thumbnails in the project menu (around 10 - 20 projects). Lazy loading might actually save me around 60 seconds per day. :D > How big was the changeset that produced those lags? Very small, maybe a dozen of changes. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:26:33 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + + ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + + ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + + DualChangeSorter open.! Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu | latestMethodChanges latestClassChanges| latestMethodChanges := (Array streamContents: [:s | ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | s nextPut: { dateAndTime. method. changeType. category }]]) sorted: [:a :b | a first >= b first]. 1 to: (10 min: latestMethodChanges size) do: [:index | | spec method | spec := latestMethodChanges at: index. method := spec second. menu addItem: [:item | item contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ; target: ToolSet; balloonText: spec third asString; icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]); arguments: {method}]]. latestClassChanges := (Array streamContents: [:s | ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category | "We are not interested in classes whose method's did only change." changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]]) sorted: [:a :b | a first >= b first]. latestClassChanges ifNotEmpty: [menu addLine]. 1 to: (10 min: latestClassChanges size) do: [:index | | spec class | spec := latestClassChanges at: index. class := spec second. menu addItem: [:item | item contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ; target: ToolSet; balloonText: (spec third sorted joinSeparatedBy: Character space); icon: ((spec third includesAnyOf: #(remove addedThenRemoved)) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ (spec third includes: #add) ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]); arguments: {class}]]. + + menu defaultTarget: self. + menu addTranslatedList: #( + - + ('Browse current change set' browseChangeSet) + ('Browse changed methods' browseChangedMethods) + - + ('Simple Change Sorter' browseChanges) + ('Dual Change Sorter' browseChangesDual)). + + + ! - - menu addLine; addItem: [:item | - item - contents: 'Browse current change set...' translated; - target: self; - selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Thu May 6 21:10:36 2021 From: m at jaromir.net (Jaromir Matas) Date: Thu, 6 May 2021 16:10:36 -0500 (CDT) Subject: [squeak-dev] The Trunk: Kernel-nice.1399.mcz In-Reply-To: References: Message-ID: <1620335436360-0.post@n4.nabble.com> Hi, changes from this commit by Nicolas disappeared from the Trunk - probably replaced with their original versions by mistake when merging Kernel-jar.1400.mcz thanks for checking, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From Christoph.Thiede at student.hpi.uni-potsdam.de Thu May 6 21:15:31 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Thu, 6 May 2021 21:15:31 +0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1769.mcz In-Reply-To: References: , Message-ID: Well, I actually wanted to prevent a window from automatically applying the color of its first child, which is often a transparent panel morph. Recently we had a student complaining that his window was completely lacking color: ToolBuilder open: (PluggableWindowSpec new children: {PluggablePanelSpec new frame: (LayoutFrame new topFraction: 1; yourself); yourself}; yourself). [cid:aec6fc25-f9d7-4f33-b2f9-cfa2fd4ba205] This is because only Model implements #windowColorToUse. Note that #windowColorToUse, #paneColor, and #defaultColor can still be used to set a translucent color. But I'm not sure whether it is a good idea to derive a transparent color from a child ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:32:24 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1769.mcz > Avoid translucent color. Why? I did cut out the drop shadow. Translucent windows colors look so cool! :-D [cid:ef11b7be-3360-426c-81a3-b06a1b7d5df7] Am 01.05.2021 14:12:32 schrieb commits at source.squeak.org : A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1769.mcz ==================== Summary ==================== Name: Morphic-ct.1769 Author: ct Time: 1 May 2021, 2:12:17.510389 pm UUID: aa271c07-344a-324a-afe4-3950d6c00839 Ancestors: Morphic-mt.1767 Make SystemWindow's paneColor more robust against missing models. Avoid translucent color. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: SystemWindow>>paneColor (in category 'colors') ----- paneColor | cc | (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc]. (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse]. + cc ifNil: [cc := paneMorphs + detect: [:morph | morph color isTransparent not] + ifFound: [:morph | morph color asNontranslucentColor] + ifNone: [nil]]. - cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]. cc ifNil: [cc := self defaultColor]. self paneColor: cc. ^cc! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57317 bytes Desc: image.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 15764 bytes Desc: pastedImage.png URL: From commits at source.squeak.org Thu May 6 21:24:28 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 21:24:28 0000 Subject: [squeak-dev] The Trunk: Kernel-nice.1401.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1401.mcz ==================== Summary ==================== Name: Kernel-nice.1401 Author: nice Time: 6 May 2021, 11:24:25.403176 pm UUID: 2fbbe628-b187-4e75-ab6f-a6d16df14ce7 Ancestors: Kernel-jar.1400, Kernel-nice.1399 Merge exception handling fixes Kernel-jar.1400, Kernel-nice.1399 =============== Diff against Kernel-jar.1400 =============== Item was changed: ----- Method: Context>>resumeEvaluating: (in category 'controlling') ----- resumeEvaluating: aBlock "Unwind thisContext to self and resume with value as result of last send. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: aBlock value to: self]. ctxt := thisContext. [ ctxt := ctxt findNextUnwindContextUpTo: self. ctxt isNil ] whileFalse: [ (ctxt tempAt: 2) ifNil:[ + "(tempAt: 2) refers to complete temporary in ensure: and ifCurtailed: + or any other method marked with " ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: self. ^ aBlock value ! Item was changed: ----- Method: Exception>>resignalAs: (in category 'handling') ----- resignalAs: replacementException + "Signal an alternative exception in place of the receiver. + Unwind to signalContext before signalling the replacement exception" - "Signal an alternative exception in place of the receiver." + signalContext resumeEvaluating: [replacementException signal]! - self resumeEvaluating: [replacementException signal]! Item was changed: ----- Method: Exception>>resumeEvaluating: (in category 'handling') ----- resumeEvaluating: aBlock "Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer. The block is only evaluated after unwinding the stack." | ctxt | outerContext ifNil: [ signalContext returnEvaluating: aBlock ] ifNotNil: [ ctxt := outerContext. outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" + handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" ctxt returnEvaluating: aBlock ]. ! Item was changed: ----- Method: Exception>>resumeUnchecked: (in category 'handling') ----- resumeUnchecked: resumptionValue "Return resumptionValue as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer." + ^self resumeEvaluating: [resumptionValue]! - | ctxt | - outerContext ifNil: [ - signalContext return: resumptionValue - ] ifNotNil: [ - ctxt := outerContext. - outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" - handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" - ctxt return: resumptionValue - ]. - ! From commits at source.squeak.org Thu May 6 21:40:30 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 6 May 2021 21:40:30 0000 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz Message-ID: A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1054.mcz ==================== Summary ==================== Name: Tools-ct.1054 Author: ct Time: 6 May 2021, 11:40:27.54561 pm UUID: edc189dc-7bb9-974a-9aa3-4760e7e67239 Ancestors: Tools-mt.1053 Proposal: Adds a new preference #acceptWithPrettyPrint that, if enabled, automatically pretty-prints every message before accepting it in a code holder. When used together with the preferences #browseWithPrettyPrint (and maybe also #diffsWithPrettyPrint), given a good pretty-printer such as PoppyPrint, this has the potential to make your journey through Squeak even prettier. :-) =============== Diff against Tools-mt.1053 =============== Item was changed: ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | selectedMessageName selector category oldMessageList selectedClassOrMetaClass | selectedMessageName := self selectedMessageName. oldMessageList := self messageList. selectedClassOrMetaClass := self selectedClassOrMetaClass. contents := nil. selector := (selectedClassOrMetaClass newParser parseSelector: aString). (self metaClassIndicated and: [(selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. category := selectedMessageName ifNil: [ self selectedMessageCategoryName ] ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. + selector := self + basicCompile: aString + in: selectedClassOrMetaClass + classified: category + notifying: aController. - selector := selectedClassOrMetaClass - compile: aString - classified: category - notifying: aController. selector == nil ifTrue: [^ nil]. contents := aString copy. self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." selector ~~ selectedMessageName ifTrue: [category = ClassOrganizer nullCategory ifTrue: [self changed: #classSelectionChanged. self changed: #classList. self messageCategoryListIndex: 1]. self setClassOrganizer. "In case organization not cached" (oldMessageList includes: selector) ifFalse: [self changed: #messageList]. self messageListIndex: (self messageList indexOf: selector)]. ^ selector! Item was added: + ----- Method: CodeHolder>>basicCompile:in:classified:notifying: (in category 'code pane') ----- + basicCompile: aString in: aClassOrMetaClass classified: category notifying: requestor + + | source | + source := SystemBrowser acceptWithPrettyPrint + ifTrue: [aClassOrMetaClass prettyPrinterClass + format: aString in: aClassOrMetaClass notifying: requestor] + ifFalse: [aString]. + ^ aClassOrMetaClass + compile: source + classified: category + notifying: requestor! Item was changed: ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code pane') ----- compileMessage: aString notifying: aController "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." | selectedMessageName selector category selectedClassOrMetaClass | selectedMessageName := self selectedMessageName. selectedClassOrMetaClass := self selectedClassOrMetaClass. contents := nil. selector := (selectedClassOrMetaClass newParser parseSelector: aString). (self metaClassIndicated and: [(selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. category := self selectedMessageCategoryName. + selector := self + basicCompile: aString + in: selectedClassOrMetaClass + classified: category + notifying: aController. - selector := selectedClassOrMetaClass - compile: aString - classified: category - notifying: aController. selector == nil ifTrue: [^ nil]. contents := aString copy. currentCompiledMethod := selectedClassOrMetaClass compiledMethodAt: selector. ^ true! Item was changed: ----- Method: DependencyBrowser>>defineMessageFrom:notifying: (in category 'contents') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | selectedMessageName selector category oldMessageList | selectedMessageName := self selectedMessageName. oldMessageList := self messageList. contents := nil. selector := (self selectedClassOrMetaClass newParser parseSelector: aString). + selector := self + basicCompile: aString + in: self selectedClassOrMetaClass + classified: (category := self selectedMessageCategoryName) + notifying: aController. - selector := self selectedClassOrMetaClass - compile: aString - classified: (category := self selectedMessageCategoryName) - notifying: aController. selector == nil ifTrue: [^ false]. contents := aString copy. ^ true ! Item was changed: AppRegistry subclass: #SystemBrowser instanceVariableNames: '' + classVariableNames: 'AcceptWithPrettyPrint BrowseWithDragNDrop BrowseWithPrettyPrint' - classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' poolDictionaries: '' category: 'Tools-Base'! !SystemBrowser commentStamp: '' prior: 0! This is the AppRegistry class for class browsing! Item was added: + ----- Method: SystemBrowser class>>acceptWithPrettyPrint (in category 'preferences') ----- + acceptWithPrettyPrint + + ^ AcceptWithPrettyPrint ifNil: [false].! Item was added: + ----- Method: SystemBrowser class>>acceptWithPrettyPrint: (in category 'preferences') ----- + acceptWithPrettyPrint: aBoolean + AcceptWithPrettyPrint := aBoolean.! From nicolas.cellier.aka.nice at gmail.com Thu May 6 21:59:31 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Thu, 6 May 2021 23:59:31 +0200 Subject: [squeak-dev] The Trunk: Kernel-nice.1399.mcz In-Reply-To: <1620335436360-0.post@n4.nabble.com> References: <1620335436360-0.post@n4.nabble.com> Message-ID: Hi Jaromir, that's right, merged. Le jeu. 6 mai 2021 à 23:10, Jaromir Matas a écrit : > > Hi, > > changes from this commit by Nicolas disappeared from the Trunk - probably > replaced with their original versions by mistake when merging > Kernel-jar.1400.mcz > thanks for checking, > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From asqueaker at gmail.com Thu May 6 22:36:40 2021 From: asqueaker at gmail.com (Chris Muller) Date: Thu, 6 May 2021 17:36:40 -0500 Subject: [squeak-dev] how to determine available RAM? Message-ID: I have an old method from 2014 which could calculate the maximum *addressable* RAM for 32-bit images. First it checked for the -memory or -mmap arguments (are these still supported?) and used them if specified, otherwise, it default to these hard-coded numbers: isRunningSpur? -> 3.8GB else Win32? -> 500MB else -> 1GB But now with 64-bit, the addressable exceeds the available RAM of most machines. What is that max addressable BTW, 64GB? Also, what about taking into account what the OS believes it has *remaining*? Can it be done within the image or would I have to call out to "free" via OSProcess or something..? Thanks for any tips. - Chris From asqueaker at gmail.com Thu May 6 23:01:26 2021 From: asqueaker at gmail.com (Chris Muller) Date: Thu, 6 May 2021 18:01:26 -0500 Subject: [squeak-dev] The Trunk: Tools-mt.1029.mcz In-Reply-To: References: <,CANzdToEv5PXU26vJDY3PgBa+cNuSLsMMsW7AN4jQynpd2QffNA@mail.gmail.com> Message-ID: Hi Marcel, I know you already got it loaded, but thanks for the heads-up about "Compiler". I have my own version of "Compiler" which simply changes the formatting to Kent Beck style and nothing else. I need to move all my Squeak mods which I keep in 'squeak' down into "MyInstaller" instead of MaInstaller. Thanks. On Thu, Apr 29, 2021 at 2:35 AM Marcel Taeumel wrote: > > Hi Chris, > > I wanted to check Maui but its latest version does not load in Squeak Trunk because its installer scripts depend on some local magma-index SqueakSource server. > > More specifically, it wants to load "Compiler" from #local->'squeak', which ends up in Installer class >> #defaultLocalRepository, which answers just a local file-based repository on "mc/squeak" ... which does not exist ony my machine. :-) > > What is the expected setup here? Is there a fall-back? Why not just load the code from source.squeak.org/trunk? > > Best, > Marcel > > Am 29.04.2021 07:01:47 schrieb Taeumel, Marcel : > > Hi Chris, > > for custom projects such as Maui, you should change the world's drop handler to fit your needs. It is very easy and avoids any conflict. Of course you can replicate some of the standard features if you want. For example, I did this for Vivide to open custom tools. > > See PasteUpMorph >> #transferMorphConverter: > > Just call it with a selector when Maui starts. > > Best, > Marcel > ________________________________ > From: Squeak-dev on behalf of Chris Muller > Sent: Wednesday, April 28, 2021 9:03:34 PM > To: The general-purpose Squeak developers list > Subject: Re: [squeak-dev] The Trunk: Tools-mt.1029.mcz > > If I understand this correctly, it'll probably conflict with Maui's > equivalent gesture, and only for the equivalent of dragging a splitter > bar all the way up to the top..? (really, is it just substituting > that one DnD operation for another?) Except it opens a new window, > too (which I'll have to later close?). Maybe I'm missing something, > but it seems heavy and laborious for only what it does. Hopefully the > hook can be customized.. > > > On Thu, Mar 4, 2021 at 8:47 AM Marcel Taeumel wrote: > > > > Here is an example: > > > > > > Am 04.03.2021 15:38:47 schrieb commits at source.squeak.org : > > > > Marcel Taeumel uploaded a new version of Tools to project The Trunk: > > http://source.squeak.org/trunk/Tools-mt.1029.mcz > > > > ==================== Summary ==================== > > > > Name: Tools-mt.1029 > > Author: mt > > Time: 4 March 2021, 3:38:36.350661 pm > > UUID: bef0c471-6ff1-774d-860e-8958e1aa508b > > Ancestors: Tools-mt.1028 > > > > Enable source-code dragging through a browser's message list to be dropped into the world to open a compact code editor. > > > > Complements Tools-mt.1028, ToolBuilder-Kernel-mt.139, ToolBuilder-Morphic-mt.274, and Morphic-mt.1733. > > > > =============== Diff against Tools-mt.1028 =============== > > > > Item was changed: > > ----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') ----- > > buildMessageListWith: builder > > | listSpec | > > listSpec := builder pluggableListSpec new. > > listSpec > > model: self; > > list: #messageList; > > getIndex: #messageListIndex; > > setIndex: #messageListIndex:; > > icon: #messageIconAt:; > > helpItem: #messageHelpAt:; > > menu: #messageListMenu:shifted:; > > keyPress: #messageListKey:from:. > > + SystemBrowser browseWithDragNDrop ifTrue: [ > > + listSpec > > + dragItem: #dragFromMessageList:; > > + dragType: #dragTypeForMessageListAt:]. > > - SystemBrowser browseWithDragNDrop > > - ifTrue:[listSpec dragItem: #dragFromMessageList:]. > > ^listSpec > > ! > > > > Item was added: > > + ----- Method: Browser>>dragTypeForMessageListAt: (in category 'drag and drop') ----- > > + dragTypeForMessageListAt: index > > + > > + ^ #sourceCode! > > > > > > > > From tim at rowledge.org Thu May 6 23:33:55 2021 From: tim at rowledge.org (tim Rowledge) Date: Thu, 6 May 2021 16:33:55 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: References: Message-ID: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> I was just about to say something about Chris'question and tried 2 raisedTo: 63 in a Workspace. I was a little surprised to see '0' returned. On my Mac 64 I get the right answer. On the Pi I get the right(ish) answer if I substitute 2.0. To make things weirder if I debug, the end value of 'result' in Number>>#raisedToInteger: is correct. The value of 'stack top' in its sender #raisedTo: is the same correct value. Gronk? It's clearly not a problem with printing the value since I see the correct value. If I try (2 raisedTo: 63) / 64.0 to check what number is actually there... I get 0. Implying there is really 0. Debug it and.. yup 0. What? It looks like somewhere the LPI instance is getting mishandled but where? tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: CSD: Charge Surreptitiously to DOE From asqueaker at gmail.com Fri May 7 00:01:57 2021 From: asqueaker at gmail.com (Chris Muller) Date: Thu, 6 May 2021 19:01:57 -0500 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> Message-ID: Hi Marcel, > Hmm... it is unusual that a normal click can also select a range. Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet, and "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. In Squeak it's called PluggableListMorphOfMany (used by changes browser) and it's [Alternate] incantation which doesn't lose selections simply because your framerate is too low.. And, yes, Control was *supposed* to be a modifier key to toggle individuals, but as Jakob pointed out, it's intercepted by the halo. All the functions Tim mentioned are currently available via the menus. - Chris From asqueaker at gmail.com Fri May 7 00:24:10 2021 From: asqueaker at gmail.com (Chris Muller) Date: Thu, 6 May 2021 19:24:10 -0500 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz In-Reply-To: References: Message-ID: -1. The IDE should not break the boundaries of roles between the human and IDE. IOW, it should maintain explicit gesture separation between what the human crafted, and what is stored in the system. If this was really a good idea, why not write a script to simply format all methods in the whole system? (answer: because I'm sure you agree that's a bad idea). Or why not just use #browseWithPrettyPrint? There is already a hot-key for pretty-print (Shift+Cmd+S), so you can obtain the same effect with virtually no extra effort if you want to. On Thu, May 6, 2021 at 4:40 PM wrote: > > A new version of Tools was added to project The Inbox: > http://source.squeak.org/inbox/Tools-ct.1054.mcz > > ==================== Summary ==================== > > Name: Tools-ct.1054 > Author: ct > Time: 6 May 2021, 11:40:27.54561 pm > UUID: edc189dc-7bb9-974a-9aa3-4760e7e67239 > Ancestors: Tools-mt.1053 > > Proposal: Adds a new preference #acceptWithPrettyPrint that, if enabled, automatically pretty-prints every message before accepting it in a code holder. When used together with the preferences #browseWithPrettyPrint (and maybe also #diffsWithPrettyPrint), given a good pretty-printer such as PoppyPrint, this has the potential to make your journey through Squeak even prettier. :-) > > =============== Diff against Tools-mt.1053 =============== > > Item was changed: > ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- > defineMessageFrom: aString notifying: aController > "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." > | selectedMessageName selector category oldMessageList selectedClassOrMetaClass | > selectedMessageName := self selectedMessageName. > oldMessageList := self messageList. > selectedClassOrMetaClass := self selectedClassOrMetaClass. > contents := nil. > selector := (selectedClassOrMetaClass newParser parseSelector: aString). > (self metaClassIndicated > and: [(selectedClassOrMetaClass includesSelector: selector) not > and: [Metaclass isScarySelector: selector]]) > ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" > (self confirm: ((selector , ' is used in the existing class system. > Overriding it could cause serious problems. > Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) > ifFalse: [^nil]]. > category := selectedMessageName > ifNil: [ self selectedMessageCategoryName ] > ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. > + selector := self > + basicCompile: aString > + in: selectedClassOrMetaClass > + classified: category > + notifying: aController. > - selector := selectedClassOrMetaClass > - compile: aString > - classified: category > - notifying: aController. > selector == nil ifTrue: [^ nil]. > contents := aString copy. > > self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." > self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." > > selector ~~ selectedMessageName > ifTrue: > [category = ClassOrganizer nullCategory > ifTrue: [self changed: #classSelectionChanged. > self changed: #classList. > self messageCategoryListIndex: 1]. > self setClassOrganizer. "In case organization not cached" > (oldMessageList includes: selector) > ifFalse: [self changed: #messageList]. > self messageListIndex: (self messageList indexOf: selector)]. > ^ selector! > > Item was added: > + ----- Method: CodeHolder>>basicCompile:in:classified:notifying: (in category 'code pane') ----- > + basicCompile: aString in: aClassOrMetaClass classified: category notifying: requestor > + > + | source | > + source := SystemBrowser acceptWithPrettyPrint > + ifTrue: [aClassOrMetaClass prettyPrinterClass > + format: aString in: aClassOrMetaClass notifying: requestor] > + ifFalse: [aString]. > + ^ aClassOrMetaClass > + compile: source > + classified: category > + notifying: requestor! > > Item was changed: > ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code pane') ----- > compileMessage: aString notifying: aController > "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." > > | selectedMessageName selector category selectedClassOrMetaClass | > selectedMessageName := self selectedMessageName. > selectedClassOrMetaClass := self selectedClassOrMetaClass. > contents := nil. > selector := (selectedClassOrMetaClass newParser parseSelector: aString). > (self metaClassIndicated > and: [(selectedClassOrMetaClass includesSelector: selector) not > and: [Metaclass isScarySelector: selector]]) > ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" > (self confirm: ((selector , ' is used in the existing class system. > Overriding it could cause serious problems. > Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) > ifFalse: [^nil]]. > category := self selectedMessageCategoryName. > + selector := self > + basicCompile: aString > + in: selectedClassOrMetaClass > + classified: category > + notifying: aController. > - selector := selectedClassOrMetaClass > - compile: aString > - classified: category > - notifying: aController. > selector == nil ifTrue: [^ nil]. > contents := aString copy. > currentCompiledMethod := selectedClassOrMetaClass compiledMethodAt: selector. > ^ true! > > Item was changed: > ----- Method: DependencyBrowser>>defineMessageFrom:notifying: (in category 'contents') ----- > defineMessageFrom: aString notifying: aController > "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." > | selectedMessageName selector category oldMessageList | > selectedMessageName := self selectedMessageName. > oldMessageList := self messageList. > contents := nil. > selector := (self selectedClassOrMetaClass newParser parseSelector: aString). > + selector := self > + basicCompile: aString > + in: self selectedClassOrMetaClass > + classified: (category := self selectedMessageCategoryName) > + notifying: aController. > - selector := self selectedClassOrMetaClass > - compile: aString > - classified: (category := self selectedMessageCategoryName) > - notifying: aController. > selector == nil ifTrue: [^ false]. > contents := aString copy. > ^ true > ! > > Item was changed: > AppRegistry subclass: #SystemBrowser > instanceVariableNames: '' > + classVariableNames: 'AcceptWithPrettyPrint BrowseWithDragNDrop BrowseWithPrettyPrint' > - classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' > poolDictionaries: '' > category: 'Tools-Base'! > > !SystemBrowser commentStamp: '' prior: 0! > This is the AppRegistry class for class browsing! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint (in category 'preferences') ----- > + acceptWithPrettyPrint > + > + ^ AcceptWithPrettyPrint ifNil: [false].! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint: (in category 'preferences') ----- > + acceptWithPrettyPrint: aBoolean > + AcceptWithPrettyPrint := aBoolean.! > > From tomjonabc at gmail.com Fri May 7 05:35:02 2021 From: tomjonabc at gmail.com (Tom Beckmann) Date: Fri, 7 May 2021 07:35:02 +0200 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz In-Reply-To: References: Message-ID: Hi Chris, speaking from experience with an extension like this: I started out with a script that reformatted all methods in my package (it was a good idea) and moved on to using something like this proposed extension. For further context, I have gotten used to and comfortable with the idea that formatting is just busy work in 95% of cases that I'd like to spend on something productive rather than moving whitespace. Undoubtedly, using a pretty printer on most trunk code is infeasible, as each method/class/package currently follows different intricacies of secondary notation. Additionally, there are of course some "special" (from the POV of our pretty printer) formatting choices that authors deliberately chose to make a point about the code. This type of secondary notation, where it's actually valuable, is I think quite common in trunk code, but exceedingly uncommon in code I produce in the daily business. I don't think anyone currently even considers applying a pretty printer against all trunk code, for various reasons. Since it's a preference I would give the proposed change a +1. It supports a valuable workflow that I believe is slowly becoming feasible in Squeak. The Ctrl+Shift+S shortcut could even be inverted when the preference is active so that you can keep formatting idiosyncrasies where it's appropriate. It may be important to note that we are working on having a pretty printer understand common Smalltalk idioms and format those accordingly. We are also planning to try and maintain deliberate choices, such as empty lines, strides in array formatting, or comment positions. If you've never tried programming in an ecosystem where there's a well-accepted standard for code style that can be automatically applied, I'd recommend you give it a shot. At least for me, it allowed performing changes more directly (no tedious cleanup each time I want to look at an intermediate or final state of a change) and saved a good chunk of brain power that I could invest elsewhere :) Best, Tom On Fri, May 7, 2021, 02:25 Chris Muller wrote: > -1. The IDE should not break the boundaries of roles between the > human and IDE. IOW, it should maintain explicit gesture separation > between what the human crafted, and what is stored in the system. If > this was really a good idea, why not write a script to simply format > all methods in the whole system? (answer: because I'm sure you agree > that's a bad idea). Or why not just use #browseWithPrettyPrint? > > There is already a hot-key for pretty-print (Shift+Cmd+S), so you can > obtain the same effect with virtually no extra effort if you want to. > > > > > On Thu, May 6, 2021 at 4:40 PM wrote: > > > > A new version of Tools was added to project The Inbox: > > http://source.squeak.org/inbox/Tools-ct.1054.mcz > > > > ==================== Summary ==================== > > > > Name: Tools-ct.1054 > > Author: ct > > Time: 6 May 2021, 11:40:27.54561 pm > > UUID: edc189dc-7bb9-974a-9aa3-4760e7e67239 > > Ancestors: Tools-mt.1053 > > > > Proposal: Adds a new preference #acceptWithPrettyPrint that, if enabled, > automatically pretty-prints every message before accepting it in a code > holder. When used together with the preferences #browseWithPrettyPrint (and > maybe also #diffsWithPrettyPrint), given a good pretty-printer such as > PoppyPrint, this has the potential to make your journey through Squeak even > prettier. :-) > > > > =============== Diff against Tools-mt.1053 =============== > > > > Item was changed: > > ----- Method: Browser>>defineMessageFrom:notifying: (in category > 'message functions') ----- > > defineMessageFrom: aString notifying: aController > > "Compile the expressions in aString. Notify aController if a > syntax error occurs. Install the compiled method in the selected class > classified under the currently selected message category name. Answer the > selector obtained if compilation succeeds, nil otherwise." > > | selectedMessageName selector category oldMessageList > selectedClassOrMetaClass | > > selectedMessageName := self selectedMessageName. > > oldMessageList := self messageList. > > selectedClassOrMetaClass := self selectedClassOrMetaClass. > > contents := nil. > > selector := (selectedClassOrMetaClass newParser parseSelector: > aString). > > (self metaClassIndicated > > and: [(selectedClassOrMetaClass includesSelector: > selector) not > > and: [Metaclass isScarySelector: selector]]) > > ifTrue: ["A frist-time definition overlaps the protocol > of Metaclasses" > > (self confirm: ((selector , ' is used in > the existing class system. > > Overriding it could cause serious problems. > > Is this really what you want to do?') asText makeBoldFrom: 1 to: > selector size)) > > ifFalse: [^nil]]. > > category := selectedMessageName > > ifNil: [ self selectedMessageCategoryName ] > > ifNotNil: [ (selectedClassOrMetaClass >> > selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. > > + selector := self > > + basicCompile: aString > > + in: selectedClassOrMetaClass > > + classified: category > > + notifying: aController. > > - selector := selectedClassOrMetaClass > > - compile: aString > > - classified: category > > - notifying: aController. > > selector == nil ifTrue: [^ nil]. > > contents := aString copy. > > > > self changed: #messageCategoryList. "Because the 'as yet > unclassified' might just appear." > > self changed: #messageList. "Because we have code-dependent list > formatting by now such as #isDeprecated." > > > > selector ~~ selectedMessageName > > ifTrue: > > [category = ClassOrganizer nullCategory > > ifTrue: [self changed: > #classSelectionChanged. > > self changed: #classList. > > self > messageCategoryListIndex: 1]. > > self setClassOrganizer. "In case organization > not cached" > > (oldMessageList includes: selector) > > ifFalse: [self changed: #messageList]. > > self messageListIndex: (self messageList > indexOf: selector)]. > > ^ selector! > > > > Item was added: > > + ----- Method: CodeHolder>>basicCompile:in:classified:notifying: (in > category 'code pane') ----- > > + basicCompile: aString in: aClassOrMetaClass classified: category > notifying: requestor > > + > > + | source | > > + source := SystemBrowser acceptWithPrettyPrint > > + ifTrue: [aClassOrMetaClass prettyPrinterClass > > + format: aString in: aClassOrMetaClass notifying: > requestor] > > + ifFalse: [aString]. > > + ^ aClassOrMetaClass > > + compile: source > > + classified: category > > + notifying: requestor! > > > > Item was changed: > > ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code > pane') ----- > > compileMessage: aString notifying: aController > > "Compile the code that was accepted by the user, placing the > compiled method into an appropriate message category. Return true if the > compilation succeeded, else false." > > > > | selectedMessageName selector category selectedClassOrMetaClass > | > > selectedMessageName := self selectedMessageName. > > selectedClassOrMetaClass := self selectedClassOrMetaClass. > > contents := nil. > > selector := (selectedClassOrMetaClass newParser parseSelector: > aString). > > (self metaClassIndicated > > and: [(selectedClassOrMetaClass includesSelector: > selector) not > > and: [Metaclass isScarySelector: selector]]) > > ifTrue: ["A frist-time definition overlaps the protocol > of Metaclasses" > > (self confirm: ((selector , ' is used in > the existing class system. > > Overriding it could cause serious problems. > > Is this really what you want to do?') asText makeBoldFrom: 1 to: > selector size)) > > ifFalse: [^nil]]. > > category := self selectedMessageCategoryName. > > + selector := self > > + basicCompile: aString > > + in: selectedClassOrMetaClass > > + classified: category > > + notifying: aController. > > - selector := selectedClassOrMetaClass > > - compile: aString > > - classified: category > > - notifying: aController. > > selector == nil ifTrue: [^ nil]. > > contents := aString copy. > > currentCompiledMethod := selectedClassOrMetaClass > compiledMethodAt: selector. > > ^ true! > > > > Item was changed: > > ----- Method: DependencyBrowser>>defineMessageFrom:notifying: (in > category 'contents') ----- > > defineMessageFrom: aString notifying: aController > > "Compile the expressions in aString. Notify aController if a > syntax error occurs. Install the compiled method in the selected class > classified under the currently selected message category name. Answer the > selector obtained if compilation succeeds, nil otherwise." > > | selectedMessageName selector category oldMessageList | > > selectedMessageName := self selectedMessageName. > > oldMessageList := self messageList. > > contents := nil. > > selector := (self selectedClassOrMetaClass newParser > parseSelector: aString). > > + selector := self > > + basicCompile: aString > > + in: self selectedClassOrMetaClass > > + classified: (category := self > selectedMessageCategoryName) > > + notifying: aController. > > - selector := self selectedClassOrMetaClass > > - compile: aString > > - classified: (category := self > selectedMessageCategoryName) > > - notifying: aController. > > selector == nil ifTrue: [^ false]. > > contents := aString copy. > > ^ true > > ! > > > > Item was changed: > > AppRegistry subclass: #SystemBrowser > > instanceVariableNames: '' > > + classVariableNames: 'AcceptWithPrettyPrint BrowseWithDragNDrop > BrowseWithPrettyPrint' > > - classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' > > poolDictionaries: '' > > category: 'Tools-Base'! > > > > !SystemBrowser commentStamp: '' prior: 0! > > This is the AppRegistry class for class browsing! > > > > Item was added: > > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint (in category > 'preferences') ----- > > + acceptWithPrettyPrint > > + description: 'If true, browsers will automatically pretty-print every > method when you accept it.' type: #Boolean> > > + ^ AcceptWithPrettyPrint ifNil: [false].! > > > > Item was added: > > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint: (in category > 'preferences') ----- > > + acceptWithPrettyPrint: aBoolean > > + AcceptWithPrettyPrint := aBoolean.! > > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Fri May 7 05:47:30 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Fri, 7 May 2021 07:47:30 +0200 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz In-Reply-To: References: Message-ID: Hi all -- Since the preference is disabled by default (and I would want to make that explicit in the ReleaseBuilder, too), I think this might improve some folks' programming experience. Well, I don't think this preference/proposal would have a huge impact because: 1. Squeak's pretty printer is rather limited to support project/user-specific styles (or accuracy to preserve those implicit rules). 2. There is already a way to pretty print your code selection via SHIFT+CMD+S easily. 3. If any project would even want to enforce such formatting -- Squeak Trunk should not do that -- it should be scoped per repository and rather be done at commit time (or code-review time). Not a global setting. If people are too scared that such a preference would open a "pandora's box", I would like to make sure that we make our intentions for Squeak Trunk/Inbox/Treated as explicit as possible to preserve the programmer's creative freedom. -1 for now =) Best, Marcel Am 07.05.2021 07:35:27 schrieb Tom Beckmann : Hi Chris, speaking from experience with an extension like this: I started out with a script that reformatted all methods in my package (it was a good idea) and moved on to using something like this proposed extension. For further context, I have gotten used to and comfortable with the idea that formatting is just busy work in 95% of cases that I'd like to spend on something productive rather than moving whitespace. Undoubtedly, using a pretty printer on most trunk code is infeasible, as each method/class/package currently follows different intricacies of secondary notation. Additionally, there are of course some "special" (from the POV of our pretty printer) formatting choices that authors deliberately chose to make a point about the code. This type of secondary notation, where it's actually valuable, is I think quite common in trunk code, but exceedingly uncommon in code I produce in the daily business. I don't think anyone currently even considers applying a pretty printer against all trunk code, for various reasons. Since it's a preference I would give the proposed change a +1. It supports a valuable workflow that I believe is slowly becoming feasible in Squeak. The Ctrl+Shift+S shortcut could even be inverted when the preference is active so that you can keep formatting idiosyncrasies where it's appropriate. It may be important to note that we are working on having a pretty printer understand common Smalltalk idioms and format those accordingly. We are also planning to try and maintain deliberate choices, such as empty lines, strides in array formatting, or comment positions. If you've never tried programming in an ecosystem where there's a well-accepted standard for code style that can be automatically applied, I'd recommend you give it a shot. At least for me, it allowed performing changes more directly (no tedious cleanup each time I want to look at an intermediate or final state of a change) and saved a good chunk of brain power that I could invest elsewhere :)  Best, Tom On Fri, May 7, 2021, 02:25 Chris Muller wrote: -1.  The IDE should not break the boundaries of roles between the human and IDE.  IOW, it should maintain explicit gesture separation between what the human crafted, and what is stored in the system.  If this was really a good idea, why not write a script to simply format all methods in the whole system? (answer: because I'm sure you agree that's a bad idea).  Or why not just use #browseWithPrettyPrint? There is already a hot-key for pretty-print (Shift+Cmd+S), so you can obtain the same effect with virtually no extra effort if you want to. On Thu, May 6, 2021 at 4:40 PM wrote: > > A new version of Tools was added to project The Inbox: > http://source.squeak.org/inbox/Tools-ct.1054.mcz [http://source.squeak.org/inbox/Tools-ct.1054.mcz] > > ==================== Summary ==================== > > Name: Tools-ct.1054 > Author: ct > Time: 6 May 2021, 11:40:27.54561 pm > UUID: edc189dc-7bb9-974a-9aa3-4760e7e67239 > Ancestors: Tools-mt.1053 > > Proposal: Adds a new preference #acceptWithPrettyPrint that, if enabled, automatically pretty-prints every message before accepting it in a code holder. When used together with the preferences #browseWithPrettyPrint (and maybe also #diffsWithPrettyPrint), given a good pretty-printer such as PoppyPrint, this has the potential to make your journey through Squeak even prettier. :-) > > =============== Diff against Tools-mt.1053 =============== > > Item was changed: >   ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- >   defineMessageFrom: aString notifying: aController >         "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." >         | selectedMessageName selector category oldMessageList selectedClassOrMetaClass | >         selectedMessageName := self selectedMessageName. >         oldMessageList := self messageList. >         selectedClassOrMetaClass := self selectedClassOrMetaClass. >         contents := nil. >         selector := (selectedClassOrMetaClass newParser parseSelector: aString). >         (self metaClassIndicated >                 and: [(selectedClassOrMetaClass includesSelector: selector) not >                 and: [Metaclass isScarySelector: selector]]) >                 ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" >                                 (self confirm: ((selector , ' is used in the existing class system. >   Overriding it could cause serious problems. >   Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) >                                 ifFalse: [^nil]]. >         category := selectedMessageName >                 ifNil: [ self selectedMessageCategoryName ] >                 ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. > +       selector := self > +               basicCompile: aString > +               in: selectedClassOrMetaClass > +               classified: category > +               notifying: aController. > -       selector := selectedClassOrMetaClass > -                               compile: aString > -                               classified: category > -                               notifying: aController. >         selector == nil ifTrue: [^ nil]. >         contents := aString copy. > >         self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." >         self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." > >         selector ~~ selectedMessageName >                 ifTrue: >                         [category = ClassOrganizer nullCategory >                                 ifTrue: [self changed: #classSelectionChanged. >                                                 self changed: #classList. >                                                 self messageCategoryListIndex: 1]. >                         self setClassOrganizer.  "In case organization not cached" >                         (oldMessageList includes: selector) >                                 ifFalse: [self changed: #messageList]. >                         self messageListIndex: (self messageList indexOf: selector)]. >         ^ selector! > > Item was added: > + ----- Method: CodeHolder>>basicCompile:in:classified:notifying: (in category 'code pane') ----- > + basicCompile: aString in: aClassOrMetaClass classified: category notifying: requestor > + > +       | source | > +       source := SystemBrowser acceptWithPrettyPrint > +               ifTrue: [aClassOrMetaClass prettyPrinterClass > +                       format: aString in: aClassOrMetaClass notifying: requestor] > +               ifFalse: [aString]. > +       ^ aClassOrMetaClass > +               compile: source > +               classified: category > +               notifying: requestor! > > Item was changed: >   ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code pane') ----- >   compileMessage: aString notifying: aController >         "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false." > >         | selectedMessageName selector category selectedClassOrMetaClass | >         selectedMessageName := self selectedMessageName. >         selectedClassOrMetaClass := self selectedClassOrMetaClass. >         contents := nil. >         selector := (selectedClassOrMetaClass newParser parseSelector: aString). >         (self metaClassIndicated >                 and: [(selectedClassOrMetaClass includesSelector: selector) not >                 and: [Metaclass isScarySelector: selector]]) >                 ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" >                                 (self confirm: ((selector , ' is used in the existing class system. >   Overriding it could cause serious problems. >   Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) >                                 ifFalse: [^nil]]. >         category := self selectedMessageCategoryName. > +       selector := self > +               basicCompile: aString > +               in: selectedClassOrMetaClass > +               classified: category > +               notifying: aController. > -       selector := selectedClassOrMetaClass > -                               compile: aString > -                               classified: category > -                               notifying: aController. >         selector == nil ifTrue: [^ nil]. >         contents := aString copy. >         currentCompiledMethod := selectedClassOrMetaClass compiledMethodAt: selector. >         ^ true! > > Item was changed: >   ----- Method: DependencyBrowser>>defineMessageFrom:notifying: (in category 'contents') ----- >   defineMessageFrom: aString notifying: aController >         "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." >         | selectedMessageName selector category oldMessageList | >         selectedMessageName := self selectedMessageName. >         oldMessageList := self messageList. >         contents := nil. >         selector := (self selectedClassOrMetaClass newParser parseSelector: aString). > +       selector := self > +               basicCompile: aString > +               in: self selectedClassOrMetaClass > +               classified: (category := self selectedMessageCategoryName) > +               notifying: aController. > -       selector := self selectedClassOrMetaClass > -                               compile: aString > -                               classified: (category := self selectedMessageCategoryName) > -                               notifying: aController. >         selector == nil ifTrue: [^ false]. >         contents := aString copy. >         ^ true >   ! > > Item was changed: >   AppRegistry subclass: #SystemBrowser >         instanceVariableNames: '' > +       classVariableNames: 'AcceptWithPrettyPrint BrowseWithDragNDrop BrowseWithPrettyPrint' > -       classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' >         poolDictionaries: '' >         category: 'Tools-Base'! > >   !SystemBrowser commentStamp: '' prior: 0! >   This is the AppRegistry class for class browsing! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint (in category 'preferences') ----- > + acceptWithPrettyPrint > +        > +       ^ AcceptWithPrettyPrint ifNil: [false].! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint: (in category 'preferences') ----- > + acceptWithPrettyPrint: aBoolean > +       AcceptWithPrettyPrint := aBoolean.! > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Fri May 7 05:51:37 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Fri, 7 May 2021 07:51:37 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> Message-ID: Hi Chris. > Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet Ah, that's right. In the Windows Explorer, there has always been a conflict between click-drag-out gestures and click-drag-select gestures. It is sometimes really hard to intentionally perform one or the other. Many touch interfaces opted for having an extra drag handle nearby. Maybe this could work? Best, Marcel Am 07.05.2021 02:02:44 schrieb Chris Muller : Hi Marcel, > Hmm... it is unusual that a normal click can also select a range. Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet, and "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. In Squeak it's called PluggableListMorphOfMany (used by changes browser) and it's [Alternate] incantation which doesn't lose selections simply because your framerate is too low.. And, yes, Control was *supposed* to be a modifier key to toggle individuals, but as Jakob pointed out, it's intercepted by the halo. All the functions Tim mentioned are currently available via the menus. - Chris -------------- next part -------------- An HTML attachment was scrubbed... URL: From Das.Linux at gmx.de Fri May 7 06:30:30 2021 From: Das.Linux at gmx.de (Tobias Pape) Date: Fri, 7 May 2021 08:30:30 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> Message-ID: Hi > On 7. May 2021, at 07:51, Marcel Taeumel wrote: > > Hi Chris. > > > Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet > > Ah, that's right. In the Windows Explorer, there has always been a conflict between click-drag-out gestures and click-drag-select gestures. It is sometimes really hard to intentionally perform one or the other. Mac makes the distinction based on how long you wait between the click and the drag, at least for text. So if you - have a selection, - click, - wait for around a second, and - then drag, you will drag the selected text around. In all other cases for text, it changes the selection. I just found it is similar for files in the Finder (think explorer), but slightly different. Since files are always in a vertical fashion, _the same as for text_ is true for files as long as you drag _vertically_ I if you click-drag horizontally, it directly drags the file/selection. I think this is a quite good tradeoff there. Best regards -Tobias > > Many touch interfaces opted for having an extra drag handle nearby. Maybe this could work? > > Best, > Marcel >> Am 07.05.2021 02:02:44 schrieb Chris Muller : >> >> Hi Marcel, >> >> > Hmm... it is unusual that a normal click can also select a range. >> >> Hmm, no, I don't think so. Swipe select is very common -- like >> swiping characters in text, or cells of a spreadsheet, and >> "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. >> In Squeak it's called PluggableListMorphOfMany (used by changes >> browser) and it's [Alternate] incantation which doesn't lose >> selections simply because your framerate is too low.. >> >> And, yes, Control was *supposed* to be a modifier key to toggle >> individuals, but as Jakob pointed out, it's intercepted by the halo. >> >> All the functions Tim mentioned are currently available via the menus. >> >> >> - Chris >> > From tonyg at leastfixedpoint.com Fri May 7 08:27:35 2021 From: tonyg at leastfixedpoint.com (Tony Garnock-Jones) Date: Fri, 7 May 2021 10:27:35 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> Message-ID: On 5/7/21 1:33 AM, tim Rowledge wrote: > 2 raisedTo: 63 > in a Workspace. I was a little surprised to see '0' returned. Eek! I don't see this BTW. Here's what I get: 2 raisedTo: 63 "9223372036854775808" Output from uname -a: Linux zip 5.10.0-6-amd64 #1 SMP Debian 5.10.28-1 (2021-04-09) x86_64 GNU/Linux Output from squeak -version: 5.0-202003021730 Tue Mar 3 08:27:37 UTC 2020 clang [Production Spur 64-bit VM] CoInterpreter VMMaker.oscog-nice.2715 uuid: 78e2f556-9829-42fe-963d-e19dfc43c0e9 Mar 3 2020 StackToRegisterMappingCogit VMMaker.oscog-eem.2719 uuid: e40f3e94-3a54-411b-9613-5d19114ea131 Mar 3 2020 VM: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git Date: Mon Mar 2 18:30:55 2020 CommitHash: 6a0bc96 Plugins: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git Linux travis-job-16fcd698-43db-40d8-82c2-9f02c4a1c566 4.15.0-1028-gcp #29~16.04.1-Ubuntu SMP Tue Feb 12 16:31:10 UTC 2019 x86_64 x86_64 x86_64 GNU/Linux plugin path: /opt/Squeak/Squeak6.0alpha-19905-64bit-202003021730-Linux/bin/ [default: /opt/Squeak/Squeak6.0alpha-19905-64bit-202003021730-Linux/bin/] Finally, from "About Squeak" in the image: Image ----- /home/tonyg/src/Squeak/squeak.image Squeak6.0alpha latest update: #20329 Current Change Set: Unnamed Image format 68021 (64 bit) Preferred bytecode set: SistaV1 Virtual Machine --------------- squeak Open Smalltalk Cog[Spur] VM [CoInterpreterPrimitives VMMaker.oscog-nice.2715] Unix built on Mar 3 2020 08:27:09 Compiler: 4.2.1 Compatible Clang 7.0.0 (tags/RELEASE_700/final) platform sources revision VM: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git Date: Mon Mar 2 18:30:55 2020 CommitHash: 6a0bc96 Plugins: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git CoInterpreter VMMaker.oscog-nice.2715 uuid: 78e2f556-9829-42fe-963d-e19dfc43c0e9 Mar 3 2020 StackToRegisterMappingCogit VMMaker.oscog-eem.2719 uuid: e40f3e94-3a54-411b-9613-5d19114ea131 Mar 3 2020 From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 7 08:35:37 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 7 May 2021 08:35:37 +0000 Subject: [squeak-dev] packages@lists.squeakfoundation.org Message-ID: Hi all, short question: What is packages at lists.squeakfoundation.org for and when exactly will it be involved in a discussion on this list? Does it simply receive any announcement about an upload to the Trunk? Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Fri May 7 09:39:03 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 09:39:03 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.139.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.139.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.139 Author: mt Time: 7 May 2021, 11:39:01.650725 am UUID: 1b17c0aa-8b78-9e4c-80fe-614726687a6c Ancestors: FFI-Kernel-mt.138 Clean up NUL-terminated CString processing in ExternalData. Allow clients to do that only explicitely via #fromCString(s) if #allowDetectForUnknownSize preference is enabled. Automatic processing moved over to "FFI-Tools" and even then it remains dangerous. Fixes small glitch in housekeeping for array types (#noticeModificationOf:). Fixes a small regression by ingoring the #doneCompiling call on ExternalData. =============== Diff against FFI-Kernel-mt.138 =============== Item was changed: ExternalStructure subclass: #ExternalData instanceVariableNames: 'type size' + classVariableNames: 'AllowDetectForUnknownSize' - classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0! Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *'). Instance variables: type The external type of the receiver. Always a pointer type. The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed. ! Item was added: + ----- Method: ExternalData class>>allowDetectForUnknownSize (in category 'preferences') ----- + allowDetectForUnknownSize + + ^AllowDetectForUnknownSize ifNil: [true]! Item was added: + ----- Method: ExternalData class>>allowDetectForUnknownSize: (in category 'preferences') ----- + allowDetectForUnknownSize: aBoolean + + AllowDetectForUnknownSize := aBoolean.! Item was added: + ----- Method: ExternalData class>>allowDetectForUnknownSizeDuring: (in category 'preferences') ----- + allowDetectForUnknownSizeDuring: aBlock + + | priorValue | + priorValue := AllowDetectForUnknownSize. + AllowDetectForUnknownSize := true. + aBlock ensure: [AllowDetectForUnknownSize := priorValue].! Item was added: + ----- Method: ExternalData class>>doneCompiling (in category 'class management') ----- + doneCompiling + "Nevermind here."! Item was added: + ----- Method: ExternalData>>detect:ifFound: (in category 'enumerating') ----- + detect: aBlock ifFound: foundBlock + "DANGEROUS for unknown size!!" + + self class allowDetectForUnknownSize + ifFalse: [self sizeCheck]. + + size + ifNotNil: [ + self detect: aBlock ifFound: foundBlock ifNone: nil] + ifNil: [ | index each | + index := 1. + [each := self at: index. + (aBlock value: each) + ifTrue: [^ foundBlock value: each] + ifFalse: [index := index + 1. false]] + whileFalse].! Item was added: + ----- Method: ExternalData>>detect:ifFound:ifNone: (in category 'enumerating') ----- + detect: aBlock ifFound: foundBlock ifNone: exceptionBlock + + self sizeCheck. + self do: [:each | (aBlock value: each) ifTrue: [^ foundBlock value: each]]. + ^ exceptionBlock value! Item was added: + ----- Method: ExternalData>>detect:ifNone: (in category 'enumerating') ----- + detect: aBlock ifNone: exceptionBlock + + ^ self + detect: aBlock + ifFound: [:element | element] + ifNone: exceptionBlock! Item was changed: ----- Method: ExternalData>>fromCString (in category 'converting - support') ----- fromCString + "Read a NUL-terminated string" - "Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18" - | stream index char | self + assert: [self mightBeCString] - assert: [self containerType = ExternalType string] description: 'Wrong content type'. + + ^ String streamContents: [:stream | + self + detect: [:char | + char == Character null ifTrue: [true] ifFalse: [ + stream nextPut: char. + false]] + ifFound: [:char | "finished"]]! - - stream := WriteStream on: String new. - index := 1. - [(char := self at: index) = 0 asCharacter] whileFalse: [ - stream nextPut: char. - index := index + 1]. - ^stream contents! Item was changed: ----- Method: ExternalData>>fromCStrings (in category 'converting - support') ----- + fromCStrings + "Read a list of double-null terminated strings. + + https://devblogs.microsoft.com/oldnewthing/20110511-00/?p=10693 + http://web.archive.org/web/20100103003417/http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx" - fromCStrings - "Assume that the receiver represents a set of C strings and is teerminated by a empty string and convert it to a Smalltalk ordered collection of strings" + self + assert: [self mightBeCString] + description: 'Wrong content type'. + + ^ Array streamContents: [:list | String streamContents: [:element | + | lastChar | + lastChar := nil. + self + detect: [:char | + (lastChar == Character null and: [char == Character null]) + ifTrue: [true] ifFalse: [ + char == Character null + ifTrue: [ + list nextPut: element contents. + element reset] + ifFalse: [ + element nextPut: char]. + lastChar := char. false]] + ifFound: [:char | "finished"]]].! - | stream index char strings str | - type isPointerType ifFalse: [self error: 'External object is not a pointer type.']. - self flag: #bogus. "mt: This format seems to be rather specific to some library. There would normally be pointers to pointers for such a structure. Or does the C standard mention such a format somehow? 'abcd\0efg\0hijklmnopq\0rstuvwxyz\0\0' ??? " - strings := OrderedCollection new. - index := 1. - [ - stream := WriteStream on: String new. - [(char := handle unsignedCharAt: index) = 0 asCharacter] - whileFalse: [ - stream nextPut: char. - index := index + 1 - ]. - str := stream contents. - strings addLast: str. - str size = 0 - ] whileFalse. - ^strings! Item was added: + ----- Method: ExternalData>>mightBeCString (in category 'testing') ----- + mightBeCString + + self + assert: [(ExternalType char asArrayType: 1) asPointerType ~= ExternalType char asPointerType] + description: 'Unexpected reuse of pointer type char* for both atomic type and array type!!'. + + ^ type = ExternalType string "char*"! Item was changed: ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') ----- noticeModificationOf: aClass "A subclass of ExternalStructure has been redefined. Clean out any obsolete references to its type." aClass withAllSubclassesDo: [:cls | | typeName | typeName := cls name. (StructTypes at: typeName ifAbsent: []) ifNotNil: [:type | type newReferentClass: cls. type asPointerType newReferentClass: cls]. ArrayTypes keysAndValuesDo: [:nameSpec :arrayType | + arrayType ifNotNil: [ + nameSpec key = typeName "content type" ifTrue: [ + arrayType newReferentClass: cls. + arrayType asPointerType newReferentClass: cls]]]]! - nameSpec key = typeName "content type" ifTrue: [ - arrayType newReferentClass: cls. - arrayType asPointerType newReferentClass: cls]]]! Item was changed: ----- Method: ExternalType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." - | result | self checkType. self isPointerType ifFalse: [ "Answer atomic value" ^ handle perform: (AtomicSelectors at: self atomicType) with: byteOffset] ifTrue: [ ^ referentClass ifNotNil: [ "Answer structure, union, or type alias" referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] ifNil: [ + "Answer wrapper that points to external data, unknown size (i.e. number of elements)" + ExternalData - "Answer wrapper that points to external data" - result := ExternalData fromHandle: (handle pointerAt: byteOffset length: self byteSize) + type: self ]]! - type: self. - self = ExternalType string - ifTrue: [result fromCString] - ifFalse: [result]]]! Item was changed: ----- Method: ExternalType>>readAlias (in category 'external structure') ----- readAlias self checkType. ^ String streamContents: [:s | self isPointerType ifFalse: [ "this is an aliased atomic, non-pointer type" s nextPutAll: '^handle "', self writeFieldArgName, '"'] ifTrue: [ referentClass ifNotNil: [ "this is an aliased pointer to a structure, union, or type alias" s nextPutAll:'^', referentClass name,' fromHandle: handle asExternalPointer'] ifNil: [ "this is an aliased pointer to external data" + s nextPutAll: '^ ExternalData fromHandle: handle'. - | shouldReadCString | - (shouldReadCString := self = ExternalType string) - ifTrue: [s nextPutAll: '^('] - ifFalse: [s nextPutAll: '^']. - s nextPutAll: 'ExternalData fromHandle: handle'. self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']. s nextPutAll:' type: '. + s nextPutAll: self asPointerType storeString]]]! - shouldReadCString - ifTrue: [s nextPutAll: 'ExternalType string) fromCString'] - ifFalse: [s nextPutAll: self asPointerType storeString]]]]! Item was changed: ----- Method: ExternalType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self checkType. ^ String streamContents: [:s | self isPointerType ifFalse: [ "Atomic value" s nextPutAll:'^handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset] ifTrue: [ - | shouldReadCString | - shouldReadCString := self = ExternalType string. referentClass ifNotNil: [ "Pointer to structure, union, or type alias" s nextPutAll: '^'; print: referentClass; nextPutAll: ' fromHandle: (handle pointerAt: '; print: byteOffset; nextPutAll: ' length: '; print: self byteSize; nextPut: $)] ifNil: [ "Pointer to external data" + s nextPutAll: '^ ExternalData fromHandle: (handle pointerAt: '; - shouldReadCString - ifTrue: [s nextPutAll: '^('] - ifFalse: [s nextPutAll: '^']. - s nextPutAll: 'ExternalData fromHandle: (handle pointerAt: '; print: byteOffset; nextPutAll: ' length: '; print: self byteSize; + nextPutAll: ') type: ExternalType '; + nextPutAll: self atomicTypeName]]].! - nextPutAll: ') type: ExternalType '. - shouldReadCString - ifTrue: - [s nextPutAll: 'string) fromCString'] - ifFalse: - [s nextPutAll: self atomicTypeName; - nextPutAll: ' asPointerType']]]].! Item was changed: ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') ----- writeFieldArgName ^ self isPointerType ifFalse: [ self atomicTypeName caseOf: { ['bool'] -> ['aBoolean']. ['char'] -> ['aCharacter']. ['schar'] -> ['aCharacter']. ['float'] -> ['aFloat']. ['double'] -> ['aFloat']. } otherwise: ['anInteger']] ifTrue: [ referentClass ifNotNil: ['a',referentClass name] + ifNil: ['externalData']]! - ifNil: [ - self = ExternalType string - ifTrue: ['externalCStringData'] - ifFalse: ['externalData']]]! From commits at source.squeak.org Fri May 7 09:54:22 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 09:54:22 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.140.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.140.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.140 Author: mt Time: 7 May 2021, 11:54:20.790725 am UUID: 417350cb-800d-de4a-9554-5e2398442674 Ancestors: FFI-Kernel-mt.139 Refactors and clarifies the current state of container types and content types. Browse all senders of #contentVsContainer to learn about the current trade-offs. Most of them are confined within ExternalData and ExternalArrayType, with two assertions in ExternalType. Here is the current list of senders for #contentVsContainer: ExternalData >> containerType ExternalData >> contentType ExternalData >> externalType ExternalData >> pointerAt: ExternalData >> pointerAt:put: ExternalData >> setSize: ExternalData >> setType: ExternalArrayType >> allocate: ExternalArrayType >> allocateExternal: ExternalArrayType >> contentType ExternalArrayType class >> newTypeForContentType:size: ExternalType >> allocate: ExternalType >> allocateExternal: *** Luckily, I was able to get rid of ExternalStructure >> #byteSize and ExternalType >> #contentType again. :-) The latter being only defined for ExternalArrayType for now. The former can be replaced through "externalType byteSize" ... not sure whether a convenience accessor brings benefit here. *** Note that for multi-dimensional container support we would have to make changes to the compiledSpec's design in types, which would also imply changes in the FFI plugin. My current goal is to clean up what we have now, make an FFI release, and then go on brainstorming with Nicholas and Eliot and all other interested parties about possible next steps to support char** and int[10][20] and what-not. :-) =============== Diff against FFI-Kernel-mt.139 =============== Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self + flag: #contentVsContainer; + assert: [contentType isPointerType not and: [contentType isArrayType not]] + description: 'No support for multi-dimensional containers yet!!'. - assert: [contentType isPointerType not] - description: 'No support for pointers as content type yet!!'. self assert: [numElements > 0] description: 'Empty array types are not supported!!'. self assert: [contentType byteSize > 0] description: 'Invalid byte size!!'. self assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not] description: 'Array type already exists. Use #typeNamed: to access it.'. type := self "ExternalArrayType" basicNew. pointerType := ExternalType basicNew. "1) Regular type" byteSize := numElements * contentType byteSize. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: contentType byteAlignment; setReferentClass: contentType referentClass; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: contentType asPointerType compiledSpec copy; byteAlignment: contentType asPointerType byteAlignment; setReferentClass: contentType asPointerType referentClass. "3) Remember this new array type." ArrayTypes at: contentType typeName -> numElements put: type. ^ type! Item was changed: ----- Method: ExternalArrayType>>allocate: (in category 'external data') ----- allocate: anInteger "No support for n-dimensional containers." + + self flag: #contentVsContainer. self notYetImplemented.! Item was changed: ----- Method: ExternalArrayType>>allocateExternal: (in category 'external data') ----- allocateExternal: anInteger "No support for n-dimensional containers." + + self flag: #contentVsContainer. self notYetImplemented.! Item was changed: ----- Method: ExternalArrayType>>contentType (in category 'external data') ----- + contentType "^ " + "We are an array of things. Our content type is encoded in the compiledSpec's headerWord. The super implementation of #typeName can figure that out." - contentType - "Overwritten because array types have their content type as part of their non-pointer type." + self flag: #contentVsContainer. "mt: For n-dimensional containers, we might have to adapt this." ^ ExternalType typeNamed: super typeName! Item was changed: ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." self checkType. + ^ ExternalData - ^ (ExternalData fromHandle: (handle structAt: byteOffset length: self byteSize) + type: self! - type: self contentType) size: self size; yourself! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self checkType. ^ String streamContents:[:s | + s nextPutAll:'^ ExternalData fromHandle: (handle structAt: '; - s nextPutAll:'^ (ExternalData fromHandle: (handle structAt: '; print: byteOffset; nextPutAll: ' length: '; print: self byteSize; nextPutAll: ') type: '. self contentType isAtomic ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName] ifFalse: [s nextPutAll: self contentType typeName, ' externalType']. + s nextPutAll: ' size: '; print: self size]! - s nextPutAll: ') size: '; print: self size; nextPutAll: '; yourself']! Item was changed: ----- Method: ExternalData class>>fromHandle:type: (in category 'instance creation') ----- + fromHandle: aHandle type: containerType + + ^ self basicNew setHandle: aHandle type: containerType! - fromHandle: aHandle type: aType - "Create a pointer to the given type" - "ExternalData fromHandle: ExternalAddress new type: ExternalType float" - ^self basicNew setHandle: aHandle type: aType! Item was added: + ----- Method: ExternalData class>>fromHandle:type:size: (in category 'instance creation') ----- + fromHandle: aHandle type: contentType size: numElements + + ^ self basicNew setHandle: aHandle type: contentType size: numElements! Item was changed: ----- Method: ExternalData>>byteSize (in category 'accessing') ----- byteSize "Answer how many bytes the receiver manages." self sizeCheck. + ^ self size * self contentType byteSize! - - ^ handle isExternalAddress - ifTrue: [self size * self contentType byteSize] - ifFalse: [ "ByteArray" handle size]! Item was changed: ----- Method: ExternalData>>containerType (in category 'accessing - types') ----- + containerType "^ " + "Answer the current containter type. Note that pointer types with unknown size cannot serve as container type." + + ^ size isNil + ifTrue: [ + self flag: #contentVsContainer. "mt: Maybe we should have an actual type for this kind of container?" + self assert: [type isPointerType]. + #undefined] + ifFalse: [ + self assert: [type asNonPointerType isArrayType]. + type asNonPointerType]! - containerType - - ^ (size isNil or: [type isVoid]) - ifTrue: [type] - ifFalse: [self contentType asArrayType: size]! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- + contentType "^ " + "Answer the content type for the current container type. Handle the special case for pointer types with an unknown number of elements (i.e. #size)." - contentType + | containerType contentType | + containerType := self containerType. + + containerType = #undefined + flag: #contentVsContainer; "mt: Our best guess is the non-pointer type." + assert: [type isPointerType]; + ifTrue: [ + (contentType := type asNonPointerType) isArrayType + flag: #initializationOnly; "mt: We are in the middle of initializing this external data. See #setType and #setSize: to learn more." + ifTrue: [contentType := contentType contentType]] + ifFalse: [ + contentType := containerType contentType]. + + ^ contentType! - ^ type contentType! Item was changed: ----- Method: ExternalData>>externalType (in category 'accessing - types') ----- + externalType "^ " + "Overwritten to answer our #containerType, which is important so that clients can then send #byteSize to the result." + + | result | + ^ (result := self containerType) = #undefined + ifFalse: [result] + ifTrue: [ + self flag: #contentVsContainer. "mt: Avoid leaking #undefined to the outside." + ExternalType void]! - externalType - - ^ self containerType! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." + | byteOffset numElements byteSize contentType | - | byteOffset numElements byteSize newType | ((1 > firstIndex) or: [size notNil and: [lastIndex > size]]) ifTrue: [^ self errorSubscriptBounds: lastIndex]. + contentType := self contentType. + byteOffset := ((firstIndex-1) * contentType byteSize)+1. - byteOffset := ((firstIndex-1) * self contentType byteSize)+1. numElements := lastIndex - firstIndex + 1 max: 0. + byteSize := numElements * contentType byteSize. - byteSize := numElements * self contentType byteSize. - - "For portions of a null-terminated C string, change the type from char* to byte* to avoid confusion." - newType := self containerType = ExternalType string - ifTrue: [ExternalType byte asPointerType] - ifFalse: [self containerType "No change"]. + ^ ExternalData - ^ (ExternalData fromHandle: (handle structAt: byteOffset length: byteSize) + type: contentType + size: numElements! - type: newType) size: numElements; yourself! Item was changed: ----- Method: ExternalData>>getExternalData (in category 'accessing - external structures') ----- getExternalData + "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory. Use #copy if you want to get a another copy in the object memory. Also see ExternalStructure >> #postCopy." - "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. It does just work once for an external address." | data | handle isExternalAddress ifFalse: [^ self]. - self sizeCheck. + data := ByteArray new: self byteSize. - data := ByteArray new: size * self contentType byteSize. 1 to: data size do: [:index | data unsignedByteAt: index put: (handle unsignedByteAt: index)]. + ^ ExternalData - ^ (ExternalData fromHandle: data + type: type + size: size! - type: self contentType) - size: size! Item was changed: ----- Method: ExternalData>>setHandle:type: (in category 'private') ----- + setHandle: aHandle type: containerType + + self setHandle: aHandle. + self setType: containerType.! - setHandle: aHandle type: aType - handle := aHandle. - type := aType asPointerType.! Item was added: + ----- Method: ExternalData>>setHandle:type:size: (in category 'private') ----- + setHandle: aHandle type: contentType size: numElements + + self setHandle: aHandle. + self setType: contentType. + self setSize: numElements.! Item was added: + ----- Method: ExternalData>>setSize: (in category 'private') ----- + setSize: numElements + "Set the size for the receiver, which will be used when enumerating its elements." + + | ct | + ct := self contentType. + size := numElements. + + self flag: #contentVsContainer. "mt: If we have a size, change the array type. If not, just hold on to the pointer type of the prior content type." + size + ifNil: [type := ct asPointerType] + ifNotNil: [type := (ct asArrayType: size) asPointerType].! Item was added: + ----- Method: ExternalData>>setType: (in category 'private') ----- + setType: contentOrContainerType + "Private. Set the type used to derive content and container types. If we get an array type, also remember its size to distinguish its pointer type from other pointer types." + + type := contentOrContainerType asPointerType. + + contentOrContainerType isArrayType ifTrue: [ + self flag: #contentVsContainer. "mt: Note that we do not have to check whether the argument is actually the pointer type for an array type because those will usually be supplied with an extra call to #setSize: from the outside. See senders of #fromHandle:type:size:." + self setSize: contentOrContainerType size].! Item was removed: - ----- Method: ExternalData>>size: (in category 'accessing') ----- - size: anInteger - "Set the size for the receiver, which will be used when enumerating its elements." - - size := anInteger. - ! Item was changed: ----- Method: ExternalData>>writer (in category 'accessing') ----- writer "Overwritten to preserve type and size." handle isInternalMemory ifFalse: [^ self]. + ^ self class - ^ (self class fromHandle: (ByteArrayReadWriter on: handle) + type: type + size: size! - type: type) size: size; yourself! Item was changed: ----- Method: ExternalStructure>>asExternalData (in category 'converting') ----- asExternalData + ^ ExternalData + fromHandle: self getHandle + type: self externalType "content type" + size: 1! - ^ (ExternalData fromHandle: self getHandle type: self externalType) - size: 1; yourself! Item was removed: - ----- Method: ExternalStructure>>byteSize (in category 'accessing') ----- - byteSize - "Answer the number of bytes managed by the receiver." - - ^ self externalType byteSize! Item was changed: ----- Method: ExternalStructureType>>storeOn: (in category 'printing') ----- storeOn: aStream referentClass ifNil: [ "unknown struct type" ^ aStream nextPutAll: 'nil']. aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space; store: referentClass name; + nextPut: $).! - nextPut: $). - - self isPointerType ifTrue: [ - aStream space; nextPutAll: #asPointerType].! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- allocate: numElements "Allocate space for containing an array of numElements of this dataType" | handle | self + flag: #contentVsContainer; assert: [self isPointerType not or: [self isVoid]] description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; assert: [self byteSize > 0] description: 'Invalid byte size.'. handle := ByteArray new: self byteSize * numElements. + ^ExternalData fromHandle: handle type: self size: numElements! - ^(ExternalData fromHandle: handle type: self) size: numElements! Item was changed: ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- allocateExternal: numElements "Allocate space for containing an array of numElements of this type. Note that we zero the memory for safe use. If you do not need that, please use ExternalAddress class >> #allocate: directly. BE AWARE that structs can have pointers tools automatically follow and thus risking a SEGFAULT and hence VM CRASH for uninitalized memory." | handle | self + flag: #contentVsContainer; assert: [self isPointerType not or: [self isVoid]] description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; assert: [self byteSize > 0] description: 'Invalid byte size.'. handle := ExternalAddress allocate: self byteSize * numElements. + ^(ExternalData fromHandle: handle type: self size: numElements) - ^(ExternalData fromHandle: handle type: self) - size: numElements; zeroMemory; yourself! Item was removed: - ----- Method: ExternalType>>contentType (in category 'external data') ----- - contentType - - | result | - self - assert: [self isPointerType] - description: 'Content type is only defined for pointer types!!'. - - result := self asNonPointerType. - ^ result isArrayType - ifTrue: [result contentType] - ifFalse: [result]! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. "Adds housekeeping for array types." + ExternalType resetAllStructureTypes. - ExternalType resetAllStructureTypes.. + "Re-generate all field accessors because in ExternalData, #size: was replaced with #setSet: and a new constructors for content and container types." - "Re-generate all field accessors because type checks are now controlled by a new preference." ExternalStructure defineAllFields. '! From commits at source.squeak.org Fri May 7 09:54:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 09:54:55 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.29.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.29.mcz ==================== Summary ==================== Name: FFI-Tests-mt.29 Author: mt Time: 7 May 2021, 11:54:55.047725 am UUID: 3e7e1f4d-46de-154b-8c46-5fd1f4fe86bf Ancestors: FFI-Tests-mt.28 Complements FFI-Kernel-mt.139 =============== Diff against FFI-Tests-mt.28 =============== Item was added: + ----- Method: ExternalStructureTests>>test05ReadCString (in category 'tests - external data') ----- + test05ReadCString + + | data | + ExternalData allowDetectForUnknownSizeDuring: [ + data := ExternalData fromHandle: #[65 66 67 0] type: ExternalType char. + self assert: 'ABC' equals: data fromCString. + data := ExternalData fromHandle: #[65 66 67 0 68 69 70 0 0] type: ExternalType char. + self assert:#('ABC' 'DEF') equals: data fromCStrings].! From commits at source.squeak.org Fri May 7 09:55:56 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 09:55:56 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.29.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.29.mcz ==================== Summary ==================== Name: FFI-Tools-mt.29 Author: mt Time: 7 May 2021, 11:55:55.901725 am UUID: 80be7cad-4657-4446-b564-15c92683b1b9 Ancestors: FFI-Tools-mt.28 Complements FFI-Kernel-mt.139 and FFI-Kernel-mt.140. =============== Diff against FFI-Tools-mt.28 =============== Item was changed: ----- Method: ExternalData>>explorerContentsStructFields (in category '*FFI-Tools') ----- explorerContentsStructFields "In case some data interpretation omitted to convert char*, which is a (null-terminated) C string, to Smalltalk string." size notNil ifTrue: [ ^ self withIndexCollect: [:each :index | ObjectExplorerWrapper with: each name: index printString model: self]]. + ^ (ExternalStructureInspector readCStrings and: [self mightBeCString]) ifFalse: [#()] ifTrue: [ - ^ (self isNull not and: [self containerType = ExternalType string]) ifFalse: [#()] ifTrue: [ {ObjectExplorerWrapper + with: ([self fromCString] ifError: [:msg | '<', msg, '>']) - with: self fromCString name: 'as C string' model: self}]! Item was changed: ----- Method: ExternalData>>hasContentsInExplorer (in category '*FFI-Tools') ----- hasContentsInExplorer ^ super hasContentsInExplorer + or: [size notNil or: [ExternalStructureInspector readCStrings and: [self mightBeCString]]]! - or: [self isNull not and: [self containerType = ExternalType string]]! Item was changed: ----- Method: ExternalStructure>>explorerOkToClose (in category '*FFI-Tools') ----- explorerOkToClose "We are being explored and that explorer wants to close. If we point to external memory, ask the user whether we should free it to avoid leaks." + | byteSize | (handle isExternalAddress and: [handle isNull not]) ifTrue: [ (Project uiManager confirm: ('There are {1} bytes addressed.
Do you want to free the allocated memory?' translated format: { + (byteSize := self externalType byteSize) > 0 + ifTrue: [byteSize] ifFalse: ['an unknown number of']. }) asTextFromHtml - [self byteSize] ifError: ['an unknown number of']. }) asTextFromHtml orCancel: [^ false] title: 'External Address Detected' translated) ifTrue: [self free]]. ^ true! Item was changed: Inspector subclass: #ExternalStructureInspector instanceVariableNames: '' + classVariableNames: 'ReadCStrings' - classVariableNames: '' poolDictionaries: '' category: 'FFI-Tools'! Item was added: + ----- Method: ExternalStructureInspector class>>readCStrings (in category 'preferences') ----- + readCStrings + + ^ReadCStrings ifNil:[false]! Item was added: + ----- Method: ExternalStructureInspector class>>readCStrings: (in category 'preferences') ----- + readCStrings: aBoolean + + ReadCStrings := aBoolean.! From commits at source.squeak.org Fri May 7 09:57:00 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 09:57:00 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.11.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.11.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.11 Author: mt Time: 7 May 2021, 11:56:59.650725 am UUID: d9a23c73-af82-6246-89db-be73bb87615a Ancestors: FFI-Callbacks-mt.9 Complements FFI-Kernel-mt.140. =============== Diff against FFI-Callbacks-mt.9 =============== Item was changed: ----- Method: ExternalData class>>fromHandle:byteSize: (in category '*FFI-Callbacks') ----- + fromHandle: aHandle byteSize: numBytes + "Answer an instance that manages a number of unsigned bytes." + + ^ self + fromHandle: aHandle + type: ExternalType unsignedByte "content type" + size: numBytes! - fromHandle: aHandle byteSize: byteSize - ^ (self fromHandle: aHandle type: ExternalType unsignedByte asPointerType) - size: byteSize; - yourself! Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Materialize pointers from integers." isPointer ifTrue: [ self flag: #designSmell. "mt: If we had a way to set, for example, double** as container type and double* as content type for intArgs, we would not have to construct the correct external object here but already had it." self flag: #discuss. "mt: Should we resolve atomic types? That is, double* to an actual float object etc? Well, for pointers to external structures (unions, ...) it would make sense to provide an actual instance of that structure to the callback... If so, we just need to send #value below." data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) + type: argType size: 1) "value"]] - type: argType) size: 1; "value; " yourself]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := argType handle: handle at: byteOffset. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_ARM32: (in category 'callback - evaluators') ----- evaluateDynamic_ARM32: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + callbackContext integerArguments setSize: 4. + callbackContext floatArguments setSize: 8. - callbackContext integerArguments size: 4. - callbackContext floatArguments size: 8. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_ARM64: (in category 'callback - evaluators') ----- evaluateDynamic_ARM64: callbackContext "Set handle to access arguments as most appropriate for the ABI. ARMv8 with AArch64." + callbackContext integerArguments setSize: 8. + callbackContext floatArguments setSize: 8. - callbackContext integerArguments size: 8. - callbackContext floatArguments size: 8. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_IA32: (in category 'callback - evaluators') ----- evaluateDynamic_IA32: callbackContext "Set handle to access arguments as most appropriate for the ABI. For x86 (i.e. IA32) it is the stack pointer." + callbackContext integerArguments setSize: 0. + callbackContext floatArguments setSize: 0. - callbackContext integerArguments size: 0. - callbackContext floatArguments size: 0. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_X64: (in category 'callback - evaluators') ----- evaluateDynamic_X64: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + callbackContext integerArguments setSize: 6. + callbackContext floatArguments setSize: 8. - callbackContext integerArguments size: 6. - callbackContext floatArguments size: 8. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>evaluateDynamic_X64Win64: (in category 'callback - evaluators') ----- evaluateDynamic_X64Win64: callbackContext "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." + callbackContext integerArguments setSize: 4. + callbackContext floatArguments setSize: 4. - callbackContext integerArguments size: 4. - callbackContext floatArguments size: 4. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallbackMemory>>addressFieldPut: (in category 'alien compatibility') ----- addressFieldPut: value " ^" self notify: 'Primitive failed. Proceed to use fallback code.'. ^ (ExternalData fromHandle: self type: ExternalType uintptr_t) + at: ExternalAddress wordSize "Alien size prefix bytes" + 1 "Start of pointer address" - at: ExternalData wordSize + 1 put: value! From bruce.oneel at pckswarms.ch Fri May 7 10:21:02 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Fri, 07 May 2021 12:21:02 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> Message-ID: <1620382862-052682a7b914343cf2785db3cc50a19a@pckswarms.ch> HI, You're right.  I have the following with top to bottom: Pi 3, Rasp PI OS based on Debian Stretch 9.0, Squeak 6.0alpha 20509, VM Cog[spur] built from 20210109. Pi 400, Rasp PI OS based on Debian Buster 10.0,  Squeak 6.0alpha 20509, VM Cog[spur] built from 202109 x86-64 Linux, Mint 20.1 (ubuntu 20.4), Squeak 6.0alpha 20509, VM Cog[spur] built form 20210109. Windows x86-64, Win 10, Squeak 6.0alpha 20509, VMCog[spur] built from 20200302.  I think that's the release VM for windows. and finally a broken one. Armv8, Debian 18.4 (I think), Squeak6.0alpha 20509, but VM built 20210324.  I'll move back to the older VM and try again. cheers bruce ![image.png](cid:77bd605bd683a2a8f17da2db9b54cf3850d9b9d5 at infomaniak "image.png") > I was just about to say something about Chris'question and tried > > 2 raisedTo: 63 > > in a Workspace. I was a little surprised to see '0' returned. > > On my Mac 64 I get the right answer. On the Pi I get the right(ish) answer if I substitute 2.0. To make things weirder if I debug, the end value of 'result' in Number>>#raisedToInteger: is correct. The value of 'stack top' in its sender #raisedTo: is the same correct value. > > Gronk? It's clearly not a problem with printing the value since I see the correct value. If I try > (2 raisedTo: 63) / 64.0 > to check what number is actually there... I get 0. Implying there is really 0. Debug it and.. yup 0. What? It looks like somewhere the LPI instance is getting mishandled but where? > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Strange OpCodes: CSD: Charge Surreptitiously to DOE -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 144838 bytes Desc: not available URL: From bruce.oneel at pckswarms.ch Fri May 7 10:32:49 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Fri, 07 May 2021 12:32:49 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <1620382862-052682a7b914343cf2785db3cc50a19a@pckswarms.ch> References: <1620382862-052682a7b914343cf2785db3cc50a19a@pckswarms.ch> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> Message-ID: <1620383569-fab42929c644e0a220fb6f1fccc367e8@pckswarms.ch> Same results on the ArmV8 with the VM from 20210109. 2 raisedTo: 61 works,  2 raisedTo: 62 and above don't work. -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Fri May 7 15:56:26 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 15:56:26 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.141.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.141.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.141 Author: mt Time: 7 May 2021, 5:56:25.63964 pm UUID: d7665324-f0e5-dc4d-a0bd-fa20b91338ef Ancestors: FFI-Kernel-mt.140 Fixes some bugs and regressions: - clean-up of unused struct and array types is working again (at system start up) - (re-)creation of unknown struct types for never-existent referent-classes works now Adds new accessors/tests on atomic types: - #minVal, #maxVal - #isSinglePrecision, #isDoublePrecision - #asSinglePrecision, #asDoublePrecision =============== Diff against FFI-Kernel-mt.140 =============== Item was changed: ----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') ----- cleanupUnusedTypes "In the lookup table for struct types and array types, remove keys to types no longer present.. ExternalType cleanupUnusedTypes " Smalltalk garbageCollect. StructTypes keys do: [:key | (StructTypes at: key) ifNil: [ + StructTypes removeKey: key]]. - [StructTypes removeKey: key]]]. ArrayTypes keys do: [:key | (ArrayTypes at: key) ifNil: [ + ArrayTypes removeKey: key]].! - [ArrayTypes removeKey: key]]].! Item was changed: ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') ----- structTypeNamed: typeName "Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class." ^ (StructTypes at: typeName ifAbsent: [nil]) + ifNil: [ + StructTypes removeKey: typeName ifAbsent: []. + self newTypeNamed: typeName]! - ifNil: [ "Create struct types for existing struct classes on-the-fly." - (self environment classNamed: typeName) - ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ - StructTypes removeKey: typeName ifAbsent: []. - self newTypeNamed: typeName]]]! Item was added: + ----- Method: ExternalType>>asDoublePrecision (in category 'converting - integer') ----- + asDoublePrecision + + self isDoublePrecision ifTrue: [^ self]. + ^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)! Item was changed: + ----- Method: ExternalType>>asSigned (in category 'converting - integer') ----- - ----- Method: ExternalType>>asSigned (in category 'converting') ----- asSigned self isSigned ifTrue: [^ self]. ^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)! Item was added: + ----- Method: ExternalType>>asSinglePrecision (in category 'converting - integer') ----- + asSinglePrecision + + self isSinglePrecision ifTrue: [^ self]. + ^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)! Item was changed: + ----- Method: ExternalType>>asUnsigned (in category 'converting - integer') ----- - ----- Method: ExternalType>>asUnsigned (in category 'converting') ----- asUnsigned self isUnsigned ifTrue: [^ self]. ^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)! Item was added: + ----- Method: ExternalType>>checkFloatType (in category 'private') ----- + checkFloatType + + self isFloatType + ifFalse: [self error: 'Test is only defined on integer types!!'].! Item was added: + ----- Method: ExternalType>>isDoublePrecision (in category 'testing - float') ----- + isDoublePrecision + + self checkFloatType. + ^ self atomicType = FFITypeDoubleFloat ! Item was changed: + ----- Method: ExternalType>>isFloatType (in category 'testing - float') ----- - ----- Method: ExternalType>>isFloatType (in category 'testing') ----- isFloatType "Return true if the receiver is a built-in float type" | type | type := self atomicType. ^type = FFITypeSingleFloat or: [type = FFITypeDoubleFloat]! Item was changed: + ----- Method: ExternalType>>isIntegerType (in category 'testing - integer') ----- - ----- Method: ExternalType>>isIntegerType (in category 'testing') ----- isIntegerType "Return true if the receiver is a built-in integer type" | type | type := self atomicType. ^type > FFITypeBool and:[type <= FFITypeSignedChar]! Item was changed: + ----- Method: ExternalType>>isSigned (in category 'testing - integer') ----- - ----- Method: ExternalType>>isSigned (in category 'testing') ----- isSigned "Return true if the receiver is a signed integer type." self checkIntegerType. ^self atomicType anyMask: 1! Item was added: + ----- Method: ExternalType>>isSinglePrecision (in category 'testing - float') ----- + isSinglePrecision + + self checkFloatType. + ^ self atomicType = FFITypeSingleFloat ! Item was changed: + ----- Method: ExternalType>>isUnsigned (in category 'testing - integer') ----- - ----- Method: ExternalType>>isUnsigned (in category 'testing') ----- isUnsigned "Return true if the receiver is an unsigned integer type." + + ^ self isSigned not! - - self checkIntegerType. - ^self isSigned not! Item was added: + ----- Method: ExternalType>>maxVal (in category 'accessing') ----- + maxVal + + | data bytes | + data := self allocate: 1. + bytes := data getHandle. + + self isIntegerType ifTrue: [ + self isSigned ifTrue: [ + bytes atAllPut: 16rFF. + FFIPlatformDescription current endianness = #little + ifTrue: [bytes at: bytes size put: 16r7F] + ifFalse: [bytes at: 1 put: 16r7F]. + ^ data value]. + self isUnsigned ifTrue: [ + bytes atAllPut: 16rFF. + ^ data value]]. + + self isFloatType ifTrue: [ + bytes atAllPut: 16rFF. + self isSinglePrecision ifTrue: [ + FFIPlatformDescription current endianness = #little + ifTrue: [ + bytes at: bytes size put: 16r7F. + bytes at: bytes size - 1 put: 16r7F] + ifFalse: [ + bytes at: 1 put: 16r7F. + bytes at: 2 put: 16r7F]. + ^ data value]. + self isDoublePrecision ifTrue: [ + FFIPlatformDescription current endianness = #little + ifTrue: [ + bytes at: bytes size put: 16r7F. + bytes at: bytes size - 1 put: 16rEF] + ifFalse: [ + bytes at: 1 put: 16r7F. + bytes at: 2 put: 16rEF]. + ^ data value]]. + + self error: 'maxVal not defined for this type'.! Item was added: + ----- Method: ExternalType>>minVal (in category 'accessing') ----- + minVal + + | data bytes | + data := self allocate: 1. + bytes := data getHandle. + + self isIntegerType ifTrue: [ + self isSigned ifTrue: [ + FFIPlatformDescription current endianness = #little + ifTrue: [bytes at: bytes size put: 1 << 7] + ifFalse: [bytes at: 1 put: 1 << 7]. + ^ data value]. + self isUnsigned ifTrue: [ + ^ data value]]. + + self isFloatType ifTrue: [ + bytes atAllPut: 16rFF. + self isSinglePrecision ifTrue: [ + FFIPlatformDescription current endianness = #little + ifTrue: [bytes at: bytes size - 1 put: 16r7F] + ifFalse: [bytes at: 2 put: 16r7F]. + ^ data value]. + self isDoublePrecision ifTrue: [ + FFIPlatformDescription current endianness = #little + ifTrue: [bytes at: bytes size - 1 put: 16rEF] + ifFalse: [bytes at: 2 put: 16rEF]. + ^ data value]]. + + self error: 'minVal not defined for this type'.! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" + ExternalAddress allBeNull. + ExternalType cleanupUnusedTypes ] - ExternalAddress allBeNull] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." { ExternalAddress. ExternalType. ExternalStructure. ExternalPool } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]] ].! From commits at source.squeak.org Fri May 7 16:52:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 16:52:55 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.30.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.30.mcz ==================== Summary ==================== Name: FFI-Tests-mt.30 Author: mt Time: 7 May 2021, 6:52:54.95064 pm UUID: 9e06096e-b5c4-5848-abb5-b98200c4d9f4 Ancestors: FFI-Tests-mt.29 More tests =) =============== Diff against FFI-Tests-mt.29 =============== Item was changed: ----- Method: ExternalTypeTests>>testAllocateAtomicsExternal (in category 'tests') ----- testAllocateAtomicsExternal + "Note that #allocateExternal for atomics does not need an extra #free. See #allocateExternal." self should: [ExternalType void allocateExternal] raise: Error. self assert: false equals: ExternalType bool allocateExternal. self assert: 0 equals: ExternalType int8_t "sbyte" allocateExternal. self assert: 0 equals: ExternalType uint8_t "byte" allocateExternal. self assert: 0 equals: ExternalType uint16_t "ushort" allocateExternal. self assert: 0 equals: ExternalType int16_t "short" allocateExternal. self assert: 0 equals: ExternalType uint32_t "ulong" allocateExternal. self assert: 0 equals: ExternalType int32_t "long" allocateExternal. self assert: 0 equals: ExternalType uint64_t "ulonglong" allocateExternal. self assert: 0 equals: ExternalType int64_t "longlong" allocateExternal. self assert: Character null equals: ExternalType schar allocateExternal. self assert: Character null equals: ExternalType char allocateExternal. self assert: 0.0 equals: ExternalType float allocateExternal. self assert: 0.0 equals: ExternalType double allocateExternal.! Item was added: + ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests') ----- + testAtomicTypeRange + + self should: [ExternalType void minVal] raise: Error. + self should: [ExternalType void maxVal] raise: Error. + + self should: [ExternalType bool minVal] raise: Error. + self should: [ExternalType bool maxVal] raise: Error. + + self assert: 0 equals: ExternalType uint8_t "byte" minVal. + self assert: 255 equals: ExternalType uint8_t "byte" maxVal. + self assert: -128 equals: ExternalType int8_t "sbyte" minVal. + self assert: 127 equals: ExternalType int8_t "sbyte" maxVal. + + self assert: 0 equals: ExternalType uint16_t "ushort" minVal. + self assert: 65535 equals: ExternalType uint16_t "ushort" maxVal. + self assert: -32768 equals: ExternalType int16_t "short" minVal. + self assert: 32767 equals: ExternalType int16_t "short" maxVal. + + self assert: 0 equals: ExternalType uint32_t "ulong" minVal. + self assert: 4294967295 equals: ExternalType uint32_t "ulong" maxVal. + self assert: -2147483648 equals: ExternalType int32_t "long" minVal. + self assert: 2147483647 equals: ExternalType int32_t "long" maxVal. + + self assert: 0 equals: ExternalType uint64_t "ulonglong" minVal. + self assert: 18446744073709551615 equals: ExternalType uint64_t "ulonglong" maxVal. + self assert: -9223372036854775808 equals: ExternalType int64_t "longlong" minVal. + self assert: 9223372036854775807 equals: ExternalType int64_t "longlong" maxVal. + + self assert: Character null equals: ExternalType char "unsignedChar" minVal. + self assert: (Character value: 255) equals: ExternalType char "unsignedChar" maxVal. + self assert: (Character value: 128) equals: ExternalType signedChar "schar" minVal. + self assert: (Character value: 127) equals: ExternalType signedChar "schar" maxVal. + + self assert: -3.4028234663852886e38 equals: ExternalType float minVal. + self assert: 3.4028234663852886e38 equals: ExternalType float maxVal. + self assert: -1.7976931348623157e308 equals: ExternalType double minVal. + self assert: 1.7976931348623157e308 equals: ExternalType double maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testPrecisionFloatTypes (in category 'tests') ----- + testPrecisionFloatTypes + + self + assert: ExternalType float isSinglePrecision; + assert: ExternalType double + equals: ExternalType float asDoublePrecision; + assert: ExternalType double isDoublePrecision; + assert: ExternalType float + equals: ExternalType float asSinglePrecision.! Item was added: + ----- Method: ExternalTypeTests>>testPrecisionIntegerTypes (in category 'tests') ----- + testPrecisionIntegerTypes + + AtomicTypeNames do: [:typeName | + | type | + type := ExternalType atomicTypeNamed: typeName. + type isIntegerType ifTrue: [ + self + should: [type isSinglePrecision] + raise: Error; + should: [type isDoublePrecision] + raise: Error]].! From marcel.taeumel at hpi.de Fri May 7 17:26:32 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Fri, 7 May 2021 19:26:32 +0200 Subject: [squeak-dev] The Inbox: Morphic-ct.1769.mcz In-Reply-To: References: <,> Message-ID: Ah. Then #transparent ~= #translucent =) Best, Marcel Am 06.05.2021 23:15:41 schrieb Thiede, Christoph : Well, I actually wanted to prevent a window from automatically applying the color of its first child, which is often a transparent panel morph. Recently we had a student complaining that his window was completely lacking color: ToolBuilder open: (PluggableWindowSpec new children: {PluggablePanelSpec new     frame: (LayoutFrame new topFraction: 1;     yourself); yourself}; yourself). This is because only Model implements #windowColorToUse. Note that #windowColorToUse, #paneColor, and #defaultColor can still be used to set a translucent color. But I'm not sure whether it is a good idea to derive a transparent color from a child ... Best, Christoph [http://www.hpi.de/] Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:32:24 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1769.mcz   > Avoid translucent color. Why? I did cut out the drop shadow. Translucent windows colors look so cool! :-D Am 01.05.2021 14:12:32 schrieb commits at source.squeak.org : A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1769.mcz ==================== Summary ==================== Name: Morphic-ct.1769 Author: ct Time: 1 May 2021, 2:12:17.510389 pm UUID: aa271c07-344a-324a-afe4-3950d6c00839 Ancestors: Morphic-mt.1767 Make SystemWindow's paneColor more robust against missing models. Avoid translucent color. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: SystemWindow>>paneColor (in category 'colors') ----- paneColor | cc | (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc]. (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse]. + cc ifNil: [cc := paneMorphs + detect: [:morph | morph color isTransparent not] + ifFound: [:morph | morph color asNontranslucentColor] + ifNone: [nil]]. - cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]. cc ifNil: [cc := self defaultColor]. self paneColor: cc. ^cc! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57317 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 15764 bytes Desc: not available URL: From marcel.taeumel at hpi.de Fri May 7 17:36:04 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Fri, 7 May 2021 19:36:04 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de> References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> <,> <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de> Message-ID: A rather big change set (81 changed methods, 474 changed methods) has about 150 ms lag in that menu. An empty change set has 5 ms lag. For comparison, the Extras-Menu has 15 ms lag. [self owner selectItem: self event: ActiveHand lastEvent. ActiveWorld displayWorldSafely. self deselect: ActiveHand lastEvent. ActiveWorld displayWorldSafely] bench Best, Marcel Am 06.05.2021 22:59:20 schrieb Thiede, Christoph : > So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? This, of course, would only work if the list could only grow at its end. But I see your point ... I often have a similar situation with the thumbnails in the project menu (around 10 - 20 projects). Lazy loading might actually save me around 60 seconds per day. :D > How big was the changeset that produced those lags? Very small, maybe a dozen of changes. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:26:33 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) [http://www.hpi.de/] Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz [http://source.squeak.org/trunk/Morphic-mt.1767.mcz] ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + +        ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + +        ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + +        DualChangeSorter open.! Item was changed:   ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') -----   listChangesOn: menu            | latestMethodChanges latestClassChanges|          latestMethodChanges := (Array streamContents: [:s |                  ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category |                          s nextPut: { dateAndTime. method. changeType. category }]])                          sorted: [:a :b | a first >= b first].            1 to: (10 min: latestMethodChanges size) do: [:index | | spec method |                  spec := latestMethodChanges at: index.                  method := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ;                                  target: ToolSet;                                  balloonText: spec third asString;                                  icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [                                          spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]);                                  selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]);                                  arguments: {method}]].                                           latestClassChanges := (Array streamContents: [:s |                  ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category |                          "We are not interested in classes whose method's did only change."                          changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]])                          sorted: [:a :b | a first >= b first].            latestClassChanges ifNotEmpty: [menu addLine].          1 to: (10 min: latestClassChanges size) do: [:index | | spec class |                  spec := latestClassChanges at: index.                  class := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ;                                  target: ToolSet;                                  balloonText: (spec third sorted joinSeparatedBy: Character space);                                  icon: ((spec third includesAnyOf: #(remove addedThenRemoved))                                          ifTrue: [MenuIcons smallDeleteIcon]                                          ifFalse: [                                                  (spec third includes: #add)                                                          ifTrue: [MenuIcons smallNewIcon]                                                          ifFalse: [MenuIcons blankIcon]]);                                  selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]);                                  arguments: {class}]]. +        +        menu defaultTarget: self. +        menu addTranslatedList: #( +                - +                ('Browse current change set'            browseChangeSet) +                ('Browse changed methods'               browseChangedMethods) +                - +                ('Simple Change Sorter'                         browseChanges) +                ('Dual Change Sorter'                                   browseChangesDual)). + + + ! -                                -        menu addLine; addItem: [:item | -                item -                        contents: 'Browse current change set...' translated; -                        target: self; -                        selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From jakres+squeak at gmail.com Fri May 7 18:49:22 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Fri, 7 May 2021 20:49:22 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> Message-ID: Sounds like a good compromise, although I have no Mac to try how it feels. How does Apple teach this handling to its users, or do they gladly find out by accident? How complex would an implementation of such motion- and time-dependent drag handling be? Am Fr., 7. Mai 2021 um 08:30 Uhr schrieb Tobias Pape : > > Hi > > > > On 7. May 2021, at 07:51, Marcel Taeumel wrote: > > > > Hi Chris. > > > > > Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet > > > > Ah, that's right. In the Windows Explorer, there has always been a conflict between click-drag-out gestures and click-drag-select gestures. It is sometimes really hard to intentionally perform one or the other. > > Mac makes the distinction based on how long you wait between the click and the drag, at least for text. > So if you > - have a selection, > - click, > - wait for around a second, and > - then drag, > you will drag the selected text around. > > In all other cases for text, it changes the selection. > > I just found it is similar for files in the Finder (think explorer), but slightly different. > Since files are always in a vertical fashion, _the same as for text_ is true for files as long as you drag _vertically_ > I if you click-drag horizontally, it directly drags the file/selection. > > I think this is a quite good tradeoff there. > > Best regards > -Tobias > > > > > Many touch interfaces opted for having an extra drag handle nearby. Maybe this could work? > > > > Best, > > Marcel > >> Am 07.05.2021 02:02:44 schrieb Chris Muller : > >> > >> Hi Marcel, > >> > >> > Hmm... it is unusual that a normal click can also select a range. > >> > >> Hmm, no, I don't think so. Swipe select is very common -- like > >> swiping characters in text, or cells of a spreadsheet, and > >> "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. > >> In Squeak it's called PluggableListMorphOfMany (used by changes > >> browser) and it's [Alternate] incantation which doesn't lose > >> selections simply because your framerate is too low.. > >> > >> And, yes, Control was *supposed* to be a modifier key to toggle > >> individuals, but as Jakob pointed out, it's intercepted by the halo. > >> > >> All the functions Tim mentioned are currently available via the menus. > >> > >> > >> - Chris > >> > > > > > From Das.Linux at gmx.de Fri May 7 19:02:13 2021 From: Das.Linux at gmx.de (Tobias Pape) Date: Fri, 7 May 2021 21:02:13 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> Message-ID: <821531DF-4875-46CF-AA20-2DB7B02672F0@gmx.de> > On 7. May 2021, at 20:49, Jakob Reschke wrote: > > Sounds like a good compromise, although I have no Mac to try how it > feels. How does Apple teach this handling to its users, or do they > gladly find out by accident? I figured by accident and wrongdoing. Like, try to drag but select, wonder, try differntly, epiphany, never think about it again but use it daily. also, newer touchpads have this click-throuhg, that when you click hard enough (like literally) it selects the whole word and brings up a pop up with a definition. its neat. > How complex would an implementation of > such motion- and time-dependent drag handling be? Not the slightest idea. -t > > > Am Fr., 7. Mai 2021 um 08:30 Uhr schrieb Tobias Pape : >> >> Hi >> >> >>> On 7. May 2021, at 07:51, Marcel Taeumel wrote: >>> >>> Hi Chris. >>> >>>> Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet >>> >>> Ah, that's right. In the Windows Explorer, there has always been a conflict between click-drag-out gestures and click-drag-select gestures. It is sometimes really hard to intentionally perform one or the other. >> >> Mac makes the distinction based on how long you wait between the click and the drag, at least for text. >> So if you >> - have a selection, >> - click, >> - wait for around a second, and >> - then drag, >> you will drag the selected text around. >> >> In all other cases for text, it changes the selection. >> >> I just found it is similar for files in the Finder (think explorer), but slightly different. >> Since files are always in a vertical fashion, _the same as for text_ is true for files as long as you drag _vertically_ >> I if you click-drag horizontally, it directly drags the file/selection. >> >> I think this is a quite good tradeoff there. >> >> Best regards >> -Tobias >> >>> >>> Many touch interfaces opted for having an extra drag handle nearby. Maybe this could work? >>> >>> Best, >>> Marcel >>>> Am 07.05.2021 02:02:44 schrieb Chris Muller : >>>> >>>> Hi Marcel, >>>> >>>>> Hmm... it is unusual that a normal click can also select a range. >>>> >>>> Hmm, no, I don't think so. Swipe select is very common -- like >>>> swiping characters in text, or cells of a spreadsheet, and >>>> "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. >>>> In Squeak it's called PluggableListMorphOfMany (used by changes >>>> browser) and it's [Alternate] incantation which doesn't lose >>>> selections simply because your framerate is too low.. >>>> >>>> And, yes, Control was *supposed* to be a modifier key to toggle >>>> individuals, but as Jakob pointed out, it's intercepted by the halo. >>>> >>>> All the functions Tim mentioned are currently available via the menus. >>>> >>>> >>>> - Chris >>>> >>> >> >> >> > From Patrick.Rein at hpi.de Fri May 7 19:24:10 2021 From: Patrick.Rein at hpi.de (Rein, Patrick) Date: Fri, 7 May 2021 19:24:10 +0000 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! Message-ID: Hi Everyone, I'm very pleased to announce your Squeak Oversight Board for 2021. They are: 1. Vanessa Freudenberg 2. Tim Rowledge 3. Craig Latta 4. Marcel Taeumel 5. David T. Lewis 6. Tony Garnock-Jones 7. Bruce O'Neel (The list already accounts for the withdrawal of Chris Muller.) http://wiki.squeak.org/squeak/6656 I would like to thank everyone that served on the board last year! Thank you for your contributions to Squeak! Thank you to everyone that ran this year and for everyone that voted! We are looking forward to a great year in the Squeak community! Please help me to congratulate your new board for 2021!! All the best, Patrick From commits at source.squeak.org Fri May 7 19:24:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 19:24:53 0000 Subject: [squeak-dev] The Trunk: KernelTests-nice.404.mcz Message-ID: Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.404.mcz ==================== Summary ==================== Name: KernelTests-nice.404 Author: nice Time: 7 May 2021, 9:24:51.105431 pm UUID: 2685fbb3-2da9-4f09-8344-325b655d1c18 Ancestors: KernelTests-nice.403 Expose bugs of LargePositiveInteger sqrt as encountered in Kernel-nice.1401 1) we need twice the Float precision for deciding the case when the exact root falls between two consecutive Float (exact tie), so truncating bits too eagerly ain't gonna work 2) we need to assert that self mightBeASquare before answering an Integer. There were some cases when truncating bits would make us an exact square, and we would answer an Integer even if we are not an exact square when equipped with trailing bits ! In this testSqrtNearExactTie, we carefully craft some exact tie, and try to extract the square root of slightly bigger and smaller integers =============== Diff against KernelTests-nice.403 =============== Item was added: + ----- Method: LargePositiveIntegerTest>>assert:classAndValueEquals: (in category 'asserting') ----- + assert: expected classAndValueEquals: actual + self + assert: expected equals: actual; + assert: expected class equals: actual class.! Item was added: + ----- Method: LargePositiveIntegerTest>>testSqrtNearExactTie (in category 'tests - mathematical functions') ----- + testSqrtNearExactTie + | p q evenTie oddTie perfectSquare inexactSquare | + "first construct square root results that lie exactly between 2 consecutive Float" + p := Float precision. + q := Float precision // 4. + evenTie := 1 << q + 1 << q + 1 << (p - q - q) + 1. + self assert: p + 1 = evenTie highBit. + self assert: evenTie asFloat significandAsInteger even. "evenTie round down to even" + self assert: evenTie asFloat ulp asFraction / 2 + evenTie asFloat asFraction = evenTie. + oddTie := 1 << q + 1 << q + 1 << (p - q - q) + 2r11. + self assert: p + 1 = oddTie highBit. + self assert: oddTie asFloat significandAsInteger even. "oddTie round up to even" + self assert: oddTie asFloat ulp asFraction / -2 + oddTie asFloat asFraction = oddTie. + + "then assert that we can retrieve the exact root" + perfectSquare := evenTie squared. + self assert: perfectSquare sqrt classAndValueEquals: evenTie. + + "now take an inexact square by excess : it falls above exact tie, and should round up" + inexactSquare := evenTie squared + 1. + self deny: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: evenTie asFloat successor. + "same with one possibly exact square so that we take both paths" + inexactSquare := evenTie squared + 3. + self assert: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: evenTie asFloat successor. + "same with less bits and a possibly exact square so that we explore yet another path" + inexactSquare := evenTie squared + 3 // 4. + self assert: inexactSquare * 4 equals: evenTie squared + 3. + self assert: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: (evenTie asFloat successor / 2). + "same with very very far bit to solve the tie" + inexactSquare := evenTie squared << 100 + 2. + self deny: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: (evenTie asFloat successor timesTwoPower: 50). + + "Redo the same with odd tie, just to be sure" + perfectSquare := oddTie squared. + self assert: perfectSquare sqrt classAndValueEquals: oddTie. + + "now take an inexact square by default : it falls below exact tie, and should round down" + inexactSquare := oddTie squared - 1. + self deny: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: oddTie asFloat predecessor. + "same for not possibly exact case" + inexactSquare := oddTie squared - 5. + self assert: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: oddTie asFloat predecessor. + "same with less bits" + inexactSquare := oddTie squared - 9 // 4. + self assert: inexactSquare * 4 equals: oddTie squared - 9. + self assert: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: (oddTie asFloat predecessor / 2). + "same with very very far bit to solve the tie" + inexactSquare := oddTie squared << 100 - 2. + self deny: inexactSquare mightBeASquare. + self assert: inexactSquare sqrt classAndValueEquals: (oddTie asFloat predecessor timesTwoPower: 50).! From Das.Linux at gmx.de Fri May 7 19:29:12 2021 From: Das.Linux at gmx.de (Tobias Pape) Date: Fri, 7 May 2021 21:29:12 +0200 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! In-Reply-To: References: Message-ID: <9B52E609-70F9-4BDA-BB48-E57AC6FA9E00@gmx.de> Congratulations to all of you, and thanks to everybody who served on the last board! Best regards -Tobias > On 7. May 2021, at 21:24, Rein, Patrick wrote: > > Hi Everyone, > > I'm very pleased to announce your Squeak Oversight Board for 2021. They are: > > 1. Vanessa Freudenberg > 2. Tim Rowledge > 3. Craig Latta > 4. Marcel Taeumel > 5. David T. Lewis > 6. Tony Garnock-Jones > 7. Bruce O'Neel > > (The list already accounts for the withdrawal of Chris Muller.) > http://wiki.squeak.org/squeak/6656 > > I would like to thank everyone that served on the board last year! Thank you for your contributions to Squeak! > > Thank you to everyone that ran this year and for everyone that voted! We are looking forward to a great year in the Squeak community! > > Please help me to congratulate your new board for 2021!! > > All the best, > Patrick > From commits at source.squeak.org Fri May 7 19:39:50 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 19:39:50 0000 Subject: [squeak-dev] The Trunk: Kernel-nice.1402.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1402.mcz ==================== Summary ==================== Name: Kernel-nice.1402 Author: nice Time: 7 May 2021, 9:39:45.713143 pm UUID: 21ee698b-9f75-40e3-9bd3-944e73cb9e20 Ancestors: Kernel-nice.1401 Fix sqrt bugs exposed by #testSqrtNearExactTie. If we pretend to round to nearest, we must do it right, not just pretend... How was the problem found? Accidentally... I re-examined our implementation after musing in SO: https://stackoverflow.com/questions/67361541/correctly-rounded-computation-of-sqrt-of-sum-of-two-floats-handling-overflow/67426790#67426790 Musing is more powerful than dumb static and coverage tests, I wish I got more time for musing :) We deadly need evolutive testing (neural based). =============== Diff against Kernel-nice.1401 =============== Item was changed: ----- Method: LargePositiveInteger>>sqrt (in category 'mathematical functions') ----- sqrt "Answer the square root of the receiver. If the square root is exact, answer an Integer, else answer a Float approximation. Make sure the result is correctly rounded (i.e. the nearest Float to the exact square root)" + | floatResult integerResult guardBit highBit sr maybeExact | + maybeExact := self mightBeASquare. + self isAnExactFloat - | floatResult integerResult guardBit highBit sr | - (highBit := self highBit) < (Float precision * 2) ifTrue: ["the sqrt of self asFloat is correctly rounded, so use it" floatResult := self asFloat sqrt. + maybeExact ifFalse: [^floatResult]. - self mightBeASquare ifFalse: [^floatResult]. "Answer integerResult in case of perfect square" integerResult := floatResult truncated. integerResult squared = self ifTrue: [^integerResult]. ^floatResult]. + "Eventually use guard bits for handling correct rounding direction" + highBit := self highBit. - "Eventually use a guard bit for handling correct rounding direction" guardBit := highBit <= (Float precision + 1 * 2) ifTrue: + ["Add guard bits for rounding correctly" + Float precision + 1 * 2 + 1 - highBit] - ["Add one guard bit for rounding correctly" - 1] ifFalse: + [maybeExact - [self mightBeASquare ifTrue: + ["Keep all the bits in case we were a perfect square" - ["Keep all the bits in case we are a perfect square" 0] ifFalse: + ["Remove superfluous bits that won't change the Float approximation" - ["Remove superfluous bit that won't change the Float approximation" Float precision + 1 - (highBit // 2)]]. "Get truncated sqrt and remainder for the same price" sr := (self bitShift: guardBit * 2) sqrtRem. "Handle case of perfect square" integerResult := sr first. + (maybeExact and: [sr last isZero]) ifTrue: [^integerResult bitShift: guardBit negated]. - sr last isZero ifTrue: [^integerResult bitShift: guardBit negated]. "Answer the best we have which is the sqrt correctly rounded at Float precision." ^((integerResult bitShift: Float precision - integerResult highBit) + (integerResult bitAt: integerResult highBit - Float precision)) asFloat timesTwoPower: integerResult highBit - Float precision - guardBit! From leves at caesar.elte.hu Fri May 7 19:45:29 2021 From: leves at caesar.elte.hu (Levente Uzonyi) Date: Fri, 7 May 2021 21:45:29 +0200 (CEST) Subject: [squeak-dev] The Inbox: Graphics-ct.449.mcz In-Reply-To: References: Message-ID: Hi Christoph, What about just using #magnifyBy:? Levente On Thu, 6 May 2021, commits at source.squeak.org wrote: > A new version of Graphics was added to project The Inbox: > http://source.squeak.org/inbox/Graphics-ct.449.mcz > > ==================== Summary ==================== > > Name: Graphics-ct.449 > Author: ct > Time: 6 May 2021, 10:46:15.911809 pm > UUID: 52f12efc-da63-0d44-a252-72bc5f89b6c7 > Ancestors: Graphics-mt.448 > > Proposal: Adds Form >> #scaledBy: that scales a form by a certain factor. I identified half a dozen of senders of #scaledToSize: in the Trunk each of which has reinvented this wheel. > > =============== Diff against Graphics-mt.448 =============== > > Item was added: > + ----- Method: Form>>scaledBy: (in category 'scaling, rotation') ----- > + scaledBy: factor > + "Answer a version of the receiver which is scaled by factor, which can be a number or point." > + > + (factor closeTo: 1) ifTrue: [^ self]. > + ^ self scaledToSize: (self extent * factor) rounded! From leves at caesar.elte.hu Fri May 7 20:01:18 2021 From: leves at caesar.elte.hu (Levente Uzonyi) Date: Fri, 7 May 2021 22:01:18 +0200 (CEST) Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: Message-ID: Hi Christoph, There was a discussion on this subject before: http://forum.world.st/The-Trunk-Collections-topa-806-mcz-td5084658.html Main concerns are - definition: What is a separator? - consistency: CharacterSet separators would differ from the rest with your change set. - performance: I haven't measured it, but I wouldn't be surprised if #isSeparator would become a magnitude slower with that implementation. Levente On Thu, 6 May 2021, christoph.thiede at student.hpi.uni-potsdam.de wrote: > Hi all, > > here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be identified correctly now, too. > > Please review and merge! :-) > > Best, > Christoph > > ["isSeparator.cs.gz"] From nicolas.cellier.aka.nice at gmail.com Fri May 7 20:01:17 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Fri, 7 May 2021 22:01:17 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: <821531DF-4875-46CF-AA20-2DB7B02672F0@gmx.de> References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> <814A4BBC-8CAF-45BC-80D9-A6B97C85A5D6@rowledge.org> <821531DF-4875-46CF-AA20-2DB7B02672F0@gmx.de> Message-ID: Le ven. 7 mai 2021 à 21:02, Tobias Pape a écrit : > > > > > On 7. May 2021, at 20:49, Jakob Reschke wrote: > > > > Sounds like a good compromise, although I have no Mac to try how it > > feels. How does Apple teach this handling to its users, or do they > > gladly find out by accident? > > I figured by accident and wrongdoing. Like, try to drag but select, wonder, try differntly, epiphany, never think about it again but use it daily. > also, newer touchpads have this click-throuhg, that when you click hard enough (like literally) it selects the whole word and brings up a pop up with a definition. > its neat. > Hmm, sometimes, this click-through interferes badly: it may become hard to sustain a low pressure on touchpad. >From time to time, it would prevent me from carrying my intention to drag in the finder. Maybe I should scale the cafeine down, but still ;) > > How complex would an implementation of > > such motion- and time-dependent drag handling be? > > Not the slightest idea. > > -t > > > > > > Am Fr., 7. Mai 2021 um 08:30 Uhr schrieb Tobias Pape : > >> > >> Hi > >> > >> > >>> On 7. May 2021, at 07:51, Marcel Taeumel wrote: > >>> > >>> Hi Chris. > >>> > >>>> Hmm, no, I don't think so. Swipe select is very common -- like swiping characters in text, or cells of a spreadsheet > >>> > >>> Ah, that's right. In the Windows Explorer, there has always been a conflict between click-drag-out gestures and click-drag-select gestures. It is sometimes really hard to intentionally perform one or the other. > >> > >> Mac makes the distinction based on how long you wait between the click and the drag, at least for text. > >> So if you > >> - have a selection, > >> - click, > >> - wait for around a second, and > >> - then drag, > >> you will drag the selected text around. > >> > >> In all other cases for text, it changes the selection. > >> > >> I just found it is similar for files in the Finder (think explorer), but slightly different. > >> Since files are always in a vertical fashion, _the same as for text_ is true for files as long as you drag _vertically_ > >> I if you click-drag horizontally, it directly drags the file/selection. > >> > >> I think this is a quite good tradeoff there. > >> > >> Best regards > >> -Tobias > >> > >>> > >>> Many touch interfaces opted for having an extra drag handle nearby. Maybe this could work? > >>> > >>> Best, > >>> Marcel > >>>> Am 07.05.2021 02:02:44 schrieb Chris Muller : > >>>> > >>>> Hi Marcel, > >>>> > >>>>> Hmm... it is unusual that a normal click can also select a range. > >>>> > >>>> Hmm, no, I don't think so. Swipe select is very common -- like > >>>> swiping characters in text, or cells of a spreadsheet, and > >>>> "MultiselectList" was (is?) the basis of many browsers in VisualAge Smalltalk. > >>>> In Squeak it's called PluggableListMorphOfMany (used by changes > >>>> browser) and it's [Alternate] incantation which doesn't lose > >>>> selections simply because your framerate is too low.. > >>>> > >>>> And, yes, Control was *supposed* to be a modifier key to toggle > >>>> individuals, but as Jakob pointed out, it's intercepted by the halo. > >>>> > >>>> All the functions Tim mentioned are currently available via the menus. > >>>> > >>>> > >>>> - Chris > >>>> > >>> > >> > >> > >> > > > > > From nicolas.cellier.aka.nice at gmail.com Fri May 7 20:12:28 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Fri, 7 May 2021 22:12:28 +0200 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! In-Reply-To: <9B52E609-70F9-4BDA-BB48-E57AC6FA9E00@gmx.de> References: <9B52E609-70F9-4BDA-BB48-E57AC6FA9E00@gmx.de> Message-ID: The shorter the application sent, the higher the rank : definitely, small is beautiful ;) Congrats and thank you! Le ven. 7 mai 2021 à 21:29, Tobias Pape a écrit : > > Congratulations to all of you, > and thanks to everybody who served on the last board! > > Best regards > -Tobias > > > On 7. May 2021, at 21:24, Rein, Patrick wrote: > > > > Hi Everyone, > > > > I'm very pleased to announce your Squeak Oversight Board for 2021. They are: > > > > 1. Vanessa Freudenberg > > 2. Tim Rowledge > > 3. Craig Latta > > 4. Marcel Taeumel > > 5. David T. Lewis > > 6. Tony Garnock-Jones > > 7. Bruce O'Neel > > > > (The list already accounts for the withdrawal of Chris Muller.) > > http://wiki.squeak.org/squeak/6656 > > > > I would like to thank everyone that served on the board last year! Thank you for your contributions to Squeak! > > > > Thank you to everyone that ran this year and for everyone that voted! We are looking forward to a great year in the Squeak community! > > > > Please help me to congratulate your new board for 2021!! > > > > All the best, > > Patrick > > > > > From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 7 20:50:59 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 7 May 2021 20:50:59 +0000 Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: , Message-ID: Hi Levente, thanks for the pointer. As far I can see from the linked discussion, Tobias' proposal has never been rejected but only postponed due to the upcoming release. I also see your point of performance, but IMHO correctness is more important than performance. If necessary, we could still hard-code the relevant code points into #isSeparator. > - consistency: CharacterSet separators would differ from the rest with your change set. Fair point, but I think we should instead fix the definitions of Character(Set) constants to respect the encoding as well ... By the way, Character alphabet and Character allCharacters also don't do this at the moment. Of course, all your concerns are valid points and need to be discussed, but I would be sorry if we failed to - finally - establish current standards in our Character library. I doubt that any modern parser for JSON or whatever would treat Unicode space characters incorrectly, and still, they are satisfyingly fast. I think we should be able to keep pace with them in Squeak as well. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Levente Uzonyi Gesendet: Freitag, 7. Mai 2021 22:01:18 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] [ENH] isSeparator Hi Christoph, There was a discussion on this subject before: http://forum.world.st/The-Trunk-Collections-topa-806-mcz-td5084658.html Main concerns are - definition: What is a separator? - consistency: CharacterSet separators would differ from the rest with your change set. - performance: I haven't measured it, but I wouldn't be surprised if #isSeparator would become a magnitude slower with that implementation. Levente On Thu, 6 May 2021, christoph.thiede at student.hpi.uni-potsdam.de wrote: > Hi all, > > here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be identified correctly now, too. > > Please review and merge! :-) > > Best, > Christoph > > ["isSeparator.cs.gz"] -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Fri May 7 21:45:21 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 7 May 2021 21:45:21 0000 Subject: [squeak-dev] The Inbox: Monticello-ct.747.mcz Message-ID: A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-ct.747.mcz ==================== Summary ==================== Name: Monticello-ct.747 Author: ct Time: 7 May 2021, 11:45:19.014241 pm UUID: 2cb0b275-8fb5-b149-b46d-41387d4d8f1f Ancestors: Monticello-ct.746 Fixes a bug in MCHttpRespository(MCFileBasedRepository) >> #versionNamed: that occurred when the repository did not contain the requested version. As the comment in the superclass states, answer nil in this case instead of raising a NetworkError. To do this, raise a more precise NotFound error in MCHttpRepository >> #webClientDo: if the version does not exist. I checked all other senders and handlers of the NetworkError; no one else depends on the old behavior. =============== Diff against Monticello-ct.746 =============== Item was changed: ----- Method: MCFileBasedRepository>>versionNamed: (in category 'versions') ----- versionNamed: aMCVersionName "For FileBased repositories, aMCVersionName must have the appropriate extension!! :-(" | version | version := self cache at: aMCVersionName ifAbsent: [ [ self loadVersionFromFileNamed: aMCVersionName ] + on: FileDoesNotExistException , NotFound - on: FileDoesNotExistException do: [ : err | nil ] ]. self resizeCache: cache. (version notNil and: [ version isCacheable ]) ifTrue: [ cache at: aMCVersionName asMCVersionName put: version ]. ^ version! Item was changed: ----- Method: MCHttpRepository>>webClientDo: (in category 'private') ----- webClientDo: aBlock | client attemptsLeft response result | self class useSharedWebClientInstance ifTrue: [ "Acquire webClient by atomically storing it in the client variable and setting its value to nil." client := webClient. webClient := nil ]. client ifNil: [ client := WebClient new ] ifNotNil: [ "Attempt to avoid an error by recreating the underlying stream." client isConnected ifFalse: [ client close ] ]. attemptsLeft := 3. response := nil. [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [ response := [ aBlock value: client ] on: NetworkError do: [ :error | attemptsLeft = 0 ifTrue: [ error pass ]. (3 - attemptsLeft) seconds asDelay wait. attemptsLeft := attemptsLeft - 1. nil "The response" ] ]. result := (response code between: 200 and: 299) ifFalse: [ response content. "Make sure content is read." nil ] ifTrue: [ (RWBinaryOrTextStream with: ( response contentWithProgress: [ :total :amount | HTTPProgress new total: total; amount: amount; signal ])) reset ]. self class useSharedWebClientInstance ifTrue: [ "Save the WebClient instance for reuse, but only if there is no client cached." webClient ifNil: [ webClient := client ] ifNotNil: [ client close ] ] ifFalse: [ client close ]. + (response code = 404 "Not Found" or: [response code = 410 "Gone"]) ifTrue: [ + "Need to distinguish between lookup errors and connection errors. Lookup errors will be handled by some senders following the EAFP principle. See #versionNamed:." + (NotFound object: response url) signal ]. result ifNil: [ NetworkError signal: 'Could not access ', location ]. ^result! From lewis at mail.msen.com Fri May 7 22:22:18 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Fri, 7 May 2021 18:22:18 -0400 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> Message-ID: <20210507222218.GA18151@shell.msen.com> On Thu, May 06, 2021 at 04:33:55PM -0700, tim Rowledge wrote: > I was just about to say something about Chris'question and tried > > 2 raisedTo: 63 > > in a Workspace. I was a little surprised to see '0' returned. > > On my Mac 64 I get the right answer. On the Pi I get the right(ish) answer if I substitute 2.0. To make things weirder if I debug, the end value of 'result' in Number>>#raisedToInteger: is correct. The value of 'stack top' in its sender #raisedTo: is the same correct value. > > Gronk? It's clearly not a problem with printing the value since I see the correct value. If I try > (2 raisedTo: 63) / 64.0 > to check what number is actually there... I get 0. Implying there is really 0. Debug it and.. yup 0. What? It looks like somewhere the LPI instance is getting mishandled but where? > Whatever the issue turns out to be, we need to turn it into a unit test in trunk. It's a serious failure that is very easy to overlook. It only takes 8 passes through the look in Number>>raisedToInteger: to get to the solution, so you should be able to use a debugger to see where things are going wrong. Or print to Transcript and see where it fails. For example if I use this: Number>>raisedToInteger: anInteger "The 0 raisedToInteger: 0 is an special case. In some contexts must be 1 and in others must be handled as an indeterminate form. I take the first context because that's the way that was previously handled. Maybe further discussion is required on this topic." | bitProbe result | anInteger negative ifTrue: [^(self raisedToInteger: anInteger negated) reciprocal]. bitProbe := 1 bitShift: anInteger highBit - 1. result := self class one. [ Transcript showln: 'TOP LOOP ', result asString, ' BITPROBE ', bitProbe asString. (anInteger bitAnd: bitProbe) > 0 ifTrue: [ result := result * self ]. (bitProbe := bitProbe bitShift: -1) > 0 ] whileTrue: [ result := result squared . Transcript showln: 'INNER LOOP ', result asString]. ^result Then the (good) output on the Transcript is: TOP LOOP 1 BITPROBE 32 INNER LOOP 4 TOP LOOP 4 BITPROBE 16 INNER LOOP 64 TOP LOOP 64 BITPROBE 8 INNER LOOP 16384 TOP LOOP 16384 BITPROBE 4 INNER LOOP 1073741824 TOP LOOP 1073741824 BITPROBE 2 TOP LOOP 1 BITPROBE 8 INNER LOOP 100 TOP LOOP 100 BITPROBE 4 INNER LOOP 10000 TOP LOOP 10000 BITPROBE 2 INNER LOOP 100000000 TOP LOOP 100000000 BITPROBE 1 INNER LOOP 4611686018427387904 TOP LOOP 1 BITPROBE 8 INNER LOOP 100 TOP LOOP 100 BITPROBE 4 INNER LOOP 10000 TOP LOOP 10000 BITPROBE 2 INNER LOOP 100000000 TOP LOOP 100000000 BITPROBE 1 TOP LOOP 4611686018427387904 BITPROBE 1 If you run the same thing on the Pi VM, I expect you will see something quite different. Dave From vanessa at codefrau.net Fri May 7 22:25:13 2021 From: vanessa at codefrau.net (Vanessa Freudenberg) Date: Fri, 7 May 2021 15:25:13 -0700 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! In-Reply-To: References: Message-ID: Thank you all! Glad to see two new members on the board, welcome! And thanks to Chris and John Reed, it's been a pleasure serving with you 💜 –Vanessa– On Fri, May 7, 2021 at 12:24 PM Rein, Patrick wrote: > Hi Everyone, > > I'm very pleased to announce your Squeak Oversight Board for 2021. They > are: > > 1. Vanessa Freudenberg > 2. Tim Rowledge > 3. Craig Latta > 4. Marcel Taeumel > 5. David T. Lewis > 6. Tony Garnock-Jones > 7. Bruce O'Neel > > (The list already accounts for the withdrawal of Chris Muller.) > http://wiki.squeak.org/squeak/6656 > > I would like to thank everyone that served on the board last year! Thank > you for your contributions to Squeak! > > Thank you to everyone that ran this year and for everyone that voted! We > are looking forward to a great year in the Squeak community! > > Please help me to congratulate your new board for 2021!! > > All the best, > Patrick > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ron at usmedrec.com Fri May 7 23:15:31 2021 From: ron at usmedrec.com (Ron Teitelbaum) Date: Fri, 7 May 2021 19:15:31 -0400 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! In-Reply-To: References: Message-ID: Hi All, Well done Patrick! Congratulations to the board members old and new! Thank you very much for serving the community! A big thank you to each and everyone that voted!! Thank you for making your way through the process! One more note I'm looking for volunteers for the news team. It's been 3 years since we made any posts on http://news.squeak.org. The Weekly Squeak could use at least a post a week! Ok maybe one every two weeks. Anyone interested in helping on the news team? All the best, Ron Teitelbaum On Fri, May 7, 2021 at 6:25 PM Vanessa Freudenberg wrote: > Thank you all! > > Glad to see two new members on the board, welcome! And thanks to Chris and > John Reed, it's been a pleasure serving with you 💜 > > –Vanessa– > > On Fri, May 7, 2021 at 12:24 PM Rein, Patrick wrote: > >> Hi Everyone, >> >> I'm very pleased to announce your Squeak Oversight Board for 2021. They >> are: >> >> 1. Vanessa Freudenberg >> 2. Tim Rowledge >> 3. Craig Latta >> 4. Marcel Taeumel >> 5. David T. Lewis >> 6. Tony Garnock-Jones >> 7. Bruce O'Neel >> >> (The list already accounts for the withdrawal of Chris Muller.) >> http://wiki.squeak.org/squeak/6656 >> >> I would like to thank everyone that served on the board last year! Thank >> you for your contributions to Squeak! >> >> Thank you to everyone that ran this year and for everyone that voted! We >> are looking forward to a great year in the Squeak community! >> >> Please help me to congratulate your new board for 2021!! >> >> All the best, >> Patrick >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From leves at caesar.elte.hu Sat May 8 02:12:09 2021 From: leves at caesar.elte.hu (Levente Uzonyi) Date: Sat, 8 May 2021 04:12:09 +0200 (CEST) Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: , Message-ID: On Fri, 7 May 2021, Thiede, Christoph wrote: > > Hi Levente, > > > thanks for the pointer. As far I can see from the linked discussion, Tobias' proposal has never been rejected but only postponed due to the upcoming release. I also see your point of performance, but IMHO correctness is more > important than performance. If necessary, we could still hard-code the relevant code points into #isSeparator. > > > > - consistency: CharacterSet separators would differ from the rest with your change set. > > > Fair point, but I think we should instead fix the definitions of Character(Set) constants to respect the encoding as well ... By the way, Character alphabet and Character allCharacters also don't do this at the moment. > > Of course, all your concerns are valid points and need to be discussed, but I would be sorry if we failed to - finally - establish current standards in our Character library. I doubt that any modern parser for JSON or > whatever would treat Unicode space characters incorrectly, and still, they are satisfyingly fast. I think we should be able to keep pace with them in Squeak as well. :-) Well, you ignored my question "What is a separator?". IMO a separator is a whitespace that separates tokens in the source code. Would you like to use zero-width space as a separator? Not likely. #isSeparator is deeply buried into the system. Changing it would mean changing other code your changeset doesn't touch, e.g. the parsers. The method you propose is welcome, but IMO it shouldn't be called #isSeparator. #isWhitespace is a much better fit. Levente > > Best, > Christoph > > _________________________________________________________________________________________________________________________________________________________________________________________________________________________________ > Von: Squeak-dev im Auftrag von Levente Uzonyi > Gesendet: Freitag, 7. Mai 2021 22:01:18 > An: The general-purpose Squeak developers list > Betreff: Re: [squeak-dev] [ENH] isSeparator   > Hi Christoph, > > There was a discussion on this subject before: > http://forum.world.st/The-Trunk-Collections-topa-806-mcz-td5084658.html > Main concerns are > - definition: What is a separator? > - consistency: CharacterSet separators would differ from the rest with > your change set. > - performance: I haven't measured it, but I wouldn't be surprised if > #isSeparator would become a magnitude slower with that implementation. > > > Levente > > On Thu, 6 May 2021, christoph.thiede at student.hpi.uni-potsdam.de wrote: > > > Hi all, > > > > here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be > identified correctly now, too. > > > > Please review and merge! :-) > > > > Best, > > Christoph > > > > ["isSeparator.cs.gz"] > > > From edgardec2005 at gmail.com Sat May 8 11:16:37 2021 From: edgardec2005 at gmail.com (Edgar J. De Cleene) Date: Sat, 08 May 2021 08:16:37 -0300 Subject: [squeak-dev] Squeak Oversight Board Election 2021 - Results! In-Reply-To: Message-ID: Sorry miss this Welcome new members. Thanks old members. I¹ retired of FRRO now and staying home as only have first dosis of Sputnik V (lucky me living in the most dangerous city of Argentina). Continue learning WASM , waiting a Squeak version which could run almost anywhere. If any wish direct chat, here the discord link https://discord.gg/hgSk8NU5. Stay safe Edgar @morplenauta in tweeter -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Sat May 8 17:22:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 8 May 2021 17:22:01 0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1770.mcz Message-ID: A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1770.mcz ==================== Summary ==================== Name: Morphic-ct.1770 Author: ct Time: 8 May 2021, 7:21:55.77561 pm UUID: 7a38a5a2-11a9-8748-ba2f-e0905097cc81 Ancestors: Morphic-mt.1767 Proposal: When attaching multiple morphs to the hand, position them with a small convergent distance in order to improve their visibility. In this way, the user realizes that there have been opened multiple morphs, but plenty opened morphs don't run the risk of leaving the screen. https://www.wolframalpha.com/input/?i=lim+n-%3Einf+100%281-exp%28-n%2F2%29%29 Note that, in general, I would consider attaching multiple morphs to the hand an anti-pattern from the UX perspective. Nevertheless, there are some situations where we already do this at the moment, for instance when browsing an ambivalent identifier conventionally (i.e. with the #alternativeBrowseIt preference being disabed). =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: HandMorph>>attachMorph: (in category 'grabbing/dropping') ----- + attachMorph: aMorph - attachMorph: m "Position the center of the given morph under this hand, then grab it. This method is used to grab far away or newly created morphs." + | delta | self releaseMouseFocus. "Break focus" self showTemporaryCursor: nil. + delta := aMorph bounds extent // 2. + aMorph + position: self position - delta + (self offsetForNextAttachee: aMorph); + formerPosition: aMorph position. + targetOffset := aMorph position - self position. + self addMorphBack: aMorph.! - delta := m bounds extent // 2. - m position: (self position - delta). - m formerPosition: m position. - targetOffset := m position - self position. - self addMorphBack: m.! Item was added: + ----- Method: HandMorph>>offsetForNextAttachee: (in category 'grabbing/dropping') ----- + offsetForNextAttachee: aMorph + ^ 100 asPoint * (1 - (self submorphCount negated / 2) exp)! From commits at source.squeak.org Sat May 8 17:58:34 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 8 May 2021 17:58:34 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.31.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.31.mcz ==================== Summary ==================== Name: FFI-Tests-mt.31 Author: mt Time: 8 May 2021, 7:58:33.518404 pm UUID: 7593fdcc-becc-bc4c-99f6-2387234347c2 Ancestors: FFI-Tests-mt.30 Adds test for a linked list in external memory. =============== Diff against FFI-Tests-mt.30 =============== Item was added: + ----- Method: ExternalStructureTests>>test03LinkedList (in category 'tests - external structure') ----- + test03LinkedList + + | link1 link2 link3 | + [ link1 := FFITestLink allocateExternal. + link2 := FFITestLink allocateExternal. + link3 := FFITestLink allocateExternal. + link1 next: link2. link2 prev: link1. + link2 next: link3. link3 prev: link2. + link3 next: link1. link1 prev: link3. + self assert: link1 next = link2. + self assert: link2 next = link3. + self assert: link3 next = link1. + + self assert: link3 prev = link2. + self assert: link2 prev = link1. + self assert: link1 prev = link3. + + ] ensure: [ + link1 free. + link2 free. + link3 free. + ]! Item was added: + ExternalStructure subclass: #FFITestLink + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestLink class>>fields (in category 'field definition') ----- + fields + " + self defineFields. + " + ^ #( + (prev 'FFITestLink*') + (next 'FFITestLink*') + )! Item was added: + ----- Method: FFITestLink>>= (in category 'comparing') ----- + = other + + (other isKindOf: ExternalStructure) ifFalse: [^ false]. + self externalType = other externalType ifFalse: [^ false]. + ^ other getHandle = self getHandle! Item was added: + ----- Method: FFITestLink>>hash (in category 'comparing') ----- + hash + + ^ ExternalObject hash bitXor: self getHandle hash! From christoph.thiede at student.hpi.uni-potsdam.de Sat May 8 19:01:26 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 8 May 2021 14:01:26 -0500 (CDT) Subject: [squeak-dev] The Inbox: Collections-ct.922.mcz In-Reply-To: References: <1546F06A-06F9-417C-8B80-207ED8C344C5@rowledge.org> <69591d44085842ada63aeacac94b5479@student.hpi.uni-potsdam.de> <2d10cac3607f417aa91c065be3669304@student.hpi.uni-potsdam.de> Message-ID: <1620500486934-0.post@n4.nabble.com> Hi all, what is the current state of this proposal? I would love to see this in the Trunk - I'd also be fine with Marcel's optimization from above. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From leves at caesar.elte.hu Sat May 8 21:30:52 2021 From: leves at caesar.elte.hu (Levente Uzonyi) Date: Sat, 8 May 2021 23:30:52 +0200 (CEST) Subject: [squeak-dev] The Inbox: Collections-ct.922.mcz In-Reply-To: <1620500486934-0.post@n4.nabble.com> References: <1546F06A-06F9-417C-8B80-207ED8C344C5@rowledge.org> <69591d44085842ada63aeacac94b5479@student.hpi.uni-potsdam.de> <2d10cac3607f417aa91c065be3669304@student.hpi.uni-potsdam.de> <1620500486934-0.post@n4.nabble.com> Message-ID: Hi Christoph, On Sat, 8 May 2021, Christoph Thiede wrote: > Hi all, > > what is the current state of this proposal? I would love to see this in the > Trunk - I'd also be fine with Marcel's optimization from above. :-) My assumption would be that such method restores the original state once the block has been evaluated. But that's not always the case. Can you explain the logic behind it? (Comments and test cases would probably be helpful there.) Levente From tim at rowledge.org Sat May 8 22:25:35 2021 From: tim at rowledge.org (tim Rowledge) Date: Sat, 8 May 2021 15:25:35 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <20210507222218.GA18151@shell.msen.com> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> Message-ID: <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> I had to modify Dave's code smidge because #raisedTo: etc get used in the printing of the results of theTranscript>showln: used in ... #raisedToInteger:, which confused things a smidge. So, renamed to #testRaisedToInteger: - On Mac 64bit TOP LOOP 1 BITPROBE 32 INNER LOOP 4 TOP LOOP 4 BITPROBE 16 INNER LOOP 64 TOP LOOP 64 BITPROBE 8 INNER LOOP 16384 TOP LOOP 16384 BITPROBE 4 INNER LOOP 1073741824 TOP LOOP 1073741824 BITPROBE 2 INNER LOOP 4611686018427387904 TOP LOOP 4611686018427387904 BITPROBE 1 On Pi4 64bit TOP LOOP 1 BITPROBE 32 INNER LOOP 4 TOP LOOP 4 BITPROBE 16 INNER LOOP 64 TOP LOOP 64 BITPROBE 8 INNER LOOP 16384 TOP LOOP 16384 BITPROBE 4 INNER LOOP 1073741824 TOP LOOP 1073741824 BITPROBE 2 INNER LOOP 0 TOP LOOP 0 BITPROBE 1 What we then see is that the Integer>>#digitMultiply:neg: primitive is failing; commenting out the prim gets us the correct answer. However, to make like that bit more amusing, `SmallInteger maxVal squared` gives the same answer on both systems (with the prim enabled on Pi 4) so it isn't simply that the largeint plugin is broken overall. If I try 16r80000000 squared I *usually* get 0 but once or twice get 4611686018427387904, so clearly something odd is going on. Given that this appears to be platform specific I have to start suspecting something in the ARM64 trampoline code. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Useful random insult:- A one-bit brain with a parity error. From commits at source.squeak.org Sun May 9 01:54:40 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 9 May 2021 01:54:40 0000 Subject: [squeak-dev] The Inbox: KernelTests-ct.405.mcz Message-ID: A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-ct.405.mcz ==================== Summary ==================== Name: KernelTests-ct.405 Author: ct Time: 9 May 2021, 3:54:39.03261 am UUID: 0504450e-33b8-1148-bd08-8f013c07a926 Ancestors: KernelTests-nice.404 Documents a bug in the simulation of objects as methods (OaM) when the object implements #isCompiledMethod, e.g. via dynamic forwarding. This is actually the case for TestCoverage and for that reason, debugging of SUnit test coverage collection is broken at the moment. =============== Diff against KernelTests-nice.404 =============== Item was added: + ----- Method: ContextTest>>testObjectsAsMethod (in category 'tests') ----- + testObjectsAsMethod + + | result error | + SystemChangeNotifier uniqueInstance doSilently: [ + self class addSelector: #foo withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod)]. + + result := Context runSimulated: [[self foo] on: Error do: [:ex | error := ex]]. + error ifNotNil: [self fail: error]. + + [self assert: self foo equals: result] + ensure: [self class removeSelector: #foo].! Item was added: + ProtoObject subclass: #TestObjectForMethod + instanceVariableNames: 'method' + classVariableNames: '' + poolDictionaries: '' + category: 'KernelTests-Methods'! Item was added: + ----- Method: TestObjectForMethod>>doesNotUnderstand: (in category 'dynamic forwarding') ----- + doesNotUnderstand: aMessage + + ^ aMessage sendTo: method! Item was added: + ----- Method: TestObjectForMethod>>flushCache (in category 'compatibility') ----- + flushCache + ^ self! Item was added: + ----- Method: TestObjectForMethod>>methodClass: (in category 'compatibility') ----- + methodClass: aMethodClass! Item was added: + ----- Method: TestObjectForMethod>>run:with:in: (in category 'evaluating') ----- + run: oldSelector with: arguments in: receiver + ^ {oldSelector. arguments. receiver}! Item was added: + ----- Method: TestObjectForMethod>>selector: (in category 'compatibility') ----- + selector: aSymbol! Item was added: + ----- Method: TestObjectForMethod>>xxxMethod: (in category 'accessing') ----- + xxxMethod: aCompiledMethod + + method := aCompiledMethod! From commits at source.squeak.org Sun May 9 01:56:35 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 9 May 2021 01:56:35 0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1403.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1403.mcz ==================== Summary ==================== Name: Kernel-ct.1403 Author: ct Time: 9 May 2021, 3:56:31.99261 am UUID: 9eab7066-e3ce-1a4e-814c-8bf9403a0ea2 Ancestors: Kernel-nice.1402 Fixes a bug in the simulation of objects as methods (OaM) when the object implements #isCompiledMethod, e.g. via dynamic forwarding. We always must use mirror primitives to match the behavior of the VM. Regression test and further explanation are in KernelTests-ct.405. =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') ----- send: selector to: rcvr with: arguments lookupIn: lookupClass "Simulate the action of sending a message with selector and arguments to rcvr. The argument, lookupClass, is the class in which to lookup the message. This is the receiver's class for normal messages, but for super messages it will be some specific class related to the source method." + | meth methClass primIndex val ctxt | - | meth primIndex val ctxt | (meth := lookupClass lookupSelector: selector) ifNil: [selector == #doesNotUnderstand: ifTrue: [self error: 'Recursive message not understood!!' translated]. ^self send: #doesNotUnderstand: to: rcvr with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass} lookupIn: lookupClass]. + ((methClass := self objectClass: meth) == CompiledMethod or: [methClass == CompiledBlock]) ifFalse: - meth isCompiledMethod ifFalse: ["Object as Methods (OaM) protocol: 'The contract is that, when the VM encounters an ordinary object (rather than a compiled method) in the method dictionary during lookup, it sends it the special selector #run:with:in: providing the original selector, arguments, and receiver.'. DOI: 10.1145/2991041.2991062." ^self send: #run:with:in: to: meth with: {selector. arguments. rcvr}]. meth numArgs = arguments size ifFalse: [^ self error: ('Wrong number of arguments in simulated message {1}' translated format: {selector})]. (primIndex := meth primitive) > 0 ifTrue: [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. (self isPrimFailToken: val) ifFalse: [^val]]. (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: [^self error: ('Simulated message {1} not understood' translated format: {arguments first selector})]. ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments. (primIndex isInteger and: [primIndex > 0]) ifTrue: [ctxt failPrimitiveWith: val]. ^ctxt! From edgardec2005 at gmail.com Sun May 9 09:34:07 2021 From: edgardec2005 at gmail.com (Edgar J. De Cleene) Date: Sun, 09 May 2021 06:34:07 -0300 Subject: [squeak-dev] VM for upgrade 5.3 Message-ID: Just download Squeak5.3rc3-19428-64bit.image and when try to update have this. This virtual machine is too old to support correct versions of the FloatArray>>at:[put:] primitives 238 and 239. FloatArray subclasses will not behave correctly and FloatArray[64]Test tests will fail. Please upgrade your VM. You may continue and upgrade later or abort and upgrade now. Like know where is the correct VM. In https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/tag/202003021730 Exist many, so which is for macOS BigSur ? Many thanks in advance Edgar (bike keeper of Ferrari F1 team) @morplenauta From lewis at mail.msen.com Sun May 9 14:31:52 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Sun, 9 May 2021 10:31:52 -0400 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> Message-ID: <20210509143152.GA91791@shell.msen.com> On Sat, May 08, 2021 at 03:25:35PM -0700, tim Rowledge wrote: > I had to modify Dave's code smidge because #raisedTo: etc get used in the printing of the results of theTranscript>showln: used in ... #raisedToInteger:, which confused things a smidge. > > So, renamed to #testRaisedToInteger: - > > On Mac 64bit > TOP LOOP 1 BITPROBE 32 > INNER LOOP 4 > TOP LOOP 4 BITPROBE 16 > INNER LOOP 64 > TOP LOOP 64 BITPROBE 8 > INNER LOOP 16384 > TOP LOOP 16384 BITPROBE 4 > INNER LOOP 1073741824 > TOP LOOP 1073741824 BITPROBE 2 > INNER LOOP 4611686018427387904 > TOP LOOP 4611686018427387904 BITPROBE 1 > > On Pi4 64bit > > TOP LOOP 1 BITPROBE 32 > INNER LOOP 4 > TOP LOOP 4 BITPROBE 16 > INNER LOOP 64 > TOP LOOP 64 BITPROBE 8 > INNER LOOP 16384 > TOP LOOP 16384 BITPROBE 4 > INNER LOOP 1073741824 > TOP LOOP 1073741824 BITPROBE 2 > INNER LOOP 0 > TOP LOOP 0 BITPROBE 1 > > What we then see is that the Integer>>#digitMultiply:neg: primitive is failing; commenting out the prim gets us the correct answer. > > However, to make like that bit more amusing, > `SmallInteger maxVal squared` > gives the same answer on both systems (with the prim enabled on Pi 4) so it isn't simply that the largeint plugin is broken overall. > If I try 16r80000000 squared I *usually* get 0 but once or twice get 4611686018427387904, so clearly something odd is going on. Given that this appears to be platform specific I have to start suspecting something in the ARM64 trampoline code. > If the primitive is failing for 16r80000000 squared, then I wonder if we may be looking at a signed/unsigned arithmetic problem somewhere in the plugin. 16r80000000 asRegister ==> a TwosComplementRegister with value -2147483648 (10000000000000000000000000000000) You are running a 32-bit VM on Pi, right? If so, then perhaps the same failure is happening on other 32-bit VMs but nobody noticed it until now? Dave From bruce.oneel at pckswarms.ch Sun May 9 14:56:44 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Sun, 09 May 2021 16:56:44 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <20210509143152.GA91791@shell.msen.com> References: <20210509143152.GA91791@shell.msen.com> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> Message-ID: <1620572204-2db12ce0081d7ba515caf71a090164ee@pckswarms.ch> Hi, Tim seems to be using a 64 bit VM on the Pi 4. I do not see it on 32 bit VMs on a Pi 3 nor on a Pi 400, so the same hardware.  I do see it on a Arm64 system though. So it seems, for once, not to be a 32 bit system problem and does seem to be just Arm64. cheers bruce > On Sat, May 08, 2021 at 03:25:35PM -0700, tim Rowledge wrote: > > I had to modify Dave's code smidge because #raisedTo: etc get used in the printing of the results of theTranscript>showln: used in ... #raisedToInteger:, which confused things a smidge. > > > > So, renamed to #testRaisedToInteger: - > > > > On Mac 64bit > > TOP LOOP 1 BITPROBE 32 > > INNER LOOP 4 > > TOP LOOP 4 BITPROBE 16 > > INNER LOOP 64 > > TOP LOOP 64 BITPROBE 8 > > INNER LOOP 16384 > > TOP LOOP 16384 BITPROBE 4 > > INNER LOOP 1073741824 > > TOP LOOP 1073741824 BITPROBE 2 > > INNER LOOP 4611686018427387904 > > TOP LOOP 4611686018427387904 BITPROBE 1 > > > > On Pi4 64bit > > > > TOP LOOP 1 BITPROBE 32 > > INNER LOOP 4 > > TOP LOOP 4 BITPROBE 16 > > INNER LOOP 64 > > TOP LOOP 64 BITPROBE 8 > > INNER LOOP 16384 > > TOP LOOP 16384 BITPROBE 4 > > INNER LOOP 1073741824 > > TOP LOOP 1073741824 BITPROBE 2 > > INNER LOOP 0 > > TOP LOOP 0 BITPROBE 1 > > > > What we then see is that the Integer>>#digitMultiply:neg: primitive is failing; commenting out the prim gets us the correct answer. > > > > However, to make like that bit more amusing, > > `SmallInteger maxVal squared` > > gives the same answer on both systems (with the prim enabled on Pi 4) so it isn't simply that the largeint plugin is broken overall. > > If I try 16r80000000 squared I *usually* get 0 but once or twice get 4611686018427387904, so clearly something odd is going on. Given that this appears to be platform specific I have to start suspecting something in the ARM64 trampoline code. > > > > > If the primitive is failing for 16r80000000 squared, then I wonder if we > may be looking at a signed/unsigned arithmetic problem somewhere in the > plugin. > > 16r80000000 asRegister ==> a TwosComplementRegister with value -2147483648 (10000000000000000000000000000000) > > You are running a 32-bit VM on Pi, right? If so, then perhaps the > same failure is happening on other 32-bit VMs but nobody noticed it > until now? > > Dave -------------- next part -------------- An HTML attachment was scrubbed... URL: From lewis at mail.msen.com Sun May 9 15:07:30 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Sun, 9 May 2021 11:07:30 -0400 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <1620572204-2db12ce0081d7ba515caf71a090164ee@pckswarms.ch> References: <20210509143152.GA91791@shell.msen.com> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <1620572204-2db12ce0081d7ba515caf71a090164ee@pckswarms.ch> Message-ID: <20210509150730.GA96007@shell.msen.com> youtube.com/watch?v=OjYoNL4g5Vg Dave On Sun, May 09, 2021 at 04:56:44PM +0200, Bruce O'Neel wrote: > > > Hi, > > Tim seems to be using a 64 bit VM on the Pi 4. I do not see it on 32 bit VMs on a Pi 3 nor on a Pi 400, so the same hardware. ??I do see it on a Arm64 system though. > > So it seems, for once, not to be a 32 bit system problem and does seem to be just Arm64. > > cheers > > bruce > > > > > On Sat, May 08, 2021 at 03:25:35PM -0700, tim Rowledge wrote: > > > I had to modify Dave's code smidge because #raisedTo: etc get used in the printing of the results of theTranscript>showln: used in ... #raisedToInteger:, which confused things a smidge. > > > > > > So, renamed to #testRaisedToInteger: - > > > > > > On Mac 64bit > > > TOP LOOP 1 BITPROBE 32 > > > INNER LOOP 4 > > > TOP LOOP 4 BITPROBE 16 > > > INNER LOOP 64 > > > TOP LOOP 64 BITPROBE 8 > > > INNER LOOP 16384 > > > TOP LOOP 16384 BITPROBE 4 > > > INNER LOOP 1073741824 > > > TOP LOOP 1073741824 BITPROBE 2 > > > INNER LOOP 4611686018427387904 > > > TOP LOOP 4611686018427387904 BITPROBE 1 > > > > > > On Pi4 64bit > > > > > > TOP LOOP 1 BITPROBE 32 > > > INNER LOOP 4 > > > TOP LOOP 4 BITPROBE 16 > > > INNER LOOP 64 > > > TOP LOOP 64 BITPROBE 8 > > > INNER LOOP 16384 > > > TOP LOOP 16384 BITPROBE 4 > > > INNER LOOP 1073741824 > > > TOP LOOP 1073741824 BITPROBE 2 > > > INNER LOOP 0 > > > TOP LOOP 0 BITPROBE 1 > > > > > > What we then see is that the Integer>>#digitMultiply:neg: primitive is failing; commenting out the prim gets us the correct answer. > > > > > > However, to make like that bit more amusing, > > > `SmallInteger maxVal squared` > > > gives the same answer on both systems (with the prim enabled on Pi 4) so it isn't simply that the largeint plugin is broken overall. > > > If I try 16r80000000 squared I *usually* get 0 but once or twice get 4611686018427387904, so clearly something odd is going on. Given that this appears to be platform specific I have to start suspecting something in the ARM64 trampoline code. > > > > > > > > > If the primitive is failing for 16r80000000 squared, then I wonder if we > > may be looking at a signed/unsigned arithmetic problem somewhere in the > > plugin. > > > > 16r80000000 asRegister ==> a TwosComplementRegister with value -2147483648 (10000000000000000000000000000000) > > > > You are running a 32-bit VM on Pi, right? If so, then perhaps the > > same failure is happening on other 32-bit VMs but nobody noticed it > > until now? > > > > Dave > > > From tim at rowledge.org Sun May 9 17:56:47 2021 From: tim at rowledge.org (tim Rowledge) Date: Sun, 9 May 2021 10:56:47 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <20210509143152.GA91791@shell.msen.com> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> Message-ID: <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> > On 2021-05-09, at 7:31 AM, David T. Lewis wrote: > > If the primitive is failing for 16r80000000 squared, then I wonder if we > may be looking at a signed/unsigned arithmetic problem somewhere in the > plugin. Ah, but that is the extra-weird bit. It *sometimes* gives the right answer. The only thing I can think of that could explain that & that might be ARM64 code specific is something to do with the address of the LPI, which obviously is sometihng that varies with each test. If there is some code expecting base addresses to always match some requirement and that is not always being met, subsequent code might be reading the wrong values. Another possibility is that the compiled result of the LI plugin has a bug; it's not like C compilers never get it wrong. Another possibility must be that I screwed up somewhere and the 'correct' result I saw was not actually with the prim enabled - but I'm fairly sure I did that in a different image anyway. Grr. And now I do more testing, and I haven't yet got the right answer again for 16r80000000 squared. 16r80000001 squared always seems to be ok. 16r[9ABCDEF]0000000 squared always seems to be ok. And 16r[7654321]0000000 squared always seems to be right. Also 16r40000000 squared * 4 seems always ok. So we're rather pointed to some peculiarity of the 16r80000000 bit-pattern? My brian hurts. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: SG: Show Garbage From christoph.thiede at student.hpi.uni-potsdam.de Sun May 9 19:02:15 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sun, 9 May 2021 14:02:15 -0500 (CDT) Subject: [squeak-dev] SimulationSideEffectWarning (was: The Trunk: Kernel-nice.1386.mcz) In-Reply-To: <1619976630055-0.post@n4.nabble.com> References: <1618578607101-0.post@n4.nabble.com> <1618578968761-0.post@n4.nabble.com> <5c6fa64b87f04f4b8f6d2332255d5859@student.hpi.uni-potsdam.de> <1619976630055-0.post@n4.nabble.com> Message-ID: <1620586935425-0.post@n4.nabble.com> Hi all! After rethinking the case again, here is my proposed solution (please find it in the attachment). SimulationSideEffectWarning.cs In a nutshell, I decided on a strict separation between the different causes for a side effect warning since control primitives and simulation guards actually reside on different levels of abstraction. They only have in common that the user of the simulator should maybe know about them. The detailed changelog is in the postscript of the changelog, here is a copy: SimulationSideEffectWarning.cs wrote > - Replace generic Warning in Context >> #doPrimitive:method:receiver:args: > by specific warning of new class SimulationSideEffectWarning. > - Also signal SimulationSideEffectWarning if primitive 87 > (primitiveResume) is hit. > - SimulationSideEffectWarning contains logic to detect the type > (simulation guard/control primitive) of the side effect. It can also be > suppressed or unsuppressed along the handler chain using the '*suppress*' > selectors. Control primitive side effects are suppressed by default. > - Add tests for the changes above. > - In the debugger, unsuppress control primitive warnings. > - Replace definitions of primitive 19 (currently only in ControlManager) > with a named alias pragma, > > , which is implemented on Parser. > > For more information, see: > http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html > > > (* Sorry, this should be in the preamble, not in the postscript, I know, > but the preamble editor in the ChangeSorter is currently broken. > ¯\_(ツ)_/¯) Please let us know how I can improve it or just merge it directly! :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Sun May 9 19:17:06 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sun, 9 May 2021 14:17:06 -0500 (CDT) Subject: [squeak-dev] SimulationSideEffectWarning (was: The Trunk: Kernel-nice.1386.mcz) In-Reply-To: <1620586935425-0.post@n4.nabble.com> References: <1618578607101-0.post@n4.nabble.com> <1618578968761-0.post@n4.nabble.com> <5c6fa64b87f04f4b8f6d2332255d5859@student.hpi.uni-potsdam.de> <1619976630055-0.post@n4.nabble.com> <1620586935425-0.post@n4.nabble.com> Message-ID: <1620587826575-0.post@n4.nabble.com> It is extremely confusing that Nabble strips of the revision number of the changeset upon upload. :-) --- Community service, here is the inlined diff: "Change Set:        SimulationSideEffectWarning Date:            9 May 2021 Author:            Christoph Thiede <your descriptive text goes here>" Warning subclass: #SimulationSideEffectWarning     instanceVariableNames: 'primitiveIndex sender suppressed'     classVariableNames: ''     poolDictionaries: ''     category: 'Kernel-Exceptions' I am signaled to notify the client of a simulation operation (i.e., a sender of Context) about potential side effects that might occur when resuming the simulation. See Context >> #doPrimitive:method:receiver:args:, #messageText, and Parser >> #simulationGuard for more information. doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments     "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and      arguments are given as arguments to this message. If successful, push result and return      resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes      execution needs to be intercepted and simulated to avoid execution running away."     | value |     "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents      the debugger from entering various run-away activities such as spawning a new      process, etc. Injudicious use results in the debugger not being able to debug      interesting code, such as the debugger itself. Hence use primitive 19 with care :-)"     "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"     primitiveIndex = 19 ifTrue: [         [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]             ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].     *"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation."     "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]"     (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [         [SimulationSideEffectWarning signalForPrimitive: primitiveIndex sender: self]             ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].*          ((primitiveIndex between: 201 and: 222)      and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:         [(primitiveIndex = 206          or: [primitiveIndex = 208]) ifTrue:                        "[Full]BlockClosure>>valueWithArguments:"             [^receiver simulateValueWithArguments: arguments first caller: self].          ((primitiveIndex between: 201 and: 209)             "[Full]BlockClosure>>value[:value:...]"          or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]"             [^receiver simulateValueWithArguments: arguments caller: self]].     primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"         [| selector |         selector := arguments at: 1 ifAbsent:             [^ self class primitiveFailTokenFor: #'bad argument'].         arguments size - 1 = selector numArgs ifFalse:             [^ self class primitiveFailTokenFor: #'bad number of arguments'].         ^self send: selector to: receiver with: arguments allButFirst].     primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"         [| selector args |         arguments size = 2 ifFalse:             [^ self class primitiveFailTokenFor: #'bad argument'].         selector := arguments first.         args := arguments second.         args isArray ifFalse:             [^ self class primitiveFailTokenFor: #'bad argument'].         args size = selector numArgs ifFalse:             [^ self class primitiveFailTokenFor: #'bad number of arguments'].         ^self send: selector to: receiver with: args].     primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"         [| rcvr selector args superclass |         arguments size             caseOf: {                 [3] -> [                     rcvr := receiver.                     selector := arguments first.                     args := arguments second.                     superclass := arguments third].                 [4] -> ["mirror primitive"                     rcvr := arguments first.                     selector := arguments second.                     args := arguments third.                     superclass := arguments fourth] }             otherwise: [^ self class primitiveFailTokenFor: #'bad argument'].         args isArray ifFalse:             [^ self class primitiveFailTokenFor: #'bad argument'].         args size = selector numArgs ifFalse:             [^ self class primitiveFailTokenFor: #'bad number of arguments'].         ((self objectClass: rcvr) includesBehavior: superclass) ifFalse:             [^ self class primitiveFailTokenFor: #'bad argument'].         ^self send: selector to: rcvr with: args lookupIn: superclass].     "Mutex>>primitiveEnterCriticalSection      Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"     (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:         [| effective |          effective := Processor activeProcess effectiveProcess.          "active == effective"          value := primitiveIndex = 186                     ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]                     ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].          ^(self isPrimFailToken: value)             ifTrue: [value]             ifFalse: [self push: value]].     primitiveIndex = 188 ifTrue:    "Object>>withArgs:executeMethod:                                     CompiledMethod class>>receiver:withArguments:executeMethod:                                     VMMirror>>ifFail:object:with:executeMethod: et al"         [| n args methodArg thisReceiver |          ((n := arguments size) between: 2 and: 4) ifFalse:             [^self class primitiveFailTokenFor: #'unsupported operation'].          ((self objectClass: (args := arguments at: n - 1)) == Array          and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse:             [^self class primitiveFailTokenFor: #'bad argument'].          methodArg numArgs = args size ifFalse:             [^self class primitiveFailTokenFor: #'bad number of arguments'].          thisReceiver := arguments at: n - 2 ifAbsent: [receiver].          methodArg primitive > 0 ifTrue:             [methodArg isQuick ifTrue:                 [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)].              ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args].          ^Context             sender: self             receiver: thisReceiver             method: methodArg             arguments: args].     primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM"         [(arguments size = 3          and: [(self objectClass: arguments second) == SmallInteger          and: [(self objectClass: arguments last) == Array]]) ifTrue:             [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last].          (arguments size = 2          and: [(self objectClass: arguments first) == SmallInteger          and: [(self objectClass: arguments last) == Array]]) ifFalse:             [^self class primitiveFailTokenFor: nil].          ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].     value := primitiveIndex = 120 "FFI method"                 ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]                 ifFalse:                     [primitiveIndex = 117 "named primitives"                         ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]                         ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)"                             [receiver tryPrimitive: primitiveIndex withArgs: arguments]].     ^(self isPrimFailToken: value)         ifTrue: [value]         ifFalse: [self push: value] invokeSimulationGuard     <simulationGuard>     "Nothing to see here, please move along!"     ^ 42 testSimulationSideEffectWarningControl     | warning |     [Context runSimulated: [[] fork]] on: SimulationSideEffectWarning do: [:ex |         warning := ex].          self assert: warning notNil.     self assert: warning isControlPrimitive.     self assert: warning suppressed. testSimulationSideEffectWarningGuard     | warning |     [Context runSimulated: [self invokeSimulationGuard]] on: SimulationSideEffectWarning do: [:ex |         warning := ex].          self assert: warning notNil.     self assert: warning isSimulationGuard.     self deny: warning suppressed. testSimulationSideEffectWarningSuppress     self         shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext)             suppress;             defaultAction] raise: UnhandledWarning;         should: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext)             unsuppress;             defaultAction] raise: UnhandledWarning. activeController: aController     "Set aController to be the currently active controller. Give the user     control in it."     <primitive: 19> "Simulation guard"     *"Set aController to be the currently active controller. Give the user control in it."     <simulationGuard>*     activeController := aController.     (activeController == screenController)         ifFalse: [self promote: activeController].     activeControllerProcess :=             [activeController startUp.             self searchForActiveController] newProcess.     activeControllerProcess priority: Processor userSchedulingPriority.     activeControllerProcess resume scheduleActive: aController     "Make aController be scheduled as the active controller. Presumably the     active scheduling process asked to schedule this controller and that a     new process associated this controller takes control. So this is the last act     of the active scheduling process."     <primitive: 19> "Simulation guard"     *"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process."     <simulationGuard>*     self scheduleActiveNoTerminate: aController.     Processor terminateActive handleLabelUpdatesIn: aBlock whenExecuting: aContext     "Send the selected message in the accessed method, and regain control     after the invoked method returns."          ^aBlock         on: Notification         do: [:ex|             (ex tag isArray              and: [ex tag size = 2              and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]])                 ifTrue:                     [self labelString: ex tag second description.                      ex resume]                 ifFalse:                     [ex pass]]                     *[ex pass]]         on: SimulationSideEffectWarning         do: [:ex |             ex isControlPrimitive ifTrue: [ex unsuppress].             ex pass]* simulationGuard     "primitive 19 is a null primitive that always fails. Just a marker for the simulator."     <pragmaParser>     self addPragma: (Pragma keyword: #primitive: arguments: #(19)).          self advance.     ^ true isControlPrimitive     "See StackInterpreter class>>#initializePrimitiveTable."     ^ self primitive between: 80 and: 89 isSimulationGuard     "See Parser >> #simulationGuard."     ^ self primitive = 19 primitive     ^ primitiveIndex sender     ^ sender suppress     suppressed := true. suppressed     ^ suppressed ifNil: [self isSimulationGuard not] unsuppress     suppressed := false. primitive: anInteger sender: senderContext     primitiveIndex := anInteger.     sender := senderContext. messageText     ^ messageText ifNil: [         'The code being simulated is trying to control a process ({1}). {2}' translated format: {             self sender method reference.             self isSimulationGuard                 ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated]                 ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}] defaultAction     ^ self suppressed ifFalse: [super defaultAction] forPrimitive: primitiveIndex sender: senderContext     ^ self new primitive: primitiveIndex sender: senderContext signalForPrimitive: primitiveIndex sender: senderContext     ^ (self forPrimitive: primitiveIndex sender: senderContext) signal ('instance creation' forPrimitive:sender:) ('signaling' signalForPrimitive:sender:) ('testing' isControlPrimitive isSimulationGuard) ('accessing' primitive sender suppress suppressed unsuppress) ('initialize-release' primitive:sender:) ('printing' messageText) ('priv handling' defaultAction) "Postscript: CHANGELOG*: - Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning. - Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit. - SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default. - Add tests for the changes above. - In the debugger, unsuppress control primitive warnings. - Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser. For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html (* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¬Ø\_(?)_/¬Ø) " ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From vanessa at codefrau.net Mon May 10 03:07:18 2021 From: vanessa at codefrau.net (Vanessa Freudenberg) Date: Sun, 9 May 2021 20:07:18 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> Message-ID: On Sun, May 9, 2021 at 10:57 tim Rowledge wrote: > > So we're rather pointed to some peculiarity of the 16r80000000 > bit-pattern? My brian hurts. That is a very peculiar bit pattern indeed, in that it is exactly where signed arithmetic wraps around. So signed/unsigned or < vs <= or a combination thereof perhaps? If you want some *real* fun step through it under gdb 😬 –Vanessa– > -------------- next part -------------- An HTML attachment was scrubbed... URL: From bruce.oneel at pckswarms.ch Mon May 10 10:54:56 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Mon, 10 May 2021 12:54:56 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> References: <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> Message-ID: <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> Hi, So, um, kind of good news but maybe not. So I built a collection of different VMs on ARM64 and the most recent build is below.  The stack VM gives the right answer, the cog one not.   The dates are the dates of the most recent commit from the git repository. 2020/03/24 - Cog VM does not build, stack vm builds with the right answer. 2021/01/09 - Both stack and cog VMs build.  Stack VM gives the right answer. 2021/03/24 - Both stack and cog VMs build.  Stack VM gives the right answer. All of this on a Ubuntu 18.04 based system with Gcc 7.5.0 on an NVIDIA Jetson Nano which has A57 cores. I also in all cases with the cog VMs I tested the debug build as well in hopes that it was a GCC optimization problem, but, alas, no luck there. Tim, is it possible to try a stack build and see if that gives the correct answer for you? Thanks. bruce ![image.png](cid:3a19d4bfdc9d7c15b068dd3eeee506ee60863221 at infomaniak "image.png") -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 306507 bytes Desc: not available URL: From bruce.oneel at pckswarms.ch Mon May 10 14:06:36 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Mon, 10 May 2021 16:06:36 +0200 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> References: <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> Message-ID: <1620655596-7b3e384e78dab65e043bb4e0fb7aa997@pckswarms.ch> Hi, A bit more testing and I think I can guess why Tim sees it work or not work some time. Note that below that result is correct for 2 raisedTo: 64. Somewhere walking back up the stack it loses the value. So ok: ![image.png](cid:c408a69212ad79e9057b2adcf512a078bb6d4292 at infomaniak "image.png") One level up, still ok: ![image.png](cid:4afc54ca62cd2e998e762a7935dd14b9aaee8387 at infomaniak "image.png") Still ok ![image.png](cid:5a0b277044ca28316f513755fa3b98e3cd2a4f72 at infomaniak "image.png") Still ok ![image.png](cid:1cd855677434be7788a5cd38ed2c6e083983d7d5 at infomaniak "image.png") Still ok ![image.png](cid:15c86f7732c72bb179bfb2dabc80204a73ade6df at infomaniak "image.png") But then somewhere between here, and actually printing the value we lose it. I don't get why. Thanks bruce -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 51463 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 55498 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 105170 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 196041 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 60882 bytes Desc: not available URL: From vanessa at codefrau.net Mon May 10 15:45:55 2021 From: vanessa at codefrau.net (Vanessa Freudenberg) Date: Mon, 10 May 2021 08:45:55 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> Message-ID: I think we really ought to move the discussion over to the experts at vm-dev. CC’ed. –Vanessa– On Mon, May 10, 2021 at 03:55 Bruce O'Neel wrote: > Hi, > > So, um, kind of good news but maybe not. > > So I built a collection of different VMs on ARM64 and the most recent > build is below. The stack VM gives the right answer, the cog one not. > The dates are the dates of the most recent commit from the git repository. > > 2020/03/24 - Cog VM does not build, stack vm builds with the right answer. > 2021/01/09 - Both stack and cog VMs build. Stack VM gives the right > answer. > 2021/03/24 - Both stack and cog VMs build. Stack VM gives the right > answer. > > All of this on a Ubuntu 18.04 based system with Gcc 7.5.0 on an NVIDIA > Jetson Nano which has A57 cores. > > I also in all cases with the cog VMs I tested the debug build as well in > hopes that it was a GCC optimization problem, but, alas, no luck there. > > Tim, is it possible to try a stack build and see if that gives the correct > answer for you? > > Thanks. > > bruce > > > > > > [image: image.png] > > > > *09 May 2021 19:56 tim Rowledge > > wrote:* > > > > > On 2021-05-09, at 7:31 AM, David T. Lewis wrote: > > > > > If the primitive is failing for 16r80000000 squared, then I wonder if we > > may be looking at a signed/unsigned arithmetic problem somewhere in the > > plugin. > > Ah, but that is the extra-weird bit. It *sometimes* gives the right > answer. The only thing I can think of that could explain that & that might > be ARM64 code specific is something to do with the address of the LPI, > which obviously is sometihng that varies with each test. If there is some > code expecting base addresses to always match some requirement and that is > not always being met, subsequent code might be reading the wrong values. > > Another possibility is that the compiled result of the LI plugin has a > bug; it's not like C compilers never get it wrong. > > Another possibility must be that I screwed up somewhere and the 'correct' > result I saw was not actually with the prim enabled - but I'm fairly sure I > did that in a different image anyway. Grr. > > And now I do more testing, and I haven't yet got the right answer again > for 16r80000000 squared. > 16r80000001 squared always seems to be ok. 16r[9ABCDEF]0000000 squared > always seems to be ok. And 16r[7654321]0000000 squared always seems to be > right. > > Also 16r40000000 squared * 4 seems always ok. So we're rather pointed to > some peculiarity of the 16r80000000 bit-pattern? My brian hurts. > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Strange OpCodes: SG: Show Garbage > > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 306507 bytes Desc: not available URL: From tim at rowledge.org Mon May 10 16:59:23 2021 From: tim at rowledge.org (tim Rowledge) Date: Mon, 10 May 2021 09:59:23 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: References: <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> Message-ID: <8DEADA6F-654F-4994-AD5A-F8A3BE139E1A@rowledge.org> > On 2021-05-09, at 8:07 PM, Vanessa Freudenberg wrote: > > On Sun, May 9, 2021 at 10:57 tim Rowledge wrote: > > So we're rather pointed to some peculiarity of the 16r80000000 bit-pattern? My brian hurts. > > That is a very peculiar bit pattern indeed, in that it is exactly where signed arithmetic wraps around. So signed/unsigned or < vs <= or a combination thereof perhaps? Yeah, very plausible > > If you want some *real* fun step through it under gdb 😬 Doing anything in gdb stopped being 'fun' a long time ago. But I suppose I may have to just hold my nose and try... tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Dukedom: aristocratic birth control From tim at rowledge.org Mon May 10 17:31:17 2021 From: tim at rowledge.org (tim Rowledge) Date: Mon, 10 May 2021 10:31:17 -0700 Subject: [squeak-dev] 2 raisedTo: 63 on Pi returns 0 ? (was Re: how to determine available RAM?) In-Reply-To: <1620655596-7b3e384e78dab65e043bb4e0fb7aa997@pckswarms.ch> References: <1620644096-16e8271d29733a29158f5f4d639fda80@pckswarms.ch> <69695C3C-D0E9-469A-9B02-FB685ED9E8A4@rowledge.org> <6951BADE-D8F3-4573-AEFD-D50F23BF356A@rowledge.org> <20210507222218.GA18151@shell.msen.com> <4942434F-93E5-4B09-85C4-D8FA1C172773@rowledge.org> <20210509143152.GA91791@shell.msen.com> <1620655596-7b3e384e78dab65e043bb4e0fb7aa997@pckswarms.ch> Message-ID: <2CDE1C2C-CEAA-4632-A5C4-1539B7374ACF@rowledge.org> > On 2021-05-10, at 7:06 AM, Bruce O'Neel wrote: > A bit more testing and I think I can guess why Tim sees it work or not work some time. > > Note that below that result is correct for 2 raisedTo: 64. Yeah, that weirded me a bit when I first debugged this. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Useful random insult:- Ignorant, and proud of it. From commits at source.squeak.org Mon May 10 18:45:04 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 10 May 2021 18:45:04 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1403.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1403.mcz ==================== Summary ==================== Name: Kernel-jar.1403 Author: jar Time: 10 May 2021, 8:45:01.136524 pm UUID: eccfd7f5-ad2b-0b4f-abb2-c76d21c4599a Ancestors: Kernel-nice.1402 Further improve #terminate: add comments, remove unnecessary code, fix minor issue, address Christoph's objection in [1] regarding nested errors inside unwind blocks: the following example will currently NOT execute any assignment to x: x := ''. [self error: 'x1'] ensure: [ [self error: 'x2'] ensure: [ [self error: 'x3'] ensure: [ x:=x,'3']. x:=x,'2']. x:=x,'1'] With the fix all three errors will be dealt with by opening a debugger even after abandoning the one opened on the previous error, and as a result all three assignments will be executed and the value of x will be '321'. More info in: [1] http://forum.world.st/Solving-multiple-termination-bugs-summary-proposal-tp5128285p5129113.html =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here := thisContext. "Insert ensure and exception handler contexts under aSender" error := nil. ctxt := aSender insertSender: (Context contextOn: UnhandledError do: [:ex | error ifNil: [ error := ex exception. topContext := thisContext. + here jump. + "re-signal the error if jumped back instead of resuming; + required by Process>>#terminate" + ex signalerContext restart] - ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt := ctxt insertSender: (Context contextEnsure: [error ifNil: [ topContext := thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | ctxt unwindBlock oldList outerMost top pair | - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. + suspendedContext ifNotNil: [ + "Release any method marked with the pragma. - suspendedContext ifNotNil: - ["Release any method marked with the pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + ctxt := top := suspendedContext. + suspendedContext := nil. "Disable this process while running its stack in active process below" "If terminating a process halfways through an unwind, try to complete that unwind block first; if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner blocks will be completed in the process." - ctxt := suspendedContext. [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: + "Contexts under evaluation have already set their complete variable (tempAt: 2) to true." - "Contexts under evaluation have already set their complete (tempAt: 2) to true." [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + outerMost ifNotNil: ["This is the outer-most unwind context currently under evaluation" + "Let's finish the unfinished unwind context only and return here. Note: top may be equal + to outerMost e.g. in case #ensure was interrupted right after assigning complete := true." + pair := top runUntilErrorOrReturnFrom: outerMost. + "If an error was detected jump back to open a debugger; do not jump back in case + of a MessageNotUnderstood error to prevent an infinite recursion of MNU errors. Note: for + more information on the return value pair see comments in #runUntilErrorOrReturnFrom" + pair second ifNotNil: [:error | + error class = MessageNotUnderstood ifFalse: [pair first jump]]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. "Now all unwind blocks caught halfway through have been completed; + let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts + searching from the receiver's sender but the receiver itself may be an unwind context; + set ctxt as a new starting point in a search for the remaining unwind blocks:" + ctxt := pair ifNil: [top] ifNotNil: [pair first sender]. - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. "Create a context for the unwind block and execute it on the unwind block's stack. Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing the unwind on the wrong stack preventing the correct execution of non-local returns." + top := unwindBlock asContextWithSender: ctxt. + pair := top runUntilErrorOrReturnFrom: top. + "If an error was detected jump back to open a debugger." + pair second ifNotNil: [pair first jump]]. + ctxt := ctxt findNextUnwindContextUpTo: nil]] + ! - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Mon May 10 18:49:19 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 10 May 2021 13:49:19 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1619375410272-0.post@n4.nabble.com> References: <1617642027172-0.post@n4.nabble.com> <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> Message-ID: <1620672559968-0.post@n4.nabble.com> Hi Christoph! I apologize for not responding earlier to your great comments. I had to educate myself in error handling first :) > 1. Regarding issue no. #5 in your list above ("Bug in Process>>#terminate > | > Returning from unwind contexts" [1]): Do you consider this thread resolved > by now or is my answer to it still being expected? At the moment, this > snippet you mentioned fails to unwind completely: > > x := nil. > [self error: 'x1'] ensure: [ > [self error: 'x2'] ensure: [ > [self error: 'x3'] ensure: [ > x:=3]. > x:=2]. > x:=1]. I reread your remarks regarding how to interpret a situation like above: what do we actually abandon when new errors appear during termination and we abandon the nested debuggers? I've enclosed a changeset that makes abandoning the debuggers equivalent to terminating the debugged process (including unwind) - i.e. in the example above we'll get the first debugger, abandon it which causes a process termination, encounter the second error and start the second debugger, abandon it which again causes another termination, etc. As a result all assignments will be executed (imagine a `stream close` instead of `x:=1` so I guess it's justified). However, because this is happening in the ensure block during unwind, it seems that abandoning is almost equivalent to proceeding :) (Not entirely though: proceed would continue after unwinding, abandon only proceeds within the unwind scope). This poses a new challenge however - how to kill a debugger if we deliberately want or have to stop debugging a process immediately, i.e. without unwinding? Consider this example: `[] ensure: [self gotcha]` We'd get a debugger with a MNU error (Message Not Understood), abandon it and get another debugger with the same error creating an infinite recursion (due to how #doesNotUnderstand is written). This particular example is taken care of in the changeset but in general I miss a Kill button - has this been ever considered? Note: the infinite recursion danger is present even in the current implementation but neutralized by allowing just one error during unwinding halfway through ensure blocks :) There's also a file Kernel-jar.1403 in the Inbox: http://forum.world.st/The-Inbox-Kernel-jar-1403-mcz-td5129607.html There are some additional changes to #terminate - mostly cleaning and simplifying the code. And more comments. > 2. What is the current state of this thread [2]? If all issues are > resolved > from your perspective, there is no need to discuss anything further - > otherwise, I guess it's your turn to answer again. :) No progress on my side but I look forward to getting to it and responding :) > 3.1 Consider the following snippet: > > | p | > p := Processor activeProcess. > Transcript showln: p == Processor activeProcess. > [Transcript showln: p == Processor activeProcess] ensure: [ > Transcript showln: p == Processor activeProcess]. > p > > Debug it, then step into the first block, and abandon the debugger. We > would > expect to see another "true" in the Transcript, but instead, we see a > "false". This is because #runUntilErrorOrReturnFrom: does not honor > process-faithful debugging. The protocol on Process, on the other hand, > does > so. So probably we would want to wrap these sends into > #evaluate:onBehalfOf:. This is not a new issue; if you step further - into the ensure (i.e. the argument block) block and then abandon the debugger, you will see false instead of true even in images before the change I introduced. The reason is precisely what you described - the use of #runUntilErrorOrReturnFrom which operates on a context stack belonging to an other process and this way guarantees a correct execution of non-local returns on that process's context stack (for the price of losing process-faithful debugging). I'm aware of the process-faithful debugging issue and I'd love to fix it, but I'm afraid my debugger implementation knowledge is presently next to none; I'll have to put it on my to-do list ;) I'd expect though simple wrapping into #evaluate:onBehalfOf: may reintroduce the original nasty non-local error bug. Would you have an idea how to wrap it so that non-local returns still worked? That would be awesome. > 3.2 As I think I mentioned somewhere else already, the result of > #runUntilErrorOrReturnFrom: *must* be checked to make sure that the > execution or the unwinding has not halted halfway. I don't see this in > Process >> #terminate either. This might be the cause of the bug I > mentioned > in #1 of this post. Probably it's the best idea to discuss this in [1], > too. > :-) The cause of the bug in [1] (i.e. the disastrous behavior of `[self error] ensure: [^2]`) was caused by executing the non-local return (`^2`) on a wrong context stack which happened as a result of using #popTo (and consequently #evaluate:onBehalfOf:) for evaluation of the said non-local return. Checking the return value of #runUntilErrorOrReturnFrom is the main idea behind the fix presented in this changeset. If the execution of the unwind block gets halted by an error, #runUntilErrorOrReturnFrom returns from the "foreign" stack and reports the error. Because we are operating in an unwind block I suggest the execution of the unwind block continues by opening a new debugger window for the found error, and the user will decide what to de next. To achieve this the implementation of #runUntilErrorOrReturnFrom must be modified slightly to resignal the caught exception rather than resume it - see the enclosed changeset. No other methods use #runUntilErrorOrReturnFrom so let's either accept the suggested modification or create a version of #runUntilErrorOrReturnFrom with the modified behavior. > 4. What's the current state of tests? Have you contributed tests for all > the > issues you mentioned above? This would be awesome. :-) There's a set of basic semantics tests Tests-jar.448 in the Inbox. I realized I don't know how to "simulate" pressing debugger's Abandon in a test but I'll add more when I figure it out :) Plus more test will come if the change proposed here is accepted. > Organizational notes: For sake of overview, I propose to keep this thread > of > the current level of abstraction and discuss all the implementation > details > in separate threads such as [1]. Ideally, we should also "close" all the > different threads about Process issues by adding another message to each > of > them in order to help our future selves to keep an overview of their > solutions ... Absolutely, I'll go through all relevant discussions and update them. Thanks again very much for all your comments, best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Mon May 10 19:43:13 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 10 May 2021 14:43:13 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1620672559968-0.post@n4.nabble.com> References: <1617642027172-0.post@n4.nabble.com> <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> Message-ID: <1620675793952-0.post@n4.nabble.com> Sorry, forgot to enclose the changeset: Fix_terminate_v5.cs ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From ken.dickey at whidbey.com Tue May 11 04:00:09 2021 From: ken.dickey at whidbey.com (ken.dickey at whidbey.com) Date: Mon, 10 May 2021 21:00:09 -0700 Subject: [squeak-dev] Upcoming Talk: More Direct Morphic Message-ID: Wednesday, May 12, 2021. 6:00 PM to 8:00 PM PDT California Smalltalkers: https://www.meetup.com/california-smalltalkers/events/mvzhdsycchbqb/ Cuis Smalltalk is a small, hand-crafted Smalltalk IDE which should be familiar and comfortable to Squeakers. Cuis has been evolving under the radar for some time and has developed some interesting scaling strategies. Being small, we think it is an excellent Smalltalk in which to learn and experiment. This show 'n tell is about making Morph visual properties easier to use via inheritable MetaProperties. Join us to get a quick introduction to Cuis and explore the semantics of this last sentence. Hope you can attend.. -KenD From herbertkoenig at gmx.net Tue May 11 05:15:36 2021 From: herbertkoenig at gmx.net (=?UTF-8?Q?Herbert_K=c3=b6nig?=) Date: Tue, 11 May 2021 07:15:36 +0200 Subject: [squeak-dev] Upcoming Talk: More Direct Morphic In-Reply-To: References: Message-ID: <3350f884-596b-9331-73f6-093eeaa15bb1@gmx.net> Hi, I'd love to get a link to a recording, we got 9 hrs time difference here in Germany. 7:15 h here, 22:15 h your place atm. Cheers, Herbert Am 11.05.2021 um 06:00 schrieb ken.dickey at whidbey.com: > Wednesday, May 12, 2021. 6:00 PM to 8:00 PM PDT > California Smalltalkers: > https://www.meetup.com/california-smalltalkers/events/mvzhdsycchbqb/ > > Cuis Smalltalk is a small, hand-crafted Smalltalk IDE which should be > familiar and comfortable to Squeakers. Cuis has been evolving under > the radar for some time and has developed some interesting scaling > strategies. Being small, we think it is an excellent Smalltalk in > which to learn and experiment. > > This show 'n tell is about making Morph visual properties easier to > use via inheritable MetaProperties. > > Join us to get a quick introduction to Cuis and explore the semantics > of this last sentence. > > Hope you can attend.. > -KenD > > > > > From lecteur at zogotounga.net Tue May 11 07:47:08 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Tue, 11 May 2021 09:47:08 +0200 Subject: [squeak-dev] Upcoming Talk: More Direct Morphic In-Reply-To: <3350f884-596b-9331-73f6-093eeaa15bb1@gmx.net> References: <3350f884-596b-9331-73f6-093eeaa15bb1@gmx.net> Message-ID: > I'd love to get a link to a recording +1 Stef From commits at source.squeak.org Wed May 12 03:08:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 12 May 2021 03:08:53 0000 Subject: [squeak-dev] The Trunk: Sound-eem.79.mcz Message-ID: Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.79.mcz ==================== Summary ==================== Name: Sound-eem.79 Author: eem Time: 11 May 2021, 8:08:51.274095 pm UUID: 10321fa9-6db8-4ca9-b3fc-ed5d41db23fa Ancestors: Sound-mt.78 Somewhat nicer executable comments for listening to sounds in the libraries. =============== Diff against Sound-mt.78 =============== Item was changed: ----- Method: AbstractSound class>>soundNames (in category 'sound library') ----- soundNames + "AbstractSound soundNames asSortedCollection do: + [:n | + (n padded: #right to: 10 with: $ ) asParagraph displayAt: Sensor cursorPoint - 32. + (AbstractSound soundNamed: n) ifNotNil: + [:s| s playAndWaitUntilDone. (Delay forMilliseconds: 250) wait]]" + ^ Sounds keys asArray sort ! Item was changed: ----- Method: SampledSound class>>soundNames (in category 'sound library') ----- soundNames "Answer a list of sound names for the sounds stored in the sound library." + "SampledSound soundNames asSortedCollection do: + [:n | + (n padded: #right to: 10 with: $ ) asParagraph displayAt: Sensor cursorPoint - 32. + (SampledSound soundNamed: n) ifNotNil: + [:s| s playAndWaitUntilDone. (Delay forMilliseconds: 250) wait]]" - "| s | - SampledSound soundNames asSortedCollection do: [:n | - n asParagraph display. - s := SampledSound soundNamed: n. - s ifNotNil: [s playAndWaitUntilDone]]" ^ SoundLibrary keys asArray ! From marcel.taeumel at hpi.de Wed May 12 05:37:17 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Wed, 12 May 2021 07:37:17 +0200 Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: <,> Message-ID: This reminds me of our #asNumber (or number parser) discussion where we agreed to not parse number-like appearances in Unicode to Integer. :-) Instead of modifying CharacterSet etc., one could maybe extend TextConverter to support encoding-aware identification of separators etc and also provide encoding-aware #trim. Best, Marcel Am 08.05.2021 04:12:21 schrieb Levente Uzonyi : On Fri, 7 May 2021, Thiede, Christoph wrote: > > Hi Levente, > > > thanks for the pointer. As far I can see from the linked discussion, Tobias' proposal has never been rejected but only postponed due to the upcoming release. I also see your point of performance, but IMHO correctness is more > important than performance. If necessary, we could still hard-code the relevant code points into #isSeparator. > > > > - consistency: CharacterSet separators would differ from the rest with your change set. > > > Fair point, but I think we should instead fix the definitions of Character(Set) constants to respect the encoding as well ... By the way, Character alphabet and Character allCharacters also don't do this at the moment. > > Of course, all your concerns are valid points and need to be discussed, but I would be sorry if we failed to - finally - establish current standards in our Character library. I doubt that any modern parser for JSON or > whatever would treat Unicode space characters incorrectly, and still, they are satisfyingly fast. I think we should be able to keep pace with them in Squeak as well. :-) Well, you ignored my question "What is a separator?". IMO a separator is a whitespace that separates tokens in the source code. Would you like to use zero-width space as a separator? Not likely. #isSeparator is deeply buried into the system. Changing it would mean changing other code your changeset doesn't touch, e.g. the parsers. The method you propose is welcome, but IMO it shouldn't be called #isSeparator. #isWhitespace is a much better fit. Levente > > Best, > Christoph > > _________________________________________________________________________________________________________________________________________________________________________________________________________________________________ > Von: Squeak-dev im Auftrag von Levente Uzonyi > Gesendet: Freitag, 7. Mai 2021 22:01:18 > An: The general-purpose Squeak developers list > Betreff: Re: [squeak-dev] [ENH] isSeparator   > Hi Christoph, > > There was a discussion on this subject before: > http://forum.world.st/The-Trunk-Collections-topa-806-mcz-td5084658.html > Main concerns are > - definition: What is a separator? > - consistency: CharacterSet separators would differ from the rest with > your change set. > - performance: I haven't measured it, but I wouldn't be surprised if > #isSeparator would become a magnitude slower with that implementation. > > > Levente > > On Thu, 6 May 2021, christoph.thiede at student.hpi.uni-potsdam.de wrote: > > > Hi all, > > > > here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be > identified correctly now, too. > > > > Please review and merge! :-) > > > > Best, > > Christoph > > > > ["isSeparator.cs.gz"] > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Wed May 12 11:10:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 12 May 2021 11:10:49 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1404.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1404.mcz ==================== Summary ==================== Name: Kernel-jar.1404 Author: jar Time: 12 May 2021, 1:10:44.824502 pm UUID: 8ca0f049-7c9d-ac43-befc-828adc37e6bd Ancestors: Kernel-nice.1402 Prevent VM crashes due to returning from #cannotReturn. The fix loops #cannotReturn to itself so that the user cannot crash the VM by accidentally pressing Proceed, by stepping over etc. #terminate can take advantage of this improved behavior - will post a proposal in a separate changeset. =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + "Note: BlockCannotReturn is looped back because returning to thisContext's sender (i.e. to self) wouldn't make sense and would crash the VM - the sender's pc was set to endPC+1 because the sender attempted an illegal non-local return (to a dead context or a to context on another stack). This message is sent by the VM or during simulation." + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. thisContext privRefresh]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! From commits at source.squeak.org Wed May 12 11:31:58 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 12 May 2021 11:31:58 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1405.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1405.mcz ==================== Summary ==================== Name: Kernel-jar.1405 Author: jar Time: 12 May 2021, 1:31:53.708002 pm UUID: d57e5134-bbd9-af44-9677-b0d70adef3a7 Ancestors: Kernel-nice.1402 Supersede Kernel-jar.1403.mcz Improve previous chages in Kernel-jar.1403.mcz by preventing cannot return errors crash the VM when accidentally pressing Proceed or stepping over it. Uses the fix from Kernel-jar.1404.mcz Example previously crashing the VM: [^2] fork =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + "Note: BlockCannotReturn is looped back because returning to thisContext's sender (i.e. to self) wouldn't make sense and would crash the VM - the sender's pc was set to endPC+1 because the sender attempted an illegal non-local return (to a dead context or a to context on another stack). This message is sent by the VM or during simulation." + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. thisContext privRefresh]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was changed: ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here := thisContext. "Insert ensure and exception handler contexts under aSender" error := nil. ctxt := aSender insertSender: (Context contextOn: UnhandledError do: [:ex | error ifNil: [ error := ex exception. topContext := thisContext. + here jump. + "re-signal the error if jumped back; + required by Process>>#terminate" + ex signalerContext restart] - ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt := ctxt insertSender: (Context contextEnsure: [error ifNil: [ topContext := thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | ctxt unwindBlock oldList outerMost top pair doNotDebug | - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. + suspendedContext ifNotNil: [ + "Release any method marked with the pragma. - suspendedContext ifNotNil: - ["Release any method marked with the pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + ctxt := top := suspendedContext. + "Disable this process while running its stack in active process below" + suspendedContext := nil. + "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite + recursion of MNU errors or a VM crash in case of a non-local return to a dead home context; + blocks containing these exceptions are silently skipped and the unwind procedure continues; + UndefinedObject represents #runUntilErrorOrReturnFrom: found no error and answered nil." + doNotDebug := {UndefinedObject. BlockCannotReturn. MessageNotUnderstood}. "If terminating a process halfways through an unwind, try to complete that unwind block first; if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner + blocks will be completed in the process. Halfway through blocks have already set the complete + variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true." + [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: [ + (ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + outerMost ifNotNil: ["This is the outer-most unwind context currently under evaluation" + "Let's finish the unfinished unwind context only and return here. Note: top may be equal + to outerMost e.g. in case #ensure was interrupted right after assigning complete := true." + pair := top runUntilErrorOrReturnFrom: outerMost. + "If an error was detected jump back to open a debugger; do not jump back if the error is + in the doNotDebug list. Note: for more information on the return value pair see comments + in #runUntilErrorOrReturnFrom." + (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. - blocks will be completed in the process." - ctxt := suspendedContext. - [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: - "Contexts under evaluation have already set their complete (tempAt: 2) to true." - [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. "Now all unwind blocks caught halfway through have been completed; + let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts + searching from the receiver's sender but the receiver itself may be an unwind context; + set ctxt as a new starting point in a search for the remaining unwind blocks. + Note: pair first sender points to outerMost sender i.e. the next unexplored context." + ctxt := pair ifNil: [top] ifNotNil: [pair first sender]. - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. "Create a context for the unwind block and execute it on the unwind block's stack. Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing the unwind on the wrong stack preventing the correct execution of non-local returns." + top := unwindBlock asContextWithSender: ctxt. + pair := top runUntilErrorOrReturnFrom: top. + "If an error was detected jump back to open a debugger; do not jump back if the error is + in the doNotDebug list. Note: for more information on the return value pair see comments + in #runUntilErrorOrReturnFrom." + (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. + ctxt := ctxt findNextUnwindContextUpTo: nil]] + ! - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Wed May 12 11:47:21 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 06:47:21 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1620672559968-0.post@n4.nabble.com> References: <1617642027172-0.post@n4.nabble.com> <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> Message-ID: <1620820041440-0.post@n4.nabble.com> Hi Christoph, hi all, I've added a tweak to #cannotReturn: that would make sure the method won't return to the block that attempted an illegal non-local return. This would prevent crashing the image/VM when accidentally pressing Proceed or stepping over it. #terminate can take an advantage of this improvement as well - it'd be able to safely deal with illegal non-local returns and continue unwinding. The latest version of #terminate is enclosed and in the Inbox here: http://forum.world.st/The-Inbox-Kernel-jar-1405-mcz-td5129644.html Thanks for reviewing/commenting. Fix_terminate_v6.cs best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Wed May 12 17:20:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 12 May 2021 17:20:01 0000 Subject: [squeak-dev] The Trunk: Collections-eem.944.mcz Message-ID: Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.944.mcz ==================== Summary ==================== Name: Collections-eem.944 Author: eem Time: 12 May 2021, 10:19:58.957605 am UUID: 97274a09-ff46-4d4c-8f16-420df357849d Ancestors: Collections-mt.943 Nuke duplicate methods in Float32Array inherited from FloatArray. =============== Diff against Collections-mt.943 =============== Item was removed: - ----- Method: Float32Array>>* (in category 'arithmetic') ----- - * anObject - - ^self shallowCopy *= anObject! Item was removed: - ----- Method: Float32Array>>*= (in category 'arithmetic') ----- - *= anObject - ^anObject isNumber - ifTrue:[self primMulScalar: anObject asFloat] - ifFalse:[self primMulArray: anObject]! Item was removed: - ----- Method: Float32Array>>+ (in category 'arithmetic') ----- - + anObject - - ^self shallowCopy += anObject! Item was removed: - ----- Method: Float32Array>>+= (in category 'arithmetic') ----- - += anObject - ^anObject isNumber - ifTrue:[self primAddScalar: anObject asFloat] - ifFalse:[self primAddArray: anObject]! Item was removed: - ----- Method: Float32Array>>- (in category 'arithmetic') ----- - - anObject - - ^self shallowCopy -= anObject! Item was removed: - ----- Method: Float32Array>>-= (in category 'arithmetic') ----- - -= anObject - ^anObject isNumber - ifTrue:[self primSubScalar: anObject asFloat] - ifFalse:[self primSubArray: anObject]! Item was removed: - ----- Method: Float32Array>>/ (in category 'arithmetic') ----- - / anObject - - ^self shallowCopy /= anObject! Item was removed: - ----- Method: Float32Array>>/= (in category 'arithmetic') ----- - /= anObject - ^anObject isNumber - ifTrue:[self primDivScalar: anObject asFloat] - ifFalse:[self primDivArray: anObject]! Item was removed: - ----- Method: Float32Array>>\\= (in category 'arithmetic') ----- - \\= other - - other isNumber ifTrue: [ - 1 to: self size do: [:i | - self at: i put: (self at: i) \\ other - ]. - ^ self. - ]. - 1 to: (self size min: other size) do: [:i | - self at: i put: (self at: i) \\ (other at: i). - ]. - - ! Item was removed: - ----- Method: Float32Array>>adaptToNumber:andSend: (in category 'arithmetic') ----- - adaptToNumber: rcvr andSend: selector - "If I am involved in arithmetic with a Number. If possible, - convert it to a float and perform the (more efficient) primitive operation." - selector == #+ ifTrue:[^self + rcvr]. - selector == #* ifTrue:[^self * rcvr]. - selector == #- ifTrue:[^self negated += rcvr]. - selector == #/ ifTrue:[ - "DO NOT USE TRIVIAL CODE - ^self reciprocal * rcvr - BECAUSE OF GRADUAL UNDERFLOW - self should: (1.0e-39 / (FloatArray with: 1.0e-39)) first < 2." - ^(self class new: self size withAll: rcvr) / self - ]. - ^super adaptToNumber: rcvr andSend: selector! Item was removed: - ----- Method: Float32Array>>asFloatArray (in category 'converting') ----- - asFloatArray - ^self! Item was removed: - ----- Method: Float32Array>>length (in category 'accessing') ----- - length - "Return the length of the receiver" - ^self squaredLength sqrt! Item was removed: - ----- Method: Float32Array>>negated (in category 'arithmetic') ----- - negated - - ^self shallowCopy *= -1! Item was removed: - ----- Method: Float32Array>>replaceFrom:to:with:startingAt: (in category 'private') ----- - replaceFrom: start to: stop with: replacement startingAt: repStart - "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive." - - super replaceFrom: start to: stop with: replacement startingAt: repStart! Item was removed: - ----- Method: Float32Array>>squaredLength (in category 'accessing') ----- - squaredLength - "Return the squared length of the receiver" - ^self dot: self! From m at jaromir.net Wed May 12 18:48:19 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 13:48:19 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: References: Message-ID: <1620845299641-0.post@n4.nabble.com> Hi Nicolas, Christoph, all > When debugging things like this: > > [^2] ensure: [Transcript cr; show: 'done']. > > if we step into the protected block [^2], then step over ^2, we > incorrectly get a BlockCannotReturn. Found a bug inside the debugger causing this problem: #stepOver uses #runUntilErrorOrReturnFrom: which inserts an ensure context when started. The problem happens when the debugger simulates #aboutToReturn:through: -- before it starts executing it via #runUntilErrorOrReturnFrom this method inserts its ensure context between #aboutToReturn:through:firstUnwindContext and its firstUnwindContext argument! This means the inserted context will be skipped during execution and that's the whole problem :) The situation is captured on the enclosed screenshot. Screenshot_2021-05-12_202833.png To prove this try changing #aboutToReturn and the BlockCannotReturn error is gone: #aboutToReturn: result through: firstUnwindContext "Called from VM when an unwindBlock is found between self and its home. Return to home's sender, executing unwind blocks on the way." self methodReturnContext return: result I'm not sure how to fix it but a debugger pro should figure it out way faster than me :) ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Wed May 12 19:40:22 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 14:40:22 -0500 (CDT) Subject: [squeak-dev] Another bug in Process>>#terminate in unwinding contexts ? In-Reply-To: <1617213481208-0.post@n4.nabble.com> References: <1617182207794-0.post@n4.nabble.com> <1617213481208-0.post@n4.nabble.com> Message-ID: <1620848422656-0.post@n4.nabble.com> This issue has been fixed - see the discussion at http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposal-td5128285.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Wed May 12 20:21:19 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 15:21:19 -0500 (CDT) Subject: [squeak-dev] Bug in Process>>#terminate | Returning from unwind contexts In-Reply-To: <1616920497663-0.post@n4.nabble.com> References: <3241f8cf091b41bbb5d215447cb8b287@student.hpi.uni-potsdam.de> <1615797306053-0.post@n4.nabble.com> <1615841680085-0.post@n4.nabble.com> <1615901797162-0.post@n4.nabble.com> <1616011686241-0.post@n4.nabble.com> <1616586593553-0.post@n4.nabble.com> <1616660158843-0.post@n4.nabble.com> <1616920497663-0.post@n4.nabble.com> Message-ID: <1620850879438-0.post@n4.nabble.com> This issue has been dealt with (fixed) and discussed here: http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposal-td5128285.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Wed May 12 20:32:27 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 15:32:27 -0500 (CDT) Subject: [squeak-dev] Tackling Context>>#runUntilErrorReturnFrom: (was: BUG/REGRESSION while debugging Generator >> #nextPut:) In-Reply-To: <1615566932862-0.post@n4.nabble.com> References: <9ed2db8e40684297b83d98e311e76a4b@student.hpi.uni-potsdam.de> <25a67367ce4f4ee68d0509659cb10c72@student.hpi.uni-potsdam.de> <1615231296272-0.post@n4.nabble.com> <1615566932862-0.post@n4.nabble.com> Message-ID: <1620851547306-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > By the way, another occurrence for this issue is when you debug such an > expression: > > [^6*7] ensure: [2+3] > > Step through the first block, into Context>>aboutToReturn:through:, and > then > over #return:through:. I think the cause is the same. This particular issue is related to this one: http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Wed May 12 21:27:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 12 May 2021 21:27:01 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1406.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1406.mcz ==================== Summary ==================== Name: Kernel-jar.1406 Author: jar Time: 12 May 2021, 11:26:53.034511 pm UUID: 5cb31451-f65e-0947-9f17-f2165870ce47 Ancestors: Kernel-nice.1402 Make #runUntilErrorOrReturnFrom: in #terminate process-faithful-debugging friendly - just wrap it in #evaluate:onBehalfOf: - THANKS Christoph! Supersedes Kernel-jar.1405.mcz discussed in http://forum.world.st/Solving-multiple-termination-bugs-summary-proposal-tp5128285p5129113.html Christoph's example now works: | p | p := Processor activeProcess. Transcript showln: p == Processor activeProcess. [Transcript showln: p == Processor activeProcess] ensure: [ Transcript showln: p == Processor activeProcess]. p Debug it, then step into the first block, and abandon the debugger. We would expect to see another "true" in the Transcript. (quoting Christoph - thanks) best, Jaromir =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + "Note: BlockCannotReturn is looped back because returning to thisContext's sender (i.e. to self) wouldn't make sense and would crash the VM - the sender's pc was set to endPC+1 because the sender attempted an illegal non-local return (to a dead context or a to context on another stack). This message is sent by the VM or during simulation." + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. thisContext privRefresh]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was changed: ----- Method: Context>>runUntilErrorOrReturnFrom: (in category 'controlling') ----- runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here := thisContext. "Insert ensure and exception handler contexts under aSender" error := nil. ctxt := aSender insertSender: (Context contextOn: UnhandledError do: [:ex | error ifNil: [ error := ex exception. topContext := thisContext. + here jump. + "re-signal the error if jumped back; + required by Process>>#terminate" + ex signalerContext restart] - ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt := ctxt insertSender: (Context contextEnsure: [error ifNil: [ topContext := thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | ctxt unwindBlock oldList outerMost top pair doNotDebug | - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. + suspendedContext ifNotNil: [ + "Release any method marked with the pragma. - suspendedContext ifNotNil: - ["Release any method marked with the pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + ctxt := top := suspendedContext. + "Disable this process while running its stack in active process below" + suspendedContext := nil. + "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite + recursion of MNU errors or a VM crash in case of a non-local return to a dead home context; + blocks containing these exceptions are silently skipped and the unwind procedure continues; + UndefinedObject represents #runUntilErrorOrReturnFrom: found no error and answered nil." + doNotDebug := {UndefinedObject. BlockCannotReturn. MessageNotUnderstood}. "If terminating a process halfways through an unwind, try to complete that unwind block first; if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner + blocks will be completed in the process. Halfway through blocks have already set the complete + variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true." + [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: [ + (ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + outerMost ifNotNil: ["This is the outer-most unwind context currently under evaluation" + "Let's finish the unfinished unwind context only and return here. Note: top may be equal + to outerMost e.g. in case #ensure was interrupted right after assigning complete := true." + pair := Processor activeProcess + evaluate: [top runUntilErrorOrReturnFrom: outerMost] + onBehalfOf: self. + "If an error was detected jump back to open a debugger; do not jump back if the error is + in the doNotDebug list. Note: for more information on the return value pair see comments + in #runUntilErrorOrReturnFrom." + (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. - blocks will be completed in the process." - ctxt := suspendedContext. - [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: - "Contexts under evaluation have already set their complete (tempAt: 2) to true." - [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. "Now all unwind blocks caught halfway through have been completed; + let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts + searching from the receiver's sender but the receiver itself may be an unwind context; + set ctxt as a new starting point in a search for the remaining unwind blocks. + Note: pair first sender points to outerMost sender i.e. the next unexplored context." + ctxt := pair ifNil: [top] ifNotNil: [pair first sender]. - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. "Create a context for the unwind block and execute it on the unwind block's stack. Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing the unwind on the wrong stack preventing the correct execution of non-local returns." + top := unwindBlock asContextWithSender: ctxt. + pair := Processor activeProcess + evaluate: [top runUntilErrorOrReturnFrom: top] + onBehalfOf: self. + "If an error was detected jump back to open a debugger; do not jump back if the error is + in the doNotDebug list. Note: for more information on the return value pair see comments + in #runUntilErrorOrReturnFrom." + (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. + ctxt := ctxt findNextUnwindContextUpTo: nil]] + ! - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Wed May 12 21:39:56 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 12 May 2021 16:39:56 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1620820041440-0.post@n4.nabble.com> References: <1617642027172-0.post@n4.nabble.com> <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> Message-ID: <1620855596237-0.post@n4.nabble.com> Hi Christoph & all, One more update: Christoph Thiede wrote > 3.1 Consider the following snippet: > > | p | > p := Processor activeProcess. > Transcript showln: p == Processor activeProcess. > [Transcript showln: p == Processor activeProcess] ensure: [ > Transcript showln: p == Processor activeProcess]. > p > > Debug it, then step into the first block, and abandon the debugger. We > would > expect to see another "true" in the Transcript, but instead, we see a > "false". This is because #runUntilErrorOrReturnFrom: does not honor > process-faithful debugging. The protocol on Process, on the other hand, > does > so. So probably we would want to wrap these sends into > #evaluate:onBehalfOf:. Yes, you were right, wrapping #runUntilErrorOrReturnFrom: into #evaluate:onBehalfOf: works well and your example now returns true as expected. Thanks very much! Here's a changeset: Fix_terminate_v7.cs A new version in the Inbox is: http://forum.world.st/The-Inbox-Kernel-jar-1406-mcz-td5129657.html best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Thu May 13 13:34:18 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 13 May 2021 13:34:18 0000 Subject: [squeak-dev] The Inbox: Kernel-nice.1407.mcz Message-ID: Nicolas Cellier uploaded a new version of Kernel to project The Inbox: http://source.squeak.org/inbox/Kernel-nice.1407.mcz ==================== Summary ==================== Name: Kernel-nice.1407 Author: nice Time: 13 May 2021, 3:34:15.142602 pm UUID: c4b8ae2c-02a9-415b-bcf3-6628b8f9f8e7 Ancestors: Kernel-jar.1406 When simulating (for example via the debugger) correctly unwind the simulation machinery #ensure: block inserted by #runUntilErrorOrReturnFrom: Simulating #aboutToReturn:through: did jump to first unwind context. But this first unwind context was determined BEFORE the simulation #ensure: has been inserted. This had the effect of skipping the simulation machinery protection, and did result in a BlockCannotReturn (cannotReturn:) error... This did prevent the debugger to correctly debug a protected block with non local return like this: [^2] ensure: [Transcript cr; show: 'done']. Kudos to Jaromir for finding this! =============== Diff against Kernel-jar.1406 =============== Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: [:unwindProtectCtxt| + ^self send: #simulatedAboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop! Item was added: + ----- Method: Context>>simulatedAboutToReturn:through: (in category 'private') ----- + simulatedAboutToReturn: result through: firstUnwindContext + "This is the simulated version of #aboutToReturn:through: + Since the simulation machinery inserts its own ensure: block, we must unwind it first. + See #runUntilErrorOrReturnFrom:" + + self methodReturnContext + return: result + through: ((thisContext findNextUnwindContextUpTo: firstUnwindContext) ifNil: [firstUnwindContext])! From nicolas.cellier.aka.nice at gmail.com Thu May 13 13:36:54 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Thu, 13 May 2021 15:36:54 +0200 Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1620845299641-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> Message-ID: Hi Jaromir, good find! See https://source.squeak.org/inbox/Kernel-nice.1407.diff I based it on your latest inbox contribution, because I don't know if this could be decoupled... Le mer. 12 mai 2021 à 20:48, Jaromir Matas a écrit : > > Hi Nicolas, Christoph, all > > > When debugging things like this: > > > > [^2] ensure: [Transcript cr; show: 'done']. > > > > if we step into the protected block [^2], then step over ^2, we > > incorrectly get a BlockCannotReturn. > > Found a bug inside the debugger causing this problem: #stepOver uses > #runUntilErrorOrReturnFrom: which inserts an ensure context when started. > The problem happens when the debugger simulates #aboutToReturn:through: -- > before it starts executing it via #runUntilErrorOrReturnFrom this method > inserts its ensure context between #aboutToReturn:through:firstUnwindContext > and its firstUnwindContext argument! This means the inserted context will be > skipped during execution and that's the whole problem :) > > The situation is captured on the enclosed screenshot. > Screenshot_2021-05-12_202833.png > > > To prove this try changing #aboutToReturn and the BlockCannotReturn error is > gone: > > #aboutToReturn: result through: firstUnwindContext > "Called from VM when an unwindBlock is found between self and its home. > Return to home's sender, executing unwind blocks on the way." > > self methodReturnContext return: result > > I'm not sure how to fix it but a debugger pro should figure it out way > faster than me :) > > > > > > ----- > ^[^ Jaromir > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html > From jakres+squeak at gmail.com Fri May 14 08:00:21 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Fri, 14 May 2021 10:00:21 +0200 Subject: [squeak-dev] Browser flash (was Re: The Trunk: Tools-mt.1029.mcz) In-Reply-To: <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> References: <9574ca2682be4bb78fe4664b0f7155d9@student.hpi.uni-potsdam.de> <12B8A259-39EC-453F-9CA2-D0F1E1BEB990@rowledge.org> Message-ID: Hi, I have another drag gesture suggestion: if you drag a piece of selected text and drop it on the World, open a new Workspace at the drop position and copy the dragged text into it. Can be used to drag snippets from a Transcript or pieces from a method. Subsequently one can drag more pieces into the new workspace. Kind regards, Jakob Am Mo., 26. Apr. 2021 um 01:02 Uhr schrieb tim Rowledge : > > > > > On 2021-04-25, at 2:59 PM, Thiede, Christoph wrote: > > > > > > Yeah, that's a very nice start. So, just as some thoughts relating - > > - how about some gesture to open a hierarchy browser instead ? Actually, a switch to change a typical browser into a hierarchy browser - in the manner of the inspect/explore switch - would be interesting > > - all the other browsers ought to support the drag stuff too. I see some do, but the messagetrace doesn't appear to. > > - drag a method into a MessageTrace browser and thus add implementors of that message to the stack. Maybe shift-drag adds senders of the message instead. Or, for a more extensive change, drop the message on the 'senders' button to see the senders, the 'implementors' to see (guess what) the implementors. Hell, have simple drop targets available to perform such actions; drag a method/class/etc onto a 'versions' drop target. Or 'fileout'. Etc. > > - Nothing to do with d&d, but how about a very simple way to add notes to methods in a browser? I'm thinking here of using a messagetrace browser and wanting to add little (pop-up?) notes to remind me of any points I notice as I follow the messages up and down. Why was I looking at this? What is it related to? All that stuff it is so easy to forget a week later when you start climbing back up the rabbit hole you fell into. > > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Strange OpCodes: BW: Branch on Whim > > > From christoph.thiede at student.hpi.uni-potsdam.de Fri May 14 09:15:33 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Fri, 14 May 2021 11:15:33 +0200 Subject: [squeak-dev] The Trunk: Installer-Core-mt.440.mcz In-Reply-To: Message-ID: <1eeb3119-c645-4efb-83c5-ab7026032487@email.android.com> An HTML attachment was scrubbed... URL: From jakres+squeak at gmail.com Fri May 14 09:29:25 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Fri, 14 May 2021 11:29:25 +0200 Subject: [squeak-dev] The Trunk: Installer-Core-mt.440.mcz In-Reply-To: <1eeb3119-c645-4efb-83c5-ab7026032487@email.android.com> References: <1eeb3119-c645-4efb-83c5-ab7026032487@email.android.com> Message-ID: Nope, no Metacello magic here. All the three named branches exist on GitHub, where did you look? https://github.com/hpi-swa/Squot/tree/latest-release Am Fr., 14. Mai 2021 um 11:15 Uhr schrieb Christoph Thiede : > > I can't find this branch in the GitHub repository, is this a special shortcut for Metacello? > > Am 06.05.2021 15:21 schrieb commits at source.squeak.org: > > Marcel Taeumel uploaded a new version of Installer-Core to project The Trunk: > http://source.squeak.org/trunk/Installer-Core-mt.440.mcz > > ==================== Summary ==================== > > Name: Installer-Core-mt.440 > Author: mt > Time: 6 May 2021, 3:21:07.381189 pm > UUID: 4906fd3d-9eff-e841-afc5-0a75e5a9b4b6 > Ancestors: Installer-Core-mt.439 > > Renames default branch for Git tools from "master" to "latest-release". Leave hints to "develop" branch for the brave among us. :-) > > master == latest-release ~~ develop > > =============== Diff against Installer-Core-mt.439 =============== > > Item was changed: > ----- Method: Installer class>>installGitInfrastructure (in category 'scripts') ----- > installGitInfrastructure > | priorSetting | > "for INIFileTest>>#testComplexRead" > priorSetting := Scanner allowUnderscoreAsAssignment. > + [Scanner allowUnderscoreAsAssignment: true. > - Scanner allowUnderscoreAsAssignment: true. > > (Smalltalk at: #Metacello) new > baseline: 'Squot'; > + repository: 'github://hpi-swa/Squot:latest-release/src'; > + "repository: 'github://hpi-swa/Squot:develop/src';" > - repository: 'github://hpi-swa/Squot:master/src'; > load. > > + ] ensure: [Scanner allowUnderscoreAsAssignment: priorSetting] > - Scanner allowUnderscoreAsAssignment: priorSetting > ! > > > From commits at source.squeak.org Fri May 14 11:39:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 11:39:47 0000 Subject: [squeak-dev] The Inbox: ToolBuilder-Morphic-jr.276.mcz Message-ID: A new version of ToolBuilder-Morphic was added to project The Inbox: http://source.squeak.org/inbox/ToolBuilder-Morphic-jr.276.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-jr.276 Author: jr Time: 14 May 2021, 1:39:52.580866 pm UUID: d1ad461b-3cb1-e54a-86e1-b31edc1eefe2 Ancestors: ToolBuilder-Morphic-mt.275 Allow to browse a directory that is not beneath the disk file system roots. For example, with the FileSystem API you can create in-memory file systems. Without this change it is currently impossible to browse directories in such file systems which have their own roots. =============== Diff against ToolBuilder-Morphic-mt.275 =============== Item was changed: ----- Method: FileAbstractSelectionDialog>>rootDirectoryList (in category 'directory tree') ----- rootDirectoryList "Return a list of know root directories; forms the root nodes ot the directory tree morph" | dirList dir | dir := FileDirectory root. dirList := self subDirectoriesOf: dir. dirList isEmpty ifTrue:[dirList := Array with: FileDirectory default]. + directory ifNotNil: + [| current parent | current := directory. + [(parent := current containingDirectory) ~= dir] + whileTrue: [current := parent]. + (dirList includes: current) ifFalse: [dirList := dirList, {current}]]. ^dirList ,(ServerDirectory servers values) "looks odd because #servers returns the Dictionary of known servers with local names instead of the actaul server directories"! From commits at source.squeak.org Fri May 14 13:00:16 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:00:16 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.142.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.142.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.142 Author: mt Time: 14 May 2021, 3:00:14.59076 pm UUID: 4fc40176-45b1-d345-9664-dd4f0dd6cb81 Ancestors: FFI-Kernel-mt.141 Refactors the type system. Makes the support for type aliases (i.e. typedefs) more robust. There are tests, which I will commit ASAP. To learn more about this commit, take a look at the class hierarchy of ExternalType. Then look where ExternalUnknownType will be constructed and how #becomeKnownType works. Note that there is still an issue with alias-to-pointer types, where the FFI plugin insists on returning a byte array as handle instead of ExternalAddress. And FFI calls with an external address will even fail. There seems to be some kind of magic going on. Anyway, it is not necessary for the in-image handling of types, not even for type checking because alias=typedef=invisible ;-) See #checkHandle and #checkHandleUndo for the current workaround. Also browse the flag #pointerAliasCompatibility. We now support up to 2-dimensional array types via alias-to-array types. Note that both pointer arithmetic (ExternalAddress class >> #fromAddress:movedBy:) and zero'ed allocation (#allocateZero:) should both be available from the FFI plugin the future because performance and security. :-) =============== Diff against FFI-Kernel-mt.141 =============== Item was removed: - ----- Method: ByteArray>>asByteArrayPointer (in category '*FFI-Kernel-pointers') ----- - asByteArrayPointer - "Return a ByteArray describing a pointer to the contents of the receiver." - ^self shouldNotImplement! Item was removed: - ----- Method: ByteArray>>asExternalPointer (in category '*FFI-Kernel-pointers') ----- - asExternalPointer - "Convert the receiver assuming that it describes a pointer to an object." - ^ self pointerAt: 1 length: self size! Item was changed: + ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-pointers') ----- - ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-testing') ----- isNull + "Answer false since only pointers (i.e. external addresses) can be null." - "Answer false since only pointers can be null, which is easy for external addresses but unknown for byte arrays without a proper external type for interpretation. See #isTypeAliasForPointer." ^ false! Item was removed: - ----- Method: ByteArray>>isNull: (in category '*FFI-Kernel-testing') ----- - isNull: externalType - "Given the external type, answer whether the receiver holds all null bytes representing a null pointer." - - "self assert: [self isInternalMemory]." - ^ externalType isTypeAliasForPointer - and: [externalType byteSize = self size] - and: [self allSatisfy: [:byte | byte = 0]]! Item was changed: ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset "Answer an 8-byte pointer object stored at the given byte address" + self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 8! Item was changed: ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset put: value "Store an 8-byte pointer object at the given byte address" + + self deprecated: 'Use #pointerAt:put:length:'. - ^ self pointerAt: byteOffset put: value length: 8! Item was changed: ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-pointers') ----- + pointerAt: byteOffset length: numBytes "^ " - pointerAt: byteOffset length: numBytes "Answer a pointer object of numBytes length stored at the given byte address" | addr | addr := ExternalAddress basicNew: numBytes. + 1 to: numBytes do: [:index | + addr + basicAt: index + put: (self unsignedByteAt: byteOffset+index-1)]. - 1 to: numBytes do: - [:i| - addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)]. ^addr! Item was changed: ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-pointers') ----- pointerAt: byteOffset put: value length: numBytes "Store a pointer object with numBytes lengeth at the given byte address" + + self assert: [value isExternalAddress]. + + 1 to: numBytes do: [:index | + self + unsignedByteAt: byteOffset + index - 1 + put: (value basicAt: index)]. + ^ value! - value isExternalAddress ifFalse: - [^self error:'Only external addresses can be stored']. - 1 to: numBytes do: - [:i| - self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)]. - ^value! Item was changed: ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset "Answer a 4-byte pointer object stored at the given byte address" + self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 4! Item was changed: ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset put: value "Store a 4-byte pointer object at the given byte address" + self deprecated: 'Use #pointerAt:put:length:'. ^ self pointerAt: byteOffset put: value length: 4! Item was added: + ----- Method: ByteArray>>withoutReadWriter (in category '*FFI-Kernel-comparing') ----- + withoutReadWriter + "Workaround to make #= and #== work through ByteArrayReadWriter." + + ^ self! Item was removed: - ----- Method: ByteArray>>zeroMemory (in category '*FFI-Kernel') ----- - zeroMemory - - self atAllPut: 0.! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'accessing') ----- structAt: newByteOffset length: newLength ^ ByteArrayReadWriter new setArray: byteArray offset: byteOffset + newByteOffset - 1 size: newLength! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'accessing') ----- structAt: newByteOffset put: value length: newLength (newByteOffset + newLength > byteSize) ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. ^ byteArray structAt: byteOffset + newByteOffset - 1 put: value length: newLength! Item was added: + ----- Method: ByteArrayReadWriter>>withoutReadWriter (in category 'initialization') ----- + withoutReadWriter + + ^ byteArray! Item was changed: ----- Method: CompiledMethod>>externalLibraryName (in category '*FFI-Kernel') ----- externalLibraryName "Try to answer the effective name of the external library involved. Might be ambiguous for external libraries if function's module was set, too, and handle not null." ^ self externalLibraryFunction ifNotNil: [:extFun | self methodClass ifNil: [extFun module "Method not installed. Rely on external function data."] ifNotNil: [:extLib | (extLib inheritsFrom: ExternalLibrary) ifFalse: [extFun module "Class is no external library. Rely on external function data."] ifTrue: [ extFun module ifNil: [extLib moduleName "External function has no data. Rely on external library data."] ifNotNil: [:extFunModName | extLib moduleName ifNil: [extFunModName "External library has no data. Rely on external function data."] ifNotNil: [:extLibModName | "Now we have two options: module name from function or from library." + extFun isNull - extFun getHandle isNull ifTrue: [extFunModName "Function has higher priority than library on first call."] ifFalse: [ {extFunModName. extLibModName} "We cannot know. It is likely to be from the function's module name. So put that first."]]]]]]! Item was changed: ----- Method: CompiledMethod>>externalLibraryName: (in category '*FFI-Kernel') ----- externalLibraryName: libraryName "Reset the library to look for the external function. Also reset the function's handle in case it has been called before. The next call should definitely go to the new library." ^ self externalLibraryFunction ifNotNil: [:extFun | extFun setModule: libraryName. + self flag: #todo. "mt: Maybe actually #free the handle here?" extFun getHandle beNull]! Item was changed: ----- Method: ExternalAddress class>>allocate: (in category 'instance creation') ----- allocate: byteSize + "Primitive. Allocates byteSize bytes on the external heap. Answers an address pointing to those bytes. WARNING bytes might not be zero'ed!!" - "Primitive. Allocate an object on the external heap." + + self flag: #todo. "mt: Ensure zero'ed memory." + ^ self primitiveFailed! - ^self primitiveFailed! Item was added: + ----- Method: ExternalAddress class>>allocateZero: (in category 'instance creation') ----- + allocateZero: byteSize + + ^ (self allocate: byteSize) + zeroMemory: byteSize; + yourself! Item was added: + ----- Method: ExternalAddress class>>fromAddress:movedBy: (in category 'support') ----- + fromAddress: externalAddress movedBy: delta + "Do pointer arithmetic. This might better be done in the plugin." + + delta = 0 ifTrue: [^ externalAddress]. + ^ self fromInteger: externalAddress asInteger + delta! Item was added: + ----- Method: ExternalAddress class>>fromByteArray: (in category 'instance creation') ----- + fromByteArray: aByteArray + + self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." + self assert: [aByteArray size = ExternalAddress wordSize]. + ^ aByteArray changeClassTo: self! Item was added: + ----- Method: ExternalAddress class>>fromInteger: (in category 'instance creation') ----- + fromInteger: anInteger + "Read the given interger as an address pointing to an external memory area." + + | bytes | + bytes := ByteArray basicNew: self wordSize. + bytes integerAt: 1 put: anInteger size: bytes size signed: false. + ^ bytes changeClassTo: self! Item was changed: ----- Method: ExternalAddress>>+ (in category 'arithmetic') ----- + offset + "Answer a new address that is offset by the given number of bytes." - "Create an address that is offset by the given number of bytes. - More tricky than one would think due to the FFI's handling of ExternalAddress - as pointer to an object so that 'self unsignedLongAt: ' would dereference." + ^ ExternalAddress fromAddress: self movedBy: offset! - | bytes | - offset = 0 ifTrue: [^ self]. - "Convert xaddr -> bytes" - bytes := self asByteArrayPointer. - "Update bytes using platform dependent accessors" - self size = 4 - ifTrue: [bytes unsignedLongAt: 1 put: (bytes unsignedLongAt: 1) + offset] - ifFalse: [bytes unsignedLongLongAt: 1 put: (bytes unsignedLongLongAt: 1) + offset]. - "Convert bytes -> xaddr" - ^bytes asExternalPointer! Item was removed: - ----- Method: ExternalAddress>>asByteArrayPointer (in category 'private') ----- - asByteArrayPointer - "Answer a ByteArray containing a copy of pointer to the contents of the receiver." - | sz | - ^(ByteArray basicNew: (sz := self size)) - replaceFrom: 1 to: sz with: self startingAt: 1 "answers self"! Item was removed: - ----- Method: ExternalAddress>>asExternalPointer (in category 'private') ----- - asExternalPointer - "No need to convert." - ^self! Item was changed: + ----- Method: ExternalAddress>>asInteger (in category 'arithmetic') ----- - ----- Method: ExternalAddress>>asInteger (in category 'converting') ----- asInteger + "Convert address to integer. Change class to not follow the address when reading bytes." + + | result | + [self changeClassTo: ByteArray. + result := self integerAt: 1 size: self size signed: false] + ensure: [self changeClassTo: ExternalAddress]. + + ^ result! - "convert address to integer" - ^ self asByteArrayPointer integerAt: 1 size: self size signed: false! Item was removed: - ----- Method: ExternalAddress>>fromInteger: (in category 'converting') ----- - fromInteger: address - "set my handle to point at address." - "Do we really need this? bf 2/21/2001 23:48" - - | sz pointer | - sz := self size. - pointer := ByteArray new: sz. - pointer integerAt: 1 put: address size: sz signed: false. . - self basicAt: 1 put: (pointer byteAt: 1); - basicAt: 2 put: (pointer byteAt: 2); - basicAt: 3 put: (pointer byteAt: 3); - basicAt: 4 put: (pointer byteAt: 4). - sz = 8 ifTrue: - [self basicAt: 5 put: (pointer byteAt: 5); - basicAt: 6 put: (pointer byteAt: 6); - basicAt: 7 put: (pointer byteAt: 7); - basicAt: 8 put: (pointer byteAt: 8)]! Item was changed: + ----- Method: ExternalAddress>>isExternalAddress (in category 'testing') ----- - ----- Method: ExternalAddress>>isExternalAddress (in category 'accessing') ----- isExternalAddress "Return true if the receiver describes the address of an object in the outside world" ^true! Item was removed: - ----- Method: ExternalAddress>>isNull: (in category 'testing') ----- - isNull: externalType - "Overridden to make use of #isNull. This fails if the provided pointer size does not match, which indicates an inconsistency in the system's type objects for the current platform. See 'housekeeping' protocol in ExternalType." - - self assert: [externalType pointerSize = self size]. - ^ self isNull! Item was removed: - ----- Method: ExternalAddress>>zeroMemory (in category 'initialize-release') ----- - zeroMemory - "We need length information in bytes." - self shouldNotImplement.! Item was changed: ExternalType subclass: #ExternalArrayType + instanceVariableNames: 'contentType size' - instanceVariableNames: 'size' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self flag: #contentVsContainer; + assert: [contentType isTypeAlias or: [contentType isArrayType not]] + description: 'No support for direct multi-dimensional containers yet. Use type aliases.'. - assert: [contentType isPointerType not and: [contentType isArrayType not]] - description: 'No support for multi-dimensional containers yet!!'. self + assert: [contentType byteSize > 0] "No arrays of empty structs or void type." + description: 'No array types for empty structs or void type!!'. - assert: [numElements > 0] - description: 'Empty array types are not supported!!'. self + assert: [ + (ArrayTypes at: contentType typeName + ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] + ifAbsent: [nil] ) isNil] - assert: [contentType byteSize > 0] - description: 'Invalid byte size!!'. - - self - assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not] description: 'Array type already exists. Use #typeNamed: to access it.'. + type := ExternalArrayType basicNew. + pointerType := ExternalPointerType basicNew. - type := self "ExternalArrayType" basicNew. - pointerType := ExternalType basicNew. "1) Regular type" + byteSize := numElements + ifNil: [0] ifNotNil: [numElements * contentType byteSize]. - byteSize := numElements * contentType byteSize. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); + byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); - byteAlignment: contentType byteAlignment; setReferentClass: contentType referentClass; + setContentType: contentType; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; + compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); + byteAlignment: self pointerAlignment; + setReferentClass: nil. - compiledSpec: contentType asPointerType compiledSpec copy; - byteAlignment: contentType asPointerType byteAlignment; - setReferentClass: contentType asPointerType referentClass. "3) Remember this new array type." + (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) + at: numElements put: type. + - ArrayTypes - at: contentType typeName -> numElements - put: type. - ^ type! Item was changed: ----- Method: ExternalArrayType>>allocate: (in category 'external data') ----- allocate: anInteger "No support for n-dimensional containers." + self isTypeAlias ifTrue: [^ super allocate: anInteger]. + - self flag: #contentVsContainer. self notYetImplemented.! Item was changed: ----- Method: ExternalArrayType>>allocateExternal: (in category 'external data') ----- allocateExternal: anInteger "No support for n-dimensional containers." + + self isTypeAlias ifTrue: [^ super allocateExternal: anInteger]. + - - self flag: #contentVsContainer. self notYetImplemented.! Item was added: + ----- Method: ExternalArrayType>>asArrayType: (in category 'converting') ----- + asArrayType: numElements + "N-dimensional containers only possible via type alias for now." + + self isTypeAlias ifTrue: [^ super asArrayType: numElements]. + + self notYetImplemented. + ! Item was added: + ----- Method: ExternalArrayType>>byteSize (in category 'accessing') ----- + byteSize + "For array types with an unknown size, also answer an unknown byte size." + + ^ size ifNotNil: [super byteSize]! Item was removed: - ----- Method: ExternalArrayType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - self - assert: [self isPointerType not] - description: 'Convert to ExternalType to use this feature'.! Item was changed: ----- Method: ExternalArrayType>>contentType (in category 'external data') ----- contentType "^ " - "We are an array of things. Our content type is encoded in the compiledSpec's headerWord. The super implementation of #typeName can figure that out." + ^ contentType! - self flag: #contentVsContainer. "mt: For n-dimensional containers, we might have to adapt this." - ^ ExternalType typeNamed: super typeName! Item was added: + ----- Method: ExternalArrayType>>contentTypeName (in category 'external data') ----- + contentTypeName + + ^ self contentType typeName! Item was changed: ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset - "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." - self checkType. - ^ ExternalData fromHandle: (handle structAt: byteOffset length: self byteSize) type: self! Item was changed: ----- Method: ExternalArrayType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value - "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + ^ handle - self checkType. - - handle structAt: byteOffset put: value getHandle + length: self byteSize! - length: self byteSize.! Item was added: + ----- Method: ExternalArrayType>>isArrayOfArrays (in category 'testing') ----- + isArrayOfArrays + "Limited support for 2-dimensional arrays through type aliases possible." + + ^ self contentType isArrayType! Item was added: + ----- Method: ExternalArrayType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ self isArrayOfArrays not + and: [referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isArrayType]]]! Item was added: + ----- Method: ExternalArrayType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was changed: ----- Method: ExternalArrayType>>newReferentClass: (in category 'private') ----- newReferentClass: classOrNil "The class I'm referencing has changed, which affects arrays of structs. Update my byteSize." | newByteSize newHeaderWord | (referentClass := classOrNil) ifNil: [ "my class has been removed - make me empty" compiledSpec := WordArray with: self class structureSpec. byteAlignment := 1] ifNotNil: [ "my class has been changed - update my compiledSpec" newHeaderWord := referentClass compiledSpec first. + newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)]. - newByteSize := size * (newHeaderWord bitAnd: FFIStructSizeMask). newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask. newHeaderWord := newHeaderWord bitOr: newByteSize. compiledSpec := WordArray with: newHeaderWord. + byteAlignment := referentClass byteAlignment]! - byteAlignment := referentClass byteAlignment].! Item was added: + ----- Method: ExternalArrayType>>newTypeAlias (in category 'private') ----- + newTypeAlias + "A little bit expensive but easy to implement. Once the size information is encoded in the headerWord, we might be able to do some cheap update like for the alias-to-pointer type." + + | newUnknownType | + self isTypeAlias ifFalse: [^ self]. + + newUnknownType := ExternalUnknownType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + yourself. + + "Make my pointer type common again by setting the referentClass." + newUnknownType setReferencedType: referencedType. + referencedType setReferentClass: referentClass. + + self becomeForward: newUnknownType. + newUnknownType becomeKnownType.! Item was added: + ----- Method: ExternalArrayType>>readAlias (in category 'external structure') ----- + readAlias + + ^ '^ {1} fromHandle: handle{2}' + format: { + (referentClass ifNil: [ExternalData]) name. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self storeString]}! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset - "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. - Private. Used for field definition only." + ^ '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' + format: { + byteOffset. + self byteSize. + self storeString}! - self checkType. - - ^ String streamContents:[:s | - s nextPutAll:'^ ExternalData fromHandle: (handle structAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') type: '. - - self contentType isAtomic - ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName] - ifFalse: [s nextPutAll: self contentType typeName, ' externalType']. - - s nextPutAll: ' size: '; print: self size]! Item was added: + ----- Method: ExternalArrayType>>setContentType: (in category 'private') ----- + setContentType: type + + contentType := type.! Item was changed: ----- Method: ExternalArrayType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self isTypeAlias ifTrue: [ + ^ aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType']. + + aStream nextPut: $(. + self contentType storeOn: aStream. + aStream nextPutAll: ' asArrayType: '. + aStream nextPutAll: self size asString. + aStream nextPut: $).! - - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #arrayTypeNamed:; space; - store: self typeName; - nextPut: $).! Item was changed: ----- Method: ExternalArrayType>>typeName (in category 'accessing') ----- typeName + self isTypeAlias + ifTrue: [^ super typeName]. + + ^ String streamContents: [:stream | | inParentheses | + (inParentheses := self contentType isPointerType not + and: [self contentType asPointerType isTypeAlias]) + ifTrue: [stream nextPut: $(. "e.g. (*DoublePtr)[5]"]. + + stream nextPutAll: self contentType typeName. + + inParentheses ifTrue: [stream nextPut: $)]. + + stream nextPut: $[. + self size ifNotNil: [stream nextPutAll: self size asString]. + stream nextPut: $]. ]! - ^ String streamContents: [:stream | - stream - nextPutAll: super typeName; - nextPut: $[; - nextPutAll: self size asString; - nextPut: $]]! Item was added: + ----- Method: ExternalArrayType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1} getHandle.' + format: {valueName}! Item was changed: ----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') ----- writeFieldArgName + ^ 'anExternalData'! - ^ 'anExternalData_', self contentType typeName, self size! Item was changed: ----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName + ^ 'handle stuctAt: {1} put: {2} length: {3}' + format: { + byteOffset. + valueName. + self byteSize}! - self checkType. - - ^ String streamContents:[:s | - s nextPutAll:'handle structAt: '; - print: byteOffset; - nextPutAll: ' put: '; - nextPutAll: valueName; - nextPutAll: ' getHandle length: '; - print: self byteSize]! Item was added: + ExternalType subclass: #ExternalAtomicType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalAtomicType class>>newTypeForAtomicNamed: (in category 'instance creation') ----- + newTypeForAtomicNamed: atomicTypeName + + | type pointerType | + type := ExternalAtomicType basicNew. + pointerType := ExternalPointerType basicNew. + + type setReferencedType: pointerType. + pointerType setReferencedType: type. + + AtomicTypes at: atomicTypeName put: type. + + ^ type! Item was added: + ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + + | result | + result := handle + perform: (AtomicSelectors at: self atomicType) + with: byteOffset. + ^ referentClass + ifNotNil: [referentClass fromHandle: result] + ifNil: [result]! Item was added: + ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + + ^ handle + perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol + with: byteOffset + with: (referentClass ifNil: [value] ifNotNil: [value getHandle])! Item was added: + ----- Method: ExternalAtomicType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ true! Item was added: + ----- Method: ExternalAtomicType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isAtomic]]! Item was added: + ----- Method: ExternalAtomicType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>newTypeAlias (in category 'testing') ----- + newTypeAlias + + "self isTypeAlias ifFalse: [^ self]." + "Nothing to do. My referentClass was already upated." + ! Item was added: + ----- Method: ExternalAtomicType>>originalType (in category 'accessing - type alias') ----- + originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + ^ self "e.g. *DoublePtr" asPointerType isTypeAlias "e.g. DoublePtr" + ifTrue: [super originalType asNonPointerType "e.g. double, not double*"] + ifFalse: [super originalType]! Item was added: + ----- Method: ExternalAtomicType>>readAlias (in category 'external structure') ----- + readAlias + + ^ '^ {1}handle{2}' + format: { + referentClass ifNil: [''] ifNotNil: [ + referentClass name, ' fromHandle: ']. + referentClass ifNotNil: [''] ifNil: [ + ' "', self writeFieldArgName, '"'] }! Item was added: + ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + + ^ '^ {1}handle {2} {3}{4}' + format: { + referentClass ifNil: [''] ifNotNil: [ + referentClass name, ' fromHandle: (']. + AtomicSelectors at: self atomicType. + byteOffset. + referentClass ifNil: [''] ifNotNil: [')']}! Item was added: + ----- Method: ExternalAtomicType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + referentClass + ifNil: [ + aStream + nextPutAll: 'ExternalType '; + nextPutAll: self atomicTypeName] + ifNotNil: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType'].! Item was added: + ----- Method: ExternalAtomicType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1}{2}.' + format: { + valueName. + referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was added: + ----- Method: ExternalAtomicType>>writeFieldArgName (in category 'external structure') ----- + writeFieldArgName + + self isTypeAlias ifTrue: [ + ^ super writeFieldArgName]. + + self isIntegerType ifTrue: [ + ^ 'anInteger']. + + ^ self atomicTypeName caseOf: { + ['bool'] -> ['aBoolean']. + ['char'] -> ['aCharacter']. + ['schar'] -> ['aCharacter']. + ['float'] -> ['aFloat']. + ['double'] -> ['aFloat'] }! Item was added: + ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + ^ 'handle {1} {2} put: {3}{4}.' + format: { + AtomicSelectors at: self atomicType. + byteOffset. + valueName. + referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was changed: ExternalStructure subclass: #ExternalData + instanceVariableNames: 'type' - instanceVariableNames: 'type size' classVariableNames: 'AllowDetectForUnknownSize' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0! Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *'). Instance variables: type The external type of the receiver. Always a pointer type. The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed. ! Item was changed: ----- Method: ExternalData class>>fromHandle: (in category 'instance creation') ----- fromHandle: aHandle + + ^ self fromHandle: aHandle type: ExternalType void! - "We need type information. See #fromHandle:type:" - self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>allSatisfy: (in category 'enumerating') ----- + allSatisfy: aBlock + + self do: [:each | (aBlock value: each) ifFalse: [^ false]]. + ^ true! Item was added: + ----- Method: ExternalData>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + + self do: [:each | (aBlock value: each) ifTrue: [^ true]]. + ^ false! Item was removed: - ----- Method: ExternalData>>asString (in category 'converting') ----- - asString - - ^ size - ifNil: [self fromCString] - ifNotNil: [self fromStringBounded]! Item was changed: ----- Method: ExternalData>>at: (in category 'accessing') ----- at: index + ((1 > index) or: [self size notNil and: [index > self size]]) - ((1 > index) or: [size notNil and: [index > size]]) ifTrue: [^ self errorSubscriptBounds: index]. ^ self contentType handle: handle at: ((index-1) * self contentType byteSize) + 1! Item was changed: ----- Method: ExternalData>>at:put: (in category 'accessing') ----- at: index put: value + ((1 > index) or: [self size notNil and: [index > self size]]) - ((1 > index) or: [size notNil and: [index > size]]) ifTrue: [^ self errorSubscriptBounds: index]. ^ self contentType handle: handle at: ((index-1) * self contentType byteSize) + 1 put: value! Item was changed: ----- Method: ExternalData>>byteSize (in category 'accessing') ----- byteSize "Answer how many bytes the receiver manages." + | ct myBytes | + self isNull ifTrue: [^ 0]. + self size ifNil: [^ nil "We don't know"]. + + myBytes := self size * (ct := self contentType) byteSize. + + ^ ct isPointerType + ifTrue: [ "Locally managed pointers do not ocunt. See ByteArray >> #isNull." + (handle isExternalAddress ifTrue: [myBytes] ifFalse: [0]) + + (self reader collect: [:each | each byteSize]) sum ] + ifFalse: [ myBytes ]! - self sizeCheck. - ^ self size * self contentType byteSize! Item was added: + ----- Method: ExternalData>>checkHandle (in category 'compatibility') ----- + checkHandle + "Not needed here."! Item was changed: ----- Method: ExternalData>>containerType (in category 'accessing - types') ----- + containerType "^ " + "Answer the current container type, which may or may not have a known #size and #byteSize." - containerType "^ " - "Answer the current containter type. Note that pointer types with unknown size cannot serve as container type." + "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls." + type asNonPointerType isArrayType + ifFalse: [self setType: type]. + + ^ type! - ^ size isNil - ifTrue: [ - self flag: #contentVsContainer. "mt: Maybe we should have an actual type for this kind of container?" - self assert: [type isPointerType]. - #undefined] - ifFalse: [ - self assert: [type asNonPointerType isArrayType]. - type asNonPointerType]! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- contentType "^ " + "Answer the content type for the current container type." - "Answer the content type for the current container type. Handle the special case for pointer types with an unknown number of elements (i.e. #size)." + ^ self containerType asNonPointerType contentType! - | containerType contentType | - containerType := self containerType. - - containerType = #undefined - flag: #contentVsContainer; "mt: Our best guess is the non-pointer type." - assert: [type isPointerType]; - ifTrue: [ - (contentType := type asNonPointerType) isArrayType - flag: #initializationOnly; "mt: We are in the middle of initializing this external data. See #setType and #setSize: to learn more." - ifTrue: [contentType := contentType contentType]] - ifFalse: [ - contentType := containerType contentType]. - - ^ contentType! Item was changed: ----- Method: ExternalData>>detect:ifFound: (in category 'enumerating') ----- detect: aBlock ifFound: foundBlock "DANGEROUS for unknown size!!" self class allowDetectForUnknownSize ifFalse: [self sizeCheck]. + self size - size ifNotNil: [ self detect: aBlock ifFound: foundBlock ifNone: nil] ifNil: [ | index each | index := 1. [each := self at: index. (aBlock value: each) ifTrue: [^ foundBlock value: each] ifFalse: [index := index + 1. false]] whileFalse].! Item was changed: ----- Method: ExternalData>>externalType (in category 'accessing - types') ----- externalType "^ " "Overwritten to answer our #containerType, which is important so that clients can then send #byteSize to the result." + ^ self containerType! - | result | - ^ (result := self containerType) = #undefined - ifFalse: [result] - ifTrue: [ - self flag: #contentVsContainer. "mt: Avoid leaking #undefined to the outside." - ExternalType void]! Item was changed: ----- Method: ExternalData>>free (in category 'initialize-release') ----- free + | ct | + self size ifNil: [^ super free "We don't know better"]. + + self flag: #todo. "mt: Add support for cycles. This simplification relies on the reuse of ExternalAddress and ByteArrayPointer, which is not the case. Double-free might happen for cycling structures." + ((ct := self contentType) isPointerType) + ifTrue: [self reader collect: [:each | each free]]. + super free. + self setSize: nil.! - size := nil.! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." | byteOffset numElements byteSize contentType | + ((1 > firstIndex) or: [self size notNil and: [lastIndex > self size]]) - ((1 > firstIndex) or: [size notNil and: [lastIndex > size]]) ifTrue: [^ self errorSubscriptBounds: lastIndex]. contentType := self contentType. byteOffset := ((firstIndex-1) * contentType byteSize)+1. numElements := lastIndex - firstIndex + 1 max: 0. byteSize := numElements * contentType byteSize. ^ ExternalData fromHandle: (handle structAt: byteOffset length: byteSize) type: contentType size: numElements! Item was removed: - ----- Method: ExternalData>>fromStringBounded (in category 'converting - support') ----- - fromStringBounded - "Read byte* as bounded string. You have to set a #size first." - - | offset step | - self - assert: [self contentType = ExternalType byte] - description: 'Wrong content type'. - - self sizeCheck. - - offset := 1. - step := self contentType byteSize. - - ^ String streamContents: [:s | - size timesRepeat: [ - s nextPut: (handle unsignedCharAt: offset). - offset := offset + step]]! Item was removed: - ----- Method: ExternalData>>getExternalData (in category 'accessing - external structures') ----- - getExternalData - "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory. Use #copy if you want to get a another copy in the object memory. Also see ExternalStructure >> #postCopy." - - | data | - handle isExternalAddress ifFalse: [^ self]. - - data := ByteArray new: self byteSize. - 1 to: data size do: [:index | - data unsignedByteAt: index put: (handle unsignedByteAt: index)]. - - ^ ExternalData - fromHandle: data - type: type - size: size! Item was removed: - ----- Method: ExternalData>>getExternalStructure (in category 'accessing - external structures') ----- - getExternalStructure - "Reads an external structure from this external data. If the receiver's handle is an external address, the structure's fields will be copied into object memory. Use #asExternalStructure if you want to avoid this copy." - - self - assert: [self contentType referentClass includesBehavior: ExternalStructure] - description: 'Wrong content type'. - - ^ handle isExternalAddress - ifTrue: [self getExternalData asExternalStructure] - ifFalse: [self asExternalStructure]! Item was removed: - ----- Method: ExternalData>>getExternalUnion (in category 'accessing - external structures') ----- - getExternalUnion - "Reads an external union from this external data. If the receiver's handle is an external address, the union's fields will be copied into object memory. Use #asExternalUnion if you want to avoid this copy." - - self - assert: [self contentType referentClass includesBehavior: ExternalUnion] - description: 'Wrong content type'. - - ^ handle isExternalAddress - ifTrue: [self getExternalData asExternalUnion] - ifFalse: [self asExternalUnion]! Item was added: + ----- Method: ExternalData>>isArray (in category 'testing') ----- + isArray + + ^ true! Item was added: + ----- Method: ExternalData>>isNull (in category 'testing') ----- + isNull + + handle isNil ifTrue:[^ true "internal memory already free'd"]. + handle isNull ifTrue: [^ true "external address already free'd"]. + + self size ifNil: [^ false "we don't know better"]. + + ^ false! Item was changed: ----- Method: ExternalData>>mightBeCString (in category 'testing') ----- mightBeCString + ^ self contentType = ExternalType char and: [self size isNil]! - self - assert: [(ExternalType char asArrayType: 1) asPointerType ~= ExternalType char asPointerType] - description: 'Unexpected reuse of pointer type char* for both atomic type and array type!!'. - - ^ type = ExternalType string "char*"! Item was changed: ----- Method: ExternalData>>pointerAt: (in category 'accessing - pointers') ----- pointerAt: index - | byteOffset | - byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. - - self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." - ^ handle pointerAt: byteOffset - - " self assert: [self contentType isPointerType]. + ^ self at: index! - ^ self at: index - "! Item was changed: ----- Method: ExternalData>>pointerAt:put: (in category 'accessing - pointers') ----- pointerAt: index put: value - | byteOffset | - byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. - - self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." - ^ handle pointerAt: byteOffset put: value - - " self assert: [self contentType isPointerType]. + ^ self at: index put: value! - ^ self at: index put: value - "! Item was added: + ----- Method: ExternalData>>postCopy (in category 'copying') ----- + postCopy + "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory." + + | bytes | + handle isExternalAddress ifFalse: [^ self]. + self sizeCheck. + + bytes := ByteArray new: self byteSize. + 1 to: bytes size do: [:index | + bytes basicAt: index put: (handle unsignedByteAt: index)]. + + handle := bytes. + self setType: type.! Item was changed: ----- Method: ExternalData>>setHandle:type:size: (in category 'private') ----- setHandle: aHandle type: contentType size: numElements + self + setHandle: aHandle + type: (contentType asArrayType: numElements).! - self setHandle: aHandle. - self setType: contentType. - self setSize: numElements.! Item was changed: ----- Method: ExternalData>>setSize: (in category 'private') ----- setSize: numElements "Set the size for the receiver, which will be used when enumerating its elements." + self setType: (self contentType asArrayType: numElements).! - | ct | - ct := self contentType. - size := numElements. - - self flag: #contentVsContainer. "mt: If we have a size, change the array type. If not, just hold on to the pointer type of the prior content type." - size - ifNil: [type := ct asPointerType] - ifNotNil: [type := (ct asArrayType: size) asPointerType].! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- + setType: containerType + "Private. Set the type used to derive content and container types." - setType: contentOrContainerType - "Private. Set the type used to derive content and container types. If we get an array type, also remember its size to distinguish its pointer type from other pointer types." + containerType asNonPointerType isArrayType + ifTrue: [type := containerType] + ifFalse: [type := (containerType asArrayType: nil)]. + + handle isExternalAddress + ifTrue: [type := type asPointerType] + ifFalse: [type := type asNonPointerType].! - type := contentOrContainerType asPointerType. - - contentOrContainerType isArrayType ifTrue: [ - self flag: #contentVsContainer. "mt: Note that we do not have to check whether the argument is actually the pointer type for an array type because those will usually be supplied with an extra call to #setSize: from the outside. See senders of #fromHandle:type:size:." - self setSize: contentOrContainerType size].! Item was changed: ----- Method: ExternalData>>size (in category 'accessing') ----- size "Answer how many elements the receiver contains." + ^ self containerType asNonPointerType size - ^ size ! Item was changed: ----- Method: ExternalData>>sizeCheck (in category 'private') ----- sizeCheck + self size ifNil: [self error: 'Size is unknown for this data pointer'].! - size ifNil: [self error: 'Size is unknown for this data pointer'].! Item was changed: + ----- Method: ExternalData>>value (in category 'accessing - globals') ----- - ----- Method: ExternalData>>value (in category 'accessing - external globals') ----- value "For convenience. Assume that the external data is just one global variable. Answer the value of that global variable." ^ self at: 1! Item was changed: + ----- Method: ExternalData>>value: (in category 'accessing - globals') ----- - ----- Method: ExternalData>>value: (in category 'accessing - external globals') ----- value: aValue "For convenience. Assume that the external data is just one global variable. Set the value of that global variable." self at: 1 put: aValue.! Item was changed: ----- Method: ExternalData>>writer (in category 'accessing') ----- writer + "Overwritten to preserve type." + + ^ handle isInternalMemory + ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type] + ifFalse: [self]! - "Overwritten to preserve type and size." - handle isInternalMemory ifFalse: [^ self]. - - ^ self class - fromHandle: (ByteArrayReadWriter on: handle) - type: type - size: size! Item was changed: ----- Method: ExternalData>>zeroMemory (in category 'initialize-release') ----- zeroMemory + "Remove all information but keep the memory allocated. Supports an array of pointers." - "Remove all information but keep the memory allocated." + | ct | + self isNull ifTrue: [^ self]. self sizeCheck. + + ((ct := self contentType) isPointerType) + ifTrue: [self writer do: [:each | each zeroMemory]] + ifFalse: [handle zeroMemory: self size * ct byteSize].! - - handle isExternalAddress - ifTrue: [handle zeroMemory: self size * self contentType byteSize] - ifFalse: [ "ByteArray" handle zeroMemory].! Item was added: + ----- Method: ExternalObject>>isExternalObject (in category 'testing') ----- + isExternalObject + + ^ true! Item was added: + ExternalType subclass: #ExternalPointerType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalPointerType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + + ^ referentClass + ifNotNil: [ + referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] + ifNil: [ + ExternalData + fromHandle: (handle pointerAt: byteOffset length: self byteSize) + type: self asNonPointerType "content type"]! Item was added: + ----- Method: ExternalPointerType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + + ^ handle + pointerAt: byteOffset + put: value getHandle + length: self byteSize! Item was added: + ----- Method: ExternalPointerType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ true! Item was added: + ----- Method: ExternalPointerType>>isPointerTypeForArray (in category 'testing') ----- + isPointerTypeForArray + + ^ self asNonPointerType isArrayType! Item was added: + ----- Method: ExternalPointerType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was added: + ----- Method: ExternalPointerType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>newReferentClass: (in category 'private') ----- + newReferentClass: classOrNil + "The class I'm referencing has changed. Keep pointer types for array types free of the referentClass so that FFI calls return ExternalData." + + self isPointerTypeForArray + ifTrue: [referentClass := nil] + ifFalse: [referentClass := classOrNil].! Item was added: + ----- Method: ExternalPointerType>>newTypeAlias (in category 'private') ----- + newTypeAlias + "We should update our referencedType. No need to update the compiledSpec because there is no information encoded that would change if we change the kind of pointer type." + + self isTypeAlias ifFalse: [^ self]. + + referencedType := referentClass originalType asNonPointerType copy. + referencedType setReferencedType: self. + referencedType setReferentClass: referentClass.! Item was added: + ----- Method: ExternalPointerType>>originalType (in category 'accessing - type alias') ----- + originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + self isPointerTypeForArray ifTrue: [ + ^ self asNonPointerType originalType asPointerType]. + + ^ self "e.g. MyStructPtr" asNonPointerType isTypeAlias "e.g. *MyStructPtr" + ifTrue: [super originalType asPointerType "e.g. MyStruct*, not MyStruct"] + ifFalse: [super originalType]! Item was added: + ----- Method: ExternalPointerType>>readAlias (in category 'external structure') ----- + readAlias + " + ExternalStructure defineAllFields. + " + ^ 'self checkHandle. "Fix bug in FFI plugin."\ ^ {1} fromHandle: handle{2}' withCRs + format: { + (referentClass ifNil: [ExternalData]) name. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self asNonPointerType "content type" storeString]}! Item was added: + ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + " + ExternalStructure defineAllFields. + " + ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}' + format: { + (referentClass ifNil: [ExternalData]) name. + byteOffset. + self byteSize. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self asNonPointerType "content type" storeString]}! Item was added: + ----- Method: ExternalPointerType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + self isTypeAlias + ifTrue: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType'] + ifFalse: [ + self asNonPointerType storeOn: aStream. + aStream nextPutAll: ' asPointerType'].! Item was added: + ----- Method: ExternalPointerType>>typeName (in category 'accessing') ----- + typeName + + self asNonPointerType isArrayType + ifFalse: [^ super typeName]. + + "Special case for an array-type's pointer type. Answer would be void* if not treated. Also watch out for type alias. End with a $* to mark it a pointer type." + ^ String streamContents: [:stream | | inParentheses | + (inParentheses := self asNonPointerType isTypeAlias not) + ifTrue: [stream nextPut: $(]. + stream nextPutAll: self asNonPointerType typeName. + inParentheses ifTrue: [stream nextPut: $)]. + stream nextPut: $*]! Item was added: + ----- Method: ExternalPointerType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1} getHandle.' + format: {valueName}! Item was added: + ----- Method: ExternalPointerType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + ^ 'handle pointerAt: {1} put: {2} getHandle length: {3}.' + format: { + byteOffset. + valueName. + self byteSize}! Item was changed: ExternalObject subclass: #ExternalStructure instanceVariableNames: '' classVariableNames: 'PreviousPlatform' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! ExternalStructure class + instanceVariableNames: 'compiledSpec byteAlignment'! - instanceVariableNames: 'type compiledSpec byteAlignment'! !ExternalStructure commentStamp: 'eem 6/26/2019 15:26' prior: 0! An ExternalStructure is for representing external data that is - either a structure composed of different fields (a struct of C language) - or an alias for another type (like a typedef of C language) It reserves enough bytes of data for representing all the fields. The data is stored into the handle instance variable which can be of two different types: - ExternalAddress If the handle is an external address then the object described does not reside in the Smalltalk object memory. - ByteArray If the handle is a byte array then the object described resides in Smalltalk memory. Instance Variables (class side) byteAlignment: compiledSpec: byteAlignment - the required alignment for the structure compiledSpec - the bit-field definiton of the structure in the ExternalType encoding understood by the VM's FFI call marshalling machinery. A specific structure is defined by subclassing ExternalStructure and specifying its #fields via a class side method. For example if we define a subclass: ExternalStructure subclass: #StructExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then declare the fields like this: StructExample class compile: 'fields ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'. It means that this type is composed of two different fields: - a string (accessed thru the field #name) - and an unsigned 32bit integer (accessed thru the field #color). It represents the following C type: struct StructExample {char *name; uint32_t color; }; The accessors for those fields can be generated automatically like this: StructExample defineFields. As can be verified in a Browser: StructExample browse. We see that name and color fields are stored sequentially in different zones of data. The total size of the structure can be verified with: StructExample byteSize = (Smalltalk wordSize + 4). An ExternalStructure can also be used for defining an alias. The fields definition must contain only 2 elements: an eventual accessor (or nil) and the type. For example, We can define a machine dependent 'unsigned long' like this: ExternalStructure subclass: #UnsignedLong instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then set the fields like this: UnsignedLong class compile: 'fields ^(Smalltalk wordSize=4 or: [Smalltalk platformName=''Win64'']) ifTrue: [#(nil ''ulong'')] ifFalse: [#(nil ''ulonglong'')]' classified: 'garbage'. And verify the size on current platform: UnsignedLong byteSize. Then, the class names 'UnsignedLong' and 'StructExamples' acts as a type specification. They can be used for composing other types, and for defining prototype of external functions: LibraryExample>>initMyStruct: aStructExample name: name color: anInteger self externalCallFailed ! ExternalStructure class + instanceVariableNames: 'compiledSpec byteAlignment'! - instanceVariableNames: 'type compiledSpec byteAlignment'! Item was changed: ----- Method: ExternalStructure class>>compileTypeAliasSpec:withAccessors: (in category 'field definition - support') ----- compileTypeAliasSpec: spec withAccessors: aSymbol "Define all the fields in the receiver. Return the newly compiled spec." | fieldName fieldTypeName externalType | fieldName := spec first. fieldTypeName := spec second. externalType := (ExternalType typeNamed: fieldTypeName) ifNil: [self errorTypeNotFound: spec second]. (fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[ self generateTypeAliasAccessorsFor: fieldName type: externalType]. externalType isPointerType ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer." self + setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec) + byteAlignment: ExternalType pointerAliasAlignment] - flag: #isTypeAliasForPointer; - setCompiledSpec: (WordArray with: (ExternalType structureSpec bitOr: ExternalType pointerSpec)) - byteAlignment: ExternalType pointerAlignment] ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type." self flag: #isTypeAlias; setCompiledSpec: externalType compiledSpec byteAlignment: externalType byteAlignment].! Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling - "Base class changed to something that is an external structure now." + + [self compileFields] ifError: [ "Ignore unfinished field specs" ].! - self compiledSpec ifNil: [self compileFields].! Item was added: + ----- Method: ExternalStructure class>>originalType (in category 'type alias') ----- + originalType + + ^ ExternalType typeNamed: self originalTypeName! Item was added: + ----- Method: ExternalStructure>>asArray (in category 'converting') ----- + asArray + "Convert the receiver into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address." + + | contentType arrayType | + contentType := self externalType asNonPointerType. + + contentType isAtomic ifTrue: [ + ^ (contentType allocate: 1) + at: 1 put: handle; + yourself]. + + arrayType := contentType asArrayType: 1. + self externalType isPointerType + ifTrue: [arrayType := arrayType asPointerType]. + + ^ ExternalData + fromHandle: handle + type: arrayType! Item was removed: - ----- Method: ExternalStructure>>asExternalData (in category 'converting') ----- - asExternalData - - ^ ExternalData - fromHandle: self getHandle - type: self externalType "content type" - size: 1! Item was removed: - ----- Method: ExternalStructure>>asExternalStructure (in category 'converting') ----- - asExternalStructure - - ^ self! Item was removed: - ----- Method: ExternalStructure>>asExternalUnion (in category 'converting') ----- - asExternalUnion - - ^ self! Item was added: + ----- Method: ExternalStructure>>byteSize (in category 'accessing') ----- + byteSize + "Answer the number of bytes used for my contents. If my handle is null, I do not require any bytes. If my handle is not null, my type will know the required bytes for my contents." + + ^ self isNull + ifTrue: [0] + ifFalse: [self externalType asNonPointerType "content type" byteSize]! Item was added: + ----- Method: ExternalStructure>>checkHandle (in category 'compatibility') ----- + checkHandle + + | type | + handle ifNil: [^ self "already free'd"]. + handle isExternalAddress ifTrue: [^ self "already ok"]. + + type := self class externalType. + self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." + + (type isPointerType and: [type isTypeAlias + and: [handle size = ExternalAddress wordSize]]) ifTrue: [ + handle := ExternalAddress fromByteArray: handle].! Item was added: + ----- Method: ExternalStructure>>checkHandleUndo (in category 'compatibility') ----- + checkHandleUndo + "See #checkHandle. Call this if the FFI call would not work with the ExternalAddress." + + | type | + self flag: #pointerAliasCompatibility. + + handle ifNil: [^ self "already free'd"]. + handle isInternalMemory ifTrue: [^ self "already ok"]. + + type := self class externalType. + (type isPointerType and: [type isTypeAlias + and: [handle size = ExternalAddress wordSize]]) ifTrue: [ + handle := handle changeClassTo: ByteArray].! Item was changed: ----- Method: ExternalStructure>>externalType (in category 'accessing') ----- externalType + self checkHandle. "Fix bug in FFI plugin." + ^ handle isExternalAddress + ifTrue: [self class externalType asPointerType] + ifFalse: [self class externalType asNonPointerType]! - ^ self class externalType! Item was changed: ----- Method: ExternalStructure>>free (in category 'initialize-release') ----- free "Free the handle pointed to by the receiver" + self externalType isPointerType + ifTrue: [handle isNull ifFalse: [handle free]] - handle isExternalAddress - ifTrue: [handle free; beNull] ifFalse: [handle := nil].! Item was changed: ----- Method: ExternalStructure>>isNull (in category 'testing') ----- isNull + + ^ (self externalType isPointerType and: [handle isNull]) + or: [handle isNil]! - - handle isInternalMemory - ifTrue: [^ handle isNull: self externalType]. - handle isExternalAddress - ifTrue: [^ handle isNull]. - ^ handle isNil! Item was changed: ----- Method: ExternalStructure>>postCopy (in category 'copying') ----- postCopy + "Copy external memory into object memory, shallowCopy otherwise." - "Copy external memory into object memory to not loose track of what to #free and what not. It's safer this way." + self externalType isPointerType + ifTrue: [handle := self asArray postCopy getHandle] - handle isExternalAddress - ifTrue: [handle := self asExternalData getExternalData getHandle] ifFalse: [handle := handle copy. "Materializes byte-array read-writer section if any"].! Item was changed: ----- Method: ExternalStructure>>printOn: (in category 'printing') ----- printOn: stream + | showBrackets | + showBrackets := self externalType isPointerType not. + + showBrackets ifTrue: [stream nextPutAll: '[']. - handle ifNil: [stream nextPutAll: '? ']. - handle isInternalMemory ifTrue: [stream nextPutAll: '[']. super printOn: stream. + showBrackets ifTrue: [stream nextPutAll: ']']. - handle ifNil: [stream nextPutAll: ' ?']. - handle isInternalMemory ifTrue: [stream nextPutAll: ']']. self printIdentityOn: stream.! Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer + self checkHandle. ^ handle isInternalMemory + "Wrap handle into helper to address offsets in the byte array without copy." - "Wrap handle into helper to address offsets in the byte array." ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)] "Either alias-to-atomic or already in external memory." ifFalse: [self]! Item was changed: ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') ----- zeroMemory "Remove all information but keep the memory allocated." + self externalType isPointerType + ifTrue: [handle zeroMemory: self byteSize] + ifFalse: [self externalType isAtomic + ifFalse: [handle zeroMemory: self byteSize] + ifTrue: [handle := handle class zero]].! - handle isExternalAddress - ifTrue: [handle zeroMemory: self externalType byteSize] - ifFalse: [handle isInternalMemory - ifTrue: [handle zeroMemory] - ifFalse: [ - "Alias-to-atomic type." - handle := handle class zero]].! Item was changed: ----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') ----- newTypeForStructureClass: anExternalStructureClass + | type pointerType referentClass | - | type referentClass | referentClass := anExternalStructureClass. self assert: [referentClass includesBehavior: ExternalStructure] description: 'Wrong base class for structure'. type := self newTypeForUnknownNamed: referentClass name. + pointerType := type asPointerType. referentClass compiledSpec ifNil: [ "First time. The referent class' fields are probably just compiled for the first time." + type setReferentClass: referentClass. + pointerType setReferentClass: referentClass] - type asNonPointerType setReferentClass: referentClass. - type asPointerType setReferentClass: referentClass] ifNotNil: [ + type newReferentClass: referentClass. + pointerType newReferentClass: referentClass]. + + ^ [type becomeKnownType] ifError: [ + self assert: [type isUnknownType]. + type "still unkown"]! - type asNonPointerType newReferentClass: referentClass. - type asPointerType newReferentClass: referentClass]. - - ^ type! Item was removed: - ----- Method: ExternalStructureType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- - newTypeForUnknownNamed: typeName - - | type pointerType | - self - assert: [(StructTypes includesKey: typeName) not] - description: 'Structure type already exists. Use #typeNamed: to access it.'. - - type := self "ExternalStructureType" basicNew - compiledSpec: (WordArray with: self structureSpec); - yourself. - self assert: [type isEmpty]. - - pointerType := ExternalType basicNew - compiledSpec: (WordArray with: self pointerSpec); - yourself. - self assert: [pointerType isPointerType]. - - "Connect non-pointer type with pointer type." - type setReferencedType: pointerType. - pointerType setReferencedType: type. - - "Remember this new struct type." - StructTypes at: typeName asSymbol put: type. - - ^ type! Item was removed: - ----- Method: ExternalStructureType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - self - assert: [self isPointerType not] - description: 'Convert to ExternalType to use this feature'. - - referentClass ifNil: [self error: 'Unknown structure type']. - self isEmpty ifTrue: [self error: 'Empty structure']. - ! Item was changed: ----- Method: ExternalStructureType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset - "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." - - | result | - self checkType. + ^ referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)! - result := self isAtomic - ifTrue: [ - handle "alias to atomic" - perform: (AtomicSelectors at: self atomicType) - with: byteOffset] - ifFalse: [ - handle "regular struct or alias to struct or alias to pointer" - structAt: byteOffset length: self byteSize]. - - ^ referentClass fromHandle: result! Item was changed: ----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value - "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + ^ handle + structAt: byteOffset + put: value getHandle + length: self byteSize! - self checkType. - - self isAtomic - ifTrue: [ "alias to atomic" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - ^ handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: value getHandle] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - self class extraTypeChecks ifTrue: [ - self assert: [value externalType == self]]. - ^ handle - structAt: byteOffset - put: value getHandle - length: self byteSize].! Item was added: + ----- Method: ExternalStructureType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was removed: - ----- Method: ExternalStructureType>>isEmpty (in category 'testing') ----- - isEmpty - "Return true if the receiver represents a structure type" - ^ self byteSize = 0! Item was removed: - ----- Method: ExternalStructureType>>isFloatType (in category 'testing') ----- - isFloatType - "Overwritten to not raise an error for struct types." - - ^ false! Item was removed: - ----- Method: ExternalStructureType>>isIntegerType (in category 'testing') ----- - isIntegerType - "Overwritten to not raise an error for struct types." - - ^ false! Item was added: + ----- Method: ExternalStructureType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ true! Item was changed: ----- Method: ExternalStructureType>>isTypeAlias (in category 'testing') ----- isTypeAlias + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isStructureType]]! - ^ referentClass notNil and: [referentClass isTypeAlias]! Item was removed: - ----- Method: ExternalStructureType>>isTypeAliasForAtomic (in category 'testing') ----- - isTypeAliasForAtomic - "Answer whether this type aliases an atomic type, e.g., typedef ulong ID" - "See ThreadedFFIPlugin >> ffiArgument: oop Spec: argSpec Class: argClass in: calloutState" - - ^ self isTypeAlias and: [self isStructureType not and: [self isAtomic]]! Item was removed: - ----- Method: ExternalStructureType>>isTypeAliasForPointer (in category 'testing') ----- - isTypeAliasForPointer - "Answer whether this type aliases a pointer type, e.g., typedef char* charptr_t" - "See ThreadedFFIPlugin >> ffiArgument: oop Spec: argSpec Class: argClass in: calloutState" - - "Note that self isTypeAliasForPointer => [self isPointerType not]" - ^ self isTypeAlias and: [self isStructureType and:[self headerWord anyMask: FFIFlagPointer]]! Item was added: + ----- Method: ExternalStructureType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>newTypeAlias (in category 'private') ----- + newTypeAlias + + "self isTypeAlias ifFalse: [^ self]." + "Nothing to do. My referentClass was already upated." + ! Item was changed: + ----- Method: ExternalStructureType>>originalType (in category 'accessing - type alias') ----- - ----- Method: ExternalStructureType>>originalType (in category 'accessing') ----- originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + ^ self "e.g. *MyStructPtr" asPointerType isTypeAlias "e.g. MyStructPtr" + ifTrue: [super originalType asNonPointerType "e.g. MyStruct, not MyStruct*"] + ifFalse: [super originalType]! - "Resolve original type for alias. Error if not a type alias." - - ^ ExternalType typeNamed: self originalTypeName! Item was removed: - ----- Method: ExternalStructureType>>originalTypeName (in category 'accessing') ----- - originalTypeName - "Resolve original type for alias. Error if not a type alias." - - ^ referentClass ifNotNil: [referentClass originalTypeName]! Item was added: + ----- Method: ExternalStructureType>>printContentsOn: (in category 'printing') ----- + printContentsOn: aStream + + self isEmpty + ifTrue: [aStream nextPutAll: ' { void }'] + ifFalse: [super printContentsOn: aStream].! Item was changed: ----- Method: ExternalStructureType>>printOn: (in category 'printing') ----- printOn: aStream + referentClass + ifNil: [aStream nextPutAll: ''] + ifNotNil: [super printOn: aStream].! - self isTypeAlias ifTrue: [ - aStream nextPutAll: self typeName. - aStream - nextPutAll: '~>'; - print: self originalType. - self isEmpty - ifTrue: [aStream nextPutAll: ' ???']. - ^ self]. - - referentClass == nil - ifTrue:[aStream nextPutAll: ''] - ifFalse:[ - super printOn: aStream. - self isEmpty - ifTrue: [aStream nextPutAll: ' { void }']].! Item was changed: ----- Method: ExternalStructureType>>readAlias (in category 'external structure') ----- readAlias - "this is an aliased structure type, which can itself be a regular struct or an alias to another struct or an alias to a pointer" + ^ '^ {1} fromHandle: handle' + format: {referentClass name}! - self checkType. - - ^ String streamContents: [:s | - s nextPutAll: '^', referentClass name,' fromHandle: handle']! Item was changed: ----- Method: ExternalStructureType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset - "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. - Private. Used for field definition only." + ^ '^ {1} fromHandle: (handle structAt: {2} length: {3})' + format: { + referentClass name. + byteOffset. + self byteSize}! - self checkType. - - self isAtomic - ifTrue: [ "alias to atomic" - ^ String streamContents:[:s | - s nextPutAll:'^'; - print: referentClass; - nextPutAll:' fromHandle: (handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:')']] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - ^ String streamContents:[:s| - s nextPutAll:'^'; - print: referentClass; - nextPutAll:' fromHandle: (handle'. - self isTypeAliasForPointer - ifFalse: [ - s nextPutAll: ' structAt: '; - print: byteOffset; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:')'] - ifTrue: [ - s nextPutAll: ' pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') asByteArrayPointer']]]! Item was changed: ----- Method: ExternalStructureType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self asPointerType isTypeAlias + ifTrue: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType asNonPointerType'] + ifFalse: [super storeOn: aStream].! - - referentClass ifNil: [ - "unknown struct type" - ^ aStream nextPutAll: 'nil']. - - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #structTypeNamed:; space; - store: referentClass name; - nextPut: $).! Item was changed: ----- Method: ExternalStructureType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName - "this is an aliased structure type" - "expect the value have that structure type with either byte array or external address as handle" + ^ 'handle := {1} getHandle.' + format: {valueName}! - self checkType. - - ^ String streamContents: [:s | - self class extraTypeChecks ifTrue: [ - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle := ', valueName,' getHandle']! Item was removed: - ----- Method: ExternalStructureType>>writeFieldArgName (in category 'external structure') ----- - writeFieldArgName - - ^ 'a',referentClass name! Item was changed: ----- Method: ExternalStructureType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName - "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. - Private. Used for field definition only." + ^ 'handle structAt: {1} put: {2} getHandle length: {3}.' + format: { + byteOffset. + valueName. + self byteSize}! - self checkType. - - ^String streamContents:[:s| - self isAtomic - ifTrue: [ "alias to atomic" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll: ' getHandle'] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - self class extraTypeChecks ifTrue: ["expect either byte array or external address as handle" - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - - self isTypeAliasForPointer - ifFalse: [ - s nextPutAll:'handle structAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle'; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:'.'] - ifTrue: [ - s nextPutAll:'handle pointerAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle asExternalPointer'; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:'.']]].! Item was changed: ----- Method: ExternalType class>>arrayTypeFor:size: (in category 'instance lookup') ----- arrayTypeFor: contentType size: numElements "Lookup fails if content type is not present." + ^ ((ArrayTypes + at: contentType typeName + ifAbsentPut: [WeakValueDictionary new]) + at: numElements ifAbsent: [nil]) + ifNil: [ + self + newTypeForContentType: contentType + size: numElements]! - | key | - key := contentType typeName -> numElements. - ^ (ArrayTypes at: key ifAbsent: [nil]) - ifNil: [ - ArrayTypes removeKey: key ifAbsent: []. - self - newTypeForContentType: contentType - size: numElements]! Item was changed: ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') ----- arrayTypeNamed: typeName "Answers an array type for the content type and size specified in the typeName, e.g. char[10] or MyStruct[5]. Lookup fails silently (i.e. nil) if content type does not exist." + | arraySpec contentType numElements | - | arraySpec | arraySpec := self parseArrayTypeName: typeName. + contentType := arraySpec second. + numElements := arraySpec third. - arraySpec second ifNil: [ ^ nil "content type unknown" ]. - arraySpec third ifNil: [arraySpec at: 3 put: 0]. + contentType ifNil: [ ^ nil "content type unknown" ]. + contentType isUnknownType + ifTrue: [ ^ nil "content type not initialized" ]. + ^ self arrayTypeFor: arraySpec second size: arraySpec third! Item was added: + ----- Method: ExternalType class>>arrayTypeNames (in category 'instance list') ----- + arrayTypeNames + "Answers the names of the currently known array types." + + ^ self arrayTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>arrayTypes (in category 'instance list') ----- + arrayTypes + "Answers the currently known array types." + + ^ Array streamContents: [:stream | + self arrayTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>arrayTypesDo: (in category 'instance list') ----- + arrayTypesDo: block + + ArrayTypes do: [:sizes | sizes do: [:each | + each notNil "may be garbage collected" + ifTrue: [block value: each]]]. + + "Type aliases to array types are managed in StructTypes but are actual array types." + StructTypes do: [:each | + (each notNil "may be garbage collected" and: [each isArrayType]) + ifTrue: [block value: each]].! Item was added: + ----- Method: ExternalType class>>atomicTypeNames (in category 'instance list') ----- + atomicTypeNames + "Answers the names of the currently known atomic types." + + ^ AtomicTypeNames asArray! Item was added: + ----- Method: ExternalType class>>atomicTypes (in category 'instance list') ----- + atomicTypes + "Answers the currently known atomic types." + + ^ Array streamContents: [:stream | + self atomicTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>atomicTypesDo: (in category 'instance list') ----- + atomicTypesDo: block + + AtomicTypeNames do: [:typeName | + block value: (AtomicTypes at: typeName)]! Item was changed: ----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') ----- cleanupUnusedTypes "In the lookup table for struct types and array types, remove keys to types no longer present.. ExternalType cleanupUnusedTypes " Smalltalk garbageCollect. StructTypes keys do: [:key | (StructTypes at: key) ifNil: [ StructTypes removeKey: key]]. + + ArrayTypes keys do: [:contentTypeName | + | sizes | + sizes := ArrayTypes at: contentTypeName. + sizes keys do: [:size | + (sizes at: size) ifNil: [sizes removeKey: size]]. + sizes ifEmpty: [ + ArrayTypes removeKey: contentTypeName]].! - ArrayTypes keys do: [:key | - (ArrayTypes at: key) ifNil: [ - ArrayTypes removeKey: key]].! Item was changed: ----- Method: ExternalType class>>initializeDefaultTypes (in category 'class initialization') ----- initializeDefaultTypes + "Create new atomic types and setup the dictionaries. See #resetAllAtomicTypes." + + AtomicTypes ifNil: [ + AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types." + AtomicTypeNames valuesDo: [:typeName | + self newTypeForAtomicNamed: typeName]]. + - "ExternalType initialize" - | type pointerType | - AtomicTypes = nil ifTrue:[ - "Create new atomic types and setup the dictionaries" - AtomicTypes := Dictionary new. - AtomicTypeNames valuesDo:[:k| - type := self basicNew. - pointerType := self basicNew. - AtomicTypes at: k put: type. - type setReferencedType: pointerType. - pointerType setReferencedType: type. - ]. - ]. self initializeAtomicTypes. + self initializeStructureTypes.! - self initializeStructureTypes. - "AtomicTypes := nil"! Item was changed: ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') ----- initializeStructureTypes "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size." StructTypes ifNil: [ StructTypes := WeakValueDictionary new]. ArrayTypes ifNil: [ + ArrayTypes := Dictionary new]. - ArrayTypes := WeakValueDictionary new]. self cleanupUnusedTypes. StructTypes valuesDo:[:structType | structType "asNonPointerType" compiledSpec: (WordArray with: self structureSpec); byteAlignment: nil. structType asPointerType compiledSpec: (WordArray with: self pointerSpec); byteAlignment: nil]. + ArrayTypes valuesDo: [:sizes | sizes do: [:arrayType | - ArrayTypes valuesDo: [:arrayType | arrayType compiledSpec: (WordArray with: (arrayType headerWord bitClear: FFIStructSizeMask)); byteAlignment: nil. arrayType asPointerType compiledSpec: (WordArray with: self pointerSpec); + byteAlignment: nil]].! - byteAlignment: nil].! Item was added: + ----- Method: ExternalType class>>newTypeForAtomicNamed: (in category 'instance creation') ----- + newTypeForAtomicNamed: atomicTypeName + + ^ ExternalAtomicType newTypeForAtomicNamed: atomicTypeName! Item was changed: ----- Method: ExternalType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- newTypeForUnknownNamed: typeName + ^ ExternalUnknownType newTypeForUnknownNamed: typeName! - ^ ExternalStructureType newTypeForUnknownNamed: typeName! Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." | structClass arraySpec | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. + self + assert: [aTypeName first ~~ $*] + description: 'Non-pointer type for alias-to-pointer types will be created automatically'. aTypeName last == $] ifTrue: [ "array type, e.g., char[50]" arraySpec := self parseArrayTypeName: aTypeName. arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)]. ^ self newTypeForContentType: arraySpec second size: arraySpec third]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]]. ^ structClass ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') ----- noticeModificationOf: aClass "A subclass of ExternalStructure has been redefined. Clean out any obsolete references to its type." + aClass withAllSubclassesDo: [:cls | | typeName type | - aClass withAllSubclassesDo: [:cls | | typeName | typeName := cls name. + + ArrayTypes at: typeName ifPresent: [:sizes | + sizes do: [:arrayType | arrayType ifNotNil: [ + arrayType newReferentClass: cls. + arrayType asPointerType newReferentClass: cls]]]. + + (type := StructTypes at: typeName ifAbsent: []) + ifNotNil: [ - (StructTypes at: typeName ifAbsent: []) - ifNotNil: [:type | type newReferentClass: cls. + type asPointerType newReferentClass: cls. + type newTypeAlias]]! - type asPointerType newReferentClass: cls]. - ArrayTypes keysAndValuesDo: [:nameSpec :arrayType | - arrayType ifNotNil: [ - nameSpec key = typeName "content type" ifTrue: [ - arrayType newReferentClass: cls. - arrayType asPointerType newReferentClass: cls]]]]! Item was changed: ----- Method: ExternalType class>>noticeRemovalOf: (in category 'housekeeping') ----- noticeRemovalOf: aClass "A subclass of ExternalStructure is being removed. Clean out any obsolete references to its type." | type | type := StructTypes at: aClass name ifAbsent:[nil]. type == nil ifFalse:[ type newReferentClass: nil. type asPointerType newReferentClass: nil]. + ArrayTypes at: aClass name ifPresent: [:sizes | + sizes do: [:arrayType | + arrayType newReferentClass: nil. + arrayType asPointerType newReferentClass: nil]].! - ! Item was changed: ----- Method: ExternalType class>>noticeRenamingOf:from:to: (in category 'housekeeping') ----- noticeRenamingOf: aClass from: oldName to: newName "An ExternalStructure has been renamed from oldName to newName. Keep our type names in sync." (StructTypes at: oldName ifAbsent:[nil]) ifNotNil: [:type | StructTypes at: newName put: type]. StructTypes removeKey: oldName ifAbsent: []. + (ArrayTypes at: oldName ifAbsent: [nil]) + ifNotNil: [:sizes | ArrayTypes at: newName put: sizes]. + ArrayTypes removeKey: oldName ifAbsent: [].! - ArrayTypes keys do: [:nameSpec | - nameSpec key = oldName ifTrue: [ - nameSpec key: newName]]. - ArrayTypes rehash.! Item was added: + ----- Method: ExternalType class>>pointerAliasAlignment (in category 'private') ----- + pointerAliasAlignment + ^ self pointerAlignment! Item was added: + ----- Method: ExternalType class>>pointerAliasSpec (in category 'private') ----- + pointerAliasSpec + "Answers a mask to check the #headerWord for a type alias to a pointer type." + ^ self structureSpec bitOr: self pointerSpec! Item was added: + ----- Method: ExternalType class>>pointerTypeNames (in category 'instance list') ----- + pointerTypeNames + + ^ self pointerTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>pointerTypes (in category 'instance list') ----- + pointerTypes + "Answers the currently known pointer types, including type-alias-to-pointer types." + + ^ Array streamContents: [:stream | + self pointerTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>pointerTypesDo: (in category 'instance list') ----- + pointerTypesDo: block + "Answers the currently known pointer types, including type-alias-to-pointer types." + + self atomicTypesDo: [:type | + block value: type asPointerType]. + self structTypesDo: [:type | + block value: type asPointerType]. + self arrayTypesDo: [:type | + block value: type asPointerType]. + + "Type aliases to pointer types are managed in StructTypes but are actual pointer types." + StructTypes do: [:each | (each notNil and: [each isPointerType]) + ifTrue: [block value: each]].! Item was added: + ----- Method: ExternalType class>>resetAllTypes (in category 'housekeeping') ----- + resetAllTypes + "If we reset the atomic types, we reset everything else." + + self resetAllAtomicTypes.! Item was changed: ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') ----- structTypeNamed: typeName "Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class." ^ (StructTypes at: typeName ifAbsent: [nil]) + ifNil: [ "Create struct types for existing struct classes on-the-fly." - ifNil: [ StructTypes removeKey: typeName ifAbsent: []. + (self environment classNamed: typeName) + ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ + self newTypeNamed: typeName]]]! - self newTypeNamed: typeName]! Item was added: + ----- Method: ExternalType class>>structTypeNames (in category 'instance list') ----- + structTypeNames + "Answers the names of the currently known struct types." + + ^ self structTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>structTypes (in category 'instance list') ----- + structTypes + "Answers the currently known struct types, including type-alias-to-atomic and type-alias-to-struct types." + + ^ Array streamContents: [:stream | + self structTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>structTypesDo: (in category 'instance list') ----- + structTypesDo: block + "Enumerate all struct types. Includes types for packed structs and unions." + + StructTypes do: [:each | (each notNil and: [each isStructureType]) + ifTrue: [block value: each]]! Item was added: + ----- Method: ExternalType class>>typeAliasTypeNames (in category 'instance list') ----- + typeAliasTypeNames + + ^ self typeAliasTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>typeAliasTypes (in category 'instance list') ----- + typeAliasTypes + "Answers the currently known type-alias types." + + ^ Array streamContents: [:stream | + self typeAliasTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>typeAliasTypesDo: (in category 'instance list') ----- + typeAliasTypesDo: block + "All type alias types are managed in StructTypes for easy reference via #referentClass." + + StructTypes do: [:each | each ifNotNil: [:type | + type isTypeAlias ifTrue: [block value: type]]]! Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName "Supports pointer-type lookup for both atomic and structure types. + Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *', 'IntPtr', '*IntPtr' " - Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'" + | isPointerType isNonPointerType isArrayType actualTypeName type | + isArrayType := false. isNonPointerType := false. + actualTypeName := typeName copyWithoutAll: ' '. - | isPointerType isArrayType actualTypeName type | - isArrayType := false. - (isPointerType := typeName last == $*) - ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] - ifFalse: [(isArrayType := typeName last == $]) - ifFalse: [actualTypeName := typeName]]. + (isPointerType := actualTypeName last == $*) "e.g. MyStruct*" + ifTrue: [actualTypeName := actualTypeName allButLast]. + actualTypeName last == $) "e.g. (char[])* -- pointer type for array type" + ifTrue: [actualTypeName := (actualTypeName copyFrom: 2 to: actualTypeName size - 1)]. + (isNonPointerType := actualTypeName first == $*) "e.g. *DoublePtr" + ifTrue: [actualTypeName := actualTypeName allButFirst]. - isArrayType - ifTrue: [^ self arrayTypeNamed: typeName]. + (isArrayType := actualTypeName last == $]) + ifTrue: [ type := self arrayTypeNamed: actualTypeName ] + ifFalse: [ + (Symbol lookup: actualTypeName) + ifNotNil: [:sym | actualTypeName := sym]. + type := (self atomicTypeNamed: actualTypeName) + ifNil: [self structTypeNamed: actualTypeName]]. - (Symbol lookup: actualTypeName) - ifNotNil: [:sym | actualTypeName := sym]. + ^ type ifNotNil: [ + isPointerType + ifTrue: [type asPointerType "e.g. int* MyStruct* "] + ifFalse: [isNonPointerType + ifTrue: [type asNonPointerType "e.g. *IntPtr *MyStructPtr "] + ifFalse: [type "e.g. int IntPtr MyStruct MyStructPtr "]]]! - type := (self atomicTypeNamed: actualTypeName) - ifNil: [self structTypeNamed: actualTypeName]. - - ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was changed: ----- Method: ExternalType>>allocate (in category 'external data') ----- allocate "Allocate a single representative for this type." + ^ (self asNonPointerType allocate: 1) first! - self isPointerType ifTrue: [ - self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - ^ ExternalType void asPointerType allocate: 1]. - - ^ (self allocate: 1) first! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- allocate: numElements "Allocate space for containing an array of numElements of this dataType" | handle | - self - flag: #contentVsContainer; - assert: [self isPointerType not or: [self isVoid]] - description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; - assert: [self byteSize > 0] - description: 'Invalid byte size.'. - handle := ByteArray new: self byteSize * numElements. ^ExternalData fromHandle: handle type: self size: numElements! Item was changed: ----- Method: ExternalType>>allocateExternal (in category 'external data') ----- allocateExternal "Allocate a single representative for this type in external memory." + | result | + ^ [(result := self asNonPointerType allocateExternal: 1) first] + ensure: [ self isAtomic ifTrue: [result free] ]! - | result | - self isPointerType ifTrue: [ - self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - ^ ExternalType void asPointerType allocateExternal: 1]. - - "By design, aliased pointers are stored as byte array." - self isTypeAliasForPointer ifTrue: [^ self allocate]. - - ^ [(result := self allocateExternal: 1) first] - ensure: [ - "Atomics and alias-to-atomic are immediately available in object memory. We thus must free the external memory to avoid leaks." - self isStructureType ifFalse: [result free]]! Item was changed: ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- allocateExternal: numElements "Allocate space for containing an array of numElements of this type. Note that we zero the memory for safe use. If you do not need that, please use ExternalAddress class >> #allocate: directly. BE AWARE that structs can have pointers tools automatically follow and thus risking a SEGFAULT and hence VM CRASH for uninitalized memory." + | handle arrayByteSize | + arrayByteSize := self byteSize * numElements. + handle := ExternalAddress allocateZero: arrayByteSize. + ^ ExternalData fromHandle: handle type: self size: numElements! - | handle | - self - flag: #contentVsContainer; - assert: [self isPointerType not or: [self isVoid]] - description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; - assert: [self byteSize > 0] - description: 'Invalid byte size.'. - - handle := ExternalAddress allocate: self byteSize * numElements. - ^(ExternalData fromHandle: handle type: self size: numElements) - zeroMemory; - yourself! Item was added: + ----- Method: ExternalType>>asExternalType (in category 'converting') ----- + asExternalType + + ^ self! Item was added: + ----- Method: ExternalType>>becomeStructureType (in category 'private - type alias') ----- + becomeStructureType + + self class = ExternalStructure ifTrue: [^ self]. + + self class = ExternalPointerType ifTrue: [ + | newPointerType | + "We are not a type alias for a pointer type anymore." + self changeClassTo: ExternalStructureType. + + "Fetch my updated spec as a structure type." + compiledSpec := referentClass compiledSpec. + byteAlignment := referentClass byteAlignment. + + "Prepare and set my new, dedicated pointer type." + (newPointerType := ExternalPointerType basicNew) + compiledSpec: (WordArray with: self class pointerSpec); + byteAlignment: self class pointerAlignment; + setReferentClass: referentClass; + setReferencedType: self. + referencedType := newPointerType. + + "Done. Answer self because of #changeClassTo:." + ^ self]. + + self class = ExternalArrayType ifTrue: [ + "An not #isTypeAliasForArray anymore. :-( " + | newStructType | + newStructType := ExternalStructureType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + yourself. + + "Not a pointer type for array type anymore." + referencedType setReferentClass: referentClass. + + self becomeForward: newStructType. + self assert: [newStructType class = ExternalStructureType]. + ^ newStructType].! Item was removed: - ----- Method: ExternalType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - (self isPointerType not and: [referentClass notNil]) - ifTrue: [self error: 'Must convert to ExternalStructureType before use']. - - self - assert: [self isStructureType not] - description: 'Convert to ExternalStructureType to use this feature'.! Item was changed: ----- Method: ExternalType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." + + self subclassResponsibility.! - - self checkType. - - self isPointerType - ifFalse: [ - "Answer atomic value" - ^ handle - perform: (AtomicSelectors at: self atomicType) - with: byteOffset] - ifTrue: [ - ^ referentClass - ifNotNil: [ - "Answer structure, union, or type alias" - referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] - ifNil: [ - "Answer wrapper that points to external data, unknown size (i.e. number of elements)" - ExternalData - fromHandle: (handle pointerAt: byteOffset length: self byteSize) - type: self ]]! Item was changed: ----- Method: ExternalType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + self subclassResponsibility.! - self checkType. - - self isPointerType - ifFalse: [ "set atomic value" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: value] - ifTrue: [ "set pointer to struct/union/alias" - self class extraTypeChecks ifTrue: [ - self assert: [value externalType == self]]. - handle - pointerAt: byteOffset - put: value getHandle - length: self byteSize].! Item was changed: ----- Method: ExternalType>>isArrayType (in category 'testing') ----- isArrayType + self flag: #todo. "mt: Change once encoded in headerWord. See #isAtomic for inspiration." ^ false! Item was changed: ----- Method: ExternalType>>isAtomic (in category 'testing') ----- isAtomic "Return true if the receiver describes a built-in type" + + ^ (self headerWord anyMask: FFIFlagAtomic) + and: [self headerWord noMask: FFIFlagPointer]! - ^self headerWord anyMask: FFIFlagAtomic! Item was added: + ----- Method: ExternalType>>isEmpty (in category 'testing - special') ----- + isEmpty + + ^ self byteSize = 0! Item was changed: ----- Method: ExternalType>>isPointerType (in category 'testing') ----- isPointerType + + ^ self headerWord anyMask: FFIFlagPointer! - "Return true if the receiver represents a pointer type" - ^self isStructureType not and:[self headerWord anyMask: FFIFlagPointer]! Item was changed: ----- Method: ExternalType>>isStructureType (in category 'testing') ----- isStructureType "Return true if the receiver represents a structure type" + + ^ (self headerWord anyMask: FFIFlagStructure) + and: [self headerWord noMask: FFIFlagPointer "alias to pointer type"] + and: [self isArrayType not "alias to array type"]! - ^self headerWord anyMask: FFIFlagStructure! Item was changed: ----- Method: ExternalType>>isTypeAlias (in category 'testing') ----- isTypeAlias + + self subclassResponsibility.! - - ^ false! Item was removed: - ----- Method: ExternalType>>isTypeAliasForPointer (in category 'testing') ----- - isTypeAliasForPointer - - ^ false! Item was added: + ----- Method: ExternalType>>isTypeAliasReferenced (in category 'testing') ----- + isTypeAliasReferenced + "Answer whether this type is the referencedType of a type alias." + + ^ referencedType notNil and: [referencedType isTypeAlias]! Item was added: + ----- Method: ExternalType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ (self isAtomic + or: [self isPointerType + or: [self isStructureType + or: [self isArrayType]]]) not! Item was changed: + ----- Method: ExternalType>>isVoid (in category 'testing - special') ----- - ----- Method: ExternalType>>isVoid (in category 'testing') ----- isVoid "Return true if the receiver describes a plain 'void' type" ^self isAtomic and:[self atomicType = 0]! Item was changed: ----- Method: ExternalType>>newReferentClass: (in category 'private') ----- newReferentClass: classOrNil - "The class I'm referencing has changed. Update my spec." + referentClass := classOrNil.! - referentClass := classOrNil. - self assert: [referentClass isNil or: [self isAtomic not and: [self isPointerType]]].! Item was added: + ----- Method: ExternalType>>newTypeAlias (in category 'private') ----- + newTypeAlias + + self subclassResponsibility.! Item was added: + ----- Method: ExternalType>>originalType (in category 'accessing - type alias') ----- + originalType + "Resolve original type for alias. Error if not a type alias." + + ^ referentClass originalType! Item was removed: - ----- Method: ExternalType>>pointerSize (in category 'accessing') ----- - pointerSize - - ^ self asPointerType headerWord bitAnd: FFIStructSizeMask! Item was added: + ----- Method: ExternalType>>printContentsOn: (in category 'printing') ----- + printContentsOn: aStream + + aStream + space; + nextPut: $(; + nextPutAll: self byteSize asString; + space; + nextPutAll: self byteAlignment asString; + nextPut: $).! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream + self printTypeNameOn: aStream. - aStream nextPutAll: self typeName. + (self isTypeAlias or: [self isTypeAliasReferenced]) + ifTrue: [self printOriginalTypeOn: aStream] + ifFalse: [self printContentsOn: aStream].! - aStream - space; - nextPut: $(; - nextPutAll: self byteSize asString; - space; - nextPutAll: self byteAlignment asString; - nextPut: $).! Item was added: + ----- Method: ExternalType>>printOriginalTypeOn: (in category 'printing') ----- + printOriginalTypeOn: aStream + + aStream + nextPutAll: ' ~> '; + print: self originalType.! Item was added: + ----- Method: ExternalType>>printTypeNameOn: (in category 'printing') ----- + printTypeNameOn: aStream + + aStream nextPutAll: self typeName.! Item was changed: ----- Method: ExternalType>>readAlias (in category 'external structure') ----- readAlias + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "this is an aliased atomic, non-pointer type" - s nextPutAll: '^handle "', self writeFieldArgName, '"'] - ifTrue: [ - referentClass - ifNotNil: [ - "this is an aliased pointer to a structure, union, or type alias" - s nextPutAll:'^', referentClass name,' fromHandle: handle asExternalPointer'] - ifNil: [ - "this is an aliased pointer to external data" - s nextPutAll: '^ ExternalData fromHandle: handle'. - self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']. - s nextPutAll:' type: '. - s nextPutAll: self asPointerType storeString]]]! Item was changed: ----- Method: ExternalType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - - self isPointerType - ifFalse: [ - "Atomic value" - s nextPutAll:'^handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset] - ifTrue: [ - referentClass - ifNotNil: [ - "Pointer to structure, union, or type alias" - s nextPutAll: '^'; - print: referentClass; - nextPutAll: ' fromHandle: (handle pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPut: $)] - ifNil: [ - "Pointer to external data" - s nextPutAll: '^ ExternalData fromHandle: (handle pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') type: ExternalType '; - nextPutAll: self atomicTypeName]]].! Item was added: + ----- Method: ExternalType>>size (in category 'accessing') ----- + size + "Backstop for array types. Undefined for all other types. Once encoded in the headerWord, this might answer something more specific for all types." + + ^ nil! Item was changed: ----- Method: ExternalType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self flag: #todo. "mt: There are more compact (and maybe faster) representations for atomic types." + aStream + nextPut: $(; + nextPutAll: ExternalType name; space; + nextPutAll: #typeNamed:; space; + store: self typeName; + nextPutAll: ')'.! - referentClass - ifNil: [ "atomic or pointer to atomic" - aStream nextPutAll: ExternalType name; space; nextPutAll: self atomicTypeName] - ifNotNil: [ "pointer to structure or union or type alias" - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #structTypeNamed:; space; - store: referentClass name; - nextPutAll: ')']. - - self isPointerType ifTrue: [aStream space; nextPutAll: #asPointerType]! Item was changed: ----- Method: ExternalType>>typeName (in category 'accessing') ----- typeName ^ String streamContents: [:stream | + (self isPointerType not and: [self asPointerType isTypeAlias]) + ifTrue: [stream nextPut: $* "e.g. *DoublePtr *MyStructPtr"] + ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"]. + stream nextPutAll: (referentClass + ifNil: [self atomicTypeName "e.g. double double*"] + ifNotNil: [referentClass name "e.g. MyStruct MyStruct* MyStructPtr *MyStructPtr"]). + + (self isPointerType and: [self isTypeAlias not]) + ifTrue: [stream nextPut: $* "e.g. double* MyStruct*"] + ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"]]! - ifNil: [self atomicTypeName] - ifNotNil: [referentClass name]). - self isPointerType - ifTrue: [stream nextPut: $*]]! Item was changed: ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "this is an aliased atomic non-pointer type" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle := ', valueName, '.'] - ifTrue: [ - "this is an aliased pointer type" - self class extraTypeChecks ifTrue: ["expect the value to be a structure/union/alias/data with an external address as handle" - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle := ', valueName,' getHandle asByteArrayPointer']]! Item was changed: ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') ----- writeFieldArgName + ^ referentClass + ifNotNil: ['a',referentClass name] + ifNil: ['externalData']! - ^ self isPointerType - ifFalse: [ - self atomicTypeName caseOf: { - ['bool'] -> ['aBoolean']. - ['char'] -> ['aCharacter']. - ['schar'] -> ['aCharacter']. - ['float'] -> ['aFloat']. - ['double'] -> ['aFloat']. - } otherwise: ['anInteger']] - ifTrue: [ - referentClass - ifNotNil: ['a',referentClass name] - ifNil: ['externalData']]! Item was changed: ----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "Atomic value" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName] - ifTrue: [ - "Pointer to structure, union, type alias, or external data." - self class extraTypeChecks ifTrue: [ - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle pointerAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle'; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: '.']]! Item was added: + ----- Method: ExternalTypeAlias class>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ true! Item was changed: ----- Method: ExternalTypeAlias class>>originalTypeName (in category 'type alias') ----- originalTypeName - "Answer the typeName this alias should be for, e.g., 'long', 'ulonglong*'. Provide a default here to make automated sends to #compileFields work." + self subclassResponsibility.! - ^ 'void*'! Item was changed: ----- Method: ExternalTypeAlias>>doesNotUnderstand: (in category 'proxy') ----- doesNotUnderstand: msg + "Use aliases as transparent proxies." + - ^ msg sendTo: self value! Item was added: + ExternalType subclass: #ExternalUnknownType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalUnknownType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- + newTypeForUnknownNamed: typeName + + | type pointerType | + self + assert: [(StructTypes includesKey: typeName) not] + description: 'Type already exists. Use #typeNamed: to access it.'. + + type := ExternalUnknownType basicNew + compiledSpec: (WordArray with: self structureSpec); + yourself. + self assert: [type isEmpty]. + + pointerType := ExternalPointerType basicNew + compiledSpec: (WordArray with: self pointerSpec); + byteAlignment: self pointerAlignment; + yourself. + self assert: [pointerType isPointerType]. + + "Connect non-pointer type with pointer type." + type setReferencedType: pointerType. + pointerType setReferencedType: type. + + "Remember this new struct type." + StructTypes at: typeName asSymbol put: type. + + ^ type! Item was added: + ----- Method: ExternalUnknownType>>becomeArrayType (in category 'construction') ----- + becomeArrayType + "I am now positive on #isTypeAliasForArray :-) Make myself an array type. Not that easy because Arraytype as extra instVars #size and #contentType." + + | newArrayType | + newArrayType := ExternalArrayType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + setContentType: referentClass originalType contentType; "Hmm..." + setSize: referentClass originalType size; "Hmm..." + yourself. + + "No referentClass for pointer types of array types." + referencedType setReferentClass: nil. + + self becomeForward: newArrayType. + + ^ newArrayType! Item was added: + ----- Method: ExternalUnknownType>>becomeAtomicType (in category 'construction') ----- + becomeAtomicType + + self changeClassTo: ExternalAtomicType.! Item was added: + ----- Method: ExternalUnknownType>>becomeKnownType (in category 'construction') ----- + becomeKnownType + "Give me some purpose. :-) The order of checks matters because some tests only look at the #headerWord. Make the tests that look into referentClass first." + + self isTypeAliasForStructure + ifTrue: [^ self becomeStructureType]. + self isTypeAliasForArray + ifTrue: [^ self becomeArrayType]. + + self isTypeAliasForAtomic + ifTrue: [^ self becomeAtomicType]. + self isTypeAliasForPointer + ifTrue: [^ self becomePointerType]. + + ^ self becomeStructureType! Item was added: + ----- Method: ExternalUnknownType>>becomePointerType (in category 'construction') ----- + becomePointerType + "I am a type alias for a pointer type now. Forget my current pointer type (i.e. referencedType), which I will replace myself. Also, create a new non-pointer type based on a copy of the original type's non-pointer type. In that copy, we can (1) replace the referentClass with mine and (2) link back to use via referencedType so that #asPointerType and #asNonPointerType work as expected." + + self changeClassTo: ExternalPointerType. + self newTypeAlias.! Item was added: + ----- Method: ExternalUnknownType>>becomeStructureType (in category 'construction') ----- + becomeStructureType + + self changeClassTo: ExternalStructureType.! Item was added: + ----- Method: ExternalUnknownType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ [self isTypeAliasForAtomic + or: [self isTypeAliasForPointer + or: [self isTypeAliasForStructure + or: [self isTypeAliasForArray]]] + ] ifError: [false "Ignore uninitialized field specs"]! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForArray (in category 'testing - type alias') ----- + isTypeAliasForArray + "Overwritten because at some point, the receiver might be an alias and not yet changed to ExternalArrayType. See #becomeArrayType. Once #isArrayType is encoded in the headerWord, this can be removed." + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isArrayType]]! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForAtomic (in category 'testing - type alias') ----- + isTypeAliasForAtomic + + ^ self headerWord allMask: FFIFlagAtomic! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForPointer (in category 'testing - type alias') ----- + isTypeAliasForPointer + + ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForStructure (in category 'testing - type alias') ----- + isTypeAliasForStructure + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isStructureType]]! Item was added: + ----- Method: ExternalUnknownType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ true! Item was added: + ----- Method: ExternalUnknownType>>newReferentClass: (in category 'construction') ----- + newReferentClass: classOrNil + + self assert: [classOrNil notNil]. + + referentClass := classOrNil. + compiledSpec := referentClass compiledSpec. + byteAlignment := referentClass byteAlignment.! Item was added: + ----- Method: ExternalUnknownType>>newTypeAlias (in category 'construction') ----- + newTypeAlias + + self shouldNotImplement.! Item was added: + ----- Method: ExternalUnknownType>>printOn: (in category 'printing') ----- + printOn: aStream + + aStream nextPutAll: ''.! Item was added: + ----- Method: ExternalUnknownType>>typeName (in category 'accessing') ----- + typeName + + self shouldNotImplement.! Item was added: + ----- Method: FFIPlatformDescription class>>checkFFI (in category 'system startup') ----- + checkFFI + "Try to load the FFI module. Warn if not possible." + + [ [ExternalType int32_t + handle: #[ 0 0 0 0 ] + at: 1 + put: 42] ifError: [:msg | + self notify: 'FFI plugin not available.', String cr, String cr, msg] + ] fork. "Do not interrupt the startup list."! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull. ExternalType cleanupUnusedTypes ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." { ExternalAddress. ExternalType. ExternalStructure. ExternalPool } do: [:cls | cls platformChangedFrom: lastPlatform + to: currentPlatform] ]]]. + self checkFFI].! - to: currentPlatform] ]]] ].! Item was added: + ----- Method: Object>>isExternalObject (in category '*FFI-Kernel') ----- + isExternalObject + "Answer true if the receiver is a representation for an object that lives in external memory. Note that Squeak FFI supports managing such object in internal object memory, too. See ExternalObject, ExternalStructure, ExternalUnion, ExternalData etc. and also #isInternalMemory and #isExternalAddress." + + ^ false! From commits at source.squeak.org Fri May 14 13:01:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:01:55 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.143.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.143.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.143 Author: mt Time: 14 May 2021, 3:01:53.90276 pm UUID: 94cef049-a4ee-534b-ad41-145d09816d5d Ancestors: FFI-Kernel-mt.142 Adds a generic way to compare external objects for identity and equality. =============== Diff against FFI-Kernel-mt.142 =============== Item was added: + ----- Method: ByteArray>>ffiEqual: (in category '*FFI-Kernel-comparing') ----- + ffiEqual: other + + ^ self = other withoutReadWriter! Item was added: + ----- Method: ByteArray>>ffiIdentical: (in category '*FFI-Kernel-comparing') ----- + ffiIdentical: other + + ^ self == other withoutReadWriter! Item was added: + ----- Method: ExternalData>>ffiEqual: (in category 'comparing') ----- + ffiEqual: other + "WARNING!! EXPENSIVE!! We can compare bytes if the types are compatible." + + (self ffiIdentical: other) ifTrue: [^ true]. + + self flag: #todo. "mt: Which types are actually compatible? :-)" + self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false]. + + self flag: #todo. "mt: Follow pointers? Detect cycles? Hmmm... :-) See #free as inspiration." + ^ self copy getHandle ffiEqual: other copy getHandle! Item was added: + ----- Method: ExternalData>>ffiEqualityHash (in category 'comparing') ----- + ffiEqualityHash + "WARNING!! EXPENSIVE!!" + + self ffiIdentityHash + bitXor: self copy getHandle hash! Item was added: + ----- Method: ExternalObject>>= (in category 'comparing') ----- + = other + "By default, we use the not-so-expensive check for external indentity like Object does. Subclasses can choose to use #ffiEqual:, which compares types and bytes, or implement their own domain-specific notion of equality." + + ^ self ffiIdentical: other! Item was added: + ----- Method: ExternalObject>>ffiEqual: (in category 'comparing') ----- + ffiEqual: other + "We do not know better." + + ^ self ffiIdentical: other! Item was added: + ----- Method: ExternalObject>>ffiEqualityHash (in category 'comparing') ----- + ffiEqualityHash + + ^ self ffiIdentityHash! Item was added: + ----- Method: ExternalObject>>ffiIdentical: (in category 'comparing') ----- + ffiIdentical: other + "Define identity for external objects. External objects sharing an external address are considered 'externally identical.' " + + self == other ifTrue: [^ true]. + other isExternalObject ifFalse: [^ false]. + self getHandle species = other getHandle species ifFalse: [^ false]. + + ^ (self getHandle ffiIdentical: other getHandle) or: [ + self checkHandle. other checkHandle. + self getHandle isExternalAddress + and: [other getHandle isExternalAddress] + and: [self getHandle = other getHandle]]! Item was added: + ----- Method: ExternalObject>>ffiIdentityHash (in category 'comparing') ----- + ffiIdentityHash + + ^ self species scaledIdentityHash bitXor: self getHandle scaledIdentityHash! Item was added: + ----- Method: ExternalObject>>hash (in category 'comparing') ----- + hash + + ^ self ffiIdentityHash! Item was added: + ----- Method: ExternalStructure>>ffiEqual: (in category 'comparing') ----- + ffiEqual: other + "We can compare bytes if the types are compatible." + + (self ffiIdentical: other) ifTrue: [^ true]. + self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false]. + ^ self asArray ffiEqual: other asArray! Item was added: + ----- Method: ExternalStructure>>ffiEqualityHash (in category 'comparing') ----- + ffiEqualityHash + + ^ self ffiIdentityHash + bitXor: self asArray ffiEqualityHash! Item was added: + ----- Method: ExternalStructure>>ffiIdentical: (in category 'comparing') ----- + ffiIdentical: other + "Overwritten to also check the receiver's external type." + + (super ffiIdentical: other) ifFalse: [^ false]. + ^ self externalType = other externalType! Item was added: + ----- Method: ExternalStructure>>ffiIdentityHash (in category 'comparing') ----- + ffiIdentityHash + + ^ super ffiIdentityHash bitXor: self externalType scaledIdentityHash! Item was removed: - ----- Method: ExternalTypeAlias>>= (in category 'comparing') ----- - = anExternalTypeAlias - ^self class = anExternalTypeAlias class and: [self value = anExternalTypeAlias value]! Item was removed: - ----- Method: ExternalTypeAlias>>hash (in category 'comparing') ----- - hash - ^self class hash hashMultiply bitXor: self value hash! Item was added: + ----- Method: Object>>ffiEqual: (in category '*FFI-Kernel') ----- + ffiEqual: other + + ^ self = other! Item was added: + ----- Method: Object>>ffiIdentical: (in category '*FFI-Kernel') ----- + ffiIdentical: other + + ^ self == other! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. + ExternalType resetAllTypes. - "Adds housekeeping for array types." - ExternalType resetAllStructureTypes. "Re-generate all field accessors because in ExternalData, #size: was replaced with #setSet: and a new constructors for content and container types." ExternalStructure defineAllFields. '! From commits at source.squeak.org Fri May 14 13:03:37 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:03:37 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.32.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.32.mcz ==================== Summary ==================== Name: FFI-Tests-mt.32 Author: mt Time: 14 May 2021, 3:03:36.29576 pm UUID: b806028d-7859-7f44-8485-b5958de811ed Ancestors: FFI-Tests-mt.31 Re-designs and expands all FFI tests. We now have about 400 tests for the type system, type-based allocation, and FFI plugin calls. =============== Diff against FFI-Tests-mt.31 =============== Item was removed: - TestCase subclass: #ExternalStructureTests - instanceVariableNames: 'heapObject' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests'! Item was removed: - ----- Method: ExternalStructureTests>>tearDown (in category 'running') ----- - tearDown - - heapObject ifNotNil: [heapObject free].! Item was removed: - ----- Method: ExternalStructureTests>>test01AccessingUnion (in category 'tests') ----- - test01AccessingUnion - - | ufi | - ufi := FFITestUfi new. - ufi i1: 2. - self assert: 2 equals: ufi i1. - ufi f1: 1.0. - self assert: 1.0 equals: ufi f1. - self assert: 1.0 asIEEE32BitWord equals: ufi i1. - ufi i1: 2.0 asIEEE32BitWord. - self assert: 2.0 equals: ufi f1.! Item was removed: - ----- Method: ExternalStructureTests>>test01CopyStructure (in category 'tests - external structure') ----- - test01CopyStructure - - | original copy | - original := FFITestPoint2 new. - original setX: 1 setY: 2. - - copy := original copy. - self assert: original getHandle ~~ copy getHandle. - - copy setX: 3 setY: 4. - self assert: 1 at 2 equals: original asPoint. - self assert: 3 at 4 equals: copy asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test01FromToInternal (in category 'tests - external data') ----- - test01FromToInternal - "Access a sub-range in the external data. Internal memory will be copied if not accessed through a read-writer." - - | points portion | - points := FFITestPoint2 allocate: 5. - portion := points from: 2 to: 3. - self assert: portion getHandle isInternalMemory. - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Forgot to use a read-writer..." - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Forgot to use a read-writer early enough..." - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - portion := points writer from: 2 to: 3. - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - points zeroMemory. - portion := points reader from: 2 to: 3. - portion writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Both #reader and #writer used. No worries." - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test02AccessingStructure (in category 'tests') ----- - test02AccessingStructure - - | pt | - pt := FFITestPoint2 new. - pt x: 10; y: 20. - self assert: 10 equals: pt x. - self assert: 20 equals: pt y.! Item was removed: - ----- Method: ExternalStructureTests>>test02CopyStructureFromExternal (in category 'tests - external structure') ----- - test02CopyStructureFromExternal - - | original copy | - original := heapObject := FFITestPoint2 allocateExternal. - original setX: 1 setY: 2. - - copy := original copy. - self assert: copy getHandle isInternalMemory. - - copy setX: 3 setY: 4. - self assert: 1 at 2 equals: original asPoint. - self assert: 3 at 4 equals: copy asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test02FromToExternal (in category 'tests - external data') ----- - test02FromToExternal - "Access a sub-range in the external data. External memory will not be copied." - - | points portion | - points := heapObject := FFITestPoint2 allocateExternal: 5. - - portion := points from: 2 to: 3. - self assert: portion getHandle isExternalAddress. - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test03AccessingExternalData (in category 'tests') ----- - test03AccessingExternalData - - | somePoints firstPoint | - somePoints := FFITestPoint2 allocate: 5. - self assert: 5 equals: somePoints size. - firstPoint := somePoints at: 1. - self assert: 0 at 0 equals: firstPoint asPoint. - firstPoint setX: 2 setY: 3. - self assert: 2 at 3 equals: firstPoint asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test03CopyFromExternalToInternal (in category 'tests - external data') ----- - test03CopyFromExternalToInternal - - | points copy | - points := FFITestPoint2 allocateExternal: 5. - self assert: points getHandle isExternalAddress. - - copy := points copyFrom: 2 to: 3. - self assert: copy getHandle isInternalMemory. - - "We need a writer to modify internal memory." - copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). - copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). - - "Check that we did not touch the external memory." - self - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test03LinkedList (in category 'tests - external structure') ----- - test03LinkedList - - | link1 link2 link3 | - [ link1 := FFITestLink allocateExternal. - link2 := FFITestLink allocateExternal. - link3 := FFITestLink allocateExternal. - link1 next: link2. link2 prev: link1. - link2 next: link3. link3 prev: link2. - link3 next: link1. link1 prev: link3. - self assert: link1 next = link2. - self assert: link2 next = link3. - self assert: link3 next = link1. - - self assert: link3 prev = link2. - self assert: link2 prev = link1. - self assert: link1 prev = link3. - - ] ensure: [ - link1 free. - link2 free. - link3 free. - ]! Item was removed: - ----- Method: ExternalStructureTests>>test04AccessingInternalMemory (in category 'tests') ----- - test04AccessingInternalMemory - "Check whether we can use a ByteArrayWriter to fill structures." - - | composite | - composite := FFITestSUfdUdSi2 allocate. - - self assert: composite ~~ composite writer. - - self assert: 0.0 equals: composite ufd1 f1. - composite ufd1 f1: 3.5. - self deny: 3.5 equals: composite ufd1 f1. - composite writer ufd1 f1: 3.5. - self assert: 3.5 equals: composite ufd1 f1. - - self assert: 0 equals: composite udSii2 sii1 i1. - composite udSii2 sii1 i1: 42. - self deny: 42 equals: composite udSii2 sii1 i1. - composite writer udSii2 sii1 i1: 42. - self assert: 42 equals: composite udSii2 sii1 i1.! Item was removed: - ----- Method: ExternalStructureTests>>test04CopyFromInternalToInternal (in category 'tests - external data') ----- - test04CopyFromInternalToInternal - - | points copy | - points := FFITestPoint2 allocate: 5. - self assert: points getHandle isInternalMemory. - - copy := points copyFrom: 2 to: 3. - self assert: copy getHandle isInternalMemory. - - "We need a writer to modify internal memory." - copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). - copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). - - "Check that we did not touch the original." - self - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test05AccessingExternalMemory (in category 'tests') ----- - test05AccessingExternalMemory - "Check whether we will stick to the ExternalAddress to fill structures." - - | composite | - composite := heapObject := FFITestSUfdUdSi2 allocateExternal. - - self assert: composite == composite writer. - - self assert: 0.0 equals: composite ufd1 f1. - composite ufd1 f1: 3.5. - self assert: 3.5 equals: composite ufd1 f1. - - self assert: 0 equals: composite udSii2 sii1 i1. - composite udSii2 sii1 i1: 42. - self assert: 42 equals: composite udSii2 sii1 i1.! Item was removed: - ----- Method: ExternalStructureTests>>test05ReadCString (in category 'tests - external data') ----- - test05ReadCString - - | data | - ExternalData allowDetectForUnknownSizeDuring: [ - data := ExternalData fromHandle: #[65 66 67 0] type: ExternalType char. - self assert: 'ABC' equals: data fromCString. - data := ExternalData fromHandle: #[65 66 67 0 68 69 70 0 0] type: ExternalType char. - self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was removed: - ----- Method: ExternalStructureTests>>test06AccessingTypeAliasForAtomic (in category 'tests') ----- - test06AccessingTypeAliasForAtomic - - | char | - char := FFITestCharAlias new. - self assert: 0 equals: char value asInteger. - char value: $A. - self assert: $A equals: char value. - char zeroMemory. - self assert: 0 equals: char value asInteger.! Item was removed: - ----- Method: ExternalStructureTests>>test07AccessingArrays (in category 'tests') ----- - test07AccessingArrays - - | data | - data := FFITestSdA5i allocate. - self assert: data a5i2 first equals: 0. - data writer a5i2 at: 1 put: 42. - self assert: data a5i2 first equals: 42. - - data := heapObject := FFITestSdA5i allocateExternal. - self assert: data a5i2 first equals: 0. - data a5i2 at: 1 put: 42. - self assert: data a5i2 first equals: 42.! Item was changed: TestCase subclass: #ExternalTypeTests instanceVariableNames: 'heapObject' classVariableNames: '' + poolDictionaries: '' - poolDictionaries: 'ExternalType' category: 'FFI-Tests'! Item was added: + ----- Method: ExternalTypeTests>>classesForStructures (in category 'running') ----- + classesForStructures + "Answer a list of struct classes to be used when testing struct types." + + ^ { + FFITestPoint2. + FFITestSdi. + FFITestUfd. + FFITestCompoundStruct. + }! Item was added: + ----- Method: ExternalTypeTests>>classesForTypeAliases (in category 'running') ----- + classesForTypeAliases + "Answer a list of type-alias classes to be used when testing types for type aliases." + + ^ { + FFITestAliasForChar. "alias to atomic" + FFITestAliasForInt32. "alias to atomic" + FFITestAliasForSdi. "alias to struct" + }! Item was added: + ----- Method: ExternalTypeTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + testIsArrayType "Fails because compiledSpec does not yet encode that maybe because of extra information that needs to be stored in an extra instVar." + testByteSizeArrayType "(see above)" + testSizeArrayType "(see above)" + )! Item was added: + ----- Method: ExternalTypeTests>>specsForTypeAliasForPointer (in category 'running') ----- + specsForTypeAliasForPointer + "Answer a list of type-alias classes to be used when testing types for type aliases." + + ^ { + FFITestAliasForInt32Pointer . ExternalType int32_t asPointerType . + FFITestAliasForVoidPointer . ExternalType void asPointerType . + FFITestAliasForSdiPointer . FFITestSdi externalType asPointerType + }! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArray (in category 'tests - type aliases') ----- + testAliasForArray + + | type originalType | + type := FFITestAliasForInt32Array externalType. + originalType := ExternalType int32_t asArrayType: 5. + + self + assert: type isArrayType; + assert: type isTypeAlias; + + deny: type isAtomic; + deny: type isPointerType; + deny: type isStructureType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForInt32Array identical: type referentClass; + assert: nil "array of atomics" identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayByName (in category 'tests - type aliases') ----- + testAliasForArrayByName + + | type | + type := FFITestAliasForInt32Array externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayPointer (in category 'tests - type aliases') ----- + testAliasForArrayPointer + "Not supported. User void* for n-dimensional arrays." + + | type originalType | + type := FFITestAliasForInt32ArrayPointer externalType. + originalType := ExternalType void asPointerType. + + self + assert: type isTypeAlias; + assert: type isPointerType. + + self + assert: originalType + identical: type originalType.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayPointerByName (in category 'tests - type aliases') ----- + testAliasForArrayPointerByName + + | type | + type := FFITestAliasForInt32ArrayPointer externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForAtomic (in category 'tests - type aliases') ----- + testAliasForAtomic + + | type originalType | + type := FFITestAliasForInt32 externalType. + originalType := ExternalType int32_t. + + self + assert: type isAtomic; "alias means alias =)" + assert: type isTypeAlias; + + deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForInt32 identical: type referentClass; + assert: nil identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForAtomicByName (in category 'tests - type aliases') ----- + testAliasForAtomicByName + + | type | + type := FFITestAliasForInt32 externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForPointer (in category 'tests - type aliases') ----- + testAliasForPointer + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalPointerType | + | pointerType type originalType | + pointerType := aliasClass externalType. + + self + assert: pointerType isTypeAlias; + assert: pointerType isPointerType; + + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType. + + "Note that it should be possible to access the original type." + self + assert: originalPointerType + identical: pointerType originalType. + + "Check whether specs are equal to the original type's specs." + self + assert: originalPointerType byteSize + equals: pointerType byteSize; + assert: originalPointerType byteAlignment + equals: pointerType byteAlignment. + + "Note that the non-pointer type of the alias is virtually a copy." + type := pointerType "e.g. IntPr" asNonPointerType. "e.g. int ... but w/ different referentClass and referencedType" + + self + deny: type isTypeAlias; + assert: type isTypeAliasReferenced; + deny: type isPointerType; + assert: [type isAtomic "... but for something non-pointer-ish" + or: [type isStructureType + or: [type isArrayType]]]. + + originalType := originalPointerType "e.g. int*" asNonPointerType. "e.g. int" + self deny: originalType equals: type. + self deny: originalPointerType equals: pointerType. + + "Check whether specs of non-pointer type are equal + to the original type's non-pointer type specs." + self + assert: originalType headerWord + equals: type headerWord; + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: aliasClass equals: pointerType referentClass; + assert: aliasClass equals: type referentClass; + deny: aliasClass equals: originalPointerType referentClass; + deny: aliasClass equals: originalType referentClass; + + "You can go back and forth in the type alias" + assert: pointerType identical: type asPointerType; + assert: type identical: pointerType asNonPointerType].! Item was added: + ----- Method: ExternalTypeTests>>testAliasForPointerByName (in category 'tests - type aliases') ----- + testAliasForPointerByName + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalPointerType | + | pointerType type | + pointerType := aliasClass externalType asPointerType. + type := pointerType asNonPointerType. + self + assert: pointerType + identical: (ExternalType typeNamed: pointerType typeName); + assert: type + identical: (ExternalType typeNamed: type typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testAliasForStruct (in category 'tests - type aliases') ----- + testAliasForStruct + + | type originalType | + type := FFITestAliasForSdi externalType. + originalType := FFITestSdi externalType. + + self + assert: type isStructureType; + assert: type isTypeAlias; + + deny: type isAtomic; + deny: type isPointerType; + deny: type isArrayType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForSdi identical: type referentClass; + assert: FFITestSdi identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForStructByName (in category 'tests - type aliases') ----- + testAliasForStructByName + + | type | + type := FFITestAliasForSdi externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAllArrayTypes (in category 'tests - image') ----- + testAllArrayTypes + + ExternalType arrayTypes do: [:type | + self + deny: type isAtomic; + deny: type isPointerType; + deny: type isStructureType; + assert: type isArrayType].! Item was added: + ----- Method: ExternalTypeTests>>testAllAtomicTypes (in category 'tests - image') ----- + testAllAtomicTypes + + ExternalType atomicTypes do: [:type | + self + assert: type isAtomic; + deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias].! Item was added: + ----- Method: ExternalTypeTests>>testAllPointerTypes (in category 'tests - image') ----- + testAllPointerTypes + + ExternalType pointerTypes do: [:type | + self + deny: type isAtomic; + assert: type isPointerType; + deny: type isStructureType; + deny: type isArrayType].! Item was added: + ----- Method: ExternalTypeTests>>testAllStructureTypes (in category 'tests - image') ----- + testAllStructureTypes + + ExternalType structTypes do: [:type | + self + deny: type isAtomic; + deny: type isPointerType; + assert: type isStructureType; + deny: type isArrayType].! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateAtomics (in category 'tests') ----- - testAllocateAtomics - - self should: [ExternalType void allocate] raise: Error. - self assert: false equals: ExternalType bool allocate. - - self assert: 0 equals: ExternalType int8_t "sbyte" allocate. - self assert: 0 equals: ExternalType uint8_t "byte" allocate. - - self assert: 0 equals: ExternalType uint16_t "ushort" allocate. - self assert: 0 equals: ExternalType int16_t "short" allocate. - - self assert: 0 equals: ExternalType uint32_t "ulong" allocate. - self assert: 0 equals: ExternalType int32_t "long" allocate. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" allocate. - self assert: 0 equals: ExternalType int64_t "longlong" allocate. - - self assert: Character null equals: ExternalType schar allocate. - self assert: Character null equals: ExternalType char allocate. - - self assert: 0.0 equals: ExternalType float allocate. - self assert: 0.0 equals: ExternalType double allocate.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateAtomicsExternal (in category 'tests') ----- - testAllocateAtomicsExternal - "Note that #allocateExternal for atomics does not need an extra #free. See #allocateExternal." - - self should: [ExternalType void allocateExternal] raise: Error. - self assert: false equals: ExternalType bool allocateExternal. - - self assert: 0 equals: ExternalType int8_t "sbyte" allocateExternal. - self assert: 0 equals: ExternalType uint8_t "byte" allocateExternal. - - self assert: 0 equals: ExternalType uint16_t "ushort" allocateExternal. - self assert: 0 equals: ExternalType int16_t "short" allocateExternal. - - self assert: 0 equals: ExternalType uint32_t "ulong" allocateExternal. - self assert: 0 equals: ExternalType int32_t "long" allocateExternal. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" allocateExternal. - self assert: 0 equals: ExternalType int64_t "longlong" allocateExternal. - - self assert: Character null equals: ExternalType schar allocateExternal. - self assert: Character null equals: ExternalType char allocateExternal. - - self assert: 0.0 equals: ExternalType float allocateExternal. - self assert: 0.0 equals: ExternalType double allocateExternal.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateStructs (in category 'tests') ----- - testAllocateStructs - - | struct | - struct := FFITestPoint2 allocate. - self assert: 0 equals: struct x. - self assert: 0 equals: struct y. - - struct := FFITestSd2 allocate. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct d2. - - struct := FFITestSsSsf allocate. - self assert: 0 equals: struct s1. - self assert: 0 equals: struct ssf2 s1. - self assert: 0.0 equals: struct ssf2 f2. - - struct := FFITestUfd allocate. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct f1.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateStructsExternal (in category 'tests') ----- - testAllocateStructsExternal - - | struct | - struct := heapObject := FFITestPoint2 allocateExternal. - self assert: 0 equals: struct x. - self assert: 0 equals: struct y. - - struct := heapObject := FFITestSd2 allocateExternal. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct d2. - - struct := heapObject := FFITestSsSsf allocateExternal. - self assert: 0 equals: struct s1. - self assert: 0 equals: struct ssf2 s1. - self assert: 0.0 equals: struct ssf2 f2. - - struct := heapObject := FFITestUfd allocateExternal. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct f1.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliases (in category 'tests - array types') ----- + testArrayOfAliases + + self classesForTypeAliases do: [:aliasClass | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: (contentType isAtomic or: [contentType isStructureType]); + deny: contentType isPointerType; + deny: contentType isArrayType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesByName (in category 'tests - array types') ----- + testArrayOfAliasesByName + + self classesForTypeAliases do: [:aliasClass | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForArrays (in category 'tests - array types') ----- + testArrayOfAliasesForArrays + "This is the only way to construct n-dimensional arrays for now." + + | contentType arrayType | + contentType := FFITestAliasForInt32Array externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: contentType isArrayType; + deny: contentType isAtomic; + deny: contentType isStructureType; + deny: contentType isPointerType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointers (in category 'tests - array types') ----- + testArrayOfAliasesForPointers + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: contentType isPointerType; + deny: contentType isAtomic; + deny: contentType isStructureType; + deny: contentType isArrayType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointersByName (in category 'tests - array types') ----- + testArrayOfAliasesForPointersByName + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType asNonPointerType + identical: (ExternalType typeNamed: arrayType asNonPointerType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointersDereferenced (in category 'tests - array types') ----- + testArrayOfAliasesForPointersDereferenced + "It should be possible to use the non-pointer type of an alias-to-pointer type as contentType in an array/container." + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType asNonPointerType. + contentType byteSize = 0 ifTrue: [^ self "Ignore void"]. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + deny: contentType isTypeAlias; + deny: contentType isPointerType; + assert: [contentType isAtomic + or: [contentType isStructureType + or: [contentType isArrayType]]]. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfArrays (in category 'tests - array types') ----- + testArrayOfArrays + "Not directly supported." + + self + assert: (ExternalType typeNamed: 'char[5]') + identical: (ExternalType typeNamed: 'char[5][5]'). + + self + should: [(ExternalType char asArrayType: 5) asArrayType: 5] + raise: Error. + + self + assert: (ExternalType typeNamed: 'FFITestPoint2[5]') + identical: (ExternalType typeNamed: 'FFITestPoint2[5][5]'). + + self + should: [(FFITestPoint2 externalType asArrayType: 5) asArrayType: 5] + raise: Error. + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomics (in category 'tests - array types') ----- + testArrayOfAtomics + + ExternalType atomicTypes allButFirst "void" do: [:contentType | + | arrayType | + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self assert: arrayType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomicsByName (in category 'tests - array types') ----- + testArrayOfAtomicsByName + + ExternalType atomicTypes allButFirst "void" do: [:contentType | + | arrayType | + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomicsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfAtomicsWithSpecialSize + "Test char[] and char[0]." + + | contentType containerType | + contentType := ExternalType char. + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'char[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'char[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomics (in category 'tests - array types') ----- + testArrayOfPointersToAtomics + + ExternalType atomicTypes "including void" do: [:atomicType | + | arrayType contentType | + contentType := atomicType asPointerType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self assert: arrayType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomicsByName (in category 'tests - array types') ----- + testArrayOfPointersToAtomicsByName + + ExternalType atomicTypes "including void" do: [:atomicType | + | arrayType contentType | + contentType := atomicType asPointerType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomicsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfPointersToAtomicsWithSpecialSize + "Test char*[] and char*[0]." + + | contentType containerType | + contentType := ExternalType char asPointerType. "char*" + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'char*[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'char*[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment. + + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructs (in category 'tests - array types') ----- + testArrayOfPointersToStructs + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType asPointerType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructsByName (in category 'tests - array types') ----- + testArrayOfPointersToStructsByName + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType asPointerType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfPointersToStructsWithSpecialSize + + | contentType containerType | + contentType := FFITestPoint2 externalType asPointerType. "FFITestPoint2*" + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2*[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2*[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment. + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructs (in category 'tests - array types') ----- + testArrayOfStructs + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsByName (in category 'tests - array types') ----- + testArrayOfStructsByName + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfStructsWithSpecialSize + + | contentType containerType | + contentType := FFITestPoint2 externalType. + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfUnknown (in category 'tests - unkown types') ----- + testArrayOfUnknown + "For missing referentClass, one can safely try to lookup an array type but forcing its creation will raise an error. Note that it is not possible to embed an array type for a struct in itself. You MUST use pointer types for that." + + self + assert: nil + equals: (ExternalType typeNamed: 'UnknownStruct[5]'). + + self + should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] + raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfVoid (in category 'tests - array types') ----- + testArrayOfVoid + + self + should: [ExternalType void asArrayType: 5] + raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesEmpty (in category 'tests') ----- - testArrayTypesEmpty - - self - should: [ExternalType char asArrayType: 0] - raise: Error; - should: [ExternalType typeNamed: 'char[]'] - raise: Error; - should: [ExternalType typeNamed: 'char[0]'] - raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesForAtomics (in category 'tests') ----- - testArrayTypesForAtomics - - self - should: [ExternalType void asArrayType: 5] - raise: Error. - - AtomicTypeNames keysInOrder allButFirst "void" do: [:index | - | atomicType arrayType | - atomicType := AtomicTypes at: (AtomicTypeNames at: index). - arrayType := atomicType asArrayType: 5. - self assert: arrayType isArrayType. - self assert: arrayType isAtomic. - self deny: arrayType isStructureType. - self deny: arrayType isPointerType. - self assert: 5 equals: arrayType size].! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesForStructs (in category 'tests') ----- - testArrayTypesForStructs - - self assert: (ExternalType typeNamed: 'UnknownStruct[5]') isNil. - self - should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] - raise: Error. - { - FFITestPoint2. - FFITestSdi. - FFITestUfd. - FFITestIntAlias. - FFITestCompoundStruct. - } do: [:structClass | - | arrayType | - arrayType := structClass externalType asArrayType: 5. - self assert: arrayType isArrayType. - self deny: arrayType isPointerType. - self assert: 5 equals: arrayType size].! Item was added: + ----- Method: ExternalTypeTests>>testArrayVsPointer (in category 'tests - array types') ----- + testArrayVsPointer + + | arrayType pointerType | + arrayType := ExternalType typeNamed: 'char[]'. + pointerType := ExternalType typeNamed: 'char*'. + self + assert: arrayType isArrayType; + deny: arrayType isPointerType; + assert: pointerType isPointerType; + deny: pointerType isArrayType. + + self deny: arrayType typeName = pointerType typeName. + self deny: arrayType asPointerType typeName = pointerType typeName.! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicType (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicType (in category 'tests') ----- testAtomicType + "Check the basic integrity of atomic types." + ExternalType atomicTypes do: [:type | - AtomicTypes keysAndValuesDo: [:typeName :type | self assert: type isAtomic; + assert: type typeName equals: type atomicTypeName; - assert: typeName equals: type atomicTypeName; deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias; + + assert: type referentClass isNil].! - deny: type isStructureType].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeByName (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeByName (in category 'tests') ----- testAtomicTypeByName + "Check whether the lookup of atomic types will yield the singleton instances of those types." + ExternalType atomicTypeNames do: [:typeName | - AtomicTypeNames do: [:typeName | self + assert: (ExternalType typeNamed: typeName) + identical: (ExternalType typeNamed: typeName)].! - assert: (AtomicTypes at: typeName) - identical: (ExternalType typeNamed: typeName); - assert: (AtomicTypes at: typeName) - identical: (ExternalType atomicTypeNamed: typeName)].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeBySelector (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeBySelector (in category 'tests') ----- testAtomicTypeBySelector + "Check whether all atomic type names are available as message on the class ExternalType such as 'ExternalType char'." + + ExternalType atomicTypeNames do: [:typeName | + self assert: (ExternalType perform: typeName asSymbol) isAtomic].! - - AtomicTypeNames do: [:typeName | - self - assert: (AtomicTypes at: typeName) - identical: (ExternalType perform: typeName asSymbol)].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeNameByType (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeNameByType (in category 'tests') ----- testAtomicTypeNameByType + "Check whether #typeName answers a name that can be used for looking up atomic types." + + ExternalType atomicTypes do: [:type | - - AtomicTypeNames do: [:symbol | | typeName | - typeName := symbol. self + assert: type + identical: (ExternalType typeNamed: type typeName). - assert: typeName - equals: (ExternalType typeNamed: typeName) typeName; - assert: typeName - equals: (AtomicTypes at: typeName) typeName. - typeName := (AtomicTypes at: symbol) asPointerType typeName. self + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName)].! - assert: typeName - equals: (ExternalType typeNamed: typeName) typeName].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests') ----- testAtomicTypeRange + "Tests the range of non-integer and non-float types. Includes char types because those look different in Smalltalk." + - self should: [ExternalType void minVal] raise: Error. self should: [ExternalType void maxVal] raise: Error. self should: [ExternalType bool minVal] raise: Error. + self should: [ExternalType bool maxVal] raise: Error. - self should: [ExternalType bool maxVal] raise: Error. - - self assert: 0 equals: ExternalType uint8_t "byte" minVal. - self assert: 255 equals: ExternalType uint8_t "byte" maxVal. - self assert: -128 equals: ExternalType int8_t "sbyte" minVal. - self assert: 127 equals: ExternalType int8_t "sbyte" maxVal. - self assert: 0 equals: ExternalType uint16_t "ushort" minVal. - self assert: 65535 equals: ExternalType uint16_t "ushort" maxVal. - self assert: -32768 equals: ExternalType int16_t "short" minVal. - self assert: 32767 equals: ExternalType int16_t "short" maxVal. - - self assert: 0 equals: ExternalType uint32_t "ulong" minVal. - self assert: 4294967295 equals: ExternalType uint32_t "ulong" maxVal. - self assert: -2147483648 equals: ExternalType int32_t "long" minVal. - self assert: 2147483647 equals: ExternalType int32_t "long" maxVal. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" minVal. - self assert: 18446744073709551615 equals: ExternalType uint64_t "ulonglong" maxVal. - self assert: -9223372036854775808 equals: ExternalType int64_t "longlong" minVal. - self assert: 9223372036854775807 equals: ExternalType int64_t "longlong" maxVal. - self assert: Character null equals: ExternalType char "unsignedChar" minVal. self assert: (Character value: 255) equals: ExternalType char "unsignedChar" maxVal. self assert: (Character value: 128) equals: ExternalType signedChar "schar" minVal. self assert: (Character value: 127) equals: ExternalType signedChar "schar" maxVal. + ! - - self assert: -3.4028234663852886e38 equals: ExternalType float minVal. - self assert: 3.4028234663852886e38 equals: ExternalType float maxVal. - self assert: -1.7976931348623157e308 equals: ExternalType double minVal. - self assert: 1.7976931348623157e308 equals: ExternalType double maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeArrayType (in category 'tests - compiled spec') ----- + testByteSizeArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeAtomicType (in category 'tests - compiled spec') ----- + testByteSizeAtomicType + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizePointerType (in category 'tests - compiled spec') ----- + testByteSizePointerType + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeStructureType (in category 'tests - compiled spec') ----- + testByteSizeStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testFloatPrecision (in category 'tests - atomic float types') ----- + testFloatPrecision + + self + assert: ExternalType float isSinglePrecision; + assert: ExternalType double + equals: ExternalType float asDoublePrecision; + assert: ExternalType double isDoublePrecision; + assert: ExternalType float + equals: ExternalType float asSinglePrecision.! Item was added: + ----- Method: ExternalTypeTests>>testFloatSign (in category 'tests - atomic float types') ----- + testFloatSign + "Float and double types are always signed. Thus, the check is not defined but only for integer types." + + self + should: [ExternalType float isSigned] raise: Error; + should: [ExternalType float isUnsigned] raise: Error; + should: [ExternalType float asSigned] raise: Error; + should: [ExternalType float asUnsigned] raise: Error; + should: [ExternalType double isSigned] raise: Error; + should: [ExternalType double isUnsigned] raise: Error; + should: [ExternalType double asSigned] raise: Error; + should: [ExternalType double asUnsigned] raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testFloatTypeRange (in category 'tests - atomic float types') ----- + testFloatTypeRange + + self assert: -3.4028234663852886e38 equals: ExternalType float minVal. + self assert: 3.4028234663852886e38 equals: ExternalType float maxVal. + self assert: -1.7976931348623157e308 equals: ExternalType double minVal. + self assert: 1.7976931348623157e308 equals: ExternalType double maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testFloatTypes (in category 'tests - atomic float types') ----- + testFloatTypes + + #( + float 4 + double 8 + ) pairsDo: [:typeName :byteSize | + | type | + type := ExternalType typeNamed: typeName. + self + assert: type isFloatType; + assert: byteSize equals: type byteSize].! Item was changed: + ----- Method: ExternalTypeTests>>testIntegerPointerTypes (in category 'tests - atomic integer types') ----- - ----- Method: ExternalTypeTests>>testIntegerPointerTypes (in category 'tests') ----- testIntegerPointerTypes | wordSize | wordSize := FFIPlatformDescription current wordSize. #(size_t ptrdiff_t uintptr_t intptr_t) do: [:typeName | | type | type := ExternalType typeNamed: typeName. self assert: type isIntegerType; assert: wordSize equals: type byteSize].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerPrecision (in category 'tests - atomic integer types') ----- + testIntegerPrecision + "Precision is not defined on integer types." + + ExternalType atomicTypes do: [:type | + type isIntegerType ifTrue: [ + self + should: [type isSinglePrecision] + raise: Error; + should: [type isDoublePrecision] + raise: Error]].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerSign (in category 'tests - atomic integer types') ----- + testIntegerSign + + ExternalType atomicTypes do: [:type | + self + assert: type isIntegerType ==> [ + (type isSigned and: [type asUnsigned isUnsigned]) + or: [type isUnsigned and: [type asSigned isSigned]]]].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerTypeRange (in category 'tests - atomic integer types') ----- + testIntegerTypeRange + + self assert: 0 equals: ExternalType uint8_t "byte" minVal. + self assert: 255 equals: ExternalType uint8_t "byte" maxVal. + self assert: -128 equals: ExternalType int8_t "sbyte" minVal. + self assert: 127 equals: ExternalType int8_t "sbyte" maxVal. + + self assert: 0 equals: ExternalType uint16_t "ushort" minVal. + self assert: 65535 equals: ExternalType uint16_t "ushort" maxVal. + self assert: -32768 equals: ExternalType int16_t "short" minVal. + self assert: 32767 equals: ExternalType int16_t "short" maxVal. + + self assert: 0 equals: ExternalType uint32_t "ulong" minVal. + self assert: 4294967295 equals: ExternalType uint32_t "ulong" maxVal. + self assert: -2147483648 equals: ExternalType int32_t "long" minVal. + self assert: 2147483647 equals: ExternalType int32_t "long" maxVal. + + self assert: 0 equals: ExternalType uint64_t "ulonglong" minVal. + self assert: 18446744073709551615 equals: ExternalType uint64_t "ulonglong" maxVal. + self assert: -9223372036854775808 equals: ExternalType int64_t "longlong" minVal. + self assert: 9223372036854775807 equals: ExternalType int64_t "longlong" maxVal. + ! Item was changed: + ----- Method: ExternalTypeTests>>testIntegerTypes (in category 'tests - atomic integer types') ----- - ----- Method: ExternalTypeTests>>testIntegerTypes (in category 'tests') ----- testIntegerTypes #( uint8_t 1 int8_t 1 uint16_t 2 int16_t 2 uint32_t 4 int32_t 4 uint64_t 8 int64_t 8 ) pairsDo: [:typeName :byteSize | | type | type := ExternalType typeNamed: typeName. self assert: type isIntegerType; assert: byteSize equals: type byteSize].! Item was added: + ----- Method: ExternalTypeTests>>testIsArrayType (in category 'tests - compiled spec') ----- + testIsArrayType + "#isArrayType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isArrayType. + self assert: baseType isArrayType.! Item was added: + ----- Method: ExternalTypeTests>>testIsAtomicType (in category 'tests - compiled spec') ----- + testIsAtomicType + "#isAtomic should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type isAtomic. + self assert: baseType isAtomic.! Item was added: + ----- Method: ExternalTypeTests>>testIsPointerType (in category 'tests - compiled spec') ----- + testIsPointerType + "#isPointerType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isPointerType. + self assert: baseType isPointerType.! Item was added: + ----- Method: ExternalTypeTests>>testIsStructureType (in category 'tests - compiled spec') ----- + testIsStructureType + "#isStructureType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isStructureType. + self assert: baseType isStructureType.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAlias (in category 'tests - pointer types') ----- + testPointerToAlias + "Test pointer types for type aliases for atomic types or struct types. Do not test pointer types to type aliases for array types." + + self classesForTypeAliases do: [:aliasClass | | type pointerType | + type := aliasClass externalType. + pointerType := type asPointerType. + + self + assert: type isTypeAlias; + assert: (type isAtomic or: [type isStructureType]); + deny: type isPointerType; + deny: type isArrayType. + + self + assert: pointerType isPointerType; + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias. + + self + "referentClass is retained to instantiate the correct classes for return values (i.e. ExternalStructure or ExternalData)" + assert: type referentClass + identical: pointerType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAliasForArray (in category 'tests - pointer types') ----- + testPointerToAliasForArray + + | type pointerType | + type := FFITestAliasForInt32Array externalType. + pointerType := type asPointerType. + + self + assert: type isArrayType; + assert: type isTypeAlias. + + self + assert: pointerType isPointerType; + assert: pointerType isPointerTypeForArray; + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias. + + self + "referentClass is nil to ensure ExternalData for return values from FFI calls" + assert: pointerType referentClass isNil.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAliasForPointer (in category 'tests - pointer types') ----- + testPointerToAliasForPointer + "Alias-for-pointer types are actual pointer types. Their non-pointer type points to the original non-pointer type. See #testAliasForPointer." + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | | type | + type := aliasClass externalType. + + self + assert: type + identical: type asPointerType].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToArray (in category 'tests - pointer types') ----- + testPointerToArray + "The pointer type of an array type should look like a pointer to its content type except that we omit the referentClass so that we will always get ExternalData from an FFI call. From there, #contentType is very easy to access. Note that MyStruct* and MyStruct[] are different. See #testArrayVsPointer." + + | arrayTypes | + arrayTypes := #( + char 'char*' int32_t 'int32_t*' double 'double*' + FFITestSdi 'FFITestSdi*' FFITestUfd 'FFITestUfd*') + collect: [:typeName | (ExternalType typeNamed: typeName) asArrayType: 5]. + + arrayTypes do: [:arrayType | | pointerType | + pointerType := arrayType asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + "Important!! We really want to get ExternalData for such return types. We MUST NOT instantiate the content type because we would loose the array type and thus the size information." + assert: pointerType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAtomic (in category 'tests - pointer types') ----- + testPointerToAtomic + + ExternalType atomicTypes do: [:type | | pointerType | + pointerType := type asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + assert: pointerType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToPointer (in category 'tests - pointer types') ----- + testPointerToPointer + "A double pointer could either mean array-of-pointers or address of a pointer to be initialized such as in a domain-specific allocate(void**). Since we do not support by-address invocation in FFI calls yet and we do have array types, such a type is not supported. See ExternalFunction >> #flags." + + self + assert: nil + equals: (ExternalType typeNamed: 'char**'). "Use 'char*[]' if possible." + + self + should: [ExternalType newTypeNamed: 'char**'] + raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToPointerVsArrayOfPointers (in category 'tests - pointer types') ----- + testPointerToPointerVsArrayOfPointers + "For visual clarity, the pointer type of an array-of-pointers type will look different from the pointer type of an array-of-atomics/structs. Also see #testPointerToPointer." + + | arrayType | + arrayType := ExternalType typeNamed: 'char[]'. + + self + assert: '(char[])*' + equals: arrayType asPointerType typeName. + + arrayType := ExternalType typeNamed: 'char*[]'. + + self + assert: '(char*[])*' + equals: arrayType asPointerType typeName.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToStruct (in category 'tests - pointer types') ----- + testPointerToStruct + + self classesForStructures do: [:structClass | | type pointerType | + type := structClass externalType. + pointerType := type asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + assert: structClass + identical: pointerType referentClass].! Item was removed: - ----- Method: ExternalTypeTests>>testPrecisionFloatTypes (in category 'tests') ----- - testPrecisionFloatTypes - - self - assert: ExternalType float isSinglePrecision; - assert: ExternalType double - equals: ExternalType float asDoublePrecision; - assert: ExternalType double isDoublePrecision; - assert: ExternalType float - equals: ExternalType float asSinglePrecision.! Item was removed: - ----- Method: ExternalTypeTests>>testPrecisionIntegerTypes (in category 'tests') ----- - testPrecisionIntegerTypes - - AtomicTypeNames do: [:typeName | - | type | - type := ExternalType atomicTypeNamed: typeName. - type isIntegerType ifTrue: [ - self - should: [type isSinglePrecision] - raise: Error; - should: [type isDoublePrecision] - raise: Error]].! Item was removed: - ----- Method: ExternalTypeTests>>testSignFloatTypes (in category 'tests') ----- - testSignFloatTypes - - self - should: [ExternalType float isSigned] raise: Error; - should: [ExternalType float isUnsigned] raise: Error; - should: [ExternalType float asSigned] raise: Error; - should: [ExternalType float asUnsigned] raise: Error; - should: [ExternalType double isSigned] raise: Error; - should: [ExternalType double isUnsigned] raise: Error; - should: [ExternalType double asSigned] raise: Error; - should: [ExternalType double asUnsigned] raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testSignIntegerTypes (in category 'tests') ----- - testSignIntegerTypes - - AtomicTypeNames do: [:typeName | - | type | - type := ExternalType atomicTypeNamed: typeName. - self - assert: type isIntegerType ==> [ - (type isSigned and: [type asUnsigned isUnsigned]) - or: [type isUnsigned and: [type asSigned isSigned]]]].! Item was added: + ----- Method: ExternalTypeTests>>testSizeArrayType (in category 'tests - compiled spec') ----- + testSizeArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizeAtomicType (in category 'tests - compiled spec') ----- + testSizeAtomicType + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizePointerType (in category 'tests - compiled spec') ----- + testSizePointerType + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizeStructureType (in category 'tests - compiled spec') ----- + testSizeStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testStructType (in category 'tests - struct types') ----- + testStructType + "Check the basic integrity of struct types." + + self classesForStructures do: [:structClass | | type | + type := structClass externalType. + self + deny: type isAtomic; + deny: type isPointerType; + assert: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias; + + assert: structClass + identical: type referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testStructTypeByName (in category 'tests - struct types') ----- + testStructTypeByName + + self classesForStructures do: [:structClass | | type pointerType | + type := structClass externalType asNonPointerType. + pointerType := type asPointerType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: pointerType + identical: (ExternalType typeNamed: pointerType typeName)]! Item was added: + ----- Method: ExternalTypeTests>>testUnknownReferentClass (in category 'tests - unkown types') ----- + testUnknownReferentClass + + | type | + Smalltalk garbageCollect. + ExternalType cleanupUnusedTypes. + type := ExternalType typeNamed: 'UnknownStructForTest'. + self assert: type isNil. + type := ExternalType newTypeNamed: 'UnknownStructForTest'. + self assert: type isUnknownType. + self + should: [ExternalType newTypeNamed: 'UnknownStructForTest'] + raise: Error. "Already existing" + ! Item was added: + FFIAllocateTests subclass: #FFIAllocateExternalTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! Item was added: + ----- Method: FFIAllocateExternalTests class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + + ^ true! Item was added: + ----- Method: FFIAllocateExternalTests>>allocate: (in category 'running') ----- + allocate: spec + + | result | + result := externalObjects add: (self lookupType: spec) allocateExternal. + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateExternalTests>>allocate:size: (in category 'running') ----- + allocate: spec size: size + + | result | + result := externalObjects add: ((self lookupType: spec) allocateExternal: size). + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateExternalTests>>checkAllocate: (in category 'running') ----- + checkAllocate: externalObject + + | type handle | + self assert: externalObject notNil. + (externalObject isExternalObject) + ifFalse: [ + externalObjects remove: externalObject. "skip free" + ^ self "atomics are fine"]. + + type := externalObject externalType. + handle := externalObject getHandle. + + type isAtomic ifTrue: [ + self deny: handle isExternalAddress. + self deny: handle isInternalMemory. + self deny: handle isNil. + ^ self]. + + self deny: externalObject isNull. + self deny: handle isNull. + self deny: handle isNil. + + self assert: type isPointerType. + self assert: handle isExternalAddress. + + self deny: handle isInternalMemory.! Item was added: + ----- Method: FFIAllocateExternalTests>>checkFree: (in category 'running') ----- + checkFree: externalObject + + | type handle | + type := externalObject externalType. + handle := externalObject getHandle. + + self assert: externalObject isNull. + + (type isTypeAlias and: [type isAtomic]) ifTrue: [ + self assert: handle isNil. + ^ self]. + + self assert: type isPointerType. + self assert: handle isExternalAddress. + self deny: handle isInternalMemory. + self assert: handle isNull.! Item was added: + ----- Method: FFIAllocateExternalTests>>checkType: (in category 'running') ----- + checkType: externalObject + + self assert: externalObject externalType isPointerType.! Item was added: + ----- Method: FFIAllocateExternalTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ super expectedFailures copyWithoutAll: #( + test04LinkedList "Storing pointers works fine." + )! Item was added: + ----- Method: FFIAllocateExternalTests>>test00ReaderWriter (in category 'tests') ----- + test00ReaderWriter + "Overwritten to show that #reader and #writer is virtually a #yourself on external objects that point to external memory." + + | si2 | + si2 := self allocate: FFITestSi2. + + self assert: si2 == si2 reader. + self assert: si2 == si2 writer. + self assert: si2 reader == si2. + self assert: si2 writer == si2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test01ArrayFromTo (in category 'tests - array') ----- + test01ArrayFromTo + "Overwritten because missing #writer as no effect. See #test00ReaderWriter." + + | points portion | + points := FFITestPoint2 allocateExternal: 5. + + portion := points from: 2 to: 3. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: FFIAllocateExternalTests>>test02ArrayCopyFromTo (in category 'tests - array') ----- + test02ArrayCopyFromTo + "Overwritten to emphasize that the copy is in internal memory. Implementation is the same, see #allocate:size:." + + super test02ArrayCopyFromTo.! Item was added: + ----- Method: FFIAllocateExternalTests>>test02StructureCompositeAccess (in category 'tests - structure') ----- + test02StructureCompositeAccess + "Overwritten because #writer is not necessary for external memory." + + | composite | + composite := self allocate: FFITestSsSsf. + + self assert: 0 equals: composite s1. + self assert: 0 equals: composite ssf2 s1. + self assert: 0.0 equals: composite ssf2 f2. + + composite s1: 1. + self assert: 1 equals: composite s1. + + composite ssf2 s1: 2. + self assert: 2 equals: composite ssf2 s1. + + composite ssf2 f2: 3.0. + self assert: 3.0 equals: composite ssf2 f2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test04UnionCompositeAccess (in category 'tests - union') ----- + test04UnionCompositeAccess + "Overwritten because #writer is not necessary." + + | composite | + composite := self allocate: FFITestUdSi2. + + self assert: 0.0 equals: composite d1. + self assert: 0 equals: composite sii1 i1. + self assert: 0 equals: composite sii1 i2. + + composite d1: 1.0. + self assert: 1.0 equals: composite d1. + composite d1: 0.0. "Clear to clear shared sub-structure." + + composite sii1 i1: 2. + self assert: 2 equals: composite sii1 i1. + + composite sii1 i2: 3. + self assert: 3 equals: composite sii1 i2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test05UnionCompositeAccessTwo (in category 'tests - union') ----- + test05UnionCompositeAccessTwo + "Overwritten because #writer is not necessary for external memory." + + | composite | + composite := self allocate: FFITestSUfdUdSi2. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: FFIAllocateExternalTests>>test06ArrayOfPointers (in category 'tests - array') ----- + test06ArrayOfPointers + "Overwritten because in external memory, we can manage pointer indirections." + + | array type string| + type := self lookupType: 'char*'. + array := self allocate: type size: 5. + self assert: 5 * type byteSize equals: array byteSize. + + string := self allocate: array contentType asNonPointerType size: 7. + string setSize: nil. "Not needed due to null-termination." + + string at: 1 put: $S. + string at: 2 put: $Q. + string at: 3 put: $U. + string at: 4 put: $E. + string at: 5 put: $A. + string at: 6 put: $K. + string at: 7 put: Character null. "Not needed here because memory was zero from the beginning." + self assert: 'SQUEAK' equals: string fromCString. + + array at: 1 put: string. + self assert: 'SQUEAK' equals: array first fromCString.! Item was added: + TestCase subclass: #FFIAllocateTests + instanceVariableNames: 'externalObjects' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! + + !FFIAllocateTests commentStamp: 'mt 5/10/2021 10:18' prior: 0! + A collection of tests around the allocation of structs, unions, and arrays of atomics/structs/unions. Includes tests about accessing (field read/write) those after allocation.! Item was added: + ----- Method: FFIAllocateTests>>allocate: (in category 'running') ----- + allocate: spec + + | result | + result := externalObjects add: (self lookupType: spec) allocate. + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateTests>>allocate:size: (in category 'running') ----- + allocate: spec size: size + + | result | + result := externalObjects add: ((self lookupType: spec) allocate: size). + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateTests>>checkAllocate: (in category 'running') ----- + checkAllocate: externalObject + + | type handle | + self assert: externalObject notNil. + (externalObject isExternalObject) + ifFalse: [ + externalObjects remove: externalObject. "skip free" + ^ self "pure atomics are fine"]. + + type := externalObject externalType. + handle := externalObject getHandle. + + type isAtomic ifTrue: [ + self deny: handle isExternalAddress. + self deny: handle isInternalMemory. + self deny: handle isNil. + ^ self]. + + self deny: externalObject isNull. + self deny: handle isNull. + self deny: handle isNil. + + self deny: type isPointerType. + self deny: handle isExternalAddress. + + self assert: handle isInternalMemory.! Item was added: + ----- Method: FFIAllocateTests>>checkFree: (in category 'running') ----- + checkFree: externalObject + + | type handle | + type := externalObject externalType. + handle := externalObject getHandle. + + self assert: externalObject isNull. + + (type isTypeAlias and: [type isAtomic]) ifTrue: [ + self assert: handle isNil. + ^ self]. + + (type isTypeAlias and: [type isPointerType]) ifTrue: [ + self assert: handle isExternalAddress. + self assert: handle isNull. + ^ self]. + + self assert: handle isNil.! Item was added: + ----- Method: FFIAllocateTests>>checkType: (in category 'running') ----- + checkType: externalObject + + self assert: externalObject externalType isPointerType not.! Item was added: + ----- Method: FFIAllocateTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + test04LinkedList "We don't have pointers to internal memory, yet." + )! Item was added: + ----- Method: FFIAllocateTests>>lookupType: (in category 'running') ----- + lookupType: structClassOrTypeNameOrType + + ^ structClassOrTypeNameOrType isString + ifTrue: [ExternalType typeNamed: structClassOrTypeNameOrType] + ifFalse: [structClassOrTypeNameOrType isBehavior + ifTrue: [structClassOrTypeNameOrType externalType] + ifFalse: [structClassOrTypeNameOrType]]! Item was added: + ----- Method: FFIAllocateTests>>setUp (in category 'running') ----- + setUp + + super setUp. + externalObjects := OrderedCollection new.! Item was added: + ----- Method: FFIAllocateTests>>tearDown (in category 'running') ----- + tearDown + + externalObjects do: [:externalObject | + externalObject free. + self checkFree: externalObject].! Item was added: + ----- Method: FFIAllocateTests>>test00ReaderWriter (in category 'tests') ----- + test00ReaderWriter + + | si2 | + si2 := self allocate: FFITestSi2. + + self deny: si2 == si2 reader. + self deny: si2 reader == si2 reader. + + self assert: (si2 ffiEqual: si2 reader). + self assert: (si2 reader ffiEqual: si2). + + self deny: si2 == si2 writer. + self deny: si2 writer == si2 writer. + + self assert: (si2 ffiEqual: si2 writer). + self assert: (si2 writer ffiEqual: si2). + ! Item was added: + ----- Method: FFIAllocateTests>>test01AliasForAtomicAccess (in category 'tests - type alias') ----- + test01AliasForAtomicAccess + + | char | + char := self allocate: FFITestAliasForChar. + self assert: Character null equals: char value. + char value: $A. + self assert: $A equals: char value.! Item was added: + ----- Method: FFIAllocateTests>>test01AllocateAtomics (in category 'tests - atomics') ----- + test01AllocateAtomics + + self should: [(self allocate: ExternalType void)] raise: Error. + self assert: false equals: (self allocate: ExternalType bool). + + self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte"). + self assert: 0 equals: (self allocate: ExternalType uint8_t "byte"). + + self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort"). + self assert: 0 equals: (self allocate: ExternalType int16_t "short"). + + self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong"). + self assert: 0 equals: (self allocate: ExternalType int32_t "long"). + + self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong"). + self assert: 0 equals: (self allocate: ExternalType int64_t "longlong"). + + self assert: Character null equals: (self allocate: ExternalType schar). + self assert: Character null equals: (self allocate: ExternalType char). + + self assert: 0.0 equals: (self allocate: ExternalType float). + self assert: 0.0 equals: (self allocate: ExternalType double).! Item was added: + ----- Method: FFIAllocateTests>>test01ArrayFromTo (in category 'tests - array') ----- + test01ArrayFromTo + "Access a sub-range in the external data. Internal memory will be copied if not accessed through a read-writer." + + | points portion | + points := self allocate: FFITestPoint2 size: 5. + portion := points from: 2 to: 3. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer early enough..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion := points writer from: 2 to: 3. + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + points zeroMemory. + portion := points reader from: 2 to: 3. + portion writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Both #reader and #writer used. No worries." + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: FFIAllocateTests>>test01Identity (in category 'tests') ----- + test01Identity + + | a b c | + a := self allocate: FFITestPoint2. + b := self allocate: FFITestPoint2. + c := FFITestPoint2 fromHandle: a getHandle. + + self assert: (a ffiIdentical: a). + self deny: (a ffiIdentical: b). + self assert: (a ffiIdentical: c). "!!!! unlike #==" + + self assert: a == a. + self deny: a == b. + self deny: a == c. "!!!! unlike #ffiIdentical:" + + ! Item was added: + ----- Method: FFIAllocateTests>>test01StructureAccess (in category 'tests - structure') ----- + test01StructureAccess + + | sfi | + sfi := self allocate: FFITestSfi. + + "1) Test initial values." + self assert: 0.0 equals: sfi f1. + self assert: 0 equals: sfi i2. + + "2) Test basic read/write of fields" + sfi i2: 2. + self assert: 2 equals: sfi i2. + self assert: 0.0 equals: sfi f1. "not touched" + sfi f1: 2.0. + self assert: 2.0 equals: sfi f1. + self assert: 2 equals: sfi i2. "not touched"! Item was added: + ----- Method: FFIAllocateTests>>test01UnionAccess (in category 'tests - union') ----- + test01UnionAccess + + | ufi | + ufi := self allocate: FFITestUfi. + + "1) Test initial values." + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1. + + "2) Test basic read/write of fields" + ufi i1: 2. + self assert: 2 equals: ufi i1. + self deny: 0.0 equals: ufi f1. "overwritten" + ufi f1: 2.0. + self assert: 2.0 equals: ufi f1. + self deny: 2 equals: ufi i1. "overwritten"! Item was added: + ----- Method: FFIAllocateTests>>test02AliasForAtomicZeroMemory (in category 'tests - type alias') ----- + test02AliasForAtomicZeroMemory + + | char | + char := self allocate: FFITestAliasForChar. + char value: $A. + char zeroMemory. + self assert: Character null equals: char value.! Item was added: + ----- Method: FFIAllocateTests>>test02ArrayCopyFromTo (in category 'tests - array') ----- + test02ArrayCopyFromTo + "Copy a portion of an array into a new array." + + | points copy | + points := self allocate: FFITestPoint2 size: 5. + + copy := points copyFrom: 2 to: 3. + self assert: copy getHandle isInternalMemory. + + "We need a writer to modify internal memory." + copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). + + "Check that we did not touch the original." + self + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: FFIAllocateTests>>test02Equality (in category 'tests') ----- + test02Equality + + | a b c | + a := self allocate: FFITestPoint2. + b := self allocate: FFITestPoint2. + c := FFITestPoint2 fromHandle: a getHandle. + + self assert: (a ffiEqual: a). + self assert: (a ffiEqual: b). + self assert: (a ffiEqual: c). + + self assert: a = a. + self deny: a = b. + self assert: a = c. "bc. #ffiIdentical: by default" + ! Item was added: + ----- Method: FFIAllocateTests>>test02StructureCompositeAccess (in category 'tests - structure') ----- + test02StructureCompositeAccess + "Tests the access to composite structures. Uses #writer to avoid copy-on-access for sub-structs." + + | composite | + composite := self allocate: FFITestSsSsf. + + self assert: 0 equals: composite s1. + self assert: 0 equals: composite ssf2 s1. + self assert: 0.0 equals: composite ssf2 f2. + + composite s1: 1. + self assert: 1 equals: composite s1. + + composite ssf2 s1: 2. + self assert: 0 equals: composite ssf2 s1. + composite writer ssf2 s1: 2. + self assert: 2 equals: composite ssf2 s1. + + composite ssf2 f2: 3.0. + self assert: 0.0 equals: composite ssf2 f2. + composite writer ssf2 f2: 3.0. + self assert: 3.0 equals: composite ssf2 f2.! Item was added: + ----- Method: FFIAllocateTests>>test02Union_IEEE32BitWord (in category 'tests - union') ----- + test02Union_IEEE32BitWord + "Test union-specific field overlay, directly and indirectly." + + | ufi | + ufi := self allocate: FFITestUfi. + + ufi f1: 3.0. "Direct write" + self assert: 3.0 asIEEE32BitWord equals: ufi i1. + self assert: 3.0 equals: (Float fromIEEE32Bit: ufi i1). + + ufi i1: 4.0 asIEEE32BitWord. + self assert: 4.0 equals: (Float fromIEEE32Bit: ufi i1). + self assert: 4.0 equals: ufi f1. "Direct read"! Item was added: + ----- Method: FFIAllocateTests>>test03AliasForStructureAccess (in category 'tests - type alias') ----- + test03AliasForStructureAccess + + | sdi | + sdi := self allocate: FFITestAliasForSdi. + + self assert: 0.0 equals: sdi d1. + self assert: 0 equals: sdi i2. + + sdi d1: 1.0. + sdi i2: 2. + + self assert: 1.0 equals: sdi d1. + self assert: 2 equals: sdi i2.! Item was added: + ----- Method: FFIAllocateTests>>test03ArrayAccess (in category 'tests - array') ----- + test03ArrayAccess + + | somePoints firstPoint | + somePoints := self allocate: FFITestPoint2 size: 5. + self assert: 5 equals: somePoints size. + firstPoint := somePoints at: 1. + self assert: 0 at 0 equals: firstPoint asPoint. + firstPoint setX: 2 setY: 3. + self assert: 2 at 3 equals: firstPoint asPoint.! Item was added: + ----- Method: FFIAllocateTests>>test03GlobalVariable (in category 'tests') ----- + test03GlobalVariable + "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." + | global | + global := self allocate: FFITestAliasForInt32. + self assert: 0 equals: global value. + global value: 42. + self assert: 42 equals: global value.! Item was added: + ----- Method: FFIAllocateTests>>test03StructureCopy (in category 'tests - structure') ----- + test03StructureCopy + + | original copy | + original := self allocate: FFITestPoint2. + original setX: 1 setY: 2. + + copy := original copy. + self assert: (original ffiEqual: copy). + self deny: (original ffiIdentical: copy). + + copy setX: 3 setY: 4. + self assert: 1 at 2 equals: original asPoint. + self assert: 3 at 4 equals: copy asPoint.! Item was added: + ----- Method: FFIAllocateTests>>test03Union_IEEE64BitWord (in category 'tests - union') ----- + test03Union_IEEE64BitWord + "Test union-specific field overlay, directly and indirectly." + + | udi | + udi := self allocate: FFITestUdi. + + udi d1: 3.0. "Direct write" + self assert: 3.0 asIEEE64BitWord equals: udi i1. + self assert: 3.0 equals: (Float fromIEEE64Bit: udi i1). + + udi i1: 4.0 asIEEE64BitWord. + self assert: 4.0 equals: (Float fromIEEE64Bit: udi i1). + self assert: 4.0 equals: udi d1. "Direct read"! Item was added: + ----- Method: FFIAllocateTests>>test04AliasForUnionAccess (in category 'tests - type alias') ----- + test04AliasForUnionAccess + + | ufi | + ufi := self allocate: FFITestAliasForUfi. + + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1. + + ufi i1: 2. + self assert: 2 equals: ufi i1. + self deny: 0.0 equals: ufi f1. "overwritten" + ufi f1: 2.0. + self assert: 2.0 equals: ufi f1. + self deny: 2 equals: ufi i1. "overwritten"! Item was added: + ----- Method: FFIAllocateTests>>test04ArrayCompositeAccess (in category 'tests - array') ----- + test04ArrayCompositeAccess + + | data | + data := FFITestSdA5i allocate. + self assert: data a5i2 first equals: 0. + data writer a5i2 at: 1 put: 42. + self assert: data a5i2 first equals: 42.! Item was added: + ----- Method: FFIAllocateTests>>test04GlobalVariableInArray (in category 'tests') ----- + test04GlobalVariableInArray + "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." + | global | + global := self allocate: ExternalType int32_t size: 1. + self assert: global isArray. + self assert: 0 equals: global value. + global value: 42. + self assert: 42 equals: global value.! Item was added: + ----- Method: FFIAllocateTests>>test04LinkedList (in category 'tests - structure') ----- + test04LinkedList + + | link1 link2 link3 | + link1 := self allocate: FFITestLink. + link2 := self allocate: FFITestLink. + link3 := self allocate: FFITestLink. + + link1 next: link2. link2 prev: link1. + link2 next: link3. link3 prev: link2. + link3 next: link1. link1 prev: link3. + + self assert: link1 next = link2. + self assert: link2 next = link3. + self assert: link3 next = link1. + + self assert: link3 prev = link2. + self assert: link2 prev = link1. + self assert: link1 prev = link3. ! Item was added: + ----- Method: FFIAllocateTests>>test04UnionCompositeAccess (in category 'tests - union') ----- + test04UnionCompositeAccess + "Tests the access to composite union. Uses #writer to avoid copy-on-access for sub-structs." + + | composite | + composite := self allocate: FFITestUdSi2. + + self assert: 0.0 equals: composite d1. + self assert: 0 equals: composite sii1 i1. + self assert: 0 equals: composite sii1 i2. + + composite d1: 1.0. + self assert: 1.0 equals: composite d1. + composite d1: 0.0. "Clear to clear shared sub-structure." + + composite sii1 i1: 2. + self assert: 0 equals: composite sii1 i1. + composite writer sii1 i1: 2. + self assert: 2 equals: composite sii1 i1. + + composite sii1 i2: 3. + self assert: 0 equals: composite sii1 i2. + composite writer sii1 i2: 3. + self assert: 3 equals: composite sii1 i2.! Item was added: + ----- Method: FFIAllocateTests>>test05AliasForPointerToStructureAccess (in category 'tests - type alias') ----- + test05AliasForPointerToStructureAccess + + | sdi | + sdi := self allocate: FFITestAliasForSdiPointer. + + self assert: 0.0 equals: sdi d1. + self assert: 0 equals: sdi i2. + + sdi d1: 1.0. + sdi i2: 2. + + self assert: 1.0 equals: sdi d1. + self assert: 2 equals: sdi i2.! Item was added: + ----- Method: FFIAllocateTests>>test05ArrayFromCString (in category 'tests - array') ----- + test05ArrayFromCString + + | data | + + ExternalData allowDetectForUnknownSizeDuring: [ + data := self allocate: ExternalType char size: 4. + data setType: ExternalType byte. + self assert: data size isNil. + + #[65 66 67 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setType: ExternalType char. + self assert: 'ABC' equals: data fromCString. + + data := self allocate: ExternalType char size: 9. + data setType: ExternalType byte. + self assert: data size isNil. + + #[65 66 67 0 68 69 70 0 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setType: ExternalType char. + self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was added: + ----- Method: FFIAllocateTests>>test05StructureZeroMemory (in category 'tests - structure') ----- + test05StructureZeroMemory + + | sfi | + sfi := self allocate: FFITestSfi. + sfi i2: 2. + sfi f1: 2.0. + + sfi zeroMemory. + self assert: 0.0 equals: sfi f1. + self assert: 0 equals: sfi i2.! Item was added: + ----- Method: FFIAllocateTests>>test05UnionCompositeAccessTwo (in category 'tests - union') ----- + test05UnionCompositeAccessTwo + + | composite | + composite := self allocate: FFITestSUfdUdSi2. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self deny: 3.5 equals: composite ufd1 f1. + composite writer ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self deny: 42 equals: composite udSii2 sii1 i1. + composite writer udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: FFIAllocateTests>>test06ArrayOfPointers (in category 'tests - array') ----- + test06ArrayOfPointers + "In internal memory, byte-array pointers do not count. We cannot really do anything here with an array of null-pointers." + + | array type | + type := self lookupType: 'char*'. + array := self allocate: type size: 6. + self assert: 0 equals: array byteSize. + + self deny: array isNull. + array do: [:each | + self assert: each isNull. + self assert: 0 equals: each byteSize].! Item was added: + ----- Method: FFIAllocateTests>>test06StructureAsArray (in category 'tests - structure') ----- + test06StructureAsArray + + | sfi array element | + sfi := self allocate: FFITestSfi. + sfi f1: 2.5. + sfi i2: 10. + + array := sfi reader asArray. + element := array first. + + self assert: (sfi ffiIdentical: element). + self assert: (sfi ffiEqual: element). + + self assert: 2.5 equals: element f1. + self assert: 10 equals: element i2.! Item was added: + ----- Method: FFIAllocateTests>>test06UnionCopy (in category 'tests - union') ----- + test06UnionCopy + + | original copy | + original := self allocate: FFITestUdi. + original d1: 1.0. + + copy := original copy. + self assert: (original ffiEqual: copy). + self deny: (original ffiIdentical: copy). + + copy i1: 2. + self assert: 1.0 equals: original d1. + self assert: 2 equals: copy i1.! Item was added: + ----- Method: FFIAllocateTests>>test07UnionZeroMemory (in category 'tests - union') ----- + test07UnionZeroMemory + + | ufi | + ufi := self allocate: FFITestUfi. + ufi f1: 2.0. + ufi i1: 2. + + ufi zeroMemory. + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1.! Item was changed: ----- Method: FFIPluginTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + testIntAliasCallReturnIntAlias "return-type coercing failed - check referentClass notNil missing?" + testIntCallReturnIntAlias "return-type coercing failed - check referentClass notNil missing?" - testIntAliasCallReturnIntAlias "return-type coercing failed" - testIntCallReturnIntAlias "return-type coercing failed" testMixedDoublesAndLongsSum "more than 15 method args needed" testSumStructSslf4 "some overflow issue, maybe expected")! Item was added: + ----- Method: FFIPluginTests>>testArrayResultWithPoint (in category 'tests - arrays') ----- + testArrayResultWithPoint + "Test returning of pointers to arrays" + | pt1 pt2 pt3 | + pt1 := FFITestPoint4 new. + pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. + pt2 := FFITestPoint4 new. + pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := heapObject := FFITestLibrary ffiTestArrayResultWith: pt1 with: pt2. + + self assert: pt3 isArray. + pt3 := pt3 value. + + self assert: pt3 x = 6. + self assert: pt3 y = 8. + self assert: pt3 z = 10. + self assert: pt3 w = 12.! Item was added: + ----- Method: FFIPluginTests>>testArrayResultWithString (in category 'tests - arrays') ----- + testArrayResultWithString + "Note that the result does not have to be free'd because the FFITestLibrary is just passing along a Smalltalkg string. I think." + + | string result | + string := 'Hello Squeak!!'. + result := FFITestLibrary ffiTestArrayResultWithString: string. + self assert: result isArray. + ExternalData allowDetectForUnknownSizeDuring: [ + self assert: string equals: result fromCString].! Item was changed: ----- Method: FFIPluginTests>>testIntAliasCall (in category 'tests - type alias') ----- testIntAliasCall | result | result := FFITestLibrary + ffiTestIntAlias4IntSum: (FFITestAliasForInt32 fromHandle: 1) + with: (FFITestAliasForInt32 fromHandle: 2) + with: (FFITestAliasForInt32 fromHandle: 3) + with: (FFITestAliasForInt32 fromHandle: 4). - ffiTestIntAlias4IntSum: (FFITestIntAlias fromHandle: 1) - with: (FFITestIntAlias fromHandle: 2) - with: (FFITestIntAlias fromHandle: 3) - with: (FFITestIntAlias fromHandle: 4). self assert: 10 equals: result.! Item was changed: ----- Method: FFIPluginTests>>testIntAliasCallReturnIntAlias (in category 'tests - type alias') ----- testIntAliasCallReturnIntAlias | result | result := FFITestLibrary + ffiTestIntAlias4IntAliasSum: (FFITestAliasForInt32 fromHandle: 1) + with: (FFITestAliasForInt32 fromHandle: 2) + with: (FFITestAliasForInt32 fromHandle: 3) + with: (FFITestAliasForInt32 fromHandle: 4). - ffiTestIntAlias4IntAliasSum: (FFITestIntAlias fromHandle: 1) - with: (FFITestIntAlias fromHandle: 2) - with: (FFITestIntAlias fromHandle: 3) - with: (FFITestIntAlias fromHandle: 4). self + assert: (result isKindOf: FFITestAliasForInt32); - assert: (result isKindOf: FFITestIntAlias); assert: 10 equals: result value.! Item was changed: ----- Method: FFIPluginTests>>testIntCallReturnIntAlias (in category 'tests - type alias') ----- testIntCallReturnIntAlias | result | result := FFITestLibrary ffiTestIntAlias4IntSum: 1 with: 2 with: 3 with: 4. self + assert: (result isKindOf: FFITestAliasForInt32); - assert: (result isKindOf: FFITestIntAlias); assert: 10 equals: result value.! Item was added: + TestCase subclass: #FFIPluginTypeTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! + + !FFIPluginTypeTests commentStamp: 'mt 5/10/2021 09:48' prior: 0! + A collection of tests around the type signatures for the FFITestLibrary.! Item was added: + ----- Method: FFIPluginTypeTests>>argTypesAt: (in category 'support') ----- + argTypesAt: selector + + ^ (FFITestLibrary class >> selector) externalLibraryFunction argTypes! Item was added: + ----- Method: FFIPluginTypeTests>>testArray (in category 'tests') ----- + testArray + + (self argTypesAt: #ffiTestArrayType) do: [:type | + self + assert: type isPointerType; + deny: type isArrayType; + assert: type asNonPointerType isArrayType; + assert: type asNonPointerType size > 0]! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicBool (in category 'tests') ----- + testAtomicBool + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestBool:with:with:with:) + equals: (Array new: 5 withAll: ExternalType bool).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicChar (in category 'tests') ----- + testAtomicChar + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestChars:with:with:with:) + equals: (Array new: 5 withAll: ExternalType char).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicCharPointer (in category 'tests') ----- + testAtomicCharPointer + + self + assert: (self argTypesAt: #ffiPrintString:) + equals: (Array new: 2 withAll: ExternalType char asPointerType).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicDouble (in category 'tests') ----- + testAtomicDouble + + self + assert: (self argTypesAt: #ffiTestDoubles:with:) + equals: (Array new: 3 withAll: ExternalType double).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicFloat (in category 'tests') ----- + testAtomicFloat + + self + assert: (self argTypesAt: #ffiTestFloats:with:) + equals: (Array new: 3 withAll: ExternalType float).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicInt (in category 'tests') ----- + testAtomicInt + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) + equals: (Array new: 5 withAll: ExternalType int).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicLong (in category 'tests') ----- + testAtomicLong + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) + equals: (Array new: 5 withAll: ExternalType long).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicLongLong (in category 'tests') ----- + testAtomicLongLong + + self + assert: (self argTypesAt: #ffiTestLongLong:with:) + equals: (Array new: 3 withAll: ExternalType longlong).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicString (in category 'tests') ----- + testAtomicString + + self + assert: (self argTypesAt: #ffiPrintString:) + equals: (Array new: 2 withAll: ExternalType string).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicUint (in category 'tests') ----- + testAtomicUint + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst + equals: (Array new: 4 withAll: ExternalType uint).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicUlong (in category 'tests') ----- + testAtomicUlong + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst + equals: (Array new: 4 withAll: ExternalType ulong).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicVoid (in category 'tests') ----- + testAtomicVoid + "Only test for return type since argument 'void' means 'no argument' in C." + + self + assert: (self argTypesAt: #ffiTestVoid) + equals: {ExternalType void}.! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicVoidPointer (in category 'tests') ----- + testAtomicVoidPointer + + self + assert: (self argTypesAt: #ffiTestVoidPointer) + equals: (Array new: 2 withAll: ExternalType void asPointerType).! Item was added: + ----- Method: FFIPluginTypeTests>>testStruct (in category 'tests') ----- + testStruct + + self + assert: (self argTypesAt: #ffiTestStruct64:with:) + equals: (Array new: 3 withAll: FFITestPoint2 externalType).! Item was added: + ----- Method: FFIPluginTypeTests>>testStructPointer (in category 'tests') ----- + testStructPointer + + self + assert: (self argTypesAt: #ffiTestPointers:with:) + equals: (Array new: 3 withAll: FFITestPoint4 externalType asPointerType).! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForChar + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForChar class>>originalTypeName (in category 'type alias') ----- + originalTypeName + + ^ 'char'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForCharPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForCharPointer class>>originalTypeName (in category 'as yet unclassified') ----- + originalTypeName + " + self defineFields + " + ^ 'char*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32 class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'int32_t'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32Array + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32Array class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields. + " + ^ 'int32_t[5]'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32ArrayPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32ArrayPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + "^ 'int32_t[5]*' -- Not supported" + "^ 'void**' -- Not supported" + ^ 'void*' "Workaround."! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32Pointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32Pointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'int32_t*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForSdi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForSdi class>>originalTypeName (in category 'as yet unclassified') ----- + originalTypeName + " + self defineFields + " + ^ 'FFITestSdi'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForSdiPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForSdiPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'FFITestSdi*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForUfi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForUfi class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields. + " + ^ 'FFITestUfi'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForVoidPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForVoidPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'void*'! Item was removed: - ExternalTypeAlias subclass: #FFITestCharAlias - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests-Fixtures'! Item was removed: - ----- Method: FFITestCharAlias class>>originalTypeName (in category 'type alias') ----- - originalTypeName - - ^ 'char'! Item was added: + ExternalStructure subclass: #FFITestEmptyStruct + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was removed: - ExternalTypeAlias subclass: #FFITestIntAlias - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests-Fixtures'! Item was removed: - ----- Method: FFITestIntAlias class>>originalTypeName (in category 'type alias') ----- - originalTypeName - " - self defineFields - " - ^ 'int32_t'! Item was added: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWith:with: (in category 'mocks') ----- + ffiTestArrayResultWith: pt1 with: pt2 + "Allocates the result. Needs to be free'd after calling." + + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWithString: (in category 'mocks') ----- + ffiTestArrayResultWithString: aString + " + FFITestLibrary ffiTestArrayResultWithString: 'Hello Squeak'. + " + + ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestInt4IntAliasSum:with:with:with: (in category 'type alias') ----- ffiTestInt4IntAliasSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + - ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntAliasSum:with:with:with: (in category 'type alias') ----- ffiTestIntAlias4IntAliasSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + - ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntSum:with:with:with: (in category 'type alias') ----- ffiTestIntAlias4IntSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + - ^self externalCallFailed! Item was removed: - ----- Method: FFITestLink>>= (in category 'comparing') ----- - = other - - (other isKindOf: ExternalStructure) ifFalse: [^ false]. - self externalType = other externalType ifFalse: [^ false]. - ^ other getHandle = self getHandle! Item was removed: - ----- Method: FFITestLink>>hash (in category 'comparing') ----- - hash - - ^ ExternalObject hash bitXor: self getHandle hash! Item was added: + ExternalUnion subclass: #FFITestUdi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestUdi class>>fields (in category 'field definition') ----- + fields + " + self defineFields + " + ^#( + (d1 'double') + (i1 'int64_t') + )! Item was removed: - TestCase subclass: #FFITypeNameTests - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests'! Item was removed: - ----- Method: FFITypeNameTests>>argTypesAt: (in category 'support') ----- - argTypesAt: selector - - ^ (FFITestLibrary class >> selector) externalLibraryFunction argTypes! Item was removed: - ----- Method: FFITypeNameTests>>testArray (in category 'tests') ----- - testArray - - (self argTypesAt: #ffiTestArrayType) do: [:type | - self - assert: type isPointerType; - deny: type isArrayType; - assert: type asNonPointerType isArrayType; - assert: type asNonPointerType size > 0]! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicBool (in category 'tests') ----- - testAtomicBool - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestBool:with:with:with:) - equals: (Array new: 5 withAll: ExternalType bool).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicChar (in category 'tests') ----- - testAtomicChar - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestChars:with:with:with:) - equals: (Array new: 5 withAll: ExternalType char).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicCharPointer (in category 'tests') ----- - testAtomicCharPointer - - self - assert: (self argTypesAt: #ffiPrintString:) - equals: (Array new: 2 withAll: ExternalType char asPointerType).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicDouble (in category 'tests') ----- - testAtomicDouble - - self - assert: (self argTypesAt: #ffiTestDoubles:with:) - equals: (Array new: 3 withAll: ExternalType double).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicFloat (in category 'tests') ----- - testAtomicFloat - - self - assert: (self argTypesAt: #ffiTestFloats:with:) - equals: (Array new: 3 withAll: ExternalType float).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicInt (in category 'tests') ----- - testAtomicInt - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestInts:with:with:with:) - equals: (Array new: 5 withAll: ExternalType int).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicLong (in category 'tests') ----- - testAtomicLong - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestInts:with:with:with:) - equals: (Array new: 5 withAll: ExternalType long).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicLongLong (in category 'tests') ----- - testAtomicLongLong - - self - assert: (self argTypesAt: #ffiTestLongLong:with:) - equals: (Array new: 3 withAll: ExternalType longlong).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicString (in category 'tests') ----- - testAtomicString - - self - assert: (self argTypesAt: #ffiPrintString:) - equals: (Array new: 2 withAll: ExternalType string).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicUint (in category 'tests') ----- - testAtomicUint - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst - equals: (Array new: 4 withAll: ExternalType uint).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicUlong (in category 'tests') ----- - testAtomicUlong - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst - equals: (Array new: 4 withAll: ExternalType ulong).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicVoid (in category 'tests') ----- - testAtomicVoid - "Only test for return type since argument 'void' means 'no argument' in C." - - self - assert: (self argTypesAt: #ffiTestVoid) - equals: {ExternalType void}.! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicVoidPointer (in category 'tests') ----- - testAtomicVoidPointer - - self - assert: (self argTypesAt: #ffiTestVoidPointer) - equals: (Array new: 2 withAll: ExternalType void asPointerType).! Item was removed: - ----- Method: FFITypeNameTests>>testStruct (in category 'tests') ----- - testStruct - - self - assert: (self argTypesAt: #ffiTestStruct64:with:) - equals: (Array new: 3 withAll: FFITestPoint2 externalType).! Item was removed: - ----- Method: FFITypeNameTests>>testStructPointer (in category 'tests') ----- - testStructPointer - - self - assert: (self argTypesAt: #ffiTestPointers:with:) - equals: (Array new: 3 withAll: FFITestPoint4 externalType asPointerType).! From commits at source.squeak.org Fri May 14 13:04:43 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:04:43 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.30.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.30.mcz ==================== Summary ==================== Name: FFI-Tools-mt.30 Author: mt Time: 14 May 2021, 3:04:42.77076 pm UUID: 7076b5d3-0e8a-2648-a430-bdda981b628f Ancestors: FFI-Tools-mt.29 Complements FFI-Kernel-mt.142 =============== Diff against FFI-Tools-mt.29 =============== Item was added: + ----- Method: ExternalData>>explorerContents (in category '*FFI-Tools') ----- + explorerContents + "Prefix all instance variables and append extra meta information (e.g., the external type) as well as all structure fields as defined in #fields." + + | basicExplorerFields | + basicExplorerFields := super explorerContents. + basicExplorerFields do: [:explorerField | + explorerField itemName = '_type' ifTrue: [ + explorerField itemName: '_containerType']]. + ^ basicExplorerFields! Item was changed: ----- Method: ExternalData>>explorerContentsMetaFields (in category '*FFI-Tools') ----- explorerContentsMetaFields "Skip _type because our external type is already in the basic explorer fields because it is an instance variable. Add _contentType for clarification." ^ { - ObjectExplorerWrapper with: self containerType name: '_containerType' model: self. ObjectExplorerWrapper with: self contentType name: '_contentType' model: self. }! Item was changed: ----- Method: ExternalData>>explorerContentsStructFields (in category '*FFI-Tools') ----- explorerContentsStructFields "In case some data interpretation omitted to convert char*, which is a (null-terminated) C string, to Smalltalk string." + (self size notNil and: [self isNull not]) ifTrue: [ - size notNil ifTrue: [ ^ self withIndexCollect: [:each :index | ObjectExplorerWrapper with: each name: index printString model: self]]. ^ (ExternalStructureInspector readCStrings and: [self mightBeCString]) ifFalse: [#()] ifTrue: [ {ObjectExplorerWrapper with: ([self fromCString] ifError: [:msg | '<', msg, '>']) name: 'as C string' model: self}]! Item was added: + ----- Method: ExternalData>>explorerOkToClose (in category '*FFI-Tools') ----- + explorerOkToClose + "Overwritten to also check by content type. That is, a byte array full of pointers is also managed here." + + ^ ((handle isExternalAddress or: [self contentType isPointerType]) + and: [self isNull not]) + ifTrue: [self confirmFree] + ifFalse: [true]! Item was changed: ----- Method: ExternalData>>hasContentsInExplorer (in category '*FFI-Tools') ----- hasContentsInExplorer ^ super hasContentsInExplorer + or: [self size notNil or: [ExternalStructureInspector readCStrings and: [self mightBeCString]]]! - or: [size notNil or: [ExternalStructureInspector readCStrings and: [self mightBeCString]]]! Item was added: + ----- Method: ExternalStructure>>confirmFree (in category '*FFI-Tools') ----- + confirmFree + "Ask the user whether we should free the receivers handle." + + | byteSize | + (Project uiManager + confirm: ('There are {1} bytes addressed.
Do you want to free the allocated memory?' + translated format: { + (byteSize := self byteSize) notNil + ifTrue: [byteSize] ifFalse: ['an unknown number of']. }) asTextFromHtml + orCancel: [^ false] + title: 'External Pointer Detected' translated) + ifTrue: [self free]. + + ^ true! Item was changed: ----- Method: ExternalStructure>>explorerOkToClose (in category '*FFI-Tools') ----- explorerOkToClose "We are being explored and that explorer wants to close. If we point to external memory, ask the user whether we should free it to avoid leaks." + + ^ (self externalType isPointerType and: [self isNull not]) + ifTrue: [self confirmFree] + ifFalse: [true]! - - | byteSize | - (handle isExternalAddress and: [handle isNull not]) ifTrue: [ - (Project uiManager - confirm: ('There are {1} bytes addressed.
Do you want to free the allocated memory?' - translated format: { - (byteSize := self externalType byteSize) > 0 - ifTrue: [byteSize] ifFalse: ['an unknown number of']. }) asTextFromHtml - orCancel: [^ false] - title: 'External Address Detected' translated) - ifTrue: [self free]]. - - ^ true! Item was changed: ----- Method: ExternalStructureType>>explorerContents (in category '*FFI-Tools') ----- explorerContents + | basicExplorerFields fieldTypeFields | - | basicExplorerFields originalTypeField fieldTypeFields | basicExplorerFields := super explorerContents. - - self isTypeAlias ifTrue: [ - originalTypeField := ObjectExplorerWrapper - with: self originalType - name: '_originalType' - model: self. - ^ {originalTypeField}, basicExplorerFields]. fieldTypeFields := Array streamContents: [:s | self typesDo: [:type :fieldName | s nextPut: (ObjectExplorerWrapper with: type name: (fieldName ifNil: ['__'] ifNotNil: ['_', fieldName]) model: self)]]. ^ fieldTypeFields, basicExplorerFields! Item was changed: ----- Method: ExternalStructureType>>typesDo: (in category '*FFI-Tools-enumerating') ----- typesDo: block + (self isTypeAlias or: [self isTypeAliasReferenced]) + ifTrue: [^ self originalType typesDo: block]. - self assert: [self isPointerType not]. - self assert: [self referentClass notNil]. + self referentClass fields do: [:spec | + | fieldName typeName type | + fieldName := spec first. + typeName := spec second. + type := ExternalType typeNamed: typeName. + block cull: type cull: fieldName].! - (self isTypeAlias - ifTrue: [ - "Add a custom role to emphasize it in #allTypes." - {{#'_aliasFor' . self referentClass fields second}}] - ifFalse: [self referentClass fields]) - do: [:spec | - | fieldName typeName type | - fieldName := spec first. - typeName := spec second. - type := ExternalType typeNamed: typeName. - block cull: type cull: fieldName].! Item was changed: ----- Method: ExternalType>>explorerContents (in category '*FFI-Tools') ----- explorerContents + | basicExplorerFields originalTypeField | - | basicExplorerFields | basicExplorerFields := super explorerContents. basicExplorerFields do: [:explorerField | explorerField itemName = 'compiledSpec' ifTrue: [ explorerField changeClassTo: CompiledSpecWrapper]]. + + self isTypeAlias ifTrue: [ + originalTypeField := ObjectExplorerWrapper + with: self originalType + name: '_originalType' + model: self. + ^ {originalTypeField}, basicExplorerFields]. + ^ basicExplorerFields! Item was added: + ----- Method: ExternalUnknownType>>explorerContents (in category '*FFI-Tools') ----- + explorerContents + "Overwritten to just list fields for the instVars." + + | basicExplorerFields | + basicExplorerFields := self perform: #explorerContents withArguments: #() inSuperclass: Object. + basicExplorerFields do: [:explorerField | + explorerField itemName = 'compiledSpec' ifTrue: [ + explorerField changeClassTo: CompiledSpecWrapper]]. + + ^ basicExplorerFields! From commits at source.squeak.org Fri May 14 13:27:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:27:53 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.144.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.144.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.144 Author: mt Time: 14 May 2021, 3:27:52.47176 pm UUID: a4c9086d-420e-384c-818b-6e9b0052a86d Ancestors: FFI-Kernel-mt.143 Minor fix for better support of void* -- more tests needed. Works for FFI-Callbacks. =============== Diff against FFI-Kernel-mt.143 =============== Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- + setType: externalType - setType: containerType "Private. Set the type used to derive content and container types." + externalType isVoid ifTrue: [ + ^ self setType: externalType asPointerType]. + + externalType asNonPointerType isArrayType + ifTrue: [type := externalType] + ifFalse: [type := (externalType asArrayType: nil)]. - containerType asNonPointerType isArrayType - ifTrue: [type := containerType] - ifFalse: [type := (containerType asArrayType: nil)]. handle isExternalAddress ifTrue: [type := type asPointerType] ifFalse: [type := type asNonPointerType].! From commits at source.squeak.org Fri May 14 13:28:33 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:28:33 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.12.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.12.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.12 Author: mt Time: 14 May 2021, 3:28:32.65676 pm UUID: 51cbae8c-2817-eb44-b634-c1b7672455af Ancestors: FFI-Callbacks-mt.11 Complements FFI-Kernel-mt.142 =============== Diff against FFI-Callbacks-mt.11 =============== Item was removed: - ----- Method: ExternalAddress class>>fromInteger: (in category '*FFI-Callbacks') ----- - fromInteger: anInteger - "Read the given interger as an address pointing to an external memory area." - - | buffer type | - self flag: #refactor. "Maybe: ExternalAddress new fromInteger: anInteger --- and maybe move to FFI-Kernel" - type := ExternalType uintptr_t. - buffer := ByteArray new: type byteSize. - type handle: buffer at: 1 put: anInteger. - ^ buffer asExternalPointer! Item was changed: ----- Method: FFICallback class>>exampleCqsort04 (in category 'examples') ----- exampleCqsort04 " FFICallback exampleCqsort04 " | type in out fn cb | type := ExternalType int32_t. in := type allocateExternal: 10. 1 to: in size do: [:each | in at: each put: 100 atRandom]. cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | | a b | a := arg1 signedLongAt: 1. b := arg2 signedLongAt: 1. Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + - "self halt." (a - b) sign]. fn := ExternalLibraryFunction name: 'qsort' module: 'msvcrt.dll' callType: ExternalLibraryFunction callTypeCDecl returnType: ExternalType void argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). "Invoke!!" + [fn - fn invokeWith: in "getHandle" with: in size with: in contentType byteSize + with: cb thunk "getHandle"] + ifCurtailed: [in free]. - with: cb thunk "getHandle". out := in collect: [:each | each]. in free. ^ out! Item was changed: ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') ----- init__ccall_ARM32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm32abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long r0, long r1, long r2, long r3, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "0x0 : mov r12, sp ; 0xe1a0c00d 0x4 : sub sp, sp, #16 ; 0xe24dd010 0x8 : str pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates 0xc : str r12, [sp,#4] ; 0xe58dc004 0x10 : str lr, [sp, #12] ; 0xe58de00c 0x14 : ldr r12, [pc, #8] ; 0xe59fc008 0x18 : blx r12 ; 0xe12fff3c 0x1c : add sp, sp, #12 ; 0xe28dd00c 0x20 : ldr pc, [sp], #4!! ; 0xe49df004 ; pop {pc} 0x24 : .word thunkEntry" self flag: #hidden. "mt: How is the thunk's handle stored to lookup this instance upon callback later?" thunk getHandle unsignedLongAt: 1 put: 16re1a0c00d; unsignedLongAt: 5 put: 16re24dd010; unsignedLongAt: 9 put: 16re58df000; unsignedLongAt: 13 put: 16re58dc004; unsignedLongAt: 17 put: 16re58de00c; unsignedLongAt: 21 put: 16re59fc008; unsignedLongAt: 25 put: 16re12fff3c; unsignedLongAt: 29 put: 16re28dd00c; unsignedLongAt: 33 put: 16re49df004; + pointerAt: 37 put: self thunkEntryAddress length: 4.! - shortPointerAt: 37 put: self thunkEntryAddress.! Item was changed: ----- Method: FFICallback>>init__ccall_IA32 (in category 'initialization - thunk prepare') ----- init__ccall_IA32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0x9090c30C thunk+21: ret 0xc3 thunk+22: nop 0x90 thunk+23: nop 0x90" thunk getHandle unsignedLongAt: 1 put: 16rB8905454; + pointerAt: 5 put: self thunkEntryAddress length: 4; - shortPointerAt: 5 put: self thunkEntryAddress; unsignedLongAt: 9 put: 16r68909090; + pointerAt: 13 put: thunk getHandle length: 4; - shortPointerAt: 13 put: thunk getHandle; unsignedLongAt: 17 put: 16rC483D0FF; unsignedLongAt: 21 put: 16r9090C30C! Item was changed: ----- Method: FFICallback>>init__ccall_X64 (in category 'initialization - thunk prepare') ----- init__ccall_X64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64sysvabicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. handle thunk+0xc: pushq %rax 50 thunk+0xd: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x17: callq *%rax ff d0 thunk+0x19: addq $0x18, %rsp 48 83 c4 18 thunk+0x1d: retq c3 thunk+0x1e: nop 90 thunk+0x1f: nop 90" thunk getHandle unsignedLongAt: 1 put: 16rb8485454; + pointerAt: 5 put: thunk getHandle length: 8; - longPointerAt: 5 put: thunk getHandle; unsignedLongAt: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" + pointerAt: 16 put: self thunkEntryAddress length: 8; - longPointerAt: 16 put: self thunkEntryAddress; unsignedByteAt: 24 put: 16rff; unsignedLongAt: 25 put: 16rc48348d0; unsignedLongAt: 29 put: 16r9090c318.! Item was changed: ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'initialization - thunk prepare') ----- init__ccall_X64Win64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. addressField thunk+0xc: pushq %rax 50 thunk+0xd: subq $0x20, %rsp 48 83 c4 e0 (this is addq -20 since the immediate is signed extended) thunk+0x11: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x1b: callq *%rax ff d0 thunk+0x1d: addq $0x38, %rsp 48 83 c4 38 thunk+0x21: retq c3 thunk+0x22: nop 90 thunk+0x23: nop 90" thunk getHandle unsignedLongAt: 1 put: 16rb8485454; + pointerAt: 5 put: thunk getHandle length: 8; - longPointerAt: 5 put: thunk getHandle; unsignedLongAt: 13 put: 16rc4834850; unsignedLongAt: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" + pointerAt: 20 put: self thunkEntryAddress length: 8; - longPointerAt: 20 put: self thunkEntryAddress; unsignedByteAt: 28 put: 16rff; unsignedLongAt: 29 put: 16rc48348d0; unsignedLongAt: 33 put: 16r9090c338.! Item was changed: ----- Method: FFICallback>>init__stdcall_IA32: (in category 'initialization - thunk prepare') ----- init__stdcall_IA32: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes. (See #init__ccall_IA32 for more info)" "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0xBYTSc20C thunk+21: ret $bytes 0xc2 0xBY 0xTS" thunk getHandle unsignedLongAt: 1 put: 16rB8905454; + pointerAt: 5 put: self thunkEntryAddress length: 4; - shortPointerAt: 5 put: self thunkEntryAddress; unsignedLongAt: 9 put: 16r68909090; + pointerAt: 13 put: thunk getHandle length: 4; - shortPointerAt: 13 put: thunk getHandle; unsignedLongAt: 17 put: 16rC483D0FF; unsignedShortAt: 21 put: 16rC20C; unsignedShortAt: 23 put: numBytes.! From commits at source.squeak.org Fri May 14 13:52:44 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 13:52:44 0000 Subject: [squeak-dev] The Inbox: Protocols-jr.82.mcz Message-ID: A new version of Protocols was added to project The Inbox: http://source.squeak.org/inbox/Protocols-jr.82.mcz ==================== Summary ==================== Name: Protocols-jr.82 Author: jr Time: 14 May 2021, 3:52:50.855866 pm UUID: fa44c7c0-1902-5140-be89-51048d272a3c Ancestors: Protocols-nice.81 Use MethodReferences in "browse protocol". Enables to drag methods out to the World and have CodeHolders opened on them, like it was introduced in Morphic-mt.1733. =============== Diff against Protocols-nice.81 =============== Item was changed: ----- Method: Lexicon>>displaySelector: (in category 'basic operation') ----- displaySelector: aSelector "Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category" | detectedItem messageIndex | self chooseCategory: (self categoryDefiningSelector: aSelector). detectedItem := messageList detect: + [:anItem | anItem selector == aSelector] ifNone: [^ Beeper beep]. - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ Beeper beep]. messageIndex := messageList indexOf: detectedItem. self messageListIndex: messageIndex! Item was changed: ----- Method: Lexicon>>initListFrom:highlighting: (in category 'initialization') ----- initListFrom: selectorCollection highlighting: aClass "Make up the messageList with items from aClass in boldface. Provide a final filtering in that only selectors whose implementations fall within my limitClass will be shown." messageList := OrderedCollection new. selectorCollection do: + [:selector | | item text defClass | + defClass := aClass whichClassIncludesSelector: selector. - [:selector | | item defClass | defClass := aClass whichClassIncludesSelector: selector. (defClass notNil and: [defClass includesBehavior: self limitClass]) ifTrue: + [item := MethodReference class: defClass selector: selector. + text := selector, ' (' , defClass name , ')'. + text := text asText. + defClass == aClass ifTrue: [text allBold]. + item stringVersion: text. - [item := selector, ' (' , defClass name , ')'. - item := item asText. - defClass == aClass ifTrue: [item allBold]. "(self isThereAnOverrideOf: selector) ifTrue: [item addAttribute: TextEmphasis struckOut]." "The above has a germ of a good idea but could be very slow" messageList add: item]]! Item was changed: ----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') ----- selectSelectorItsNaturalCategory: aSelector "Make aSelector be the current selection of the receiver, with the category being its home category." | cat catIndex detectedItem | cat := self categoryOfSelector: aSelector. catIndex := categoryList indexOf: cat ifAbsent: ["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category" 1]. self categoryListIndex: catIndex. detectedItem := messageList detect: + [:anItem | anItem selector == aSelector] ifNone: [^ self]. - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ self]. self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! Item was changed: ----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') ----- selectWithinCurrentCategory: aSelector "If aSelector is one of the selectors seen in the current category, select it" | detectedItem | detectedItem := self messageList detect: + [:anItem | anItem selector == aSelector] ifNone: [^ self]. - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ self]. self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! Item was changed: ----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') ----- selectWithinCurrentCategoryIfPossible: aSelector "If the receiver's message list contains aSelector, navigate right to it without changing categories" | detectedItem messageIndex | aSelector ifNil: [^ self]. detectedItem := messageList detect: + [:anItem | anItem selector == aSelector] ifNone: [^ self]. - [:anItem | (anItem asString copyUpTo: $ ) asSymbol == aSelector] ifNone: [^ self]. messageIndex := messageList indexOf: detectedItem. self messageListIndex: messageIndex ! Item was changed: ----- Method: Lexicon>>setToShowSelector:selectCategory: (in category 'selection') ----- setToShowSelector: selectorString selectCategory: aBoolean "Set up the receiver so that it will show the given selector" | catName catIndex messageIndex aList | catName := aBoolean ifTrue: [ (aList := currentVocabulary categoriesContaining: selectorString forClass: targetClass) at: 1 ifAbsent: [ self class allCategoryName ] ] ifFalse: [ self class allCategoryName ]. catIndex := categoryList indexOf: catName ifAbsent: [ 1 ]. self categoryListIndex: catIndex. messageList detect: + [ : anItem | anItem selector == selectorString ] - [ : anItem | (anItem copyUpTo: Character space) asString asSymbol == selectorString ] ifFound: [ : detectedItem | messageIndex := messageList indexOf: detectedItem. self messageListIndex: messageIndex ] ifNone: [ ^ self ]! From jakres+squeak at gmail.com Fri May 14 13:55:49 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Fri, 14 May 2021 15:55:49 +0200 Subject: [squeak-dev] The Inbox: Protocols-jr.82.mcz In-Reply-To: References: Message-ID: Note that I only briefly tested this as follows: open another Lexicon, see whether any errors pop up, search for a selector, change the selection, drag out a method. As you can see that I uploaded this, I saw no regressions during these steps. Am Fr., 14. Mai 2021 um 15:52 Uhr schrieb : > > A new version of Protocols was added to project The Inbox: > http://source.squeak.org/inbox/Protocols-jr.82.mcz > > ==================== Summary ==================== > > Name: Protocols-jr.82 > Author: jr > Time: 14 May 2021, 3:52:50.855866 pm > UUID: fa44c7c0-1902-5140-be89-51048d272a3c > Ancestors: Protocols-nice.81 > > Use MethodReferences in "browse protocol". Enables to drag methods out to the World and have CodeHolders opened on them, like it was introduced in Morphic-mt.1733. > > =============== Diff against Protocols-nice.81 =============== > > Item was changed: > ----- Method: Lexicon>>displaySelector: (in category 'basic operation') ----- > displaySelector: aSelector > "Set aSelector to be the one whose source shows in the browser. If there is a category list, make it highlight a suitable category" > > | detectedItem messageIndex | > self chooseCategory: (self categoryDefiningSelector: aSelector). > detectedItem := messageList detect: > + [:anItem | anItem selector == aSelector] ifNone: [^ Beeper beep]. > - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ Beeper beep]. > messageIndex := messageList indexOf: detectedItem. > self messageListIndex: messageIndex! > > Item was changed: > ----- Method: Lexicon>>initListFrom:highlighting: (in category 'initialization') ----- > initListFrom: selectorCollection highlighting: aClass > "Make up the messageList with items from aClass in boldface. Provide a final filtering in that only selectors whose implementations fall within my limitClass will be shown." > > > messageList := OrderedCollection new. > selectorCollection do: > + [:selector | | item text defClass | > + defClass := aClass whichClassIncludesSelector: selector. > - [:selector | | item defClass | defClass := aClass whichClassIncludesSelector: selector. > (defClass notNil and: [defClass includesBehavior: self limitClass]) ifTrue: > + [item := MethodReference class: defClass selector: selector. > + text := selector, ' (' , defClass name , ')'. > + text := text asText. > + defClass == aClass ifTrue: [text allBold]. > + item stringVersion: text. > - [item := selector, ' (' , defClass name , ')'. > - item := item asText. > - defClass == aClass ifTrue: [item allBold]. > "(self isThereAnOverrideOf: selector) ifTrue: [item addAttribute: TextEmphasis struckOut]." > "The above has a germ of a good idea but could be very slow" > messageList add: item]]! > > Item was changed: > ----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') ----- > selectSelectorItsNaturalCategory: aSelector > "Make aSelector be the current selection of the receiver, with the category being its home category." > > | cat catIndex detectedItem | > cat := self categoryOfSelector: aSelector. > catIndex := categoryList indexOf: cat ifAbsent: > ["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category" > 1]. > self categoryListIndex: catIndex. > detectedItem := messageList detect: > + [:anItem | anItem selector == aSelector] ifNone: [^ self]. > - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ self]. > self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! > > Item was changed: > ----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') ----- > selectWithinCurrentCategory: aSelector > "If aSelector is one of the selectors seen in the current category, select it" > > | detectedItem | > detectedItem := self messageList detect: > + [:anItem | anItem selector == aSelector] ifNone: [^ self]. > - [:anItem | (anItem asString copyUpTo: Character space) asSymbol == aSelector] ifNone: [^ self]. > self messageListIndex: (messageList indexOf: detectedItem ifAbsent: [^ self])! > > Item was changed: > ----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') ----- > selectWithinCurrentCategoryIfPossible: aSelector > "If the receiver's message list contains aSelector, navigate right to it without changing categories" > > | detectedItem messageIndex | > aSelector ifNil: [^ self]. > detectedItem := messageList detect: > + [:anItem | anItem selector == aSelector] ifNone: [^ self]. > - [:anItem | (anItem asString copyUpTo: $ ) asSymbol == aSelector] ifNone: [^ self]. > messageIndex := messageList indexOf: detectedItem. > self messageListIndex: messageIndex > ! > > Item was changed: > ----- Method: Lexicon>>setToShowSelector:selectCategory: (in category 'selection') ----- > setToShowSelector: selectorString selectCategory: aBoolean > "Set up the receiver so that it will show the given selector" > | catName catIndex messageIndex aList | > catName := aBoolean > ifTrue: > [ (aList := currentVocabulary > categoriesContaining: selectorString > forClass: targetClass) > at: 1 > ifAbsent: [ self class allCategoryName ] ] > ifFalse: [ self class allCategoryName ]. > catIndex := categoryList > indexOf: catName > ifAbsent: [ 1 ]. > self categoryListIndex: catIndex. > messageList > detect: > + [ : anItem | anItem selector == selectorString ] > - [ : anItem | (anItem copyUpTo: Character space) asString asSymbol == selectorString ] > ifFound: > [ : detectedItem | messageIndex := messageList indexOf: detectedItem. > self messageListIndex: messageIndex ] > ifNone: [ ^ self ]! > > From commits at source.squeak.org Fri May 14 14:01:09 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:01:09 0000 Subject: [squeak-dev] The Inbox: ToolsTests-ct.105.mcz Message-ID: A new version of ToolsTests was added to project The Inbox: http://source.squeak.org/inbox/ToolsTests-ct.105.mcz ==================== Summary ==================== Name: ToolsTests-ct.105 Author: ct Time: 14 May 2021, 4:01:07.575396 pm UUID: d8579d99-14d7-2b49-86d2-7cb6e5be9c8e Ancestors: ToolsTests-nice.104 Adds (currently failing) test for basic-inspecting a void ProtoObject. Since we expect the BasicInspector not to send any message to its object, this should not fail. Fixes are coming soon ... =============== Diff against ToolsTests-nice.104 =============== Item was added: + ----- Method: BasicInspectorTest>>testProtoObject (in category 'tests') ----- + testProtoObject + + self inspector object: ProtoObject new. + self assert: '*ProtoObject*' matches: self inspector labelString. + self testValuePane.! From commits at source.squeak.org Fri May 14 14:04:22 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:04:22 0000 Subject: [squeak-dev] The Inbox: Tools-ct.1056.mcz Message-ID: A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1056.mcz ==================== Summary ==================== Name: Tools-ct.1056 Author: ct Time: 14 May 2021, 4:04:19.358396 pm UUID: eac0462e-77bd-8a47-b585-929c7ec9cf2e Ancestors: Tools-mt.1055 Relieves BasicInspector of sending any (non-inlined) messages to the inspected object. Fixes #testProtoObject from ToolsTests-ct.105. Now you can even inspect uninitialized FutureMakers. :-) Depends on Kernel-ct.1404 (Context >> #objectIsReadOnly:). =============== Diff against Tools-mt.1055 =============== Item was changed: ----- Method: BasicInspector>>labelString (in category 'initialization') ----- labelString ^ '{1} {2}{3}' format: { '[basic]'. self basicObjectPrintString. + ((thisContext objectIsReadOnly: self object) "do not send #isReadOnlyObject, receiver could be a proxy" - (self object isReadOnlyObject ifTrue: [' (read-only)'] ifFalse: [''])}! Item was changed: ----- Method: Inspector>>updateStyler:requestor: (in category 'user interface - styling') ----- updateStyler: aStyler requestor: anObject "Use this method to update our fieldListStyler and all view stylers." aStyler environment: self environment; + classOrMetaClass: (thisContext objectClass: self doItReceiver "do not send #class, receiver could be a proxy"); - classOrMetaClass: (self doItReceiver perform: #class "do not inline send of #class, receiver could be a proxy"); context: self doItContext; parseAMethod: false.! From commits at source.squeak.org Fri May 14 14:05:55 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:05:55 0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1404.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1404.mcz ==================== Summary ==================== Name: Kernel-ct.1404 Author: ct Time: 14 May 2021, 4:05:51.632396 pm UUID: 9672a515-87f1-254a-af3d-a34210bd7e10 Ancestors: Kernel-nice.1402 Adds mirror primitive for primitiveGetImmutability (primitive 163/#isReadOnlyObject). Necessary for Tools-ct.1056 (fix for BasicInspectorTest >> #testProtoObject). =============== Diff against Kernel-nice.1402 =============== Item was added: + ----- Method: Context>>objectIsReadOnly: (in category 'mirror primitives') ----- + objectIsReadOnly: anObject + "Answer if the argument is read-only without sending it a message. This micimcs the action of the VM when an object is tested for writeability. See Object >> #isReadOnlyObject." + + + ^ (self objectClass: anObject) isImmediateClass! From commits at source.squeak.org Fri May 14 14:18:32 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:18:32 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.145.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.145.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.145 Author: mt Time: 14 May 2021, 4:18:31.545022 pm UUID: 0bda75fa-1b6d-0c48-ad46-be932ab91311 Ancestors: FFI-Kernel-mt.144 Make it easy to switch an array's content type without loosing its size information. Fixes recompilation of all affected methods by also checking the #callback: pragma. (See FFI-Callbacks) =============== Diff against FFI-Kernel-mt.144 =============== Item was added: + ----- Method: ExternalData>>setContentType: (in category 'private') ----- + setContentType: externalType + + self setType: (externalType asArrayType: self size).! Item was changed: ----- Method: ExternalType class>>recompileAllLibraryFunctions (in category 'housekeeping') ----- recompileAllLibraryFunctions "Recompile all methods that do FFI calls (e.g. or ) to update all mappings from type name to atomic type and struct type. Note that unknown struct types will be created on-the-fly and can later be completed by defining fields in the particular structure class via #defineFields or #compileFields. Note that such a recompilation is especially useful if 'type constants' for atomic types to additional dispatch such as according to the current platform's #wordSize." SystemNavigation default allSelectorsAndMethodsDo: [:behavior :selector :method | + (method externalLibraryFunction notNil + or: [method hasPragma: #callback:]) + ifTrue: [behavior recompile: selector]].! - method externalLibraryFunction ifNotNil: [behavior recompile: selector]].! From commits at source.squeak.org Fri May 14 14:19:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:19:39 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.13.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.13.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.13 Author: mt Time: 14 May 2021, 4:19:38.426022 pm UUID: b29d5eae-e802-c644-9431-430613ced096 Ancestors: FFI-Callbacks-mt.12 Fixes callbacks for 64-bit. Clean up some code in the qsort examples. =============== Diff against FFI-Callbacks-mt.12 =============== Item was changed: ----- Method: ExternalType class>>lookupTypes: (in category '*FFI-Callbacks') ----- lookupTypes: signature " Supported arguments: '' ... pragma as string #(int 'double*' 'double*') ... array with type names { ExternalType int. ExternalType double asPointerType. ExternalType double asPointerType } ... array with external types " (signature isString and: [signature first == $<]) ifTrue: [ ^ (Parser new parse: 'foo', String cr, signature class: Object) properties pragmas first argumentAt: 1]. signature first isString ifTrue: [ ^ signature collect: [:typeName | self typeNamed: typeName]]. + (signature first isKindOf: ExternalType) ifTrue: [ - signature first class == ExternalType ifTrue: [ ^ signature]. self error: 'Could not lookup external types from signature'.! Item was changed: ----- Method: FFICallback class>>exampleCqsort01 (in category 'examples') ----- exampleCqsort01 "Call the libc qsort function (which requires a callback)." "FFICallback exampleCqsort01" "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" + | type cb rand nElements values orig sort libcName knownLibcNames fn | - | type cb rand nElements sizeofDouble values orig sort libcName knownLibcNames fn | knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll'). libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'. libcName = 0 ifTrue: [^ self]. libcName := knownLibcNames at: libcName. rand := Random new. type := ExternalType double. - sizeofDouble := type byteSize. nElements := 10. + values := type allocateExternal: nElements. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. - values size: nElements. "Fetch a local copy of the external data." + orig := values copy. - orig := values collect: [:each | each]. "Construct the callback structure." cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | | a b | + a := arg1. + b := arg2. - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. (a - b) sign]. "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );" fn := ExternalLibraryFunction name: 'qsort' module: libcName callType: ExternalLibraryFunction callTypeCDecl returnType: ExternalType void argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). "Invoke!!" + fn + invokeWith: values "getHandle" + with: nElements + with: type byteSize + with: cb thunk "getHandle". - fn invokeWith: values "getHandle" with: nElements with: sizeofDouble with: cb thunk "getHandle". sort := values collect: [:each | each]. + values free. - values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback class>>exampleCqsort02 (in category 'examples') ----- exampleCqsort02 "Call the libc qsort function (which requires a callback)." " FFICallback exampleCqsort02 " "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" | type rand nElements sizeofDouble values orig sort | rand := Random new. type := ExternalType double. sizeofDouble := type byteSize. nElements := 10. + values := type allocateExternal: nElements. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. + - values size: nElements. "Fetch a local copy of the external data." + orig := values copy. + - orig := values collect: [:each | each]. - "Invoke!!" self + qsort: values with: values size with: values contentType byteSize - qsort: values with: nElements with: sizeofDouble with: [ :arg1 :arg2 | | a b | + a := arg1. + b := arg2. - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. (a - b) sign]. + sort := values copy. + values free. - sort := values collect: [:each | each]. - values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback class>>exampleCqsort03 (in category 'examples') ----- exampleCqsort03 "Call the libc qsort function (which requires a callback)." " FFICallback exampleCqsort03 " "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" + | type rand nElements values orig sort cb | - | type rand nElements sizeofDouble values orig sort cb | rand := Random new. type := ExternalType double. - sizeofDouble := type byteSize. nElements := 10. + values := type allocateExternal: nElements. - values := ExternalData - fromHandle: (ExternalAddress allocate: nElements * sizeofDouble) - type: type asPointerType. "Initialize external data and set size for enumeration." 1 to: nElements do: [:i| values at: i put: rand next]. + - values size: nElements. "Fetch a local copy of the external data." + orig := values copy. - orig := values collect: [:each | each]. "Construct the callback structure." cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | | a b | + a := arg1. + b := arg2. - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. (a - b) sign]. "Invoke!!" self + cdeclQsort: values with: values size with: values contentType byteSize - cdeclQsort: values with: nElements with: sizeofDouble with: cb thunk. sort := values collect: [:each | each]. + values free. - values getHandle free. ^orig -> sort! Item was changed: ----- Method: FFICallback class>>exampleCqsort04 (in category 'examples') ----- exampleCqsort04 " FFICallback exampleCqsort04 " | type in out fn cb | type := ExternalType int32_t. in := type allocateExternal: 10. 1 to: in size do: [:each | in at: each put: 100 atRandom]. cb := FFICallback signature: '' "signature: #(int 'double*' 'double*')" block: [ :arg1 :arg2 | | a b | + a := arg1. + b := arg2. - a := arg1 signedLongAt: 1. - b := arg2 signedLongAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - (a - b) sign]. fn := ExternalLibraryFunction name: 'qsort' module: 'msvcrt.dll' callType: ExternalLibraryFunction callTypeCDecl returnType: ExternalType void argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). "Invoke!!" [fn invokeWith: in "getHandle" with: in size with: in contentType byteSize with: cb thunk "getHandle"] ifCurtailed: [in free]. + out := in copy. - out := in collect: [:each | each]. in free. ^ out! Item was changed: ----- Method: FFICallback class>>qsort:with:with:with: (in category 'examples') ----- qsort: values with: number with: width with: block "Indirection to define the signature for the provided block." | callback | callback := FFICallback signature: ((thisContext method pragmaAt: #callback:) argumentAt: 1) block: block. + - ^ self cdeclQsort: values with: number with: width with: callback thunk! Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) + ifTrue: [intPos := intPos + 1. intArgs setContentType: argType. (intArgs at: intPos) value] - ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data - ifNotNil: [ "1b) Materialize pointers from integers." - isPointer ifTrue: [ - self flag: #designSmell. "mt: If we had a way to set, for example, double** as container type and double* as content type for intArgs, we would not have to construct the correct external object here but already had it." - self flag: #discuss. "mt: Should we resolve atomic types? That is, double* to an actual float object etc? Well, for pointers to external structures (unions, ...) it would make sense to provide an actual instance of that structure to the callback... If so, we just need to send #value below." - data := (ExternalData - fromHandle: (ExternalAddress fromInteger: data) - type: argType size: 1) "value"]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := argType handle: handle at: byteOffset. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! From commits at source.squeak.org Fri May 14 14:26:36 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:26:36 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1408.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1408.mcz ==================== Summary ==================== Name: Kernel-jar.1408 Author: jar Time: 14 May 2021, 4:26:31.500152 pm UUID: 0e0ea158-ad50-464c-847c-76413db42968 Ancestors: Kernel-nice.1407 Improve (and supersede) #terminate from Kernel-jar.1406. The point is the Debugger actually resumes after finding an error and only updates its title ( which I never fully noticed :o ) but during termination each nested error opens a new debugger - this means I can't override #runUntilErrorOrReturnFrom: as I suggested previously so I created its copy named #runUnwindUntilErrorOrReturnFrom: with the modified functionality required by #terminate. (It's a code duplication, I know, but I'd like to get it working now) On top of that I extracted a repeating part of #terminate's code to a new method #complete:to: to improve readability and avoid further code duplication. So you can now debug safely (and correctly) even examples like: [self error] ensure: [^2] =============== Diff against Kernel-nice.1407 =============== Item was added: + ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'controlling') ----- + runUnwindUntilErrorOrReturnFrom: aSender + "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." + "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." + + | error ctxt here topContext | + here := thisContext. + + "Insert ensure and exception handler contexts under aSender" + error := nil. + ctxt := aSender insertSender: (Context + contextOn: UnhandledError do: [:ex | + error ifNil: [ + error := ex exception. + topContext := thisContext. + here jump. + ex signalerContext restart "re-signal the error when jumped back"] + ifNotNil: [ex pass] + ]). + ctxt := ctxt insertSender: (Context + contextEnsure: [error ifNil: [ + topContext := thisContext. + here jump] + ]). + self jump. "Control jumps to self" + + "Control resumes here once above ensure block or exception handler is executed" + ^ error ifNil: [ + "No error was raised, remove ensure context by stepping until popped" + [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. + {topContext. nil} + + ] ifNotNil: [ + "Error was raised, remove inserted above contexts then return signaler context" + aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" + {topContext. error} + ]! Item was added: + ----- Method: Process>>complete:to: (in category 'private') ----- + complete: topContext to: aContext + "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled + error is raised. Return self's new top context. Note: topContext must be a stack top context. + This method is meant to be called primarily by Process>>#terminate." + + | pair top error doNotDebug | + pair := Processor activeProcess + evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext] + onBehalfOf: self. + top := pair first. + error := pair second. + "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite recursion + of BlockCannotReturn or MessageNotUnderstood errors; blocks containing these exceptions are + skipped silently and the unwind procedure continues." + doNotDebug := {BlockCannotReturn. MessageNotUnderstood}. + "If an error was detected jump back to #runUntilErrorOrReturnFrom: to open a debugger unless + the error is in the doNotDebug list." + error ifNotNil: [(doNotDebug includes: error class) ifFalse: [top jump]]. + ^top + ! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | ctxt unwindBlock oldList outerMost top newTop | - | ctxt unwindBlock oldList outerMost top pair doNotDebug | self isActiveProcess ifTrue: [ "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. suspendedContext ifNotNil: [ "Release any method marked with the pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + top := suspendedContext. + suspendedContext := nil. "disable this process while running its stack in active process below" - ctxt := top := suspendedContext. - "Disable this process while running its stack in active process below" - suspendedContext := nil. - "Define an exclusion list of exceptions requiring special care to prevent e.g. an infinite - recursion of MNU errors or a VM crash in case of a non-local return to a dead home context; - blocks containing these exceptions are silently skipped and the unwind procedure continues; - UndefinedObject represents #runUntilErrorOrReturnFrom: found no error and answered nil." - doNotDebug := {UndefinedObject. BlockCannotReturn. MessageNotUnderstood}. "If terminating a process halfways through an unwind, try to complete that unwind block first; if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner blocks will be completed in the process. Halfway through blocks have already set the complete variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true." + ctxt := top. [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: [ (ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + "Now outerMost is the outer-most unwind context currently under evaluation (or nil). Let's finish it. + Note: outerMost may in theory be the top context e.g. in case #ensure was interrupted right after + assigning its complete := true." + outerMost ifNotNil: [newTop := self complete: top to: outerMost]. - outerMost ifNotNil: ["This is the outer-most unwind context currently under evaluation" - "Let's finish the unfinished unwind context only and return here. Note: top may be equal - to outerMost e.g. in case #ensure was interrupted right after assigning complete := true." - pair := Processor activeProcess - evaluate: [top runUntilErrorOrReturnFrom: outerMost] - onBehalfOf: self. - "If an error was detected jump back to open a debugger; do not jump back if the error is - in the doNotDebug list. Note: for more information on the return value pair see comments - in #runUntilErrorOrReturnFrom." - (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. + "Now all halfway-through unwind blocks have been completed; let's execute the ones still pending. + Note: newTop sender points to the former outerMost sender i.e. the next unexplored context. + Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver + itself may be an unwind context." + ctxt := newTop ifNil: [top] ifNotNil: [newTop sender]. - "Now all unwind blocks caught halfway through have been completed; - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context; - set ctxt as a new starting point in a search for the remaining unwind blocks. - Note: pair first sender points to outerMost sender i.e. the next unexplored context." - ctxt := pair ifNil: [top] ifNotNil: [pair first sender]. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. "Create a context for the unwind block and execute it on the unwind block's stack. + Note: using #value instead of #complete:to: would lead to executing the unwind + on the wrong stack preventing the correct execution of non-local returns." - Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing - the unwind on the wrong stack preventing the correct execution of non-local returns." top := unwindBlock asContextWithSender: ctxt. + self complete: top to: top]. - pair := Processor activeProcess - evaluate: [top runUntilErrorOrReturnFrom: top] - onBehalfOf: self. - "If an error was detected jump back to open a debugger; do not jump back if the error is - in the doNotDebug list. Note: for more information on the return value pair see comments - in #runUntilErrorOrReturnFrom." - (doNotDebug includes: pair second class) ifFalse: [pair first jump]]. ctxt := ctxt findNextUnwindContextUpTo: nil]] ! From commits at source.squeak.org Fri May 14 14:28:13 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:28:13 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.14.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.14.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.14 Author: mt Time: 14 May 2021, 4:28:12.386065 pm UUID: d4e4e533-7d17-f14e-8810-223b646f520d Ancestors: FFI-Callbacks-mt.13 I forgot the #value for stack arguments. Sorry for the noise. =============== Diff against FFI-Callbacks-mt.13 =============== Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs setContentType: argType. (intArgs at: intPos) value] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNil: [ "2) If nothing was read, read the argument from the stack." + data := (argType handle: handle at: byteOffset) value. - data := argType handle: handle at: byteOffset. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! From m at jaromir.net Fri May 14 14:28:52 2021 From: m at jaromir.net (Jaromir Matas) Date: Fri, 14 May 2021 09:28:52 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: References: <1620845299641-0.post@n4.nabble.com> Message-ID: <1621002532100-0.post@n4.nabble.com> Hi Nicolas, thanks for your quick response; stepping over #aboutToReturn:through: now works perfectly, however the same problem remains on lower levels, i.e. for stepping over #return:through: and #resume:through: - same example, same incorrect behavior: [^2] ensure: [Transcript showln: 'done'] step into ^2 then repeat step over until you step over the return:through: and cannot return is back. Same on the level below: step into ^2 then into return:through: and then step over #resume:through: - and again, you get the cannot return error. Once you're inside #resume:through: it seems safe. So I'm wondering whether it's possible to invoke a simulated version of #resume:through: somehow instead of #aboutToReturn:through: - I guess you'd know the answer :) BTW: I tried your fix in Cuis and it works perfectly there as well :) During testing I realized I'd missed one more detail in my #terminate fix so here's the latest version in the Inbox: Kernel-jar.1408 (including your fix Kernel-nice.1407) The point is the Debugger actually resumes after finding an error and only updates its title ( which I never fully noticed :o ) but during termination each nested error opens a new debugger - this means I can't override #runUntilErrorOrReturnFrom: as I suggested previously so I created its copy named #runUnwindUntilErrorOrReturnFrom: with the modified functionality required by #terminate. (It's a code duplication, I know, but I'd like to get it working now) On top of that I extracted a repeating part of #terminate's code to a new method #complete:to: to improve readability and avoid further code duplication. So you can now debug safely (and correctly) even examples like: [self error] ensure: [^2] Thanks again, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 14 14:29:50 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 14 May 2021 14:29:50 +0000 Subject: [squeak-dev] Changeset: fix-generic-inspectOne-with-truncation.cs Message-ID: Hi all! Jan Ehmueller and Fabio (fn) have discovered an Inspector bug with #inspectOne/"inspect element..." in the field list menu that hindered users from entering the index of a truncated element in the inspect element dialog. Possible ways to reproduce the issue include: * Inspector openOn: (Array new: 1024) -> … -> Click -> 90 -> Enter * (SmalltalkImage>>#snapshot:andQuit:withExitCode:embedded:) inspect -> right click self -> inspect element... -> 450 -> Enter (might depend on Sista) * TruffleSqueak was also affected: https://github.com/hpi-swa/trufflesqueak/issues/143 The attached changeset attempts to fix the bug. Changelog: Problem: The variant of Inspector >> #inspectOne, as it is now in the trunk, fails if the key is the value for a field that has been truncated. Because in this place, explicitly only the keys of self fields are passed to #inspectOneOf: which are already truncated. The bug does not affect CollectionInspectors which passes the elementIndices directly to #inspectOneOf: without the need of having fields. Solution: I have now essentially pushed this logic from CollectionInspector with #elementIndices up to Inspector. This should make it run again. Please review and merge if you don't have any further objections. :-) Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: fix-generic-inspectOne-with-truncation.1.cs URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 14 14:50:38 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 14 May 2021 14:50:38 +0000 Subject: [squeak-dev] The Trunk: Installer-Core-mt.440.mcz In-Reply-To: References: <1eeb3119-c645-4efb-83c5-ab7026032487@email.android.com>, Message-ID: <723dd2a31bdc424bb10efab06587c291@student.hpi.uni-potsdam.de> I used the mobile version of github.com, which apparently only displays the first 6 branches (depending on your screen size). And the Android app fails completely to display this particular repository on my phone. Sigh. Sorry for the confusion. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Jakob Reschke Gesendet: Freitag, 14. Mai 2021 11:29:25 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Installer-Core-mt.440.mcz Nope, no Metacello magic here. All the three named branches exist on GitHub, where did you look? https://github.com/hpi-swa/Squot/tree/latest-release Am Fr., 14. Mai 2021 um 11:15 Uhr schrieb Christoph Thiede : > > I can't find this branch in the GitHub repository, is this a special shortcut for Metacello? > > Am 06.05.2021 15:21 schrieb commits at source.squeak.org: > > Marcel Taeumel uploaded a new version of Installer-Core to project The Trunk: > http://source.squeak.org/trunk/Installer-Core-mt.440.mcz > > ==================== Summary ==================== > > Name: Installer-Core-mt.440 > Author: mt > Time: 6 May 2021, 3:21:07.381189 pm > UUID: 4906fd3d-9eff-e841-afc5-0a75e5a9b4b6 > Ancestors: Installer-Core-mt.439 > > Renames default branch for Git tools from "master" to "latest-release". Leave hints to "develop" branch for the brave among us. :-) > > master == latest-release ~~ develop > > =============== Diff against Installer-Core-mt.439 =============== > > Item was changed: > ----- Method: Installer class>>installGitInfrastructure (in category 'scripts') ----- > installGitInfrastructure > | priorSetting | > "for INIFileTest>>#testComplexRead" > priorSetting := Scanner allowUnderscoreAsAssignment. > + [Scanner allowUnderscoreAsAssignment: true. > - Scanner allowUnderscoreAsAssignment: true. > > (Smalltalk at: #Metacello) new > baseline: 'Squot'; > + repository: 'github://hpi-swa/Squot:latest-release/src'; > + "repository: 'github://hpi-swa/Squot:develop/src';" > - repository: 'github://hpi-swa/Squot:master/src'; > load. > > + ] ensure: [Scanner allowUnderscoreAsAssignment: priorSetting] > - Scanner allowUnderscoreAsAssignment: priorSetting > ! > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Fri May 14 14:53:50 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 14 May 2021 14:53:50 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.33.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.33.mcz ==================== Summary ==================== Name: FFI-Tests-mt.33 Author: mt Time: 14 May 2021, 4:53:49.688417 pm UUID: 9752680b-6c05-e345-84b1-56b5f5117194 Ancestors: FFI-Tests-mt.32 Fixes a broken #free in one test which crashed the VM. =============== Diff against FFI-Tests-mt.32 =============== Item was changed: ----- Method: FFIAllocateExternalTests>>test06ArrayOfPointers (in category 'tests - array') ----- test06ArrayOfPointers + "Overwritten because in external memory, we can manage pointer indirections. Be sure to not log the inner allocation because the array's #free will recursively free the memory." - "Overwritten because in external memory, we can manage pointer indirections." | array type string| type := self lookupType: 'char*'. array := self allocate: type size: 5. self assert: 5 * type byteSize equals: array byteSize. + string := array contentType asNonPointerType allocateExternal: 7. - string := self allocate: array contentType asNonPointerType size: 7. string setSize: nil. "Not needed due to null-termination." string at: 1 put: $S. string at: 2 put: $Q. string at: 3 put: $U. string at: 4 put: $E. string at: 5 put: $A. string at: 6 put: $K. string at: 7 put: Character null. "Not needed here because memory was zero from the beginning." self assert: 'SQUEAK' equals: string fromCString. array at: 1 put: string. self assert: 'SQUEAK' equals: array first fromCString.! From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 14 17:38:10 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 14 May 2021 17:38:10 +0000 Subject: [squeak-dev] Why is IllegalResumeAttempt not an Error? Message-ID: <8a1b57eed8ae41909dfe0bc0de6957fc@student.hpi.uni-potsdam.de> Hi all! I was just wondering why IllegalResumeAttempt is not an error. An IllegalResumeAttempt is signaled when you try to #resume from an exception that is not resumable. In my opinion, this should pretty clearly be an Error. Just like "nil + 1", "#() at: 0", or "'hello' at: 1 put: $H", the programmer is trying to perform an illegal operation so the EHS notices this error. Why should "Error new resume" (pseudo, of course) not be an Error? I could imagine that in ancient days, when nested exception handling did not yet work as flawlessly as today (thanks Jaromir and Nicolas for all the work on this field!), the original designers tried to prevent the case in which a second exception was handled on the stack. Nevertheless, this limitation does not exist any longer today. It would not even be a problem (although not a recommended pattern) to say something like: [self error + 1] on: Error do: [:ex1 | [ex1 resume: 42] on: IllegalResumeAttempt do: [:ex2 | "Well, then return instead" ex1 return: 42] ]. So why don't we just go and make IllegalResumeAttempt an Error? Its defaultAction is already completely compatible. Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Fri May 14 19:10:35 2021 From: m at jaromir.net (Jaromir Matas) Date: Fri, 14 May 2021 14:10:35 -0500 (CDT) Subject: [squeak-dev] Why is IllegalResumeAttempt not an Error? In-Reply-To: <8a1b57eed8ae41909dfe0bc0de6957fc@student.hpi.uni-potsdam.de> References: <8a1b57eed8ae41909dfe0bc0de6957fc@student.hpi.uni-potsdam.de> Message-ID: <1621019435384-0.post@n4.nabble.com> Hi Christoph, There's a funny method under IllegalResumeAttempt: #readMe "Never handle this exception!" Author: The Fourth Estate, Inc., 1999 I can't see anything wrong with your example, the logic is clean so I'm very curious what more experienced people have to say :) Christoph Thiede wrote > It would not even be a problem (although not a recommended pattern) to say > something like: > > > [self error + 1] > on: Error > do: [:ex1 | > [ex1 resume: 42] > on: IllegalResumeAttempt > do: [:ex2 | > "Well, then return instead" > ex1 return: 42] ]. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sat May 15 12:56:09 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 12:56:09 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.146.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.146.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.146 Author: mt Time: 15 May 2021, 2:56:07.781282 pm UUID: c2bb685d-0aa5-384b-bd1c-3176fee51f46 Ancestors: FFI-Kernel-mt.145 Found a way to fix the handle for alias-to-pointer types. See #pointerAliasSpec for an explanation. Removes #checkHandle(Undo) because it is no longer needed. Makes #isTypeAlias for atomic types and pointer types independent from the headerWord. This in turn makes #becomeKnownType more robust. Clarify #setType: vs. #setContentType: in external data. Adds #asContentType: and #asType:size: besides #asType:. Removes those other #as* selectors because not needed -- use #first or #value. Adds more comments. =============== Diff against FFI-Kernel-mt.145 =============== Item was changed: ByteArray variableByteSubclass: #ExternalAddress instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' + category: 'FFI-Kernel-Support'! - category: 'FFI-Kernel'! !ExternalAddress commentStamp: '' prior: 0! An ExternalAddress is an opaque handle to objects outside Smalltalk memory (e.g., a pointer).! Item was removed: - ----- Method: ExternalAddress class>>fromByteArray: (in category 'instance creation') ----- - fromByteArray: aByteArray - - self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." - self assert: [aByteArray size = ExternalAddress wordSize]. - ^ aByteArray changeClassTo: self! Item was changed: ----- Method: ExternalData class>>fromHandle:type: (in category 'instance creation') ----- + fromHandle: aHandle type: containerOrContentType + "Answer with given container type or content type and unknown size." + + ^ self basicNew setHandle: aHandle type: containerOrContentType! - fromHandle: aHandle type: containerType - - ^ self basicNew setHandle: aHandle type: containerType! Item was added: + ----- Method: ExternalData>>asContentType: (in category 'converting') ----- + asContentType: contentType + "Keep the size." + + ^ ExternalData fromHandle: handle type: contentType size: self size! Item was removed: - ----- Method: ExternalData>>asExternalData (in category 'converting') ----- - asExternalData - - ^ self! Item was removed: - ----- Method: ExternalData>>asExternalStructure (in category 'converting') ----- - asExternalStructure - - self - assert: [self contentType referentClass includesBehavior: ExternalStructure] - description: 'Wrong type'. - - ^ self contentType referentClass fromHandle: handle! Item was removed: - ----- Method: ExternalData>>asExternalUnion (in category 'converting') ----- - asExternalUnion - - self - assert: [self contentType referentClass includesBehavior: ExternalUnion] - description: 'Wrong type'. - - ^ self contentType referentClass fromHandle: handle! Item was changed: ----- Method: ExternalData>>asType: (in category 'converting') ----- + asType: containerType - asType: anExternalType + ^ ExternalData fromHandle: handle type: containerType! - ^ ExternalData fromHandle: handle type: anExternalType! Item was added: + ----- Method: ExternalData>>asType:size: (in category 'converting') ----- + asType: contentType size: numElements + + ^ ExternalData fromHandle: handle type: contentType size: numElements! Item was removed: - ----- Method: ExternalData>>checkHandle (in category 'compatibility') ----- - checkHandle - "Not needed here."! Item was changed: ----- Method: ExternalData>>containerType (in category 'accessing - types') ----- containerType "^ " "Answer the current container type, which may or may not have a known #size and #byteSize." + self typeCheck. - "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls." - type asNonPointerType isArrayType - ifFalse: [self setType: type]. - ^ type! Item was changed: + ----- Method: ExternalData>>fromCString (in category 'accessing - unsafe') ----- - ----- Method: ExternalData>>fromCString (in category 'converting - support') ----- fromCString "Read a NUL-terminated string" self assert: [self mightBeCString] description: 'Wrong content type'. ^ String streamContents: [:stream | self detect: [:char | char == Character null ifTrue: [true] ifFalse: [ stream nextPut: char. false]] ifFound: [:char | "finished"]]! Item was changed: + ----- Method: ExternalData>>fromCStrings (in category 'accessing - unsafe') ----- - ----- Method: ExternalData>>fromCStrings (in category 'converting - support') ----- fromCStrings "Read a list of double-null terminated strings. https://devblogs.microsoft.com/oldnewthing/20110511-00/?p=10693 http://web.archive.org/web/20100103003417/http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx" self assert: [self mightBeCString] description: 'Wrong content type'. ^ Array streamContents: [:list | String streamContents: [:element | | lastChar | lastChar := nil. self detect: [:char | (lastChar == Character null and: [char == Character null]) ifTrue: [true] ifFalse: [ char == Character null ifTrue: [ list nextPut: element contents. element reset] ifFalse: [ element nextPut: char]. lastChar := char. false]] ifFound: [:char | "finished"]]].! Item was changed: ----- Method: ExternalData>>mightBeCString (in category 'testing') ----- mightBeCString ^ self contentType = ExternalType char and: [self size isNil]! Item was changed: ----- Method: ExternalData>>postCopy (in category 'copying') ----- postCopy "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory." | bytes | handle isExternalAddress ifFalse: [^ self]. self sizeCheck. bytes := ByteArray new: self byteSize. 1 to: bytes size do: [:index | bytes basicAt: index put: (handle unsignedByteAt: index)]. handle := bytes. + self setType: type. "Change container type from pointer to non-pointer type."! - self setType: type.! Item was changed: + ----- Method: ExternalData>>setContentType: (in category 'initialize-release') ----- - ----- Method: ExternalData>>setContentType: (in category 'private') ----- setContentType: externalType self setType: (externalType asArrayType: self size).! Item was changed: + ----- Method: ExternalData>>setSize: (in category 'initialize-release') ----- - ----- Method: ExternalData>>setSize: (in category 'private') ----- setSize: numElements "Set the size for the receiver, which will be used when enumerating its elements." self setType: (self contentType asArrayType: numElements).! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType + "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." - "Private. Set the type used to derive content and container types." externalType isVoid ifTrue: [ ^ self setType: externalType asPointerType]. externalType asNonPointerType isArrayType ifTrue: [type := externalType] ifFalse: [type := (externalType asArrayType: nil)]. handle isExternalAddress ifTrue: [type := type asPointerType] ifFalse: [type := type asNonPointerType].! Item was added: + ----- Method: ExternalData>>typeCheck (in category 'private') ----- + typeCheck + "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls if the signature did not specify, e.g., 'int[]' but 'int*'." + + type asNonPointerType isArrayType + ifFalse: [self setType: type].! Item was changed: ----- Method: ExternalObject>>ffiIdentical: (in category 'comparing') ----- ffiIdentical: other "Define identity for external objects. External objects sharing an external address are considered 'externally identical.' " self == other ifTrue: [^ true]. other isExternalObject ifFalse: [^ false]. self getHandle species = other getHandle species ifFalse: [^ false]. ^ (self getHandle ffiIdentical: other getHandle) or: [ - self checkHandle. other checkHandle. self getHandle isExternalAddress and: [other getHandle isExternalAddress] and: [self getHandle = other getHandle]]! Item was changed: ----- Method: ExternalPointerType>>isTypeAlias (in category 'testing') ----- isTypeAlias + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isPointerType]]! - ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was changed: ----- Method: ExternalPointerType>>readAlias (in category 'external structure') ----- readAlias " ExternalStructure defineAllFields. " + ^ '^ {1} fromHandle: handle{2}' withCRs - ^ 'self checkHandle. "Fix bug in FFI plugin."\ ^ {1} fromHandle: handle{2}' withCRs format: { (referentClass ifNil: [ExternalData]) name. referentClass ifNotNil: [''] ifNil: [ ' type: ', self asNonPointerType "content type" storeString]}! Item was removed: - ----- Method: ExternalStructure>>checkHandle (in category 'compatibility') ----- - checkHandle - - | type | - handle ifNil: [^ self "already free'd"]. - handle isExternalAddress ifTrue: [^ self "already ok"]. - - type := self class externalType. - self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." - - (type isPointerType and: [type isTypeAlias - and: [handle size = ExternalAddress wordSize]]) ifTrue: [ - handle := ExternalAddress fromByteArray: handle].! Item was removed: - ----- Method: ExternalStructure>>checkHandleUndo (in category 'compatibility') ----- - checkHandleUndo - "See #checkHandle. Call this if the FFI call would not work with the ExternalAddress." - - | type | - self flag: #pointerAliasCompatibility. - - handle ifNil: [^ self "already free'd"]. - handle isInternalMemory ifTrue: [^ self "already ok"]. - - type := self class externalType. - (type isPointerType and: [type isTypeAlias - and: [handle size = ExternalAddress wordSize]]) ifTrue: [ - handle := handle changeClassTo: ByteArray].! Item was changed: ----- Method: ExternalStructure>>externalType (in category 'accessing') ----- externalType - self checkHandle. "Fix bug in FFI plugin." ^ handle isExternalAddress ifTrue: [self class externalType asPointerType] ifFalse: [self class externalType asNonPointerType]! Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer - self checkHandle. ^ handle isInternalMemory "Wrap handle into helper to address offsets in the byte array without copy." ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)] "Either alias-to-atomic or already in external memory." ifFalse: [self]! Item was changed: ----- Method: ExternalType class>>pointerAliasSpec (in category 'private') ----- pointerAliasSpec + "Answers a mask to check the #headerWord for a type alias to a pointer type. + + mt 5/15/2021 -- I removed the FFIFlagStructure because the FFI plugin returned byte arrays as pointers instead of an external address, which is really cumbersome to manage in the image. Also this distinction is not needed, which makes me believe it was a simple bug. -- Also note that simply converting thos byte arrays into external addresses in the image would not work for FFI calls, which actually expected those byte arrays. Strange. There might be some extra table managed for those. Still not sure why." + ^ "self structureSpec bitOr:" self pointerSpec! - "Answers a mask to check the #headerWord for a type alias to a pointer type." - ^ self structureSpec bitOr: self pointerSpec! Item was changed: ----- Method: ExternalUnknownType>>becomeKnownType (in category 'construction') ----- becomeKnownType + "Give me some purpose. :-)" - "Give me some purpose. :-) The order of checks matters because some tests only look at the #headerWord. Make the tests that look into referentClass first." + self isTypeAliasForAtomic + ifTrue: [^ self becomeAtomicType]. + self isTypeAliasForPointer + ifTrue: [^ self becomePointerType]. self isTypeAliasForStructure ifTrue: [^ self becomeStructureType]. self isTypeAliasForArray ifTrue: [^ self becomeArrayType]. - self isTypeAliasForAtomic - ifTrue: [^ self becomeAtomicType]. - self isTypeAliasForPointer - ifTrue: [^ self becomePointerType]. - ^ self becomeStructureType! Item was changed: ----- Method: ExternalUnknownType>>isTypeAliasForAtomic (in category 'testing - type alias') ----- isTypeAliasForAtomic + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isAtomic]]! - ^ self headerWord allMask: FFIFlagAtomic! Item was changed: ----- Method: ExternalUnknownType>>isTypeAliasForPointer (in category 'testing - type alias') ----- isTypeAliasForPointer + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isPointerType]]! - ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was changed: Object subclass: #FFIPlatformDescription instanceVariableNames: 'name osVersion subtype wordSize' classVariableNames: 'LastPlatform' poolDictionaries: '' + category: 'FFI-Kernel-Support'! - category: 'FFI-Kernel'! !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0! This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions). 1. DETECT PLATFORM CHANGE ON STARTUP This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType. 2. PLATFORM SPECIFICITY Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are: platform name > osVersion > subtype > wordSize So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize. 3. PLATFORM COMPATIBILITY Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible. Here is an interesting edge case of two compatible platform descriptions: | p1 p2 | p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil. p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8. p1 isCompatibleWith: p2. Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools. 4. FURTHER READING - all references to FFIPlatformDescription - all senders of #wordSize - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject ! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. + ExternalType resetAllTypes.. - ExternalType resetAllTypes. "Re-generate all field accessors because in ExternalData, #size: was replaced with #setSet: and a new constructors for content and container types." ExternalStructure defineAllFields. '! From commits at source.squeak.org Sat May 15 12:57:59 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 12:57:59 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.34.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.34.mcz ==================== Summary ==================== Name: FFI-Tests-mt.34 Author: mt Time: 15 May 2021, 2:57:58.142282 pm UUID: 88a07f6a-4b02-d042-a0e5-e6e3613789a7 Ancestors: FFI-Tests-mt.33 More tests :-) And #test03GlobalVariable actually fails to meet the requirements when allocated externally. =============== Diff against FFI-Tests-mt.33 =============== Item was changed: ----- Method: FFIAllocateExternalTests>>expectedFailures (in category 'failures') ----- expectedFailures + ^ (super expectedFailures + + copyWithoutAll: #( - ^ super expectedFailures copyWithoutAll: #( test04LinkedList "Storing pointers works fine." + )), #( + test03GlobalVariable "Atomic values in an alias container will be fetched immediately. Hmm..." )! Item was added: + ----- Method: FFIAllocateExternalTests>>test03GlobalVariable (in category 'tests') ----- + test03GlobalVariable + "If you happen to have to address to a global variable you can use a type alias." + | global | + global := self allocate: FFITestAliasForInt32. + self assert: global getHandle isExternalAddress. + self assert: global externalType isPointerType. + self assert: 0 equals: global value. + global value: 42. + self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>test03GlobalVariable (in category 'tests') ----- test03GlobalVariable "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." | global | global := self allocate: FFITestAliasForInt32. self assert: 0 equals: global value. global value: 42. self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>test05ArrayFromCString (in category 'tests - array') ----- test05ArrayFromCString | data | ExternalData allowDetectForUnknownSizeDuring: [ data := self allocate: ExternalType char size: 4. + data setContentType: ExternalType byte. + data setSize: nil. - data setType: ExternalType byte. self assert: data size isNil. #[65 66 67 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setContentType: ExternalType char. - data setType: ExternalType char. self assert: 'ABC' equals: data fromCString. data := self allocate: ExternalType char size: 9. data setType: ExternalType byte. self assert: data size isNil. #[65 66 67 0 68 69 70 0 0] withIndexDo: [:byte :index | data at: index put: byte]. data setType: ExternalType char. self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was added: + ----- Method: FFIAllocateTests>>test07ArraySetSize (in category 'tests - array') ----- + test07ArraySetSize + + | data | + data := self allocate: ExternalType byte size: 10. + + data setSize: 2. "limit access" + self assert: ExternalType byte identical: data contentType. + self assert: 2 equals: data size. + self shouldnt: [data at: 2] raise: Error. + self should: [data at: 3] raise: Error. + + data setSize: 5. "move limit" + self assert: ExternalType byte identical: data contentType. + self assert: 5 equals: data size. + self shouldnt: [data at: 5] raise: Error. + self should: [data at: 6] raise: Error. + + data setSize: nil. "ignore size" + self assert: ExternalType byte identical: data contentType. + self shouldnt: [data at: 3] raise: Error. + self shouldnt: [data at: 6] raise: Error. + self shouldnt: [data at: 10] raise: Error.! Item was added: + ----- Method: FFIAllocateTests>>test08ArraySetContentType (in category 'tests - array') ----- + test08ArraySetContentType + + | data | + data := self allocate: ExternalType byte size: 1. + data at: 1 put: 65. + + self assert: 65 equals: data first. + data setContentType: ExternalType char. + self assert: $A equals: data first.! Item was added: + ----- Method: FFIPluginTests>>testReturnPointerAlias (in category 'tests - type alias') ----- + testReturnPointerAlias + "Check the handle of a returned alias-to-pointer type. Should be an external address." + + | pt1 pt2 pt3 | + pt1 := FFITestPoint4 new. + pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. + pt2 := FFITestPoint4 new. + pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := heapObject := FFITestLibrary ffiTestAliasForPointerResult: pt1 with: pt2. + + self assert: pt3 getHandle isExternalAddress. + self assert: pt3 externalType isPointerType. + + self assert: pt3 x = 6. + self assert: pt3 y = 8. + self assert: pt3 z = 10. + self assert: pt3 w = 12.! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForPoint4Pointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForPoint4Pointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + + ^ 'FFITestPoint4*'! Item was added: + ----- Method: FFITestLibrary class>>ffiTestAliasForPointerResult:with: (in category 'experiments') ----- + ffiTestAliasForPointerResult: pt1 with: pt2 + "Allocates the result. Needs to be free'd after calling." + + ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWith:with: (in category 'experiments') ----- - ----- Method: FFITestLibrary class>>ffiTestArrayResultWith:with: (in category 'mocks') ----- ffiTestArrayResultWith: pt1 with: pt2 "Allocates the result. Needs to be free'd after calling." ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWithString: (in category 'experiments') ----- - ----- Method: FFITestLibrary class>>ffiTestArrayResultWithString: (in category 'mocks') ----- ffiTestArrayResultWithString: aString " FFITestLibrary ffiTestArrayResultWithString: 'Hello Squeak'. " ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestArrayType (in category 'experiments') ----- - ----- Method: FFITestLibrary class>>ffiTestArrayType (in category 'mocks') ----- ffiTestArrayType "Just a mock. Not sure whether there will ever be call signatures using array types ... isn't this pass-by-pointer anyway?" ^ self externalCallFailed ! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestVoid (in category 'experiments') ----- - ----- Method: FFITestLibrary class>>ffiTestVoid (in category 'mocks') ----- ffiTestVoid "Note that ffiTestVoid does exist in the module." ^self externalCallFailed! Item was changed: + ----- Method: FFITestLibrary class>>ffiTestVoidPointer (in category 'experiments') ----- - ----- Method: FFITestLibrary class>>ffiTestVoidPointer (in category 'mocks') ----- ffiTestVoidPointer "Note that ffiTestVoidPointer does exist in the module." ^self externalCallFailed! From Christoph.Thiede at student.hpi.uni-potsdam.de Sat May 15 13:01:22 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sat, 15 May 2021 13:01:22 +0000 Subject: [squeak-dev] [ENH] isSeparator In-Reply-To: References: <, > , Message-ID: Hi Marcel, hi Levente. > Well, you ignored my question "What is a separator?". Sorry for that. Well, I don't completely agree with your definition, I would rather follow the semantics of Unicode. The Unicode character category "separators" includes line separators (Zl), paragraph separators (Zp), and space separators (Zs) and nbsp is like Character space part of the space separators group. In other contexts like the web, afaik they are used very interchangeably anyway, so I hardly can imagine any scenario where something like #trimWhatespace should ignore these characters. (By the way, zero-width space is not a space character at all according to Unicode but rather a formatting character (Cf).) > Instead of modifying CharacterSet etc., one could maybe extend TextConverter to support encoding-aware identification of separators etc and also provide encoding-aware #trim. I see your arguments for maintaining backward compatibility, but this proposal scares me a bit. I would really like String to see Unicode-aware by default (like perhaps every other modern programming language) instead of providing a separate interface that "a few exotic clients that care about other encodings" can use. :-) I originally stumbled upon this when I was using the HtmlReadWriter to parse a piece of HTML that contained a nbsp in its CSS. That is perfectly valid HTML/CSS, but #mapContainerTag: failed on it because #withBlanksTrimmed did not stripe away this nbsp. Yes, of course you could ask TextConverter or Unicode or whatever else in that place, but this feels like the wrong approach to me. Unicode awareness should be opt-in nowadays, not opt-out. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Mittwoch, 12. Mai 2021 07:37:17 An: squeak-dev Betreff: Re: [squeak-dev] [ENH] isSeparator This reminds me of our #asNumber (or number parser) discussion where we agreed to not parse number-like appearances in Unicode to Integer. :-) Instead of modifying CharacterSet etc., one could maybe extend TextConverter to support encoding-aware identification of separators etc and also provide encoding-aware #trim. Best, Marcel Am 08.05.2021 04:12:21 schrieb Levente Uzonyi : On Fri, 7 May 2021, Thiede, Christoph wrote: > > Hi Levente, > > > thanks for the pointer. As far I can see from the linked discussion, Tobias' proposal has never been rejected but only postponed due to the upcoming release. I also see your point of performance, but IMHO correctness is more > important than performance. If necessary, we could still hard-code the relevant code points into #isSeparator. > > > > - consistency: CharacterSet separators would differ from the rest with your change set. > > > Fair point, but I think we should instead fix the definitions of Character(Set) constants to respect the encoding as well ... By the way, Character alphabet and Character allCharacters also don't do this at the moment. > > Of course, all your concerns are valid points and need to be discussed, but I would be sorry if we failed to - finally - establish current standards in our Character library. I doubt that any modern parser for JSON or > whatever would treat Unicode space characters incorrectly, and still, they are satisfyingly fast. I think we should be able to keep pace with them in Squeak as well. :-) Well, you ignored my question "What is a separator?". IMO a separator is a whitespace that separates tokens in the source code. Would you like to use zero-width space as a separator? Not likely. #isSeparator is deeply buried into the system. Changing it would mean changing other code your changeset doesn't touch, e.g. the parsers. The method you propose is welcome, but IMO it shouldn't be called #isSeparator. #isWhitespace is a much better fit. Levente > > Best, > Christoph > > _________________________________________________________________________________________________________________________________________________________________________________________________________________________________ > Von: Squeak-dev im Auftrag von Levente Uzonyi > Gesendet: Freitag, 7. Mai 2021 22:01:18 > An: The general-purpose Squeak developers list > Betreff: Re: [squeak-dev] [ENH] isSeparator > Hi Christoph, > > There was a discussion on this subject before: > http://forum.world.st/The-Trunk-Collections-topa-806-mcz-td5084658.html > Main concerns are > - definition: What is a separator? > - consistency: CharacterSet separators would differ from the rest with > your change set. > - performance: I haven't measured it, but I wouldn't be surprised if > #isSeparator would become a magnitude slower with that implementation. > > > Levente > > On Thu, 6 May 2021, christoph.thiede at student.hpi.uni-potsdam.de wrote: > > > Hi all, > > > > here is one tiny changeset for you: isSeparator.cs adds proper encoding-aware support for testing of separator chars. As opposed to the former implementation, non-ASCII characters such as the no-break space (U+00A0) will be > identified correctly now, too. > > > > Please review and merge! :-) > > > > Best, > > Christoph > > > > ["isSeparator.cs.gz"] > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Sat May 15 13:24:51 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 13:24:51 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.147.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.147.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.147 Author: mt Time: 15 May 2021, 3:24:49.792642 pm UUID: 8ece59e5-a84c-8046-9d5e-4c26b0332926 Ancestors: FFI-Kernel-mt.146 Fixes automatic conversion of atomic pointer types to array types. Adds special treatment for 'ExternalType string' to make this work: data setType: ExternalType string) fromCString. data setContentType: ExternalType string) fromCString. ...the latter being the recommended form. Note that string lists are still possible: data setType: (ExternalType string asArrayType: nil). ExternalData fromHandle: h type: (ExternalType string asArrayType: nil). ...the latter being the generated form for struct fields (i.e. 'string[5]'). =============== Diff against FFI-Kernel-mt.146 =============== Item was changed: ----- Method: ExternalData>>setContentType: (in category 'initialize-release') ----- setContentType: externalType + externalType = ExternalType string ifTrue: [ + ^ self setContentType: externalType asNonPointerType]. + self setType: (externalType asArrayType: self size).! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." externalType isVoid ifTrue: [ ^ self setType: externalType asPointerType]. + externalType = ExternalType string ifTrue: [ + ^ self setType: externalType asNonPointerType]. externalType asNonPointerType isArrayType ifTrue: [type := externalType] ifFalse: [type := (externalType asArrayType: nil)]. handle isExternalAddress ifTrue: [type := type asPointerType] ifFalse: [type := type asNonPointerType].! Item was changed: ----- Method: ExternalData>>typeCheck (in category 'private') ----- typeCheck "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls if the signature did not specify, e.g., 'int[]' but 'int*'." type asNonPointerType isArrayType + ifFalse: [self setType: type "int*" asNonPointerType "int ... to become int[], not int*[]"].! - ifFalse: [self setType: type].! From commits at source.squeak.org Sat May 15 13:56:29 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 13:56:29 0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1405.mcz ==================== Summary ==================== Name: Kernel-ct.1405 Author: ct Time: 15 May 2021, 3:56:24.713389 pm UUID: 9a92be9b-d778-b54f-b659-713451a2ddb2 Ancestors: Kernel-nice.1402 Counterproposal to Kernel-jar.1404 for fixing VM crashes when resuming from a BlockCannotReturn. Instead of enforcing retrial, repair the context stack if the receiver has ended. There are two reasons for that: 1. Not in all situations, the receiver of #cannotReturn: is actually unable to resume. Consider this example for a disproof: a := [true ifTrue: [^ 1]. 2]. "Both statements need to be executed separately in a Workspace so that [a outerContext sender] becomes nil!" a value. In this situation, it is valid to resume from BlockCannotReturn and currently also possible in the Trunk. Note that BlockCannotReturn even overrides #isResumable to answer true, though the class comment discrecommends resuming it. 2. The pattern proposed by Jaromir reminds me of the current implementation of Object >> #doesNotUnderstand: or Object >> #at:, that is, when the error was resumed, just try it again in the manner of a (potentially) infinite recursion. While the issue with infinite debuggers (which was eventually tripped by exactly this pattern) has been solved some time ago [1], I do not really agree with the pattern in general - it makes it unnecessarily hard for ToolSet implementors to consciously resume from an error instead of retrying it (which we have an extra selector on Exception for). [1] http://forum.world.st/Please-try-out-Fixes-for-debugger-invocation-during-code-simulation-td5127684.html =============== Diff against Kernel-nice.1402 =============== Item was added: + ----- Method: BlockCannotReturn>>defaultResumeValue (in category 'defaults') ----- + defaultResumeValue + + ^ self result! Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [ + | resumptionValue | + resumptionValue := self cannotReturn: result to: self home sender. + self pc > self endPC ifTrue: [ + "This block has ended, continue with sender" + thisContext privSender: self sender]. + ^ resumptionValue]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! From christoph.thiede at student.hpi.uni-potsdam.de Sat May 15 13:58:04 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 15 May 2021 08:58:04 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-jar.1404.mcz In-Reply-To: References: Message-ID: <1621087084060-0.post@n4.nabble.com> Hi Jaromir! > Example previously crashing the VM: > > [^2] fork Nice catch! :-) Please see Kernel-ct.1405 for a counterproposal and explanation. Despite the attached wall of text, I'm not actually sure about the semantics of impossible returns, so I'm looking forward to your feedback. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Sat May 15 14:06:01 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 15 May 2021 09:06:01 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: References: Message-ID: <1621087561864-0.post@n4.nabble.com> The #defaultResumeValue was actually a commit slip and should not have been included in this version. Nevertheless, this raises another question - what would you expect from this example to return? a := [true ifTrue: [^ 1] yourself]. "Both statements need to be executed separately in a Workspace so that [a outerContext sender] becomes nil!" [a value] on: BlockCannotReturn do: [:ex | ex resume]. Should it be 1 or nil? In the Trunk, is it nil, if we override #defaultResumeValue as below, it will be 1. (Note that I appended #yourself to the block to prevent inlined compilation - when inlined, the snippet always returns nil because the optimization does not assume that the methodReturn could be skipped ...) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sat May 15 14:54:58 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 14:54:58 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1407.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1407.mcz ==================== Summary ==================== Name: Kernel-jar.1407 Author: jar Time: 15 May 2021, 4:54:53.093378 pm UUID: 19fec7a8-7276-6045-912e-4d546f26829f Ancestors: Kernel-nice.1402 full implementation of repeated #signal sends to an existing exception consistent with ANSI; according to ANSI re-signalling an existing exception should differ from sending #outer in that the search for its handler starts from the current context rather than from the exception's handler context =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Exception>>resumeEvaluating: (in category 'handling') ----- resumeEvaluating: aBlock "Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer. The block is only evaluated after unwinding the stack." | ctxt | outerContext ifNil: [ + ctxt := signalContext. + signalContext := ctxt tempAt: 1. "prevSignalContext in #signal" + handlerContext := ctxt tempAt: 2. "currHandlerContext in #signal" + ctxt returnEvaluating: aBlock - signalContext returnEvaluating: aBlock ] ifNotNil: [ ctxt := outerContext. outerContext := ctxt tempAt: 1. "prevOuterContext in #outer" handlerContext := ctxt tempAt: 2. "currHandlerContext in #outer" ctxt returnEvaluating: aBlock ]. ! Item was changed: ----- Method: Exception>>signal (in category 'signaling') ----- signal "Ask ContextHandlers in the sender chain to handle this signal. The default is to execute and return my defaultAction." + | prevSignalContext currHandlerContext | + signalContext ifNotNil: [ "re-signalling an already signalled exception is similar to #outer but + unlike #outer it starts searching for its handler from thisContext instead of handlerContext." + currHandlerContext := handlerContext. + prevSignalContext := signalContext]. - signalContext ifNotNil: [^self outer]. "re-signalling an already signalled exception is equivalent to sending #outer" signalContext := thisContext contextTag. ^(thisContext nextHandlerContextForSignal: self) handleSignal: self! From commits at source.squeak.org Sat May 15 15:01:17 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 15:01:17 0000 Subject: [squeak-dev] The Inbox: Tests-jar.464.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.464.mcz ==================== Summary ==================== Name: Tests-jar.464 Author: jar Time: 15 May 2021, 5:01:13.98097 pm UUID: aa197ba6-106c-1a42-84d4-31d65052037f Ancestors: Tests-jar.463 complement Kernel-jar.1407 - implement re-signallig an already existing exception =============== Diff against Tests-jar.463 =============== Item was added: + ----- Method: ExceptionTester>>simpleOuterResumeReturnTest (in category 'signaledException tests') ----- + simpleOuterResumeReturnTest + + [[self doSomething. + MyTestNotification signal. + self doSomethingExceptional] + on: MyTestNotification + do: [:ex | ex outer. self doYetAnotherThing. ex return]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleOuterResumeReturnTestResults (in category 'signaledException results') ----- + simpleOuterResumeReturnTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was changed: ----- Method: ExceptionTester>>simpleResignalDoubleResumeTest (in category 'signaledException tests') ----- simpleResignalDoubleResumeTest - "uses #resume" [[self doSomething. MyTestNotification signal. + self doSomethingElse] - "self doSomethingElse"] on: MyTestNotification do: [:ex | ex signal. self doYetAnotherThing. ex resume]. self doSomethingElse] on: MyTestNotification do: [:ex | ex resume]! Item was changed: ----- Method: ExceptionTester>>simpleResignalDoubleResumeTestResults (in category 'signaledException results') ----- simpleResignalDoubleResumeTestResults ^OrderedCollection new add: self doSomethingString; add: self doYetAnotherThingString; add: self doSomethingElseString; + add: self doSomethingElseString; yourself! Item was added: + ----- Method: ExceptionTester>>simpleResignalResumeReturnTest (in category 'signaledException tests') ----- + simpleResignalResumeReturnTest + + [[self doSomething. + MyTestNotification signal. + self doSomethingExceptional] + on: MyTestNotification + do: [:ex | ex outer. self doYetAnotherThing. ex return]. + self doSomethingElse] + on: MyTestNotification + do: [:ex | ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleResignalResumeReturnTestResults (in category 'signaledException results') ----- + simpleResignalResumeReturnTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleResignalVsOuter1Test (in category 'signaledException tests') ----- + simpleResignalVsOuter1Test + + [self doSomething. + MyTestNotification signal. + self doSomethingExceptional] + on: MyTestNotification + do: [:ex1 | + [ex1 signal. self doSomethingExceptional] "re-signal started searching for its handler here" + on: MyTestNotification "re-signal found and used this handler" + do: [:ex2 | self doYetAnotherThing]. + self doSomethingElse]! Item was added: + ----- Method: ExceptionTester>>simpleResignalVsOuter1TestResults (in category 'signaledException results') ----- + simpleResignalVsOuter1TestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleResignalVsOuter2Test (in category 'signaledException tests') ----- + simpleResignalVsOuter2Test + + [self doSomething. + MyTestNotification signal. + self doSomethingExceptional] + on: MyTestNotification + do: [:ex1 | + [ex1 outer. self doYetAnotherThing] "#outer reached its default handler and resumed" + on: MyTestNotification "this handler is out of #outer's search scope" + do: [:ex2 | self doSomethingExceptional]. + self doSomethingElse]! Item was added: + ----- Method: ExceptionTester>>simpleResignalVsOuter2TestResults (in category 'signaledException results') ----- + simpleResignalVsOuter2TestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testSimpleOuterResumeReturn (in category 'tests - ExceptionTester') ----- + testSimpleOuterResumeReturn + self assertSuccess: (ExceptionTester new runTest: #simpleOuterResumeReturnTest ) ! Item was changed: ----- Method: ExceptionTests>>testSimpleResignalDoubleResume (in category 'tests - ExceptionTester') ----- testSimpleResignalDoubleResume self assertSuccess: (ExceptionTester new runTest: #simpleResignalDoubleResumeTest ) ! Item was added: + ----- Method: ExceptionTests>>testSimpleResignalResumeReturn (in category 'tests - ExceptionTester') ----- + testSimpleResignalResumeReturn + self assertSuccess: (ExceptionTester new runTest: #simpleResignalResumeReturnTest ) ! Item was added: + ----- Method: ExceptionTests>>testSimpleResignalVsOuter1 (in category 'tests - ExceptionTester') ----- + testSimpleResignalVsOuter1 + self assertSuccess: (ExceptionTester new runTest: #simpleResignalVsOuter1Test) ! Item was added: + ----- Method: ExceptionTests>>testSimpleResignalVsOuter2 (in category 'tests - ExceptionTester') ----- + testSimpleResignalVsOuter2 + self assertSuccess: (ExceptionTester new runTest: #simpleResignalVsOuter2Test) ! From commits at source.squeak.org Sat May 15 15:12:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 15:12:46 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.148.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.148.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.148 Author: mt Time: 15 May 2021, 5:12:44.817141 pm UUID: bb40c1ac-0172-1f4a-b0d8-fe7f8ef24e0e Ancestors: FFI-Kernel-mt.147 Adds support method to write CStrings into external data. =============== Diff against FFI-Kernel-mt.147 =============== Item was added: + ----- Method: ExternalData>>toCString: (in category 'accessing - unsafe') ----- + toCString: aString + "Write a NUL-terminated string" + + self + assert: [self contentType = ExternalType char] + description: 'Wrong content type'. + + self + assert: [self size = (aString size + 1)] + description: 'Wrong size'. + + aString withIndexDo: [:char :index | + self at: index put: char]. + self at: aString size + 1 put: Character null. + + self setSize: nil. "See #mightBeCString."! From commits at source.squeak.org Sat May 15 15:13:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 15:13:39 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.35.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.35.mcz ==================== Summary ==================== Name: FFI-Tests-mt.35 Author: mt Time: 15 May 2021, 5:13:37.884141 pm UUID: da76b19f-4787-5641-92cb-4a80f44054b8 Ancestors: FFI-Tests-mt.34 Complements FFI-Kernel-mt.148 =============== Diff against FFI-Tests-mt.34 =============== Item was removed: - ----- Method: FFIAllocateTests>>test05ArrayFromCString (in category 'tests - array') ----- - test05ArrayFromCString - - | data | - - ExternalData allowDetectForUnknownSizeDuring: [ - data := self allocate: ExternalType char size: 4. - data setContentType: ExternalType byte. - data setSize: nil. - self assert: data size isNil. - - #[65 66 67 0] withIndexDo: [:byte :index | data at: index put: byte]. - data setContentType: ExternalType char. - self assert: 'ABC' equals: data fromCString. - - data := self allocate: ExternalType char size: 9. - data setType: ExternalType byte. - self assert: data size isNil. - - #[65 66 67 0 68 69 70 0 0] withIndexDo: [:byte :index | data at: index put: byte]. - data setType: ExternalType char. - self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was added: + ----- Method: FFIAllocateTests>>test05ArrayReadWriteCString (in category 'tests - array') ----- + test05ArrayReadWriteCString + + | array string | + string := 'Hello Squeak!!'. + self assert: string isByteString. + + ExternalData allowDetectForUnknownSizeDuring: [ + array := self allocate: ExternalType byte size: 0. + self should: [array toCString: string] raise: Error. "Wrong type" + array := self allocate: ExternalType char size: string size. + self should: [array toCString: string] raise: Error. "Wrong size" + + array := self allocate: ExternalType char size: string size + 1. + array toCString: string. + self assert: array size isNil. "It's NUL-terminated now." + self assert: string equals: array fromCString. + + array := self allocate: ExternalType string size: string size + 1. + self should: [array toCString: string] raise: Error. "Use 'char' for allocation."].! Item was added: + ----- Method: FFIAllocateTests>>test09ArrayReadCStringList (in category 'tests - array') ----- + test09ArrayReadCStringList + + | data | + ExternalData allowDetectForUnknownSizeDuring: [ + data := self allocate: ExternalType char size: 9. + data setType: ExternalType byte. + self assert: data size isNil. + + #[65 66 67 0 68 69 70 0 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setType: ExternalType char. + self assert:#('ABC' 'DEF') equals: data fromCStrings].! From lewis at mail.msen.com Sat May 15 15:17:08 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Sat, 15 May 2021 11:17:08 -0400 Subject: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) In-Reply-To: References: Message-ID: <20210515151708.GA42867@shell.msen.com> Hi Marcel, Attached are changes that should make the virtual key mapping work when the image is restarted on a different platform. Dave On Wed, Apr 28, 2021 at 12:02:44PM +0200, Marcel Taeumel wrote: > Hi all! > > Here is a small update. Please find attached the changeset. > > Updates: > - Adds KeyboardEvent >> #keyCode (via new inst-var) > - Logs the last key-down event to attach virtual-key codes to key-stroke events; see HandMorph >> #generateKeyboardEvent: > - Simplifies KeyboardEvent >> #key > - Show event repetition in KeyboardExecizer > > > > Major questions: > 1. Does it work on your machine? > 2. What are your thoughts on KeyboardEvent >> #key? > 3. What are your thoughts on KeyboardEvent >> #keyCode? > 4. Do you understand KeyboardEvent >> #physicalKey #virtualKey #physicalModifiers #virtualModifiers ? > > Happy testing! > > Best, > Marcel > > P.S.: Don't forget about the X11 key (scan?) codes. ^__^ I haven't had the time to look into the VM plugin yet. > Am 27.04.2021 16:40:56 schrieb Marcel Taeumel : > Hi all! > > > Please find attached a changeset that adds mapping tables for virtual keys (or scan codes) for macOS, X11, and Windows. You can find them in EventSensor class >> #virtualKeysOn* > > You can try out if they work through the KeyboardExerciser. Please take a look at the balloon text (i.e. tool tip) to better understand the data. > > There is also a new preference: > [x] Simplify Virtual-key codes > > ... because of Windows who dares to couple codes to the input language (e.g. US vs. DE), which Squeak knows nothing about. macOS is better in this regard. :-) > > Biggest mess is on Linux/X11. For key-down/up events, the Linux VM delivers actual character codes instead of scan codes, which makes a basic mapping to physical keys almost impossible. See EventSensor class >> #virtualKeysOnX11. We MUST fix that! Please. Somebody. Can I haz scan codes? ^__^ > > *** > > > *** > > The good news: KeyboardEvent >> #key (and UserInputEvent >> #modifiers) now gives you cross-platform stable information about physical keys to be used in keyboard handlers. Yes, for both key-stroke and key-down/up events. > > Or at least, that is the plan. That's why it would be great if you could help testing! :-) > > Why key-stroke events too? Aren't they for typing text only? > > 1. Almost all keyboard shortcuts in current Squeak are based on key-stroke events. > 2. Using the #keyCharacter is tricky because SHIFT changes lower-case to upper-case, which makes "anEvent shiftPressed" hard to understand. > 3. CTRL combinations might not do the expected thing. How would you handle CTRL+C? The #keyCharacter could arrive as $c or Character enter. See the preference "Map non-printable characters to printable characters. Now, #key will always answer $C in such a case. Regardless of that preference. > > Can't we just use #keyCharacter in key-down/up events? > > No. Those are undefined. Never do that. key-down/up events carry virtual-key codes in their #keyValue. We might want to change #keyCharacter to answer "nil" for those events. > > *** > > Q: What is a "physical key" or "physical modifier"? > A: The label that can be presented to the user so that he or she feels at home when using Squeak. Thus, looks platform-specific. > > Q: What is a "virtual key" or "virtual modifier"? > A: The information to be processed in your application's key handlers. Thus, looks platform-independent. If you have still no clue how to talk to keyboard events, please read the commentary in KeyboardEvent >> #checkCommandKey. > > *** > > Happy testing! :-) And thank you all in advance! > > Best, > Marcel > > P.S.: You might want to disable the preference "synthesize mouse-wheel events from keyboard-events" to get CTRL+ArrowUp and CTRL+ArrowDown ;-) > -------------- next part -------------- 'From Squeak6.0alpha of 12 May 2021 [latest update: #20523] on 14 May 2021 at 11:24:34 pm'! "Change Set: EventSensor-dtl Date: 14 May 2021 Author: David T. Lewis Some tweaks to Marcel's key mapping. Simplify a case statement and arrange for initialization at image startup on a possibly different platform"! !EventSensor class methodsFor: 'class initialization' stamp: 'dtl 5/14/2021 23:01'! installVirtualKeyTable VirtualKeyTable := Dictionary newFrom: ( Smalltalk windowSystemName caseOf: { ['Windows'] -> [self virtualKeysOnWindows]. ['Win32' "older VMs"] -> [self virtualKeysOnWindows]. ['Aqua'] -> [self virtualKeysOnMacOS]. ['X11'] -> [self virtualKeysOnX11]. ['RiscOS'] -> [{}]. ['Quartz'] -> [{}]. } otherwise: [{}]). "Shift 8 bits to not overwrite virtual-key mappings from above." self mapControlKeysToCommandKeys ifTrue: [ VirtualKeyTable at: (2r0010 "ctrl" bitShift: 8) put: (2r1010 "cmd+ctrl"). VirtualKeyTable at: (2r0011 "ctrl+shift" bitShift: 8) put: (2r1011 "cmd+ctrl+shift")]. self mapAltKeysToOptionKeys ifTrue: [ VirtualKeyTable at: (2r1000 "cmd/alt" bitShift: 8) put: (2r1100 "cmd/alt+opt"). VirtualKeyTable at: (2r1001 "cmd/alt+shift" bitShift: 8) put: (2r1101 "cmd/alt+opt+shift")].! ! !EventSensor class methodsFor: 'system startup' stamp: 'dtl 5/14/2021 23:07'! startUp: resuming resuming ifTrue: [ Smalltalk platformName = 'Mac OS' ifTrue: [ self mapAltKeysToOptionKeys: false. self mapControlKeysToCommandKeys: false] ifFalse: [ self mapAltKeysToOptionKeys: true. self mapControlKeysToCommandKeys: true]. self installVirtualKeyTable. self default startUp ].! ! EventSensor class removeSelector: #startUp! From commits at source.squeak.org Sat May 15 17:04:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 17:04:07 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.149.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.149.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.149 Author: mt Time: 15 May 2021, 7:04:06.411008 pm UUID: 53902204-8aa9-cd42-b172-a5773374c06c Ancestors: FFI-Kernel-mt.148 Adds mechanism to allocate using array classes (i.e. RawBitsArray's or ByteString) for array-of-atomics types. Can be disabled as preferenced, enabled by default. Does not affect #allocateExternal:. (Do not treat 'char' and 'schar' as integer types anymore because in Squeak those are Character, not Integer.) (Forces #minVal and #maxVal to use ByteArray.) =============== Diff against FFI-Kernel-mt.148 =============== Item was added: + ----- Method: ByteArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType uint8_t asArrayType: nil! Item was removed: - ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-pointers') ----- - isNull - "Answer false since only pointers (i.e. external addresses) can be null." - - ^ false! Item was added: + ----- Method: ByteString class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType char asArrayType: nil! Item was added: + ----- Method: ByteString>>contentType (in category '*FFI-Kernel') ----- + contentType + + ^ self externalType contentType! Item was added: + ----- Method: ByteString>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ self class externalType contentType asArrayType: self size! Item was added: + ----- Method: ByteString>>free (in category '*FFI-Kernel') ----- + free + + self shouldNotImplement.! Item was added: + ----- Method: ByteString>>from:to: (in category '*FFI-Kernel') ----- + from: firstIndex to: lastIndex + "See ExternalData" + + ^ self copyFrom: firstIndex to: lastIndex! Item was added: + ----- Method: ByteString>>getHandle (in category '*FFI-Kernel') ----- + getHandle + "I am my own handle." + + ^ self! Item was added: + ----- Method: ByteString>>isArray (in category '*FFI-Kernel') ----- + isArray + "Maybe move to Trunk?" + + ^ true! Item was added: + ----- Method: ByteString>>isNull (in category '*FFI-Kernel') ----- + isNull + + ^ false! Item was added: + ----- Method: ByteString>>reader (in category '*FFI-Kernel') ----- + reader + + ^ self! Item was added: + ----- Method: ByteString>>setContentType: (in category '*FFI-Kernel') ----- + setContentType: type + "See ExternalData." + + self shouldNotImplement.! Item was added: + ----- Method: ByteString>>setSize: (in category '*FFI-Kernel') ----- + setSize: size + "See ExternalData." + + self shouldNotImplement.! Item was added: + ----- Method: ByteString>>writer (in category '*FFI-Kernel') ----- + writer + + ^ self! Item was added: + ----- Method: ByteString>>zeroMemory (in category '*FFI-Kernel') ----- + zeroMemory + + 1 to: self size do: [:index | + self at: index put: Character null].! Item was added: + ----- Method: DoubleByteArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType uint16_t asArrayType: nil! Item was added: + ----- Method: DoubleWordArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType uint64_t asArrayType: nil! Item was added: + ----- Method: ExternalData>>copy (in category 'copying') ----- + copy + "Overwritten to obey #useArrayClasses preference." + + self sizeCheck. + ExternalType useArrayClasses ifTrue: [ + (self contentType allocateArrayClass: self size) + ifNotNil: [:array | + self withIndexDo: [:each :index | + array at: index put: each]. + ^ array]]. + + ^ super copy! Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' + classVariableNames: 'ArrayClasses ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses' - classVariableNames: 'ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects. Instance variables: compiledSpec Compiled specification of the external type referentClass Class type of argument required referencedType Associated (non)pointer type with the receiver byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed. Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following: FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits. FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly. [Note: Other combinations may be allowed in the future] ! Item was added: + ----- Method: ExternalType class>>extraTypeChecksDuring: (in category 'preferences') ----- + extraTypeChecksDuring: aBlock + + | priorValue | + priorValue := ExtraTypeChecks. + ExtraTypeChecks := true. + aBlock ensure: [ExtraTypeChecks := priorValue].! Item was changed: ----- Method: ExternalType class>>initialize (in category 'class initialization') ----- initialize + " + ExternalType initialize + " - "ExternalType initialize" self initializeFFIConstants. + self initializeDefaultTypes. + self initializeArrayClasses.! - self initializeDefaultTypes.! Item was added: + ----- Method: ExternalType class>>initializeArrayClasses (in category 'class initialization') ----- + initializeArrayClasses + " + ExternalType initializeArrayClasses. + " + ArrayClasses ifNil: [ + ArrayClasses := IdentityDictionary new]. + + RawBitsArray allSubclasses collect: [:arrayClass | + [ArrayClasses at: arrayClass externalType contentType ifAbsentPut: arrayClass] + on: SubclassResponsibility do: [ "Ignore." ]]. + + ArrayClasses at: ExternalType unsignedChar put: ByteString. + ArrayClasses at: ExternalType signedChar put: ByteString. ! Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes." AtomicTypes := nil. StructTypes := nil. ArrayTypes := nil. + ArrayClasses := nil. self initializeDefaultTypes. self resetAllStructureTypes.! Item was added: + ----- Method: ExternalType class>>useArrayClasses (in category 'preferences') ----- + useArrayClasses + + ^UseArrayClasses ifNil:[true]! Item was added: + ----- Method: ExternalType class>>useArrayClasses: (in category 'preferences') ----- + useArrayClasses: aBoolean + + UseArrayClasses := aBoolean.! Item was added: + ----- Method: ExternalType class>>useArrayClassesDuring: (in category 'preferences') ----- + useArrayClassesDuring: aBlock + + | priorValue | + priorValue := UseArrayClasses. + UseArrayClasses := true. + aBlock ensure: [UseArrayClasses := priorValue].! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- allocate: numElements + "Allocate space for containing an array of numElements of this dataType. Use a proper array class if present." - "Allocate space for containing an array of numElements of this dataType" | handle | + self class useArrayClasses ifTrue: [ + (self allocateArrayClass: numElements) + ifNotNil: [:array | ^ array]]. handle := ByteArray new: self byteSize * numElements. ^ExternalData fromHandle: handle type: self size: numElements! Item was added: + ----- Method: ExternalType>>allocateArrayClass: (in category 'external data') ----- + allocateArrayClass: numElements + "Allocate space for containing an array of numElements of this dataType. Try to use an array class. Answer 'nil' if there is no such class for the receiver." + + ^ ArrayClasses + at: self + ifPresent: [:arrayClass | arrayClass new: numElements] + ifAbsent: [nil] + ! Item was added: + ----- Method: ExternalType>>isCharType (in category 'testing - special') ----- + isCharType + + | type | + type := self atomicType. + ^ type = FFITypeUnsignedChar or: [type = FFITypeSignedChar]! Item was changed: ----- Method: ExternalType>>isIntegerType (in category 'testing - integer') ----- isIntegerType "Return true if the receiver is a built-in integer type" | type | type := self atomicType. + ^type > FFITypeBool and:[type <= FFITypeSignedLongLong]! - ^type > FFITypeBool and:[type <= FFITypeSignedChar]! Item was changed: ----- Method: ExternalType>>maxVal (in category 'accessing') ----- maxVal + "Force ByteArray. Do not use #allocate:." + - | data bytes | + bytes := ByteArray new: self byteSize. + data := ExternalData fromHandle: bytes type: self size: 1. - data := self allocate: 1. - bytes := data getHandle. self isIntegerType ifTrue: [ self isSigned ifTrue: [ bytes atAllPut: 16rFF. FFIPlatformDescription current endianness = #little ifTrue: [bytes at: bytes size put: 16r7F] ifFalse: [bytes at: 1 put: 16r7F]. ^ data value]. self isUnsigned ifTrue: [ bytes atAllPut: 16rFF. ^ data value]]. self isFloatType ifTrue: [ bytes atAllPut: 16rFF. self isSinglePrecision ifTrue: [ FFIPlatformDescription current endianness = #little ifTrue: [ bytes at: bytes size put: 16r7F. bytes at: bytes size - 1 put: 16r7F] ifFalse: [ bytes at: 1 put: 16r7F. bytes at: 2 put: 16r7F]. ^ data value]. self isDoublePrecision ifTrue: [ FFIPlatformDescription current endianness = #little ifTrue: [ bytes at: bytes size put: 16r7F. bytes at: bytes size - 1 put: 16rEF] ifFalse: [ bytes at: 1 put: 16r7F. bytes at: 2 put: 16rEF]. ^ data value]]. self error: 'maxVal not defined for this type'.! Item was changed: ----- Method: ExternalType>>minVal (in category 'accessing') ----- minVal + "Force ByteArray. Do not use #allocate:." | data bytes | + bytes := ByteArray new: self byteSize. + data := ExternalData fromHandle: bytes type: self size: 1. - data := self allocate: 1. - bytes := data getHandle. self isIntegerType ifTrue: [ self isSigned ifTrue: [ FFIPlatformDescription current endianness = #little ifTrue: [bytes at: bytes size put: 1 << 7] ifFalse: [bytes at: 1 put: 1 << 7]. ^ data value]. self isUnsigned ifTrue: [ ^ data value]]. self isFloatType ifTrue: [ bytes atAllPut: 16rFF. self isSinglePrecision ifTrue: [ FFIPlatformDescription current endianness = #little ifTrue: [bytes at: bytes size - 1 put: 16r7F] ifFalse: [bytes at: 2 put: 16r7F]. ^ data value]. self isDoublePrecision ifTrue: [ FFIPlatformDescription current endianness = #little ifTrue: [bytes at: bytes size - 1 put: 16rEF] ifFalse: [bytes at: 2 put: 16rEF]. ^ data value]]. self error: 'minVal not defined for this type'.! Item was added: + ----- Method: Float32Array class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType float asArrayType: nil! Item was added: + ----- Method: Float64Array class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType double asArrayType: nil! Item was added: + ----- Method: RawBitsArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + self subclassResponsibility.! Item was added: + ----- Method: RawBitsArray>>contentType (in category '*FFI-Kernel') ----- + contentType + + ^ self externalType contentType! Item was added: + ----- Method: RawBitsArray>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ self class externalType contentType asArrayType: self size! Item was added: + ----- Method: RawBitsArray>>free (in category '*FFI-Kernel') ----- + free + + self shouldNotImplement.! Item was added: + ----- Method: RawBitsArray>>from:to: (in category '*FFI-Kernel') ----- + from: firstIndex to: lastIndex + "See ExternalData" + + ^ self copyFrom: firstIndex to: lastIndex! Item was added: + ----- Method: RawBitsArray>>getHandle (in category '*FFI-Kernel') ----- + getHandle + "I am my own handle." + + ^ self! Item was added: + ----- Method: RawBitsArray>>isArray (in category '*FFI-Kernel') ----- + isArray + "Maybe move to Trunk?" + + ^ true! Item was added: + ----- Method: RawBitsArray>>isNull (in category '*FFI-Kernel') ----- + isNull + + ^ false! Item was added: + ----- Method: RawBitsArray>>reader (in category '*FFI-Kernel') ----- + reader + + ^ self! Item was added: + ----- Method: RawBitsArray>>setContentType: (in category '*FFI-Kernel') ----- + setContentType: type + "See ExternalData." + + self shouldNotImplement.! Item was added: + ----- Method: RawBitsArray>>setSize: (in category '*FFI-Kernel') ----- + setSize: size + "See ExternalData." + + self shouldNotImplement.! Item was added: + ----- Method: RawBitsArray>>writer (in category '*FFI-Kernel') ----- + writer + + ^ self! Item was added: + ----- Method: RawBitsArray>>zeroMemory (in category '*FFI-Kernel') ----- + zeroMemory + + self atAllPut: 0.! Item was added: + ----- Method: SignedByteArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType int8_t asArrayType: nil! Item was added: + ----- Method: SignedDoubleByteArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType int16_t asArrayType: nil! Item was added: + ----- Method: SignedDoubleWordArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType int64_t asArrayType: nil! Item was added: + ----- Method: SignedWordArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType int32_t asArrayType: nil! Item was added: + ----- Method: WordArray class>>externalType (in category '*FFI-Kernel') ----- + externalType + + ^ ExternalType uint32_t asArrayType: nil! From commits at source.squeak.org Sat May 15 17:04:56 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 17:04:56 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.36.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.36.mcz ==================== Summary ==================== Name: FFI-Tests-mt.36 Author: mt Time: 15 May 2021, 7:04:54.637008 pm UUID: ee0e3f05-aef0-6a43-9514-cd18cdef0092 Ancestors: FFI-Tests-mt.35 Complements FFI-Kernel-mt.149 =============== Diff against FFI-Tests-mt.35 =============== Item was changed: ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests - atomic types') ----- testAtomicTypeRange "Tests the range of non-integer and non-float types. Includes char types because those look different in Smalltalk." self should: [ExternalType void minVal] raise: Error. self should: [ExternalType void maxVal] raise: Error. self should: [ExternalType bool minVal] raise: Error. self should: [ExternalType bool maxVal] raise: Error. + self should: [ExternalType char "unsignedChar" minVal] raise: Error. + self should: [ExternalType char "unsignedChar" maxVal] raise: Error. + + self should: [ExternalType signedChar "schar" minVal] raise: Error. + self should: [ExternalType signedChar "schar" maxVal] raise: Error. - self assert: Character null equals: ExternalType char "unsignedChar" minVal. - self assert: (Character value: 255) equals: ExternalType char "unsignedChar" maxVal. - self assert: (Character value: 128) equals: ExternalType signedChar "schar" minVal. - self assert: (Character value: 127) equals: ExternalType signedChar "schar" maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testIntegerNotCharType (in category 'tests - atomic integer types') ----- + testIntegerNotCharType + + #( signedChar unsignedChar ) do: [:typeName | + | type | + type := ExternalType typeNamed: typeName. + self deny: type isIntegerType].! Item was added: + ----- Method: FFIAllocateExternalTests>>test10ArrayClasses (in category 'tests - array') ----- + test10ArrayClasses + "Array classes do not apply to external allocation."! Item was added: + ----- Method: FFIAllocateTests>>performTest (in category 'running') ----- + performTest + "Tests should opt-in to have more control." + + | prior | + prior := ExternalType useArrayClasses. + [ExternalType useArrayClasses: false. + super performTest] + ensure: [ExternalType useArrayClasses: prior].! Item was added: + ----- Method: FFIAllocateTests>>test10ArrayClasses (in category 'tests - array') ----- + test10ArrayClasses + "For integer and float types, allocate arrays and check for specific array classes. Then construct a conventional byte array for an external data structure. A copy should also convert into a specific array class with the same contents." + + ExternalType useArrayClassesDuring: [ + + ExternalType atomicTypes do: [:contentType | + (contentType isIntegerType + or: [contentType isFloatType] + or: [contentType isCharType]) ifTrue: [ + | array arrayType data copy | + array := self allocate: contentType size: 5. + arrayType := array externalType. + + self assert: array isArray. + self assert: 5 equals: array size. + self assert: array byteSize equals: arrayType byteSize. + + contentType = ExternalType signedChar ifFalse: [ + self flag: #discuss. "mt: What is signedChar even for?" + self assert: contentType equals: array contentType]. + + self deny: array isNull. + self deny: (array isKindOf: ExternalData). + self assert: array equals: array getHandle. + + self shouldnt: [array at: 1 put: contentType allocate] raise: Error. + self shouldnt: [array zeroMemory] raise: Error. + self should: [array setContentType: ExternalType byte] raise: Error. + self should: [array setSize: 42] raise: Error. + + data := ExternalData + fromHandle: (ByteArray new: arrayType byteSize) + type: arrayType. + copy := data copy. "From external data into raw-bits array." + self deny: array equals: data. + self assert: array equals: copy. ]]].! From commits at source.squeak.org Sat May 15 17:25:40 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 17:25:40 0000 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz Message-ID: David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1233.mcz ==================== Summary ==================== Name: System-dtl.1233 Author: dtl Time: 15 May 2021, 1:25:37.809444 pm UUID: 660215fe-f151-4184-8a31-8775202baa81 Ancestors: System-nice.1232 Be permissive when filing in Cuis packages. Skip chunks that begin with known extensions that are not meaningful for Squeak, logging to Transcript to show chunks that have been ignored. =============== Diff against System-nice.1232 =============== Item was changed: ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') ----- fileInAnnouncing: announcement "This is special for reading expressions from text that has been formatted with exclamation delimitors. The expressions are read and passed to the Compiler. Answer the result of compilation. Put up a progress report with the given announcement as the title." | val | announcement displayProgressFrom: 0 to: self size during: [:bar | [self atEnd] whileFalse: [bar value: self position. self skipSeparators. [ | chunk | val := (self peekFor: $!!) + ifTrue: [ | ch | + ch := self nextChunk. + (self shouldIgnore: ch) + ifTrue: [Transcript showln: 'Ignoring chunk: ', ch] + ifFalse: [(Compiler evaluate: ch logged: true) scanFrom: self]] - ifTrue: [(Compiler evaluate: self nextChunk logged: true) scanFrom: self] ifFalse: [chunk := self nextChunk. self checkForPreamble: chunk. Compiler evaluate: chunk logged: true]] on: InMidstOfFileinNotification do: [:ex | ex resume: true]. self skipStyleChunk]. self close]. "Note: The main purpose of this banner is to flush the changes file." Smalltalk logChange: '----End fileIn of ' , self name , '----'. self flag: #ThisMethodShouldNotBeThere. "sd" ^val! Item was added: + ----- Method: PositionableStream>>shouldIgnore: (in category '*System-Changes-fileIn/Out') ----- + shouldIgnore: chunk + "Fileouts created on another Smalltalk may contain chunks that are + not meaningful for Squeak. Answer true if chunk should be ignored." + + ^ ((chunk beginsWith: 'provides:') "Cuis Smalltalk extensions" + or: [chunk beginsWith: 'requires:']) + or: [chunk beginsWith: 'classDefinition:'] + ! From commits at source.squeak.org Sat May 15 17:30:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 17:30:47 0000 Subject: [squeak-dev] The Trunk: System-dtl.1234.mcz Message-ID: David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1234.mcz ==================== Summary ==================== Name: System-dtl.1234 Author: dtl Time: 15 May 2021, 1:30:44.531511 pm UUID: 40e78b44-f874-4a29-af19-9d289d15d049 Ancestors: System-dtl.1233 PositionableStream>>fileInSilentlyAnnouncing: has not been used since at least Squeak 3.8, and was not present in Squeak 3.6. Remove it without deprecation. =============== Diff against System-dtl.1233 =============== Item was removed: - ----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category '*System-Changes-fileIn/Out') ----- - fileInSilentlyAnnouncing: announcement - "This is special for reading expressions from text that has been formatted - with exclamation delimitors. The expressions are read and passed to the - Compiler. Answer the result of compilation. Put up a progress report with - the given announcement as the title." - - | val chunk | - [self atEnd] whileFalse: - [self skipSeparators. - - [val := (self peekFor: $!!) - ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self] - ifFalse: - [chunk := self nextChunk. - self checkForPreamble: chunk. - Compiler evaluate: chunk logged: true]] - on: InMidstOfFileinNotification - do: [:ex | ex resume: true]. - self skipStyleChunk]. - self close. - "Note: The main purpose of this banner is to flush the changes file." - Smalltalk logChange: '----End fileIn of ' , self name , '----'. - self flag: #ThisMethodShouldNotBeThere. "sd" - SystemNavigation new allBehaviorsDo: - [:cl | - cl - removeSelectorSimply: #DoIt; - removeSelectorSimply: #DoItIn:]. - ^val! From marcel.taeumel at hpi.de Sat May 15 17:32:01 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Sat, 15 May 2021 19:32:01 +0200 Subject: [squeak-dev] The Trunk: System-dtl.1234.mcz In-Reply-To: References: Message-ID: +1 :-) Best, Marcel Am 15.05.2021 19:31:00 schrieb commits at source.squeak.org : David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1234.mcz ==================== Summary ==================== Name: System-dtl.1234 Author: dtl Time: 15 May 2021, 1:30:44.531511 pm UUID: 40e78b44-f874-4a29-af19-9d289d15d049 Ancestors: System-dtl.1233 PositionableStream>>fileInSilentlyAnnouncing: has not been used since at least Squeak 3.8, and was not present in Squeak 3.6. Remove it without deprecation. =============== Diff against System-dtl.1233 =============== Item was removed: - ----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category '*System-Changes-fileIn/Out') ----- - fileInSilentlyAnnouncing: announcement - "This is special for reading expressions from text that has been formatted - with exclamation delimitors. The expressions are read and passed to the - Compiler. Answer the result of compilation. Put up a progress report with - the given announcement as the title." - - | val chunk | - [self atEnd] whileFalse: - [self skipSeparators. - - [val := (self peekFor: $!!) - ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self] - ifFalse: - [chunk := self nextChunk. - self checkForPreamble: chunk. - Compiler evaluate: chunk logged: true]] - on: InMidstOfFileinNotification - do: [:ex | ex resume: true]. - self skipStyleChunk]. - self close. - "Note: The main purpose of this banner is to flush the changes file." - Smalltalk logChange: '----End fileIn of ' , self name , '----'. - self flag: #ThisMethodShouldNotBeThere. "sd" - SystemNavigation new allBehaviorsDo: - [:cl | - cl - removeSelectorSimply: #DoIt; - removeSelectorSimply: #DoItIn:]. - ^val! -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Sat May 15 17:36:25 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Sat, 15 May 2021 19:36:25 +0200 Subject: [squeak-dev] Please try out | Cross-platform mapping for virtual key codes :-) In-Reply-To: <20210515151708.GA42867@shell.msen.com> References: <20210515151708.GA42867@shell.msen.com> Message-ID: Thanks! :-) I see. Did not notice that. :-D Tom and I want to be brave and take a quick look at the X11 Input Plugin, too. >From a first glance, the bug is in this (repeated) pattern: ... recordKeyboardEvent(0, EventKeyDown, modifierState, utf32); recordKeyboardEvent(0, EventKeyChar, modifierState, utf32); ... If we can hunt down something like a "scanCode" for "EventKeyDown", it might work. Maybe I am overlooking some X11 basics here. Best, Marcel Am 15.05.2021 17:17:18 schrieb David T. Lewis : Hi Marcel, Attached are changes that should make the virtual key mapping work when the image is restarted on a different platform. Dave On Wed, Apr 28, 2021 at 12:02:44PM +0200, Marcel Taeumel wrote: > Hi all! > > Here is a small update. Please find attached the changeset. > > Updates: > - Adds KeyboardEvent >> #keyCode (via new inst-var) > - Logs the last key-down event to attach virtual-key codes to key-stroke events; see HandMorph >> #generateKeyboardEvent: > - Simplifies KeyboardEvent >> #key > - Show event repetition in KeyboardExecizer > > > > Major questions: > 1. Does it work on your machine? > 2. What are your thoughts on KeyboardEvent >> #key? > 3. What are your thoughts on KeyboardEvent >> #keyCode? > 4. Do you understand KeyboardEvent >> #physicalKey #virtualKey #physicalModifiers #virtualModifiers ? > > Happy testing! > > Best, > Marcel > > P.S.: Don't forget about the X11 key (scan?) codes. ^__^ I haven't had the time to look into the VM plugin yet. > Am 27.04.2021 16:40:56 schrieb Marcel Taeumel : > Hi all! > > > Please find attached a changeset that adds mapping tables for virtual keys (or scan codes) for macOS, X11, and Windows. You can find them in EventSensor class >> #virtualKeysOn* > > You can try out if they work through the KeyboardExerciser. Please take a look at the balloon text (i.e. tool tip) to better understand the data. > > There is also a new preference: > [x] Simplify Virtual-key codes > > ... because of Windows who dares to couple codes to the input language (e.g. US vs. DE), which Squeak knows nothing about. macOS is better in this regard. :-) > > Biggest mess is on Linux/X11. For key-down/up events, the Linux VM delivers actual character codes instead of scan codes, which makes a basic mapping to physical keys almost impossible. See EventSensor class >> #virtualKeysOnX11. We MUST fix that! Please. Somebody. Can I haz scan codes? ^__^ > > *** > > > *** > > The good news: KeyboardEvent >> #key (and UserInputEvent >> #modifiers) now gives you cross-platform stable information about physical keys to be used in keyboard handlers. Yes, for both key-stroke and key-down/up events. > > Or at least, that is the plan. That's why it would be great if you could help testing! :-) > > Why key-stroke events too? Aren't they for typing text only? > > 1. Almost all keyboard shortcuts in current Squeak are based on key-stroke events. > 2. Using the #keyCharacter is tricky because SHIFT changes lower-case to upper-case, which makes "anEvent shiftPressed" hard to understand. > 3. CTRL combinations might not do the expected thing. How would you handle CTRL+C? The #keyCharacter could arrive as $c or Character enter. See the preference "Map non-printable characters to printable characters. Now, #key will always answer $C in such a case. Regardless of that preference. > > Can't we just use #keyCharacter in key-down/up events? > > No. Those are undefined. Never do that. key-down/up events carry virtual-key codes in their #keyValue. We might want to change #keyCharacter to answer "nil" for those events. > > *** > > Q: What is a "physical key" or "physical modifier"? > A: The label that can be presented to the user so that he or she feels at home when using Squeak. Thus, looks platform-specific. > > Q: What is a "virtual key" or "virtual modifier"? > A: The information to be processed in your application's key handlers. Thus, looks platform-independent. If you have still no clue how to talk to keyboard events, please read the commentary in KeyboardEvent >> #checkCommandKey. > > *** > > Happy testing! :-) And thank you all in advance! > > Best, > Marcel > > P.S.: You might want to disable the preference "synthesize mouse-wheel events from keyboard-events" to get CTRL+ArrowUp and CTRL+ArrowDown ;-) > -------------- next part -------------- An HTML attachment was scrubbed... URL: From christoph.thiede at student.hpi.uni-potsdam.de Sat May 15 18:11:31 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 15 May 2021 13:11:31 -0500 (CDT) Subject: [squeak-dev] Tackling Context>>#runUntilErrorReturnFrom: (was: BUG/REGRESSION while debugging Generator >> #nextPut:) In-Reply-To: <1620851547306-0.post@n4.nabble.com> References: <9ed2db8e40684297b83d98e311e76a4b@student.hpi.uni-potsdam.de> <25a67367ce4f4ee68d0509659cb10c72@student.hpi.uni-potsdam.de> <1615231296272-0.post@n4.nabble.com> <1615566932862-0.post@n4.nabble.com> <1620851547306-0.post@n4.nabble.com> Message-ID: <1621102291419-0.post@n4.nabble.com> Hi all, hi Jaromir, with regard to the bug mentioned in [1], I have updated the changeset from above: runUntilErrorOrReturnFrom.cs Basically, I inserted a send to #informDebuggerAboutContextSwitchTo: in the loop body of Context >> #resume:through: as well. I could not find any regressions from the previous changeset, but since this is a very low-level method, any crash tests will be appreciated. I believe that in the past a similar approach has crashed my image, but I could not reproduce this any longer today ... I am also - still :-) - very excited to hear your feedback and thoughts on the general approach. In my message from above, I have highlighted two bold questions, it would be great if some of our Kernel experts could find a few minutes for them. Nicolas? Eliot? Jaromir? :-) Best, Christoph [1] http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Sat May 15 18:16:04 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sat, 15 May 2021 13:16:04 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1621002532100-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> <1621002532100-0.post@n4.nabble.com> Message-ID: <1621102564397-0.post@n4.nabble.com> Hi Jaromir, Hi Nicolas, > however the same problem remains on lower levels, i.e. for stepping over > #return:through: and #resume:through: - same example, same incorrect > behavior: I fully agree with this. While Nicolas's fix makes this particular situation easier to debug, IMHO it is only fighting the symptoms. In my opinion, we should instead fix the underlying problem of dangling guard contexts in #runUntilErrorOrReturnFrom:. I have just updated runUntilErrorOrReturnFrom.cs as proposed in [1], which notifies the debugger about risky context manipulations such as #jump, #swapSender:, and now also #resume:through:. I think that this is a more holistic approach than #simulatedAboutToReturn:through:. I'm still wondering whether this approach has its limits, but if there are any, I did not yet find them. Probably Jaromir you might feel like giving this a closer look? Looking forward to your feedback! :-) Best, Christoph [1] http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-nextPut-tp5108125p5129721.html ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sat May 15 18:16:37 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 18:16:37 0000 Subject: [squeak-dev] The Trunk: System-dtl.1235.mcz Message-ID: David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1235.mcz ==================== Summary ==================== Name: System-dtl.1235 Author: dtl Time: 15 May 2021, 2:16:34.362599 pm UUID: 0fa23815-1b1d-431f-ad7f-3b97f3a0cf08 Ancestors: System-dtl.1234 Clean up redundant fileIn methods and let SARInstaller use the same method as the rest of us. =============== Diff against System-dtl.1234 =============== Item was changed: ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') ----- fileInAnnouncing: announcement - "This is special for reading expressions from text that has been formatted - with exclamation delimitors. The expressions are read and passed to the - Compiler. Answer the result of compilation. Put up a progress report with - the given announcement as the title." + ^ self fileInFor: nil announcing: announcement! - | val | - announcement - displayProgressFrom: 0 - to: self size - during: - [:bar | - [self atEnd] whileFalse: - [bar value: self position. - self skipSeparators. - - [ | chunk | - val := (self peekFor: $!!) - ifTrue: [ | ch | - ch := self nextChunk. - (self shouldIgnore: ch) - ifTrue: [Transcript showln: 'Ignoring chunk: ', ch] - ifFalse: [(Compiler evaluate: ch logged: true) scanFrom: self]] - ifFalse: - [chunk := self nextChunk. - self checkForPreamble: chunk. - Compiler evaluate: chunk logged: true]] - on: InMidstOfFileinNotification - do: [:ex | ex resume: true]. - self skipStyleChunk]. - self close]. - "Note: The main purpose of this banner is to flush the changes file." - Smalltalk logChange: '----End fileIn of ' , self name , '----'. - self flag: #ThisMethodShouldNotBeThere. "sd" - ^val! Item was changed: ----- Method: PositionableStream>>fileInFor:announcing: (in category '*System-Changes-fileIn/Out') ----- fileInFor: client announcing: announcement "This is special for reading expressions from text that has been formatted with exclamation delimitors. The expressions are read and passed to the Compiler. Answer the result of compilation. Put up a progress report with + the given announcement as the title." + - the given announcement as the title. - Does NOT handle preambles or postscripts specially." | val | + announcement - announcement displayProgressFrom: 0 to: self size + during: + [:bar | + [self atEnd] whileFalse: + [bar value: self position. + self skipSeparators. + + [ | chunk | + val := (self peekFor: $!!) + ifTrue: [ | ch | + ch := self nextChunk. + (self shouldIgnore: ch) + ifTrue: [Transcript showln: 'Ignoring chunk: ', ch] + ifFalse: [(Compiler evaluate: ch for: client logged: true) scanFrom: self]] + ifFalse: + [chunk := self nextChunk. + self checkForPreamble: chunk. + Compiler evaluate: chunk for: client logged: true]] + on: InMidstOfFileinNotification + do: [:ex | ex resume: true]. + self skipStyleChunk]. + self close]. - during: - [:bar | - [self atEnd] - whileFalse: - [bar value: self position. - self skipSeparators. - [ | chunk | - val := (self peekFor: $!!) ifTrue: [ - (Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self - ] ifFalse: [ - chunk := self nextChunk. - self checkForPreamble: chunk. - Compiler evaluate: chunk for: client logged: true ]. - ] on: InMidstOfFileinNotification - do: [ :ex | ex resume: true]. - self atEnd ifFalse: [ self skipStyleChunk ]]. - self close]. "Note: The main purpose of this banner is to flush the changes file." Smalltalk logChange: '----End fileIn of ' , self name , '----'. + self flag: #ThisMethodShouldNotBeThere. "sd" + ^val! - ^ val! From commits at source.squeak.org Sat May 15 18:41:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 18:41:53 0000 Subject: [squeak-dev] The Inbox: Tools-ct.1057.mcz Message-ID: A new version of Tools was added to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1057.mcz ==================== Summary ==================== Name: Tools-ct.1057 Author: ct Time: 15 May 2021, 8:41:49.62983 pm UUID: 4391ea2e-e428-4d44-b095-1a523f0c29f6 Ancestors: Tools-mt.1055 Fixes minor bugs and regressions in ChangeSorters: - Since Tools-mt.1046, change sorters' selection always jumped back to the first message in the list when the model was reactivated (i.e., select the entry from the list, focus another window, and give focus back to the change sorter window). This was due to the too-aggressive #showChangeSet: send in #updateIfNecessary. I removed it since I don't think it's necessary at all. Instead, eagerly select the current changeset upon initialization. - Add missing send to #decorateButtons when the current selector has changed. =============== Diff against Tools-mt.1055 =============== Item was changed: ----- Method: ChangeSorter>>currentSelector: (in category 'message list') ----- currentSelector: messageName currentSelector := messageName. self changed: #currentSelector. self setContents. + self contentsChanged. + self decorateButtons.! - self contentsChanged.! Item was changed: ----- Method: ChangeSorter>>initialize (in category 'initialize') ----- initialize super initialize. + self showChangeSet: ChangeSet current.! - myChangeSet := ChangeSet current.! Item was changed: ----- Method: ChangeSorter>>updateIfNecessary (in category 'changeSet menu') ----- updateIfNecessary "Recompute all of my panes." | newList | self okToChange ifFalse: [^ self]. + - myChangeSet ifNil: [^ self]. "Has been known to happen though shouldn't" (myChangeSet isMoribund) ifTrue: [self changed: #changeSetList. ^ self showChangeSet: ChangeSet current]. + - newList := self changeSetList. + - (priorChangeSetList == nil or: [priorChangeSetList ~= newList]) ifTrue: [priorChangeSetList := newList. + self changed: #changeSetList].! - self changed: #changeSetList]. - self showChangeSet: myChangeSet! From ken.dickey at whidbey.com Sat May 15 19:48:15 2021 From: ken.dickey at whidbey.com (ken.dickey at whidbey.com) Date: Sat, 15 May 2021 12:48:15 -0700 Subject: [squeak-dev] "More Direct Morphic": The Movie Message-ID: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> For those of you in different time zones who have an interest.. The "More Direct Morphic" talk starts a bit after 18 minutes in: https://www.youtube.com/watch?v=BqWuUpXzQt8 Enjoy, -KenD From commits at source.squeak.org Sat May 15 19:53:54 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 19:53:54 0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1406.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1406.mcz ==================== Summary ==================== Name: Kernel-ct.1406 Author: ct Time: 15 May 2021, 9:53:50.156138 pm UUID: 8d0523c3-281e-7c44-bff5-8d5c69646c62 Ancestors: Kernel-nice.1402 Fixes a typo in Context >> #d?sarmHandler. Normally I would not have spammed the inbox with minor changes like this one, but me as a non-native speaker was actually confused about the term "desarm" before consulting a dictionary. :-) =============== Diff against Kernel-nice.1402 =============== Item was removed: - ----- Method: Context>>desarmHandler (in category 'private-exceptions') ----- - desarmHandler - "Private - sent to exception handler context only (on:do:)" - - stackp >= 4 ifTrue: [self tempAt: 4 put: false] "this is temporary handlerRearmed in #on:do:"! Item was added: + ----- Method: Context>>disarmHandler (in category 'private-exceptions') ----- + disarmHandler + "Private - sent to exception handler context only (on:do:)" + + stackp >= 4 ifTrue: [self tempAt: 4 put: false] "this is temporary handlerRearmed in #on:do:"! Item was changed: ----- Method: Context>>rearmHandlerDuring: (in category 'private-exceptions') ----- rearmHandlerDuring: aBlock "Sent to handler (on:do:) contexts only. Makes me re-entrant for the duration of aBlock. Only works in a closure-enabled image" ^ [self rearmHandler. aBlock value] + ensure: [self disarmHandler]! - ensure: [self desarmHandler]! From commits at source.squeak.org Sat May 15 19:54:27 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 15 May 2021 19:54:27 0000 Subject: [squeak-dev] The Inbox: ToolBuilder-Kernel-ct.146.mcz Message-ID: A new version of ToolBuilder-Kernel was added to project The Inbox: http://source.squeak.org/inbox/ToolBuilder-Kernel-ct.146.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-ct.146 Author: ct Time: 15 May 2021, 9:54:25.721138 pm UUID: 753c1d5e-f5d7-3a4c-b4ae-fb49859db529 Ancestors: ToolBuilder-Kernel-nice.145 Complements Kernel-ct.1406 so that sender search works again. =============== Diff against ToolBuilder-Kernel-nice.145 =============== Item was changed: ----- Method: ProgressInitiationException>>sendNotificationsTo: (in category 'handling') ----- sendNotificationsTo: aNewBlock "Resume execution using aNewBlock as workBlock value. Note that the execution is resumed in signalContext (or outerContext). This is done so that inner exception handlers be active during workBlock execution. However, our own handlerContext should be deactivated, unless explicitely rearmed." | mustDeactivateHandler | mustDeactivateHandler := handlerContext notNil and: [handlerContext isHandlerActive not]. mustDeactivateHandler ifTrue: ["The handlerContext is de-activated during handleSignal: But it will be reactivated during unwinding when we will resumeEvaluating: That's unwanted, we don't generally want to rearm the handler during workBlock evaluation. Hence we have to deactivate it again inside the deferred block." self resumeEvaluating: [handlerContext deactivateHandler. [workBlock value: [ :barVal | aNewBlock value: minVal value: maxVal value: barVal]] ensure: [handlerContext reactivateHandler]]] ifFalse: ["If the handler is active at this step, then it must have been rearmed with a #rearmHandlerDuring: It's thus intentional to keep the handler active during workBlock evaluation + But the ensure: [self disarmHandler] will be evaluated during unwinding when we will resumeEvaluating: - But the ensure: [self desarmHandler] will be evaluated during unwinding when we will resumeEvaluating: It is thus necessary to rearm again inside the evaluated block" self resumeEvaluating: [self rearmHandlerDuring: [workBlock value: [ :barVal | aNewBlock value: minVal value: maxVal value: barVal]]]]! From m at jaromir.net Sat May 15 21:20:54 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 15 May 2021 16:20:54 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: <1621087561864-0.post@n4.nabble.com> References: <1621087561864-0.post@n4.nabble.com> Message-ID: <1621113654445-0.post@n4.nabble.com> Hi Christoph, > Counterproposal to Kernel-jar.1404 for fixing VM crashes when resuming > from a BlockCannotReturn. Instead of enforcing retrial, repair the context > stack if the receiver has ended. I was considering the idea whether it could make sense to "fix" the stack but dumped it eventually because it would completely change the semantics of non-local returns. In my opinion once the home context sender is not available it means it's gone irreparably. There are two situation to consider: double return to the same context within one stack (e.g. the return context is gone or it may even still exist but its pc has moved) or the home sender is on a different context stack - in case of forks etc. Non-local returns between forks could in theory work but not in the current environment; Squeak strictly requires the home context sender to be on the same stack. > Not in all situations, the receiver of #cannotReturn: is actually unable > to resume. Consider this example for a disproof: > `a := [true ifTrue: [^ 1]. 2].` > "Both statements need to be executed separately in a Workspace so that > [a outerContext sender] becomes nil!" > `a value.` > In this situation, it is valid to resume from BlockCannotReturn and > currently also possible in the Trunk. Note that BlockCannotReturn even > overrides #isResumable to answer true, though the class comment > discrecommends resuming it. My interpretation of this example is the home sender of ^1 is gone once the first do-it ends. So the second do-it correctly, in my opinion, invokes the cannot return error. Current Trunk returning 2 seems wildly incorrect to me. Resuming BlockCannotReturn sounds crazy to me by definition and you're right: it's set as resumable, I haven't noticed. I'd set it non-resumable. If a block cannot return, why should we be tempted to do that? :) > Nevertheless, this raises another question - what would you expect from > this > example to return? > > `a := [true ifTrue: [^ 1] yourself].` > "Both statements need to be executed separately in a Workspace so that [a > outerContext sender] becomes nil!" > `[a value] on: BlockCannotReturn do: [:ex | ex resume].` > > Should it be 1 or nil? In the Trunk, is it nil, if we override > \#defaultResumeValue as below, it will be 1. This is a mean example... My fix ended in an infinite loop :) I tried to fix it but the only clean solution that occurred to me is to set BlockCannotReturn as non-resumable. But again, my interpretation here is any attempt to "repair" the context that cannot return means a substantial change of the non-local return semantics. It means I'd return nil because the meaning of the error is: I cannot return 1 to my home sender. Here's one of my examples I'm planning to send as test cases to the Inbox soon: [ [ [ ] ensure: [ [] ensure: [ ^Transcript show: 'x1']. Transcript show: 'x2'] ] ensure: [ Transcript show: 'x3']. Transcript show: 'x4' ] fork In this case the expected outcome is ---> x1 x3. Neither x2 nor x4 should be printed (x2 is intentionally skipped by the non-local return and x4 is outside the ensure blocks). With the fix you propose the outcome is either ---> x1 x2 x3 if pressed Abandon or ---> x1 x2 x3 x4 if pressed Proceed - this would be equivalent to no non-local return at all :) I hope I'll be able to put the tests together and publish in a few days. Juan Vuletich showed me a beautiful example about the non-local return semantics - take a look in [1] in the middle of the post. Thanks for discussing this! best, [1] [[Cuis-dev\] Unwind mechanism during termination is broken and inconsistent](https://lists.cuis.st/mailman/archives/cuis-dev/2021-April/003055.html) ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sun May 16 05:29:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:29:47 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.150.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.150.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.150 Author: mt Time: 16 May 2021, 7:29:44.888024 am UUID: d372abc2-2996-6949-be7e-2bfad84cfa4a Ancestors: FFI-Kernel-mt.149 Fixes support of void and void* in ExternalData. =============== Diff against FFI-Kernel-mt.149 =============== Item was added: + ----- Method: ExternalData>>arrayType (in category 'accessing - types') ----- + arrayType + "Answer this container's array type or 'nil' if unknown." + + | arrayType | + type ifNil: [^ nil]. + arrayType := self containerType asNonPointerType. + ^ arrayType isVoid + ifTrue: [nil] + ifFalse: [arrayType]! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- contentType "^ " "Answer the content type for the current container type." + ^ self arrayType + ifNil: [ExternalType void] + ifNotNil: [:arrayType | arrayType contentType]! - ^ self containerType asNonPointerType contentType! Item was added: + ----- Method: ExternalData>>contentTypeCheck (in category 'private') ----- + contentTypeCheck + + self contentType isVoid ifTrue: [ + self error: 'You cannot do that for void content.'].! Item was changed: ----- Method: ExternalData>>setContentType: (in category 'initialize-release') ----- setContentType: externalType externalType = ExternalType string ifTrue: [ ^ self setContentType: externalType asNonPointerType]. + self setType: (externalType isVoid + ifTrue: [externalType "Size gets lost for void."] + ifFalse: [externalType asArrayType: self size]).! - self setType: (externalType asArrayType: self size).! Item was changed: ----- Method: ExternalData>>setSize: (in category 'initialize-release') ----- setSize: numElements "Set the size for the receiver, which will be used when enumerating its elements." + + self contentTypeCheck. - self setType: (self contentType asArrayType: numElements).! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." - externalType isVoid ifTrue: [ - ^ self setType: externalType asPointerType]. externalType = ExternalType string ifTrue: [ ^ self setType: externalType asNonPointerType]. + (externalType asNonPointerType isArrayType or: [externalType isVoid]) - externalType asNonPointerType isArrayType ifTrue: [type := externalType] ifFalse: [type := (externalType asArrayType: nil)]. handle isExternalAddress ifTrue: [type := type asPointerType] ifFalse: [type := type asNonPointerType].! Item was changed: ----- Method: ExternalData>>size (in category 'accessing') ----- size + "Answer how many elements the receiver contains. Support void type." + + ^ self arrayType ifNotNil: [:arrayType | arrayType size]! - "Answer how many elements the receiver contains." - - ^ self containerType asNonPointerType size - ! Item was changed: ----- Method: ExternalData>>sizeCheck (in category 'private') ----- sizeCheck + self size ifNil: [self error: 'Size is unknown for this data'].! - self size ifNil: [self error: 'Size is unknown for this data pointer'].! Item was changed: ----- Method: ExternalData>>typeCheck (in category 'private') ----- typeCheck "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls if the signature did not specify, e.g., 'int[]' but 'int*'." + type asNonPointerType isVoid + ifTrue: [^ self]. + type asNonPointerType isArrayType ifFalse: [self setType: type "int*" asNonPointerType "int ... to become int[], not int*[]"].! From commits at source.squeak.org Sun May 16 05:30:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:30:11 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.37.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.37.mcz ==================== Summary ==================== Name: FFI-Tests-mt.37 Author: mt Time: 16 May 2021, 7:30:08.986024 am UUID: 461435c5-e0ab-904d-9e43-b1b02fbe51a8 Ancestors: FFI-Tests-mt.36 Complements FFI-Kernel-mt.150 =============== Diff against FFI-Tests-mt.36 =============== Item was changed: ----- Method: FFIAllocateExternalTests>>checkAllocate: (in category 'running') ----- checkAllocate: externalObject | type handle | self assert: externalObject notNil. (externalObject isExternalObject) ifFalse: [ externalObjects remove: externalObject. "skip free" ^ self "atomics are fine"]. type := externalObject externalType. handle := externalObject getHandle. + (type isAtomic and: [type isVoid not]) ifTrue: [ - type isAtomic ifTrue: [ self deny: handle isExternalAddress. self deny: handle isInternalMemory. self deny: handle isNil. ^ self]. self deny: externalObject isNull. self deny: handle isNull. self deny: handle isNil. self assert: type isPointerType. self assert: handle isExternalAddress. self deny: handle isInternalMemory.! Item was changed: ----- Method: FFIAllocateTests>>checkAllocate: (in category 'running') ----- checkAllocate: externalObject | type handle | self assert: externalObject notNil. (externalObject isExternalObject) ifFalse: [ externalObjects remove: externalObject. "skip free" ^ self "pure atomics are fine"]. type := externalObject externalType. handle := externalObject getHandle. + (type isAtomic and: [type isVoid not]) ifTrue: [ - type isAtomic ifTrue: [ self deny: handle isExternalAddress. self deny: handle isInternalMemory. self deny: handle isNil. ^ self]. self deny: externalObject isNull. self deny: handle isNull. self deny: handle isNil. self deny: type isPointerType. self deny: handle isExternalAddress. self assert: handle isInternalMemory.! Item was added: + ----- Method: FFIAllocateTests>>test11ArrayAsVoidPointer (in category 'tests - array') ----- + test11ArrayAsVoidPointer + "Check whether the undefined content type -- void -- works. Type casting via #setContentType: is necessary in such cases." + + | type void array | + type := ExternalType int32_t. + void := ExternalType void. + array := self allocate: type size: 5. + self assert: type equals: array contentType. + array setContentType: void. + self checkAllocate: array. "Checks container type." + self assert: void equals: array contentType. + self assert: array size isNil. + self should: [array at: 1] raise: Error. + self should: [array at: 1 put: 42] raise: Error. + array setContentType: type. + self checkAllocate: array. + self assert: type equals: array contentType. + self assert: array size isNil. + self shouldnt: [array at: 1] raise: Error. + self shouldnt: [array at: 1 put: 42] raise: Error. ! From commits at source.squeak.org Sun May 16 05:46:22 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:46:22 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.151.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.151.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.151 Author: mt Time: 16 May 2021, 7:46:20.55258 am UUID: f2621e33-405f-8247-8385-299eb813579e Ancestors: FFI-Kernel-mt.150 Fixes regression with array-vs-string comparision, which broke the VMMaker source generation. Sorry! :-) =============== Diff against FFI-Kernel-mt.150 =============== Item was removed: - ----- Method: ByteString>>isArray (in category '*FFI-Kernel') ----- - isArray - "Maybe move to Trunk?" - - ^ true! Item was added: + ----- Method: ByteString>>isFFIArray (in category '*FFI-Kernel') ----- + isFFIArray + + ^ true! Item was removed: - ----- Method: ExternalData>>isArray (in category 'testing') ----- - isArray - - ^ true! Item was added: + ----- Method: ExternalData>>isFFIArray (in category 'testing') ----- + isFFIArray + + ^ true! Item was added: + ----- Method: Object>>isFFIArray (in category '*FFI-Kernel') ----- + isFFIArray + + ^ false! Item was removed: - ----- Method: RawBitsArray>>isArray (in category '*FFI-Kernel') ----- - isArray - "Maybe move to Trunk?" - - ^ true! Item was added: + ----- Method: RawBitsArray>>isFFIArray (in category '*FFI-Kernel') ----- + isFFIArray + + ^ true! From commits at source.squeak.org Sun May 16 05:50:27 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:50:27 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.38.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.38.mcz ==================== Summary ==================== Name: FFI-Tests-mt.38 Author: mt Time: 16 May 2021, 7:50:25.29658 am UUID: b32d1ecd-c367-cd43-907d-e0a00c06d6b5 Ancestors: FFI-Tests-mt.37 Complements FFI-Kernel-mt.151 =============== Diff against FFI-Tests-mt.37 =============== Item was changed: ----- Method: FFIAllocateTests>>test04GlobalVariableInArray (in category 'tests') ----- test04GlobalVariableInArray "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." | global | global := self allocate: ExternalType int32_t size: 1. + self assert: global isFFIArray. - self assert: global isArray. self assert: 0 equals: global value. global value: 42. self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>test10ArrayClasses (in category 'tests - array') ----- test10ArrayClasses "For integer and float types, allocate arrays and check for specific array classes. Then construct a conventional byte array for an external data structure. A copy should also convert into a specific array class with the same contents." ExternalType useArrayClassesDuring: [ ExternalType atomicTypes do: [:contentType | (contentType isIntegerType or: [contentType isFloatType] or: [contentType isCharType]) ifTrue: [ | array arrayType data copy | array := self allocate: contentType size: 5. arrayType := array externalType. + self assert: array isFFIArray. - self assert: array isArray. self assert: 5 equals: array size. self assert: array byteSize equals: arrayType byteSize. contentType = ExternalType signedChar ifFalse: [ self flag: #discuss. "mt: What is signedChar even for?" self assert: contentType equals: array contentType]. self deny: array isNull. self deny: (array isKindOf: ExternalData). self assert: array equals: array getHandle. self shouldnt: [array at: 1 put: contentType allocate] raise: Error. self shouldnt: [array zeroMemory] raise: Error. self should: [array setContentType: ExternalType byte] raise: Error. self should: [array setSize: 42] raise: Error. data := ExternalData fromHandle: (ByteArray new: arrayType byteSize) type: arrayType. copy := data copy. "From external data into raw-bits array." self deny: array equals: data. self assert: array equals: copy. ]]].! Item was changed: ----- Method: FFIPluginTests>>testArrayResultWithPoint (in category 'tests - arrays') ----- testArrayResultWithPoint "Test returning of pointers to arrays" | pt1 pt2 pt3 | pt1 := FFITestPoint4 new. pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. pt2 := FFITestPoint4 new. pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. pt3 := heapObject := FFITestLibrary ffiTestArrayResultWith: pt1 with: pt2. + self assert: pt3 isFFIArray. - self assert: pt3 isArray. pt3 := pt3 value. self assert: pt3 x = 6. self assert: pt3 y = 8. self assert: pt3 z = 10. self assert: pt3 w = 12.! Item was changed: ----- Method: FFIPluginTests>>testArrayResultWithString (in category 'tests - arrays') ----- testArrayResultWithString "Note that the result does not have to be free'd because the FFITestLibrary is just passing along a Smalltalkg string. I think." | string result | string := 'Hello Squeak!!'. result := FFITestLibrary ffiTestArrayResultWithString: string. + self assert: result isFFIArray. - self assert: result isArray. ExternalData allowDetectForUnknownSizeDuring: [ self assert: string equals: result fromCString].! From commits at source.squeak.org Sun May 16 05:59:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:59:11 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.152.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.152.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.152 Author: mt Time: 16 May 2021, 7:59:09.18058 am UUID: 45ab85b9-b754-6c41-91ae-029f790e1e23 Ancestors: FFI-Kernel-mt.151 Replaces the misnomer #asArray in ExternalStructure with a class-side #with: on ExternalData -- which fits the expected protocol for array creation. =============== Diff against FFI-Kernel-mt.151 =============== Item was added: + ----- Method: ExternalData class>>with: (in category 'instance creation') ----- + with: externalStructure + "Put externalStructure into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address." + + | contentType arrayType | + contentType := externalStructure externalType asNonPointerType. + + contentType isAtomic ifTrue: [ + ^ (contentType allocate: 1) + at: 1 put: externalStructure getHandle; + yourself]. + + arrayType := contentType asArrayType: 1. + + ^ ExternalData + fromHandle: externalStructure getHandle + type: arrayType! Item was removed: - ----- Method: ExternalStructure>>asArray (in category 'converting') ----- - asArray - "Convert the receiver into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address." - - | contentType arrayType | - contentType := self externalType asNonPointerType. - - contentType isAtomic ifTrue: [ - ^ (contentType allocate: 1) - at: 1 put: handle; - yourself]. - - arrayType := contentType asArrayType: 1. - self externalType isPointerType - ifTrue: [arrayType := arrayType asPointerType]. - - ^ ExternalData - fromHandle: handle - type: arrayType! Item was changed: ----- Method: ExternalStructure>>ffiEqual: (in category 'comparing') ----- ffiEqual: other "We can compare bytes if the types are compatible." (self ffiIdentical: other) ifTrue: [^ true]. self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false]. + ^ (ExternalData with: self) ffiEqual: (ExternalData with: other)! - ^ self asArray ffiEqual: other asArray! Item was changed: ----- Method: ExternalStructure>>ffiEqualityHash (in category 'comparing') ----- ffiEqualityHash ^ self ffiIdentityHash + bitXor: (ExternalData with: self) ffiEqualityHash! - bitXor: self asArray ffiEqualityHash! Item was changed: ----- Method: ExternalStructure>>postCopy (in category 'copying') ----- postCopy "Copy external memory into object memory, shallowCopy otherwise." self externalType isPointerType + ifTrue: [handle := (ExternalData with: self) postCopy getHandle] - ifTrue: [handle := self asArray postCopy getHandle] ifFalse: [handle := handle copy. "Materializes byte-array read-writer section if any"].! From commits at source.squeak.org Sun May 16 05:59:38 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 05:59:38 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.39.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.39.mcz ==================== Summary ==================== Name: FFI-Tests-mt.39 Author: mt Time: 16 May 2021, 7:59:36.04458 am UUID: 2a91569c-d035-c442-8ba5-0accd6901992 Ancestors: FFI-Tests-mt.38 Complements FFI-Kernel-mt.152 =============== Diff against FFI-Tests-mt.38 =============== Item was changed: ----- Method: FFIAllocateTests>>test06StructureAsArray (in category 'tests - structure') ----- test06StructureAsArray | sfi array element | sfi := self allocate: FFITestSfi. sfi f1: 2.5. sfi i2: 10. + array := ExternalData with: sfi reader. - array := sfi reader asArray. element := array first. self assert: (sfi ffiIdentical: element). self assert: (sfi ffiEqual: element). self assert: 2.5 equals: element f1. self assert: 10 equals: element i2.! From m at jaromir.net Sun May 16 10:21:15 2021 From: m at jaromir.net (Jaromir Matas) Date: Sun, 16 May 2021 05:21:15 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1621102564397-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> <1621002532100-0.post@n4.nabble.com> <1621102564397-0.post@n4.nabble.com> Message-ID: <1621160475891-0.post@n4.nabble.com> Hi Christoph, > I have just updated runUntilErrorOrReturnFrom.cs as proposed in [1], which > notifies the debugger about risky context manipulations such as #jump, > #swapSender:, and now also #resume:through:. I think that this is a more > holistic approach than #simulatedAboutToReturn:through:. Debugger implementation is still out of my league so at least a few observations: \1. You inserted `here push: nil` line into #runUntilErrorOrReturnFrom: I guess it's because you wanted to make it a top context but I thought #jump already takes care of that with its first line: `thisContext sender push: nil` Please correct me if I'm wrong, I'm very interested :) \2 Your #nextHandlerContext predates and thus removes Nicolas's changes made recently - is it just accidental or intentional? > > however the same problem remains on lower levels, i.e. for stepping over > > #return:through: and #resume:through: - same example, same incorrect > > behavior: > > I fully agree with this. While Nicolas's fix makes this particular > situation > easier to debug, IMHO it is only fighting the symptoms. In my opinion, we > should instead fix the underlying problem of dangling guard contexts in > #runUntilErrorOrReturnFrom:. I've tested your changeset against the famous example: `[self error] ensure: [^2]` If you step through until you get to ^2 and then step over the ^2 - you get the cannot return error again (without Nicolas's fix). My opinion is let's get this working using whichever approach (I was wondering if it would help to create a simulated version of #return:through: instead of #aboutToReturn:through:) and build on that. At least we'll have a better understanding of the mechanism :) Thanks and regards, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sun May 16 11:02:06 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 11:02:06 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.153.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.153.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.153 Author: mt Time: 16 May 2021, 1:02:04.676551 pm UUID: b7201890-f5ab-104b-bd0c-c4f82dca5af3 Ancestors: FFI-Kernel-mt.152 Yay! ^__^ Fixes the bug where alias-to-atomic types initialized the referentClass with the actual atomic instead of a proper handle (i.e. ByteArray or ExternalAddress). Note that this fix renders #isInternalMemory unnecessary, which I replaced with "isExternalAddress not". =============== Diff against FFI-Kernel-mt.152 =============== Item was removed: - ----- Method: ByteArray>>isInternalMemory (in category '*FFI-Kernel-testing') ----- - isInternalMemory - - ^ true! Item was changed: ----- Method: ByteArrayReadWriter class>>on: (in category 'instance creation') ----- on: handle "Wraps the given handle into a read-writer. Avoid double-wrapping." + self assert: [handle isExternalAddress not]. - self assert: [handle isInternalMemory]. ^ (thisContext objectClass: handle) == self ifTrue: [handle] ifFalse: [self new setArray: handle]! Item was removed: - ----- Method: ExternalAddress>>isInternalMemory (in category 'testing') ----- - isInternalMemory - - ^ false! Item was changed: ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset - | result | - result := handle - perform: (AtomicSelectors at: self atomicType) - with: byteOffset. ^ referentClass + ifNil: [ "Genuine atomics" + handle + perform: (AtomicSelectors at: self atomicType) + with: byteOffset] + ifNotNil: [ "Alias to atomics" + referentClass fromHandle: (handle + structAt: byteOffset + length: self byteSize)]! - ifNotNil: [referentClass fromHandle: result] - ifNil: [result]! Item was changed: ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value + ^ referentClass + ifNil: ["genuine atomic" + handle + perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol + with: byteOffset + with: value] + ifNotNil: ["type alias" + handle + structAt: byteOffset + put: value getHandle + length: self byteSize]! - ^ handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: (referentClass ifNil: [value] ifNotNil: [value getHandle])! Item was changed: ----- Method: ExternalAtomicType>>readAlias (in category 'external structure') ----- readAlias + ^ self readFieldAt: 1! - ^ '^ {1}handle{2}' - format: { - referentClass ifNil: [''] ifNotNil: [ - referentClass name, ' fromHandle: ']. - referentClass ifNotNil: [''] ifNil: [ - ' "', self writeFieldArgName, '"'] }! Item was changed: ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset + ^ referentClass + ifNil: [ "Genuine atomics" + '^ handle {1} {2}' + format: { + AtomicSelectors at: self atomicType. + byteOffset}] + ifNotNil: [ "Type alias" + '^ {1} fromHandle: (handle structAt: {2} length: {3})' + format: { + referentClass name. + byteOffset. + self byteSize}]! - ^ '^ {1}handle {2} {3}{4}' - format: { - referentClass ifNil: [''] ifNotNil: [ - referentClass name, ' fromHandle: (']. - AtomicSelectors at: self atomicType. - byteOffset. - referentClass ifNil: [''] ifNotNil: [')']}! Item was changed: ----- Method: ExternalAtomicType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName + ^ self writeFieldAt: 1 with: valueName! - ^ 'handle := {1}{2}.' - format: { - valueName. - referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was changed: ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName + ^ referentClass + ifNil: ["genuine atomics" + 'handle {1} {2} put: {3}.' + format: { + AtomicSelectors at: self atomicType. + byteOffset. + valueName}] + ifNotNil: ["type alias" + 'handle structAt: {1} put: {2} getHandle length: {3}.' + format: { + byteOffset. + valueName. + self byteSize}]! - ^ 'handle {1} {2} put: {3}{4}.' - format: { - AtomicSelectors at: self atomicType. - byteOffset. - valueName. - referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was changed: ----- Method: ExternalData class>>with: (in category 'instance creation') ----- with: externalStructure "Put externalStructure into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address." | contentType arrayType | contentType := externalStructure externalType asNonPointerType. - - contentType isAtomic ifTrue: [ - ^ (contentType allocate: 1) - at: 1 put: externalStructure getHandle; - yourself]. - arrayType := contentType asArrayType: 1. ^ ExternalData fromHandle: externalStructure getHandle type: arrayType! Item was changed: ----- Method: ExternalData>>writer (in category 'accessing') ----- writer "Overwritten to preserve type." + ^ handle isExternalAddress + ifTrue: [self] + ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type]! - ^ handle isInternalMemory - ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type] - ifFalse: [self]! Item was changed: ----- Method: ExternalPointerType>>readAlias (in category 'external structure') ----- readAlias + + ^ self asNonPointerType readAlias! - " - ExternalStructure defineAllFields. - " - ^ '^ {1} fromHandle: handle{2}' withCRs - format: { - (referentClass ifNil: [ExternalData]) name. - referentClass ifNotNil: [''] ifNil: [ - ' type: ', self asNonPointerType "content type" storeString]}! Item was changed: ----- Method: ExternalPointerType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName + ^ self asNonPointerType writeAliasWith: valueName! - ^ 'handle := {1} getHandle.' - format: {valueName}! Item was changed: ----- Method: ExternalStructure>>free (in category 'initialize-release') ----- free "Free the handle pointed to by the receiver" + handle isExternalAddress - self externalType isPointerType ifTrue: [handle isNull ifFalse: [handle free]] ifFalse: [handle := nil].! Item was changed: ----- Method: ExternalStructure>>isNull (in category 'testing') ----- isNull + ^ (handle isExternalAddress and: [handle isNull]) - ^ (self externalType isPointerType and: [handle isNull]) or: [handle isNil]! Item was removed: - ----- Method: ExternalStructure>>printIdentityOn: (in category 'printing') ----- - printIdentityOn: stream - "Reveal information about this external object's identity so that users can quickly assess the need for inspecting its contents. Users can also infer lifetime properties and consider those when passing this object around in the system." - - handle ifNil: [ - ^ stream nextPutAll: '']. - - self isNull ifTrue: [ - ^ stream nextPutAll: ''].! Item was changed: ----- Method: ExternalStructure>>printOn: (in category 'printing') ----- printOn: stream + handle isExternalAddress + ifTrue: [ + stream + nextPutAll: '@ '; + nextPutAll: self class name] + ifFalse: [ + stream + nextPutAll: '[ '; + nextPutAll: self class name; + nextPutAll: ' ]']. + self isNull ifTrue: [ + ^ stream nextPutAll: ''].! - | showBrackets | - showBrackets := self externalType isPointerType not. - - showBrackets ifTrue: [stream nextPutAll: '[']. - - super printOn: stream. - - showBrackets ifTrue: [stream nextPutAll: ']']. - - self printIdentityOn: stream.! Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer + ^ handle isExternalAddress + ifTrue: [self] + ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle)]! - ^ handle isInternalMemory - "Wrap handle into helper to address offsets in the byte array without copy." - ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)] - "Either alias-to-atomic or already in external memory." - ifFalse: [self]! Item was changed: ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') ----- zeroMemory "Remove all information but keep the memory allocated." + handle zeroMemory: self byteSize.! - self externalType isPointerType - ifTrue: [handle zeroMemory: self byteSize] - ifFalse: [self externalType isAtomic - ifFalse: [handle zeroMemory: self byteSize] - ifTrue: [handle := handle class zero]].! Item was changed: ----- Method: ExternalType>>allocate (in category 'external data') ----- allocate "Allocate a single representative for this type." + + | data | + data := self asNonPointerType allocate: 1. + ^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]! - - ^ (self asNonPointerType allocate: 1) first! Item was changed: ----- Method: ExternalType>>allocateExternal (in category 'external data') ----- allocateExternal "Allocate a single representative for this type in external memory." + | data | + data := self asNonPointerType allocateExternal: 1. + ^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]! - | result | - ^ [(result := self asNonPointerType allocateExternal: 1) first] - ensure: [ self isAtomic ifTrue: [result free] ]! Item was removed: - ----- Method: Object>>isInternalMemory (in category '*FFI-Kernel') ----- - isInternalMemory - "Return true if the receiver describes a region of memory (within Squeak's object memory) to be interpreted (e.g., as external structure, pointer, ...). NOTE that this backstop is in Object because atomic types store actual objects (e.g., numbers) as their handle." - - ^ false! From commits at source.squeak.org Sun May 16 11:03:45 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 11:03:45 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.40.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.40.mcz ==================== Summary ==================== Name: FFI-Tests-mt.40 Author: mt Time: 16 May 2021, 1:03:43.340551 pm UUID: ba595b70-5e3c-5f4e-ac74-7d780815f6c6 Ancestors: FFI-Tests-mt.39 Complements FFI-Kernel-mt.153 Tests for global variables pass now. :-) =============== Diff against FFI-Tests-mt.39 =============== Item was changed: ----- Method: FFIAllocateExternalTests>>checkAllocate: (in category 'running') ----- checkAllocate: externalObject | type handle | self assert: externalObject notNil. - (externalObject isExternalObject) - ifFalse: [ - externalObjects remove: externalObject. "skip free" - ^ self "atomics are fine"]. type := externalObject externalType. handle := externalObject getHandle. - (type isAtomic and: [type isVoid not]) ifTrue: [ - self deny: handle isExternalAddress. - self deny: handle isInternalMemory. - self deny: handle isNil. - ^ self]. - self deny: externalObject isNull. self deny: handle isNull. self deny: handle isNil. self assert: type isPointerType. + self assert: handle isExternalAddress.! - self assert: handle isExternalAddress. - - self deny: handle isInternalMemory.! Item was changed: ----- Method: FFIAllocateExternalTests>>checkFree: (in category 'running') ----- checkFree: externalObject | type handle | type := externalObject externalType. handle := externalObject getHandle. self assert: externalObject isNull. (type isTypeAlias and: [type isAtomic]) ifTrue: [ self assert: handle isNil. ^ self]. self assert: type isPointerType. self assert: handle isExternalAddress. - self deny: handle isInternalMemory. self assert: handle isNull.! Item was changed: ----- Method: FFIAllocateExternalTests>>expectedFailures (in category 'failures') ----- expectedFailures + ^ super expectedFailures - ^ (super expectedFailures copyWithoutAll: #( test04LinkedList "Storing pointers works fine." - )), #( - test03GlobalVariable "Atomic values in an alias container will be fetched immediately. Hmm..." )! Item was removed: - ----- Method: FFIAllocateExternalTests>>test03GlobalVariable (in category 'tests') ----- - test03GlobalVariable - "If you happen to have to address to a global variable you can use a type alias." - | global | - global := self allocate: FFITestAliasForInt32. - self assert: global getHandle isExternalAddress. - self assert: global externalType isPointerType. - self assert: 0 equals: global value. - global value: 42. - self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>checkAllocate: (in category 'running') ----- checkAllocate: externalObject | type handle | self assert: externalObject notNil. - (externalObject isExternalObject) - ifFalse: [ - externalObjects remove: externalObject. "skip free" - ^ self "pure atomics are fine"]. type := externalObject externalType. handle := externalObject getHandle. - (type isAtomic and: [type isVoid not]) ifTrue: [ - self deny: handle isExternalAddress. - self deny: handle isInternalMemory. - self deny: handle isNil. - ^ self]. - self deny: externalObject isNull. self deny: handle isNull. self deny: handle isNil. self deny: type isPointerType. + self deny: handle isExternalAddress.! - self deny: handle isExternalAddress. - - self assert: handle isInternalMemory.! Item was changed: ----- Method: FFIAllocateTests>>tearDown (in category 'running') ----- tearDown externalObjects do: [:externalObject | + externalObjects isExternalObject "i.e. not a RawBitsArray" + ifTrue: [ + externalObject free. + self checkFree: externalObject]].! - externalObject free. - self checkFree: externalObject].! Item was changed: ----- Method: FFIAllocateTests>>test01AllocateAtomics (in category 'tests - atomics') ----- test01AllocateAtomics self should: [(self allocate: ExternalType void)] raise: Error. + self assert: false equals: (self allocate: ExternalType bool) value. - self assert: false equals: (self allocate: ExternalType bool). + self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte") value. + self assert: 0 equals: (self allocate: ExternalType uint8_t "byte") value. - self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte"). - self assert: 0 equals: (self allocate: ExternalType uint8_t "byte"). + self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort") value. + self assert: 0 equals: (self allocate: ExternalType int16_t "short") value. - self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort"). - self assert: 0 equals: (self allocate: ExternalType int16_t "short"). + self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong") value. + self assert: 0 equals: (self allocate: ExternalType int32_t "long") value. - self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong"). - self assert: 0 equals: (self allocate: ExternalType int32_t "long"). + self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong") value. + self assert: 0 equals: (self allocate: ExternalType int64_t "longlong") value. - self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong"). - self assert: 0 equals: (self allocate: ExternalType int64_t "longlong"). + self assert: Character null equals: (self allocate: ExternalType schar) value. + self assert: Character null equals: (self allocate: ExternalType char) value. - self assert: Character null equals: (self allocate: ExternalType schar). - self assert: Character null equals: (self allocate: ExternalType char). + self assert: 0.0 equals: (self allocate: ExternalType float) value. + self assert: 0.0 equals: (self allocate: ExternalType double) value.! - self assert: 0.0 equals: (self allocate: ExternalType float). - self assert: 0.0 equals: (self allocate: ExternalType double).! Item was changed: ----- Method: FFIAllocateTests>>test02ArrayCopyFromTo (in category 'tests - array') ----- test02ArrayCopyFromTo "Copy a portion of an array into a new array." | points copy | points := self allocate: FFITestPoint2 size: 5. copy := points copyFrom: 2 to: 3. + self deny: copy getHandle isExternalAddress. - self assert: copy getHandle isInternalMemory. "We need a writer to modify internal memory." copy withIndexDo: [:point :index | point setX: index+1 setY: index+1]. self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]). "Check that we did not touch the original." self assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } equals: (points collect: [:each | each asPoint]).! Item was changed: ----- Method: FFIAllocateTests>>test03GlobalVariable (in category 'tests') ----- test03GlobalVariable "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." + + | global alias | - | global | global := self allocate: FFITestAliasForInt32. + self deny: global isFFIArray. self assert: 0 equals: global value. + + alias := global class fromHandle: global getHandle. + self assert: 0 equals: alias value. + + alias value: 42. + self assert: 42 equals: alias value. - global value: 42. self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>test04GlobalVariableInArray (in category 'tests') ----- test04GlobalVariableInArray "If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:." + + | global alias | + global := self allocate: ExternalType int32_t. - | global | - global := self allocate: ExternalType int32_t size: 1. self assert: global isFFIArray. self assert: 0 equals: global value. + + alias := global class fromHandle: global getHandle. + alias setContentType: global contentType. + self assert: 0 equals: alias value. + + alias value: 42. + self assert: 42 equals: alias value. - global value: 42. self assert: 42 equals: global value.! Item was changed: ----- Method: FFIAllocateTests>>test10ArrayClasses (in category 'tests - array') ----- test10ArrayClasses "For integer and float types, allocate arrays and check for specific array classes. Then construct a conventional byte array for an external data structure. A copy should also convert into a specific array class with the same contents." ExternalType useArrayClassesDuring: [ ExternalType atomicTypes do: [:contentType | (contentType isIntegerType or: [contentType isFloatType] or: [contentType isCharType]) ifTrue: [ | array arrayType data copy | array := self allocate: contentType size: 5. arrayType := array externalType. self assert: array isFFIArray. self assert: 5 equals: array size. self assert: array byteSize equals: arrayType byteSize. contentType = ExternalType signedChar ifFalse: [ self flag: #discuss. "mt: What is signedChar even for?" self assert: contentType equals: array contentType]. self deny: array isNull. self deny: (array isKindOf: ExternalData). self assert: array equals: array getHandle. + self shouldnt: [array at: 1 put: contentType allocate first] raise: Error. - self shouldnt: [array at: 1 put: contentType allocate] raise: Error. self shouldnt: [array zeroMemory] raise: Error. self should: [array setContentType: ExternalType byte] raise: Error. self should: [array setSize: 42] raise: Error. data := ExternalData fromHandle: (ByteArray new: arrayType byteSize) type: arrayType. copy := data copy. "From external data into raw-bits array." self deny: array equals: data. self assert: array equals: copy. ]]].! From commits at source.squeak.org Sun May 16 11:04:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 11:04:46 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.31.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.31.mcz ==================== Summary ==================== Name: FFI-Tools-mt.31 Author: mt Time: 16 May 2021, 1:04:44.550551 pm UUID: d9289a3f-d78b-aa45-a291-5b027280ca12 Ancestors: FFI-Tools-mt.30 Complements FFI-Kernel-mt.153 =============== Diff against FFI-Tools-mt.30 =============== Item was changed: ----- Method: ExternalObjectHandleWrapper>>objectString (in category 'accessing') ----- objectString | label handle skipLimit | label := super objectString. handle := self getHandle. skipLimit := 16. + ^ handle isExternalAddress ifTrue: [label] ifFalse: [ + (thisContext objectClass: handle) == ByteArrayReadWriter - handle isExternalAddress ifTrue: [^ label]. - handle isInternalMemory ifTrue: [ - ^ (thisContext objectClass: handle) == ByteArrayReadWriter ifFalse: [label] ifTrue: [ | begin end tokens | label :=(thisContext object: handle instVarAt: 3) "byteArray" printString. label := label copyFrom: 3 to: (label size - 1). begin := (thisContext object: handle instVarAt: 1) "byteOffset" + 1. end := begin - 1 + (thisContext object: handle instVarAt: 2) "byteSize". String streamContents: [:stream | stream nextPutAll: '#[ '. tokens := label findTokens: ' ' "#[0 0 0 0 0]". begin > skipLimit ifTrue: [ stream nextPutAll: '. . ', (begin - 1) asString, ' bytes . . '. tokens := tokens allButFirst: begin - 1. end := end - begin + 1. begin := 1]. (1 to: end) do: [:index | | token | token := tokens at: index. index >= begin ifTrue: [stream nextPutAll: token] ifFalse: ["Skip byte info" stream nextPut: $.]. stream space]. (tokens size - end + 1) > skipLimit ifTrue: [ stream nextPutAll: '. . ', (tokens size - end) asString, ' bytes . . '. tokens := tokens allButLast: tokens size - end. end := tokens size]. (tokens size - end) timesRepeat: [ "Skip byte info" stream nextPut: $.. stream space]. stream nextPutAll: ']'. + ]]].! - ]]]. - - "Type aliases to atomic types store primitive Smalltalk objects in their handle. Indicate that role of actually being a handle for the FFI plugin with a small prefix." - ^ '-> ', label! From commits at source.squeak.org Sun May 16 12:31:17 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 12:31:17 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.41.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.41.mcz ==================== Summary ==================== Name: FFI-Tests-mt.41 Author: mt Time: 16 May 2021, 2:31:15.844808 pm UUID: adf2f023-0388-9345-b404-41adb308b192 Ancestors: FFI-Tests-mt.40 Adds a minor test to check whether we can read smaller integer types from space allocated for bigger integer types. =============== Diff against FFI-Tests-mt.40 =============== Item was removed: - ----- Method: FFIAllocateTests>>test01AllocateAtomics (in category 'tests - atomics') ----- - test01AllocateAtomics - - self should: [(self allocate: ExternalType void)] raise: Error. - self assert: false equals: (self allocate: ExternalType bool) value. - - self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte") value. - self assert: 0 equals: (self allocate: ExternalType uint8_t "byte") value. - - self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort") value. - self assert: 0 equals: (self allocate: ExternalType int16_t "short") value. - - self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong") value. - self assert: 0 equals: (self allocate: ExternalType int32_t "long") value. - - self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong") value. - self assert: 0 equals: (self allocate: ExternalType int64_t "longlong") value. - - self assert: Character null equals: (self allocate: ExternalType schar) value. - self assert: Character null equals: (self allocate: ExternalType char) value. - - self assert: 0.0 equals: (self allocate: ExternalType float) value. - self assert: 0.0 equals: (self allocate: ExternalType double) value.! Item was added: + ----- Method: FFIAllocateTests>>test01AtomicsAllocated (in category 'tests - atomics') ----- + test01AtomicsAllocated + + self should: [(self allocate: ExternalType void)] raise: Error. + self assert: false equals: (self allocate: ExternalType bool) value. + + self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte") value. + self assert: 0 equals: (self allocate: ExternalType uint8_t "byte") value. + + self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort") value. + self assert: 0 equals: (self allocate: ExternalType int16_t "short") value. + + self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong") value. + self assert: 0 equals: (self allocate: ExternalType int32_t "long") value. + + self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong") value. + self assert: 0 equals: (self allocate: ExternalType int64_t "longlong") value. + + self assert: Character null equals: (self allocate: ExternalType schar) value. + self assert: Character null equals: (self allocate: ExternalType char) value. + + self assert: 0.0 equals: (self allocate: ExternalType float) value. + self assert: 0.0 equals: (self allocate: ExternalType double) value.! Item was added: + ----- Method: FFIAllocateTests>>test02AtomicsReinterpreted (in category 'tests - atomics') ----- + test02AtomicsReinterpreted + + #( + int8_t int16_t minVal + int8_t int16_t maxVal + int16_t int32_t minVal + int16_t int32_t maxVal + int32_t int64_t minVal + int32_t int64_t maxVal + ) groupsDo: [:smallIntegerTypeName :bigIntegerTypeName :valueSelector | + | smallIntegerType bigIntegerType value data | + smallIntegerType := ExternalType typeNamed: smallIntegerTypeName. + bigIntegerType := ExternalType typeNamed: bigIntegerTypeName. + value := smallIntegerType perform: valueSelector. + data := self allocate: bigIntegerType. + data value: value. + data setContentType: smallIntegerType. + self assert: value equals: data value]! From commits at source.squeak.org Sun May 16 12:32:16 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 12:32:16 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.15.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.15.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.15 Author: mt Time: 16 May 2021, 2:32:14.911808 pm UUID: 97d29055-72c1-8f47-b15f-1584f2f776d0 Ancestors: FFI-Callbacks-mt.14 Fixes regression in callbacks on 64-bit platforms. =============== Diff against FFI-Callbacks-mt.14 =============== Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext integerArguments. intPos := 0. floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) + ifTrue: [intPos := intPos + 1. intArgs at: intPos] - ifTrue: [intPos := intPos + 1. intArgs setContentType: argType. (intArgs at: intPos) value] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data + ifNotNil: [ "1b) Read pointers from register value." + isPointer ifFalse: ["data is already an integer"] ifTrue: [ + data := (ExternalData + fromHandle: (ExternalAddress fromInteger: data) + type: argType asNonPointerType "contentType" size: 1) value]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := (argType handle: handle at: byteOffset) value. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( (thunkp 'void*') + (stackPtr 'byte*') "was: char*" - (stackPtr 'intptr_t*') "was: char*" (intRegArgs 'intptr_t*') "was: long* or int*" (floatRegArgs 'double*') (nil 'void*') "was: savedCStackPointer" (nil 'void*') "was: savedCFramePointer" (rvs 'FFICallbackResult') (nil 'void*') "was: savedPrimFunctionPointer" (outerContext 'FFICallbackContext*') "jmp_buf trampoline --- for debugging only?" ) " typedef struct { void *thunkp; char *stackptr; long *intRegArgs; double *floatRegArgs; void *savedCStackPointer; void *savedCFramePointer; union { intptr_t vallong; struct { int low, high; } valleint64; struct { int high, low; } valbeint64; double valflt64; struct { void *addr; intptr_t size; } valstruct; } rvs; void *savedPrimFunctionPointer; jmp_buf trampoline; jmp_buf savedReenterInterpreter; } VMCallbackContext; "! From commits at source.squeak.org Sun May 16 12:36:38 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 12:36:38 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.154.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.154.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.154 Author: mt Time: 16 May 2021, 2:36:37.104023 pm UUID: 715aa829-6097-0747-ac0b-5bab5ef55344 Ancestors: FFI-Kernel-mt.153 Fixes minor slip. :-) =============== Diff against FFI-Kernel-mt.153 =============== Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes." AtomicTypes := nil. StructTypes := nil. ArrayTypes := nil. ArrayClasses := nil. self initializeDefaultTypes. + self initializeArrayClasses. self resetAllStructureTypes.! From herbertkoenig at gmx.net Sun May 16 12:38:35 2021 From: herbertkoenig at gmx.net (=?UTF-8?Q?Herbert_K=c3=b6nig?=) Date: Sun, 16 May 2021 14:38:35 +0200 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: Thanks Ken, thank you for sharing. That's a lot like I'm working. I am a bit too impatient for the loading times (assuming you presented on a 'normal' computer and me often using a Pi down to A+) but I still can save images so I think that would be ok. What about Projects and  Flaps, can they be added to Cuis? Cheers, Herbert Am 15.05.2021 um 21:48 schrieb ken.dickey at whidbey.com: > For those of you in different time zones who have an interest.. > > The "More Direct Morphic" talk starts a bit after 18 minutes in: > >   https://www.youtube.com/watch?v=BqWuUpXzQt8 > > Enjoy, > -KenD > From lewis at mail.msen.com Sun May 16 15:10:00 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Sun, 16 May 2021 11:10:00 -0400 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: Message-ID: <20210516151000.GA16478@shell.msen.com> On Fri, May 07, 2021 at 07:39:50PM +0000, commits at source.squeak.org wrote: > Nicolas Cellier uploaded a new version of Kernel to project The Trunk: > http://source.squeak.org/trunk/Kernel-nice.1402.mcz > > > Musing is more powerful than dumb static and coverage tests, I wish I got more time for musing :) > We deadly need evolutive testing (neural based). > Interesting commit comment. How might this work? Dave From christoph.thiede at student.hpi.uni-potsdam.de Sun May 16 16:40:59 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Sun, 16 May 2021 11:40:59 -0500 (CDT) Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> Message-ID: <1621183259431-0.post@n4.nabble.com> Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Sun May 16 17:06:31 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 17:06:31 0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1407.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1407.mcz ==================== Summary ==================== Name: Kernel-ct.1407 Author: ct Time: 16 May 2021, 7:06:28.57708 pm UUID: 8efbcb28-1774-174b-9fe0-17609ca53503 Ancestors: Kernel-nice.1402 Fixes #isPrimFailToken: for objects that do not implement #isArray in a conventional way, or that do not implement it all. The following should be debuggable without any problems, but currently is not due to a regression in Kernel-eem.1366. Fur more information, see: http://forum.world.st/The-Trunk-Kernel-eem-1366-mcz-td5126558.html =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>isPrimFailToken: (in category 'private') ----- isPrimFailToken: contextOrPrimFailToken "Answer if contextOrPrimFailToken, which will either be a Context object or a primitive fail token (a tuple of the PrimitiveFailToken unique object and a primitive failure code), is the latter. This should only be used with the (possibly indirect) results of Context>>doPrimitive:method:receiver:args:" + ^ (self objectClass: contextOrPrimFailToken) == Array - ^contextOrPrimFailToken isArray and: [contextOrPrimFailToken size = 2 and: [(contextOrPrimFailToken at: 1) == PrimitiveFailToken]]! From Christoph.Thiede at student.hpi.uni-potsdam.de Sun May 16 17:07:25 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Sun, 16 May 2021 17:07:25 +0000 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: <1621183259431-0.post@n4.nabble.com> References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> , <1621183259431-0.post@n4.nabble.com> Message-ID: Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim at rowledge.org Sun May 16 18:13:20 2021 From: tim at rowledge.org (tim Rowledge) Date: Sun, 16 May 2021 11:13:20 -0700 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: > On 2021-05-16, at 5:38 AM, Herbert König wrote: > > What about Projects and Flaps, can they be added to Cuis? I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent From commits at source.squeak.org Sun May 16 18:29:25 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 16 May 2021 18:29:25 0000 Subject: [squeak-dev] The Inbox: System-ct.1233.mcz Message-ID: A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-ct.1233.mcz ==================== Summary ==================== Name: System-ct.1233 Author: ct Time: 16 May 2021, 8:29:18.906267 pm UUID: da744348-52c0-3a4b-9f66-26ce81d8af02 Ancestors: System-nice.1232 Makes TextDiffBuilder capable of building string patches (that use +/- prefixes instead of text attributes) or combined patches that use both prefixes and attributes. Usage: | aTextDiffBuilder | aTextDiffBuilder := TextDiffBuilder from: 'Hello world\Squeak is great\Carpe Squeak!' withCRs to: 'Hello world\Squeak is awesine\Carpe Squeak!' withCRs. aTextDiffBuilder buildStringPatch edit. aTextDiffBuilder buildPrefixedDisplayPatch edit. aTextDiffBuilder buildDisplayPatch edit. "classic" =============== Diff against System-nice.1232 =============== Item was added: + ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category 'standard queries') ----- + allowEtoyUserCustomEvents + ^ self + valueOfFlag: #allowEtoyUserCustomEvents + ifAbsent: [false]! Item was added: + ----- Method: TextDiffBuilder class>>insertTextAttributes (in category 'as yet unclassified') ----- + insertTextAttributes + + ^ InsertTextAttributes ifNil: [InsertTextAttributes := + self userInterfaceTheme insertTextAttributes + ifNil: [{TextColor red}]]! Item was added: + ----- Method: TextDiffBuilder class>>normalTextAttributes (in category 'as yet unclassified') ----- + normalTextAttributes + + ^ NormalTextAttributes ifNil: [NormalTextAttributes := + self userInterfaceTheme normalTextAttributes + ifNil: [{TextEmphasis normal}]]! Item was added: + ----- Method: TextDiffBuilder class>>removeTextAttributes (in category 'as yet unclassified') ----- + removeTextAttributes + + ^ RemoveTextAttributes ifNil: [RemoveTextAttributes := + self userInterfaceTheme removeTextAttributes + ifNil: [{TextEmphasis struckOut. TextColor blue}]]! Item was changed: ----- Method: TextDiffBuilder>>buildDisplayPatch (in category 'creating patches') ----- buildDisplayPatch + ^ self buildPatchWithAttributes: true withPrefixes: false! - | stream result | - stream := AttributedTextStream new. - - "Lazy initialize the text attributes cache." - NormalTextAttributes ifNil: [NormalTextAttributes := self userInterfaceTheme normalTextAttributes - ifNil: [{TextEmphasis normal}]]. - InsertTextAttributes ifNil: [InsertTextAttributes := self userInterfaceTheme insertTextAttributes - ifNil: [{TextColor red}]]. - RemoveTextAttributes ifNil: [RemoveTextAttributes := self userInterfaceTheme removeTextAttributes - ifNil: [{TextEmphasis struckOut. TextColor blue}]]. - - self - patchSequenceDoIfMatch: [ :string | - self print: string withAttributes: NormalTextAttributes on: stream ] - ifInsert: [ :string | - self print: string withAttributes: InsertTextAttributes on: stream ] - ifRemove: [ :string | - self print: string withAttributes: RemoveTextAttributes on: stream ]. - result := stream contents. - (result notEmpty - and: [result last = Character cr - and: [(self lastIsCR: xLines) not - and: [(self lastIsCR: yLines) not]]]) ifTrue: - [result := result allButLast]. - ^result! Item was added: + ----- Method: TextDiffBuilder>>buildPatch (in category 'creating patches') ----- + buildPatch + + | result | + result := String streamContents: [:stream | + self + patchSequenceDoIfMatch: [:string | + self print: string on: stream] + ifInsert: [:string | + self print: '+ ' , string on: stream] + ifRemove: [:string | + self print: '- ' , string on: stream]]. + (result notEmpty + and: [result last = Character cr + and: [(self lastIsCR: xLines) not + and: [(self lastIsCR: yLines) not]]]) ifTrue: + [result := result allButLast]. + ^ result! Item was added: + ----- Method: TextDiffBuilder>>buildPatchWithAttributes:withPrefixes: (in category 'creating patches') ----- + buildPatchWithAttributes: useAttributes withPrefixes: usePrefixes + + | stream result | + stream := useAttributes ifFalse: [WriteStream on: String new] ifTrue: [AttributedTextStream new]. + + self + patchSequenceDoIfMatch: [:string | + useAttributes ifTrue: [stream currentAttributes: self class normalTextAttributes]. + self print: string on: stream] + ifInsert: [:string | + useAttributes ifTrue: [stream currentAttributes: self class insertTextAttributes]. + usePrefixes ifTrue: [string := '+ ' , string]. + self print: string on: stream] + ifRemove: [:string | + useAttributes ifTrue: [stream currentAttributes: self class removeTextAttributes]. + usePrefixes ifTrue: [string := '- ' , string]. + self print: string on: stream]. + result := stream contents. + + (result notEmpty + and: [result last = Character cr + and: [(self lastIsCR: xLines) not + and: [(self lastIsCR: yLines) not]]]) ifTrue: + [result := result allButLast]. + + ^ result! Item was added: + ----- Method: TextDiffBuilder>>buildPrefixedDisplayPatch (in category 'creating patches') ----- + buildPrefixedDisplayPatch + + ^ self buildPatchWithAttributes: true withPrefixes: true! Item was added: + ----- Method: TextDiffBuilder>>buildStringPatch (in category 'creating patches') ----- + buildStringPatch + + ^ self buildPatchWithAttributes: false withPrefixes: true! Item was added: + ----- Method: TextDiffBuilder>>print:on: (in category 'private') ----- + print: aString on: stream + + stream nextPutAll: aString. + (aString notEmpty and: [ + aString last = Character cr or: [ + aString endsWith: String crlf ] ]) + ifFalse: [ stream cr ]! Item was changed: ----- Method: TextDiffBuilder>>print:withAttributes:on: (in category 'private') ----- print: aString withAttributes: attributes on: stream + self deprecated. + stream currentAttributes: attributes. + ^ self print: aString on: stream! - stream - currentAttributes: attributes; - nextPutAll: aString. - (aString notEmpty and: [ - aString last = Character cr or: [ - aString endsWith: String crlf ] ]) - ifFalse: [ stream cr ]! From herbertkoenig at gmx.net Sun May 16 18:57:54 2021 From: herbertkoenig at gmx.net (=?UTF-8?Q?Herbert_K=c3=b6nig?=) Date: Sun, 16 May 2021 20:57:54 +0200 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: Am 16.05.2021 um 20:13 schrieb tim Rowledge: > >> On 2021-05-16, at 5:38 AM, Herbert König wrote: >> >> What about Projects and Flaps, can they be added to Cuis? > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. Hi Tim, not sure about popularity and as you see I'm happy to use older versions. And I do little coding in Squeak nowadays. It's still a great tool for thought though. Actually the below is for discussing some electronics with a customer. He (non technical person) can use it because each project has a button 'Back to overview'. I have more complex stuff. :-) These are quickly built and I hoped that 'More Direct Morpic' even might make it quicker. (It would with projects and flaps to move stuff between projects.) Any alternatives in Squeak I am missing? Cheers, Herbert > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: bidfmhdkapdbjffg.png Type: image/png Size: 611836 bytes Desc: not available URL: From herbertkoenig at gmx.net Sun May 16 19:01:08 2021 From: herbertkoenig at gmx.net (=?UTF-8?Q?Herbert_K=c3=b6nig?=) Date: Sun, 16 May 2021 21:01:08 +0200 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: <5cb13538-073a-c24e-7907-65a906fa95db@gmx.net> And your signature generator had the right choice again :-)) Herbert Am 16.05.2021 um 20:13 schrieb tim Rowledge: > >> On 2021-05-16, at 5:38 AM, Herbert König wrote: >> >> What about Projects and Flaps, can they be added to Cuis? > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. > > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent > > > > > From tim at rowledge.org Sun May 16 23:09:59 2021 From: tim at rowledge.org (tim Rowledge) Date: Sun, 16 May 2021 16:09:59 -0700 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: > On 2021-05-16, at 11:57 AM, Herbert König wrote: > Actually the below is for discussing some electronics with a customer. He (non technical person) can use it because each project has a button 'Back to overview'. I have more complex stuff. :-) These are quickly built and I hoped that 'More Direct Morpic' even might make it quicker. (It would with projects and flaps to move stuff between projects.) > > Any alternatives in Squeak I am missing? > > Cheers, > > Herbert > Interesting use of Projects. You linked them up visually with Connectors, right? > > And your signature generator had the right choice again :-)) I sometimes worry about whether it has become sentient. And what does that mean when I reboot the Mac? See also the season 2 first episode of 'Love Death and Robots' tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: RLBM: Ruin Logic Board Multiple From marcel.taeumel at hpi.de Mon May 17 05:54:59 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 07:54:59 +0200 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> Message-ID: Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html [http://forum.world.st/Squeak-Dev-f45488.html] -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Mon May 17 06:08:53 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 08:08:53 +0200 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> Message-ID: > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html [http://forum.world.st/Squeak-Dev-f45488.html] -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Mon May 17 06:45:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 06:45:08 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.155.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.155.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.155 Author: mt Time: 17 May 2021, 8:45:06.479407 am UUID: bf403e45-81e8-cf42-8cbf-1cbede10602d Ancestors: FFI-Kernel-mt.154 Adds endianness to platform description. =============== Diff against FFI-Kernel-mt.154 =============== Item was changed: Object subclass: #FFIPlatformDescription + instanceVariableNames: 'name osVersion subtype wordSize endianness' - instanceVariableNames: 'name osVersion subtype wordSize' classVariableNames: 'LastPlatform' poolDictionaries: '' category: 'FFI-Kernel-Support'! !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0! This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions). 1. DETECT PLATFORM CHANGE ON STARTUP This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType. 2. PLATFORM SPECIFICITY Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are: platform name > osVersion > subtype > wordSize So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize. 3. PLATFORM COMPATIBILITY Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible. Here is an interesting edge case of two compatible platform descriptions: | p1 p2 | p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil. p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8. p1 isCompatibleWith: p2. Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools. 4. FURTHER READING - all references to FFIPlatformDescription - all senders of #wordSize - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject ! Item was added: + ----- Method: FFIPlatformDescription class>>currentEndianness (in category 'accessing') ----- + currentEndianness + "self currentEndianness" + + ^ Smalltalk os endianness! Item was added: + ----- Method: FFIPlatformDescription>>endianness (in category 'accessing') ----- + endianness + + ^ endianness ifNil: [endianness := self class currentEndianness]! Item was added: + ----- Method: FFIPlatformDescription>>endianness: (in category 'accessing') ----- + endianness: aSymbol + + endianness := aSymbol.! From commits at source.squeak.org Mon May 17 06:45:25 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 06:45:25 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.16.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.16.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.16 Author: mt Time: 17 May 2021, 8:45:23.735407 am UUID: 7cb4579e-eff0-064d-85e6-1d350169cbee Ancestors: FFI-Callbacks-mt.15 Complements FFI-Kernel-mt.155 =============== Diff against FFI-Callbacks-mt.15 =============== Item was removed: - ----- Method: FFIPlatformDescription>>endianness (in category '*FFI-Callbacks') ----- - endianness - - ^ Smalltalk endianness! From commits at source.squeak.org Mon May 17 06:48:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 06:48:01 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.156.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.156.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.156 Author: mt Time: 17 May 2021, 8:47:59.239407 am UUID: 8a83dbdc-1aed-e943-a350-efcdfe3b945f Ancestors: FFI-Kernel-mt.155 Allow empty array types so that code loading can work. Since structure types are initialized only partially when referenced in an FFI call, this must be possible for array types too, which can reference to those not-yet-fully-initialized struct types as content type. =============== Diff against FFI-Kernel-mt.155 =============== Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self flag: #contentVsContainer; assert: [contentType isTypeAlias or: [contentType isArrayType not]] description: 'No support for direct multi-dimensional containers yet. Use type aliases.'. self - assert: [contentType byteSize > 0] "No arrays of empty structs or void type." - description: 'No array types for empty structs or void type!!'. - - self assert: [ (ArrayTypes at: contentType typeName ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] ifAbsent: [nil] ) isNil] description: 'Array type already exists. Use #typeNamed: to access it.'. type := ExternalArrayType basicNew. pointerType := ExternalPointerType basicNew. "1) Regular type" byteSize := numElements ifNil: [0] ifNotNil: [numElements * contentType byteSize]. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); setReferentClass: contentType referentClass; setContentType: contentType; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); byteAlignment: self pointerAlignment; setReferentClass: nil. "3) Remember this new array type." (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) at: numElements put: type. ^ type! From tonyg at leastfixedpoint.com Mon May 17 07:15:31 2021 From: tonyg at leastfixedpoint.com (Tony Garnock-Jones) Date: Mon, 17 May 2021 09:15:31 +0200 Subject: [squeak-dev] Flaps aren't dead! They feel happy! (was Re: "More Direct Morphic": The Movie) In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: I use flaps! Specifically, in my experimentation with squeak-on-a-cellphone, I put the on screen keyboard in a flap, and open the flap automatically whenever keyboard focus switches to something non-nil: newKeyboardFocus: aMorphOrNil aMorphOrNil ifNil: [OnScreenKeyboardMorph hideFlap] ifNotNil: [(OnScreenKeyboardMorph future: 200) raiseFlap]. ^ super newKeyboardFocus: aMorphOrNil. It works surprisingly well for this. Being able to adjust the height of the keyboard by moving the flap, etc. Cheers, Tony On 5/16/21 8:13 PM, tim Rowledge wrote: > > >> On 2021-05-16, at 5:38 AM, Herbert König wrote: >> >> What about Projects and Flaps, can they be added to Cuis? > > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. > > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent > > > > > From commits at source.squeak.org Mon May 17 08:03:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 08:03:49 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.157.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.157.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.157 Author: mt Time: 17 May 2021, 10:03:47.21887 am UUID: eee9f199-4910-6b4b-b9b5-1c793d7ce342 Ancestors: FFI-Kernel-mt.156 Fixes some bugs with empty array types during code loading. =============== Diff against FFI-Kernel-mt.156 =============== Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self flag: #contentVsContainer; assert: [contentType isTypeAlias or: [contentType isArrayType not]] description: 'No support for direct multi-dimensional containers yet. Use type aliases.'. self + assert: [contentType isVoid not] + description: 'No array types for void type!!'. + + self assert: [ (ArrayTypes at: contentType typeName ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] ifAbsent: [nil] ) isNil] description: 'Array type already exists. Use #typeNamed: to access it.'. type := ExternalArrayType basicNew. pointerType := ExternalPointerType basicNew. "1) Regular type" byteSize := numElements ifNil: [0] ifNotNil: [numElements * contentType byteSize]. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); setReferentClass: contentType referentClass; setContentType: contentType; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); byteAlignment: self pointerAlignment; setReferentClass: nil. "3) Remember this new array type." (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) at: numElements put: type. ^ type! Item was changed: ----- Method: ExternalArrayType>>isTypeAlias (in category 'testing') ----- isTypeAlias + self isUnknownType ifTrue: [^ false]. + ^ self isArrayOfArrays not and: [referentClass notNil and: [referentClass isTypeAlias and: [referentClass originalType isArrayType]]]! Item was changed: ----- Method: ExternalArrayType>>isUnknownType (in category 'testing') ----- isUnknownType + "Array of unknown type is also an unknown type." + + ^ self contentType isUnknownType! - - ^ false! Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling "Base class changed to something that is an external structure now." + [self compileFields] ifError: [ "Ignore unfinished field specs" ]. + self externalType isUnknownType ifTrue: [self externalType becomeKnownType].! - [self compileFields] ifError: [ "Ignore unfinished field specs" ].! Item was changed: ----- Method: ExternalUnknownType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- + newTypeForUnknownNamed: label - newTypeForUnknownNamed: typeName + | typeName type pointerType | + typeName := label asSymbol. - | type pointerType | self assert: [(StructTypes includesKey: typeName) not] description: 'Type already exists. Use #typeNamed: to access it.'. type := ExternalUnknownType basicNew compiledSpec: (WordArray with: self structureSpec); + byteAlignment: 0; "dummy until #newReferentClass: is called" + setReferentClass: typeName; yourself. self assert: [type isEmpty]. pointerType := ExternalPointerType basicNew compiledSpec: (WordArray with: self pointerSpec); byteAlignment: self pointerAlignment; yourself. self assert: [pointerType isPointerType]. "Connect non-pointer type with pointer type." type setReferencedType: pointerType. pointerType setReferencedType: type. "Remember this new struct type." + StructTypes at: typeName put: type. - StructTypes at: typeName asSymbol put: type. ^ type! Item was changed: ----- Method: ExternalUnknownType>>typeName (in category 'accessing') ----- typeName + self assert: [referentClass isSymbol]. + ^ referentClass "Usually just the name of the class."! - self shouldNotImplement.! From commits at source.squeak.org Mon May 17 08:04:16 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 08:04:16 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.42.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.42.mcz ==================== Summary ==================== Name: FFI-Tests-mt.42 Author: mt Time: 17 May 2021, 10:04:14.48387 am UUID: 7e88afc9-7a32-ee42-a024-591c91ea8b4a Ancestors: FFI-Tests-mt.41 Complements FFI-Kernel-mt.157 =============== Diff against FFI-Tests-mt.41 =============== Item was changed: ----- Method: ExternalTypeTests>>testArrayOfUnknown (in category 'tests - unkown types') ----- testArrayOfUnknown + "For missing a referentClass, an unknown type will be constructed." - "For missing referentClass, one can safely try to lookup an array type but forcing its creation will raise an error. Note that it is not possible to embed an array type for a struct in itself. You MUST use pointer types for that." + | type | + Smalltalk garbageCollect. + ExternalType cleanupUnusedTypes. + + self assert: nil equals: (ExternalType typeNamed: 'UnknownStruct[]'). + self assert: nil equals: (ExternalType typeNamed: 'UnknownStruct[5]'). + + type := ExternalType newTypeNamed: 'UnknownStruct[5]'. + self assert: type isArrayType. + self assert: type isUnknownType. + + type := ExternalType newTypeNamed: 'UnknownStruct[]'. + self assert: type isArrayType. + self assert: type isUnknownType. + + "Already there." + self should: [ExternalType newTypeNamed: 'UnknownStruct[]'] raise: Error. + self should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] raise: Error. + ! - self - assert: nil - equals: (ExternalType typeNamed: 'UnknownStruct[5]'). - - self - should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] - raise: Error.! Item was changed: ----- Method: FFIAllocateTests>>test04ArrayCompositeAccess (in category 'tests - array') ----- test04ArrayCompositeAccess | data | data := FFITestSdA5i allocate. + self assert: 0 equals: data a5i2 first. - self assert: data a5i2 first equals: 0. data writer a5i2 at: 1 put: 42. + self assert: 42 equals: data a5i2 first.! - self assert: data a5i2 first equals: 42.! From lists at fniephaus.com Mon May 17 08:52:10 2021 From: lists at fniephaus.com (Fabio Niephaus) Date: Mon, 17 May 2021 10:52:10 +0200 Subject: [squeak-dev] Changeset: fix-generic-inspectOne-with-truncation.cs In-Reply-To: References: Message-ID: Thanks, Christoph! The changeset looks good to me and fixes our issue. Nonetheless, it's probably better if Marcel reviews and merges it. Marcel, could you have a look please? Many thanks, Fabio On Fri, May 14, 2021 at 4:29 PM Thiede, Christoph wrote: > > Hi all! > > > Jan Ehmueller and Fabio (fn) have discovered an Inspector bug with #inspectOne/"inspect element..." in the field list menu that hindered users from entering the index of a truncated element in the inspect element dialog. Possible ways to reproduce the issue include: > > > Inspector openOn: (Array new: 1024) -> … -> Click -> 90 -> Enter > (SmalltalkImage>>#snapshot:andQuit:withExitCode:embedded:) inspect -> right click self -> inspect element... -> 450 -> Enter (might depend on Sista) > TruffleSqueak was also affected: https://github.com/hpi-swa/trufflesqueak/issues/143 > > > The attached changeset attempts to fix the bug. > > Changelog: > > Problem: The variant of Inspector >> #inspectOne, as it is now in the trunk, fails if the key is the value for a field that has been truncated. Because in this place, explicitly only the keys of self fields are passed to #inspectOneOf: which are already truncated. The bug does not affect CollectionInspectors which passes the elementIndices directly to #inspectOneOf: without the need of having fields. > Solution: I have now essentially pushed this logic from CollectionInspector with #elementIndices up to Inspector. This should make it run again. > > Please review and merge if you don't have any further objections. :-) > > Best, > Christoph > > From commits at source.squeak.org Mon May 17 09:54:33 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 09:54:33 0000 Subject: [squeak-dev] The Trunk: ReleaseBuilder-mt.216.mcz Message-ID: Marcel Taeumel uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-mt.216.mcz ==================== Summary ==================== Name: ReleaseBuilder-mt.216 Author: mt Time: 17 May 2021, 11:54:31.046498 am UUID: bd03b00b-059f-d449-ac56-b22783dc4766 Ancestors: ReleaseBuilder-mt.215 Fixes regression in recent reset of pragma preferences. Enable "browse with drag-n-drop" by default. =============== Diff against ReleaseBuilder-mt.215 =============== Item was changed: ----- Method: ReleaseBuilder class>>setPreferences (in category 'scripts') ----- setPreferences "Preferences class defaultValueTableForCurrentRelease" " Preferences outOfTheBox." "<-- uncomment after #defaultValueTableForCurrentRelease is fixed up." "General User interaction" Preferences enable: #generalizedYellowButtonMenu ; enable: #swapMouseButtons; disable: #mouseOverForKeyboardFocus. Morph indicateKeyboardFocus: true. Project uiManager openToolsAttachedToMouseCursor: false. SearchBar useScratchPad: false. HandMorph sendMouseWheelToKeyboardFocus: false. HandMorph synthesizeMouseWheelEvents: true. "Text input." TextEditor autoEnclose: true ; autoIndent: true ; encloseSelection: false ; destructiveBackWord: false ; blinkingCursor: true ; dumbbellCursor: false. PluggableTextMorph simpleFrameAdornments: false. TextMorphForEditView draggableTextSelection: true. "Windows" SystemWindow reuseWindows: false. SystemWindow windowsRaiseOnClick: true. SystemWindow windowTitleActiveOnFirstClick: true. Model windowActiveOnFirstClick: false. "Not good for little screen real estate." Model useColorfulWindows: false. Preferences disable: #fastDragWindowForMorphic. AbstractResizerMorph gripThickness: 4; handleLength: 25. CornerGripMorph drawCornerResizeHandles: false; drawEdgeResizeHandles: false. ProportionalSplitterMorph showSplitterHandles: false; smartHorizontalSplitters: false; smartVerticalSplitters: false. "Scroll bars." Preferences enable: #scrollBarsNarrow; enable: #scrollBarsOnRight; enable: #alwaysHideHScrollbar; disable: #alwaysShowHScrollbar; disable: #alwaysShowVScrollbar. ScrollBar scrollBarsWithoutArrowButtons: true; scrollBarsWithoutMenuButton: true. ScrollPane useRetractableScrollBars: false. "Rounded corners." Morph preferredCornerRadius: 8. SystemWindow roundedWindowCorners: false. DialogWindow roundedDialogCorners: false. MenuMorph roundedMenuCorners: false. PluggableButtonMorph roundedButtonCorners: false. ScrollBar roundedScrollBarLook: false. "Gradients." SystemWindow gradientWindow: false. DialogWindow gradientDialog: false. MenuMorph gradientMenu: false. PluggableButtonMorph gradientButton: false. ScrollBar gradientScrollBar: false. "Shadows" Preferences enable: #menuAppearance3d. Morph useSoftDropShadow: true. "Lists and Trees" PluggableListMorph filterableLists: true; clearFilterAutomatically: false; clearFilterDelay: 500; highlightHoveredRow: true; highlightPreSelection: false; menuRequestUpdatesSelection: true. PluggableTreeMorph filterByLabelsOnly: false; maximumSearchDepth: 1. "Standard Tools" TheWorldMainDockingBar showWorldMainDockingBar: true; showSecondsInClock: true; twentyFourHourClock: true. SearchBar useSmartSearch: true. Workspace shouldStyle: false. TranscriptStream forceUpdate: true; redirectToStdOut: false; characterLimit: 20000. Browser listClassesHierarchically: true; showClassIcons: true; showMessageIcons: true; sortMessageCategoriesAlphabetically: true. + SystemBrowser browseWithDragNDrop: true. MessageSet useUnifiedMessageLabels: true. Preferences enable: #annotationPanes; defaultAnnotationRequests: #(timeStamp author messageCategory implementorsCount allChangeSets); enable: #optionalButtons; disable: #diffsWithPrettyPrint; enable: #traceMessages; enable: #alternativeBrowseIt; enable: #menuWithIcons; enable: #visualExplorer. Preferences disable: #debugLogTimestamp. "Halo" Preferences enable: #showBoundsInHalo ; disable: #alternateHandlesLook; disable: #showDirectionHandles. Morph haloForAll: true; metaMenuForAll: true. "System" NetNameResolver enableIPv6: false. Scanner allowUnderscoreAsAssignment: true; prefAllowUnderscoreSelectors: true. Deprecation showDeprecationWarnings: true "that's all, folks"! From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:00:24 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:00:24 +0000 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> , Message-ID: <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de> Hi Marcel, > Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Of course, here are you: Debug it: ObjectTracer on: Morph new In the trunk, this spawns an embarrassing number of additional debuggers while debugging the expression. With my proposed fix, not a single additional debugger is opened before you actually send a message to the morph. Here is another example. Given any object of a class that reimplements #isArray in an erroneous way, this will break the simulator, too: Object newSubclass compile: 'isArray ^self notYetImplemented'; new "step through this" > My impression was that even the BasicInspector struggled to deal with proxies. I think I have fixed this issue via Tools-ct.1056/ToolsTests-ct.105. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 08:08 Uhr An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Mon May 17 10:00:24 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 17 May 2021 12:00:24 +0200 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: <20210516151000.GA16478@shell.msen.com> References: <20210516151000.GA16478@shell.msen.com> Message-ID: Le dim. 16 mai 2021 à 17:10, David T. Lewis a écrit : > > On Fri, May 07, 2021 at 07:39:50PM +0000, commits at source.squeak.org wrote: > > Nicolas Cellier uploaded a new version of Kernel to project The Trunk: > > http://source.squeak.org/trunk/Kernel-nice.1402.mcz > > > > > > Musing is more powerful than dumb static and coverage tests, I wish I got more time for musing :) > > We deadly need evolutive testing (neural based). > > > > Interesting commit comment. How might this work? > > Dave > > Hi Dave, How? This way: put enough buzzwords in commit comments to bring some academics on the subject ;) From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:08:13 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:08:13 +0000 Subject: [squeak-dev] The Inbox: Collections-ct.922.mcz In-Reply-To: References: <1546F06A-06F9-417C-8B80-207ED8C344C5@rowledge.org> <69591d44085842ada63aeacac94b5479@student.hpi.uni-potsdam.de> <2d10cac3607f417aa91c065be3669304@student.hpi.uni-potsdam.de> <1620500486934-0.post@n4.nabble.com>, Message-ID: <86a6cd843b9b41a9b232448b8f947c92@student.hpi.uni-potsdam.de> Hi Levente, hi all, I think that the former state of the relevant key in the dictionary should be always reverted after evaluating aBlock (even if it has been curtailed). One exception could be newer changes made to this key during aBlock, but this is a question I'm actually not sure about. I have attached an updated changeset that 1) adds a few tests and 2) adds #removeKeyDuring: analogously to #at:put:during:. Looking forward to your thoughts! :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Levente Uzonyi Gesendet: Samstag, 8. Mai 2021 23:30:52 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Inbox: Collections-ct.922.mcz Hi Christoph, On Sat, 8 May 2021, Christoph Thiede wrote: > Hi all, > > what is the current state of this proposal? I would love to see this in the > Trunk - I'd also be fine with Marcel's optimization from above. :-) My assumption would be that such method restores the original state once the block has been evaluated. But that's not always the case. Can you explain the logic behind it? (Comments and test cases would probably be helpful there.) Levente -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: Dictionary-executeAround.1.cs URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:10:40 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:10:40 +0000 Subject: [squeak-dev] The Inbox: Graphics-ct.449.mcz In-Reply-To: References: , Message-ID: <921bd6b4d2934faf89fd05365e7cf0b4@student.hpi.uni-potsdam.de> D'oh, I seem to have missed this selector! "magnify" is just the not verb I was searching for. :-) Is it of interest that I update the changeset below to reuse #magnifyBy: in more places? Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Levente Uzonyi Gesendet: Freitag, 7. Mai 2021 21:45:29 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Inbox: Graphics-ct.449.mcz Hi Christoph, What about just using #magnifyBy:? Levente On Thu, 6 May 2021, commits at source.squeak.org wrote: > A new version of Graphics was added to project The Inbox: > http://source.squeak.org/inbox/Graphics-ct.449.mcz > > ==================== Summary ==================== > > Name: Graphics-ct.449 > Author: ct > Time: 6 May 2021, 10:46:15.911809 pm > UUID: 52f12efc-da63-0d44-a252-72bc5f89b6c7 > Ancestors: Graphics-mt.448 > > Proposal: Adds Form >> #scaledBy: that scales a form by a certain factor. I identified half a dozen of senders of #scaledToSize: in the Trunk each of which has reinvented this wheel. > > =============== Diff against Graphics-mt.448 =============== > > Item was added: > + ----- Method: Form>>scaledBy: (in category 'scaling, rotation') ----- > + scaledBy: factor > + "Answer a version of the receiver which is scaled by factor, which can be a number or point." > + > + (factor closeTo: 1) ifTrue: [^ self]. > + ^ self scaledToSize: (self extent * factor) rounded! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:16:48 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:16:48 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> <,> <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de>, Message-ID: <5d5527688c45407b939868ac00713db9@student.hpi.uni-potsdam.de> I think this depends on your machine. :-) As I have already mentioned somewhere else on the list, for unknown reasons, I often have very slow access to my changes file. When the menu is opened, my image spends about 1000 ms in StandardFileStream >> #open:forWrite:, invoked by CompiledMethod >> #timeStamp as part of TheWorldMainDockingBar >> #listChangesOn:. It would be great if there was a way to keep the image and menus responsive even on systems with not-so-fast access to the file system. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Freitag, 7. Mai 2021 19:36:04 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz A rather big change set (81 changed methods, 474 changed methods) has about 150 ms lag in that menu. An empty change set has 5 ms lag. For comparison, the Extras-Menu has 15 ms lag. [self owner selectItem: self event: ActiveHand lastEvent. ActiveWorld displayWorldSafely. self deselect: ActiveHand lastEvent. ActiveWorld displayWorldSafely] bench Best, Marcel Am 06.05.2021 22:59:20 schrieb Thiede, Christoph : > So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? This, of course, would only work if the list could only grow at its end. But I see your point ... I often have a similar situation with the thumbnails in the project menu (around 10 - 20 projects). Lazy loading might actually save me around 60 seconds per day. :D > How big was the changeset that produced those lags? Very small, maybe a dozen of changes. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:26:33 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + + ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + + ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + + DualChangeSorter open.! Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu | latestMethodChanges latestClassChanges| latestMethodChanges := (Array streamContents: [:s | ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | s nextPut: { dateAndTime. method. changeType. category }]]) sorted: [:a :b | a first >= b first]. 1 to: (10 min: latestMethodChanges size) do: [:index | | spec method | spec := latestMethodChanges at: index. method := spec second. menu addItem: [:item | item contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ; target: ToolSet; balloonText: spec third asString; icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]); arguments: {method}]]. latestClassChanges := (Array streamContents: [:s | ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category | "We are not interested in classes whose method's did only change." changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]]) sorted: [:a :b | a first >= b first]. latestClassChanges ifNotEmpty: [menu addLine]. 1 to: (10 min: latestClassChanges size) do: [:index | | spec class | spec := latestClassChanges at: index. class := spec second. menu addItem: [:item | item contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ; target: ToolSet; balloonText: (spec third sorted joinSeparatedBy: Character space); icon: ((spec third includesAnyOf: #(remove addedThenRemoved)) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ (spec third includes: #add) ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]); arguments: {class}]]. + + menu defaultTarget: self. + menu addTranslatedList: #( + - + ('Browse current change set' browseChangeSet) + ('Browse changed methods' browseChangedMethods) + - + ('Simple Change Sorter' browseChanges) + ('Dual Change Sorter' browseChangesDual)). + + + ! - - menu addLine; addItem: [:item | - item - contents: 'Browse current change set...' translated; - target: self; - selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:18:27 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:18:27 +0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1769.mcz In-Reply-To: References: <,> , Message-ID: Alright. Are you criticizing my change or only the attached description? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Freitag, 7. Mai 2021 19:26:32 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1769.mcz Ah. Then #transparent ~= #translucent =) Best, Marcel Am 06.05.2021 23:15:41 schrieb Thiede, Christoph : Well, I actually wanted to prevent a window from automatically applying the color of its first child, which is often a transparent panel morph. Recently we had a student complaining that his window was completely lacking color: ToolBuilder open: (PluggableWindowSpec new children: {PluggablePanelSpec new frame: (LayoutFrame new topFraction: 1; yourself); yourself}; yourself). [cid:aec6fc25-f9d7-4f33-b2f9-cfa2fd4ba205] This is because only Model implements #windowColorToUse. Note that #windowColorToUse, #paneColor, and #defaultColor can still be used to set a translucent color. But I'm not sure whether it is a good idea to derive a transparent color from a child ... Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:32:24 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Morphic-ct.1769.mcz > Avoid translucent color. Why? I did cut out the drop shadow. Translucent windows colors look so cool! :-D [cid:ef11b7be-3360-426c-81a3-b06a1b7d5df7] Am 01.05.2021 14:12:32 schrieb commits at source.squeak.org : A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1769.mcz ==================== Summary ==================== Name: Morphic-ct.1769 Author: ct Time: 1 May 2021, 2:12:17.510389 pm UUID: aa271c07-344a-324a-afe4-3950d6c00839 Ancestors: Morphic-mt.1767 Make SystemWindow's paneColor more robust against missing models. Avoid translucent color. =============== Diff against Morphic-mt.1767 =============== Item was changed: ----- Method: SystemWindow>>paneColor (in category 'colors') ----- paneColor | cc | (cc := self valueOfProperty: #paneColor) ifNotNil: [^cc]. (model respondsTo: #windowColorToUse) ifTrue: [cc := model windowColorToUse]. + cc ifNil: [cc := paneMorphs + detect: [:morph | morph color isTransparent not] + ifFound: [:morph | morph color asNontranslucentColor] + ifNone: [nil]]. - cc ifNil: [cc := paneMorphs isEmptyOrNil ifFalse: [paneMorphs first color]]. cc ifNil: [cc := self defaultColor]. self paneColor: cc. ^cc! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 57317 bytes Desc: image.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 15764 bytes Desc: pastedImage.png URL: From marcel.taeumel at hpi.de Mon May 17 10:19:39 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 12:19:39 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: <5d5527688c45407b939868ac00713db9@student.hpi.uni-potsdam.de> References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> <,> <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de> <,> <5d5527688c45407b939868ac00713db9@student.hpi.uni-potsdam.de> Message-ID: > I think this depends on your machine. :-)  Exactly. I wanted to motivate you to share some statistics from your environment so that I can better understand the issue here. ;-) Best, Marcel Am 17.05.2021 12:16:58 schrieb Thiede, Christoph : I think this depends on your machine. :-) As I have already mentioned somewhere else on the list, for unknown reasons, I often have very slow access to my changes file. When the menu is opened, my image spends about 1000 ms in StandardFileStream >> #open:forWrite:, invoked by CompiledMethod >> #timeStamp as part of TheWorldMainDockingBar >> #listChangesOn:. It would be great if there was a way to keep the image and menus responsive even on systems with not-so-fast access to the file system. :-) Best, Christoph [http://www.hpi.de/] Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Freitag, 7. Mai 2021 19:36:04 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   A rather big change set (81 changed methods, 474 changed methods) has about 150 ms lag in that menu. An empty change set has 5 ms lag. For comparison, the Extras-Menu has 15 ms lag. [self owner selectItem: self event: ActiveHand lastEvent. ActiveWorld displayWorldSafely. self deselect: ActiveHand lastEvent. ActiveWorld displayWorldSafely] bench Best, Marcel Am 06.05.2021 22:59:20 schrieb Thiede, Christoph : > So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? This, of course, would only work if the list could only grow at its end. But I see your point ... I often have a similar situation with the thumbnails in the project menu (around 10 - 20 projects). Lazy loading might actually save me around 60 seconds per day. :D > How big was the changeset that produced those lags? Very small, maybe a dozen of changes. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:26:33 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) [http://www.hpi.de/] Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz [http://source.squeak.org/trunk/Morphic-mt.1767.mcz] ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + +        ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + +        ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + +        DualChangeSorter open.! Item was changed:   ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') -----   listChangesOn: menu            | latestMethodChanges latestClassChanges|          latestMethodChanges := (Array streamContents: [:s |                  ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category |                          s nextPut: { dateAndTime. method. changeType. category }]])                          sorted: [:a :b | a first >= b first].            1 to: (10 min: latestMethodChanges size) do: [:index | | spec method |                  spec := latestMethodChanges at: index.                  method := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ;                                  target: ToolSet;                                  balloonText: spec third asString;                                  icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [                                          spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]);                                  selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]);                                  arguments: {method}]].                                           latestClassChanges := (Array streamContents: [:s |                  ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category |                          "We are not interested in classes whose method's did only change."                          changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]])                          sorted: [:a :b | a first >= b first].            latestClassChanges ifNotEmpty: [menu addLine].          1 to: (10 min: latestClassChanges size) do: [:index | | spec class |                  spec := latestClassChanges at: index.                  class := spec second.                  menu addItem: [:item |                          item                                  contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ;                                  target: ToolSet;                                  balloonText: (spec third sorted joinSeparatedBy: Character space);                                  icon: ((spec third includesAnyOf: #(remove addedThenRemoved))                                          ifTrue: [MenuIcons smallDeleteIcon]                                          ifFalse: [                                                  (spec third includes: #add)                                                          ifTrue: [MenuIcons smallNewIcon]                                                          ifFalse: [MenuIcons blankIcon]]);                                  selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]);                                  arguments: {class}]]. +        +        menu defaultTarget: self. +        menu addTranslatedList: #( +                - +                ('Browse current change set'            browseChangeSet) +                ('Browse changed methods'               browseChangedMethods) +                - +                ('Simple Change Sorter'                         browseChanges) +                ('Dual Change Sorter'                                   browseChangesDual)). + + + ! -                                -        menu addLine; addItem: [:item | -                item -                        contents: 'Browse current change set...' translated; -                        target: self; -                        selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:25:12 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:25:12 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1767.mcz In-Reply-To: References: <9dd20b75349344cbbfc852a92e637d72@student.hpi.uni-potsdam.de> <,> <90040e259536464082efb59dc897fc85@student.hpi.uni-potsdam.de> <,> <5d5527688c45407b939868ac00713db9@student.hpi.uni-potsdam.de>, Message-ID: <535d6c9406304722a82aea203dee181f@student.hpi.uni-potsdam.de> No problem. I have attached the entire output of the InteractiveProfilingTool. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:19:39 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz > I think this depends on your machine. :-) Exactly. I wanted to motivate you to share some statistics from your environment so that I can better understand the issue here. ;-) Best, Marcel Am 17.05.2021 12:16:58 schrieb Thiede, Christoph : I think this depends on your machine. :-) As I have already mentioned somewhere else on the list, for unknown reasons, I often have very slow access to my changes file. When the menu is opened, my image spends about 1000 ms in StandardFileStream >> #open:forWrite:, invoked by CompiledMethod >> #timeStamp as part of TheWorldMainDockingBar >> #listChangesOn:. It would be great if there was a way to keep the image and menus responsive even on systems with not-so-fast access to the file system. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Freitag, 7. Mai 2021 19:36:04 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz A rather big change set (81 changed methods, 474 changed methods) has about 150 ms lag in that menu. An empty change set has 5 ms lag. For comparison, the Extras-Menu has 15 ms lag. [self owner selectItem: self event: ActiveHand lastEvent. ActiveWorld displayWorldSafely. self deselect: ActiveHand lastEvent. ActiveWorld displayWorldSafely] bench Best, Marcel Am 06.05.2021 22:59:20 schrieb Thiede, Christoph : > So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? This, of course, would only work if the list could only grow at its end. But I see your point ... I often have a similar situation with the thumbnails in the project menu (around 10 - 20 projects). Lazy loading might actually save me around 60 seconds per day. :D > How big was the changeset that produced those lags? Very small, maybe a dozen of changes. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Donnerstag, 6. Mai 2021 20:26:33 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1767.mcz > Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) So that the user can watch the list grow and repeatedly miss the click on the intended item because it moved away "just in time"? Maybe that's not a good. :-) How big was the changeset that produced those lags? Best, Marcel Am 01.05.2021 19:31:52 schrieb Thiede, Christoph : Hi Marcel, thanks again. Here are some -- new and recycled :-) -- ideas: * IMO the ChangeSetBrowser does not really add value here. It is only a subset of a regular SimpleChangeSorter, isn't it? * I noticed multiple lags when opening the new menu because the change list is compiled dynamically. Could we add lazy menu loading (i.e., adding some items to the menu *after* it has been opened) to our future wish-list? :-) * Despite the new options, I use the change sorter options most frequently. To make them easier to find (and to guarantee their visibility, considering very large changesets ...), I would still prefer to find the tool section at the beginning but not the end of the menu. What do you think? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Freitag, 30. April 2021 10:11 Uhr An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1767.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1767.mcz ==================== Summary ==================== Name: Morphic-mt.1767 Author: mt Time: 30 April 2021, 10:11:09.230936 am UUID: ebeb7f55-0ca6-a04c-8b5c-87008f09c697 Ancestors: Morphic-mt.1766 Now that I recently discovered the various ways to browse changes ... make the (rather new) changes menu in the docking bar feel more complete. Note that I have no real clue on the actual uses of browsing single change sets or sets of changed methods. Maybe you can help me with some experience reports so that we might remove one or the other menu item again. =============== Diff against Morphic-mt.1766 =============== Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangeSet (in category 'submenu - changes') ----- + browseChangeSet + + ChangeSetBrowser openOnCurrent.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangedMethods (in category 'submenu - changes') ----- + browseChangedMethods + + ChangedMessageSet openFor: ChangeSet current.! Item was added: + ----- Method: TheWorldMainDockingBar>>browseChangesDual (in category 'submenu - changes') ----- + browseChangesDual + + DualChangeSorter open.! Item was changed: ----- Method: TheWorldMainDockingBar>>listChangesOn: (in category 'submenu - changes') ----- listChangesOn: menu | latestMethodChanges latestClassChanges| latestMethodChanges := (Array streamContents: [:s | ChangeSet current changedMethodsDo: [:method :changeType :dateAndTime :category | s nextPut: { dateAndTime. method. changeType. category }]]) sorted: [:a :b | a first >= b first]. 1 to: (10 min: latestMethodChanges size) do: [:index | | spec method | spec := latestMethodChanges at: index. method := spec second. menu addItem: [:item | item contents: ('{1} {2} \{{3}\} \{{4}\}' format: {method methodClass. method selector. spec fourth. method methodClass category}) ; target: ToolSet; balloonText: spec third asString; icon: ((#(remove addedThenRemoved) includes: spec third) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ spec third = #add ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: (method isInstalled ifTrue: [#browseMethod:] ifFalse: [#browseMethodVersion:]); arguments: {method}]]. latestClassChanges := (Array streamContents: [:s | ChangeSet current changedClassesDo: [:class :changeTypes :dateAndTime :category | "We are not interested in classes whose method's did only change." changeTypes ifNotEmpty: [s nextPut: { dateAndTime. class. changeTypes. category }]]]) sorted: [:a :b | a first >= b first]. latestClassChanges ifNotEmpty: [menu addLine]. 1 to: (10 min: latestClassChanges size) do: [:index | | spec class | spec := latestClassChanges at: index. class := spec second. menu addItem: [:item | item contents: ('{1} \{{2}\}' format: {class name. spec fourth }) ; target: ToolSet; balloonText: (spec third sorted joinSeparatedBy: Character space); icon: ((spec third includesAnyOf: #(remove addedThenRemoved)) ifTrue: [MenuIcons smallDeleteIcon] ifFalse: [ (spec third includes: #add) ifTrue: [MenuIcons smallNewIcon] ifFalse: [MenuIcons blankIcon]]); selector: ((spec third includes: #remove) ifTrue: [#inspect:] ifFalse: [#browseClass:]); arguments: {class}]]. + + menu defaultTarget: self. + menu addTranslatedList: #( + - + ('Browse current change set' browseChangeSet) + ('Browse changed methods' browseChangedMethods) + - + ('Simple Change Sorter' browseChanges) + ('Dual Change Sorter' browseChangesDual)). + + + ! - - menu addLine; addItem: [:item | - item - contents: 'Browse current change set...' translated; - target: self; - selector: #browseChanges].! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances..'! - (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- An embedded and charset-unspecified text was scrubbed... Name: profile-changelist-menu.txt URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:44:05 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:44:05 +0000 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz In-Reply-To: References: , Message-ID: <86213ab9ee3e4fbcabfbcac3fd3c0783@student.hpi.uni-potsdam.de> Hi Marcel, these are very good points for further and tighter integration of a pretty printer into the system (I'm mainly referring to customized and project-specific settings), and I'm sure that Tom and his team will consider at least some of them for PoppyPrint. :-) Nevertheless, I don't think that we should hesitate to integrate new features like this one into the Trunk as experimental features. Unless turned on by default, I don't see how this could harm anyone, but it allows certain users to configure their image to better match their individual preference, so we can give them more freedom. I think we should be more open to and supportive of new ideas, even if they do not perfectly fit together. Last but not least, isn't this one of the core ideas of trunk-based development? :-) At the moment, the preference offers a working prototype that interested users can enable - when working on projects that do not enforce a different coding style - and benefit from additional convenience while writing their code. I'm liking this feature very much while developing my latest project. I'm also making good experiences with the analogous concept in the JavaScript world (VS Code "formatOnSave" + eslint) these days. > Squeak Trunk should not do that [enforce such formatting] I'm not requesting that here. At least not yet. This will enough stuff for a future discussion. :-) > it should [...] rather be done at commit time (or code-review time) -1. :-) The idea of automatic pretty-printing is that you do not have to spend any time or thoughts on thinking about the proper formatting of a method. Thus the earlier automatic pretty-printing is applied, the less the programmer gets distracted by thinking about manual formatting. I would even love to try out pretty-printing as you type, but this would be technically more challenging. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Freitag, 7. Mai 2021 07:47:30 An: squeak-dev Betreff: Re: [squeak-dev] The Inbox: Tools-ct.1054.mcz Hi all -- Since the preference is disabled by default (and I would want to make that explicit in the ReleaseBuilder, too), I think this might improve some folks' programming experience. Well, I don't think this preference/proposal would have a huge impact because: 1. Squeak's pretty printer is rather limited to support project/user-specific styles (or accuracy to preserve those implicit rules). 2. There is already a way to pretty print your code selection via SHIFT+CMD+S easily. 3. If any project would even want to enforce such formatting -- Squeak Trunk should not do that -- it should be scoped per repository and rather be done at commit time (or code-review time). Not a global setting. If people are too scared that such a preference would open a "pandora's box", I would like to make sure that we make our intentions for Squeak Trunk/Inbox/Treated as explicit as possible to preserve the programmer's creative freedom. -1 for now =) Best, Marcel Am 07.05.2021 07:35:27 schrieb Tom Beckmann : Hi Chris, speaking from experience with an extension like this: I started out with a script that reformatted all methods in my package (it was a good idea) and moved on to using something like this proposed extension. For further context, I have gotten used to and comfortable with the idea that formatting is just busy work in 95% of cases that I'd like to spend on something productive rather than moving whitespace. Undoubtedly, using a pretty printer on most trunk code is infeasible, as each method/class/package currently follows different intricacies of secondary notation. Additionally, there are of course some "special" (from the POV of our pretty printer) formatting choices that authors deliberately chose to make a point about the code. This type of secondary notation, where it's actually valuable, is I think quite common in trunk code, but exceedingly uncommon in code I produce in the daily business. I don't think anyone currently even considers applying a pretty printer against all trunk code, for various reasons. Since it's a preference I would give the proposed change a +1. It supports a valuable workflow that I believe is slowly becoming feasible in Squeak. The Ctrl+Shift+S shortcut could even be inverted when the preference is active so that you can keep formatting idiosyncrasies where it's appropriate. It may be important to note that we are working on having a pretty printer understand common Smalltalk idioms and format those accordingly. We are also planning to try and maintain deliberate choices, such as empty lines, strides in array formatting, or comment positions. If you've never tried programming in an ecosystem where there's a well-accepted standard for code style that can be automatically applied, I'd recommend you give it a shot. At least for me, it allowed performing changes more directly (no tedious cleanup each time I want to look at an intermediate or final state of a change) and saved a good chunk of brain power that I could invest elsewhere :) Best, Tom On Fri, May 7, 2021, 02:25 Chris Muller > wrote: -1. The IDE should not break the boundaries of roles between the human and IDE. IOW, it should maintain explicit gesture separation between what the human crafted, and what is stored in the system. If this was really a good idea, why not write a script to simply format all methods in the whole system? (answer: because I'm sure you agree that's a bad idea). Or why not just use #browseWithPrettyPrint? There is already a hot-key for pretty-print (Shift+Cmd+S), so you can obtain the same effect with virtually no extra effort if you want to. On Thu, May 6, 2021 at 4:40 PM > wrote: > > A new version of Tools was added to project The Inbox: > http://source.squeak.org/inbox/Tools-ct.1054.mcz > > ==================== Summary ==================== > > Name: Tools-ct.1054 > Author: ct > Time: 6 May 2021, 11:40:27.54561 pm > UUID: edc189dc-7bb9-974a-9aa3-4760e7e67239 > Ancestors: Tools-mt.1053 > > Proposal: Adds a new preference #acceptWithPrettyPrint that, if enabled, automatically pretty-prints every message before accepting it in a code holder. When used together with the preferences #browseWithPrettyPrint (and maybe also #diffsWithPrettyPrint), given a good pretty-printer such as PoppyPrint, this has the potential to make your journey through Squeak even prettier. :-) > > =============== Diff against Tools-mt.1053 =============== > > Item was changed: > ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- > defineMessageFrom: aString notifying: aController > "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." > | selectedMessageName selector category oldMessageList selectedClassOrMetaClass | > selectedMessageName := self selectedMessageName. > oldMessageList := self messageList. > selectedClassOrMetaClass := self selectedClassOrMetaClass. > contents := nil. > selector := (selectedClassOrMetaClass newParser parseSelector: aString). > (self metaClassIndicated > and: [(selectedClassOrMetaClass includesSelector: selector) not > and: [Metaclass isScarySelector: selector]]) > ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" > (self confirm: ((selector , ' is used in the existing class system. > Overriding it could cause serious problems. > Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) > ifFalse: [^nil]]. > category := selectedMessageName > ifNil: [ self selectedMessageCategoryName ] > ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. > + selector := self > + basicCompile: aString > + in: selectedClassOrMetaClass > + classified: category > + notifying: aController. > - selector := selectedClassOrMetaClass > - compile: aString > - classified: category > - notifying: aController. > selector == nil ifTrue: [^ nil]. > contents := aString copy. > > self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." > self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." > > selector ~~ selectedMessageName > ifTrue: > [category = ClassOrganizer nullCategory > ifTrue: [self changed: #classSelectionChanged. > self changed: #classList. > self messageCategoryListIndex: 1]. > self setClassOrganizer. "In case organization not cached" > (oldMessageList includes: selector) > ifFalse: [self changed: #messageList]. > self messageListIndex: (self messageList indexOf: selector)]. > ^ selector! > > Item was added: > + ----- Method: CodeHolder>>basicCompile:in:classified:notifying: (in category 'code pane') ----- > + basicCompile: aString in: aClassOrMetaClass classified: category notifying: requestor > + > + | source | > + source := SystemBrowser acceptWithPrettyPrint > + ifTrue: [aClassOrMetaClass prettyPrinterClass > + format: aString in: aClassOrMetaClass notifying: requestor] > + ifFalse: [aString]. > + ^ aClassOrMetaClass > + compile: source > + classified: category > + notifying: requestor! > > Item was changed: > ----- Method: CodeHolder>>compileMessage:notifying: (in category 'code pane') ----- > compileMessage: aString notifying: aController > "Compile the code that was accepted by the user, placing the compiled method into an appropriate message category. Return true if the compilation succeeded, else false." > > | selectedMessageName selector category selectedClassOrMetaClass | > selectedMessageName := self selectedMessageName. > selectedClassOrMetaClass := self selectedClassOrMetaClass. > contents := nil. > selector := (selectedClassOrMetaClass newParser parseSelector: aString). > (self metaClassIndicated > and: [(selectedClassOrMetaClass includesSelector: selector) not > and: [Metaclass isScarySelector: selector]]) > ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" > (self confirm: ((selector , ' is used in the existing class system. > Overriding it could cause serious problems. > Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) > ifFalse: [^nil]]. > category := self selectedMessageCategoryName. > + selector := self > + basicCompile: aString > + in: selectedClassOrMetaClass > + classified: category > + notifying: aController. > - selector := selectedClassOrMetaClass > - compile: aString > - classified: category > - notifying: aController. > selector == nil ifTrue: [^ nil]. > contents := aString copy. > currentCompiledMethod := selectedClassOrMetaClass compiledMethodAt: selector. > ^ true! > > Item was changed: > ----- Method: DependencyBrowser>>defineMessageFrom:notifying: (in category 'contents') ----- > defineMessageFrom: aString notifying: aController > "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." > | selectedMessageName selector category oldMessageList | > selectedMessageName := self selectedMessageName. > oldMessageList := self messageList. > contents := nil. > selector := (self selectedClassOrMetaClass newParser parseSelector: aString). > + selector := self > + basicCompile: aString > + in: self selectedClassOrMetaClass > + classified: (category := self selectedMessageCategoryName) > + notifying: aController. > - selector := self selectedClassOrMetaClass > - compile: aString > - classified: (category := self selectedMessageCategoryName) > - notifying: aController. > selector == nil ifTrue: [^ false]. > contents := aString copy. > ^ true > ! > > Item was changed: > AppRegistry subclass: #SystemBrowser > instanceVariableNames: '' > + classVariableNames: 'AcceptWithPrettyPrint BrowseWithDragNDrop BrowseWithPrettyPrint' > - classVariableNames: 'BrowseWithDragNDrop BrowseWithPrettyPrint' > poolDictionaries: '' > category: 'Tools-Base'! > > !SystemBrowser commentStamp: '' prior: 0! > This is the AppRegistry class for class browsing! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint (in category 'preferences') ----- > + acceptWithPrettyPrint > + > + ^ AcceptWithPrettyPrint ifNil: [false].! > > Item was added: > + ----- Method: SystemBrowser class>>acceptWithPrettyPrint: (in category 'preferences') ----- > + acceptWithPrettyPrint: aBoolean > + AcceptWithPrettyPrint := aBoolean.! > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Mon May 17 10:45:38 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 10:45:38 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.158.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.158.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.158 Author: mt Time: 17 May 2021, 12:45:36.337555 pm UUID: e43bcf87-27f2-f04b-82e6-f350dee91c3a Ancestors: FFI-Kernel-mt.157 Further fixes for code loading. Sorry for the noise :-( =============== Diff against FFI-Kernel-mt.157 =============== Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling "Base class changed to something that is an external structure now." + [self compileFields] + ifError: [ "Ignore unfinished field specs" ]. + self externalType isUnknownType + ifTrue: [self externalType becomeKnownTypeSafely].! - [self compileFields] ifError: [ "Ignore unfinished field specs" ]. - self externalType isUnknownType ifTrue: [self externalType becomeKnownType].! Item was changed: ----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') ----- newTypeForStructureClass: anExternalStructureClass | type pointerType referentClass | referentClass := anExternalStructureClass. self assert: [referentClass includesBehavior: ExternalStructure] description: 'Wrong base class for structure'. type := self newTypeForUnknownNamed: referentClass name. pointerType := type asPointerType. referentClass compiledSpec ifNil: [ "First time. The referent class' fields are probably just compiled for the first time." type setReferentClass: referentClass. pointerType setReferentClass: referentClass] ifNotNil: [ type newReferentClass: referentClass. pointerType newReferentClass: referentClass]. + ^ type becomeKnownTypeSafely! - ^ [type becomeKnownType] ifError: [ - self assert: [type isUnknownType]. - type "still unkown"]! Item was added: + ----- Method: ExternalUnknownType>>becomeKnownTypeSafely (in category 'construction') ----- + becomeKnownTypeSafely + "Give me some purpose. :-)" + + ^ [self becomeKnownType] + on: Error + do: [ + self assert: [self isUnkownType]. + self].! From commits at source.squeak.org Mon May 17 10:47:31 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 17 May 2021 10:47:31 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.159.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.159.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.159 Author: mt Time: 17 May 2021, 12:47:29.106555 pm UUID: b9a462e7-8a49-794f-b7ed-052098e6f2af Ancestors: FFI-Kernel-mt.158 *sigh* =============== Diff against FFI-Kernel-mt.158 =============== Item was changed: ----- Method: ExternalUnknownType>>becomeKnownTypeSafely (in category 'construction') ----- becomeKnownTypeSafely "Give me some purpose. :-)" ^ [self becomeKnownType] on: Error do: [ + self assert: [self isUnknownType]. - self assert: [self isUnkownType]. self].! From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 10:49:39 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 10:49:39 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: Message-ID: Nice catch! :-) For anyone else wondering about this glitch: Before: [cid:fa526f81-7fe1-4dca-8487-be1c5bc0731b] After: [cid:3b6aa025-5213-4b7a-80f9-d3ae74dbbfe9] IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed: ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') ----- explorerContents ^#( ('hexadecimal' 16 2) ('octal' 8 3) ('binary' 2 4)) collect: [ :each | | label group | group := each third. + label := self abs printStringBase: each second. - label := self printStringBase: each second. label := label padded: #left to: (label size roundUpTo: group) with: $0. label := String streamContents: [:s | + self negative ifTrue: [s nextPutAll: '- ']. (1 to: label size by: group) do: [:index | 1 to: group do: [:gIndex | s nextPut: (label at: index + gIndex - 1)]] separatedBy: [s space]]. ObjectExplorerWrapper with: label name: each first translated model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: pastedImage.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: pastedImage.png URL: From marcel.taeumel at hpi.de Mon May 17 10:52:23 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 12:52:23 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: Message-ID: > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: After: IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz [http://source.squeak.org/trunk/Morphic-mt.1769.mcz] ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed:   ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----   explorerContents            ^#(                  ('hexadecimal' 16 2)                  ('octal' 8 3)                  ('binary' 2 4)) collect: [ :each | | label group |                          group := each third. +                        label := self abs printStringBase: each second. -                        label := self printStringBase: each second.                          label := label padded: #left to: (label size roundUpTo: group) with: $0.                                  label := String streamContents: [:s | +                                self negative ifTrue: [s nextPutAll: '- '].                                  (1 to: label size by: group)                                          do: [:index |                                                  1 to: group do: [:gIndex |                                                          s nextPut: (label at: index + gIndex - 1)]]                                          separatedBy: [s space]].                                                    ObjectExplorerWrapper                                  with: label                                  name: each first translated                                  model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: not available URL: From marcel.taeumel at hpi.de Mon May 17 10:54:50 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 12:54:50 +0200 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de> References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> <,> <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de> Message-ID: > Given any object of a class that reimplements #isArray in an erroneous way Given my recent slip in the FFI package, I have the feeling that #isArray has a really specific meaning for the class layout. No one should claim to also be an Array. :-D I mean, not even RawBitsArray does it. There is something going on. :-) Best, Marcel Am 17.05.2021 12:00:33 schrieb Thiede, Christoph : Hi Marcel, > Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Of course, here are you: Debug it: ObjectTracer on: Morph new In the trunk, this spawns an embarrassing number of additional debuggers while debugging the expression. With my proposed fix, not a single additional debugger is opened before you actually send a message to the morph. Here is another example. Given any object of a class that reimplements #isArray in an erroneous way, this will break the simulator, too: Object newSubclass     compile: 'isArray ^self notYetImplemented';     new "step through this" > My impression was that even the BasicInspector struggled to deal with proxies. I think I have fixed this issue via Tools-ct.1056/ToolsTests-ct.105. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 08:08 Uhr An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html [http://forum.world.st/Squeak-Dev-f45488.html] -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Mon May 17 11:01:44 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 13:01:44 +0200 Subject: [squeak-dev] Flaps aren't dead! They feel happy! (was Re: "More Direct Morphic": The Movie) In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: I like flaps. :-) But I don't use them. Best, Marcel Am 17.05.2021 09:15:42 schrieb Tony Garnock-Jones : I use flaps! Specifically, in my experimentation with squeak-on-a-cellphone, I put the on screen keyboard in a flap, and open the flap automatically whenever keyboard focus switches to something non-nil: newKeyboardFocus: aMorphOrNil aMorphOrNil ifNil: [OnScreenKeyboardMorph hideFlap] ifNotNil: [(OnScreenKeyboardMorph future: 200) raiseFlap]. ^ super newKeyboardFocus: aMorphOrNil. It works surprisingly well for this. Being able to adjust the height of the keyboard by moving the flap, etc. Cheers, Tony On 5/16/21 8:13 PM, tim Rowledge wrote: > > >> On 2021-05-16, at 5:38 AM, Herbert König wrote: >> >> What about Projects and Flaps, can they be added to Cuis? > > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. > > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 11:07:19 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 11:07:19 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: , Message-ID: > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: [cid:fa526f81-7fe1-4dca-8487-be1c5bc0731b] After: [cid:3b6aa025-5213-4b7a-80f9-d3ae74dbbfe9] IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed: ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') ----- explorerContents ^#( ('hexadecimal' 16 2) ('octal' 8 3) ('binary' 2 4)) collect: [ :each | | label group | group := each third. + label := self abs printStringBase: each second. - label := self printStringBase: each second. label := label padded: #left to: (label size roundUpTo: group) with: $0. label := String streamContents: [:s | + self negative ifTrue: [s nextPutAll: '- ']. (1 to: label size by: group) do: [:index | 1 to: group do: [:gIndex | s nextPut: (label at: index + gIndex - 1)]] separatedBy: [s space]]. ObjectExplorerWrapper with: label name: each first translated model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: pastedImage.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: pastedImage.png URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 11:08:00 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 11:08:00 +0000 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> <,> <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de>, Message-ID: <64c52ebc75c540d292c96ff0dee2118d@student.hpi.uni-potsdam.de> Well, that's another argument for my proposed fix, isn't it? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:54:50 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Given any object of a class that reimplements #isArray in an erroneous way Given my recent slip in the FFI package, I have the feeling that #isArray has a really specific meaning for the class layout. No one should claim to also be an Array. :-D I mean, not even RawBitsArray does it. There is something going on. :-) Best, Marcel Am 17.05.2021 12:00:33 schrieb Thiede, Christoph : Hi Marcel, > Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Of course, here are you: Debug it: ObjectTracer on: Morph new In the trunk, this spawns an embarrassing number of additional debuggers while debugging the expression. With my proposed fix, not a single additional debugger is opened before you actually send a message to the morph. Here is another example. Given any object of a class that reimplements #isArray in an erroneous way, this will break the simulator, too: Object newSubclass compile: 'isArray ^self notYetImplemented'; new "step through this" > My impression was that even the BasicInspector struggled to deal with proxies. I think I have fixed this issue via Tools-ct.1056/ToolsTests-ct.105. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 08:08 Uhr An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Mon May 17 11:08:47 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 13:08:47 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <,> Message-ID: > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Best, Marcel Am 17.05.2021 13:07:28 schrieb Thiede, Christoph : > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: After: IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz [http://source.squeak.org/trunk/Morphic-mt.1769.mcz] ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed:   ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----   explorerContents            ^#(                  ('hexadecimal' 16 2)                  ('octal' 8 3)                  ('binary' 2 4)) collect: [ :each | | label group |                          group := each third. +                        label := self abs printStringBase: each second. -                        label := self printStringBase: each second.                          label := label padded: #left to: (label size roundUpTo: group) with: $0.                                  label := String streamContents: [:s | +                                self negative ifTrue: [s nextPutAll: '- '].                                  (1 to: label size by: group)                                          do: [:index |                                                  1 to: group do: [:gIndex |                                                          s nextPut: (label at: index + gIndex - 1)]]                                          separatedBy: [s space]].                                                    ObjectExplorerWrapper                                  with: label                                  name: each first translated                                  model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: not available URL: From herbertkoenig at gmx.net Mon May 17 11:56:28 2021 From: herbertkoenig at gmx.net (=?UTF-8?Q?Herbert_K=c3=b6nig?=) Date: Mon, 17 May 2021 13:56:28 +0200 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: <619be1c8-70b1-e3ad-f88e-d7f7d1cefdd7@gmx.net> > Interesting use of Projects. You linked them up visually with Connectors, right? nope, just Arrows from the Object tool. Usually with visible handles. Always as simple as possible. I know you are doing beautiful things. For me it's about brainstorming. Costs, UI (physical buttons and sliders for the electronics, mouse miles for GUIs  Implement elsewhere), sometimes keep together stuff I learned. Cheers, Herbert >> And your signature generator had the right choice again :-)) > I sometimes worry about whether it has become sentient. And what does that mean when I reboot the Mac? See also the season 2 first episode of 'Love Death and Robots' > > tim > -- > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > Strange OpCodes: RLBM: Ruin Logic Board Multiple > > > From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 12:00:23 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 12:00:23 +0000 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <,> , Message-ID: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> > > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... > > So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Why do you think so? The object layout of Squeak Integer is not something like "list of decimal digits". The decimal representation is just one of many equivalent representations. On the other hand, any complement semantic adds a completely new concept because it neglects the infinite size of integers. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 13:08:47 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Best, Marcel Am 17.05.2021 13:07:28 schrieb Thiede, Christoph : > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: [cid:fa526f81-7fe1-4dca-8487-be1c5bc0731b] After: [cid:3b6aa025-5213-4b7a-80f9-d3ae74dbbfe9] IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed: ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') ----- explorerContents ^#( ('hexadecimal' 16 2) ('octal' 8 3) ('binary' 2 4)) collect: [ :each | | label group | group := each third. + label := self abs printStringBase: each second. - label := self printStringBase: each second. label := label padded: #left to: (label size roundUpTo: group) with: $0. label := String streamContents: [:s | + self negative ifTrue: [s nextPutAll: '- ']. (1 to: label size by: group) do: [:index | 1 to: group do: [:gIndex | s nextPut: (label at: index + gIndex - 1)]] separatedBy: [s space]]. ObjectExplorerWrapper with: label name: each first translated model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: pastedImage.png URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: pastedImage.png URL: From nicolas.cellier.aka.nice at gmail.com Mon May 17 12:14:08 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 17 May 2021 14:14:08 +0200 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: <20210516151000.GA16478@shell.msen.com> Message-ID: More seriously, there is not a single kind of test. One category is kind of specification illustrating the expectations, and demonstrating how to use some message/class. Most of the time, our tests as specification lack the quantifiers (like the universal quantifier), that's why I name them illustrating. Ideally, we would like to have some form of formal proof, but there rarely is one accessible, unless we drastically restrict the capabilities (like recursivity and all forms of reflexivity) At least, that's my understanding of https://en.wikipedia.org/wiki/Formal_methods In some rare cases, we now have enough computing power to test an implementation exhaustively (like a function of a single float32 argument). Alternatively, we can try and test with randomly generated inputs, but that's a bit like shooting in the dark. In order to be more eager, we sometimes write tests against a specific implementation with specially crafted examples for non regression or main gotchas of the specific algorithm. I guess my efforts fall in such a category: it's kind of adversarial strategy; somehow like a game of finding the shortcomings. If we have watts to burn, I think that it would be interesting to use machine power to find and construct those adversarial examples, not based on sole randomness, but some form of analysis of algorithms and probably some set of heuristics. How could we build such machinery, I don't know, for now it's still buzzwords. Le lun. 17 mai 2021 à 12:00, Nicolas Cellier a écrit : > > Le dim. 16 mai 2021 à 17:10, David T. Lewis a écrit : > > > > On Fri, May 07, 2021 at 07:39:50PM +0000, commits at source.squeak.org wrote: > > > Nicolas Cellier uploaded a new version of Kernel to project The Trunk: > > > http://source.squeak.org/trunk/Kernel-nice.1402.mcz > > > > > > > > > Musing is more powerful than dumb static and coverage tests, I wish I got more time for musing :) > > > We deadly need evolutive testing (neural based). > > > > > > > Interesting commit comment. How might this work? > > > > Dave > > > > > Hi Dave, > How? This way: put enough buzzwords in commit comments to bring some > academics on the subject ;) From marcel.taeumel at hpi.de Mon May 17 13:34:58 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Mon, 17 May 2021 15:34:58 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> References: <,> <,> <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> Message-ID: > The decimal representation is just one of many equivalent representations. The problem being that the basic (machine) representation is not clear. I think its 2's complement. HEX and OCT -- I suppose -- are very close to the machine representation. That's not an issue for positive numbers. :-)  Best, Marcel Am 17.05.2021 14:00:36 schrieb Thiede, Christoph : > > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... >  > So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Why do you think so? The object layout of Squeak Integer is not something like "list of decimal digits". The decimal representation is just one of many equivalent representations. On the other hand, any complement semantic adds a completely new concept because it neglects the infinite size of integers. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 13:08:47 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Best, Marcel Am 17.05.2021 13:07:28 schrieb Thiede, Christoph : > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: After: IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org; packages at lists.squeakfoundation.org Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz [http://source.squeak.org/trunk/Morphic-mt.1769.mcz] ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed:   ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----   explorerContents            ^#(                  ('hexadecimal' 16 2)                  ('octal' 8 3)                  ('binary' 2 4)) collect: [ :each | | label group |                          group := each third. +                        label := self abs printStringBase: each second. -                        label := self printStringBase: each second.                          label := label padded: #left to: (label size roundUpTo: group) with: $0.                                  label := String streamContents: [:s | +                                self negative ifTrue: [s nextPutAll: '- '].                                  (1 to: label size by: group)                                          do: [:index |                                                  1 to: group do: [:gIndex |                                                          s nextPut: (label at: index + gIndex - 1)]]                                          separatedBy: [s space]].                                                    ObjectExplorerWrapper                                  with: label                                  name: each first translated                                  model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: not available URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 14:26:32 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 14:26:32 +0000 Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: <1621113654445-0.post@n4.nabble.com> References: <1621087561864-0.post@n4.nabble.com>,<1621113654445-0.post@n4.nabble.com> Message-ID: Hi Jaromir, first of all, please let me clarify one thing: BlockCannotReturn is an Error, of course, and thus under normal circumstances should never be resumed. Just like it would usually be an anti-pattern to resume from a subscript error, KeyNotFound error, or anything else. Not for nothing, Error implements #isResumeable with false so that sending #resume[:] to an error will usually raise an IllegalResumeAttempt. Nevertheless, our debugger supports enforcing the resumption of an exception using Proceed, even if the exception is not marked as resumable. So this should only be used for debugging scenarios, but still, I think that we could - and maybe also should - make it as convenient as possible to perform this non-recommended operation if you are debugging some unusual scenarios. This is mainly helpful to manipulate the behavior of a program during runtime (similar to the "return entered value" in the stack list menu of the debugger). > Resuming BlockCannotReturn sounds crazy to me by definition and you're right: it's set as resumable, I haven't noticed. I'd set it non-resumable. If a block cannot return, why should we be tempted to do that? :) I don't know whether there was a special reason to mark it as resumable, but if there wasn't one, I totally agree with you on this point! Just talkin' about the conscious decision of the debugging person to ignore the non-resumability of this exception and resume it anyway, just like you can do it for any other normal error. :-) > > `a := [true ifTrue: [^ 1]. 2].` > > "Both statements need to be executed separately in a Workspace so that [a outerContext sender] becomes nil!" > > `a value.` > > In this situation, it is valid to resume from BlockCannotReturn and currently also possible in the Trunk. Note that BlockCannotReturn even overrides #isResumable to answer true, though the class comment discrecommends resuming it. > > My interpretation of this example is the home sender of ^1 is gone once the first do-it ends. So the second do-it correctly, in my opinion, invokes the cannot return error. Current Trunk returning 2 seems wildly incorrect to me. Again, just for clarification: The example does raise a BlockCannotReturn in the second expression in the current Trunk as it should do. :-) Maybe my explanation was not precise enough here. I was only referring to the unusual edge case in which you attempt to proceed the process from this BlockCannotReturn error. In the Trunk, the expression will return 2 in this case. With your example, you won't be able to escape from the situation without pressing Abandon. > [ > [ > [ ] ensure: [ > [] ensure: [ > ^Transcript show: 'x1']. > Transcript show: 'x2'] > ] ensure: [ > Transcript show: 'x3']. > Transcript show: 'x4' > ] fork > > In this case the expected outcome is ---> x1 x3. Neither x2 nor x4 should be printed (x2 is intentionally skipped by the non-local return and x4 is outside the ensure blocks). With the fix you propose the outcome is either ---> x1 x2 x3 if pressed Abandon or ---> x1 x2 x3 x4 if pressed Proceed - this would be equivalent to no non-local return at all :) Wait, wait, wait. This smells to me. :-) #cannotReturn: should not be *resumed* after the error was abandoned. Otherwise, something is wrong with the termination logic. Process >> #terminate *must not* resume in this place. Terminating means only executing all uncompleted unwind contexts. I just reverted to the version ct 1/17/2021 18:35 of Process >> #terminate and with regard to your example, both implementations of #cannotReturn: behave the save (---> x1 x3) as expected. Hm, I'm sorry, but Process >> #terminate is not yet done correctly IMHO. I'll send you another message concerning this method soon, but I'm checking many things while drafting the message, so please have some more patience. :-) > Thanks for discussing this! Thank *you* for whipping the "machine room" of Squeak into shape again and bringing up all these interesting questions along the way! :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Jaromir Matas Gesendet: Samstag, 15. Mai 2021 23:20:54 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Inbox: Kernel-ct.1405.mcz Hi Christoph, > Counterproposal to Kernel-jar.1404 for fixing VM crashes when resuming > from a BlockCannotReturn. Instead of enforcing retrial, repair the context > stack if the receiver has ended. I was considering the idea whether it could make sense to "fix" the stack but dumped it eventually because it would completely change the semantics of non-local returns. In my opinion once the home context sender is not available it means it's gone irreparably. There are two situation to consider: double return to the same context within one stack (e.g. the return context is gone or it may even still exist but its pc has moved) or the home sender is on a different context stack - in case of forks etc. Non-local returns between forks could in theory work but not in the current environment; Squeak strictly requires the home context sender to be on the same stack. > Not in all situations, the receiver of #cannotReturn: is actually unable > to resume. Consider this example for a disproof: > `a := [true ifTrue: [^ 1]. 2].` > "Both statements need to be executed separately in a Workspace so that > [a outerContext sender] becomes nil!" > `a value.` > In this situation, it is valid to resume from BlockCannotReturn and > currently also possible in the Trunk. Note that BlockCannotReturn even > overrides #isResumable to answer true, though the class comment > discrecommends resuming it. My interpretation of this example is the home sender of ^1 is gone once the first do-it ends. So the second do-it correctly, in my opinion, invokes the cannot return error. Current Trunk returning 2 seems wildly incorrect to me. Resuming BlockCannotReturn sounds crazy to me by definition and you're right: it's set as resumable, I haven't noticed. I'd set it non-resumable. If a block cannot return, why should we be tempted to do that? :) > Nevertheless, this raises another question - what would you expect from > this > example to return? > > `a := [true ifTrue: [^ 1] yourself].` > "Both statements need to be executed separately in a Workspace so that [a > outerContext sender] becomes nil!" > `[a value] on: BlockCannotReturn do: [:ex | ex resume].` > > Should it be 1 or nil? In the Trunk, is it nil, if we override > \#defaultResumeValue as below, it will be 1. This is a mean example... My fix ended in an infinite loop :) I tried to fix it but the only clean solution that occurred to me is to set BlockCannotReturn as non-resumable. But again, my interpretation here is any attempt to "repair" the context that cannot return means a substantial change of the non-local return semantics. It means I'd return nil because the meaning of the error is: I cannot return 1 to my home sender. Here's one of my examples I'm planning to send as test cases to the Inbox soon: [ [ [ ] ensure: [ [] ensure: [ ^Transcript show: 'x1']. Transcript show: 'x2'] ] ensure: [ Transcript show: 'x3']. Transcript show: 'x4' ] fork In this case the expected outcome is ---> x1 x3. Neither x2 nor x4 should be printed (x2 is intentionally skipped by the non-local return and x4 is outside the ensure blocks). With the fix you propose the outcome is either ---> x1 x2 x3 if pressed Abandon or ---> x1 x2 x3 x4 if pressed Proceed - this would be equivalent to no non-local return at all :) I hope I'll be able to put the tests together and publish in a few days. Juan Vuletich showed me a beautiful example about the non-local return semantics - take a look in [1] in the middle of the post. Thanks for discussing this! best, [1] [[Cuis-dev\] Unwind mechanism during termination is broken and inconsistent](https://lists.cuis.st/mailman/archives/cuis-dev/2021-April/003055.html) ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html Smalltalk - Squeak - Dev | Mailing List Archive forum.world.st Squeak - Dev forum and mailing list archive. The general-purpose Squeak developers list -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 17 15:29:56 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 17 May 2021 15:29:56 +0000 Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination Message-ID: Hi all, hi Jaromir, I'm raising a new question in this post that is related to the following threads, but I think that it deserves its own thread due to the fundamental criticism expressed: [1, 2] I just took a closer look at ProcessTest >> #testNestedUnwind and I have to say that I don't agree with it. I'm sorry that I did not mention this earlier, but somehow this aspect of Jaromir's large amount of recent work has escaped my attention before today. For reference, so that we all know what we are talking about, here is the test in question: testNestedUnwind "Test all nested unwind blocks are correctly unwound; all unwind blocks halfway through their execution should be completed or at least attempted to complete, not only the innermost one" | p x1 x2 x3 | x1 := x2 := x3 := false. p := [ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" Processor activeProcess suspend. x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] fork. Processor yield. p terminate. self assert: x1 & x2 & x3. I'm not convinced about the assertions in this test. :-) In fact, I would only expect x3 to be true but x1 and x2 to be false! IMHO, when terminating a process, halfway-executed unwinded contexts should not be continued. Only not-yet-activated unwind contexts should be triggered. Here are my arguments: * Regular unwinding and process termination should have exactly the same behavior. Assume we manipulated the example from the test like this: [ [ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" self error. x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] on: Error do: [] ] fork. I have highlighted the differences, so what I changed was i) to insert an error handler at the bottom of the process and ii) instead of terminating the process, to raise an error in the innermost block. In this example, only x3 will be set to true which is because the exceptional control flow explicitly discontinues the logic running inside the error handler. Only not-yet-activated unwind contexts will be triggered as part of the unwinding, which only applies to the outermost unwind context. In my view, process termination should have exactly the same semantics as using an exception to abort the control flow. If we would not catch the error in the above example but press Abandon in the appearing debugger instead, I see no reason why we would want to execute a different set of unwind contexts. * Last but not least, the fact that an error has been signaled means that the signalerContext is "infected" so under no circumstances, abandoning the process should resume the execution of this infected context! (The only exception is when you consciously do so via the "Proceed" button in a debugger.) This might become more vivid if I replace the innermost block with the following: x1 := (2 / 0 "error!") > 0. Actually, it is enough to run the following stand-alone: [] ensure: [ x1 := (2 / 0 "error!") > 0 ] If you debug the Abandon button, you can see that another error occurs while terminating the process, which is a MessageNotUnderstood for #> in ZeroDivision. The only reason why a second debugger does not appear is the current bug in Process >> #terminate which "absorbs" subsequent error in this situation and which is currently being discussed in [2]. Sorry for the long message! I hope that you agree with my arguments, and if not, I am very excited to hear your ones. :-) Unless contradicted, I would like to request to change #testNestedUnwind as described above and use the changed version as the general basis for the ongoing discussions in [1, 2]. But maybe I am also just committing a fatal case of false reasoning ... :-) Best, Christoph [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html [2] http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Mon May 17 16:04:56 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 17 May 2021 11:04:56 -0500 (CDT) Subject: [squeak-dev] [BUG(s)] in Context control (#jump, #runUntilErrorOrReturnFrom:) In-Reply-To: <3286bd2468074ef399913ec401e642c6@student.hpi.uni-potsdam.de> References: <3286bd2468074ef399913ec401e642c6@student.hpi.uni-potsdam.de> Message-ID: <1621267496919-0.post@n4.nabble.com> Hi Christoph, has there been a progress on this issue? I've tried scenario2 with your changeset from [1] and the problem is gone :) Is this news? best, [1] http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-gt-gt-nextPut-td5108125i20.html#a5129721 ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From lecteur at zogotounga.net Mon May 17 16:25:21 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Mon, 17 May 2021 18:25:21 +0200 Subject: [squeak-dev] "More Direct Morphic": The Movie In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: <1d9cb2af-28d7-a69d-9a32-ffa8e7d3db9b@zogotounga.net> >> What about Projects and Flaps, can they be added to Cuis? > > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. I do use both. Stef From nicolas.cellier.aka.nice at gmail.com Mon May 17 16:53:20 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 17 May 2021 18:53:20 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> Message-ID: Hi all, Virtual Machine implementation is a detail. SmallInteger are two complement, while LargeNegativeInteger are sign magnitude (with sign encoded in the class). From bit perspective (bitAnd: bitOr: bitAt: etc...), all Integer behave as two complement with an infinite sequence of 1 for negative, and infinite sequence of 0 for positive. We could express this in inspectors with a bits field and a leading ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). Le lun. 17 mai 2021 à 15:35, Marcel Taeumel a écrit : > > The decimal representation is just one of many equivalent > representations. > > The problem being that the basic (machine) representation is not clear. I > think its 2's complement. HEX and OCT -- I suppose -- are very close to the > machine representation. > > That's not an issue for positive numbers. :-) > > Best, > Marcel > > Am 17.05.2021 14:00:36 schrieb Thiede, Christoph < > christoph.thiede at student.hpi.uni-potsdam.de>: > > > > But this would not really match the actual object layout of integers > in Squeak which can have arbitrary sizes ... > > > > So, the binary representation does not make sense, right? And neither > does the HEX or OCT. :-) > > Why do you think so? The object layout of Squeak Integer is not something > like "list of decimal digits". The decimal representation is just one of > many equivalent representations. On the other hand, any complement semantic > adds a completely new concept because it neglects the infinite size of > integers. > > Best, > Christoph > > ------------------------------ > *Von:* Squeak-dev im > Auftrag von Taeumel, Marcel > *Gesendet:* Montag, 17. Mai 2021 13:08:47 > *An:* squeak-dev > *Betreff:* Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz > > > But this would not really match the actual object layout of integers in > Squeak which can have arbitrary sizes ... > > So, the binary representation does not make sense, right? And neither does > the HEX or OCT. :-) > > Best, > Marcel > > Am 17.05.2021 13:07:28 schrieb Thiede, Christoph < > christoph.thiede at student.hpi.uni-potsdam.de>: > > > And I would have expected a 2's complement, right? > > > Ah, now I see. :-) But this would not really match the actual object > layout of integers in Squeak which can have arbitrary sizes ... > > > In my opinion, we should just leave it as is (just maybe without the > space), I don't really like such artificial limitations. :-) > > > Best, > > Christoph > ------------------------------ > *Von:* Squeak-dev im > Auftrag von Taeumel, Marcel > *Gesendet:* Montag, 17. Mai 2021 12:52:23 > *An:* squeak-dev > *Betreff:* Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz > > > Apart from that, I would have expected '-02' instead of '- 02'. :-) > > And I would have expected a 2's complement, right? Or even drop this > representation for negative numbers altogether? > > Best, > Marcel > > Am 17.05.2021 12:49:51 schrieb Thiede, Christoph < > christoph.thiede at student.hpi.uni-potsdam.de>: > > Nice catch! :-) > > > For anyone else wondering about this glitch: > > Before: > > > After: > > > IMO our printing protocol on Number should have a padded argument similar > to the (post-comma) decimal places. > Apart from that, I would have expected '-02' instead of '- 02'. :-) > > Best, > Christoph > ------------------------------ > *Von:* Squeak-dev im > Auftrag von commits at source.squeak.org > *Gesendet:* Donnerstag, 6. Mai 2021 19:05:29 > *An:* squeak-dev at lists.squeakfoundation.org; > packages at lists.squeakfoundation.org > *Betreff:* [squeak-dev] The Trunk: Morphic-mt.1769.mcz > > Marcel Taeumel uploaded a new version of Morphic to project The Trunk: > http://source.squeak.org/trunk/Morphic-mt.1769.mcz > > ==================== Summary ==================== > > Name: Morphic-mt.1769 > Author: mt > Time: 6 May 2021, 7:05:24.828981 pm > UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 > Ancestors: Morphic-ct.1768 > > Fixes minor glitch in objext explorers on integers. > > This makes me wonder ... what are the expectations for negative integers > here? > > =============== Diff against Morphic-ct.1768 =============== > > Item was changed: > ----- Method: Integer>>explorerContents (in category > '*Morphic-Explorer') ----- > explorerContents > > ^#( > ('hexadecimal' 16 2) > ('octal' 8 3) > ('binary' 2 4)) collect: [ :each | | label group | > group := each third. > + label := self abs printStringBase: each second. > - label := self printStringBase: each second. > label := label padded: #left to: (label size > roundUpTo: group) with: $0. > label := String streamContents: [:s | > + self negative ifTrue: [s nextPutAll: '- > ']. > (1 to: label size by: group) > do: [:index | > 1 to: group do: [:gIndex | > s nextPut: (label > at: index + gIndex - 1)]] > separatedBy: [s space]]. > > ObjectExplorerWrapper > with: label > name: each first translated > model: self ]! > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 8037 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: pastedImage.png Type: image/png Size: 7983 bytes Desc: not available URL: From christoph.thiede at student.hpi.uni-potsdam.de Mon May 17 17:09:31 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Mon, 17 May 2021 12:09:31 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1620855596237-0.post@n4.nabble.com> References: <1617642027172-0.post@n4.nabble.com> <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> Message-ID: <1621271371954-0.post@n4.nabble.com> Hi Jaromir, sorry for the late reply. I'm always impressed again by your energy and efforts for Squeak! :-) So, now let's hope that I'll be able to obtain an overview of all the new stuff ... First of all, please read my message in [1] first if you have not already done it. :-) I am quite sure that halfway-executed unwind contexts should *not* be resumed when terminating a process. After studying your changeset, I have rewritten #terminate in the attached changeset to 1) not resume halfway-executed contexts any longer and b) clean up the implementation IMHO significantly. Instead of reinventing the unwinding wheel in Process, I reused the existing logic from Context which is important deduplication. Process-faithful debugging now also works consistently during termination. I have also changed #testNestedUnwinding as proposed in [1]. My implementation passes all process tests, non-local returns seem to work as expected, and, in particular, nested debuggers are spawned and terminated correctly for the hot example from above: > x := nil. > [self error: 'x1'] ensure: [ > [self error: 'x2'] ensure: [ > [self error: 'x3'] ensure: [ > x:=3]. > x:=2]. > x:=1]. Hope you do not find any regressions. :-) I am looking forward to your feedback! --- Even though I have rewritten #terminate entirely, I wanted to leave you some general comments on your approach, maybe they are helpful for your next important contribution: :-) - I think that the fact that you needed to skip certain exceptions manually was a giant suboptimal hack. :-) It was a consequence of the older behavior of #terminate to resume halfway-executed unwinded contexts. I think I have explained in [2] why this was not a good idea. - Instead of modifying #runUntilErrorOrReturnFrom:, I have moved the logic to re-signal the UnhandledError into Process >> #complete:ifError:. The reason is that roerf seems to me like something which we should change as rarely as possible - because of its mind-blowing complexity and because it is used in regular debugging as well. The #resumeUnchecked: part could actually be relevant if there occurs a second UnhandledError while jumping out of reorf. - Some minor comments regarding coding style: I always recommend using as many block-local temps as possible, this makes it easier to understand their scope. In case you haven't heard it before, you might also want to google Guard Clause. :-) It's a very helpful idiom to avoid unnecessarily indented structures. But that's minor remarks only, of course. :-) --- Regarding your other ideas: > This poses a new challenge however - how to kill a debugger if we > deliberately want or have to stop debugging a process immediately, i.e. > without unwinding? Consider this example: > > `[] ensure: [self gotcha]` > > We'd get a debugger with a MNU error (Message Not Understood), abandon it > and get another debugger with the same error creating an infinite > recursion (due to how #doesNotUnderstand is written). This particular > example is taken care of in the changeset but in general I miss a Kill > button - has this been ever considered? If you got an infinite recursion, that must have been another consequence of resuming halfway-executed unwind contexts. Normally, this shouldn't happen (and I also could not reproduce this). But yes, there might be - though very exotic - situations in which you actually want to force-kill a process without executing any unwind contexts. In such situations, I usually manually set the suspendedContext's sender to nil, you can do this directly from the debugger and it does what it should. :-) But yes, I am already planning to add a few more secondary buttons to the debugger (they did something similar in Pharo some time ago, too), and a small Kill button next to Proceed/Abandon could indeed be a nice extension. > I'm afraid my debugger implementation knowledge is presently next to none; > I'll have to put it on my to-do list ;) Learning by doing and debugging it. :-) If you have any questions, please feel free to ask them on the list ... > There's a set of basic semantics tests Tests-jar.448 in the Inbox. I > realized I don't know how to "simulate" pressing debugger's Abandon in a > test but I'll add more when I figure it out :) Plus more test will come if > the change proposed here is accepted. Great work! They're unfortunately deprecated if we do not want to resume halfway-executed unwind contexts, but you could update them if you agree. Apart from that, you could also take a look at DebuggerTests if you want to learn how to write E2E tests for the debugger. But I think that your tests already operate at a good level of abstraction. Best, Christoph fix-Process-terminate.cs [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Mon May 17 17:20:14 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Mon, 17 May 2021 12:20:14 -0500 (CDT) Subject: [squeak-dev] [BUG(s)] in Context control (#jump, #runUntilErrorOrReturnFrom:) In-Reply-To: <1621267496919-0.post@n4.nabble.com> References: <3286bd2468074ef399913ec401e642c6@student.hpi.uni-potsdam.de> <1621267496919-0.post@n4.nabble.com> Message-ID: <1621272014853-0.post@n4.nabble.com> Hi Jaromir, I was actually aware of this, but thanks for the follow-up! :-) Now we need some more feedback on the changeset in [1] ... [1] http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-gt-gt-nextPut-td5108125i20.html#a5129721 Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Mon May 17 17:38:10 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Mon, 17 May 2021 12:38:10 -0500 (CDT) Subject: [squeak-dev] Tackling Context>>#runUntilErrorReturnFrom: (was: BUG/REGRESSION while debugging Generator >> #nextPut:) In-Reply-To: <1621102291419-0.post@n4.nabble.com> References: <9ed2db8e40684297b83d98e311e76a4b@student.hpi.uni-potsdam.de> <25a67367ce4f4ee68d0509659cb10c72@student.hpi.uni-potsdam.de> <1615231296272-0.post@n4.nabble.com> <1615566932862-0.post@n4.nabble.com> <1620851547306-0.post@n4.nabble.com> <1621102291419-0.post@n4.nabble.com> Message-ID: <1621273090858-0.post@n4.nabble.com> Version 7 of the changeset fixes glitches reported by Jaromir in [1]: runUntilErrorOrReturnFrom.cs Best, Christoph [1] http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-tp5128777p5129736.html ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Mon May 17 17:50:29 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Mon, 17 May 2021 12:50:29 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1621160475891-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> <1621002532100-0.post@n4.nabble.com> <1621102564397-0.post@n4.nabble.com> <1621160475891-0.post@n4.nabble.com> Message-ID: <1621273829599-0.post@n4.nabble.com> Hi Jaromir, thanks for the feedback. \2 and \3 were both minor slips which I have corrected in version 7 of the changeset, see: http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-nextPut-tp5108125p5129807.html \1: Fair question. I think I stumbled upon some situation where stepping *over* #runUntilErrorOrReturnFrom: has not worked for me without these lines. I just had inserted the "push: nil" without thinking about it in detail, just because it had also worked for me in Context class >> #contextEnsure: and #contextOn:do: in the last year (this was also a very interesting bug, you can read the full story in the mailing archives if you are interested). But yes, that is suspicious, I need to recheck this because I cannot reproduce the need for this patch. \2: This was indeed a slip because I forgot to update the image. I have moved my patch to #findNextHandlerContext - it makes the method robust against bottom-contexts that do not have a sender (i.e., sender is nil). \3: Ah, in this case, the unwind context was already marked as complete. :-) Since we appear to need the debugger information anyway, I have moved the #informDebuggerAboutContextSwitchTo: in #resume:through: before the check so your example now should work, too. I'm curious whether you can find any other regressions in the changeset! :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From frank.shearar at gmail.com Mon May 17 18:05:11 2021 From: frank.shearar at gmail.com (Frank Shearar) Date: Mon, 17 May 2021 11:05:11 -0700 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: <20210516151000.GA16478@shell.msen.com> Message-ID: Nicolas, are you aware of SAT-SMT solvers? (SAT/SMT by Example (sat-smt.codes) ) Microsoft used Z3 to great effect in flushing out bugs in Vista. SAT-SMT's used in a thing called Concolic testing - Wikipedia , frank On Mon, 17 May 2021 at 05:14, Nicolas Cellier < nicolas.cellier.aka.nice at gmail.com> wrote: > More seriously, there is not a single kind of test. > One category is kind of specification illustrating the expectations, > and demonstrating how to use some message/class. > Most of the time, our tests as specification lack the quantifiers > (like the universal quantifier), that's why I name them illustrating. > Ideally, we would like to have some form of formal proof, but there > rarely is one accessible, unless we drastically restrict the > capabilities (like recursivity and all forms of reflexivity) > At least, that's my understanding of > https://en.wikipedia.org/wiki/Formal_methods > > In some rare cases, we now have enough computing power to test an > implementation exhaustively (like a function of a single float32 > argument). > Alternatively, we can try and test with randomly generated inputs, but > that's a bit like shooting in the dark. > > In order to be more eager, we sometimes write tests against a specific > implementation with specially crafted examples for non regression or > main gotchas of the specific algorithm. > I guess my efforts fall in such a category: it's kind of adversarial > strategy; somehow like a game of finding the shortcomings. > If we have watts to burn, I think that it would be interesting to use > machine power to find and construct those adversarial examples, not > based on sole randomness, but some form of analysis of algorithms and > probably some set of heuristics. > How could we build such machinery, I don't know, for now it's still > buzzwords. > > Le lun. 17 mai 2021 à 12:00, Nicolas Cellier > a écrit : > > > > Le dim. 16 mai 2021 à 17:10, David T. Lewis a > écrit : > > > > > > On Fri, May 07, 2021 at 07:39:50PM +0000, commits at source.squeak.org > wrote: > > > > Nicolas Cellier uploaded a new version of Kernel to project The > Trunk: > > > > http://source.squeak.org/trunk/Kernel-nice.1402.mcz > > > > > > > > > > > > Musing is more powerful than dumb static and coverage tests, I wish > I got more time for musing :) > > > > We deadly need evolutive testing (neural based). > > > > > > > > > > Interesting commit comment. How might this work? > > > > > > Dave > > > > > > > > Hi Dave, > > How? This way: put enough buzzwords in commit comments to bring some > > academics on the subject ;) > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Mon May 17 18:06:55 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 17 May 2021 13:06:55 -0500 (CDT) Subject: [squeak-dev] [BUG(s)] in Context control (#jump, #runUntilErrorOrReturnFrom:) In-Reply-To: <3286bd2468074ef399913ec401e642c6@student.hpi.uni-potsdam.de> References: <3286bd2468074ef399913ec401e642c6@student.hpi.uni-potsdam.de> Message-ID: <1621274815841-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > The same goes for #runUntilErrorOrReturnFrom:, because when "here jump" is > executed, "here" again is neither a sender of the block context, nor it > has is return value on stack. > > In a nutshell, to us, it has been keeping an open question so far whether > the other senders of #jump are legitime. Just a quick answer to this one as I was just looking at it: #runUntilErrorOrReturnFrom: is a different story - in this case "here" is the context the #jump jumps from, i.e. "here" is the sender and #jump will push nil to here's stack and make it a top context. Thus no fix needed. In your case of #contextEnsure: the #jump happened from a context higher above and "ctxt" wasn't the sender thus your fix was necessary. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Mon May 17 19:29:53 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 17 May 2021 14:29:53 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1621273829599-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> <1621002532100-0.post@n4.nabble.com> <1621102564397-0.post@n4.nabble.com> <1621160475891-0.post@n4.nabble.com> <1621273829599-0.post@n4.nabble.com> Message-ID: <1621279793278-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > Hi Jaromir, > > thanks for the feedback. \2 and \3 were both minor slips which I have > corrected in version 7 of the changeset, see: > http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-nextPut-tp5108125p5129807.html > > \1: Fair question. I think I stumbled upon some situation where stepping > *over* #runUntilErrorOrReturnFrom: has not worked for me without these > lines. I just had inserted the "push: nil" without thinking about it in > detail, just because it had also worked for me in Context class >> > #contextEnsure: and #contextOn:do: in the last year (this was also a very > interesting bug, you can read the full story in the mailing archives if > you > are interested). But yes, that is suspicious, I need to recheck this > because > I cannot reproduce the need for this patch. I've updated http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFrom-td5107263.html with my explanation why I /think/ #runUntilErrorOrReturnFrom: works correctly. Christoph Thiede wrote > \2: This was indeed a slip because I forgot to update the image. I have > moved my patch to #findNextHandlerContext - it makes the method robust > against bottom-contexts that do not have a sender (i.e., sender is nil). The changeset still seems to have the old version of #runUntilErrorOrReturnFrom: and #nextHandlerContext nixing Nicolas's changes made in the meantime... Christoph Thiede wrote > \3: Ah, in this case, the unwind context was already marked as complete. > :-) > Since we appear to need the debugger information anyway, I have moved the > #informDebuggerAboutContextSwitchTo: in #resume:through: before the check > so > your example now should work, too. Yes!, my non-local examples work OK now, your scenarios as well; I'll keep it in my images to give it a ride :) As for the general approach - I look forward to learning from experts ;) later, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From jakres+squeak at gmail.com Mon May 17 20:09:38 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Mon, 17 May 2021 22:09:38 +0200 Subject: [squeak-dev] Flaps aren't dead! They feel happy! (was Re: "More Direct Morphic": The Movie) In-Reply-To: References: <317501fa65a3f485358ddcc99994ab7b@whidbey.com> Message-ID: I also use flaps to move windows between projects (in particular to parent projects), and to stash away windows related to a topic that I will continue later, to declutter my screen. Most of the time I don't know in advance that I will want a separate project for all those windows when I start digging into something. Otherwise I use projects as the multiple desktops substitute, or as the task-focused interface as Eclipse Mylyn would call it... But I usually do not use the contents of the flaps that come preinstalled. Am Mo., 17. Mai 2021 um 13:01 Uhr schrieb Marcel Taeumel : > > I like flaps. :-) But I don't use them. > > Best, > Marcel > > Am 17.05.2021 09:15:42 schrieb Tony Garnock-Jones : > > I use flaps! Specifically, in my experimentation with > squeak-on-a-cellphone, I put the on screen keyboard in a flap, and open > the flap automatically whenever keyboard focus switches to something > non-nil: > > newKeyboardFocus: aMorphOrNil > aMorphOrNil > ifNil: [OnScreenKeyboardMorph hideFlap] > ifNotNil: [(OnScreenKeyboardMorph future: 200) raiseFlap]. > ^ super newKeyboardFocus: aMorphOrNil. > > It works surprisingly well for this. Being able to adjust the height of > the keyboard by moving the flap, etc. > > Cheers, > Tony > > > > On 5/16/21 8:13 PM, tim Rowledge wrote: > > > > > >> On 2021-05-16, at 5:38 AM, Herbert König wrote: > >> > >> What about Projects and Flaps, can they be added to Cuis? > > > > I'm actually surprised to see that someone uses these any more; is this still a popular thing? I'd be very happy to see them go away in most respects. I suppose Projects could be argued to have some utility for the 'rescue project' but I don't think I've seen anyone use Flaps in decades. > > > > > > tim > > -- > > tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim > > Engineers work to a couple of decimal places; Physicists work to an order of magnitude; Astrophysicists work to an order of magnitude in the exponent > > > > > > > > > > > > From nicolas.cellier.aka.nice at gmail.com Mon May 17 20:53:07 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 17 May 2021 22:53:07 +0200 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: <20210516151000.GA16478@shell.msen.com> Message-ID: Hi Frank, Thanks for the links. Le lun. 17 mai 2021 à 20:05, Frank Shearar a écrit : > Nicolas, are you aware of SAT-SMT solvers? (SAT/SMT by Example > (sat-smt.codes) ) Microsoft > used Z3 to great effect in flushing out bugs in Vista. SAT-SMT's used in a > thing called Concolic testing - Wikipedia > , > > frank > > On Mon, 17 May 2021 at 05:14, Nicolas Cellier < > nicolas.cellier.aka.nice at gmail.com> wrote: > >> More seriously, there is not a single kind of test. >> One category is kind of specification illustrating the expectations, >> and demonstrating how to use some message/class. >> Most of the time, our tests as specification lack the quantifiers >> (like the universal quantifier), that's why I name them illustrating. >> Ideally, we would like to have some form of formal proof, but there >> rarely is one accessible, unless we drastically restrict the >> capabilities (like recursivity and all forms of reflexivity) >> At least, that's my understanding of >> https://en.wikipedia.org/wiki/Formal_methods >> >> In some rare cases, we now have enough computing power to test an >> implementation exhaustively (like a function of a single float32 >> argument). >> Alternatively, we can try and test with randomly generated inputs, but >> that's a bit like shooting in the dark. >> >> In order to be more eager, we sometimes write tests against a specific >> implementation with specially crafted examples for non regression or >> main gotchas of the specific algorithm. >> I guess my efforts fall in such a category: it's kind of adversarial >> strategy; somehow like a game of finding the shortcomings. >> If we have watts to burn, I think that it would be interesting to use >> machine power to find and construct those adversarial examples, not >> based on sole randomness, but some form of analysis of algorithms and >> probably some set of heuristics. >> How could we build such machinery, I don't know, for now it's still >> buzzwords. >> >> Le lun. 17 mai 2021 à 12:00, Nicolas Cellier >> a écrit : >> > >> > Le dim. 16 mai 2021 à 17:10, David T. Lewis a >> écrit : >> > > >> > > On Fri, May 07, 2021 at 07:39:50PM +0000, commits at source.squeak.org >> wrote: >> > > > Nicolas Cellier uploaded a new version of Kernel to project The >> Trunk: >> > > > http://source.squeak.org/trunk/Kernel-nice.1402.mcz >> > > > >> > > > >> > > > Musing is more powerful than dumb static and coverage tests, I wish >> I got more time for musing :) >> > > > We deadly need evolutive testing (neural based). >> > > > >> > > >> > > Interesting commit comment. How might this work? >> > > >> > > Dave >> > > >> > > >> > Hi Dave, >> > How? This way: put enough buzzwords in commit comments to bring some >> > academics on the subject ;) >> >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From asqueaker at gmail.com Mon May 17 21:13:09 2021 From: asqueaker at gmail.com (Chris Muller) Date: Mon, 17 May 2021 16:13:09 -0500 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz In-Reply-To: References: Message-ID: Does this mean that installation of software can now fail silently in the 100% normal case, e.g., with no Error signaled? (sorry, a line that scrolled out of the Transcript after 100ms is not an adequate warning at all). Installing Cuis code is typically a "one time thing" for a port of some app, here or there, and someone would simply hack your change in temporarily. I don't understand why you feel this should be a regular part of trunk. Making things less-strict willy-nilly invites future issues... On Sat, May 15, 2021 at 12:25 PM wrote: > > David T. Lewis uploaded a new version of System to project The Trunk: > http://source.squeak.org/trunk/System-dtl.1233.mcz > > ==================== Summary ==================== > > Name: System-dtl.1233 > Author: dtl > Time: 15 May 2021, 1:25:37.809444 pm > UUID: 660215fe-f151-4184-8a31-8775202baa81 > Ancestors: System-nice.1232 > > Be permissive when filing in Cuis packages. Skip chunks that begin with known extensions that are not meaningful for Squeak, logging to Transcript to show chunks that have been ignored. > > =============== Diff against System-nice.1232 =============== > > Item was changed: > ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') ----- > fileInAnnouncing: announcement > "This is special for reading expressions from text that has been formatted > with exclamation delimitors. The expressions are read and passed to the > Compiler. Answer the result of compilation. Put up a progress report with > the given announcement as the title." > > | val | > announcement > displayProgressFrom: 0 > to: self size > during: > [:bar | > [self atEnd] whileFalse: > [bar value: self position. > self skipSeparators. > > [ | chunk | > val := (self peekFor: $!!) > + ifTrue: [ | ch | > + ch := self nextChunk. > + (self shouldIgnore: ch) > + ifTrue: [Transcript showln: 'Ignoring chunk: ', ch] > + ifFalse: [(Compiler evaluate: ch logged: true) scanFrom: self]] > - ifTrue: [(Compiler evaluate: self nextChunk logged: true) scanFrom: self] > ifFalse: > [chunk := self nextChunk. > self checkForPreamble: chunk. > Compiler evaluate: chunk logged: true]] > on: InMidstOfFileinNotification > do: [:ex | ex resume: true]. > self skipStyleChunk]. > self close]. > "Note: The main purpose of this banner is to flush the changes file." > Smalltalk logChange: '----End fileIn of ' , self name , '----'. > self flag: #ThisMethodShouldNotBeThere. "sd" > ^val! > > Item was added: > + ----- Method: PositionableStream>>shouldIgnore: (in category '*System-Changes-fileIn/Out') ----- > + shouldIgnore: chunk > + "Fileouts created on another Smalltalk may contain chunks that are > + not meaningful for Squeak. Answer true if chunk should be ignored." > + > + ^ ((chunk beginsWith: 'provides:') "Cuis Smalltalk extensions" > + or: [chunk beginsWith: 'requires:']) > + or: [chunk beginsWith: 'classDefinition:'] > + ! > > From nicolas.cellier.aka.nice at gmail.com Mon May 17 21:21:50 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Mon, 17 May 2021 23:21:50 +0200 Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination In-Reply-To: References: Message-ID: Hi Christoph, I guess that the original intention was to perform the cleanup (like releasing resources) even if we close the debugger in the midst of unwinding. Whether this is a good idea or not is questionable indeed if the debugger was opened due to unhandled error during execution of unwind block. But the debugger was not necessarily opened during unwinding... The question you raise is whether we are trying to be too much clever... It might be. Le lun. 17 mai 2021 à 17:30, Thiede, Christoph < Christoph.Thiede at student.hpi.uni-potsdam.de> a écrit : > Hi all, hi Jaromir, > > > I'm raising a new question in this post that is related to the following > threads, but I think that it deserves its own thread due to the fundamental > criticism expressed: [1, 2] > > I just took a closer look at *ProcessTest >> #testNestedUnwind* and I > have to say that I don't agree with it. I'm sorry that I did not mention > this earlier, but somehow this aspect of Jaromir's large amount of recent > work has escaped my attention before today. For reference, so that we all > know what we are talking about, here is the test in question: > > testNestedUnwind > > "Test all nested unwind blocks are correctly unwound; all unwind blocks > halfway through their execution should be completed or at least attempted > to complete, not only the innermost one" > > > | p x1 x2 x3 | > > x1 := x2 := x3 := false. > > p := > > [ > > [ > > [ ] ensure: [ "halfway through completion when suspended" > > [ ] ensure: [ "halfway through completion when suspended" > > Processor activeProcess suspend. > > x1 := true]. > > x2 := true] > > ] ensure: [ "not started yet when suspended" > > x3 := true] > > ] fork. > > Processor yield. > > p terminate. > > self assert: x1 & x2 & x3. > > > I'm not convinced about the assertions in this test. :-) In fact, I > would only expect x3 to be true but x1 and x2 to be false! > IMHO, when terminating a process, halfway-executed unwinded contexts > should not be continued. Only not-yet-activated unwind contexts should be > triggered. > Here are my arguments: > > > - *Regular unwinding and process termination should have exactly > the same behavior.* > > Assume we manipulated the example from the test like this: > [ > *[* > [ > [ ] ensure: [ "halfway through completion when suspended" > [ ] ensure: [ "halfway through completion when suspended" > *self error.* > x1 := true]. > x2 := true] > ] ensure: [ "not started yet when suspended" > x3 := true] > *] on: Error do: []* > ] fork. > I have highlighted the differences, so what I changed was i) to insert an > error handler at the bottom of the process and ii) instead of terminating > the process, to raise an error in the innermost block. > In this example, only x3 will be set to true which is because the > exceptional control flow explicitly discontinues the logic running inside > the error handler. Only not-yet-activated unwind contexts will be triggered > as part of the unwinding, which only applies to the outermost unwind > context. > In my view, process termination should have exactly the same semantics as > using an exception to abort the control flow. > If we would not catch the error in the above example but press Abandon in > the appearing debugger instead, I see no reason why we would want to > execute a different set of unwind contexts. > > > - Last but not least, the fact that an error has been signaled means > that the signalerContext is "infected" so under no circumstances, > abandoning the process should resume the execution of this infected > context! (The only exception is when you consciously do so via the > "Proceed" button in a debugger.) This might become more vivid if I replace > the innermost block with the following: > > x1 := (2 / 0 "error!") > 0. > > Actually, it is enough to run the following stand-alone: > > [] ensure: [ > > x1 := (2 / 0 "error!") > 0 > > ] > > If you debug the Abandon button, you can see that another error occurs while > terminating the process, which is a *MessageNotUnderstood for #> in > ZeroDivision.* The only reason why a second debugger does not appear is > the current bug in Process >> #terminate which "absorbs" subsequent error > in this situation and which is currently being discussed in [2]. > > > Sorry for the long message! I hope that you agree with my arguments, and > if not, I am very excited to hear your ones. :-) Unless contradicted, I > would like to request to change #testNestedUnwind as described above and > use the changed version as the general basis for the ongoing discussions in > [1, 2]. But maybe I am also just committing a fatal case of false reasoning > ... :-) > > Best, > Christoph > > [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html > [2] > http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Mon May 17 22:00:37 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 17 May 2021 17:00:37 -0500 (CDT) Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination In-Reply-To: References: Message-ID: <1621288837863-0.post@n4.nabble.com> Hi Christoph, > IMHO, when terminating a process, halfway-executed unwinded contexts > should not be continued. Only not-yet-activated unwind contexts should be > triggered. Yes, I too was wondering why there are different unwind semantics in various situations (error handling, active process unwind, active and suspended process termination); why there's not just one common semantics for all. My conclusion was completing half-ways through unwind blocks was way more complex than unwinding just the not-yet-started unwind blocks. As a result (my opinion) Squeak implemented just the completion of the most recent half-ways through unwind block during termination, and VisualWorks went a step further and implemented the completion of the outer-most half-ways through unwind block. Both however left the termination of the active process on the basic level - no completion of half-ways through blocks. In my attempt I proposed to unify the semantics of active process and suspended process termination by suspending the active process and terminating is as a suspended process. I was considering a fun discussion about extending the error handling and unwind semantics to match the termination unwind semantics - i.e. including completion of half-ways through unwind blocks during normal returns - but that's most likely in the "way too clever" territory :) Your proposition goes in the opposite direction however - to reduce the termination semantics to match the current error handling and active process unwind semantics. Well, I personally prefer completing the half-ways through unwind blocks where possible. In my mind it means "try to repair or clean-up as much as possible before ending a process". I still think completing half-ways through unwind blocks is worth the extra effort. Regarding the example: > [ > [ > [ > [ ] ensure: [ "halfway through completion" > [ ] ensure: [ "halfway through completion" > self error. > x1 := true]. > x2 := true] > ] ensure: [ "not started yet" > x3 := true] > ] on: Error do: [] > ] fork > {x1 . x2 . x3} ---> #(nil nil true) > > In my view, process termination should have exactly the same semantics as > using an exception to abort the control flow. > If we would not catch the error in the above example but press Abandon in > the appearing debugger instead, I see no reason why we would want to > execute a different set of unwind contexts. I disagree here: If we would not catch the error, we would be in a different situation: an error would have occurred which we would not have anticipated, thus abandoning the debugger would be a different intentional action than a controlled and anticipated return from an exception. I may argue we could even attempt to unwind as if terminating but I'm not sure it'd be justified. So actually I must admit a different semantics here may even be desirable. I'm not sure in this regard. So to conclude, unification was my original driver but I'm no longer so sure... Termination may be a different beast than a regular return or handled error after all. Thanks for this discussion, I look forward to taking a closer look at your changeset! Hi Nicolas, Nicolas Cellier wrote > Hi Christoph, > I guess that the original intention was to perform the cleanup (like > releasing resources) even if we close the debugger in the midst of > unwinding. > Whether this is a good idea or not is questionable indeed if the debugger > was opened due to unhandled error during execution of unwind block. > But the debugger was not necessarily opened during unwinding... > The question you raise is whether we are trying to be too much clever... > It > might be. Yes indeed, trying to be too clever is very dangerous!! I'm old enough to know first hand :D Thanks, best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From asqueaker at gmail.com Mon May 17 22:51:51 2021 From: asqueaker at gmail.com (Chris Muller) Date: Mon, 17 May 2021 17:51:51 -0500 Subject: [squeak-dev] The Inbox: Tools-ct.1054.mcz In-Reply-To: <86213ab9ee3e4fbcabfbcac3fd3c0783@student.hpi.uni-potsdam.de> References: <86213ab9ee3e4fbcabfbcac3fd3c0783@student.hpi.uni-potsdam.de> Message-ID: Hey Christoph, hey all, sorry, but I care about this one. :/ Everyone agrees that pretty-printers are useful, it's about the responsibility and activation. You overlooked my question about the philosophical inversion of the responsibility, from the developer to the machine. Tools should *empower* the developer with convenient activation of PLUS operations *if desired*, NOT take over and obliterate their intentional formatting and force them into an even more-distracting corrective operation. It isn't clear what problem you're trying to solve, and you also ignored the question of why #browseWithPrettyPrint doesn't already solve it. It can't be Tom's vision, because you would need a postscript to reformat all methods in the system. So, it seems like you're still going to have to rely on #browseWithPrettyPrint in any case. Anything more is an overstep against the developer. I'm doubtful consensus on what the stored format should be could ever be achieved, and whether it would even be healthy if it "could". Even you yourself may change your mind one day about a particular formatting rule, so what good will it been to have rewritten all the code libraries, instead of simply adjusting your (and, each, their own) #browseWithPrettyPrint? > these are very good points for further and tighter integration of a pretty printer into the system (I'm mainly referring to customized and project-specific settings), and I'm sure that Tom and his team will consider at least some of them for PoppyPrint. :-) Nevertheless, I don't think that we should hesitate to integrate new features like this one into the Trunk as experimental features. The Inbox is for experimental features. The Trunk is for finished features that integrate in a cohesive way. Piling on features that don't integrate cohesively are detrimental to the IDE. > Unless turned on by default, I don't see how this could harm anyone, It harms the IDE by violating a basic premise of not controlling the developer. The simplest, best IDE's are one's made up of "Unconditional Plus Actions". This preference introduces behavior conditioned on yet another new global. Imagine trying to explain this to a student who just lost their artfully-formatted code. Having to explain "pretty-print" with, vs. without, this feature. Again, #browseWithPrettyPrint avoids these issues. > but it allows certain users to configure their image to better match their individual preference, so we can give them more freedom. I think we should be more open to and supportive of new ideas, even if they do not perfectly fit > together. Marcel is plenty open and supportive of new ideas. You should stick to the core _specific_ arguments for this. These abstract platitudes could be argued for any idea about anything.. > At the moment, the preference offers a working prototype that interested users can enable - when working on projects that do not enforce a different coding style - and benefit from additional convenience while writing their code. You mean sparing one hot-key press per method save? (<-- except, NOT, see? -->) That's not much convenience, because the imperfect formatter won't always do what you want. Then, you'll have to click back in and re-edit the method, press "Save" again, ... except, OOPS! Wait, it overrode you the developer *again*, so simply temporarily turn off this preference, re-edit a third time, THEN save again, THEN turn the pref back on...?? If the above "never happens", then you could simply use #browseWithPrettyPrint. If it does, you would use up the entire day's added "convenience" the very first time it happened (believe me, it would). > I'm liking this feature very much while developing my latest project. I'm also making good experiences with the analogous concept in the JavaScript world (VS Code "formatOnSave" + eslint) these days. It's a bad idea there, too. They should improve to be more empowering like Squeak. Please have faith that Squeak's designers have thought through some of these things since the 1970's, and sometimes have better ideas than the new kids on the block.. :) > > Squeak Trunk should not do that [enforce such formatting] > > I'm not requesting that here. At least not yet. This will enough stuff for a future discussion. :-) Reading and writing code is a personal thing. As long as it's basically readable, code in the library should reflect the individuals' style who contributed it. IMO, stripping away that personalization from everyone would not only be harmful to the class-library, it could stifle creative energy and ways of thinking, and possibly even foster resentment. Some see this level of control as overbearing and petty, especially in the presence of #browseWithPrettyPrint, and so it could cause "formatting" to end up becoming the very thing you wanted to avoid, a major distraction. > > it should [...] rather be done at commit time (or code-review time) > > -1. :-) The idea of automatic pretty-printing is that you do not have to spend any time or thoughts on thinking about the proper formatting of a method. Thus the earlier automatic pretty-printing is applied, the less the programmer gets distracted by thinking about manual formatting. We already don't have to. Pretty-printing is already a useful feature, as long as I can apply it easily, when and where I want to, and not have to "fight" against it where I don't want it. Again, with #browseWithPrettyPrint, you shouldn't either... > I would even love to try out pretty-printing as you type, but this would be technically more challenging. OMG, that is exactly when you would get *distracted* by it! The text editor not behaving as you expect because it's busy "formatting" while you're simply trying to "input". Also, I like to left-justify debugging code, I actually want it to NOT be formatted in.. Pretty-print is just right the way it is, #acceptWithPrettyPrint is a bad idea to add to the IDE, IMO. Best, Chris From lewis at mail.msen.com Tue May 18 02:39:21 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Mon, 17 May 2021 22:39:21 -0400 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz In-Reply-To: References: Message-ID: <20210518023921.GA34512@shell.msen.com> On Mon, May 17, 2021 at 04:13:09PM -0500, Chris Muller wrote: > Does this mean that installation of software can now fail silently in > the 100% normal case, e.g., with no Error signaled? (sorry, a line > that scrolled out of the Transcript after 100ms is not an adequate > warning at all). > No, that is not what it means. It means that the installation should succeed gracefully, rather than failing unnecessarily. > Installing Cuis code is typically a "one time thing" for a port of > some app, here or there, and someone would simply hack your change in > temporarily. I don't understand why you feel this should be a regular > part of trunk. Making things less-strict willy-nilly invites future > issues... > No, it does not invite future issues. See the PositionableStream>>shouldIgnore: method comment: Fileouts created on another Smalltalk may contain chunks that are not meaningful for Squeak. Answer true if chunk should be ignored. And as explained in the commit comment: Skip chunks that begin with known extensions that are not meaningful for Squeak, logging to Transcript to show chunks that have been ignored. With respect to the Cuis reference, my use case was installing VectorEnginePlugin in Squeak. The upstream repository for this plugin is on GitHub, which stores the portable Smalltalk code in chunk format with some Cuis extensions: https://github.com/Cuis-Smalltalk/Cuis-Smalltalk-Dev/blob/master/Packages/Features/VectorEnginePlugin.pck.st The plugin code is well-written and portable for at least Squeak and Cuis. The Cuis-specific chunks are not relevant to Squeak, so they can and should be ignored when filing in to Squeak. Dave > > On Sat, May 15, 2021 at 12:25 PM wrote: > > > > David T. Lewis uploaded a new version of System to project The Trunk: > > http://source.squeak.org/trunk/System-dtl.1233.mcz > > > > ==================== Summary ==================== > > > > Name: System-dtl.1233 > > Author: dtl > > Time: 15 May 2021, 1:25:37.809444 pm > > UUID: 660215fe-f151-4184-8a31-8775202baa81 > > Ancestors: System-nice.1232 > > > > Be permissive when filing in Cuis packages. Skip chunks that begin with known extensions that are not meaningful for Squeak, logging to Transcript to show chunks that have been ignored. > > > > =============== Diff against System-nice.1232 =============== > > > > Item was changed: > > ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') ----- > > fileInAnnouncing: announcement > > "This is special for reading expressions from text that has been formatted > > with exclamation delimitors. The expressions are read and passed to the > > Compiler. Answer the result of compilation. Put up a progress report with > > the given announcement as the title." > > > > | val | > > announcement > > displayProgressFrom: 0 > > to: self size > > during: > > [:bar | > > [self atEnd] whileFalse: > > [bar value: self position. > > self skipSeparators. > > > > [ | chunk | > > val := (self peekFor: $!!) > > + ifTrue: [ | ch | > > + ch := self nextChunk. > > + (self shouldIgnore: ch) > > + ifTrue: [Transcript showln: 'Ignoring chunk: ', ch] > > + ifFalse: [(Compiler evaluate: ch logged: true) scanFrom: self]] > > - ifTrue: [(Compiler evaluate: self nextChunk logged: true) scanFrom: self] > > ifFalse: > > [chunk := self nextChunk. > > self checkForPreamble: chunk. > > Compiler evaluate: chunk logged: true]] > > on: InMidstOfFileinNotification > > do: [:ex | ex resume: true]. > > self skipStyleChunk]. > > self close]. > > "Note: The main purpose of this banner is to flush the changes file." > > Smalltalk logChange: '----End fileIn of ' , self name , '----'. > > self flag: #ThisMethodShouldNotBeThere. "sd" > > ^val! > > > > + ----- Method: PositionableStream>>shouldIgnore: (in category '*System-Changes-fileIn/Out') ----- > > + shouldIgnore: chunk > > + "Fileouts created on another Smalltalk may contain chunks that are > > + not meaningful for Squeak. Answer true if chunk should be ignored." > > + > > + ^ ((chunk beginsWith: 'provides:') "Cuis Smalltalk extensions" > > + or: [chunk beginsWith: 'requires:']) > > + or: [chunk beginsWith: 'classDefinition:'] > > + ! > > > > > > > Item was added: From Christoph.Thiede at student.hpi.uni-potsdam.de Tue May 18 11:21:25 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Tue, 18 May 2021 11:21:25 +0000 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello Message-ID: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Hi all, while loading a class (MyClass) with an attached pool dictionary (MyPool) today using Monticello, I encountered an error from MCPackageLoader which states: Warning: This package depends on the following classes: MyPool This error message does not make sense to me since MyPool is not a class but a pool dictionary. But in MCClassDefinition >> #requirements, all #poolDictionaries are explicitly added to the list of required items. If I exclude them from this list, I get a warning "The pool dictionary MyPool does not exist. Do you want it automatically created?" later from Class >> #sharing:. Is this a bug? I also tried to manually add the pool dictionary initialization (Smalltalk at: #MyPool put: Dictionary new) into the preamble of the package, but this preamble is also evaluated too late (i.e., not before the dependency warning is raised. Also, this feels a bit too redundant to me. Do we need a new subclass of MCDefinition to create pool dictionaries automatically? Or could we just remove the confirmation dialog in Class >> #sharing: so that new pools will automatically be created, especially in non-interactive CI contexts? Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Tue May 18 11:55:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 18 May 2021 11:55:53 0000 Subject: [squeak-dev] The Trunk: ToolBuilder-Morphic-mt.276.mcz Message-ID: Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.276.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.276 Author: mt Time: 18 May 2021, 1:55:52.205287 pm UUID: 8fd06e0a-20b0-3d41-bf57-4e5dfcc69f87 Ancestors: ToolBuilder-Morphic-mt.275 Fix custom invocation of Workspace for string edit to not use the public interface for opening a workspace. (This is a minor regression since the addiction of #embedTranscript earlier this month.) =============== Diff against ToolBuilder-Morphic-mt.275 =============== Item was changed: ----- Method: MorphicUIManager>>edit:label:shouldStyle:accept: (in category 'ui requests') ----- edit: aText label: labelString shouldStyle: aBoolean accept: anAction "Open an editor on the given string/text" + + | workspace | + workspace := Workspace new - | window | - window := Workspace open. - labelString ifNotNil: [ window setLabel: labelString ]. - window model shouldStyle: aBoolean; acceptContents: aText; acceptAction: anAction. + ^ workspace openLabel: (labelString ifNil: [workspace labelString])! - ^ window! From commits at source.squeak.org Tue May 18 11:58:28 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 18 May 2021 11:58:28 0000 Subject: [squeak-dev] The Trunk: Tools-mt.1056.mcz Message-ID: Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1056.mcz ==================== Summary ==================== Name: Tools-mt.1056 Author: mt Time: 18 May 2021, 1:58:25.950287 pm UUID: f32e4e04-6f83-d641-ba5a-0de0c535aa73 Ancestors: Tools-mt.1055 Tweak #embedTranscript to only apply when opening a regular workspace via class-side #open. Note that the workspace model is re-used for other purposes such as string edit. See UIManager. Adds new preference to file-out workspace contents on accept. Thanks to Jaromir for the idea! Preference is enabled by default since there was noe default accept-action in workspaces yet. =============== Diff against Tools-mt.1055 =============== Item was changed: StringHolder subclass: #Workspace instanceVariableNames: 'bindings acceptDroppedMorphs acceptAction mustDeclareVariables shouldStyle environment' + classVariableNames: 'DeclareVariablesAutomatically EmbedTranscript FileOutFilePath FileOutOnAccept LookupPools ShouldStyle' - classVariableNames: 'DeclareVariablesAutomatically EmbedTranscript LookupPools ShouldStyle' poolDictionaries: '' category: 'Tools-Base'! !Workspace commentStamp: 'fbs 6/2/2012 20:46' prior: 0! A Workspace is a text area plus a lot of support for executable code. It is a great place to execute top-level commands to compute something useful, and it is a great place to develop bits of a program before those bits get put into class methods. To open a new workspace, execute: Workspace open A workspace can have its own variables, called "workspace variables", to hold intermediate results. For example, if you type into a workspace "x := 5" and do-it, then later you could type in "y := x * 2" and y would become 10. Additionally, in Morphic, a workspace can gain access to morphs that are on the screen. If acceptDroppedMorphs is turned on, then whenever a morph is dropped on the workspace, a variable will be created which references that morph. This functionality is toggled with the window-wide menu of a workspace. The instance variables of this class are: bindings - holds the workspace variables for this workspace acceptDroppedMorphs - whether dropped morphs should create new variables! Item was changed: ----- Method: Workspace class>>embedTranscript (in category 'preferences') ----- embedTranscript ^ EmbedTranscript ifNil: [ false ]! Item was added: + ----- Method: Workspace class>>fileOut: (in category 'support') ----- + fileOut: contents + "Write the given contents into the workspace file-out file path." + + | filePath | + filePath := self fileOutFilePath. + (FileDirectory default on: filePath) containingDirectory assureExistence. + FileStream + fileNamed: filePath + do: [:stream | + stream + setToEnd; + nextPutAll: '"----ACCEPT----'; + nextPutAll: DateAndTime now asString; + nextPutAll: '"'; + cr; nextPutAll: contents; cr]. + Transcript showln: 'Workspace contents successfully appended to: ', filePath printString.! Item was added: + ----- Method: Workspace class>>fileOutFilePath (in category 'preferences') ----- + fileOutFilePath + + ^ FileOutFilePath ifNil: [ 'workspace.st' ]! Item was added: + ----- Method: Workspace class>>fileOutFilePath: (in category 'preferences') ----- + fileOutFilePath: aString + + FileOutFilePath := aString.! Item was added: + ----- Method: Workspace class>>fileOutOnAccept (in category 'preferences') ----- + fileOutOnAccept + + ^ FileOutOnAccept ifNil: [ true ]! Item was added: + ----- Method: Workspace class>>fileOutOnAccept: (in category 'preferences') ----- + fileOutOnAccept: aBoolean + + FileOutOnAccept := aBoolean.! Item was added: + ----- Method: Workspace class>>open (in category 'instance creation') ----- + open + + | workspace | + workspace := self new. + self fileOutOnAccept ifTrue: [ + workspace acceptAction: [:string | self fileOut: string]]. + ^ self embedTranscript + ifTrue: [workspace buildAndOpenWorkspaceTranscript] + ifFalse: [workspace buildAndOpen]! Item was added: + ----- Method: Workspace>>buildAndOpen (in category 'toolbuilder') ----- + buildAndOpen + + ToolBuilder default open: self. + ^ self! Item was added: + ----- Method: Workspace>>buildAndOpenWorkspaceTranscript (in category 'toolbuilder') ----- + buildAndOpenWorkspaceTranscript + + | windowSpec builder | + builder := ToolBuilder default. + windowSpec := self buildWindowWith: builder specs: { + (0.0 @ 0.0 corner: 1.0 @ 0.6) -> [self buildCodePaneWith: builder]. + (0.0 @ 0.6 corner: 1.0 @ 1.0) -> [self buildTranscriptWith: builder]. + }. + builder open: windowSpec. + ^ self! Item was removed: - ----- Method: Workspace>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - - ^ self class embedTranscript - ifTrue: [self buildWorkspaceTranscriptWith: builder] - ifFalse: [super buildWith: builder]! Item was removed: - ----- Method: Workspace>>buildWorkspaceTranscriptWith: (in category 'toolbuilder') ----- - buildWorkspaceTranscriptWith: builder - - | windowSpec | - windowSpec := self buildWindowWith: builder specs: { - (0.0 @ 0.0 corner: 1.0 @ 0.6) -> [self buildCodePaneWith: builder]. - (0.0 @ 0.6 corner: 1.0 @ 1.0) -> [self buildTranscriptWith: builder]. - }. - ^builder build: windowSpec! From commits at source.squeak.org Tue May 18 12:05:21 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 18 May 2021 12:05:21 0000 Subject: [squeak-dev] The Trunk: PreferenceBrowser-mt.114.mcz Message-ID: Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.114.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.114 Author: mt Time: 18 May 2021, 2:05:20.131287 pm UUID: a4e8648a-e41f-474f-9017-b5b5ec7f7f8a Ancestors: PreferenceBrowser-mt.113 Add the two new workspace preferences to the wizard because both are primarily intended for newcomers. =============== Diff against PreferenceBrowser-mt.113 =============== Item was changed: ----- Method: PreferenceWizardMorph>>initializePage05Tools (in category 'initialization - pages') ----- initializePage05Tools | currentPage pane | currentPage := pages add: self createPage. pane := self createScrollPane. currentPage addMorphBack: (self createLabel: 'Choose other settings' color: Color white). currentPage addMorphBack: pane. pane scroller firstSubmorph addAllMorphsBack: { self createCheckbox: 'Trace messages browser' translated for: #TraceMessages help: #(trace message). + self createCheckbox: 'Browse class hierarchy' translated for: #AlternativeBrowseIt help: 'Whether to spawn a hierarchy browser or full system browser on browse-it commands.' translated. + self createVerticalSpace. self createCheckbox: 'Reuse tool windows' translated for: #ReuseWindows help: #(window reuse). self createCheckbox: 'Tool and menu icons' translated for: #ToolAndMenuIcons help: 'Whether to show icons in tools and menus.' translated. + self createVerticalSpace. + self createCheckbox: 'Embed Transcript in Workspace' translated for: #WorkspaceEmbedTranscript help: #(workspace transcript). + self createCheckbox: 'File-out on accept' translated for: #WorkspaceFileOutOnAccept help: #(workspace accept). - self createCheckbox: 'Browse class hierarchy' translated for: #AlternativeBrowseIt help: 'Whether to spawn a hierarchy browser or full system browser on browse-it commands.' translated. }. ! Item was added: + ----- Method: PreferenceWizardMorph>>stateWorkspaceEmbedTranscript (in category 'actions - buttons') ----- + stateWorkspaceEmbedTranscript + + ^ Workspace embedTranscript! Item was added: + ----- Method: PreferenceWizardMorph>>stateWorkspaceFileOutOnAccept (in category 'actions - buttons') ----- + stateWorkspaceFileOutOnAccept + + ^ Workspace fileOutOnAccept! Item was added: + ----- Method: PreferenceWizardMorph>>toggleWorkspaceEmbedTranscript (in category 'actions - buttons') ----- + toggleWorkspaceEmbedTranscript + + Workspace embedTranscript: Workspace embedTranscript not.! Item was added: + ----- Method: PreferenceWizardMorph>>toggleWorkspaceFileOutOnAccept (in category 'actions - buttons') ----- + toggleWorkspaceFileOutOnAccept + + Workspace fileOutOnAccept: Workspace fileOutOnAccept not.! From marcel.taeumel at hpi.de Tue May 18 12:41:44 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Tue, 18 May 2021 14:41:44 +0200 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Message-ID: Hi Christoph, > This error message does not make sense to me since MyPool is not a class > but a pool dictionary. You can use classes and global dictionaries as a shared pool.  From the system's perspective, it does not make any difference as long as #bindingOf: etc. is implemented. See class-side of SharedPool class. If you use a class as a shared pool in another class, the class variables will be shared. :-) *** Yet, I think you found a bug. Maybe this was the reason why "FFI-Pools" exists in the first place. So that it can be loaded before "FFI-Kernel" xD Best, Marcel Am 18.05.2021 13:21:34 schrieb Thiede, Christoph : Hi all, while loading a class (MyClass) with an attached pool dictionary (MyPool) today using Monticello, I encountered an error from MCPackageLoader which states: Warning: This package depends on the following classes: MyPool This error message does not make sense to me since MyPool is not a class but a pool dictionary. But in MCClassDefinition >> #requirements, all #poolDictionaries are explicitly added to the list of required items. If I exclude them from this list, I get a warning "The pool dictionary MyPool does not exist. Do you want it automatically created?" later from Class >> #sharing:. Is this a bug? I also tried to manually add the pool dictionary initialization (Smalltalk at: #MyPool put: Dictionary new) into the preamble of the package, but this preamble is also evaluated too late (i.e., not before the dependency warning is raised. Also, this feels a bit too redundant to me. Do we need a new subclass of MCDefinition to create pool dictionaries automatically? Or could we just remove the confirmation dialog in Class >> #sharing: so that new pools will automatically be created, especially in non-interactive CI contexts? Best, Christoph [http://www.hpi.de/] -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Tue May 18 13:26:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 18 May 2021 13:26:07 0000 Subject: [squeak-dev] The Trunk: PreferenceBrowser-mt.115.mcz Message-ID: Marcel Taeumel uploaded a new version of PreferenceBrowser to project The Trunk: http://source.squeak.org/trunk/PreferenceBrowser-mt.115.mcz ==================== Summary ==================== Name: PreferenceBrowser-mt.115 Author: mt Time: 18 May 2021, 3:26:06.839468 pm UUID: 8f6a0f55-d68f-b140-8242-ebb88f3b2ca0 Ancestors: PreferenceBrowser-mt.114 Tweak the previous commit. Make the two new preferences be reflected in the preview world for the user to play around with. :-) =============== Diff against PreferenceBrowser-mt.114 =============== Item was added: + ----- Method: PreferenceWizardMorph>>addOrReplaceBrowser (in category 'initialization - playfield') ----- + addOrReplaceBrowser + + self + addOrReplaceTool: (ToolSet browse: Morph selector: #drawOn:) + named: #browser.! Item was added: + ----- Method: PreferenceWizardMorph>>addOrReplaceSenders (in category 'initialization - playfield') ----- + addOrReplaceSenders + + self + addOrReplaceTool: + (ToolSet + browseMessageSet: (SystemNavigation default allCallsOn: #negated) + name: 'Senders' translated + autoSelect: 'negated') + named: #senders! Item was added: + ----- Method: PreferenceWizardMorph>>addOrReplaceTool:named: (in category 'initialization - playfield') ----- + addOrReplaceTool: windowOrModel named: toolName + + | window | + window := windowOrModel isMorph + ifTrue: [windowOrModel] + ifFalse: [windowOrModel dependents detect: [:ea | ea isSystemWindow]]. + window + name: toolName; + makeUnclosable. + (previewWorld submorphNamed: window knownName) + ifNil: [previewWorld addMorph: window] + ifNotNil: [:existing | + window bounds: existing bounds. + previewWorld addMorph: window inFrontOf: existing. + existing makeClosable; delete].! Item was added: + ----- Method: PreferenceWizardMorph>>addOrReplaceWorkspace (in category 'initialization - playfield') ----- + addOrReplaceWorkspace + + self + addOrReplaceTool: (Workspace open contents: '3+4 "Select and hit [CMD]+[P]."') + named: #workspace.! Item was changed: ----- Method: PreferenceWizardMorph>>initializePreviewWorld (in category 'initialization - playfield') ----- initializePreviewWorld - | w1 w2 w3 | Preferences enable: #systemWindowEmbedOK. previewWorld := PasteUpMorph new hResizing: #spaceFill; vResizing: #spaceFill; viewBox: (0 at 0 corner: 500 at 500); layoutFrame: (LayoutFrame fractions: (0.3 @ 0 corner: 1.0 @ 1.0) offsets: (0@ titleMorph height corner: 0 @ buttonRowMorph height negated)); fillStyle: Project current world fillStyle; borderWidth: 2; borderColor: Color white; cornerStyle: (self hasLowPerformance ifTrue: [#square] ifFalse: [#rounded]); yourself. + self + addOrReplaceBrowser; + addOrReplaceSenders; + addOrReplaceWorkspace; + updateWindowBounds.! - w1 := (ToolSet browse: Morph selector: #drawOn:) dependents detect: [:ea | ea isSystemWindow]. - w2 := ToolSet browseMessageSet: (SystemNavigation default allCallsOn: #negated) name: 'Senders' translated autoSelect: 'negated'. - w3 := (Workspace new contents: '3+4 "Select and hit [CMD]+[P]."') openLabel: 'Workspace'. - - {w1. w2. w3} do: [:ea | - ea makeUnclosable. - previewWorld addMorph: ea]. - - self updateWindowBounds.! Item was changed: ----- Method: PreferenceWizardMorph>>toggleWorkspaceEmbedTranscript (in category 'actions - buttons') ----- toggleWorkspaceEmbedTranscript + Workspace embedTranscript: Workspace embedTranscript not. + self addOrReplaceWorkspace. + self changed: #stateWorkspaceEmbedTranscript.! - Workspace embedTranscript: Workspace embedTranscript not.! Item was changed: ----- Method: PreferenceWizardMorph>>toggleWorkspaceFileOutOnAccept (in category 'actions - buttons') ----- toggleWorkspaceFileOutOnAccept + Workspace fileOutOnAccept: Workspace fileOutOnAccept not. + self addOrReplaceWorkspace. + self changed: #stateWorkspaceFileOutOnAccept.! - Workspace fileOutOnAccept: Workspace fileOutOnAccept not.! From marcel.taeumel at hpi.de Tue May 18 13:55:23 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Tue, 18 May 2021 15:55:23 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> Message-ID: Hi Nicolas, >  We could express this in inspectors with a bits field and a leading ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). You mean like this? DEC -2 HEX -02 OCT -002 BIN -0010 BIT 1111 1111 1111 1110 ? Best, Marcel Am 17.05.2021 18:53:42 schrieb Nicolas Cellier : Hi all, Virtual Machine implementation is a detail. SmallInteger are two complement, while LargeNegativeInteger are sign magnitude (with sign encoded in the class). From bit perspective (bitAnd: bitOr: bitAt: etc...), all Integer behave as two complement with an infinite sequence of 1 for negative, and infinite sequence of 0 for positive. We could express this in inspectors with a bits field and a leading ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). Le lun. 17 mai 2021 à 15:35, Marcel Taeumel a écrit : > The decimal representation is just one of many equivalent representations. The problem being that the basic (machine) representation is not clear. I think its 2's complement. HEX and OCT -- I suppose -- are very close to the machine representation. That's not an issue for positive numbers. :-)  Best, Marcel Am 17.05.2021 14:00:36 schrieb Thiede, Christoph : > > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... >  > So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Why do you think so? The object layout of Squeak Integer is not something like "list of decimal digits". The decimal representation is just one of many equivalent representations. On the other hand, any complement semantic adds a completely new concept because it neglects the infinite size of integers. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 13:08:47 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Best, Marcel Am 17.05.2021 13:07:28 schrieb Thiede, Christoph : > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: After: IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org [mailto:commits at source.squeak.org] Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org [mailto:squeak-dev at lists.squeakfoundation.org]; packages at lists.squeakfoundation.org [mailto:packages at lists.squeakfoundation.org] Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz [http://source.squeak.org/trunk/Morphic-mt.1769.mcz] ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed:   ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----   explorerContents            ^#(                  ('hexadecimal' 16 2)                  ('octal' 8 3)                  ('binary' 2 4)) collect: [ :each | | label group |                          group := each third. +                        label := self abs printStringBase: each second. -                        label := self printStringBase: each second.                          label := label padded: #left to: (label size roundUpTo: group) with: $0.                                  label := String streamContents: [:s | +                                self negative ifTrue: [s nextPutAll: '- '].                                  (1 to: label size by: group)                                          do: [:index |                                                  1 to: group do: [:gIndex |                                                          s nextPut: (label at: index + gIndex - 1)]]                                          separatedBy: [s space]].                                                    ObjectExplorerWrapper                                  with: label                                  name: each first translated                                  model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcel.taeumel at hpi.de Tue May 18 14:13:32 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Tue, 18 May 2021 16:13:32 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> Message-ID: Am 18.05.2021 15:55:23 schrieb Marcel Taeumel : Hi Nicolas, >  We could express this in inspectors with a bits field and a leading ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). You mean like this? DEC -2 HEX -02 OCT -002 BIN -0010 BIT 1111 1111 1111 1110 ? Best, Marcel Am 17.05.2021 18:53:42 schrieb Nicolas Cellier : Hi all, Virtual Machine implementation is a detail. SmallInteger are two complement, while LargeNegativeInteger are sign magnitude (with sign encoded in the class). From bit perspective (bitAnd: bitOr: bitAt: etc...), all Integer behave as two complement with an infinite sequence of 1 for negative, and infinite sequence of 0 for positive. We could express this in inspectors with a bits field and a leading ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). Le lun. 17 mai 2021 à 15:35, Marcel Taeumel a écrit : > The decimal representation is just one of many equivalent representations. The problem being that the basic (machine) representation is not clear. I think its 2's complement. HEX and OCT -- I suppose -- are very close to the machine representation. That's not an issue for positive numbers. :-)  Best, Marcel Am 17.05.2021 14:00:36 schrieb Thiede, Christoph : > > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... >  > So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Why do you think so? The object layout of Squeak Integer is not something like "list of decimal digits". The decimal representation is just one of many equivalent representations. On the other hand, any complement semantic adds a completely new concept because it neglects the infinite size of integers. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 13:08:47 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... So, the binary representation does not make sense, right? And neither does the HEX or OCT. :-) Best, Marcel Am 17.05.2021 13:07:28 schrieb Thiede, Christoph : > And I would have expected a 2's complement, right? Ah, now I see. :-) But this would not really match the actual object layout of integers in Squeak which can have arbitrary sizes ... In my opinion, we should just leave it as is (just maybe without the space), I don't really like such artificial limitations. :-) Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:52:23 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   > Apart from that, I would have expected '-02' instead of '- 02'. :-) And I would have expected a 2's complement, right? Or even drop this representation for negative numbers altogether? Best, Marcel Am 17.05.2021 12:49:51 schrieb Thiede, Christoph : Nice catch! :-) For anyone else wondering about this glitch: Before: After: IMO our printing protocol on Number should have a padded argument similar to the (post-comma) decimal places. Apart from that, I would have expected '-02' instead of '- 02'. :-) Best, Christoph Von: Squeak-dev im Auftrag von commits at source.squeak.org [mailto:commits at source.squeak.org] Gesendet: Donnerstag, 6. Mai 2021 19:05:29 An: squeak-dev at lists.squeakfoundation.org [mailto:squeak-dev at lists.squeakfoundation.org]; packages at lists.squeakfoundation.org [mailto:packages at lists.squeakfoundation.org] Betreff: [squeak-dev] The Trunk: Morphic-mt.1769.mcz   Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1769.mcz [http://source.squeak.org/trunk/Morphic-mt.1769.mcz] ==================== Summary ==================== Name: Morphic-mt.1769 Author: mt Time: 6 May 2021, 7:05:24.828981 pm UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 Ancestors: Morphic-ct.1768 Fixes minor glitch in objext explorers on integers. This makes me wonder ... what are the expectations for negative integers here? =============== Diff against Morphic-ct.1768 =============== Item was changed:   ----- Method: Integer>>explorerContents (in category '*Morphic-Explorer') -----   explorerContents            ^#(                  ('hexadecimal' 16 2)                  ('octal' 8 3)                  ('binary' 2 4)) collect: [ :each | | label group |                          group := each third. +                        label := self abs printStringBase: each second. -                        label := self printStringBase: each second.                          label := label padded: #left to: (label size roundUpTo: group) with: $0.                                  label := String streamContents: [:s | +                                self negative ifTrue: [s nextPutAll: '- '].                                  (1 to: label size by: group)                                          do: [:index |                                                  1 to: group do: [:gIndex |                                                          s nextPut: (label at: index + gIndex - 1)]]                                          separatedBy: [s space]].                                                    ObjectExplorerWrapper                                  with: label                                  name: each first translated                                  model: self ]! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 31614 bytes Desc: not available URL: From vanessa at codefrau.net Tue May 18 17:02:37 2021 From: vanessa at codefrau.net (Vanessa Freudenberg) Date: Tue, 18 May 2021 10:02:37 -0700 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Message-ID: I’m certain we had a good reason to turn loadable shared pools into classes. I think (but I’m not entirely sure) it had to do with ensuring they had been properly initialized before executing code that depended on the constants declared in that pool. Class initialization of a designated class was TSTTCPW. In other words, your shared pool should indeed be a class. It doesn’t matter for using it, but it does matter for loading it reliably. I admit I could be misremembering, it’s been quite a while. –Vanessa– On Tue, May 18, 2021 at 05:42 Marcel Taeumel wrote: > Hi Christoph, > > > This error message does not make sense to me since MyPool is not a class > > but a pool dictionary. > > You can use classes and global dictionaries as a shared pool. From the > system's perspective, it does not make any difference as long as > #bindingOf: etc. is implemented. See class-side of SharedPool class. If you > use a class as a shared pool in another class, the class variables will be > shared. :-) > > *** > > Yet, I think you found a bug. Maybe this was the reason why "FFI-Pools" > exists in the first place. So that it can be loaded before "FFI-Kernel" xD > > Best, > Marcel > > Am 18.05.2021 13:21:34 schrieb Thiede, Christoph < > christoph.thiede at student.hpi.uni-potsdam.de>: > > Hi all, > > > while loading a class (MyClass) with an attached pool dictionary > (MyPool) today using Monticello, I encountered an error from > MCPackageLoader which states: > > > Warning: This package depends on the following classes: > > MyPool > > > This error message does not make sense to me since MyPool is not a class > but a pool dictionary. But in MCClassDefinition >> #requirements, all #poolDictionaries > are explicitly added to the list of required items. If I exclude them from > this list, I get a warning "The pool dictionary MyPool does not exist. Do > you want it automatically created?" later from Class >> #sharing:. Is this > a bug? > > I also tried to manually add the pool dictionary initialization (Smalltalk > at: #MyPool put: Dictionary new) into the preamble of the package, but this > preamble is also evaluated too late (i.e., not before the dependency > warning is raised. Also, this feels a bit too redundant to me. > > Do we need a new subclass of MCDefinition to create pool dictionaries > automatically? Or could we just remove the confirmation dialog in Class >> > #sharing: so that new pools will automatically be created, especially in > non-interactive CI contexts? > > Best, > Christoph > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From kirtai+st at gmail.com Tue May 18 18:15:35 2021 From: kirtai+st at gmail.com (Douglas Brebner) Date: Tue, 18 May 2021 19:15:35 +0100 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: <20210516151000.GA16478@shell.msen.com> Message-ID: <142f5f01-c422-ef35-114e-aa8dc99d292b@gmail.com> On 17/05/2021 13:14, Nicolas Cellier wrote: > Alternatively, we can try and test with randomly generated inputs, but > that's a bit like shooting in the dark. Isn't that the whole point of fuzz testing which seems quite effective in other languages? From tim at rowledge.org Tue May 18 19:14:53 2021 From: tim at rowledge.org (tim Rowledge) Date: Tue, 18 May 2021 12:14:53 -0700 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Message-ID: <6DEA0F75-CA93-4245-A230-9B60B3ABA296@rowledge.org> > On 2021-05-18, at 10:02 AM, Vanessa Freudenberg wrote: > > I’m certain we had a good reason to turn loadable shared pools into classes. This is stuff Andreas & I did in 2003. By making the shared variables stuff classes we could map them into the version system decently so that they got loaded. It also makes them a bit more maintainable since you don't rely on magic doits to establish the contents. One very important matter we bailed on (most definitely wimping out) was sorting out the TextConstants stuff. That is still awaiting some brave hero to ride into frame and Sort It Out. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Useful random insult:- Monorail doesn't go all the way to Tomorrowland. From nicolas.cellier.aka.nice at gmail.com Tue May 18 19:44:59 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Tue, 18 May 2021 21:44:59 +0200 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: <142f5f01-c422-ef35-114e-aa8dc99d292b@gmail.com> References: <20210516151000.GA16478@shell.msen.com> <142f5f01-c422-ef35-114e-aa8dc99d292b@gmail.com> Message-ID: Hi Douglas, If the number of failing cases is one out of 1,000,000 or more, the probability to find one is infinitesimal. The percentage of failure in the sqrt case was even smaller (it requires crafting the trailing bits of integer whose highBit > 100)... I don't believe that fuzz testing is really the effective way in this context. Only the setup is effective (very simple and cheap - though we have to bound our LargePositiveInteger...). Shooting in the dark is effective only in crowded places. White box testing is certainly much more effective in such cases. Le mar. 18 mai 2021 à 20:15, Douglas Brebner a écrit : > > On 17/05/2021 13:14, Nicolas Cellier wrote: > > Alternatively, we can try and test with randomly generated inputs, but > > that's a bit like shooting in the dark. > Isn't that the whole point of fuzz testing which seems quite effective > in other languages? > From nicolas.cellier.aka.nice at gmail.com Tue May 18 19:51:00 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Tue, 18 May 2021 21:51:00 +0200 Subject: [squeak-dev] The Trunk: Morphic-mt.1769.mcz In-Reply-To: References: <24ca219cca034b50b0a4f16f786a8af7@student.hpi.uni-potsdam.de> Message-ID: Hi Marcel, yes, maybe with some ellipsis ahead "..." to denote the fact that it's infinite... Le mar. 18 mai 2021 à 16:13, Marcel Taeumel a écrit : > > Am 18.05.2021 15:55:23 schrieb Marcel Taeumel : > Hi Nicolas, > > > We could express this in inspectors with a bits field and a leading > ... 00000000 or ... 11111111 digit (yes digits are 1 byte long currently). > > You mean like this? > > DEC -2 > HEX -02 > OCT -002 > BIN -0010 > BIT 1111 1111 1111 1110 > ? > > Best, > Marcel > > Am 17.05.2021 18:53:42 schrieb Nicolas Cellier < > nicolas.cellier.aka.nice at gmail.com>: > Hi all, > Virtual Machine implementation is a detail. SmallInteger are two > complement, while LargeNegativeInteger are sign magnitude (with sign > encoded in the class). From bit perspective (bitAnd: bitOr: bitAt: etc...), > all Integer behave as two complement with an infinite sequence of 1 for > negative, and infinite sequence of 0 for positive. We could express this in > inspectors with a bits field and a leading ... 00000000 or ... 11111111 > digit (yes digits are 1 byte long currently). > > Le lun. 17 mai 2021 à 15:35, Marcel Taeumel a > écrit : > >> > The decimal representation is just one of many equivalent >> representations. >> >> The problem being that the basic (machine) representation is not clear. I >> think its 2's complement. HEX and OCT -- I suppose -- are very close to the >> machine representation. >> >> That's not an issue for positive numbers. :-) >> >> Best, >> Marcel >> >> Am 17.05.2021 14:00:36 schrieb Thiede, Christoph < >> christoph.thiede at student.hpi.uni-potsdam.de>: >> >> > > But this would not really match the actual object layout of integers >> in Squeak which can have arbitrary sizes ... >> > >> > So, the binary representation does not make sense, right? And neither >> does the HEX or OCT. :-) >> >> Why do you think so? The object layout of Squeak Integer is not something >> like "list of decimal digits". The decimal representation is just one of >> many equivalent representations. On the other hand, any complement semantic >> adds a completely new concept because it neglects the infinite size of >> integers. >> >> Best, >> Christoph >> >> ------------------------------ >> *Von:* Squeak-dev im >> Auftrag von Taeumel, Marcel >> *Gesendet:* Montag, 17. Mai 2021 13:08:47 >> *An:* squeak-dev >> *Betreff:* Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz >> >> > But this would not really match the actual object layout of integers >> in Squeak which can have arbitrary sizes ... >> >> So, the binary representation does not make sense, right? And neither >> does the HEX or OCT. :-) >> >> Best, >> Marcel >> >> Am 17.05.2021 13:07:28 schrieb Thiede, Christoph < >> christoph.thiede at student.hpi.uni-potsdam.de>: >> >> > And I would have expected a 2's complement, right? >> >> >> Ah, now I see. :-) But this would not really match the actual object >> layout of integers in Squeak which can have arbitrary sizes ... >> >> >> In my opinion, we should just leave it as is (just maybe without the >> space), I don't really like such artificial limitations. :-) >> >> >> Best, >> >> Christoph >> ------------------------------ >> *Von:* Squeak-dev im >> Auftrag von Taeumel, Marcel >> *Gesendet:* Montag, 17. Mai 2021 12:52:23 >> *An:* squeak-dev >> *Betreff:* Re: [squeak-dev] The Trunk: Morphic-mt.1769.mcz >> >> > Apart from that, I would have expected '-02' instead of '- 02'. :-) >> >> And I would have expected a 2's complement, right? Or even drop this >> representation for negative numbers altogether? >> >> Best, >> Marcel >> >> Am 17.05.2021 12:49:51 schrieb Thiede, Christoph < >> christoph.thiede at student.hpi.uni-potsdam.de>: >> >> Nice catch! :-) >> >> >> For anyone else wondering about this glitch: >> >> Before: >> >> >> After: >> >> >> IMO our printing protocol on Number should have a padded argument similar >> to the (post-comma) decimal places. >> Apart from that, I would have expected '-02' instead of '- 02'. :-) >> >> Best, >> Christoph >> ------------------------------ >> *Von:* Squeak-dev im >> Auftrag von commits at source.squeak.org >> *Gesendet:* Donnerstag, 6. Mai 2021 19:05:29 >> *An:* squeak-dev at lists.squeakfoundation.org; >> packages at lists.squeakfoundation.org >> *Betreff:* [squeak-dev] The Trunk: Morphic-mt.1769.mcz >> >> Marcel Taeumel uploaded a new version of Morphic to project The Trunk: >> http://source.squeak.org/trunk/Morphic-mt.1769.mcz >> >> ==================== Summary ==================== >> >> Name: Morphic-mt.1769 >> Author: mt >> Time: 6 May 2021, 7:05:24.828981 pm >> UUID: 8109f744-f1f3-7048-8646-fed21a8e23d4 >> Ancestors: Morphic-ct.1768 >> >> Fixes minor glitch in objext explorers on integers. >> >> This makes me wonder ... what are the expectations for negative integers >> here? >> >> =============== Diff against Morphic-ct.1768 =============== >> >> Item was changed: >> ----- Method: Integer>>explorerContents (in category >> '*Morphic-Explorer') ----- >> explorerContents >> >> ^#( >> ('hexadecimal' 16 2) >> ('octal' 8 3) >> ('binary' 2 4)) collect: [ :each | | label group | >> group := each third. >> + label := self abs printStringBase: each second. >> - label := self printStringBase: each second. >> label := label padded: #left to: (label size >> roundUpTo: group) with: $0. >> label := String streamContents: [:s | >> + self negative ifTrue: [s nextPutAll: '- >> ']. >> (1 to: label size by: group) >> do: [:index | >> 1 to: group do: [:gIndex >> | >> s nextPut: >> (label at: index + gIndex - 1)]] >> separatedBy: [s space]]. >> >> ObjectExplorerWrapper >> with: label >> name: each first translated >> model: self ]! >> >> >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: image.png Type: image/png Size: 31614 bytes Desc: not available URL: From kirtai+st at gmail.com Wed May 19 00:27:15 2021 From: kirtai+st at gmail.com (Douglas Brebner) Date: Wed, 19 May 2021 01:27:15 +0100 Subject: [squeak-dev] Neural based evolutive testing (was: The Trunk: Kernel-nice.1402.mcz) In-Reply-To: References: <20210516151000.GA16478@shell.msen.com> <142f5f01-c422-ef35-114e-aa8dc99d292b@gmail.com> Message-ID: <546db47c-bdcf-eb49-c01e-5525e2bfb587@gmail.com> On 18/05/2021 20:44, Nicolas Cellier wrote: > Hi Douglas, > If the number of failing cases is one out of 1,000,000 or more, the > probability to find one is infinitesimal. > The percentage of failure in the sqrt case was even smaller (it > requires crafting the trailing bits of integer whose highBit > 100)... > I don't believe that fuzz testing is really the effective way in this context. > Only the setup is effective (very simple and cheap - though we have to > bound our LargePositiveInteger...). > Shooting in the dark is effective only in crowded places. > White box testing is certainly much more effective in such cases. Oh yeah, in this context it may not work well. I was just pointing out that it can be useful. Not to mention that even one in a million chances are likely to be smoked out with hundreds of millions (or more) fuzz tests. From ma.chris.m at gmail.com Wed May 19 02:22:02 2021 From: ma.chris.m at gmail.com (Chris Muller) Date: Tue, 18 May 2021 21:22:02 -0500 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz In-Reply-To: <20210518023921.GA34512@shell.msen.com> References: <20210518023921.GA34512@shell.msen.com> Message-ID: > > And as explained in the commit comment: > > Skip chunks that begin with known extensions that are not meaningful > for Squeak, logging to Transcript to show chunks that have been ignored. > Magma implements a method called #classDefinition:. I wanted to make sure this wouldn't cause it to get skipped. My test of filing out a single method and also the whole class, seemed to work okay. > With respect to the Cuis reference, my use case was installing > VectorEnginePlugin in Squeak. The upstream repository for this plugin > is on GitHub, which stores the portable Smalltalk code in chunk format > with some Cuis extensions: > > > https://github.com/Cuis-Smalltalk/Cuis-Smalltalk-Dev/blob/master/Packages/Features/VectorEnginePlugin.pck.st > > The plugin code is well-written and portable for at least Squeak and Cuis. > The Cuis-specific chunks are not relevant to Squeak, so they can and > should be ignored when filing in to Squeak. > Does this mean we can generally load Cuis code into Squeak now? That almost seems [ANN]-worthy. :) - Chris -------------- next part -------------- An HTML attachment was scrubbed... URL: From nicolas.cellier.aka.nice at gmail.com Wed May 19 07:38:45 2021 From: nicolas.cellier.aka.nice at gmail.com (Nicolas Cellier) Date: Wed, 19 May 2021 09:38:45 +0200 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz In-Reply-To: References: <20210518023921.GA34512@shell.msen.com> Message-ID: Ah, here are some related hack for ChangeList https://source.squeak.org/trunk/Tools-nice.725.diff Does this Cuis change file opens correctly in a Change List, or do we have to unify efforts? Le mer. 19 mai 2021 à 04:22, Chris Muller a écrit : >> >> And as explained in the commit comment: >> >> Skip chunks that begin with known extensions that are not meaningful >> for Squeak, logging to Transcript to show chunks that have been ignored. > > > Magma implements a method called #classDefinition:. I wanted to make sure this wouldn't cause it to get skipped. My test of filing out a single method and also the whole class, seemed to work okay. > >> >> With respect to the Cuis reference, my use case was installing >> VectorEnginePlugin in Squeak. The upstream repository for this plugin >> is on GitHub, which stores the portable Smalltalk code in chunk format >> with some Cuis extensions: >> >> https://github.com/Cuis-Smalltalk/Cuis-Smalltalk-Dev/blob/master/Packages/Features/VectorEnginePlugin.pck.st >> >> The plugin code is well-written and portable for at least Squeak and Cuis. >> The Cuis-specific chunks are not relevant to Squeak, so they can and >> should be ignored when filing in to Squeak. > > > Does this mean we can generally load Cuis code into Squeak now? That almost seems [ANN]-worthy. :) > > - Chris > From commits at source.squeak.org Wed May 19 08:34:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 08:34:08 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.160.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.160.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.160 Author: mt Time: 19 May 2021, 10:34:07.057615 am UUID: 5179b160-697d-7b46-9e83-dbccf3a05953 Ancestors: FFI-Kernel-mt.159 Clean-up the extension protocol on ByteArray and ExternalAddress: - Explicit read/write methods for integers are no longer used but replaced through FFIAtomicReadWriteSend, which also speeds up dynamic reads (i.e. through ExternalData) about 3x - Protocol retained as "*FFI-Kernel-examples" in ByteArray and ExternalAddress - Generated field accessors in ExternalStructure now use the primitives #integerAt:(put:)size:length: directly, which also speeds up such static reads a little bit. - ByteArrayReadWriter benefits from this change by a simpler implementation without a tricky DNU - Extra mappings over integer types - i.e. bool, char, schar - are now encapsulated in CharacterReadWriteSend and BooleanReadWriteSend. Other minor changes: - Unknown types now show their soon-to-be-known type name - External types can be asked for #isBoolType just like #isIntegerType and #isFloatTpye and #isCharType - In ExternalType, AtomicSelectors got replaced with AtomicSends The postscript should re-build all types and re-define all field accessors. If not do-it: ExternalType resetAllTypes. ExternalStructure defineAllFields. =============== Diff against FFI-Kernel-mt.159 =============== Item was added: + IntegerReadWriteSend subclass: #BooleanReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !BooleanReadWriteSend commentStamp: 'mt 5/19/2021 10:17' prior: 0! + I am a specialization for the atomic 'bool' type, which maps to 'byte' but adds extra pre- and post-processing to read and write instances of Boolean, i.e. true and false.! Item was added: + ----- Method: BooleanReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: type + + ^ super fromType: ExternalType byte! Item was added: + ----- Method: BooleanReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: handle at: byteOffset + + ^ (super handle: handle at: byteOffset) ~= 0! Item was added: + ----- Method: BooleanReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: handle at: byteOffset put: aBoolean + + super + handle: handle + at: byteOffset + put: (aBoolean ifTrue: [1] ifFalse: [0]). + ^ aBoolean! Item was added: + ----- Method: BooleanReadWriteSend>>template (in category 'compiling') ----- + template + + ^ self isReading + ifTrue: ['(', super template, ') ~= 0'] + ifFalse: [super template copyReplaceAll: '{3}' with: '({3} ifTrue: [1] ifFalse: [0])']! Item was changed: + ----- Method: ByteArray>>booleanAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>booleanAt: (in category '*FFI-Kernel') ----- booleanAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType bool handle: self at: byteOffset! - "Booleans are just integers in C word" - ^(self integerAt: byteOffset size: 1 signed: false) ~= 0! Item was changed: + ----- Method: ByteArray>>booleanAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>booleanAt:put: (in category '*FFI-Kernel') ----- booleanAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType bool handle: self at: byteOffset put: value! - "Booleans are just integers in C word" - ^self integerAt: byteOffset put: (value ifTrue:[1] ifFalse:[0]) size: 1 signed: false! Item was changed: ----- Method: ByteArray>>doubleAt: (in category '*FFI-Kernel') ----- + doubleAt: byteOffset + "Primitive. Return a float value from the receiver. + - FAILS IF the receiver has not enough bytes for an IEEE 754 (64 bits) floating point number. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress. + - SEE Float class >> #fromIEEE64Bit: and Float >> #asIEEE64BitWord" - doubleAt: byteOffset + + "Examples: + ExternalType double handle: #[ 0 0 0 255 0 0 0 0 ] at: 1. + ExternalType double handle: #[ 0 0 0 255 ] at: 1. --- Error. + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: ----- Method: ByteArray>>doubleAt:put: (in category '*FFI-Kernel') ----- doubleAt: byteOffset put: value + "Primitive. Store the given value as IEEE 754 (64 bits) floating point number. + - FAILS IF the receiver has not enough bytes for that representation. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress. + - SEE Float class >> #fromIEEE64Bit: and Float >> #asIEEE64BitWord" + + "Examples: + ExternalType double allocate value: 123.4567890; explore + ExternalType double allocate value: 0.0001; explore + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: ----- Method: ByteArray>>floatAt: (in category '*FFI-Kernel') ----- floatAt: byteOffset + "Primitive. Return a float value from the receiver. + - FAILS IF the receiver has not enough bytes for an IEEE 754 (32 bits) floating point number. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress. + - SEE Float class >> #fromIEEE32Bit: and Float >> #asIEEE32BitWord" + + "Examples: + ExternalType float handle: #[ 0 0 0 255 ] at: 1. + ExternalType float handle: #[ 0 0 255 ] at: 1. --- Error. + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: ----- Method: ByteArray>>floatAt:put: (in category '*FFI-Kernel') ----- floatAt: byteOffset put: value + "Primitive. Store the given value as IEEE 754 (32 bits) floating point number. + - FAILS IF the receiver has not enough bytes for that representation. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress. + - SEE Float class >> #fromIEEE32Bit: and Float >> #asIEEE32BitWord" + + "Examples: + ExternalType float allocate value: 123.4567890; explore + ExternalType float allocate value: 0.0001; explore + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: ----- Method: ByteArray>>integerAt:put:size:signed: (in category '*FFI-Kernel') ----- integerAt: byteOffset put: value size: nBytes signed: aBoolean + "Primitive. Store the given value as integer of nBytes size in the receiver. + - BYTE ORDER is Smalltalk order, which is little-endian. + - FAILS IF the value is out of range. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress." - "Primitive. Store the given value as integer of nBytes size - in the receiver. Fail if the value is out of range. - Note: This primitive will access memory in the outer space if - invoked from ExternalAddress." + + "Examples: + ExternalType int32_t allocate value: -1; explore. + ExternalType uint32_t allocate value: 1; explore. + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: ----- Method: ByteArray>>integerAt:size:signed: (in category '*FFI-Kernel') ----- integerAt: byteOffset size: nBytes signed: aBoolean "Primitive. Return an integer of nBytes size from the receiver. + - BYTE ORDER is Smalltalk order, which is little-endian. + - FAILS IF the receiver has not enough bytes. + - NOTE that this primitive will access memory in the outer space if invoked from ExternalAddress." - Note: This primitive will access memory in the outer space if - invoked from ExternalAddress." + + "Examples: + ExternalType int32_t handle: #[ 255 0 0 255 ] at: 1. + ExternalType uint32_t handle: #[ 255 0 0 255 ] at: 1. + " + ^ self primitiveFailed! - ^self primitiveFailed! Item was changed: + ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-deprecated') ----- - ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset "Answer an 8-byte pointer object stored at the given byte address" self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 8! Item was changed: + ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-deprecated') ----- - ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset put: value "Store an 8-byte pointer object at the given byte address" self deprecated: 'Use #pointerAt:put:length:'. ^ self pointerAt: byteOffset put: value length: 8! Item was changed: + ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-pointers') ----- pointerAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType void asPointerType handle: self at: byteOffset! - "Answer a pointer object stored at the given byte address" - - ^ self pointerAt: byteOffset length: ExternalAddress wordSize! Item was changed: + ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel') ----- + pointerAt: byteOffset length: length + "Return a pointer of the given length starting at the indicated byte offset." - ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-pointers') ----- - pointerAt: byteOffset length: numBytes "^ " - "Answer a pointer object of numBytes length stored at the given byte address" + | pointer startByteOffset | + pointer := ExternalAddress basicNew: length. + startByteOffset := byteOffset - 1. + 1 to: length do: [:pointerByteOffset | + pointer + basicAt: pointerByteOffset + put: (self unsignedByteAt: startByteOffset + pointerByteOffset)]. + ^ pointer! - | addr | - addr := ExternalAddress basicNew: numBytes. - 1 to: numBytes do: [:index | - addr - basicAt: index - put: (self unsignedByteAt: byteOffset+index-1)]. - ^addr! Item was changed: + ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-pointers') ----- pointerAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType void asPointerType handle: self at: byteOffset put: value! - "Store a pointer object at the given byte address" - - ^ self pointerAt: byteOffset put: value length: ExternalAddress wordSize! Item was changed: + ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel') ----- + pointerAt: byteOffset put: pointer length: length + "Store a pointer of the given length starting at the indicated byte offset." - ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-pointers') ----- - pointerAt: byteOffset put: value length: numBytes - "Store a pointer object with numBytes lengeth at the given byte address" + | startByteOffset | + self assert: [pointer isExternalAddress]. + startByteOffset := byteOffset - 1. + 1 to: length do: [:pointerByteOffset | - self assert: [value isExternalAddress]. - - 1 to: numBytes do: [:index | self + unsignedByteAt: startByteOffset + pointerByteOffset + put: (pointer basicAt: pointerByteOffset)]. + ^ pointer! - unsignedByteAt: byteOffset + index - 1 - put: (value basicAt: index)]. - ^ value! Item was changed: + ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-deprecated') ----- - ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset "Answer a 4-byte pointer object stored at the given byte address" self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 4! Item was changed: + ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-deprecated') ----- - ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset put: value "Store a 4-byte pointer object at the given byte address" self deprecated: 'Use #pointerAt:put:length:'. ^ self pointerAt: byteOffset put: value length: 4! Item was changed: + ----- Method: ByteArray>>signedCharAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedCharAt: (in category '*FFI-Kernel') ----- signedCharAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType signedChar handle: self at: byteOffset! - ^(self unsignedByteAt: byteOffset) asCharacter! Item was changed: + ----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedCharAt:put: (in category '*FFI-Kernel') ----- signedCharAt: byteOffset put: aCharacter + + ^ ExternalType signedChar handle: self at: byteOffset put: aCharacter! - ^self unsignedByteAt: byteOffset put: aCharacter asciiValue! Item was changed: + ----- Method: ByteArray>>signedLongAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedLongAt: (in category '*FFI-Kernel') ----- signedLongAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int32_t handle: self at: byteOffset! - "Return a 32bit signed integer starting at the given byte offset" - ^self integerAt: byteOffset size: 4 signed: true! Item was changed: + ----- Method: ByteArray>>signedLongAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedLongAt:put: (in category '*FFI-Kernel') ----- signedLongAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int32_t handle: self at: byteOffset put: value! - "Store a 32bit signed integer starting at the given byte offset" - ^self integerAt: byteOffset put: value size: 4 signed: true! Item was changed: + ----- Method: ByteArray>>signedLongLongAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedLongLongAt: (in category '*FFI-Kernel') ----- signedLongLongAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int64_t handle: self at: byteOffset! - | int | - int := self unsignedLongLongAt: byteOffset. - int > 16r7FFFFFFFFFFFFFFF ifTrue: [^int - 16r10000000000000000]. - ^int! Item was changed: + ----- Method: ByteArray>>signedLongLongAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedLongLongAt:put: (in category '*FFI-Kernel') ----- signedLongLongAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int64_t handle: self at: byteOffset put: value! - self unsignedLongLongAt: byteOffset put: (value < 0 - ifTrue: [ value + 16r10000000000000000 ] - ifFalse: [ value ])! Item was changed: + ----- Method: ByteArray>>signedShortAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedShortAt: (in category '*FFI-Kernel') ----- signedShortAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int16_t handle: self at: byteOffset! - "Return a 16bit signed integer starting at the given byte offset" - ^self integerAt: byteOffset size: 2 signed: true! Item was changed: + ----- Method: ByteArray>>signedShortAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>signedShortAt:put: (in category '*FFI-Kernel') ----- signedShortAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int16_t handle: self at: byteOffset put: value! - "Store a 16bit signed integer starting at the given byte offset" - ^self integerAt: byteOffset put: value size: 2 signed: true! Item was changed: ----- Method: ByteArray>>structAt:length: (in category '*FFI-Kernel') ----- structAt: byteOffset length: length "Return a structure of the given length starting at the indicated byte offset." + + | value startByteOffset | - | value | value := ByteArray new: length. + startByteOffset := byteOffset - 1. + 1 to: length do: [:valueByteOffset | + value + unsignedByteAt: valueByteOffset + put: (self unsignedByteAt: startByteOffset + valueByteOffset)]. + ^ value! - 1 to: length do:[:i| - value unsignedByteAt: i put: (self unsignedByteAt: byteOffset+i-1)]. - ^value! Item was changed: ----- Method: ByteArray>>structAt:put:length: (in category '*FFI-Kernel') ----- structAt: byteOffset put: value length: length "Store a structure of the given length starting at the indicated byte offset." + + | startByteOffset | + startByteOffset := byteOffset - 1. + 1 to: length do: [:valueByteOffset | + self + unsignedByteAt: startByteOffset + valueByteOffset + put: (value unsignedByteAt:valueByteOffset)]. + ^ value! - 1 to: length do:[:i| - self unsignedByteAt: byteOffset+i-1 put: (value unsignedByteAt: i)]. - ^value! Item was changed: ----- Method: ByteArray>>unsignedByteAt: (in category '*FFI-Kernel') ----- unsignedByteAt: byteOffset + "Same as #byteAt: but different primitive to support ExternalAddress." + + ^ self integerAt: byteOffset size: 1 signed: false! - "Return a 8bit unsigned integer starting at the given byte offset" - ^self integerAt: byteOffset size: 1 signed: false! Item was changed: ----- Method: ByteArray>>unsignedByteAt:put: (in category '*FFI-Kernel') ----- unsignedByteAt: byteOffset put: value + "Same as #byteAt: but different primitive to support ExternalAddress." + + ^ self integerAt: byteOffset put: value size: 1 signed: false! - "Store a 8bit unsigned integer starting at the given byte offset" - ^self integerAt: byteOffset put: value size: 1 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedCharAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedCharAt: (in category '*FFI-Kernel') ----- unsignedCharAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType unsignedChar handle: self at: byteOffset! - ^(self unsignedByteAt: byteOffset) asCharacter! Item was changed: + ----- Method: ByteArray>>unsignedCharAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedCharAt:put: (in category '*FFI-Kernel') ----- unsignedCharAt: byteOffset put: aCharacter + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType unsignedChar handle: self at: byteOffset put: aCharacter! - ^self unsignedByteAt: byteOffset put: aCharacter asciiValue! Item was changed: + ----- Method: ByteArray>>unsignedLongAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedLongAt: (in category '*FFI-Kernel') ----- unsignedLongAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint32_t handle: self at: byteOffset! - "Return a 32bit unsigned integer starting at the given byte offset" - ^self integerAt: byteOffset size: 4 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedLongAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedLongAt:put: (in category '*FFI-Kernel') ----- unsignedLongAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint32_t handle: self at: byteOffset put: value! - "Store a 32bit signed integer starting at the given byte offset" - ^self integerAt: byteOffset put: value size: 4 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedLongLongAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedLongLongAt: (in category '*FFI-Kernel') ----- unsignedLongLongAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint64_t handle: self at: byteOffset! - "Answer a 64-bit integer in Smalltalk order (little-endian)." - ^self integerAt: byteOffset size: 8 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedLongLongAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedLongLongAt:put: (in category '*FFI-Kernel') ----- unsignedLongLongAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint64_t handle: self at: byteOffset put: value! - "I store 64-bit integers in Smalltalk (little-endian) order." - ^self integerAt: byteOffset put: value size: 8 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedShortAt: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedShortAt: (in category '*FFI-Kernel') ----- unsignedShortAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint16_t handle: self at: byteOffset! - "Return a 16bit unsigned integer starting at the given byte offset" - ^self integerAt: byteOffset size: 2 signed: false! Item was changed: + ----- Method: ByteArray>>unsignedShortAt:put: (in category '*FFI-Kernel-examples') ----- - ----- Method: ByteArray>>unsignedShortAt:put: (in category '*FFI-Kernel') ----- unsignedShortAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint16_t handle: self at: byteOffset put: value! - "Store a 16bit unsigned integer starting at the given byte offset" - ^self integerAt: byteOffset put: value size: 2 signed: false! Item was removed: - ----- Method: ByteArray>>voidAt: (in category '*FFI-Kernel') ----- - voidAt: byteOffset - "no accessors for void" - ^self shouldNotImplement! Item was removed: - ----- Method: ByteArray>>voidAt:put: (in category '*FFI-Kernel') ----- - voidAt: byteOffset put: value - "no accessors for void" - ^self shouldNotImplement! Item was changed: ----- Method: ByteArray>>zeroMemory: (in category '*FFI-Kernel') ----- zeroMemory: numBytes 1 to: numBytes do: [:index | + self unsignedByteAt: index put: 0].! - self byteAt: index put: 0].! Item was changed: ----- Method: ByteArrayReadWriter>>copy (in category 'copying') ----- copy + "Materialize the current array segment. See ExternalStructure >> #postCopy" + - ^ byteArray copyFrom: byteOffset + 1 to: byteOffset + byteSize ! Item was changed: ----- Method: ByteArrayReadWriter>>doesNotUnderstand: (in category 'system primitives') ----- doesNotUnderstand: aMessage - | selector args | - selector := aMessage selector. - args := aMessage arguments. - args size caseOf: { - [ 1 ] -> [ (selector endsWith: 'At:') ifTrue: [ args at: 1 put: args first + byteOffset ] ]. - [ 2 ] -> [ (selector endsWith: 'length:') - ifTrue: [ - args at: 1 put: args first + byteOffset. - (args first + args second - 1) > (byteOffset + byteSize) - ifTrue: [self errorSubscriptBounds: args first + args second - 1] ] - ifFalse: [(selector endsWith: 'put:') ifTrue: [ - args at: 1 put: args first + byteOffset ]] ]. - [ 3 ] -> [ (selector endsWith: 'length:') - ifTrue: [ - args at: 1 put: args first + byteOffset. - (args first + args third - 1) > (byteSize + byteSize) - ifTrue: [self errorSubscriptBounds: args first + args third - 1]]] - } otherwise: []. ^ aMessage sendTo: byteArray! Item was added: + ----- Method: ByteArrayReadWriter>>doubleAt: (in category 'read/write atomics') ----- + doubleAt: oByteOffset + + ^ byteArray doubleAt: oByteOffset + byteOffset! Item was added: + ----- Method: ByteArrayReadWriter>>doubleAt:put: (in category 'read/write atomics') ----- + doubleAt: oByteOffset put: value + + ^ byteArray doubleAt: oByteOffset + byteOffset put: value! Item was added: + ----- Method: ByteArrayReadWriter>>floatAt: (in category 'read/write atomics') ----- + floatAt: oByteOffset + + ^ byteArray floatAt: oByteOffset + byteOffset! Item was added: + ----- Method: ByteArrayReadWriter>>floatAt:put: (in category 'read/write atomics') ----- + floatAt: oByteOffset put: value + + ^ byteArray floatAt: oByteOffset + byteOffset put: value! Item was added: + ----- Method: ByteArrayReadWriter>>integerAt:put:size:signed: (in category 'read/write atomics') ----- + integerAt: oByteOffset put: value size: nBytes signed: aBoolean + + ^ byteArray integerAt: oByteOffset + byteOffset put: value size: nBytes signed: aBoolean! Item was added: + ----- Method: ByteArrayReadWriter>>integerAt:size:signed: (in category 'read/write atomics') ----- + integerAt: oByteOffset size: nBytes signed: aBoolean + + ^ byteArray integerAt: oByteOffset + byteOffset size: nBytes signed: aBoolean.! Item was removed: - ----- Method: ByteArrayReadWriter>>perform:with: (in category 'message handling') ----- - perform: aSymbol with: anObject - "Needed because of AtomicSelectors. See ExternalType >> #handle:at:." - - - ^ self perform: aSymbol withArguments: { anObject }! Item was removed: - ----- Method: ByteArrayReadWriter>>perform:with:with: (in category 'message handling') ----- - perform: aSymbol with: firstObject with: secondObject - "Needed because of AtomicSelectors. See ExternalType >> #handle:at:put:." - - - ^ self perform: aSymbol withArguments: { firstObject. secondObject }! Item was added: + ----- Method: ByteArrayReadWriter>>perform:with:with:with: (in category 'message handling') ----- + perform: aSymbol with: firstObject with: secondObject with: thirdObject + "Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:." + + + ^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject }! Item was added: + ----- Method: ByteArrayReadWriter>>perform:with:with:with:with: (in category 'message handling') ----- + perform: aSymbol with: firstObject with: secondObject with: thirdObject with: fourthObject + "Needed because of AtomicSelectors. See FFIAtomicReadWriteSend >> #handle:at:put:." + + + ^ self perform: aSymbol withArguments: { firstObject. secondObject. thirdObject. fourthObject }! Item was added: + ----- Method: ByteArrayReadWriter>>pointerAt:length: (in category 'read/write pointers') ----- + pointerAt: oByteOffset length: numBytes + + ^ byteArray pointerAt: oByteOffset + byteOffset length: numBytes! Item was added: + ----- Method: ByteArrayReadWriter>>pointerAt:put:length: (in category 'read/write pointers') ----- + pointerAt: oByteOffset put: value length: numBytes + + ^ byteArray pointerAt: oByteOffset + byteOffset put: value length: numBytes! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'read/write structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'structs') ----- structAt: newByteOffset length: newLength ^ ByteArrayReadWriter new setArray: byteArray offset: byteOffset + newByteOffset - 1 size: newLength! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'read/write structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'structs') ----- structAt: newByteOffset put: value length: newLength (newByteOffset + newLength > byteSize) ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. ^ byteArray structAt: byteOffset + newByteOffset - 1 put: value length: newLength! Item was added: + IntegerReadWriteSend subclass: #CharacterReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !CharacterReadWriteSend commentStamp: 'mt 5/19/2021 10:18' prior: 0! + I am a specialization for the atomic 'char' and 'schar' types, which both map to (unsigned) 'byte' but add extra pre- and post-processing to read and write instances of Character such as $A and $Z.! Item was added: + ----- Method: CharacterReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: type + + ^ super fromType: ExternalType byte! Item was added: + ----- Method: CharacterReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: handle at: byteOffset + + ^ (super handle: handle at: byteOffset) asCharacter! Item was added: + ----- Method: CharacterReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: handle at: byteOffset put: aCharacter + + super + handle: handle + at: byteOffset + put: aCharacter asciiValue. + ^ aCharacter! Item was added: + ----- Method: CharacterReadWriteSend>>template (in category 'compiling') ----- + template + + ^ self isReading + ifTrue: ['(', super template, ') asCharacter'] + ifFalse: [super template copyReplaceAll: '{3}' with: '{3} asciiValue']! Item was changed: ----- Method: ExternalAddress>>byteAt: (in category 'accessing') ----- byteAt: byteOffset + "For documentation and convenient exploration only. Please use #unsignedByteAt: directly. + Overwritten to go through a different primitive since the receiver describes data in the outside world." - "Overwritten to to through a different primitive since the receiver describes data in the outside world." + ^ self unsignedByteAt: byteOffset! - ^ self integerAt: byteOffset size: 1 signed: false! Item was changed: ----- Method: ExternalAddress>>byteAt:put: (in category 'accessing') ----- byteAt: byteOffset put: value + "For documentation and convenient exploration only. Please use #unsignedByteAt:put: directly. + Overwritten to go through a different primitive since the receiver describes data in the outside world." + + ^ self unsignedByteAt: byteOffset put: value! - "Overwritten to go through a different primitive since the receiver describes data in the outside world." - - ^ self integerAt: byteOffset put: value size: 1 signed: false! Item was changed: + ----- Method: ExternalAddress>>signedByteAt: (in category 'examples') ----- - ----- Method: ExternalAddress>>signedByteAt: (in category 'accessing') ----- signedByteAt: byteOffset + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType uint8_t handle: self at: byteOffset! - "Overwritten to go through a different primitive since the receiver describes data in the outside world." - - ^ self integerAt: byteOffset size: 1 signed: true! Item was changed: + ----- Method: ExternalAddress>>signedByteAt:put: (in category 'examples') ----- - ----- Method: ExternalAddress>>signedByteAt:put: (in category 'accessing') ----- signedByteAt: byteOffset put: value + "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + + ^ ExternalType int8_t handle: self at: byteOffset put: value! - "Overwritten to go through a different primitive since the receiver describes data in the outside world." - - ^ self integerAt: byteOffset put: value size: 1 signed: true! Item was changed: ----- Method: ExternalAddress>>structAt:length: (in category 'accessing') ----- structAt: byteOffset length: length + "Overwritten to not read bytes but just move the pointer. Ignore the length." + + ^ ExternalAddress fromAddress: self movedBy: byteOffset - 1! - "Return the external address of the struct's first field. Ignore length." - ^ self + (byteOffset-1)! Item was removed: - ----- Method: ExternalAddress>>structAt:put:length: (in category 'accessing') ----- - structAt: byteOffset put: externalAddress length: length - "Read length bytes from externalAddress and write it at this external address (plus byteOffset)." - - | start | - start := self + (byteOffset-1). - 1 to: length do: [:targetOffset | - start - byteAt: targetOffset - put: (externalAddress byteAt: targetOffset)].! Item was changed: ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset ^ referentClass ifNil: [ "Genuine atomics" + (AtomicSends at: self atomicType + 1) first + handle: handle + at: byteOffset] - handle - perform: (AtomicSelectors at: self atomicType) - with: byteOffset] ifNotNil: [ "Alias to atomics" referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)]! Item was changed: ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value ^ referentClass ifNil: ["genuine atomic" + (AtomicSends at: self atomicType + 1) second + handle: handle + at: byteOffset + put: value] - handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: value] ifNotNil: ["type alias" handle structAt: byteOffset put: value getHandle length: self byteSize]! Item was changed: ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset ^ referentClass ifNil: [ "Genuine atomics" + '^ ', (AtomicSends at: self atomicType + 1) first template - '^ handle {1} {2}' format: { + 'handle'. - AtomicSelectors at: self atomicType. byteOffset}] ifNotNil: [ "Type alias" '^ {1} fromHandle: (handle structAt: {2} length: {3})' format: { referentClass name. byteOffset. self byteSize}]! Item was changed: ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName ^ referentClass ifNil: ["genuine atomics" + (AtomicSends at: self atomicType + 1) second template, '.' - 'handle {1} {2} put: {3}.' format: { + 'handle'. - AtomicSelectors at: self atomicType. byteOffset. valueName}] ifNotNil: ["type alias" 'handle structAt: {1} put: {2} getHandle length: {3}.' format: { byteOffset. valueName. self byteSize}]! Item was changed: ----- Method: ExternalStructureType>>readAlias (in category 'external structure') ----- readAlias ^ '^ {1} fromHandle: handle' format: {referentClass name}! Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' + classVariableNames: 'ArrayClasses ArrayTypes AtomicSends AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses' - classVariableNames: 'ArrayClasses ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects. Instance variables: compiledSpec Compiled specification of the external type referentClass Class type of argument required referencedType Associated (non)pointer type with the receiver byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed. Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following: FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits. FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly. [Note: Other combinations may be allowed in the future] ! Item was added: + ----- Method: ExternalType class>>initializeAtomicSends (in category 'class initialization') ----- + initializeAtomicSends + " + ExternalType initializeAtomicSends. + " + AtomicSends ifNil: [ + AtomicSends := Array new: AtomicTypeNames size]. + + self atomicTypes withIndexDo: [:type :index | + AtomicSends at: index put: (FFIAtomicReadWriteSend fromType: type)].! Item was changed: ----- Method: ExternalType class>>initializeDefaultTypes (in category 'class initialization') ----- initializeDefaultTypes "Create new atomic types and setup the dictionaries. See #resetAllAtomicTypes." AtomicTypes ifNil: [ AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types." AtomicTypeNames valuesDo: [:typeName | self newTypeForAtomicNamed: typeName]]. self initializeAtomicTypes. + self initializeAtomicSends. self initializeStructureTypes.! Item was changed: ----- Method: ExternalType class>>initializeFFIConstants (in category 'class initialization') ----- initializeFFIConstants "ExternalType initialize" FFIConstants initialize. "ensure proper initialization" AtomicTypeNames := IdentityDictionary new. - AtomicSelectors := IdentityDictionary new. AtomicTypeNames at: FFITypeVoid put: 'void'; at: FFITypeBool put: 'bool'; at: FFITypeUnsignedByte put: 'byte'; at: FFITypeSignedByte put: 'sbyte'; at: FFITypeUnsignedShort put: 'ushort'; at: FFITypeSignedShort put: 'short'; flag: #ffiLongVsInt; at: FFITypeUnsignedInt put: 'ulong'; at: FFITypeSignedInt put: 'long'; at: FFITypeUnsignedLongLong put: 'ulonglong'; at: FFITypeSignedLongLong put: 'longlong'; at: FFITypeUnsignedChar put: 'char'; at: FFITypeSignedChar put: 'schar'; at: FFITypeSingleFloat put: 'float'; at: FFITypeDoubleFloat put: 'double'; + yourself.! - yourself. - - AtomicSelectors - at: FFITypeVoid put: #voidAt:; - at: FFITypeBool put: #booleanAt:; - at: FFITypeUnsignedByte put: #unsignedByteAt:; - at: FFITypeSignedByte put: #signedByteAt:; - at: FFITypeUnsignedShort put: #unsignedShortAt:; - at: FFITypeSignedShort put: #signedShortAt:; - flag: #ffiLongVsInt; - at: FFITypeUnsignedInt put: #unsignedLongAt:; - at: FFITypeSignedInt put: #signedLongAt:; - at: FFITypeUnsignedLongLong put: #unsignedLongLongAt:; - at: FFITypeSignedLongLong put: #signedLongLongAt:; - at: FFITypeUnsignedChar put: #unsignedCharAt:; - at: FFITypeSignedChar put: #signedCharAt:; - at: FFITypeSingleFloat put: #floatAt:; - at: FFITypeDoubleFloat put: #doubleAt:; - yourself! Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes." AtomicTypes := nil. + AtomicSends := nil. StructTypes := nil. ArrayTypes := nil. ArrayClasses := nil. self initializeDefaultTypes. self initializeArrayClasses. self resetAllStructureTypes.! Item was added: + ----- Method: ExternalType>>isBoolType (in category 'testing - special') ----- + isBoolType + + | type | + type := self atomicType. + ^ type = FFITypeBool! Item was changed: ----- Method: ExternalUnknownType>>printOn: (in category 'printing') ----- printOn: aStream + aStream + nextPutAll: ''; + space; + print: self typeName.! - aStream nextPutAll: ''.! Item was added: + MessageSend subclass: #FFIAtomicReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !FFIAtomicReadWriteSend commentStamp: 'mt 5/19/2021 10:20' prior: 0! + I am a message send for reading and writing atomic values from and to byte arrays or external addresses. + + I can help with code generation through #template. + + Take a look at ExternalType class >> #initializeAtomicSends.! Item was added: + ----- Method: FFIAtomicReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: atomicType + + atomicType isFloatType + ifTrue: [^ FloatReadWriteSend fromType: atomicType]. + + atomicType isIntegerType + ifTrue: [^ IntegerReadWriteSend fromType: atomicType]. + + atomicType isCharType + ifTrue: [^ CharacterReadWriteSend fromType: atomicType]. + + atomicType isBoolType + ifTrue: [^ BooleanReadWriteSend fromType: atomicType]. + + atomicType isVoid + ifTrue: [^ VoidReadWriteSend fromType: atomicType]. + + self error: 'Unkown atomic type!!'.! Item was added: + ----- Method: FFIAtomicReadWriteSend class>>lookupSelectorsFor: (in category 'instance creation') ----- + lookupSelectorsFor: atomicType + + | result | + result := Array with: nil "read selector" with: nil "write selector". + ByteArray methodsDo: [:method | + (method pragmaAt: #ffiAtomicRead:) ifNotNil: [:pragma | + ((pragma argumentAt: 1) anySatisfy: [:typeName | + (ExternalType atomicTypeNamed: typeName) = atomicType]) + ifTrue: [result at: 1 put: method selector]]. + (method pragmaAt: #ffiAtomicWrite:) ifNotNil: [:pragma | + ((pragma argumentAt: 1) anySatisfy: [:typeName | + (ExternalType atomicTypeNamed: typeName) = atomicType]) + ifTrue: [result at: 2 put: method selector]]. + (result first notNil and: [result second notNil]) + ifTrue: [^ result "early out"]]. + + (result first isNil or: [result second isNil]) + ifTrue: [self error: 'Could not find selectors for both read and write!!']. + + ^ result! Item was added: + ----- Method: FFIAtomicReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: receiver at: byteOffset + + self subclassResponsibility.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: receiver at: byteOffset put: floatValue + + self subclassResponsibility.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>isReading (in category 'accessing') ----- + isReading + + self subclassResponsibility.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>isWriting (in category 'accessing') ----- + isWriting + + ^ self isReading not! Item was added: + ----- Method: FFIAtomicReadWriteSend>>printOn: (in category 'nil') ----- + printOn: stream + + stream nextPutAll: self template.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>template (in category 'compiling') ----- + template + "Answers a source code template to be used to compile this send into an accessor method such as for struct fields." + + | formatIndex result | + formatIndex := 1. + result := ((selector findTokens: ':') with: arguments collect: [:token :argument | + argument + ifNil: [ formatIndex := formatIndex + 1. token, ': {', formatIndex, '}' ] + ifNotNil: [ token, ': ', argument asString ]]) joinSeparatedBy: String space. + ^ '{1} ', result! Item was added: + FFIAtomicReadWriteSend subclass: #FloatReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !FloatReadWriteSend commentStamp: 'mt 5/19/2021 10:19' prior: 0! + I am a message send for reading and writing atomic float values from and to byte arrays or external addresses. See #isFloatType and #initializeAtomicSends.! Item was added: + ----- Method: FloatReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: type + + | selectors | + selectors := self lookupSelectorsFor: type. + ^ { + + self + receiver: nil "handle" selector: selectors first + arguments: (Array + with: nil "byteOffset"). + + self + receiver: nil "handle" selector: selectors second + arguments: (Array + with: nil "byteOffset" + with: nil "aFloat") + + }! Item was added: + ----- Method: FloatReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: receiver at: byteOffset + + ^ receiver + perform: selector + with: byteOffset! Item was added: + ----- Method: FloatReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: receiver at: byteOffset put: floatValue + + receiver + perform: selector + with: byteOffset + with: floatValue. + ^ floatValue! Item was added: + ----- Method: FloatReadWriteSend>>isReading (in category 'accessing') ----- + isReading + + ^ selector numArgs = 1! Item was added: + FFIAtomicReadWriteSend subclass: #IntegerReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !IntegerReadWriteSend commentStamp: 'mt 5/19/2021 10:15' prior: 0! + I am a message send for reading and writing atomic integer values from and to byte arrays or external addresses. My instances memoize type-specific #byteSize and #isSigned. See #isIntegerType and #initializeAtomicSends.! Item was added: + ----- Method: IntegerReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: type + "Overwritten to account for byteSize and isSigned." + + | selectors | + selectors := self lookupSelectorsFor: type. + ^ { + + self + receiver: nil "handle" selector: selectors first + arguments: (Array + with: nil "byteOffset" + with: type byteSize + with: type isSigned). + + self + receiver: nil "handle" selector: selectors second + arguments: (Array + with: nil "byteOffset" + with: nil "integerValue" + with: type byteSize + with: type isSigned) + + }! Item was added: + ----- Method: IntegerReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: receiver at: byteOffset + "Read." + + ^ receiver + perform: selector + with: byteOffset + with: (arguments at: 2) "byteSize" + with: (arguments at: 3) "isSigned"! Item was added: + ----- Method: IntegerReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: receiver at: byteOffset put: integerValue + "Write." + + receiver + perform: selector + with: byteOffset + with: integerValue + with: (arguments at: 3) "byteSize" + with: (arguments at: 4). "isSigned" + ^ integerValue! Item was added: + ----- Method: IntegerReadWriteSend>>isReading (in category 'accessing') ----- + isReading + + ^ selector numArgs = 3! Item was added: + FFIAtomicReadWriteSend subclass: #VoidReadWriteSend + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !VoidReadWriteSend commentStamp: 'mt 5/19/2021 10:19' prior: 0! + I am (kind of a) null object for atomic read-write sends. You should never try to read nor write void.! Item was added: + ----- Method: VoidReadWriteSend class>>fromType: (in category 'instance creation') ----- + fromType: type + + ^ { + self receiver: nil selector: #voidAt:. + self receiver: nil selector: #voidAt:put:}! Item was added: + ----- Method: VoidReadWriteSend>>handle:at: (in category 'evaluating') ----- + handle: handle at: byteOffset + "no accessors for void" + self shouldNotImplement.! Item was added: + ----- Method: VoidReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: handle at: byteOffset put: value + "no accessors for void" + self shouldNotImplement.! Item was added: + ----- Method: VoidReadWriteSend>>isReading (in category 'accessing') ----- + isReading + + ^ selector numArgs = 1! Item was added: + ----- Method: VoidReadWriteSend>>template (in category 'compiling') ----- + template + + ^ 'self shouldNotImplement'! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. + "Introduce FFIAtomicReadWriteSend. All types need to be reset and all fields need to be re-defined." + ExternalType resetAllTypes. - ExternalType resetAllTypes.. - - "Re-generate all field accessors because in ExternalData, #size: was replaced with #setSet: and a new constructors for content and container types." ExternalStructure defineAllFields. '! From commits at source.squeak.org Wed May 19 08:34:53 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 08:34:53 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.32.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.32.mcz ==================== Summary ==================== Name: FFI-Tools-mt.32 Author: mt Time: 19 May 2021, 10:34:52.271615 am UUID: 85d06810-dfc4-2246-8e37-5bbc2bc11872 Ancestors: FFI-Tools-mt.31 Minor tweaks for representation of external types in Object Explorer. =============== Diff against FFI-Tools-mt.31 =============== Item was changed: ----- Method: ExternalStructureType>>explorerContents (in category '*FFI-Tools') ----- explorerContents | basicExplorerFields fieldTypeFields | basicExplorerFields := super explorerContents. fieldTypeFields := Array streamContents: [:s | self typesDo: [:type :fieldName | s nextPut: (ObjectExplorerWrapper with: type name: (fieldName ifNil: ['__'] ifNotNil: ['_', fieldName]) model: self)]]. + ^ basicExplorerFields, fieldTypeFields! - ^ fieldTypeFields, basicExplorerFields! Item was changed: ----- Method: ExternalType>>explorerContents (in category '*FFI-Tools') ----- explorerContents + | basicExplorerFields | - | basicExplorerFields originalTypeField | basicExplorerFields := super explorerContents. basicExplorerFields do: [:explorerField | explorerField itemName = 'compiledSpec' ifTrue: [ explorerField changeClassTo: CompiledSpecWrapper]]. + (self isTypeAlias or: [self isTypeAliasReferenced]) + ifTrue: [ + basicExplorerFields := + {ObjectExplorerWrapper + with: self originalType + name: '~>' + model: self}, basicExplorerFields] + ifFalse: [self isAtomic ifTrue: [ + basicExplorerFields := basicExplorerFields, + {ObjectExplorerWrapper + with: (AtomicSends at: self atomicType + 1) first + name: '_reader' + model: self. + ObjectExplorerWrapper + with: (AtomicSends at: self atomicType + 1) second + name: '_writer' + model: self}]]. + - self isTypeAlias ifTrue: [ - originalTypeField := ObjectExplorerWrapper - with: self originalType - name: '_originalType' - model: self. - ^ {originalTypeField}, basicExplorerFields]. - ^ basicExplorerFields! From commits at source.squeak.org Wed May 19 09:47:00 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 09:47:00 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.161.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.161.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.161 Author: mt Time: 19 May 2021, 11:46:59.622615 am UUID: 711b5cef-0d3c-9e4b-98d5-79cc06662c70 Ancestors: FFI-Kernel-mt.160 Adds support for arrays with more than 65535 bytes. Note that this information cannot be encoded in the headerWord (yet) and is similar to the other information not encoded there (yet): size and contentType. =============== Diff against FFI-Kernel-mt.160 =============== Item was changed: ExternalType subclass: #ExternalArrayType + instanceVariableNames: 'contentType size byteSize' - instanceVariableNames: 'contentType size' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!" | type pointerType headerWord byteSize | self flag: #contentVsContainer; assert: [contentType isTypeAlias or: [contentType isArrayType not]] description: 'No support for direct multi-dimensional containers yet. Use type aliases.'. self assert: [contentType isVoid not] description: 'No array types for void type!!'. self assert: [ (ArrayTypes at: contentType typeName ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] ifAbsent: [nil] ) isNil] description: 'Array type already exists. Use #typeNamed: to access it.'. type := ExternalArrayType basicNew. pointerType := ExternalPointerType basicNew. "1) Regular type" byteSize := numElements ifNil: [0] ifNotNil: [numElements * contentType byteSize]. - self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. + headerWord := headerWord bitOr: (byteSize min: FFIStructSizeMask). - headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); setReferentClass: contentType referentClass; setContentType: contentType; + setSize: numElements; + setByteSize: byteSize. - setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); byteAlignment: self pointerAlignment; setReferentClass: nil. "3) Remember this new array type." (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) at: numElements put: type. ^ type! Item was changed: ----- Method: ExternalArrayType>>byteSize (in category 'accessing') ----- byteSize "For array types with an unknown size, also answer an unknown byte size." + ^ size ifNotNil: [byteSize]! - ^ size ifNotNil: [super byteSize]! Item was changed: ----- Method: ExternalArrayType>>newReferentClass: (in category 'private') ----- newReferentClass: classOrNil "The class I'm referencing has changed, which affects arrays of structs. Update my byteSize." | newByteSize newHeaderWord | (referentClass := classOrNil) ifNil: [ "my class has been removed - make me empty" compiledSpec := WordArray with: self class structureSpec. byteAlignment := 1] ifNotNil: [ "my class has been changed - update my compiledSpec" newHeaderWord := referentClass compiledSpec first. newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)]. newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask. + newHeaderWord := newHeaderWord bitOr: (newByteSize min: FFIStructSizeMask). - newHeaderWord := newHeaderWord bitOr: newByteSize. compiledSpec := WordArray with: newHeaderWord. + byteAlignment := referentClass byteAlignment. + byteSize := newByteSize]! - byteAlignment := referentClass byteAlignment]! Item was added: + ----- Method: ExternalArrayType>>setByteSize: (in category 'private') ----- + setByteSize: newByteSize + + byteSize := newByteSize.! Item was added: + ----- Method: ExternalType>>asBasicType (in category 'converting') ----- + asBasicType + "Construct a basic representation of the receiver. Can be used for testing the #headerWord and other basic properties that are accessible from within the FFI plugin for type checking etc. where polymorphic message sending cannot be applied." + + | basicType basicReferencedType | + basicType := ExternalType basicNew + compiledSpec: compiledSpec; + setReferentClass: referentClass; + yourself. + basicReferencedType := ExternalType basicNew + compiledSpec: referencedType compiledSpec; + setReferentClass: referencedType referentClass; + yourself. + basicType setReferencedType: basicReferencedType. + basicReferencedType setReferencedType: basicType. + ^ basicType! Item was removed: - ----- Method: ExternalType>>asExternalType (in category 'converting') ----- - asExternalType - - ^ self! Item was changed: ----- Method: ExternalType>>asPointerToPointerType (in category 'converting') ----- asPointerToPointerType - "char** etc." + self flag: #todo. "mt: Maybe we might want to use double pointers such as void** to indicate address-of-a-pointer on call? So that domain-specific malloc functions can work such as void allocate(void** pointer, size_t size);. Otherwise map it to an array of pointers instead: void*[]." + ^ (self asPointerType asArrayType: nil) asPointerType! - self flag: #todo. "mt: We might want to cast this to something that holds multiple ExternalData. If null-terminated, that would be easy. But maybe also support extra arg for size as in main(argc int, char *argv[]) . Maybe we could add ExternalArray... I assume that such a type starts in the image anyway to be passed as argument in an FFI call. That is, can there be function that returns void** ?" - ^ self asPointerType! Item was changed: ----- Method: ExternalUnknownType>>becomeArrayType (in category 'construction') ----- becomeArrayType "I am now positive on #isTypeAliasForArray :-) Make myself an array type. Not that easy because Arraytype as extra instVars #size and #contentType." | newArrayType | newArrayType := ExternalArrayType basicNew compiledSpec: self compiledSpec; byteAlignment: self byteAlignment; setReferentClass: referentClass; setReferencedType: referencedType; setContentType: referentClass originalType contentType; "Hmm..." setSize: referentClass originalType size; "Hmm..." + setByteSize: referentClass originalType byteSize; "Hmm..." yourself. "No referentClass for pointer types of array types." referencedType setReferentClass: nil. self becomeForward: newArrayType. ^ newArrayType! From commits at source.squeak.org Wed May 19 09:49:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 09:49:11 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.43.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.43.mcz ==================== Summary ==================== Name: FFI-Tests-mt.43 Author: mt Time: 19 May 2021, 11:49:10.499615 am UUID: f6ac8199-1124-3f4c-9e7a-29f27148057f Ancestors: FFI-Tests-mt.42 Complements FFI-Kernel-mt.161. Adds tests for large arrays and arrays of empty structs. =============== Diff against FFI-Tests-mt.42 =============== Item was changed: TestCase subclass: #ExternalTypeTests instanceVariableNames: 'heapObject' classVariableNames: '' + poolDictionaries: 'FFIConstants' - poolDictionaries: '' category: 'FFI-Tests'! Item was changed: ----- Method: ExternalTypeTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + testBasicTypeForArrayType "Fails because compiledSpec does not yet encode that information" - testIsArrayType "Fails because compiledSpec does not yet encode that maybe because of extra information that needs to be stored in an extra instVar." - testByteSizeArrayType "(see above)" - testSizeArrayType "(see above)" )! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsEmpty (in category 'tests - array types') ----- + testArrayOfStructsEmpty + + | structClass arrayType contentType | + structClass := FFITestEmptyStruct. + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + + self assert: contentType isEmpty. + self assert: 0 equals: contentType byteSize. + self assert: 0 equals: arrayType byteSize. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testArrayWithLargeByteSize (in category 'tests - array types') ----- + testArrayWithLargeByteSize + + | arrayType byteSize contentType arraySize | + byteSize := FFIStructSizeMask + 1. + contentType := ExternalType uint64_t. + arraySize := (byteSize / contentType byteSize) rounded. + arrayType := contentType asArrayType: arraySize. + self assert: arrayType byteSize > FFIStructSizeMask.! Item was added: + ----- Method: ExternalTypeTests>>testBasicType (in category 'tests - compiled spec') ----- + testBasicType + + | type baseType | + type := ExternalType int32_t. + baseType := type asBasicType. + self assert: ExternalType identical: baseType asNonPointerType class. + self assert: ExternalType identical: baseType asPointerType class.! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForArrayType (in category 'tests - compiled spec') ----- + testBasicTypeForArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type asBasicType. + self assert: type isArrayType equals: baseType isArrayType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForAtomicType (in category 'tests - compiled spec') ----- + testBasicTypeForAtomicType + + | type baseType | + type := ExternalType int32_t. + baseType := type asBasicType. + self assert: type isAtomic equals: baseType isAtomic. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForPointerType (in category 'tests - compiled spec') ----- + testBasicTypeForPointerType + + | type baseType | + type := ExternalType int32_t asPointerType. + baseType := type asBasicType. + self assert: type isPointerType equals: baseType isPointerType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForStructureType (in category 'tests - compiled spec') ----- + testBasicTypeForStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type asBasicType. + self assert: type isStructureType equals: baseType isStructureType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeArrayType (in category 'tests - compiled spec') ----- - testByteSizeArrayType - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeAtomicType (in category 'tests - compiled spec') ----- - testByteSizeAtomicType - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizePointerType (in category 'tests - compiled spec') ----- - testByteSizePointerType - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeStructureType (in category 'tests - compiled spec') ----- - testByteSizeStructureType - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testIsArrayType (in category 'tests - compiled spec') ----- - testIsArrayType - "#isArrayType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isArrayType. - self assert: baseType isArrayType.! Item was removed: - ----- Method: ExternalTypeTests>>testIsAtomicType (in category 'tests - compiled spec') ----- - testIsAtomicType - "#isAtomic should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type isAtomic. - self assert: baseType isAtomic.! Item was removed: - ----- Method: ExternalTypeTests>>testIsPointerType (in category 'tests - compiled spec') ----- - testIsPointerType - "#isPointerType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isPointerType. - self assert: baseType isPointerType.! Item was removed: - ----- Method: ExternalTypeTests>>testIsStructureType (in category 'tests - compiled spec') ----- - testIsStructureType - "#isStructureType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isStructureType. - self assert: baseType isStructureType.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeArrayType (in category 'tests - compiled spec') ----- - testSizeArrayType - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeAtomicType (in category 'tests - compiled spec') ----- - testSizeAtomicType - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizePointerType (in category 'tests - compiled spec') ----- - testSizePointerType - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeStructureType (in category 'tests - compiled spec') ----- - testSizeStructureType - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was changed: TestCase subclass: #FFIAllocateTests instanceVariableNames: 'externalObjects' classVariableNames: '' + poolDictionaries: 'FFIConstants' - poolDictionaries: '' category: 'FFI-Tests'! !FFIAllocateTests commentStamp: 'mt 5/10/2021 10:18' prior: 0! A collection of tests around the allocation of structs, unions, and arrays of atomics/structs/unions. Includes tests about accessing (field read/write) those after allocation.! Item was added: + ----- Method: FFIAllocateTests>>test12ArrayWithLargeSize (in category 'tests - array') ----- + test12ArrayWithLargeSize + + | array byteSize contentType arraySize | + byteSize := FFIStructSizeMask + 1. + contentType := ExternalType uint64_t. + arraySize := (byteSize / contentType byteSize) rounded. + array := self allocate: contentType size: arraySize. + self assert: array byteSize > FFIStructSizeMask.! From commits at source.squeak.org Wed May 19 09:51:17 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 09:51:17 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.43.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.43.mcz ==================== Summary ==================== Name: FFI-Tests-mt.43 Author: mt Time: 19 May 2021, 11:51:16.731615 am UUID: acd1fba9-b1dd-c348-9c51-d0ba449c6a2f Ancestors: FFI-Tests-mt.43 Complements FFI-Kernel-mt.161. Adds tests for large arrays and arrays of empty structs. =============== Diff against FFI-Tests-mt.43 =============== From commits at source.squeak.org Wed May 19 09:52:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 09:52:46 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.43.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.43.mcz ==================== Summary ==================== Name: FFI-Tests-mt.43 Author: mt Time: 19 May 2021, 11:49:10.499615 am UUID: f6ac8199-1124-3f4c-9e7a-29f27148057f Ancestors: FFI-Tests-mt.42 Complements FFI-Kernel-mt.161. Adds tests for large arrays and arrays of empty structs. =============== Diff against FFI-Tests-mt.42 =============== Item was changed: TestCase subclass: #ExternalTypeTests instanceVariableNames: 'heapObject' classVariableNames: '' + poolDictionaries: 'FFIConstants' - poolDictionaries: '' category: 'FFI-Tests'! Item was changed: ----- Method: ExternalTypeTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + testBasicTypeForArrayType "Fails because compiledSpec does not yet encode that information" - testIsArrayType "Fails because compiledSpec does not yet encode that maybe because of extra information that needs to be stored in an extra instVar." - testByteSizeArrayType "(see above)" - testSizeArrayType "(see above)" )! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsEmpty (in category 'tests - array types') ----- + testArrayOfStructsEmpty + + | structClass arrayType contentType | + structClass := FFITestEmptyStruct. + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + + self assert: contentType isEmpty. + self assert: 0 equals: contentType byteSize. + self assert: 0 equals: arrayType byteSize. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testArrayWithLargeByteSize (in category 'tests - array types') ----- + testArrayWithLargeByteSize + + | arrayType byteSize contentType arraySize | + byteSize := FFIStructSizeMask + 1. + contentType := ExternalType uint64_t. + arraySize := (byteSize / contentType byteSize) rounded. + arrayType := contentType asArrayType: arraySize. + self assert: arrayType byteSize > FFIStructSizeMask.! Item was added: + ----- Method: ExternalTypeTests>>testBasicType (in category 'tests - compiled spec') ----- + testBasicType + + | type baseType | + type := ExternalType int32_t. + baseType := type asBasicType. + self assert: ExternalType identical: baseType asNonPointerType class. + self assert: ExternalType identical: baseType asPointerType class.! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForArrayType (in category 'tests - compiled spec') ----- + testBasicTypeForArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type asBasicType. + self assert: type isArrayType equals: baseType isArrayType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForAtomicType (in category 'tests - compiled spec') ----- + testBasicTypeForAtomicType + + | type baseType | + type := ExternalType int32_t. + baseType := type asBasicType. + self assert: type isAtomic equals: baseType isAtomic. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForPointerType (in category 'tests - compiled spec') ----- + testBasicTypeForPointerType + + | type baseType | + type := ExternalType int32_t asPointerType. + baseType := type asBasicType. + self assert: type isPointerType equals: baseType isPointerType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testBasicTypeForStructureType (in category 'tests - compiled spec') ----- + testBasicTypeForStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type asBasicType. + self assert: type isStructureType equals: baseType isStructureType. + self assert: type byteSize equals: baseType byteSize. + self assert: type size equals: baseType size. ! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeArrayType (in category 'tests - compiled spec') ----- - testByteSizeArrayType - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeAtomicType (in category 'tests - compiled spec') ----- - testByteSizeAtomicType - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizePointerType (in category 'tests - compiled spec') ----- - testByteSizePointerType - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testByteSizeStructureType (in category 'tests - compiled spec') ----- - testByteSizeStructureType - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type byteSize equals: baseType byteSize.! Item was removed: - ----- Method: ExternalTypeTests>>testIsArrayType (in category 'tests - compiled spec') ----- - testIsArrayType - "#isArrayType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isArrayType. - self assert: baseType isArrayType.! Item was removed: - ----- Method: ExternalTypeTests>>testIsAtomicType (in category 'tests - compiled spec') ----- - testIsAtomicType - "#isAtomic should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type isAtomic. - self assert: baseType isAtomic.! Item was removed: - ----- Method: ExternalTypeTests>>testIsPointerType (in category 'tests - compiled spec') ----- - testIsPointerType - "#isPointerType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isPointerType. - self assert: baseType isPointerType.! Item was removed: - ----- Method: ExternalTypeTests>>testIsStructureType (in category 'tests - compiled spec') ----- - testIsStructureType - "#isStructureType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type isStructureType. - self assert: baseType isStructureType.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeArrayType (in category 'tests - compiled spec') ----- - testSizeArrayType - - | type baseType | - type := ExternalType typeNamed: 'char[5]'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalArrayType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeAtomicType (in category 'tests - compiled spec') ----- - testSizeAtomicType - - | type baseType | - type := ExternalType typeNamed: 'int32_t'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalAtomicType identical: type class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizePointerType (in category 'tests - compiled spec') ----- - testSizePointerType - - | type baseType | - type := ExternalType typeNamed: 'int32_t*'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalPointerType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was removed: - ----- Method: ExternalTypeTests>>testSizeStructureType (in category 'tests - compiled spec') ----- - testSizeStructureType - - | type baseType | - type := ExternalType typeNamed: 'FFITestSdi'. - baseType := type copy changeClassTo: ExternalType. - - self assert: ExternalStructureType identical: type class. - self assert: ExternalType identical: baseType class. - - self assert: type size equals: baseType size.! Item was changed: TestCase subclass: #FFIAllocateTests instanceVariableNames: 'externalObjects' classVariableNames: '' + poolDictionaries: 'FFIConstants' - poolDictionaries: '' category: 'FFI-Tests'! !FFIAllocateTests commentStamp: 'mt 5/10/2021 10:18' prior: 0! A collection of tests around the allocation of structs, unions, and arrays of atomics/structs/unions. Includes tests about accessing (field read/write) those after allocation.! Item was added: + ----- Method: FFIAllocateTests>>test12ArrayWithLargeSize (in category 'tests - array') ----- + test12ArrayWithLargeSize + + | array byteSize contentType arraySize | + byteSize := FFIStructSizeMask + 1. + contentType := ExternalType uint64_t. + arraySize := (byteSize / contentType byteSize) rounded. + array := self allocate: contentType size: arraySize. + self assert: array byteSize > FFIStructSizeMask.! From marcel.taeumel at hpi.de Wed May 19 16:19:41 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Wed, 19 May 2021 18:19:41 +0200 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: <64c52ebc75c540d292c96ff0dee2118d@student.hpi.uni-potsdam.de> References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> <,> <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de> <,> <64c52ebc75c540d292c96ff0dee2118d@student.hpi.uni-potsdam.de> Message-ID: > Well, that's another argument for my proposed fix, isn't it? :-) Only if you would make a case for removing #isArray from the entire image. I suppose. Maybe #isArray is like a trade-off. You do not want to have to compare classes, but it might not be a good idea to implement #isArray in your domain object. Hmm... To improve anything in this regard, I would suggest to widen our perspective on this issue. A list of the current challenges around ProtoObject (maybe in combination with object-as-method?) might be helpful to make informed decisions. This isolated discussion around "== Array" vs. "isArray" doesn't feel right. Best, Marcel Am 17.05.2021 13:08:07 schrieb Thiede, Christoph : Well, that's another argument for my proposed fix, isn't it? :-) Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:54:50 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   > Given any object of a class that reimplements #isArray in an erroneous way Given my recent slip in the FFI package, I have the feeling that #isArray has a really specific meaning for the class layout. No one should claim to also be an Array. :-D I mean, not even RawBitsArray does it. There is something going on. :-) Best, Marcel Am 17.05.2021 12:00:33 schrieb Thiede, Christoph : Hi Marcel, > Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Of course, here are you: Debug it: ObjectTracer on: Morph new In the trunk, this spawns an embarrassing number of additional debuggers while debugging the expression. With my proposed fix, not a single additional debugger is opened before you actually send a message to the morph. Here is another example. Given any object of a class that reimplements #isArray in an erroneous way, this will break the simulator, too: Object newSubclass     compile: 'isArray ^self notYetImplemented';     new "step through this" > My impression was that even the BasicInspector struggled to deal with proxies. I think I have fixed this issue via Tools-ct.1056/ToolsTests-ct.105. Best, Christoph Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 08:08 Uhr An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz   Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html [http://forum.world.st/Squeak-Dev-f45488.html] -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Wed May 19 17:34:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 19 May 2021 17:34:01 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1409.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1409.mcz ==================== Summary ==================== Name: Kernel-jar.1409 Author: jar Time: 19 May 2021, 7:33:57.421479 pm UUID: 6644ef0b-cdd5-3a47-9f3a-47c6639c7f82 Ancestors: Kernel-nice.1402 Replace Kernel-jar.1408 and supersede Kernel-jar.1406. This is a "final" version :) (I noticed too late Kernel-jar.1408 uploaded incorrectly, apologies - please disregard that commit) Clean-up, extract repeating code to a new method #complete:to:, revert an incorrect modification of #runUntilErrorOrReturnFrom from Kernel-jar.1406 and 1408, resolve MessageNotUnderstood recursion problem, update comments... Consistent with current ProcessTest >> #testNestedUnwind semantics for completing nested halfways-through unwind blocks during termination: x1 := x2 := x3 := nil. p:=[ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" Processor activeProcess suspend. "here the process gets terminated" x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] fork. Processor yield. p terminate self assert: x1 & x2 & x3. Original discussion of the changes in #terminate: http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposal-td5128285.html Discussion regarding a proposal to change the current semantics: http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. thisContext privRefresh]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was added: + ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'private') ----- + runUnwindUntilErrorOrReturnFrom: aSender + "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." + "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." + + | error ctxt here topContext | + here := thisContext. + + "Insert ensure and exception handler contexts under aSender" + error := nil. + ctxt := aSender insertSender: (Context + contextOn: UnhandledError do: [:ex | + error ifNil: [ + error := ex exception. + topContext := thisContext. + here jump. + ex signalerContext restart "re-signal the error when jumped back"] + ifNotNil: [ex pass] + ]). + ctxt := ctxt insertSender: (Context + contextEnsure: [error ifNil: [ + topContext := thisContext. + here jump] + ]). + self jump. "Control jumps to self" + + "Control resumes here once above ensure block or exception handler is executed" + ^ error ifNil: [ + "No error was raised, remove ensure context by stepping until popped" + [ctxt isDead] whileFalse: [topContext := topContext stepToCallee]. + {topContext. nil} + + ] ifNotNil: [ + "Error was raised, remove inserted above contexts then return signaler context" + aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" + {topContext. error} + ]! Item was added: + ----- Method: Process>>complete:to: (in category 'private') ----- + complete: topContext to: aContext + "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled + error is raised. Return self's new top context. Note: topContext must be a stack top context. + This method is meant to be called primarily by Process>>#terminate." + + | pair top error | + pair := Processor activeProcess + evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext] + onBehalfOf: self. + top := pair first. + error := pair second. + "If an error was detected jump back to the debugged process and re-signal the error; + some errors may require a special care to prevent e.g. an infinite recursion. + Note: BlockCannotReturn is an opportunity for further improvements." + error ifNotNil: [ + error class == BlockCannotReturn ifTrue: [^top]. "do not jump back, just continue unwinding" + error class == MessageNotUnderstood ifTrue: [error initialize]. "reset reachedDefaultHandler before jump" + top jump]. + ^top + ! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | oldList top ctxt outerMost newTop unwindBlock | + "If terminating the active process, suspend it first and terminate it as a suspended process." - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ - "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." - N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al - then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. + suspendedContext ifNil: [^self]. "self is already terminated" + "Release any method marked with the pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - suspendedContext ifNotNil: - ["Release any method marked with the pragma. - The argument is whether the process is runnable." - self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + top := suspendedContext. + suspendedContext := nil. "disable this process while running its stack in active process below" + "If terminating a process halfways through an unwind, try to complete that unwind block first; + if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner + blocks will be completed in the process. Halfway through blocks have already set the complete + variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true." + ctxt := top. + [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: [ + (ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. + "Let's finish the outer-most unwind context currently under evaluation (if there's one). + Note: outerMost may in theory be the top context e.g. in case #ensure was interrupted right after + assigning its complete := true." + outerMost ifNotNil: [newTop := self complete: top to: outerMost]. - "If terminating a process halfways through an unwind, try to complete that unwind block first; - if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner - blocks will be completed in the process." - ctxt := suspendedContext. - [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: - "Contexts under evaluation have already set their complete (tempAt: 2) to true." - [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. + "By now all halfway-through unwind blocks have been completed; let's execute the ones still pending. + Note: newTop sender points to the former outerMost sender i.e. the next unexplored context. + Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver + itself may be an unwind context." + ctxt := newTop ifNil: [top] ifNotNil: [newTop sender]. + ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. + [ctxt isNil] whileFalse: [ + (ctxt tempAt: 2) ifNil: [ + ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + "Create a context for the unwind block and execute it on the unwind block's stack. + Note: using #value instead of #complete:to: would lead to executing the unwind + on the wrong stack preventing the correct execution of non-local returns." + top := unwindBlock asContextWithSender: ctxt. + self complete: top to: top]. + ctxt := ctxt findNextUnwindContextUpTo: nil] + ! - "Now all unwind blocks caught halfway through have been completed; - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. - ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. - [ctxt isNil] whileFalse: [ - (ctxt tempAt: 2) ifNil: [ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - "Create a context for the unwind block and execute it on the unwind block's stack. - Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing - the unwind on the wrong stack preventing the correct execution of non-local returns." - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Wed May 19 17:38:52 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 19 May 2021 12:38:52 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1621271371954-0.post@n4.nabble.com> References: <1618045093475-0.post@n4.nabble.com> <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> Message-ID: <1621445932092-0.post@n4.nabble.com> Hi Christoph, hi all, I've updated my #terminate fix to a "final" version Kernel-jar.1409 in the Inbox: I'm still 100% convinced completing unwind block halfway-through their execution is a good idea; and it's not my idea ;) If a process gets interrupted or is suspended in the middle of unwinding, it should be allowed to finish all unwind blocks - both halfway-through and not-yet-started. It's not necessarily a case of a raised error or abandoning the debugger - it's a general termination procedure. If we say Abandoning a debugger equals terminating the debugged process then we should terminate it including all unwinds. If we don't want to equate Abandon to general termination that doesn't mean we have to change the termination logic - we should rather change the Abandoning logic in such case :) I think ProcessTest >> #testNestedUnwind illustrates the idea clearly: x1 := x2 := x3 := nil. p:=[ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" Processor activeProcess suspend. "here the process gets terminated" x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] fork. Processor yield. p terminate self assert: x1 & x2 & x3. There was nothing wrong with the process p when it got terminated in the first place and thus there's no reason to prevent it from finishing all its unwind blocks. > [...] the fact that an error has been signaled means that the > signalerContext is "infected" so under no circumstances, abandoning the > process should resume the execution of this infected context! You cannot know whether an error will be raised during termination - so you should not be changing the general termination logic but rather adjusting the "debugger abandon/termination" logic; currently the consensus is: debugger Abandon equals process termination but that's not necessarily so... > Instead of reinventing the unwinding wheel in Process, I reused the > existing logic from Context which > is important deduplication. Well, actually I didn't reinvent the unwind pattern but intentionally reused it with as few changes as possible - I think it improves readability because people easily recognize this pattern from #resume:, #resume:through:, #unwindTo and even the previous #terminate used the exact same pattern for an active process termination. Besides, using the same pattern for achieving a similar goal feels "safer" to me. > Instead of modifying #runUntilErrorOrReturnFrom:, I have moved the logic > to re-signal the UnhandledError into Process >> #complete:ifError:. [...] > The #resumeUnchecked: part could > actually be relevant if there occurs a second UnhandledError while jumping > out of reorf. Yes indeed, I made a silly assumption but reverted the change back already in Kernel-jar.1408. I use its modified replica instead. > I think that the fact that you needed to skip certain exceptions manually > was a giant suboptimal hack. :-) Yes, it was a sort of my to-do list ;) I've sorted out the MessageNotUnderstood but BlockCannotReturn is still a hot topic :) > I always recommend using as many block-local temps as possible, this makes > it easier to understand their > scope. In case you haven't heard it before, you might also want to google > Guard Clause. :-) Again, I wanted to make as few changes as possible; but agreed absolutely :) Thanks again very much for your comments. best regards, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Wed May 19 18:04:21 2021 From: m at jaromir.net (Jaromir Matas) Date: Wed, 19 May 2021 13:04:21 -0500 (CDT) Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination In-Reply-To: <1621288837863-0.post@n4.nabble.com> References: <1621288837863-0.post@n4.nabble.com> Message-ID: <1621447461345-0.post@n4.nabble.com> Hi Christoph, I posted some additional arguments in http://forum.world.st/Solving-multiple-termination-bugs-summary-proposal-tp5128285p5129859.html > [...] the fact that an error has been signaled means that the > signalerContext is "infected" so under no > circumstances, abandoning the process should resume the execution of this > infected context! This is what really got me thinking... yes, resuming errors sounds like a bad idea. But the point is if you terminate a totally healthy process in the middle of its unwind block then there's no reason to prevent its normal completion. The thing is you don't know in advance. But a debugger is a different story - you see an error and make a conscious decision - Proceed or Abandon? That's why I was looking for a Kill button :) Currently the consensus is Abandon = terminate, however this is not a given, it can be reconsidered... e.g. use the unwind version of regular #return/#resume/ etc - without unwinding halfway through block - that could make a good sense... It means two different unwind semantics could really be desirable and justified: If a healthy process terminates, let it unwind as much as possible including all unwind blocks halfway-through execution. If a broken process terminates via Abandoning the debugger, use the current "return" unwind semantics - i.e. execute only not-yet-started unwind blocks. What do you think? I'm looking forward to your thoughts. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From lewis at mail.msen.com Wed May 19 21:12:46 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Wed, 19 May 2021 17:12:46 -0400 Subject: [squeak-dev] The Trunk: System-dtl.1233.mcz In-Reply-To: References: <20210518023921.GA34512@shell.msen.com> Message-ID: <20210519211246.GB15318@shell.msen.com> On Wed, May 19, 2021 at 09:38:45AM +0200, Nicolas Cellier wrote: > Ah, here are some related hack for ChangeList > > https://source.squeak.org/trunk/Tools-nice.725.diff > Thanks I had not noticed that. > Does this Cuis change file opens correctly in a Change List, or do we > have to unify efforts? > I am not sure, but I will try to look at it soon. I just did the minimal change to support loading a pck file without error. It is good to support Cuis, we are all part of the Squeak family :-) Dave > Le mer. 19 mai 2021 ?? 04:22, Chris Muller a ??crit : > >> > >> And as explained in the commit comment: > >> > >> Skip chunks that begin with known extensions that are not meaningful > >> for Squeak, logging to Transcript to show chunks that have been ignored. > > > > > > Magma implements a method called #classDefinition:. I wanted to make sure this wouldn't cause it to get skipped. My test of filing out a single method and also the whole class, seemed to work okay. > > > >> > >> With respect to the Cuis reference, my use case was installing > >> VectorEnginePlugin in Squeak. The upstream repository for this plugin > >> is on GitHub, which stores the portable Smalltalk code in chunk format > >> with some Cuis extensions: > >> > >> https://github.com/Cuis-Smalltalk/Cuis-Smalltalk-Dev/blob/master/Packages/Features/VectorEnginePlugin.pck.st > >> > >> The plugin code is well-written and portable for at least Squeak and Cuis. > >> The Cuis-specific chunks are not relevant to Squeak, so they can and > >> should be ignored when filing in to Squeak. > > > > > > Does this mean we can generally load Cuis code into Squeak now? That almost seems [ANN]-worthy. :) > > > > - Chris > > > From giovanni at corriga.net Wed May 19 21:36:28 2021 From: giovanni at corriga.net (Giovanni Corriga) Date: Wed, 19 May 2021 22:36:28 +0100 Subject: [squeak-dev] UK Smalltalk User Group meeting - Wednesday May 26th Message-ID: The next meeting of the UK Smalltalk User Group will be on Wednesday, May 26th. Caffeine ( https://caffeine.js.org ) is a livecoded integration of the SqueakJS Smalltalkvirtual machine with the Web platform and its many frameworks. Craig Latta will show the current state of Caffeine development through live manipulation and combination of those frameworks. The primary vehicle is a Caffeine app called Worldly, combining the A-Frame VR framework, screen-sharing, and the Chrome Debugging Protocol into an immersive virtual-reality workspace. Craig Latta ( https://blackpagedigital.com ) is a livecoding composer from California. He studied music at Berkeley, where he learned Smalltalk as an improvisation practice. He has worked as a research computer scientist at Atari Games, IBM's Watson lab, and Lam Research. In 2016 he began combining Smalltalk technologies with the Web platform, with an emphasis on spatial computing. He is currently exploring spatial audio for immersive workspaces. Given the current COVID-19 restrictions, this will be an online meeting from home. If you'd like to join us, please sign up in advance on the meeting's Meetup page ( https://www.meetup.com/UKSTUG/events/cbklbrycchbjc/ ) to receive the meeting details. Don’t forget to bring your laptop and drinks! -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Thu May 20 09:47:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 May 2021 09:47:11 0000 Subject: [squeak-dev] The Trunk: Monticello-ct.747.mcz Message-ID: Marcel Taeumel uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.747.mcz ==================== Summary ==================== Name: Monticello-ct.747 Author: ct Time: 7 May 2021, 11:45:19.014241 pm UUID: 2cb0b275-8fb5-b149-b46d-41387d4d8f1f Ancestors: Monticello-ct.746 Fixes a bug in MCHttpRespository(MCFileBasedRepository) >> #versionNamed: that occurred when the repository did not contain the requested version. As the comment in the superclass states, answer nil in this case instead of raising a NetworkError. To do this, raise a more precise NotFound error in MCHttpRepository >> #webClientDo: if the version does not exist. I checked all other senders and handlers of the NetworkError; no one else depends on the old behavior. =============== Diff against Monticello-ct.746 =============== Item was changed: ----- Method: MCFileBasedRepository>>versionNamed: (in category 'versions') ----- versionNamed: aMCVersionName "For FileBased repositories, aMCVersionName must have the appropriate extension!! :-(" | version | version := self cache at: aMCVersionName ifAbsent: [ [ self loadVersionFromFileNamed: aMCVersionName ] + on: FileDoesNotExistException , NotFound - on: FileDoesNotExistException do: [ : err | nil ] ]. self resizeCache: cache. (version notNil and: [ version isCacheable ]) ifTrue: [ cache at: aMCVersionName asMCVersionName put: version ]. ^ version! Item was changed: ----- Method: MCHttpRepository>>webClientDo: (in category 'private') ----- webClientDo: aBlock | client attemptsLeft response result | self class useSharedWebClientInstance ifTrue: [ "Acquire webClient by atomically storing it in the client variable and setting its value to nil." client := webClient. webClient := nil ]. client ifNil: [ client := WebClient new ] ifNotNil: [ "Attempt to avoid an error by recreating the underlying stream." client isConnected ifFalse: [ client close ] ]. attemptsLeft := 3. response := nil. [ response isNil and: [ attemptsLeft > 0 ] ] whileTrue: [ response := [ aBlock value: client ] on: NetworkError do: [ :error | attemptsLeft = 0 ifTrue: [ error pass ]. (3 - attemptsLeft) seconds asDelay wait. attemptsLeft := attemptsLeft - 1. nil "The response" ] ]. result := (response code between: 200 and: 299) ifFalse: [ response content. "Make sure content is read." nil ] ifTrue: [ (RWBinaryOrTextStream with: ( response contentWithProgress: [ :total :amount | HTTPProgress new total: total; amount: amount; signal ])) reset ]. self class useSharedWebClientInstance ifTrue: [ "Save the WebClient instance for reuse, but only if there is no client cached." webClient ifNil: [ webClient := client ] ifNotNil: [ client close ] ] ifFalse: [ client close ]. + (response code = 404 "Not Found" or: [response code = 410 "Gone"]) ifTrue: [ + "Need to distinguish between lookup errors and connection errors. Lookup errors will be handled by some senders following the EAFP principle. See #versionNamed:." + (NotFound object: response url) signal ]. result ifNil: [ NetworkError signal: 'Could not access ', location ]. ^result! From commits at source.squeak.org Thu May 20 14:09:20 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 May 2021 14:09:20 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.33.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.33.mcz ==================== Summary ==================== Name: FFI-Tools-mt.33 Author: mt Time: 20 May 2021, 4:09:18.82558 pm UUID: 33654c93-d0a2-5143-a683-044770efb5d5 Ancestors: FFI-Tools-mt.32 Fixes issue with printing large byte-array handles in object explorer. Makes the text representation of byte-array handles configurable. =============== Diff against FFI-Tools-mt.32 =============== Item was changed: ObjectExplorerWrapper subclass: #ExternalObjectHandleWrapper instanceVariableNames: '' + classVariableNames: 'MaxVisibleBytes MaxVisibleDots' - classVariableNames: '' poolDictionaries: '' category: 'FFI-Tools'! !ExternalObjectHandleWrapper commentStamp: 'mt 6/8/2020 10:27' prior: 0! I am a wrapper around handles of external objects. I am used in the object explorer tool. My role is to fine-tune the string representation of handles that are neither ByteArray nor ExternalAddress.! Item was added: + ----- Method: ExternalObjectHandleWrapper class>>maxVisibleBytes (in category 'preferences') ----- + maxVisibleBytes + + ^MaxVisibleBytes ifNil: [32]! Item was added: + ----- Method: ExternalObjectHandleWrapper class>>maxVisibleBytes: (in category 'preferences') ----- + maxVisibleBytes: anInteger + + MaxVisibleBytes := anInteger ifNotNil: [:i | i rounded].! Item was added: + ----- Method: ExternalObjectHandleWrapper class>>maxVisibleDots (in category 'preferences') ----- + maxVisibleDots + + ^MaxVisibleDots ifNil:[12]! Item was added: + ----- Method: ExternalObjectHandleWrapper class>>maxVisibleDots: (in category 'preferences') ----- + maxVisibleDots: anInteger + + MaxVisibleDots := anInteger ifNotNil: [:i | i rounded].! Item was removed: - ----- Method: ExternalObjectHandleWrapper>>getHandle (in category 'accessing') ----- - getHandle - - ^ self object! Item was changed: ----- Method: ExternalObjectHandleWrapper>>objectString (in category 'accessing') ----- objectString + ^ String streamContents: [:stream | + (thisContext objectClass: self object) == ByteArrayReadWriter + ifTrue: [self printReadWriterOn: stream] + ifFalse: [stream nextPutAll: super objectString]]! - | label handle skipLimit | - label := super objectString. - handle := self getHandle. - skipLimit := 16. - - ^ handle isExternalAddress ifTrue: [label] ifFalse: [ - (thisContext objectClass: handle) == ByteArrayReadWriter - ifFalse: [label] - ifTrue: [ | begin end tokens | - label :=(thisContext object: handle instVarAt: 3) "byteArray" printString. - label := label copyFrom: 3 to: (label size - 1). - begin := (thisContext object: handle instVarAt: 1) "byteOffset" + 1. - end := begin - 1 + (thisContext object: handle instVarAt: 2) "byteSize". - String streamContents: [:stream | - stream nextPutAll: '#[ '. - tokens := label findTokens: ' ' "#[0 0 0 0 0]". - begin > skipLimit ifTrue: [ - stream nextPutAll: '. . ', (begin - 1) asString, ' bytes . . '. - tokens := tokens allButFirst: begin - 1. - end := end - begin + 1. begin := 1]. - (1 to: end) do: [:index | | token | - token := tokens at: index. - index >= begin - ifTrue: [stream nextPutAll: token] - ifFalse: ["Skip byte info" stream nextPut: $.]. - stream space]. - (tokens size - end + 1) > skipLimit ifTrue: [ - stream nextPutAll: '. . ', (tokens size - end) asString, ' bytes . . '. - tokens := tokens allButLast: tokens size - end. - end := tokens size]. - (tokens size - end) timesRepeat: [ - "Skip byte info" stream nextPut: $.. - stream space]. - stream nextPutAll: ']'. - ]]].! Item was added: + ----- Method: ExternalObjectHandleWrapper>>printReadWriterOn: (in category 'printing') ----- + printReadWriterOn: stream + + | handle array head tail numBytes maxVisibleDots maxVisibleBytes | + handle := self object. + maxVisibleDots := 12. "e.g. #[ . . . . . . . . 0 0 0 0 ...356 bytes... ]" + maxVisibleBytes := 32. "e.g. #[ 0 0 0 0 ...555 bytes... 0 0 0 0 ]" + + array := (thisContext object: handle instVarAt: 3) "byteArray". + head := (thisContext object: handle instVarAt: 1) "byteOffset". + numBytes := (thisContext object: handle instVarAt: 2) "byteSize". + tail := array size - head - numBytes. + + stream nextPutAll: '#[ '. + + head > 0 ifTrue: [ + head > maxVisibleDots + ifTrue: [stream nextPutAll: '...', head asString, ' bytes... '] + ifFalse: [head timesRepeat: [stream nextPut: $.; space]]]. + + numBytes > maxVisibleBytes + ifTrue: [ "Trim inner bytes" + head + 1 to: head + (maxVisibleBytes / 2) do: [:index | + stream nextPutAll: (array at: index) asString; space]. + stream nextPutAll: '...', (numBytes - maxVisibleBytes) asString, ' bytes... '. + array size - tail - (maxVisibleBytes / 2) + 1 to: array size - tail do: [:index | + stream nextPutAll: (array at: index) asString; space]] + ifFalse: [ "No trimming" + head + 1 to: array size - tail do: [:index | + stream nextPutAll: (array at: index) asString; space]]. + + tail > 0 ifTrue: [ + tail > maxVisibleDots + ifTrue: [stream nextPutAll: '...', tail asString, ' bytes... '] + ifFalse: [tail timesRepeat: [stream nextPut: $.; space]]]. + + stream nextPutAll: ']'. + ! From commits at source.squeak.org Thu May 20 17:35:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 May 2021 17:35:07 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.162.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.162.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.162 Author: mt Time: 20 May 2021, 7:35:06.00258 pm UUID: 438d5218-def5-7e48-8016-e53905db2a19 Ancestors: FFI-Kernel-mt.161 For genuine atomic types (i.e. no type alias), speeds up dynamic array access, i.e. ExternalData >> #at:(put:). For all types, also speed up pointer/non-pointer conversion and #isVoid check. =============== Diff against FFI-Kernel-mt.161 =============== Item was added: + ----- Method: ExternalArrayType>>asNonPointerType (in category 'converting') ----- + asNonPointerType + + ^ self! Item was added: + ----- Method: ExternalArrayType>>asPointerType (in category 'converting') ----- + asPointerType + + ^ referencedType! Item was added: + ----- Method: ExternalArrayType>>isVoid (in category 'testing') ----- + isVoid + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>asNonPointerType (in category 'converting') ----- + asNonPointerType + + ^ self! Item was added: + ----- Method: ExternalAtomicType>>asPointerType (in category 'converting') ----- + asPointerType + + ^ referencedType! Item was added: + ----- Method: ExternalAtomicType>>handle:atIndex: (in category 'external data') ----- + handle: handle atIndex: index + "Overwritten to use cached byteSize in atomic sends for performance." + + referentClass == nil ifTrue: [ + ^ (AtomicSends at: self atomicType + 1) first + handle: handle + atIndex: index]. + ^ super handle: handle atIndex: index! Item was added: + ----- Method: ExternalAtomicType>>handle:atIndex:put: (in category 'external data') ----- + handle: handle atIndex: index put: value + "Overwritten to use cached byteSize in atomic sends for performance." + + referentClass == nil ifTrue: [ + ^ (AtomicSends at: self atomicType + 1) second + handle: handle + atIndex: index + put: value]. + ^ super handle: handle atIndex: index put: value! Item was added: + ----- Method: ExternalAtomicType>>isVoid (in category 'testing') ----- + isVoid + + ^ self atomicType = 0! Item was changed: ExternalStructure subclass: #ExternalData + instanceVariableNames: 'type contentType' + classVariableNames: 'AllowDetectForUnknownSize ExtraSizeChecks' - instanceVariableNames: 'type' - classVariableNames: 'AllowDetectForUnknownSize' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0! Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *'). Instance variables: type The external type of the receiver. Always a pointer type. The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed. ! Item was added: + ----- Method: ExternalData class>>extraSizeChecks (in category 'preferences') ----- + extraSizeChecks + + ^ ExtraSizeChecks ifNil: [false]! Item was added: + ----- Method: ExternalData class>>extraSizeChecks: (in category 'preferences') ----- + extraSizeChecks: aBoolean + + ExtraSizeChecks := aBoolean.! Item was changed: ----- Method: ExternalData>>arrayType (in category 'accessing - types') ----- arrayType "Answer this container's array type or 'nil' if unknown." | arrayType | + ^ (arrayType := self containerType) isVoid - type ifNil: [^ nil]. - arrayType := self containerType asNonPointerType. - ^ arrayType isVoid - ifTrue: [nil] ifFalse: [arrayType]! Item was changed: ----- Method: ExternalData>>at: (in category 'accessing') ----- at: index + ExtraSizeChecks == true ifTrue: [self sizeCheck: index]. - ((1 > index) or: [self size notNil and: [index > self size]]) - ifTrue: [^ self errorSubscriptBounds: index]. ^ self contentType handle: handle + atIndex: index! - at: ((index-1) * self contentType byteSize) + 1! Item was changed: ----- Method: ExternalData>>at:put: (in category 'accessing') ----- at: index put: value + ExtraSizeChecks == true ifTrue: [self sizeCheck: index]. + - ((1 > index) or: [self size notNil and: [index > self size]]) - ifTrue: [^ self errorSubscriptBounds: index]. - ^ self contentType handle: handle + atIndex: index - at: ((index-1) * self contentType byteSize) + 1 put: value! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- contentType "^ " "Answer the content type for the current container type." + ^ contentType ifNil: [ + contentType := self arrayType + ifNil: [ExternalType void] + ifNotNil: [:arrayType | arrayType contentType]]! - ^ self arrayType - ifNil: [ExternalType void] - ifNotNil: [:arrayType | arrayType contentType]! Item was changed: ----- Method: ExternalData>>externalType (in category 'accessing - types') ----- externalType "^ " "Overwritten to answer our #containerType, which is important so that clients can then send #byteSize to the result." + + ^ handle isExternalAddress + ifTrue: [self containerType asPointerType] + ifFalse: [self containerType asNonPointerType]! - - ^ self containerType! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." | byteOffset numElements byteSize contentType | + ExtraSizeChecks == true ifTrue: [ + self sizeCheck: firstIndex. + self sizeCheck: lastIndex]. - ((1 > firstIndex) or: [self size notNil and: [lastIndex > self size]]) - ifTrue: [^ self errorSubscriptBounds: lastIndex]. contentType := self contentType. byteOffset := ((firstIndex-1) * contentType byteSize)+1. numElements := lastIndex - firstIndex + 1 max: 0. byteSize := numElements * contentType byteSize. ^ ExternalData fromHandle: (handle structAt: byteOffset length: byteSize) type: contentType size: numElements! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." externalType = ExternalType string ifTrue: [ ^ self setType: externalType asNonPointerType]. + (externalType isArrayType or: [externalType isVoid]) - (externalType asNonPointerType isArrayType or: [externalType isVoid]) ifTrue: [type := externalType] ifFalse: [type := (externalType asArrayType: nil)]. + contentType := nil.! - handle isExternalAddress - ifTrue: [type := type asPointerType] - ifFalse: [type := type asNonPointerType].! Item was added: + ----- Method: ExternalData>>sizeCheck: (in category 'private') ----- + sizeCheck: index + + | sz | + ((1 > index) or: [(sz := self size) notNil and: [index > sz]]) + ifTrue: [^ self errorSubscriptBounds: index].! Item was changed: ----- Method: ExternalData>>typeCheck (in category 'private') ----- typeCheck "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls if the signature did not specify, e.g., 'int[]' but 'int*'." + type asNonPointerType isVoid "void*" - type asNonPointerType isVoid ifTrue: [^ self]. + type isArrayType - type asNonPointerType isArrayType ifFalse: [self setType: type "int*" asNonPointerType "int ... to become int[], not int*[]"].! Item was added: + ----- Method: ExternalPointerType>>asNonPointerType (in category 'converting') ----- + asNonPointerType + + ^ referencedType! Item was added: + ----- Method: ExternalPointerType>>asPointerType (in category 'converting') ----- + asPointerType + + ^ self! Item was added: + ----- Method: ExternalPointerType>>isVoid (in category 'testing') ----- + isVoid + + ^ false! Item was added: + ----- Method: ExternalStructureType>>asNonPointerType (in category 'converting') ----- + asNonPointerType + + ^ self! Item was added: + ----- Method: ExternalStructureType>>asPointerType (in category 'converting') ----- + asPointerType + + ^ referencedType! Item was added: + ----- Method: ExternalStructureType>>isVoid (in category 'testing') ----- + isVoid + + ^ false! Item was added: + ----- Method: ExternalType>>handle:atIndex: (in category 'external data') ----- + handle: handle atIndex: index + + ^ self + handle: handle + at: ((index-1) * self byteSize) + 1! Item was added: + ----- Method: ExternalType>>handle:atIndex:put: (in category 'external data') ----- + handle: handle atIndex: index put: value + + ^ self + handle: handle + at: ((index-1) * self byteSize) + 1 + put: value! Item was changed: MessageSend subclass: #FFIAtomicReadWriteSend + instanceVariableNames: 'byteSize' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel-Support'! !FFIAtomicReadWriteSend commentStamp: 'mt 5/19/2021 10:20' prior: 0! I am a message send for reading and writing atomic values from and to byte arrays or external addresses. I can help with code generation through #template. Take a look at ExternalType class >> #initializeAtomicSends.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>byteSize (in category 'accessing') ----- + byteSize + + ^ byteSize! Item was added: + ----- Method: FFIAtomicReadWriteSend>>byteSize: (in category 'accessing') ----- + byteSize: numBytes + + byteSize := numBytes.! Item was changed: ----- Method: FFIAtomicReadWriteSend>>handle:at:put: (in category 'evaluating') ----- + handle: receiver at: byteOffset put: value - handle: receiver at: byteOffset put: floatValue self subclassResponsibility.! Item was added: + ----- Method: FFIAtomicReadWriteSend>>handle:atIndex: (in category 'evaluating') ----- + handle: receiver atIndex: index + + ^ self + handle: receiver + at: ((index-1) * self byteSize) + 1! Item was added: + ----- Method: FFIAtomicReadWriteSend>>handle:atIndex:put: (in category 'evaluating') ----- + handle: receiver atIndex: index put: value + + ^ self + handle: receiver + at: ((index-1) * self byteSize) + 1 + put: value! Item was changed: + ----- Method: FFIAtomicReadWriteSend>>printOn: (in category 'printing') ----- - ----- Method: FFIAtomicReadWriteSend>>printOn: (in category 'nil') ----- printOn: stream stream nextPutAll: self template.! Item was changed: ----- Method: FloatReadWriteSend class>>fromType: (in category 'instance creation') ----- fromType: type | selectors | selectors := self lookupSelectorsFor: type. ^ { + (self - self receiver: nil "handle" selector: selectors first arguments: (Array + with: nil "byteOffset")) + byteSize: type byteSize; + yourself. - with: nil "byteOffset"). + (self - self receiver: nil "handle" selector: selectors second arguments: (Array with: nil "byteOffset" + with: nil "aFloat")) + byteSize: type byteSize; + yourself - with: nil "aFloat") }! Item was changed: ----- Method: IntegerReadWriteSend class>>fromType: (in category 'instance creation') ----- fromType: type "Overwritten to account for byteSize and isSigned." | selectors | selectors := self lookupSelectorsFor: type. ^ { + (self - self receiver: nil "handle" selector: selectors first arguments: (Array with: nil "byteOffset" with: type byteSize + with: type isSigned)) + byteSize: type byteSize; + yourself. - with: type isSigned). + (self - self receiver: nil "handle" selector: selectors second arguments: (Array with: nil "byteOffset" with: nil "integerValue" with: type byteSize + with: type isSigned)) + byteSize: type byteSize; + yourself. - with: type isSigned) - }! From commits at source.squeak.org Thu May 20 17:35:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 May 2021 17:35:46 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.34.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.34.mcz ==================== Summary ==================== Name: FFI-Tools-mt.34 Author: mt Time: 20 May 2021, 7:35:45.65158 pm UUID: b4e13008-ef6e-5240-8777-6322a3d3edc8 Ancestors: FFI-Tools-mt.33 Complements FFI-Kernel-mt.162 =============== Diff against FFI-Tools-mt.33 =============== Item was changed: ----- Method: ExternalData>>explorerContents (in category '*FFI-Tools') ----- explorerContents "Prefix all instance variables and append extra meta information (e.g., the external type) as well as all structure fields as defined in #fields." | basicExplorerFields | basicExplorerFields := super explorerContents. basicExplorerFields do: [:explorerField | explorerField itemName = '_type' ifTrue: [ + explorerField object: self externalType]]. - explorerField itemName: '_containerType']]. ^ basicExplorerFields! Item was changed: ----- Method: ExternalData>>explorerContentsMetaFields (in category '*FFI-Tools') ----- explorerContentsMetaFields "Skip _type because our external type is already in the basic explorer fields because it is an instance variable. Add _contentType for clarification." ^ { + ObjectExplorerWrapper with: self containerType name: '_containerType' model: self. ObjectExplorerWrapper with: self contentType name: '_contentType' model: self. }! From commits at source.squeak.org Thu May 20 17:37:44 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 20 May 2021 17:37:44 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.44.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.44.mcz ==================== Summary ==================== Name: FFI-Tests-mt.44 Author: mt Time: 20 May 2021, 7:37:42.74558 pm UUID: e6517ef7-61b3-3249-a8b0-a85f226a877d Ancestors: FFI-Tests-mt.43 Complements FFI-Kernel-mt.162 =============== Diff against FFI-Tests-mt.43 =============== Item was changed: ----- Method: FFIAllocateTests>>performTest (in category 'running') ----- performTest "Tests should opt-in to have more control." + | prior1 prior2 | + prior1 := ExternalType useArrayClasses. + prior2 := ExternalData extraSizeChecks. - | prior | - prior := ExternalType useArrayClasses. [ExternalType useArrayClasses: false. + ExternalData extraSizeChecks: true. super performTest] + ensure: [ + ExternalType useArrayClasses: prior1. + ExternalData extraSizeChecks: prior2].! - ensure: [ExternalType useArrayClasses: prior].! From ma.chris.m at gmail.com Fri May 21 03:46:59 2021 From: ma.chris.m at gmail.com (Chris Muller) Date: Thu, 20 May 2021 22:46:59 -0500 Subject: [squeak-dev] when safe to set maxExternalSemaphores:? What value? Message-ID: Hi, the comment in maxExternalSemaphores: says: _____ "Setting this at any time other than start-up can potentially lose requests. i.e. during the realloc new storage is allocated, the old contents are copied and then pointers are switched. Requests occurring during copying won't be seen if they occur to indices already copied. The intended use is to set the table to some adequate maximum at start-up" _____ I could use some help in translating this to my limited user-level comprehension. Does "start-up" here refer to the #startUp: hook? Could "requests won't be seen" result in an image crash, or simply a few lost InputEvents? If a crash is possible, I might be nervous to risk messing with it at all even in #startUp: in case it happened to be too low in the list, for example, and my image became unstartable.. Any guidance on what these external semaphores are for (at a high level) and a good suggested value for a chatty TCP/IP server would be greatly appreciated. Thanks, Chris -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Fri May 21 04:27:24 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Thu, 20 May 2021 21:27:24 -0700 Subject: [squeak-dev] when safe to set maxExternalSemaphores:? What value? In-Reply-To: References: Message-ID: Hi Chris, > On May 20, 2021, at 8:46 PM, Chris Muller wrote: > > Hi, the comment in maxExternalSemaphores: says: > _____ > "Setting this at any time other than start-up can potentially lose requests. > i.e. during the realloc new storage is allocated, > the old contents are copied and then pointers are switched. > Requests occurring during copying won't be seen if they occur to indices already copied. > The intended use is to set the table to some adequate maximum at start-up" > _____ > > I could use some help in translating this to my limited user-level comprehension. Does "start-up" here refer to the #startUp: hook? Yes Before the image starts listening for events. > > Could "requests won't be seen" result in an image crash, or simply a few lost InputEvents? If a crash is possible, I might be nervous to risk messing with it at all even in #startUp: in case it happened to be too low in the list, for example, and my image became unstartable.. Simply lost input events. And lost input events include e.g. notifications of readable socket data, etc. > > Any guidance on what these external semaphores are for (at a high level) and a good suggested value for a chatty TCP/IP server would be greatly appreciated. They are used in the Semaphore implementation. You’re probably using them already. > > Thanks, > Chris > From commits at source.squeak.org Fri May 21 09:09:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:09:42 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.35.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.35.mcz ==================== Summary ==================== Name: FFI-Tools-mt.35 Author: mt Time: 21 May 2021, 11:09:41.766138 am UUID: 9978c435-751b-4c43-ad0e-8419760825ae Ancestors: FFI-Tools-mt.34 Fixes visual glitch now that "contentType" is cached as instVar in ExternalData. =============== Diff against FFI-Tools-mt.34 =============== Item was changed: ----- Method: ExternalData>>explorerContentsMetaFields (in category '*FFI-Tools') ----- explorerContentsMetaFields "Skip _type because our external type is already in the basic explorer fields because it is an instance variable. Add _contentType for clarification." ^ { ObjectExplorerWrapper with: self containerType name: '_containerType' model: self. - ObjectExplorerWrapper with: self contentType name: '_contentType' model: self. }! From commits at source.squeak.org Fri May 21 09:11:03 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:11:03 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.45.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.45.mcz ==================== Summary ==================== Name: FFI-Tests-mt.45 Author: mt Time: 21 May 2021, 11:11:03.010138 am UUID: 4632b985-36be-564f-9ddc-e30405f110e9 Ancestors: FFI-Tests-mt.44 More robust tests for the "base type" of atomic types to really check the headerWord. More tests for sub-array access. =============== Diff against FFI-Tests-mt.44 =============== Item was changed: ----- Method: ExternalTypeTests>>testBasicTypeForAtomicType (in category 'tests - compiled spec') ----- testBasicTypeForAtomicType + "Check all information about atomics compiled in the compiledSpec's headerWord. While there might be polymorphic optimizations for in-image type checking, the basic type MUST contain all that information, too. Some checks will signal errors, which is okay as long as there are errors for the basic type, too." + + ExternalType atomicTypes do: [:type | + | baseType | + baseType := type asBasicType. + #(isAtomic atomicType byteSize size + isIntegerType isFloatType isCharType isBoolType isVoid + isEmpty) + do: [:selector | + self + assert: (type perform: selector) + equals: (baseType perform: selector)]. + #(isSigned isUnsigned isSinglePrecision isDoublePrecision) + do: [:selector | + self + assert: ([type perform: selector] on: Error do: [#error]) + equals: ([baseType perform: selector] on: Error do: [#error])]].! - - | type baseType | - type := ExternalType int32_t. - baseType := type asBasicType. - self assert: type isAtomic equals: baseType isAtomic. - self assert: type byteSize equals: baseType byteSize. - self assert: type size equals: baseType size. ! Item was added: + ----- Method: FFIAllocateExternalTests>>test17ArrayFromUnkownSize (in category 'tests - array') ----- + test17ArrayFromUnkownSize + "Overwritten because there is no out-of-bounds check for external memory." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + array setSize: nil. "Possible but limited for byte-array handles." + portion := array reader from: 3. + self assert: 3 equals: (portion at: 1). + self assert: 4 equals: (portion at: 2).! Item was added: + ----- Method: FFIAllocateTests>>test13ArrayFirst (in category 'tests - array') ----- + test13ArrayFirst + "Access a sub-range in the external data." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + array setSize: nil. "Not needed for #first:." + portion := array reader first: 2. + self assert: #(1 2) equals: (portion collect: #yourself). + + portion at: 2 put: 42. + self assert: 42 equals: (array at: 2).! Item was added: + ----- Method: FFIAllocateTests>>test14ArrayLast (in category 'tests - array') ----- + test14ArrayLast + "Access a sub-range in the external data." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + portion := array reader last: 2. + self assert: #(4 5) equals: (portion collect: #yourself). + + portion at: 2 put: 42. + self assert: 42 equals: (array at: 5).! Item was added: + ----- Method: FFIAllocateTests>>test15ArrayLastError (in category 'tests - array') ----- + test15ArrayLastError + "Access a sub-range in the external data. Error for unknown size because #last: needs to access the end of the array." + + | array | + array := self allocate: 'int32_t' size: 5. + array setSize: nil. + self should: [array last: 2] raise: Error.! Item was added: + ----- Method: FFIAllocateTests>>test16ArrayFrom (in category 'tests - array') ----- + test16ArrayFrom + "Access a sub-range in the external data by moving the start of the array." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + portion := array reader from: 3. + self assert: #(3 4 5) equals: (portion collect: #yourself).! Item was added: + ----- Method: FFIAllocateTests>>test17ArrayFromUnkownSize (in category 'tests - array') ----- + test17ArrayFromUnkownSize + "Access a sub-range in the external data by moving the start of the array." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + array setSize: nil. "Possible but limited for byte-array handles." + portion := array reader from: 3. + self assert: 3 equals: (portion at: 1). + self should: [portion at: 2] raise: Error.! Item was added: + ----- Method: FFIAllocateTests>>test18ArrayMoveBackAndForth (in category 'tests - array') ----- + test18ArrayMoveBackAndForth + "Check whether it is possible to move back-and-forth in memory without keeping track of the original array." + + | array portion | + array := self allocate: 'int32_t' size: 5. + 1 to: array size do: [:index | array at: index put: index]. + + portion := array reader from: 3. + self assert: 3 equals: (portion at: 1). + portion := portion from: 0. + self assert: 2 equals: (portion at: 1). + + portion := array reader from: 3. + self assert: 3 equals: (portion at: 1). + portion := portion from: -1. + self assert: 1 equals: (portion at: 1). + + portion := portion from: 4. + self assert: 4 equals: (portion at: 1).! From commits at source.squeak.org Fri May 21 09:13:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:13:46 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.163.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.163.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.163 Author: mt Time: 21 May 2021, 11:13:45.365138 am UUID: c175e00a-7423-de4a-8e42-e1fdf6ffb4c9 Ancestors: FFI-Kernel-mt.162 Adds out-of-bounds checks for byte-array handles in composite structures. Adds #first: #last: #from: to ExternalData extract handles for backwards-filled buffers. Relax #sizeCheck: in ExternalData to allow for moving back-and-forth in memory. Complements FFI-Tests-mt.45. =============== Diff against FFI-Kernel-mt.162 =============== Item was added: + ----- Method: ByteArrayReadWriter>>checkAt: (in category 'private') ----- + checkAt: nextByteOffset + + | endOffset | + (endOffset := nextByteOffset + byteOffset) > (byteOffset + byteSize) + ifTrue: [self errorSubscriptBounds: endOffset].! Item was added: + ----- Method: ByteArrayReadWriter>>checkAt:length: (in category 'private') ----- + checkAt: nextByteOffset length: numBytes + + | endOffset | + (endOffset := nextByteOffset + numBytes - 1) > (byteOffset + byteSize) + ifTrue: [self errorSubscriptBounds: endOffset].! Item was changed: ----- Method: ByteArrayReadWriter>>doubleAt: (in category 'read/write atomics') ----- doubleAt: oByteOffset + self checkAt: oByteOffset. ^ byteArray doubleAt: oByteOffset + byteOffset! Item was changed: ----- Method: ByteArrayReadWriter>>doubleAt:put: (in category 'read/write atomics') ----- doubleAt: oByteOffset put: value + self checkAt: oByteOffset. ^ byteArray doubleAt: oByteOffset + byteOffset put: value! Item was changed: ----- Method: ByteArrayReadWriter>>floatAt: (in category 'read/write atomics') ----- floatAt: oByteOffset + self checkAt: oByteOffset. ^ byteArray floatAt: oByteOffset + byteOffset! Item was changed: ----- Method: ByteArrayReadWriter>>floatAt:put: (in category 'read/write atomics') ----- floatAt: oByteOffset put: value + self checkAt: oByteOffset. ^ byteArray floatAt: oByteOffset + byteOffset put: value! Item was changed: ----- Method: ByteArrayReadWriter>>integerAt:put:size:signed: (in category 'read/write atomics') ----- integerAt: oByteOffset put: value size: nBytes signed: aBoolean + self checkAt: oByteOffset. ^ byteArray integerAt: oByteOffset + byteOffset put: value size: nBytes signed: aBoolean! Item was changed: ----- Method: ByteArrayReadWriter>>integerAt:size:signed: (in category 'read/write atomics') ----- integerAt: oByteOffset size: nBytes signed: aBoolean + self checkAt: oByteOffset. ^ byteArray integerAt: oByteOffset + byteOffset size: nBytes signed: aBoolean.! Item was changed: ----- Method: ByteArrayReadWriter>>pointerAt:length: (in category 'read/write pointers') ----- pointerAt: oByteOffset length: numBytes + self checkAt: oByteOffset length: numBytes. ^ byteArray pointerAt: oByteOffset + byteOffset length: numBytes! Item was changed: ----- Method: ByteArrayReadWriter>>pointerAt:put:length: (in category 'read/write pointers') ----- pointerAt: oByteOffset put: value length: numBytes + self checkAt: oByteOffset length: numBytes. ^ byteArray pointerAt: oByteOffset + byteOffset put: value length: numBytes! Item was changed: ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'read/write structs') ----- structAt: newByteOffset length: newLength + self checkAt: newByteOffset length: newLength. ^ ByteArrayReadWriter new setArray: byteArray offset: byteOffset + newByteOffset - 1 size: newLength! Item was changed: ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'read/write structs') ----- structAt: newByteOffset put: value length: newLength + self checkAt: newByteOffset length: newLength. - (newByteOffset + newLength > byteSize) - ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. - ^ byteArray structAt: byteOffset + newByteOffset - 1 put: value length: newLength! Item was added: + ----- Method: ExternalData>>first: (in category 'accessing') ----- + first: n + "Answer the first n elements of the receiver." + + ^ self from: 1 to: n! Item was added: + ----- Method: ExternalData>>from: (in category 'accessing') ----- + from: firstIndex + "Move the start of this array. Size not needed." + + | byteOffset numElements byteSize contentType | + contentType := self contentType. + byteOffset := ((firstIndex-1) * contentType byteSize)+1. + numElements := (self size ifNotNil: [:sz | sz - firstIndex + 1 max: 0]). + byteSize := numElements + ifNil: [contentType byteSize] + ifNotNil: [numElements * contentType byteSize]. + + ^ ExternalData + fromHandle: (handle structAt: byteOffset length: (byteSize ifNil: [1])) + type: contentType + size: numElements! Item was added: + ----- Method: ExternalData>>last: (in category 'accessing') ----- + last: n + "Answer the last n elements of the receiver." + + | sz | + self sizeCheck. + ^ self from: (sz := self size) - n + 1 to: sz! Item was changed: ----- Method: ExternalData>>sizeCheck: (in category 'private') ----- sizeCheck: index + "Negative indices should work to move back-and-forth in the memory." + - | sz | + ((sz := self size) notNil and: [index > sz]) - ((1 > index) or: [(sz := self size) notNil and: [index > sz]]) ifTrue: [^ self errorSubscriptBounds: index].! From commits at source.squeak.org Fri May 21 09:22:51 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:22:51 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.164.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.164.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.164 Author: mt Time: 21 May 2021, 11:22:51.005285 am UUID: ce4d8f9a-e8bb-564e-9714-b5d5426178b6 Ancestors: FFI-Kernel-mt.163 I forgot the addition of #from: to the other FFI-arrays (#isFFIArray). =============== Diff against FFI-Kernel-mt.163 =============== Item was added: + ----- Method: ByteString>>from: (in category '*FFI-Kernel') ----- + from: firstIndex + "See ExternalData" + + ^ self copyFrom: firstIndex to: self size! Item was added: + ----- Method: RawBitsArray>>from: (in category '*FFI-Kernel') ----- + from: firstIndex + "See ExternalData" + + ^ self copyFrom: firstIndex to: self size! From commits at source.squeak.org Fri May 21 09:54:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:54:01 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.165.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.165.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.165 Author: mt Time: 21 May 2021, 11:54:01.161285 am UUID: 849d8c16-bd3f-e941-8765-2d5813f9e0eb Ancestors: FFI-Kernel-mt.164 For consistency, make raw-bits arrays compatible with handle-based access. They are both handle and (FFI) array after all. Unlike ExternalData. See #getHandle. Note that the intended use is still through the array protocol: #at:, #at:put:, #from:to:, #from:, ... =============== Diff against FFI-Kernel-mt.164 =============== Item was added: + ----- Method: ByteString>>atByteOffset: (in category '*FFI-Kernel-accessing') ----- + atByteOffset: byteOffset + + | index | + index := ((byteOffset-1) / self contentType byteSize) + 1. + ^ self at: index! Item was added: + ----- Method: ByteString>>atByteOffset:put: (in category '*FFI-Kernel-accessing') ----- + atByteOffset: byteOffset put: value + + | index | + index := ((byteOffset-1) / self contentType byteSize) + 1. + ^ self at: index put: value! Item was changed: + ----- Method: ByteString>>contentType (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>contentType (in category '*FFI-Kernel') ----- contentType ^ self externalType contentType! Item was changed: + ----- Method: ByteString>>externalType (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>externalType (in category '*FFI-Kernel') ----- externalType ^ self class externalType contentType asArrayType: self size! Item was changed: + ----- Method: ByteString>>free (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>free (in category '*FFI-Kernel') ----- free self shouldNotImplement.! Item was changed: + ----- Method: ByteString>>from: (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>from: (in category '*FFI-Kernel') ----- from: firstIndex "See ExternalData" ^ self copyFrom: firstIndex to: self size! Item was changed: + ----- Method: ByteString>>from:to: (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>from:to: (in category '*FFI-Kernel') ----- from: firstIndex to: lastIndex "See ExternalData" ^ self copyFrom: firstIndex to: lastIndex! Item was changed: + ----- Method: ByteString>>getHandle (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>getHandle (in category '*FFI-Kernel') ----- getHandle "I am my own handle." ^ self! Item was added: + ----- Method: ByteString>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset put: value size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value asCharacter.! Item was added: + ----- Method: ByteString>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was changed: + ----- Method: ByteString>>isFFIArray (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>isFFIArray (in category '*FFI-Kernel') ----- isFFIArray ^ true! Item was changed: + ----- Method: ByteString>>isNull (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>isNull (in category '*FFI-Kernel') ----- isNull ^ false! Item was changed: + ----- Method: ByteString>>reader (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>reader (in category '*FFI-Kernel') ----- reader ^ self! Item was changed: + ----- Method: ByteString>>setContentType: (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>setContentType: (in category '*FFI-Kernel') ----- setContentType: type "See ExternalData." self shouldNotImplement.! Item was changed: + ----- Method: ByteString>>setSize: (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>setSize: (in category '*FFI-Kernel') ----- setSize: size "See ExternalData." self shouldNotImplement.! Item was changed: + ----- Method: ByteString>>writer (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>writer (in category '*FFI-Kernel') ----- writer ^ self! Item was changed: + ----- Method: ByteString>>zeroMemory (in category '*FFI-Kernel-external data') ----- - ----- Method: ByteString>>zeroMemory (in category '*FFI-Kernel') ----- zeroMemory 1 to: self size do: [:index | self at: index put: Character null].! Item was added: + ----- Method: RawBitsArray>>atByteOffset: (in category '*FFI-Kernel-accessing') ----- + atByteOffset: byteOffset + + | index | + index := ((byteOffset-1) / self contentType byteSize) + 1. + ^ self at: index! Item was added: + ----- Method: RawBitsArray>>atByteOffset:put: (in category '*FFI-Kernel-accessing') ----- + atByteOffset: byteOffset put: value + + | index | + index := ((byteOffset-1) / self contentType byteSize) + 1. + ^ self at: index put: value! Item was changed: + ----- Method: RawBitsArray>>contentType (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>contentType (in category '*FFI-Kernel') ----- contentType ^ self externalType contentType! Item was added: + ----- Method: RawBitsArray>>doubleAt: (in category '*FFI-Kernel-accessing') ----- + doubleAt: byteOffset + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was added: + ----- Method: RawBitsArray>>doubleAt:put: (in category '*FFI-Kernel-accessing') ----- + doubleAt: byteOffset put: value + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was changed: + ----- Method: RawBitsArray>>externalType (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>externalType (in category '*FFI-Kernel') ----- externalType ^ self class externalType contentType asArrayType: self size! Item was added: + ----- Method: RawBitsArray>>floatAt: (in category '*FFI-Kernel-accessing') ----- + floatAt: byteOffset + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was added: + ----- Method: RawBitsArray>>floatAt:put: (in category '*FFI-Kernel-accessing') ----- + floatAt: byteOffset put: value + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was changed: + ----- Method: RawBitsArray>>free (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>free (in category '*FFI-Kernel') ----- free self shouldNotImplement.! Item was changed: + ----- Method: RawBitsArray>>from: (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>from: (in category '*FFI-Kernel') ----- from: firstIndex "See ExternalData" ^ self copyFrom: firstIndex to: self size! Item was changed: + ----- Method: RawBitsArray>>from:to: (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>from:to: (in category '*FFI-Kernel') ----- from: firstIndex to: lastIndex "See ExternalData" ^ self copyFrom: firstIndex to: lastIndex! Item was changed: + ----- Method: RawBitsArray>>getHandle (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>getHandle (in category '*FFI-Kernel') ----- getHandle "I am my own handle." ^ self! Item was added: + ----- Method: RawBitsArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset put: value size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was added: + ----- Method: RawBitsArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was changed: + ----- Method: RawBitsArray>>isFFIArray (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>isFFIArray (in category '*FFI-Kernel') ----- isFFIArray ^ true! Item was changed: + ----- Method: RawBitsArray>>isNull (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>isNull (in category '*FFI-Kernel') ----- isNull ^ false! Item was changed: + ----- Method: RawBitsArray>>reader (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>reader (in category '*FFI-Kernel') ----- reader ^ self! Item was changed: + ----- Method: RawBitsArray>>setContentType: (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>setContentType: (in category '*FFI-Kernel') ----- setContentType: type "See ExternalData." self shouldNotImplement.! Item was changed: + ----- Method: RawBitsArray>>setSize: (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>setSize: (in category '*FFI-Kernel') ----- setSize: size "See ExternalData." self shouldNotImplement.! Item was changed: + ----- Method: RawBitsArray>>writer (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>writer (in category '*FFI-Kernel') ----- writer ^ self! Item was changed: + ----- Method: RawBitsArray>>zeroMemory (in category '*FFI-Kernel-external data') ----- - ----- Method: RawBitsArray>>zeroMemory (in category '*FFI-Kernel') ----- zeroMemory self atAllPut: 0.! From commits at source.squeak.org Fri May 21 09:54:33 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 09:54:33 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.46.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.46.mcz ==================== Summary ==================== Name: FFI-Tests-mt.46 Author: mt Time: 21 May 2021, 11:54:32.525285 am UUID: a5f60e40-93a8-ae44-a9de-0ea146302ac1 Ancestors: FFI-Tests-mt.45 Tests for FFI-Kernel-mt.165. =============== Diff against FFI-Tests-mt.45 =============== Item was added: + ----- Method: FFIAllocateTests>>test01ByHandleInt32Access (in category 'tests - array by handle') ----- + test01ByHandleInt32Access + + | type handle | + type := ExternalType int32_t. + handle := (self allocate: type size: 5) getHandle. + self assert: 0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 42. + type handle: handle atIndex: 1 put: 0. + self assert: 42 equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test02ByHandleFloatAccess (in category 'tests - array by handle') ----- + test02ByHandleFloatAccess + + | type handle | + type := ExternalType float. + handle := (self allocate: type size: 5) getHandle. + self assert: 0.0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 1.23. + type handle: handle atIndex: 1 put: 0.0. + self assert: ((type handle: handle atIndex: 2) + between: 1.23 - 0.0005 and: 1.23 + 0.0005).! Item was added: + ----- Method: FFIAllocateTests>>test03ByHandleDoubleAccess (in category 'tests - array by handle') ----- + test03ByHandleDoubleAccess + + | type handle | + type := ExternalType double. + handle := (self allocate: type size: 5) getHandle. + self assert: 0.0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 1.23456. + type handle: handle atIndex: 1 put: 0.0. + self assert: 1.23456 equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test04ByHandleCharAccess (in category 'tests - array by handle') ----- + test04ByHandleCharAccess + + | type handle | + type := ExternalType char. + handle := (self allocate: type size: 5) getHandle. + self assert: Character null equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: $A. + type handle: handle atIndex: 1 put: Character null. + self assert: $A equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test05ByHandleBoolAccess (in category 'tests - array by handle') ----- + test05ByHandleBoolAccess + + | type handle | + type := ExternalType bool. + handle := (self allocate: type size: 5) getHandle. + self assert: false equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: true. + type handle: handle atIndex: 1 put: false. + self assert: true equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test06ByArrayHandleInt32Access (in category 'tests - array by handle') ----- + test06ByArrayHandleInt32Access + + | type handle | + type := ExternalType int32_t. + ExternalType useArrayClassesDuring: [ + handle := (self allocate: type size: 5) getHandle]. + self assert: 0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 42. + type handle: handle atIndex: 1 put: 0. + self assert: 42 equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test07ByArrayHandleFloatAccess (in category 'tests - array by handle') ----- + test07ByArrayHandleFloatAccess + + | type handle | + type := ExternalType float. + ExternalType useArrayClassesDuring: [ + handle := (self allocate: type size: 5) getHandle]. + self assert: 0.0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 1.23. + type handle: handle atIndex: 1 put: 0.0. + self assert: ((type handle: handle atIndex: 2) + between: 1.23 - 0.0005 and: 1.23 + 0.0005).! Item was added: + ----- Method: FFIAllocateTests>>test08ByArrayHandleDoubleAccess (in category 'tests - array by handle') ----- + test08ByArrayHandleDoubleAccess + + | type handle | + type := ExternalType double. + ExternalType useArrayClassesDuring: [ + handle := (self allocate: type size: 5) getHandle]. + self assert: 0.0 equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: 1.23456. + type handle: handle atIndex: 1 put: 0.0. + self assert: 1.23456 equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test09ByArrayHandleCharAccess (in category 'tests - array by handle') ----- + test09ByArrayHandleCharAccess + + | type handle | + type := ExternalType char. + ExternalType useArrayClassesDuring: [ + handle := (self allocate: type size: 5) getHandle]. + self assert: Character null equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: $A. + type handle: handle atIndex: 1 put: Character null. + self assert: $A equals: (type handle: handle atIndex: 2).! Item was added: + ----- Method: FFIAllocateTests>>test10ByArrayHandleBoolAccess (in category 'tests - array by handle') ----- + test10ByArrayHandleBoolAccess + + | type handle | + type := ExternalType bool. + ExternalType useArrayClassesDuring: [ + handle := (self allocate: type size: 5) getHandle]. + self assert: false equals: (type handle: handle atIndex: 2). + type handle: handle atIndex: 2 put: true. + type handle: handle atIndex: 1 put: false. + self assert: true equals: (type handle: handle atIndex: 2).! From m at jaromir.net Fri May 21 12:22:46 2021 From: m at jaromir.net (Jaromir Matas) Date: Fri, 21 May 2021 07:22:46 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: References: <1621087561864-0.post@n4.nabble.com> <1621113654445-0.post@n4.nabble.com> Message-ID: <1621599766501-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote >> > [ >> > [ >> > [ ] ensure: [ >> > [] ensure: [ >> > ^Transcript show: 'x1']. >> > Transcript show: 'x2'] >> > ] ensure: [ >> > Transcript show: 'x3']. >> > Transcript show: 'x4' >> > ] fork >> > >> > In this case the expected outcome is ---> x1 x3. Neither x2 nor x4 >> should be printed (x2 is intentionally skipped by the non-local return >> and x4 is outside the ensure blocks). With the fix you propose the >> outcome is either ---> x1 x2 x3 if pressed Abandon or ---> x1 x2 x3 x4 if >> pressed Proceed - this would be equivalent to no non-local return at all >> :) >> >> Wait, wait, wait. This smells to me. :-) #cannotReturn: should not be >> *resumed* after the error was abandoned. Otherwise, something is wrong >> with the termination logic. Process >> #terminate *must not* resume in >> this place. Terminating means only executing all uncompleted unwind >> contexts. I just reverted to the version ct 1/17/2021 18:35 of Process >> >> #terminate and with regard to your example, both implementations of >> #cannotReturn: behave the save (---> x1 x3) as expected. Hm, I'm sorry, >> but Process >> #terminate is not yet done correctly IMHO. What happened: in your changeset you made #cannotReturn: return to its sender after choosing Proceed, i.e. the execution continued into the preceding #ensure context. This, I feel, introduces an incorrect semantics here: the real sender of the #cannotReturn: was the VM that tried to execute a non-local return and failed. For lack of other options (I guess) the VM set the #ensure: context as a sender of #cannotReturn: - my guess the main purpose of this link is to keep the stack chain available for unwind - but not for resuming the execution - so this is my objection. Proceeding after BlockCannotReturn actually means: Proceed as if no non-local return was ever there. This doesn't seem right to me but maybe there could be good a reason to do this in debugging, I don't know. The crucial point here is #terminate now attempts to complete the outer-most unfinished unwind block instead of the inner-most only (i.e. the deepest unfinished unwind block as opposed to the most shallow one). In this particular example current #terminate correctly leaves the unfinished unwind block after abandoning BlockCannotReturn (skipping 'x2') and finds another unwind block with 'x3'. But if you apply your #cannotReturn patch and press Proceed then #cannotReturn: returns and current #terminate simply continues the unwind within the current unwind block and finds 'x2'. To avoid any confusion: by no means #terminate resumes after BlockCannotReturn - absolutely not, #terminate just continues unwinding remaining unwind blocks only; that's different. > With your example, you won't be able to escape from the situation without > pressing Abandon. Well, yes, that was the point: I can't imagine a reasonable next step from a non-local return with no home context to return to... That's why I looped #cannotReturn: to itself with the only way out via Abandon, i.e. terminating :) I'm sending an alternative proposal to solve the infinite recursion of BlockCannotReturn: ``` cannotReturn: result closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. [self cannotReturnRecursive: result to: self home sender. self notify: 'Invoking an infinite loop'. true] whileTrue]. Processor debugWithTitle: 'Computation has been terminated!' translated full: false. ``` where #cannotReturnRecursive:to: sets a Boolean variable for the user to be able to deal with the recursion. Resuming BCR or not should no longer be an issue... I know you're questioning whether Abandoning the debugger should be equivalent to terminating; or more precisely you're suggesting termination logic should be reduced to follow a normal return or exception return logic, i.e. skipping the unwind blocks currently under evaluation as discussed in [1]. As you know I disagree here and maintain the general termination logic should be as broad as possible but I see your point in reducing the termination logic in case of abandoning a debugger in case the debugged process is broken. Thanks and best regards! [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Fri May 21 13:55:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 21 May 2021 13:55:42 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1410.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1410.mcz ==================== Summary ==================== Name: Kernel-jar.1410 Author: jar Time: 21 May 2021, 3:55:35.689716 pm UUID: 8f28f106-e393-2a4f-beb1-c6e955c155fe Ancestors: Kernel-nice.1402 Prevent VM crashes due to returning from #cannotReturn. The fix introduces a isRecursive variable to BlockCannotReturn to recognize an infinite loop. #cannotReturn: loops to itself and notifies the user an infinite loop is starting. Returning from #cannotReturn: is no longer possible so that the user cannot crash the VM by accidentally pressing Proceed, by stepping over etc. #terminate can take advantage of this improved behavior. This is a more sophisticated alternative to Kernel-jar.1404 for a discussion. Examples like: [^2] fork or [[self error] ensure: [^2]] fork or even a := [true ifTrue: [^ 1] yourself] "and then do-it separately (c) Christoph:" [a value] on: BlockCannotReturn do: [:ex | ex resume] can no longer crash the image :) =============== Diff against Kernel-nice.1402 =============== Item was changed: Error subclass: #BlockCannotReturn + instanceVariableNames: 'result deadHome isRecursive' - instanceVariableNames: 'result deadHome' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'! !BlockCannotReturn commentStamp: '' prior: 0! This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as: [self doThis. ^nil] ensure: [self doThat] Signaling or handling this exception is not recommended.! Item was added: + ----- Method: BlockCannotReturn>>isRecursive (in category 'accessing') ----- + isRecursive + + ^isRecursive ifNil: [false]! Item was added: + ----- Method: BlockCannotReturn>>isRecursive: (in category 'accessing') ----- + isRecursive: aBoolean + + ^isRecursive := aBoolean! Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. + [self cannotReturnRecursive: result to: self home sender. + self notify: '#cannotReturn: Invoking an infinite loop'. + true] whileTrue]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was added: + ----- Method: Context>>cannotReturnRecursive:to: (in category 'private-exceptions') ----- + cannotReturnRecursive: result to: homeContext + "The receiver tried to return result to homeContext that no longer exists. + This is a repeated invocation of the BlockCannotReturn error." + + ^BlockCannotReturn new + result: result; + deadHome: homeContext; + isRecursive: true; + signal! From maxleske at gmail.com Fri May 21 19:19:11 2021 From: maxleske at gmail.com (Max Leske) Date: Fri, 21 May 2021 21:19:11 +0200 Subject: [squeak-dev] Missing STONJSON class Message-ID: <50FB5F74-100F-48A6-ACCA-7D7E2E30AF91@gmail.com> Hi While testing Fuel I ran into an issue with trunk (which impacts all SmalltalkCI builds): at least 3 methods reference an unknown global called "STONJSON". There is no such class. Renaming the references to "STON" fixes the problems. My guess is that the refactoring of the repository classes led to this (the failing class during the build is the new MCFilesystemFetchOnlyRepository), why the global has that weird name is another question... :) I've been trying for the last half hour to contribute the fix but I wasn't able to find the repository for Metacello-Platform.squeak-ct-70. I'll leave the fix to someone who knows what's going on. Cheers, Max -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: OpenPGP digital signature URL: From jakres+squeak at gmail.com Fri May 21 19:47:31 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Fri, 21 May 2021 21:47:31 +0200 Subject: [squeak-dev] Missing STONJSON class In-Reply-To: <50FB5F74-100F-48A6-ACCA-7D7E2E30AF91@gmail.com> References: <50FB5F74-100F-48A6-ACCA-7D7E2E30AF91@gmail.com> Message-ID: Hi Max, Curious. STONJSON is part of the STON-Core package. If the Squeak fork is loaded, this is it: https://github.com/squeak-smalltalk/squeak-ston/tree/master/repository/STON-Core.package/STONJSON.class So the question is, why is it missing in those test images if STON is loaded. The Metacello repository is on GitHub: https://github.com/Metacello/metacello/tree/master/repository/Metacello-Platform.squeak.package Kind regards, Jakob Am Fr., 21. Mai 2021 um 21:19 Uhr schrieb Max Leske : > > Hi > > While testing Fuel I ran into an issue with trunk (which impacts all SmalltalkCI builds): at least 3 methods reference an unknown global called "STONJSON". There is no such class. Renaming the references to "STON" fixes the problems. > > My guess is that the refactoring of the repository classes led to this (the failing class during the build is the new MCFilesystemFetchOnlyRepository), why the global has that weird name is another question... :) > > > I've been trying for the last half hour to contribute the fix but I wasn't able to find the repository for Metacello-Platform.squeak-ct-70. I'll leave the fix to someone who knows what's going on. > > > Cheers, > Max From commits at source.squeak.org Sat May 22 06:23:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 22 May 2021 06:23:49 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.17.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.17.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.17 Author: mt Time: 22 May 2021, 8:23:46.263398 am UUID: b3ac5bb7-3823-d04c-bcc9-7409126840dd Ancestors: FFI-Callbacks-mt.16 Minor improvement for callbacks. Decide on abi-specific register size during field definition in FFICallbackContext already. Not at callback time. Please re-define fields: "FFICallbackContext defineFields." =============== Diff against FFI-Callbacks-mt.16 =============== Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. + intArgs := callbackContext intRegArgs. - intArgs := callbackContext integerArguments. intPos := 0. + floatArgs := callbackContext floatRegArgs. - floatArgs := callbackContext floatArguments. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Read pointers from register value." isPointer ifFalse: ["data is already an integer"] ifTrue: [ data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) type: argType asNonPointerType "contentType" size: 1) value]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := (argType handle: handle at: byteOffset) value. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was removed: - ----- Method: FFICallback>>evaluateDynamic_ARM32: (in category 'callback - evaluators') ----- - evaluateDynamic_ARM32: callbackContext - "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." - - - callbackContext integerArguments setSize: 4. - callbackContext floatArguments setSize: 8. - ^ self evaluateDynamic: callbackContext! Item was removed: - ----- Method: FFICallback>>evaluateDynamic_ARM64: (in category 'callback - evaluators') ----- - evaluateDynamic_ARM64: callbackContext - "Set handle to access arguments as most appropriate for the ABI. ARMv8 with AArch64." - - - callbackContext integerArguments setSize: 8. - callbackContext floatArguments setSize: 8. - ^ self evaluateDynamic: callbackContext! Item was removed: - ----- Method: FFICallback>>evaluateDynamic_IA32: (in category 'callback - evaluators') ----- - evaluateDynamic_IA32: callbackContext - "Set handle to access arguments as most appropriate for the ABI. For x86 (i.e. IA32) it is the stack pointer." - - - callbackContext integerArguments setSize: 0. - callbackContext floatArguments setSize: 0. - ^ self evaluateDynamic: callbackContext! Item was removed: - ----- Method: FFICallback>>evaluateDynamic_X64: (in category 'callback - evaluators') ----- - evaluateDynamic_X64: callbackContext - "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." - - - callbackContext integerArguments setSize: 6. - callbackContext floatArguments setSize: 8. - ^ self evaluateDynamic: callbackContext! Item was removed: - ----- Method: FFICallback>>evaluateDynamic_X64Win64: (in category 'callback - evaluators') ----- - evaluateDynamic_X64Win64: callbackContext - "Set handle to access arguments as most appropriate for the ABI. For ''RISCs'' it is the pointer to the integer register." - - - callbackContext integerArguments setSize: 4. - callbackContext floatArguments setSize: 4. - ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>setResult:inContext: (in category 'callback') ----- setResult: anObject inContext: aCallbackContext "Set the result in the callback context. Add some fast checks to detect errors." resultType isPointerType ifTrue: [ "an ExternalStructure, an ExternalUnion, an ExternalData, ..." ^ aCallbackContext externalObjectResult: anObject]. resultType atomicType = 0 "void" ifTrue: ["Quick exit for void return type." ^ aCallbackContext voidResult]. anObject isInteger ifTrue: [ self assert: [resultType isIntegerType]. self flag: #todo. "mt: ABI #X64Win64 has special treatment for word64, too. But maybe it is not needed." + ^ (anObject isLarge and: [abi = #IA32]) - ^ (anObject isLarge and: [FFIPlatformDescription current abi = #IA32]) ifTrue: [aCallbackContext word64Result: anObject] ifFalse: [aCallbackContext wordResult: anObject]]. anObject isBoolean ifTrue: [ self assert: [resultType atomicType = 1 "bool"]. ^ aCallbackContext wordResult: anObject]. anObject isFloat ifTrue: [ self assert: [resultType atomicType >= 12 "float/double"]. ^ aCallbackContext floatResult: anObject]. self notify: 'Unkown result type.'. ^ aCallbackContext errorResult! Item was changed: ----- Method: FFICallback>>valueInContext: (in category 'callback') ----- valueInContext: callbackContext " ^" + + ^ self evaluateDynamic: callbackContext! - - FFICallback methodsDo: [:method | - (method hasPragma: #evaluator) ifTrue: [ - (method pragmaAt: #abi:) - ifNotNil: [:pragma | (pragma argumentAt: 1) = abi - ifTrue: [^ self with: callbackContext executeMethod: method]]]]. - - self error: 'Could find evaluator for current ABI: ', abi.! Item was changed: ExternalStructure subclass: #FFICallbackContext + instanceVariableNames: '' - instanceVariableNames: 'floatArguments integerArguments' classVariableNames: '' poolDictionaries: 'FFICallbackConstants' category: 'FFI-Callbacks'! !FFICallbackContext commentStamp: 'mt 4/30/2021 11:32' prior: 0! A callback context is a data structure prepared from the VM for accessing the callback's arguments. See FFICallback >> #thunkEntryAddress. !!!!!! BE AWARE that the actual location of argument values in this structure depend on the current ABI (i.e. 'Application Binary Interface'). See FFIPlatformDescription to access the current ABI.! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " + ^ #( (thunkp 'void*') (stackPtr 'byte*') "was: char*" + ), + (FFIPlatformDescription current abiSend: #fields to: self), + #( - (intRegArgs 'intptr_t*') "was: long* or int*" - (floatRegArgs 'double*') (nil 'void*') "was: savedCStackPointer" (nil 'void*') "was: savedCFramePointer" (rvs 'FFICallbackResult') (nil 'void*') "was: savedPrimFunctionPointer" (outerContext 'FFICallbackContext*') "jmp_buf trampoline --- for debugging only?" ) " typedef struct { void *thunkp; char *stackptr; long *intRegArgs; double *floatRegArgs; void *savedCStackPointer; void *savedCFramePointer; union { intptr_t vallong; struct { int low, high; } valleint64; struct { int high, low; } valbeint64; double valflt64; struct { void *addr; intptr_t size; } valstruct; } rvs; void *savedPrimFunctionPointer; jmp_buf trampoline; jmp_buf savedReenterInterpreter; } VMCallbackContext; "! Item was added: + ----- Method: FFICallbackContext class>>fields_ARM32 (in category 'field definition') ----- + fields_ARM32 + + + ^ #( + (intRegArgs '(intptr_t[4])*') + (floatRegArgs '(double[8])*') + )! Item was added: + ----- Method: FFICallbackContext class>>fields_ARM64 (in category 'field definition') ----- + fields_ARM64 + + + ^ #( + (intRegArgs '(intptr_t[8])*') + (floatRegArgs '(double[8])*') + )! Item was added: + ----- Method: FFICallbackContext class>>fields_IA32 (in category 'field definition') ----- + fields_IA32 + + + ^ #( + (intRegArgs '(intptr_t[0])*') + (floatRegArgs '(double[0])*') + )! Item was added: + ----- Method: FFICallbackContext class>>fields_X64 (in category 'field definition') ----- + fields_X64 + + + ^ #( + (intRegArgs '(intptr_t[6])*') + (floatRegArgs '(double[8])*') + )! Item was added: + ----- Method: FFICallbackContext class>>fields_X64Win64 (in category 'field definition') ----- + fields_X64Win64 + + + ^ #( + (intRegArgs '(intptr_t[4])*') + (floatRegArgs '(double[4])*') + )! Item was removed: - ----- Method: FFICallbackContext>>floatArguments (in category 'callback arguments') ----- - floatArguments - "Cache proxy to the list of float arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size." - - ^ floatArguments ifNil: [ - floatArguments := self floatRegArgs]! Item was removed: - ----- Method: FFICallbackContext>>integerArguments (in category 'callback arguments') ----- - integerArguments - "Cache proxy to the list of integer arguments (i.e. an ExternalData) to attach ABI-specific properties such as #size." - - ^ integerArguments ifNil: [ - integerArguments := self intRegArgs]! Item was added: + ----- Method: FFIPlatformDescription>>abiSend:to: (in category '*FFI-Callbacks') ----- + abiSend: selector to: receiver + + receiver class methodsDo: [:method | + (method hasPragma: selector) ifTrue: [ + (method pragmaAt: #abi:) + ifNotNil: [:pragma | (pragma argumentAt: 1) = self abi + ifTrue: [^ receiver executeMethod: method]]]]. + + self error: 'Could find method for current ABI: ', self abi.! Item was added: + ----- Method: FFIPlatformDescription>>abiSend:to:with: (in category '*FFI-Callbacks') ----- + abiSend: selector to: receiver with: argument + + receiver class methodsDo: [:method | + (method hasPragma: selector) ifTrue: [ + (method pragmaAt: #abi:) + ifNotNil: [:pragma | (pragma argumentAt: 1) = self abi + ifTrue: [^ receiver with: argument executeMethod: method]]]]. + + self error: 'Could find method for current ABI: ', self abi.! From commits at source.squeak.org Sat May 22 13:19:44 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 22 May 2021 13:19:44 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.166.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.166.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.166 Author: mt Time: 22 May 2021, 3:19:41.704855 pm UUID: cecd9ff4-64c2-2343-a278-d7263d721b90 Ancestors: FFI-Kernel-mt.165 Some bug fixes around void and void* =============== Diff against FFI-Kernel-mt.165 =============== Item was changed: ----- Method: ExternalData>>arrayType (in category 'accessing - types') ----- arrayType + "Answer this container's array type or 'nil' if unknown. Supports" - "Answer this container's array type or 'nil' if unknown." | arrayType | + ^ (arrayType := self containerType) asNonPointerType isVoid - ^ (arrayType := self containerType) isVoid ifFalse: [arrayType]! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." externalType = ExternalType string ifTrue: [ ^ self setType: externalType asNonPointerType]. + externalType isVoid ifTrue: [ + ^ self setType: externalType asPointerType]. + + (externalType isArrayType or: [externalType asNonPointerType isVoid]) + ifTrue: [type := externalType "array type or void*"] - (externalType isArrayType or: [externalType isVoid]) - ifTrue: [type := externalType] ifFalse: [type := (externalType asArrayType: nil)]. contentType := nil.! Item was changed: ----- Method: ExternalData>>writer (in category 'accessing') ----- writer "Overwritten to preserve type." + ^ (self isNull or: [handle isExternalAddress]) - ^ handle isExternalAddress ifTrue: [self] ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type]! Item was added: + ----- Method: VoidReadWriteSend>>handle:atIndex: (in category 'evaluating') ----- + handle: handle atIndex: byteOffset + "no accessors for void" + self shouldNotImplement.! Item was added: + ----- Method: VoidReadWriteSend>>handle:atIndex:put: (in category 'evaluating') ----- + handle: handle atIndex: byteOffset put: value + "no accessors for void" + self shouldNotImplement.! From commits at source.squeak.org Sat May 22 13:20:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sat, 22 May 2021 13:20:47 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.47.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.47.mcz ==================== Summary ==================== Name: FFI-Tests-mt.47 Author: mt Time: 22 May 2021, 3:20:44.808855 pm UUID: d0f55a99-244f-8d4f-ac64-3068068e631c Ancestors: FFI-Tests-mt.46 Complements FFI-Kernel-mt.166 =============== Diff against FFI-Tests-mt.46 =============== Item was added: + ----- Method: FFIAllocateTests>>test19ArrayFromVoidPointer (in category 'tests - array') ----- + test19ArrayFromVoidPointer + "Check whether the construction of external data with void or void* will always set void* as containerType and void as contentType. Whether or not the #externalType will be a pointer type still corresponds to the kind of handle, that is, byte array (void) or external address (void*)." + + | type void array | + type := ExternalType int32_t. + void := ExternalType void. + array := self allocate: type size: 5. + + array := ExternalData + fromHandle: array getHandle + type: void asPointerType. + self assert: void asPointerType equals: array containerType. + self assert: void equals: array contentType. + self checkAllocate: array. + + array := ExternalData + fromHandle: array getHandle + type: void. "Should still become void*" + self assert: void asPointerType equals: array containerType. + self assert: void equals: array contentType. + self checkAllocate: array. + + array := ExternalData fromHandle: array getHandle. + self assert: void asPointerType equals: array containerType. + self assert: void equals: array contentType. + self checkAllocate: array.! From commits at source.squeak.org Sun May 23 13:42:13 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 23 May 2021 13:42:13 0000 Subject: [squeak-dev] FFI: FFI-Pools-mt.27.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.27.mcz ==================== Summary ==================== Name: FFI-Pools-mt.27 Author: mt Time: 23 May 2021, 3:42:11.878158 pm UUID: a2ba55a2-24e2-2940-a551-3daaa4540cfc Ancestors: FFI-Pools-eem.26 Prepares extra pool for types to be used for fast field access in external structures. =============== Diff against FFI-Pools-eem.26 =============== Item was added: + SharedPool subclass: #ExternalTypePool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !ExternalTypePool commentStamp: 'mt 5/23/2021 15:01' prior: 0! + I am a pool for known external types to be used in struct-field accessors. See #useTypePool preference. All subclasses of ExternalStructure should use this shared pool by default.! Item was added: + ----- Method: ExternalTypePool class>>assuredPoolVarNameFor: (in category 'housekeeping') ----- + assuredPoolVarNameFor: type + + | name | + name := (self poolVarNameFor: type) asSymbol. + (self classPool includesKey: name) + ifFalse: [self addClassVarName: name]. + self classPool at: name put: type. + ^ name! Item was added: + ----- Method: ExternalTypePool class>>cleanUp (in category 'housekeeping') ----- + cleanUp + " + self cleanUp. + " + self classPool keys do: [:classVarName | + (classVarName beginsWith: 'ExternalType_') ifTrue: [ + (self classPool at: classVarName) + ifNil: [self classPool removeKey: classVarName]]].! Item was added: + ----- Method: ExternalTypePool class>>poolVarNameFor: (in category 'housekeeping') ----- + poolVarNameFor: type + "Answers the name to be used in the shared pool to speed up type look-up for field access in ExternalStructure." + + ^ String streamContents: [:stream | + | nameStream | + stream nextPutAll: 'ExternalType_'. + nameStream := type typeName readStream. + [nameStream atEnd] whileFalse: [ + | char | + (char := nameStream next) caseOf: { + [ $( ] -> [ "Ignore." ]. + [ $) ] -> [ "Ignore." ]. + [ $* ] -> [ stream nextPutAll: '_star' ]. + [ $[ ] -> [ stream nextPut: $_ ]. + [ $] ] -> [ stream nextPut: $_ ] + } otherwise: [ stream nextPut: char ]]]! Item was added: + ----- Method: ExternalTypePool class>>reset (in category 'housekeeping') ----- + reset + " + self reset + " + self classPool keys do: [:classVarName | + (classVarName beginsWith: 'ExternalType_') ifTrue: [ + (self classPool at: classVarName put: nil)]].! From commits at source.squeak.org Sun May 23 13:45:10 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 23 May 2021 13:45:10 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.167.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.167.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.167 Author: mt Time: 23 May 2021, 3:45:09.673158 pm UUID: 6e67015a-9732-e741-aefe-49f7cf42ef82 Ancestors: FFI-Kernel-mt.166 Complements FFI-Pools-mt.27. New preference for using a type pool for about 2x faster access to struct fields. =============== Diff against FFI-Kernel-mt.166 =============== Item was changed: ----- Method: ByteArray>>structAt:length: (in category '*FFI-Kernel') ----- structAt: byteOffset length: length "Return a structure of the given length starting at the indicated byte offset." | value startByteOffset | + self flag: #todo. "mt: Better name #unsignedBytesAt:length:?" value := ByteArray new: length. startByteOffset := byteOffset - 1. 1 to: length do: [:valueByteOffset | value unsignedByteAt: valueByteOffset put: (self unsignedByteAt: startByteOffset + valueByteOffset)]. ^ value! Item was changed: ----- Method: ByteArray>>structAt:put:length: (in category '*FFI-Kernel') ----- structAt: byteOffset put: value length: length "Store a structure of the given length starting at the indicated byte offset." | startByteOffset | + self flag: #todo. "mt: Better name #unsignedBytesAt:put:length:?" startByteOffset := byteOffset - 1. 1 to: length do: [:valueByteOffset | self unsignedByteAt: startByteOffset + valueByteOffset put: (value unsignedByteAt:valueByteOffset)]. ^ value! Item was changed: ----- Method: ExternalArrayType>>readAlias (in category 'external structure') ----- readAlias ^ '^ {1} fromHandle: handle{2}' format: { (referentClass ifNil: [ExternalData]) name. referentClass ifNotNil: [''] ifNil: [ + ' type: ', self storeStringForField]}! - ' type: ', self storeString]}! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset ^ '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' format: { byteOffset. self byteSize. + self storeStringForField}! - self storeString}! Item was changed: ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset " ExternalStructure defineAllFields. " ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}' format: { (referentClass ifNil: [ExternalData]) name. byteOffset. self byteSize. referentClass ifNotNil: [''] ifNil: [ + ' type: ', self asNonPointerType "content type" storeStringForField]}! - ' type: ', self asNonPointerType "content type" storeString]}! Item was changed: ExternalObject subclass: #ExternalStructure instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: 'ExternalTypePool FFIConstants' - classVariableNames: 'PreviousPlatform' - poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! ExternalStructure class instanceVariableNames: 'compiledSpec byteAlignment'! !ExternalStructure commentStamp: 'eem 6/26/2019 15:26' prior: 0! An ExternalStructure is for representing external data that is - either a structure composed of different fields (a struct of C language) - or an alias for another type (like a typedef of C language) It reserves enough bytes of data for representing all the fields. The data is stored into the handle instance variable which can be of two different types: - ExternalAddress If the handle is an external address then the object described does not reside in the Smalltalk object memory. - ByteArray If the handle is a byte array then the object described resides in Smalltalk memory. Instance Variables (class side) byteAlignment: compiledSpec: byteAlignment - the required alignment for the structure compiledSpec - the bit-field definiton of the structure in the ExternalType encoding understood by the VM's FFI call marshalling machinery. A specific structure is defined by subclassing ExternalStructure and specifying its #fields via a class side method. For example if we define a subclass: ExternalStructure subclass: #StructExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then declare the fields like this: StructExample class compile: 'fields ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'. It means that this type is composed of two different fields: - a string (accessed thru the field #name) - and an unsigned 32bit integer (accessed thru the field #color). It represents the following C type: struct StructExample {char *name; uint32_t color; }; The accessors for those fields can be generated automatically like this: StructExample defineFields. As can be verified in a Browser: StructExample browse. We see that name and color fields are stored sequentially in different zones of data. The total size of the structure can be verified with: StructExample byteSize = (Smalltalk wordSize + 4). An ExternalStructure can also be used for defining an alias. The fields definition must contain only 2 elements: an eventual accessor (or nil) and the type. For example, We can define a machine dependent 'unsigned long' like this: ExternalStructure subclass: #UnsignedLong instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then set the fields like this: UnsignedLong class compile: 'fields ^(Smalltalk wordSize=4 or: [Smalltalk platformName=''Win64'']) ifTrue: [#(nil ''ulong'')] ifFalse: [#(nil ''ulonglong'')]' classified: 'garbage'. And verify the size on current platform: UnsignedLong byteSize. Then, the class names 'UnsignedLong' and 'StructExamples' acts as a type specification. They can be used for composing other types, and for defining prototype of external functions: LibraryExample>>initMyStruct: aStructExample name: name color: anInteger self externalCallFailed ! ExternalStructure class instanceVariableNames: 'compiledSpec byteAlignment'! Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' + classVariableNames: 'ArrayClasses ArrayTypes AtomicSends AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool' - classVariableNames: 'ArrayClasses ArrayTypes AtomicSends AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! !ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects. Instance variables: compiledSpec Compiled specification of the external type referentClass Class type of argument required referencedType Associated (non)pointer type with the receiver byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed. Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following: FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits. FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly. [Note: Other combinations may be allowed in the future] ! Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes." AtomicTypes := nil. AtomicSends := nil. + ArrayClasses := nil. + StructTypes := nil. ArrayTypes := nil. - ArrayClasses := nil. self initializeDefaultTypes. self initializeArrayClasses. self resetAllStructureTypes.! Item was changed: ----- Method: ExternalType class>>resetAllStructureTypes (in category 'housekeeping') ----- resetAllStructureTypes "Warning: This call is only required if you change the container for StructTypes!! Note that (2) and (3) can be swapped but that puts unnecessary pressure on the GC." StructTypes := nil. ArrayTypes := nil. "1) Initialize the container for structure types." self initializeStructureTypes. "2) Recompile all FFI calls to create and persist structure types." self recompileAllLibraryFunctions. "3) Update all structure types' spec and alignment." + ExternalTypePool reset. + ExternalStructure defineAllFields. + ExternalTypePool cleanUp. - ExternalStructure compileAllFields. ! Item was changed: ----- Method: ExternalType class>>useArrayClasses (in category 'preferences') ----- useArrayClasses + ^UseArrayClasses ifNil:[true]! Item was added: + ----- Method: ExternalType class>>useTypePool (in category 'preferences') ----- + useTypePool + + ^UseTypePool ifNil: [true]! Item was added: + ----- Method: ExternalType class>>useTypePool: (in category 'preferences') ----- + useTypePool: aBoolean + + UseTypePool = aBoolean ifTrue: [^ self]. + + UseTypePool := aBoolean. + + Cursor wait showWhile: [ + "Either fill or clean out the type pool." + ExternalTypePool reset. + ExternalStructure defineAllFields. + ExternalTypePool cleanUp].! Item was added: + ----- Method: ExternalType>>storeStringForField (in category 'external structure') ----- + storeStringForField + "Answers the code snippet to be used to make use of the receiver during field access in an external structure." + + ^ self class useTypePool + ifTrue: [ExternalTypePool assuredPoolVarNameFor: self] + ifFalse: [self storeString]! Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. Smalltalk removeFromStartUpList: ExternalObject. "Introduce FFIAtomicReadWriteSend. All types need to be reset and all fields need to be re-defined." + ExternalType resetAllTypes.'! - ExternalType resetAllTypes. - ExternalStructure defineAllFields. - '! From commits at source.squeak.org Sun May 23 13:46:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 23 May 2021 13:46:49 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.168.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.168.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.168 Author: mt Time: 23 May 2021, 3:46:48.099158 pm UUID: 3db8d87e-8c71-7946-840a-b09c28b36af3 Ancestors: FFI-Kernel-mt.167 Minor clean-up in raw-bits array to clarify the use of FFIAtomicReadWriteSend for FloatArray and (Signed|Unsigned)IntegerArray. =============== Diff against FFI-Kernel-mt.167 =============== Item was added: + ----- Method: FloatArray>>doubleAt: (in category '*FFI-Kernel-accessing') ----- + doubleAt: byteOffset + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was added: + ----- Method: FloatArray>>doubleAt:put: (in category '*FFI-Kernel-accessing') ----- + doubleAt: byteOffset put: value + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was added: + ----- Method: FloatArray>>floatAt: (in category '*FFI-Kernel-accessing') ----- + floatAt: byteOffset + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was added: + ----- Method: FloatArray>>floatAt:put: (in category '*FFI-Kernel-accessing') ----- + floatAt: byteOffset put: value + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was removed: - ----- Method: RawBitsArray>>doubleAt: (in category '*FFI-Kernel-accessing') ----- - doubleAt: byteOffset - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." - - ^ self atByteOffset: byteOffset! Item was removed: - ----- Method: RawBitsArray>>doubleAt:put: (in category '*FFI-Kernel-accessing') ----- - doubleAt: byteOffset put: value - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." - - ^ self atByteOffset: byteOffset put: value! Item was removed: - ----- Method: RawBitsArray>>floatAt: (in category '*FFI-Kernel-accessing') ----- - floatAt: byteOffset - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." - - ^ self atByteOffset: byteOffset! Item was removed: - ----- Method: RawBitsArray>>floatAt:put: (in category '*FFI-Kernel-accessing') ----- - floatAt: byteOffset put: value - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." - - ^ self atByteOffset: byteOffset put: value! Item was removed: - ----- Method: RawBitsArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') ----- - integerAt: byteOffset put: value size: nBytes signed: aBoolean - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." - - ^ self atByteOffset: byteOffset put: value! Item was removed: - ----- Method: RawBitsArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') ----- - integerAt: byteOffset size: nBytes signed: aBoolean - "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." - - ^ self atByteOffset: byteOffset! Item was added: + ----- Method: SignedIntegerArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset put: value size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was added: + ----- Method: SignedIntegerArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! Item was added: + ----- Method: UnsignedIntegerArray>>integerAt:put:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset put: value size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:put:." + + ^ self atByteOffset: byteOffset put: value! Item was added: + ----- Method: UnsignedIntegerArray>>integerAt:size:signed: (in category '*FFI-Kernel-accessing') ----- + integerAt: byteOffset size: nBytes signed: aBoolean + "Backstop for compatibility with handle-based access. Raw-bits arrays are their own handle. See #getHandle and ExternalType >> #handle:at:." + + ^ self atByteOffset: byteOffset! From commits at source.squeak.org Sun May 23 14:03:14 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 23 May 2021 14:03:14 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.18.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.18.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.18 Author: mt Time: 23 May 2021, 4:03:13.688158 pm UUID: fcb16553-c424-d646-b58f-dc47277ed808 Ancestors: FFI-Callbacks-mt.17 Use #abiSend: for callback init. =============== Diff against FFI-Callbacks-mt.17 =============== Item was changed: ----- Method: FFICallback>>init__ccall (in category 'initialization - thunk prepare') ----- init__ccall "Initialize the receiver with a __ccall thunk." + FFIPlatformDescription current abiSend: #'init_ccall' to: self.! - FFICallback methodsDo: [:method | - (method selector beginsWith: 'init__ccall') ifTrue: [ - (method hasPragma: #init) ifTrue: [ - (method pragmaAt: #abi:) - ifNotNil: [:pragma | (pragma argumentAt: 1) = abi - ifTrue: [^ self executeMethod: method]]]]]. - - self error: 'Could not initialize thunk for current ABI: ', abi.! Item was changed: ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') ----- init__ccall_ARM32 + - "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm32abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long r0, long r1, long r2, long r3, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "0x0 : mov r12, sp ; 0xe1a0c00d 0x4 : sub sp, sp, #16 ; 0xe24dd010 0x8 : str pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates 0xc : str r12, [sp,#4] ; 0xe58dc004 0x10 : str lr, [sp, #12] ; 0xe58de00c 0x14 : ldr r12, [pc, #8] ; 0xe59fc008 0x18 : blx r12 ; 0xe12fff3c 0x1c : add sp, sp, #12 ; 0xe28dd00c 0x20 : ldr pc, [sp], #4!! ; 0xe49df004 ; pop {pc} 0x24 : .word thunkEntry" self flag: #hidden. "mt: How is the thunk's handle stored to lookup this instance upon callback later?" thunk getHandle unsignedLongAt: 1 put: 16re1a0c00d; unsignedLongAt: 5 put: 16re24dd010; unsignedLongAt: 9 put: 16re58df000; unsignedLongAt: 13 put: 16re58dc004; unsignedLongAt: 17 put: 16re58de00c; unsignedLongAt: 21 put: 16re59fc008; unsignedLongAt: 25 put: 16re12fff3c; unsignedLongAt: 29 put: 16re28dd00c; unsignedLongAt: 33 put: 16re49df004; pointerAt: 37 put: self thunkEntryAddress length: 4.! Item was changed: ----- Method: FFICallback>>init__ccall_ARM64 (in category 'initialization - thunk prepare') ----- init__ccall_ARM64 + - "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the Alien/IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long x0, long x1, long x2, long x3, long x4, long x5, long x6, long x7, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." self shouldBeImplemented "self newCCall"! Item was changed: ----- Method: FFICallback>>init__ccall_IA32 (in category 'initialization - thunk prepare') ----- init__ccall_IA32 + - "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0x9090c30C thunk+21: ret 0xc3 thunk+22: nop 0x90 thunk+23: nop 0x90" thunk getHandle unsignedLongAt: 1 put: 16rB8905454; pointerAt: 5 put: self thunkEntryAddress length: 4; unsignedLongAt: 9 put: 16r68909090; pointerAt: 13 put: thunk getHandle length: 4; unsignedLongAt: 17 put: 16rC483D0FF; unsignedLongAt: 21 put: 16r9090C30C! Item was changed: ----- Method: FFICallback>>init__ccall_X64 (in category 'initialization - thunk prepare') ----- init__ccall_X64 + - "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64sysvabicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. handle thunk+0xc: pushq %rax 50 thunk+0xd: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x17: callq *%rax ff d0 thunk+0x19: addq $0x18, %rsp 48 83 c4 18 thunk+0x1d: retq c3 thunk+0x1e: nop 90 thunk+0x1f: nop 90" thunk getHandle unsignedLongAt: 1 put: 16rb8485454; pointerAt: 5 put: thunk getHandle length: 8; unsignedLongAt: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" pointerAt: 16 put: self thunkEntryAddress length: 8; unsignedByteAt: 24 put: 16rff; unsignedLongAt: 25 put: 16rc48348d0; unsignedLongAt: 29 put: 16r9090c318.! Item was changed: ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'initialization - thunk prepare') ----- init__ccall_X64Win64 + - "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. addressField thunk+0xc: pushq %rax 50 thunk+0xd: subq $0x20, %rsp 48 83 c4 e0 (this is addq -20 since the immediate is signed extended) thunk+0x11: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x1b: callq *%rax ff d0 thunk+0x1d: addq $0x38, %rsp 48 83 c4 38 thunk+0x21: retq c3 thunk+0x22: nop 90 thunk+0x23: nop 90" thunk getHandle unsignedLongAt: 1 put: 16rb8485454; pointerAt: 5 put: thunk getHandle length: 8; unsignedLongAt: 13 put: 16rc4834850; unsignedLongAt: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" pointerAt: 20 put: self thunkEntryAddress length: 8; unsignedByteAt: 28 put: 16rff; unsignedLongAt: 29 put: 16rc48348d0; unsignedLongAt: 33 put: 16r9090c338.! Item was changed: ----- Method: FFICallback>>init__stdcall: (in category 'initialization - thunk prepare') ----- init__stdcall: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes." + FFIPlatformDescription current abiSend: #'init_stdcall' to: self with: numBytes.! - FFICallback methodsDo: [:method | - (method selector beginsWith: 'init__stdcall') ifTrue: [ - (method hasPragma: #init) ifTrue: [ - (method pragmaAt: #abi:) - ifNotNil: [:pragma | (pragma argumentAt: 1) = abi - ifTrue: [^ self with: numBytes executeMethod: method]]]]]. - - self error: 'Could not initialize thunk for current ABI: ', abi.! Item was changed: ----- Method: FFICallback>>init__stdcall_IA32: (in category 'initialization - thunk prepare') ----- init__stdcall_IA32: numBytes + - "Initialize the receiver with a __stdcall thunk with numBytes argument bytes. (See #init__ccall_IA32 for more info)" "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0xBYTSc20C thunk+21: ret $bytes 0xc2 0xBY 0xTS" thunk getHandle unsignedLongAt: 1 put: 16rB8905454; pointerAt: 5 put: self thunkEntryAddress length: 4; unsignedLongAt: 9 put: 16r68909090; pointerAt: 13 put: thunk getHandle length: 4; unsignedLongAt: 17 put: 16rC483D0FF; unsignedShortAt: 21 put: 16rC20C; unsignedShortAt: 23 put: numBytes.! From maxleske at gmail.com Sun May 23 18:41:00 2021 From: maxleske at gmail.com (Max Leske) Date: Sun, 23 May 2021 20:41:00 +0200 Subject: [squeak-dev] Missing STONJSON class In-Reply-To: References: Message-ID: Thanks Jakob, After looking at it again, the issues appears to be that SmalltalkCI provides its own STON-Core packages, replacing the one already in the image. I'll open an issue for SmalltalkCI. Cheers, Max On 23 May 2021, at 15:45, squeak-dev-request at lists.squeakfoundation.org wrote: > Hi Max, > > Curious. STONJSON is part of the STON-Core package. If the Squeak fork > is loaded, this is it: > https://github.com/squeak-smalltalk/squeak-ston/tree/master/repository/STON-Core.package/STONJSON.class > > So the question is, why is it missing in those test images if STON is loaded. > > The Metacello repository is on GitHub: > https://github.com/Metacello/metacello/tree/master/repository/Metacello-Platform.squeak.package > > Kind regards, > Jakob > > Am Fr., 21. Mai 2021 um 21:19 Uhr schrieb Max Leske : > > Hi > > While testing Fuel I ran into an issue with trunk (which impacts all SmalltalkCI builds): at least 3 methods reference an unknown global called "STONJSON". There is no such class. Renaming the references to "STON" fixes the problems. > > My guess is that the refactoring of the repository classes led to this (the failing class during the build is the new MCFilesystemFetchOnlyRepository), why the global has that weird name is another question... :) > > > I've been trying for the last half hour to contribute the fix but I wasn't able to find the repository for Metacello-Platform.squeak-ct-70. I'll leave the fix to someone who knows what's going on. > > > Cheers, > Max -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: OpenPGP digital signature URL: From commits at source.squeak.org Mon May 24 13:03:26 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 13:03:26 0000 Subject: [squeak-dev] The Inbox: KernelTests-jar.405.mcz Message-ID: A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.405.mcz ==================== Summary ==================== Name: KernelTests-jar.405 Author: jar Time: 24 May 2021, 3:03:24.007073 pm UUID: b261daff-2743-364f-876f-2049af8f75f7 Ancestors: KernelTests-nice.404 Add a stress test #testTerminateInEnsure presented by Martin McClure at 2019 Smalltalk conference. Tests unwind when a process gets terminated inside the #ensure unwind block. Complements latest #terminate in the Inbox. =============== Diff against KernelTests-nice.404 =============== Item was added: + ----- Method: ProcessTest>>testTerminateInEnsure (in category 'tests') ----- + testTerminateInEnsure + "As shown in + Martin McClure's 'Threads, Critical Sections, and Termination' (Smalltalks 2019 conference) + https://youtu.be/AvM5YrjK9AE + at 23:17 + self new testTerminateInEnsure + " + | process count random delay | + random _ Random new. + 10 timesRepeat: [ + process _ [ + count _ 0. + [] ensure: [ + 10 timesRepeat: [ + count _ count + 1. + 1000000 timesRepeat: [12 factorial]]. + count _ count + 1] + ] forkAt: Processor activeProcess priority - 1. + delay _ (random next * 100) asInteger + 10. "avoid 0-ms delay" + (Delay forMilliseconds: delay) wait. + self assert: process isTerminated not. + process terminate. + process priority: Processor activeProcess priority + 1. + self + assert: process isTerminated; + assert: count equals: 11 ]! From commits at source.squeak.org Mon May 24 13:08:52 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 13:08:52 0000 Subject: [squeak-dev] The Inbox: Tests-jar.465.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.465.mcz ==================== Summary ==================== Name: Tests-jar.465 Author: jar Time: 24 May 2021, 3:08:49.157073 pm UUID: 18735b9b-6bdc-b349-b14f-bedaeb898934 Ancestors: Tests-jar.463 Add a set of tests comlpementing the latest #terminate in the Inbox. Tests the unwind semantics during termination. =============== Diff against Tests-jar.463 =============== Item was added: + TestCase subclass: #ProcessTerminateUnwindTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-Exceptions'! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminateEnsureAsTopContext (in category 'tests') ----- + testTerminateEnsureAsTopContext + "Test #ensure unwind block is executed even when #ensure context is on stack's top." + + | p1 p2 p3 x1 x2 x3 | + x1 := x2 := x3 := false. + + "p1 is at the beginning of the ensure block; the unwind block hasn't run yet" + p1 := Process + forBlock: [[] ensure: [x1 := x1 not]] + runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) isNil]]. + + "p2 has already set complete to true (tempAt: 2) but the unwind block hasn't run yet" + p2 := Process + forBlock: [[] ensure: [x2 := x2 not]] + runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) notNil]]. + + "p3 has already set complete to true AND the unwind block has run already run; + we have to verify the unwind block is not executed again during termination" + p3 := Process + forBlock: [[] ensure: [x3 := x3 not]] + runUntil: [:ctx | ctx isUnwindContext and: [ctx willReturn]]. + + "make sure all processes are running and only the p3's unwind block has finished" + self deny: p1 isTerminated | p2 isTerminated | p3 isTerminated. + self deny: x1 | x2. + self assert: x3. "p3 has already run its unwind block; we test it won't run it again" + "terminate all processes and verify all unwind blocks have finished correctly" + p1 terminate. p2 terminate. p3 terminate. + self assert: p1 isTerminated & p2 isTerminated & p3 isTerminated. + self assert: x1 & x2 & x3! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind1 (in category 'tests') ----- + testTerminationDuringNestedUnwind1 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind2 (in category 'tests') ----- + testTerminationDuringNestedUnwind2 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind3 (in category 'tests') ----- + testTerminationDuringNestedUnwind3 + "Terminate runnable process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor yield] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind4 (in category 'tests') ----- + testTerminationDuringNestedUnwind4 + "Terminate runnable process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor yield. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind5 (in category 'tests') ----- + testTerminationDuringNestedUnwind5 + "Terminate active process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess terminate] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now let the termination continue and make sure all unwind blocks have finished" + Processor yield. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind6 (in category 'tests') ----- + testTerminationDuringNestedUnwind6 + "Terminate active process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess terminate. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now let the termination continue and make sure all unwind blocks have finished" + Processor yield. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind7 (in category 'tests') ----- + testTerminationDuringNestedUnwind7 + "Terminate blocked process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 semaphore | + x1 := x2 := x3 := x4 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [semaphore wait] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind8 (in category 'tests') ----- + testTerminationDuringNestedUnwind8 + "Terminate blocked process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 semaphore | + x1 := x2 := x3 := x4 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + semaphore wait. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn1 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn1 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true. return value]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x3. + self deny: x2 & x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn2 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn2 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true. return value]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x3. + self deny: x2 & x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn3 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn3 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true. return value] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn4 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn4 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true. return value] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn5 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn5 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true. return value]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn6 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn6 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true. return value]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn7 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn7 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. return value. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn8 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn8 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. return value. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + p terminate. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! From commits at source.squeak.org Mon May 24 13:15:00 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 13:15:00 0000 Subject: [squeak-dev] The Inbox: ToolsTests-jar.105.mcz Message-ID: A new version of ToolsTests was added to project The Inbox: http://source.squeak.org/inbox/ToolsTests-jar.105.mcz ==================== Summary ==================== Name: ToolsTests-jar.105 Author: jar Time: 24 May 2021, 3:14:58.469073 pm UUID: d928e860-c443-7943-820b-8b74e3120013 Ancestors: ToolsTests-nice.104 Complement latest #terminate in the Inbox. Test unwind semantics for nested Unhandled errors aborted via debugger's Abandon (interpreted as terminate). =============== Diff against ToolsTests-nice.104 =============== Item was added: + ----- Method: DebuggerTests>>test19ProcessUnwindsAfterDebuggerClose (in category 'tests') ----- + test19ProcessUnwindsAfterDebuggerClose + "Closing a debugger on a suspended process means terminating that process." + + | x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + process := + [ + [ + [ ] ensure: [ + [self error: 'outer error'] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true + ] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and make sure all unwind blocks have finished" + self ensureDebugger. + debugger close. + + self assert: process isTerminated. + self assert: x1 & x2 & x3. + self deny: x4! Item was added: + ----- Method: DebuggerTests>>test20ProcessUnwindsAfterDebuggerClose (in category 'tests') ----- + test20ProcessUnwindsAfterDebuggerClose + "Closing a debugger on a suspended process means terminating that process." + + | x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + process := + [ + [ + [ ] ensure: [ + [] ensure: [ + self error: 'inner error'. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true + ] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and make sure all unwind blocks have finished" + self ensureDebugger. + debugger close. + + self assert: process isTerminated. + self assert: x1 & x2 & x3. + self deny: x4! Item was added: + ----- Method: DebuggerTests>>test21ProcessUnwindsAfterDebuggerClose (in category 'tests') ----- + test21ProcessUnwindsAfterDebuggerClose + "Closing a debugger on a suspended process means terminating that process." + + | x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + process := + [ + [ + [ ] ensure: [ + [self error: 'outer error'] ensure: [ + self error: 'inner error'. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true + ] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and let the unwind continue to the next error" + self ensureDebugger. + process := [debugger close] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and make sure all unwind blocks have finished" + self ensureDebugger. + debugger close. + + self assert: process isTerminated. + self assert: x1 & x2 & x3. + self deny: x4! Item was added: + ----- Method: DebuggerTests>>test22ProcessUnwindsAfterDebuggerClose (in category 'tests') ----- + test22ProcessUnwindsAfterDebuggerClose + "Closing a debugger on a suspended process means terminating that process." + + | x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + process := + [ + [ + [self error: 'outer error'] ensure: [ + [self error: 'middle error'] ensure: [ + self error: 'inner error'. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true + ] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and let the unwind continue to the next error" + self ensureDebugger. + process := [debugger close] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and let the unwind continue to the next error" + self ensureDebugger. + process := [debugger close] fork. + Processor yield. + + "make sure process is suspended and none of the unwind blocks has finished yet" + self assert: process isSuspended. + self deny: x1 | x2 | x3 | x4. + + "now find and close the debugger and make sure all unwind blocks have finished" + self ensureDebugger. + debugger close. + + self assert: process isTerminated. + self assert: x1 & x2 & x3. + self deny: x4! From commits at source.squeak.org Mon May 24 13:27:04 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 13:27:04 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1411.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1411.mcz ==================== Summary ==================== Name: Kernel-jar.1411 Author: jar Time: 24 May 2021, 3:26:59.344073 pm UUID: 10663cd1-f068-024f-a791-24209108196b Ancestors: Kernel-nice.1402 Supersede Kernel-jar.1409; latest changes: fix unwind when #ensure is top context, fix typo in isRecursive: setter. This is a "final" version. Complemented with tests: Tests-jar.465, ToolsTests-jar.105, KernelTests-jar.405 Please remove Kernel-jar.1409, Kernel-jar.1404, Kernel-jar.1410 and Tests-jar.448 from the Inbox. Summary and discussion of the bugs and changes in #terminate: http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposal-td5128285.html Recent changes: Clean-up, extract repeating code to a new method #complete:to: to improve readability, resolve MessageNotUnderstood and BlockCannotReturn recursion problem, update comments, support unwind from nested errors. Consistent with current ProcessTest >> #testNestedUnwind semantics for completing nested halfways-through unwind blocks during termination: x1 := x2 := x3 := nil. p:=[ [ [ ] ensure: [ "halfway through completion when suspended" [ ] ensure: [ "halfway through completion when suspended" Processor activeProcess suspend. "here the process gets terminated" x1 := true]. x2 := true] ] ensure: [ "not started yet when suspended" x3 := true] ] fork. Processor yield. p terminate self assert: x1 & x2 & x3. Discussion regarding a proposal to change the current semantics: http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html =============== Diff against Kernel-nice.1402 =============== Item was changed: Error subclass: #BlockCannotReturn + instanceVariableNames: 'result deadHome isRecursive' - instanceVariableNames: 'result deadHome' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'! !BlockCannotReturn commentStamp: '' prior: 0! This class is private to the EHS implementation. Its use allows for ensured execution to survive code such as: [self doThis. ^nil] ensure: [self doThat] Signaling or handling this exception is not recommended.! Item was added: + ----- Method: BlockCannotReturn>>isRecursive (in category 'accessing') ----- + isRecursive + + ^isRecursive ifNil: [false]! Item was added: + ----- Method: BlockCannotReturn>>isRecursive: (in category 'accessing') ----- + isRecursive: aBoolean + + isRecursive := aBoolean! Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [self cannotReturn: result to: self home sender. + [self cannotReturnRecursive: result to: self home sender. + self notify: '#cannotReturn: Invoking an infinite loop'. + true] whileTrue]. "loop back to prevent return and image crash when resumed" - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was added: + ----- Method: Context>>cannotReturnRecursive:to: (in category 'private-exceptions') ----- + cannotReturnRecursive: result to: homeContext + "The receiver tried to return result to homeContext that no longer exists. + This is a repeated invocation of the BlockCannotReturn error." + + ^BlockCannotReturn new + result: result; + deadHome: homeContext; + isRecursive: true; + signal! Item was added: + ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'private') ----- + runUnwindUntilErrorOrReturnFrom: aSender + "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." + "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." + + | error ctxt here topContext | + here := thisContext. + + "Insert ensure and exception handler contexts under aSender" + error := nil. + ctxt := aSender insertSender: (Context + contextOn: UnhandledError do: [:ex | + error ifNil: [ + error := ex exception. + topContext := thisContext. + here jump. + ex signalerContext restart "re-signal the error when jumped back"] + ifNotNil: [ex pass] + ]). + ctxt := ctxt insertSender: (Context + contextEnsure: [error ifNil: [ + topContext := thisContext. + here jump] + ]). + self jump. "Control jumps to self" + + "Control resumes here once above ensure block or exception handler is executed" + ^ error ifNil: [ + "No error was raised, remove ensure context by making its sender a top context" + topContext := ctxt sender push: nil. + {topContext. nil} + + ] ifNotNil: [ + "Error was raised, remove inserted above contexts then return signaler context" + aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" + {topContext. error} + ]! Item was added: + ----- Method: Process>>complete:to: (in category 'private') ----- + complete: topContext to: aContext + "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled + error is raised. Return self's new top context. Note: topContext must be a stack top context. + This method is meant to be called primarily by Process>>#terminate." + + | pair top error | + pair := Processor activeProcess + evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext] + onBehalfOf: self. + top := pair first. + error := pair second. + "If an error was detected jump back to the debugged process and re-signal the error; + some errors may require a special care - see a note below." + error ifNotNil: [ + error class == BlockCannotReturn and: [error isRecursive] and: [^top]. "do not jump back again" + error class == MessageNotUnderstood ifTrue: [error initialize]. "reset reachedDefaultHandler before jump" + top jump]. + ^top + + "Note: to prevent an infinite recursion of the MessageNotUnderstood error, reset reachedDefaultHandler before jumping back which will prevent #doesNotUnderstand: from resending the unknown message. + To prevent an infinite recursion of the BlockCannotReturn error, simply check its isRecursive variable whether it's a repeating invocation of the error."! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | oldList top ctxt outerMost newTop unwindBlock | + "If terminating the active process, suspend it first and terminate it as a suspended process." - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ - "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." - N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al - then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. + suspendedContext ifNil: [^self]. "self is already terminated" + "Release any method marked with the pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - suspendedContext ifNotNil: - ["Release any method marked with the pragma. - The argument is whether the process is runnable." - self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + top := suspendedContext. + suspendedContext := nil. "disable this process while running its stack in active process below" + "If terminating a process halfways through an unwind, try to complete that unwind block first; + if there are multiple such nested unwind blocks, try to complete the outer-most one; nested + unwind blocks will be completed in the process. Halfway-through blocks have already set the + complete variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true. + Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver + itself may be an unwind context." + ctxt := top. + ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. + [ctxt isNil] whileFalse: [ + (ctxt tempAt:2) ifNotNil: [ + outerMost := ctxt]. + ctxt := ctxt findNextUnwindContextUpTo: nil]. + outerMost ifNotNil: [newTop := self complete: top to: outerMost]. - "If terminating a process halfways through an unwind, try to complete that unwind block first; - if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner - blocks will be completed in the process." - ctxt := suspendedContext. - [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: - "Contexts under evaluation have already set their complete (tempAt: 2) to true." - [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. + "By now no halfway-through unwind blocks are on the stack. Create a new top context for each + pending unwind block (tempAt: 1) and execute it on the unwind block's stack. + Note: using #value instead of #complete:to: would lead to incorrect evaluation of non-local returns. + Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context." + ctxt := newTop ifNil: [top] ifNotNil: [newTop sender]. + ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. + [ctxt isNil] whileFalse: [ + (ctxt tempAt: 2) ifNil: [ + ctxt tempAt: 2 put: true. + unwindBlock := ctxt tempAt: 1. + top := unwindBlock asContextWithSender: ctxt. + self complete: top to: top]. + ctxt := ctxt findNextUnwindContextUpTo: nil]! - "Now all unwind blocks caught halfway through have been completed; - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. - ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. - [ctxt isNil] whileFalse: [ - (ctxt tempAt: 2) ifNil: [ - ctxt tempAt: 2 put: true. - unwindBlock := ctxt tempAt: 1. - "Create a context for the unwind block and execute it on the unwind block's stack. - Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing - the unwind on the wrong stack preventing the correct execution of non-local returns." - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Mon May 24 15:18:48 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 24 May 2021 10:18:48 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1621445932092-0.post@n4.nabble.com> References: <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> <1621445932092-0.post@n4.nabble.com> Message-ID: <1621869528589-0.post@n4.nabble.com> Hi all, there's one more "final" version (Kernel-jar.1411) of #terminate fixing unwind in a situation where #ensure is the top context when a process is terminated. More tests covering unwind from non-local returns, unwind from nested errors and a stress test #testTerminateInEnsure presented by Martin McClure at 2019 Smalltalk conference have been added: Tests-jar.465 ToolsTests-jar.105 KernelTests-jar.405 Finally managed to add debugger tests - thanks to Marcel and Christoph for inspiration! A patch from Kernel-jar.1410 solving catastrophic returns and infinite loops caused by BlockCannotReturn has been integrated here as well. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Mon May 24 21:02:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 21:02:42 0000 Subject: [squeak-dev] The Inbox: KernelTests-jar.406.mcz Message-ID: A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.406.mcz ==================== Summary ==================== Name: KernelTests-jar.406 Author: jar Time: 24 May 2021, 11:02:39.394885 pm UUID: 08657090-5a49-f84b-904f-8a37f5f2ec75 Ancestors: KernelTests-jar.405 Test a situation when a process terminating another process is terminated in the middle of the unwind. make sure both processes are unwound correctly. =============== Diff against KernelTests-jar.405 =============== Item was added: + ----- Method: ProcessTest>>testTerminateInTerminate (in category 'tests') ----- + testTerminateInTerminate + "Terminating a terminator process should unwind both the terminator and its terminatee process" + + | terminator terminatee unwound | + unwound := false. + terminatee := [[Processor activeProcess suspend] ensure: [unwound := true]] fork. + Processor yield. + terminator := [terminatee terminate] newProcess. + self assert: terminatee isSuspended. + self assert: terminator isSuspended. + terminator runUntil: [:ctx | ctx selectorToSendOrSelf = #suspend]. "first #suspend in #terminate" + self assert: terminator isSuspended. + terminator terminate. + self assert: terminator isTerminated. + self assert: unwound! From commits at source.squeak.org Mon May 24 21:06:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 24 May 2021 21:06:47 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1412.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1412.mcz ==================== Summary ==================== Name: Kernel-jar.1412 Author: jar Time: 24 May 2021, 11:06:42.045885 pm UUID: a5554c88-2df6-dc43-ad89-8b128c719dcd Ancestors: Kernel-jar.1411 Fix an issue when a process terminating another process is terminated in the middle of the unwind. As a result the original process won't finish unwinding and will leave either a suspended process or a chain of unfinished contexts behind (to be GC'd). This is an update of Kernel-jar.1411 (not replacement). Complemented by a test: KernelTests-jar.406 =============== Diff against Kernel-jar.1411 =============== Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." | oldList top ctxt outerMost newTop unwindBlock | "If terminating the active process, suspend it first and terminate it as a suspended process." self isActiveProcess ifTrue: [ [self terminate] fork. ^self suspend]. + [] ensure: [ "Always suspend the process first so it doesn't accidentally get woken up. N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al then the process is blocked, and if it is nil then the process is already suspended." oldList := self suspend. suspendedContext ifNil: [^self]. "self is already terminated" "Release any method marked with the pragma. The argument is whether the process is runnable." self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). top := suspendedContext. suspendedContext := nil. "disable this process while running its stack in active process below" "If terminating a process halfways through an unwind, try to complete that unwind block first; if there are multiple such nested unwind blocks, try to complete the outer-most one; nested unwind blocks will be completed in the process. Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining #ensure:/#ifCurtailed contexts from nil to true. Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver itself may be an unwind context." ctxt := top. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt:2) ifNotNil: [ outerMost := ctxt]. ctxt := ctxt findNextUnwindContextUpTo: nil]. outerMost ifNotNil: [newTop := self complete: top to: outerMost]. "By now no halfway-through unwind blocks are on the stack. Create a new top context for each pending unwind block (tempAt: 1) and execute it on the unwind block's stack. Note: using #value instead of #complete:to: would lead to incorrect evaluation of non-local returns. Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context." ctxt := newTop ifNil: [top] ifNotNil: [newTop sender]. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. top := unwindBlock asContextWithSender: ctxt. self complete: top to: top]. + ctxt := ctxt findNextUnwindContextUpTo: nil] + ]! - ctxt := ctxt findNextUnwindContextUpTo: nil]! From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 24 22:39:52 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 24 May 2021 22:39:52 +0000 Subject: [squeak-dev] [Sounds] How to turn off reverb Message-ID: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> Hi all, I never have dealt with the Sound system in Squeak before so here is a newbie question from my side: How can I turn off the reverb which you hear every time you play an FM sound? Take this example: AbstractSound dial: '#'. Either my speakers are broken or there is a reverb that is hidden somewhere in the implementation of FMSound. :-) I can also reproduce this when creating an FMSound manually without defining any envelopes. I also took a look at the ingenious Speech-TTS package from Squeak 3 and could hear a reverb there, too. Is this a bug? Is this a - maybe unfortunate - default setting? How can I turn off this? Thanks in advance! :-) Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Tue May 25 04:56:29 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Mon, 24 May 2021 21:56:29 -0700 Subject: [squeak-dev] [Sounds] How to turn off reverb In-Reply-To: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> References: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> Message-ID: Hi Christoph, you’ll find a class variable called (IIRC) Reverb or UseReverb or done such in ind of the sound classes. Use the MessageNames to track it down. _,,,^..^,,,_ (phone) > On May 24, 2021, at 3:40 PM, Thiede, Christoph wrote: > >  > Hi all, > > > > I never have dealt with the Sound system in Squeak before so here is a newbie question from my side: How can I turn off the reverb which you hear every time you play an FM sound? Take this example: > > > > AbstractSound dial: '#'. > > > > Either my speakers are broken or there is a reverb that is hidden somewhere in the implementation of FMSound. :-) I can also reproduce this when creating an FMSound manually without defining any envelopes. I also took a look at the ingenious Speech-TTS package from Squeak 3 and could hear a reverb there, too. Is this a bug? Is this a - maybe unfortunate - default setting? How can I turn off this? > > > > Thanks in advance! :-) > > > > Best, > > Christoph > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Tue May 25 17:38:54 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 25 May 2021 17:38:54 0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1771.mcz Message-ID: A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1771.mcz ==================== Summary ==================== Name: Morphic-ct.1771 Author: ct Time: 25 May 2021, 7:38:48.072683 pm UUID: 5a9ddaf0-a062-7047-b5b2-d2ae2da3fe15 Ancestors: Morphic-mt.1769 Fixes a bottleneck when opening a yellow button menu on a morph that contains a very large number of subsub*morphs. On not-so-fast systems, this can be reproduced using: self systemNavigation browseAllSelect: #notNil On faster systems, you might need to write a small toolbuilder application to reproduce the bottleneck. I have an app with >10k list items in my image which actually blocked the image for several seconds when I yellow-clicked the window. Fixed the problem without duplicating the logic of #allStringsAfter: by using a generator. =============== Diff against Morphic-mt.1769 =============== Item was changed: ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') ----- addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" Preferences noviceMode ifFalse: [aMenu addStayUpItem]. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" (self isWorldMorph or: [self mustBeBackmost or: [self wantsToBeTopmost]]) ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" Preferences noviceMode ifFalse: ["" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. + (Generator on: [:gen | self streamAllStringsAfter: nil on: gen]) in: [:gen | + "optimized!! #allStringsAfter: can be slow for large subtrees." + gen atEnd ifFalse: [ + aMenu add: 'copy text' translated action: #clipText]]. - (self allStringsAfter: nil) isEmpty - ifFalse: [aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" (Preferences noviceMode not and: [self isWorldMorph not]) ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! Item was changed: ----- Method: Morph>>allStringsAfter: (in category 'debug and other') ----- + allStringsAfter: aSubmorph - allStringsAfter: aSubmorph - "return an OrderedCollection of strings of text in my submorphs. If aSubmorph is non-nil, begin with that container." + ^ OrderedCollection streamContents: [:stream | + self streamAllStringsAfter: aSubmorph on: stream]! - | list ok | - list := OrderedCollection new. - ok := aSubmorph isNil. - self allMorphsDo: - [:sub | | string | - ok ifFalse: [ok := sub == aSubmorph]. "and do this one too" - ok - ifTrue: - [(string := sub userString) ifNotNil: - [string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]]. - ^list! Item was added: + ----- Method: Morph>>streamAllStringsAfter:on: (in category 'debug and other') ----- + streamAllStringsAfter: aSubmorph on: aStream + "Stream all strings of text in my submorphs on aStream. If aSubmorph is non-nil, begin with that container." + + | ok | + ok := aSubmorph isNil. + self allMorphsDo: [:sub | | string | + ok ifFalse: [ok := sub == aSubmorph]. + "and do this one too" + ok ifTrue: [ + (string := sub userString) + ifNotNil: [string isString + ifTrue: [aStream nextPut: string] + ifFalse: [aStream nextPutAll: string]]]].! From lecteur at zogotounga.net Tue May 25 17:42:33 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Tue, 25 May 2021 19:42:33 +0200 Subject: [squeak-dev] [Sounds] How to turn off reverb In-Reply-To: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> References: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> Message-ID: SoundPlayer stopReverb Stef From lecteur at zogotounga.net Tue May 25 17:50:17 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Tue, 25 May 2021 19:50:17 +0200 Subject: [squeak-dev] [Sounds] How to turn off reverb In-Reply-To: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> References: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> Message-ID: > Is this a - maybe unfortunate - default setting? The default reverb is indeed unfortunate IMO. It is hard-coded in SoundPlayer>>#startReverb In muO, I use a much lighter reverb (no reverb would make some FMSounds end badly): ReverbState := ReverbSound new tapDelays: #(1601 3469 7919) gains: #(0.012 0.007 0.001). Whatever the default, I guess it would be good to have it defined elsewhere. Stef From m at jaromir.net Tue May 25 19:51:59 2021 From: m at jaromir.net (Jaromir Matas) Date: Tue, 25 May 2021 14:51:59 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: References: <1620845299641-0.post@n4.nabble.com> Message-ID: <1621972319412-0.post@n4.nabble.com> Hi Nicolas, Christoph, Nicolas Cellier wrote > Simulating #aboutToReturn:through: did jump to first unwind context. But > this first unwind context was determined BEFORE the simulation #ensure: > has been inserted. This had the effect of skipping the simulation > machinery protection, and did result in a BlockCannotReturn > (cannotReturn:) error... > > This did prevent the debugger to correctly debug a protected block with > non local return like this: > > [^2] ensure: [Transcript cr; show: 'done']. What would you think about this approach: because #return:from: supplies the first unwind context for #aboutToReturn:through: prematurely, how about to supply nil instead of the first unwind context and let #resume:through: find the first unwind context at precisely the right time? I.e.: resume: value through: firstUnwindCtxt "Unwind thisContext to self and resume with value as result of last send. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext." | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: value to: self]. ----> ctxt := firstUnwindCtxt ifNil: [thisContext findNextUnwindContextUpTo: self]. [ctxt isNil] whileFalse: [(ctxt tempAt: 2) ifNil: [ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ctxt := ctxt findNextUnwindContextUpTo: self]. thisContext terminateTo: self. ^value The change is without any adverse effects and deals with all similar simulated non-local returns. Here's the modified #return:from: return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: -----> [^self send: #aboutToReturn:through: to: self with: {value. nil}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop What do you think? Would this be clean? ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From commits at source.squeak.org Tue May 25 23:07:34 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Tue, 25 May 2021 23:07:34 0000 Subject: [squeak-dev] The Trunk: Sound-eem.80.mcz Message-ID: Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.80.mcz ==================== Summary ==================== Name: Sound-eem.80 Author: eem Time: 25 May 2021, 4:07:32.508103 pm UUID: c65df365-47b5-4670-8ec6-411aac823b15 Ancestors: Sound-eem.79 Fix FFT>>plot:in: for an all-zero collection. =============== Diff against Sound-eem.79 =============== Item was changed: ----- Method: FFT>>plot:in: (in category 'testing') ----- plot: samples in: rect "Throw-away code just to check out a couple of examples" + | dx pen min max x divisor offset | - | dx pen min max x | Display fillWhite: rect; border: (rect expandBy: 2) width: 2. min := 1.0e30. max := -1.0e30. samples do: [:v | min := min min: v. max := max max: v]. + max = min + ifTrue: [divisor := rect height asFloat. + offset := rect height / 2.0] + ifFalse: [divisor := max - min. + offset := 0.0]. pen := Pen new. pen up. x := rect left. dx := rect width asFloat / samples size. samples do: [:v | | y | + y := (max - v) / divisor * rect height + offset. + pen goto: x asInteger @ (rect top + y asInteger); down. - y := (max-v) / (max-min) * rect height asFloat. - pen goto: x asInteger @ (rect top + y asInteger). - pen down. x := x + dx]. + max printString displayOn: Display at: (x + 2) @ (rect top - 9). + min printString displayOn: Display at: (x + 2) @ (rect bottom - 9)! - max printString displayOn: Display at: (x+2) @ (rect top-9). - min printString displayOn: Display at: (x+2) @ (rect bottom - 9)! From marcel.taeumel at hpi.de Wed May 26 07:25:53 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Wed, 26 May 2021 09:25:53 +0200 Subject: [squeak-dev] The Inbox: Morphic-ct.1771.mcz In-Reply-To: References: Message-ID: Hi Christoph. Thanks. I think that the expected pattern is a little bit different, though. The explicit use of Generator is unfortunate but can be easily avoided. :-) allStringsAfter: morph do: block    "..." allStringsAfter: morph    ^ Array streamContents: [:stream |       self allStringsAfter: morph do: [:string |          stream nextPut: string]] hasStringsAfter: morph    self allStringsAfter: morph do: [:string | ^ true].    ^ false Best, Marcel Am 25.05.2021 19:39:07 schrieb commits at source.squeak.org : A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1771.mcz ==================== Summary ==================== Name: Morphic-ct.1771 Author: ct Time: 25 May 2021, 7:38:48.072683 pm UUID: 5a9ddaf0-a062-7047-b5b2-d2ae2da3fe15 Ancestors: Morphic-mt.1769 Fixes a bottleneck when opening a yellow button menu on a morph that contains a very large number of subsub*morphs. On not-so-fast systems, this can be reproduced using: self systemNavigation browseAllSelect: #notNil On faster systems, you might need to write a small toolbuilder application to reproduce the bottleneck. I have an app with >10k list items in my image which actually blocked the image for several seconds when I yellow-clicked the window. Fixed the problem without duplicating the logic of #allStringsAfter: by using a generator. =============== Diff against Morphic-mt.1769 =============== Item was changed: ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') ----- addYellowButtonMenuItemsTo: aMenu event: evt "Populate aMenu with appropriate menu items for a yellow-button (context menu) click." aMenu defaultTarget: self. "" Preferences noviceMode ifFalse: [aMenu addStayUpItem]. "" self addModelYellowButtonItemsTo: aMenu event: evt. "" Preferences generalizedYellowButtonMenu ifFalse: [^ self]. "" aMenu addLine. aMenu add: 'inspect' translated action: #inspect. "" aMenu addLine. self world selectedObject == self ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] ifFalse: [aMenu add: 'select' translated action: #addHalo]. "" (self isWorldMorph or: [self mustBeBackmost or: [self wantsToBeTopmost]]) ifFalse: ["" aMenu addLine. aMenu add: 'send to back' translated action: #goBehind. aMenu add: 'bring to front' translated action: #comeToFront. self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. "" self isWorldMorph ifFalse: ["" Smalltalk at: #NCAAConnectorMorph ifPresent: [:connectorClass | aMenu addLine. aMenu add: 'connect to' translated action: #startWiring. aMenu addLine]. "" self isFullOnScreen ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. "" Preferences noviceMode ifFalse: ["" self addLayoutMenuItems: aMenu hand: evt hand. (owner notNil and: [owner isTextMorph]) ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]]. "" self isWorldMorph ifFalse: ["" aMenu addLine. self addToggleItemsToHaloMenu: aMenu]. "" aMenu addLine. self isWorldMorph ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. + (Generator on: [:gen | self streamAllStringsAfter: nil on: gen]) in: [:gen | + "optimized!! #allStringsAfter: can be slow for large subtrees." + gen atEnd ifFalse: [ + aMenu add: 'copy text' translated action: #clipText]]. - (self allStringsAfter: nil) isEmpty - ifFalse: [aMenu add: 'copy text' translated action: #clipText]. "" self addExportMenuItems: aMenu hand: evt hand. "" (Preferences noviceMode not and: [self isWorldMorph not]) ifTrue: ["" aMenu addLine. aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. "" self addCustomMenuItems: aMenu hand: evt hand! Item was changed: ----- Method: Morph>>allStringsAfter: (in category 'debug and other') ----- + allStringsAfter: aSubmorph - allStringsAfter: aSubmorph - "return an OrderedCollection of strings of text in my submorphs. If aSubmorph is non-nil, begin with that container." + ^ OrderedCollection streamContents: [:stream | + self streamAllStringsAfter: aSubmorph on: stream]! - | list ok | - list := OrderedCollection new. - ok := aSubmorph isNil. - self allMorphsDo: - [:sub | | string | - ok ifFalse: [ok := sub == aSubmorph]. "and do this one too" - ok - ifTrue: - [(string := sub userString) ifNotNil: - [string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]]. - ^list! Item was added: + ----- Method: Morph>>streamAllStringsAfter:on: (in category 'debug and other') ----- + streamAllStringsAfter: aSubmorph on: aStream + "Stream all strings of text in my submorphs on aStream. If aSubmorph is non-nil, begin with that container." + + | ok | + ok := aSubmorph isNil. + self allMorphsDo: [:sub | | string | + ok ifFalse: [ok := sub == aSubmorph]. + "and do this one too" + ok ifTrue: [ + (string := sub userString) + ifNotNil: [string isString + ifTrue: [aStream nextPut: string] + ifFalse: [aStream nextPutAll: string]]]].! -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Wed May 26 09:37:12 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 09:37:12 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.169.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.169.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.169 Author: mt Time: 26 May 2021, 11:37:11.537346 am UUID: cb1e1e46-ba82-ab45-b4da-779d840cb050 Ancestors: FFI-Kernel-mt.168 Fix #copy in ExternalData to always copy. Provide #assureLocal for that other scenario. =============== Diff against FFI-Kernel-mt.168 =============== Item was added: + ----- Method: ExternalData>>assureLocal (in category 'copying') ----- + assureLocal + + ^ handle isExternalAddress + ifTrue: [self copy] + ifFalse: [self]! Item was changed: ----- Method: ExternalData>>ffiEqual: (in category 'comparing') ----- ffiEqual: other "WARNING!! EXPENSIVE!! We can compare bytes if the types are compatible." (self ffiIdentical: other) ifTrue: [^ true]. self flag: #todo. "mt: Which types are actually compatible? :-)" self externalType asNonPointerType = other externalType asNonPointerType ifFalse: [^ false]. self flag: #todo. "mt: Follow pointers? Detect cycles? Hmmm... :-) See #free as inspiration." + ^ self assureLocal getHandle ffiEqual: other assureLocal getHandle! - ^ self copy getHandle ffiEqual: other copy getHandle! Item was changed: ----- Method: ExternalData>>ffiEqualityHash (in category 'comparing') ----- ffiEqualityHash "WARNING!! EXPENSIVE!!" self ffiIdentityHash + bitXor: self assureLocal getHandle hash! - bitXor: self copy getHandle hash! Item was changed: ----- Method: ExternalData>>postCopy (in category 'copying') ----- postCopy + "Reads all bytes from external into object memory or duplicate the array within object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it." - "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory." | bytes | - handle isExternalAddress ifFalse: [^ self]. self sizeCheck. bytes := ByteArray new: self byteSize. 1 to: bytes size do: [:index | bytes basicAt: index put: (handle unsignedByteAt: index)]. handle := bytes. self setType: type. "Change container type from pointer to non-pointer type."! From commits at source.squeak.org Wed May 26 09:38:32 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 09:38:32 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.48.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.48.mcz ==================== Summary ==================== Name: FFI-Tests-mt.48 Author: mt Time: 26 May 2021, 11:38:32.557346 am UUID: 3abd90ac-f78e-b542-9442-2942594cc738 Ancestors: FFI-Tests-mt.47 Complements FFI-Kernel-mt.169 (and FFI-Examples-mt.8). =============== Diff against FFI-Tests-mt.47 =============== Item was added: + ----- Method: FFIAllocateExternalTests>>test21ArrayAssureLocal (in category 'tests - array') ----- + test21ArrayAssureLocal + "Copy the array into local (object) memory." + + | original copy | + original := self allocate: ExternalType int32_t size: 5. + copy := original assureLocal. + self deny: original == copy. + self assert: copy assureLocal identical: copy.! Item was added: + ----- Method: FFIAllocateTests>>test20ArrayCopy (in category 'tests - array') ----- + test20ArrayCopy + "Copy the array into a new array." + + | original firstCopy secondCopy | + original := self allocate: ExternalType int32_t size: 5. + firstCopy := original copy. + secondCopy := firstCopy copy. + + firstCopy withIndexDo: [:num :index | firstCopy at: index put: index]. + self assert: #(0 0 0 0 0) equals: (original collect: #yourself). + self assert: #(1 2 3 4 5) equals: (firstCopy collect: #yourself). + self assert: #(0 0 0 0 0) equals: (secondCopy collect: #yourself). + + secondCopy withIndexDo: [:num :index | secondCopy at: index put: index+1]. + self assert: #(0 0 0 0 0) equals: (original collect: #yourself). + self assert: #(1 2 3 4 5) equals: (firstCopy collect: #yourself). + self assert: #(2 3 4 5 6) equals: (secondCopy collect: #yourself). + ! Item was added: + ----- Method: FFIAllocateTests>>test21ArrayAssureLocal (in category 'tests - array') ----- + test21ArrayAssureLocal + "Copy the array into local (object) memory." + + | original copy | + original := self allocate: ExternalType int32_t size: 5. + copy := original assureLocal. + self assert: original identical: copy.! Item was added: + ExternalStructure subclass: #X64TestStruct + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: X64TestStruct class>>fields (in category 'field definition') ----- + fields + "X64TestStruct defineFields" + ^#( + (one 'longlong') + (two 'double') + (three 'longlong') + (four 'double') + (five 'longlong') + (six 'double') + (seven 'longlong') + (eight 'double') + (nine 'longlong') + (ten 'double') + (eleven 'longlong') + (twelve 'double') + (thirteen 'longlong') + (fourteen 'double') + (fifteen 'longlong') + (sixteen 'double') + )! Item was added: + ExternalStructure subclass: #X64TestStruct2 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: X64TestStruct2 class>>fields (in category 'field definition') ----- + fields + "X64TestStruct2 defineFields" + ^#( + (one #X64TestStruct) + (two #X64TestStruct) + )! Item was added: + ExternalStructure subclass: #X64TestStruct3 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: X64TestStruct3 class>>fields (in category 'field definition') ----- + fields + "X64TestStruct3 defineFields" + ^#( + (one 'longlong') + (two 'double') + (three 'longlong') + (four 'double') + (five 'longlong') + (six 'double') + (seven 'longlong') + (eight 'double') + (nine 'longlong') + (ten 'double') + (eleven 'longlong') + (twelve 'double') + (thirteen 'longlong') + (fourteen 'double') + (fifteen 'longlong') + (sixteen 'double') + (seventeen #X64TestStruct) + (eighteen #X64TestStruct2) + (nineteen 'X64TestStruct*') + (twenty 'X64TestStruct2*') + )! From commits at source.squeak.org Wed May 26 13:28:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 13:28:49 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.170.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.170.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.170 Author: mt Time: 26 May 2021, 3:28:49.060346 pm UUID: 9cc52c33-866f-d44a-972c-af0d84acfcc3 Ancestors: FFI-Kernel-mt.169 More flexible parsing of external types in signatures. Skip commas and 'const' when parsing external types. Allow name-by-token in signatures to avoid those extra string quotation characters. Fixes bug that occurred during parsing array types with unknown size, i.e. char[]. =============== Diff against FFI-Kernel-mt.169 =============== Item was changed: ----- Method: Parser>>callback (in category '*FFI-Kernel') ----- callback | descriptorClass retType externalName args argType | descriptorClass := ExternalFunction. "Parse return type" self advance. - here = 'const' ifTrue: [self advance]. retType := self externalType: descriptorClass. retType == nil ifTrue:[^self expected:'return type']. "Parse function name or index" externalName := here. (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. args := WriteStream on: Array new. [self match: #rightParenthesis] whileFalse:[ - here = 'const' ifTrue: [self advance]. - here = ',' ifTrue: [self advance]. argType := self externalType: descriptorClass. argType == nil ifTrue:[^self expected:'argument']. argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). ^true! Item was changed: ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Kernel') ----- externalFunctionDeclaration "Parse the function declaration for a call to an external library. (1) Create an instance of ExternalLibraryFunction and install it as first literal. (2) Add a pragma to primitive call 120. " | descriptorClass callType modifier retType externalName args argType module fn | descriptorClass := cue environment valueOf: #ExternalFunction ifAbsent: [^ false]. callType := descriptorClass callingConventionFor: here. callType == nil ifTrue:[^false]. [modifier := descriptorClass callingConventionModifierFor: token. modifier notNil] whileTrue: [self advance. callType := callType bitOr: modifier]. "Parse return type" self advance. retType := self externalType: descriptorClass. retType == nil ifTrue:[^self expected:'return type']. "Parse function name or index" externalName := here. + (self match: #number) + ifFalse: [ "Consume all tokens as function name" + self advance. + externalName := externalName asSymbol]. - (self match: #string) - ifTrue:[externalName := externalName asSymbol] - ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']]. (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. args := WriteStream on: Array new. [self match: #rightParenthesis] whileFalse:[ argType := self externalType: descriptorClass. argType == nil ifTrue:[^self expected:'argument']. argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. (self matchToken: 'module:') ifTrue:[ module := here. (self match: #string) ifFalse:[^self expected: 'String']. module := module asSymbol]. Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| fn := xfn name: externalName module: module callType: callType returnType: retType argumentTypes: args contents. self allocateLiteral: fn. fn beWritableObject. "Undo the read-only setting in litIndex:"]. (self matchToken: 'error:') ifTrue: [| errorCodeVariable | errorCodeVariable := here. (hereType == #string or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. self advance. self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] ifFalse: [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. ^true! Item was changed: ----- Method: Parser>>externalType: (in category '*FFI-Kernel') ----- externalType: descriptorClass + "Parse and return an external type. Ignore leading comma and 'const'." + + | xType typeName isArrayType tokenString | + self matchToken: ','. + self matchToken: 'const'. - "Parse and return an external type" - | xType typeName isArrayType | typeName := here. "Note that pointer token is not yet parsed!!" self advance. (isArrayType := self matchToken: $[) ifTrue: [ + (self matchToken: $]) + ifTrue: [typeName := typeName, '[]'] + ifFalse: [ + typeName := typeName, '[', here, ']'. + self advance. + (self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]]. - typeName := typeName, '[', here, ']'. - self advance. - self matchToken: $]]. (xType := descriptorClass typeNamed: typeName) ifNil: [ "Raise an error if user is there" self interactive ifTrue: [^nil]. "otherwise go over it silently -- use an unknown struct type" xType := descriptorClass newTypeNamed: typeName]. isArrayType ifTrue: [ - self flag: #todo. "mt: We must send arrays as pointers." xType := xType asPointerType]. + self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token." + tokenString := here asString. + ^ (tokenString first == $*) + ifTrue: [self advance. xType asPointerType] + ifFalse:[(tokenString beginsWith: '**') + ifTrue: [self advance. xType asPointerToPointerType] - ^ (self matchToken: #*) - ifTrue:[xType asPointerType] - ifFalse:[(self matchToken: #**) - ifTrue: [xType asPointerToPointerType] ifFalse: [xType]]! From commits at source.squeak.org Wed May 26 13:29:21 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 13:29:21 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.49.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.49.mcz ==================== Summary ==================== Name: FFI-Tests-mt.49 Author: mt Time: 26 May 2021, 3:29:21.849346 pm UUID: 9502c26d-eff5-4641-98ad-d3ee650f08ba Ancestors: FFI-Tests-mt.48 Complements FFI-Kernel-mt.170 =============== Diff against FFI-Tests-mt.48 =============== Item was changed: ----- Method: FFIAllocateTests>>tearDown (in category 'running') ----- tearDown externalObjects do: [:externalObject | externalObjects isExternalObject "i.e. not a RawBitsArray" ifTrue: [ externalObject free. + self checkFree: externalObject]]. + super tearDown.! - self checkFree: externalObject]].! Item was added: + ----- Method: FFITestLibrary class>>ffiTestDecoration (in category 'experiments') ----- + ffiTestDecoration + "Just a mock. Commas and 'const' should be ignored while parsing the signature." + + + ^ self externalCallFailed ! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFunctionByIndex (in category 'experiments') ----- + ffiTestFunctionByIndex + "Just a mock. Functions can be specified by index." + + + ^ self externalCallFailed ! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFunctionByString (in category 'experiments') ----- + ffiTestFunctionByString + "Just a mock. Functions can be specified by string." + + + ^ self externalCallFailed ! Item was added: + ----- Method: FFITestLibrary class>>ffiTestFunctionByToken (in category 'experiments') ----- + ffiTestFunctionByToken + "Just a mock. Functions can be specified by token." + + + ^ self externalCallFailed ! From commits at source.squeak.org Wed May 26 13:32:10 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 13:32:10 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.36.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.36.mcz ==================== Summary ==================== Name: FFI-Tools-mt.36 Author: mt Time: 26 May 2021, 3:32:10.751346 pm UUID: 8e4974c2-b56b-ce43-835a-63b50d879ece Ancestors: FFI-Tools-mt.35 Complements FFI-Kernel-mt.170. Simplifies Shout styling by re-using standard range-types such as #pragmaKeyword and #comment. No need for #externalFunctionCallingConvention or #module. Even #externalCallTypePointerIndicator might not be necessary. Yet, #externalCallType seems to be a useful range type, though. =============== Diff against FFI-Tools-mt.35 =============== Item was changed: ----- Method: SHParserST80>>callback (in category '*FFI-Tools') ----- callback + self scanPast: #pragmaKeyword. + self failUnless: currentToken notNil. - self scanPast: #externalFunctionCallingConvention. + "1) Return type" + currentToken = 'const' + ifTrue: [self scanPast: #comment]. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]. + "2) Placeholder for function pointer" + currentTokenFirst == $( ifFalse: [^ self fail]. self scanPast: #string. + currentTokenFirst == $* ifFalse: [^ self fail]. self scanPast: #string. + currentTokenFirst == $) ifFalse: [^ self fail]. self scanPast: #string. + + "3) Argument types" - currentTokenFirst == $( ifFalse: [^ self fail]. self scanNext. - currentTokenFirst == $* ifFalse: [^ self fail]. self scanNext. - currentTokenFirst == $) ifFalse: [^ self fail]. self scanNext. - self failUnless: currentTokenFirst == $(. self scanPast: #leftParenthesis. [currentTokenFirst ~= $)] whileTrue: [ self failUnless: currentToken notNil. + currentToken = 'const' + ifTrue: [self scanPast: #comment] + ifFalse: [self scanPast: #externalCallType]. - self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]]. self scanPast: #rightParenthesis. + - currentToken = 'module:' - ifTrue: [ - self scanPast: #module. - self parseStringOrSymbol ]. - currentToken = 'error:' ifTrue: [ - self scanPast: #primitive. "there's no rangeType for error" - self currentTokenType == #name - ifTrue: [ self parseTemporary: #patternTempVar ] - ifFalse: [ self parseStringOrSymbol ] ]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! Item was changed: ----- Method: SHParserST80>>parseExternalCall (in category '*FFI-Tools') ----- parseExternalCall + "0) First keyword of pragma e.g., " + self addRangeType: #pragmaKeyword. + + "1) Call flags such as 'threaded' " - self addRangeType: #externalFunctionCallingConvention. - [self scanNext. ((Smalltalk at: #ExternalFunction) callingConventionModifierFor: currentToken) notNil] whileTrue. + + "2) Return type" self failUnless: currentToken notNil. + currentToken = 'const' + ifTrue: [self scanPast: #comment]. self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]. currentToken = '[' ifTrue: ["array types return" self scanPast: #externalCallType. [currentTokenFirst ~= $]] whileTrue: [ self failUnless: currentTokenFirst isDigit. self scanPast: #externalCallType]. self scanPast: #externalCallType]. + + "3) Function name or index" currentTokenFirst isDigit + ifTrue: [self scanPast: #string] + ifFalse: [currentTokenFirst == $' + ifTrue: [self parseString] + ifFalse: [self scanPast: #string]]. + + "4) Argument types" - ifTrue: [self scanPast: #integer] - ifFalse: [ - self failUnless: currentTokenFirst == $'. - self parseString]. self failUnless: currentTokenFirst == $(. self scanPast: #leftParenthesis. [currentTokenFirst ~= $)] whileTrue: [ self failUnless: currentToken notNil. + currentToken = 'const' + ifTrue: [self scanPast: #comment] + ifFalse: [self scanPast: #externalCallType]. - self scanPast: #externalCallType. currentToken = '*' ifTrue: [self scanPast: #externalCallTypePointerIndicator]]. self scanPast: #rightParenthesis. + + "5) Module name" currentToken = 'module:' ifTrue: [ + self scanPast: #pragmaKeyword. - self scanPast: #module. self parseStringOrSymbol ]. + + "6) Error code" currentToken = 'error:' ifTrue: [ + self scanPast: #pragmaKeyword. - self scanPast: #primitive. "there's no rangeType for error" self currentTokenType == #name ifTrue: [ self parseTemporary: #patternTempVar ] ifFalse: [ self parseStringOrSymbol ] ]. self failUnless: currentToken = '>'. self scanPast: #primitiveOrExternalCallEnd! From commits at source.squeak.org Wed May 26 16:14:48 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:14:48 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.171.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.171.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.171 Author: mt Time: 26 May 2021, 6:14:47.506788 pm UUID: 6d230712-f208-ee49-a387-8a075d9f8732 Ancestors: FFI-Kernel-mt.170 Adds (parts of the) C standard library to be used in examples and tests. Includes a rough guess for the module name across the major platforms. See #guessModuleName. Includes unix-specific #LibC as a synonym for #CStandardLibrary --- which might have to be discussed at some point. Adds functionality check for the C standard library at image start-up time. Makes this check and the FFI check optional through preferences, which are enabled by default. Fixes ExternalData to support #hasEqualElements:, which depends on #isSequenceable, which ExternalData arguably is because of #at:(put:). =============== Diff against FFI-Kernel-mt.170 =============== Item was added: + ExternalLibrary subclass: #CStandardLibrary + instanceVariableNames: '' + classVariableNames: 'ModuleName' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !CStandardLibrary commentStamp: 'mt 5/26/2021 10:08' prior: 0! + The ISO C standard library, also known as "CRT" and "libc." + + Further reading: + https://www.gnu.org/software/libc/ + https://docs.microsoft.com/en-us/cpp/c-runtime-library + https://www.cplusplus.com/reference/clibrary/ + https://www.iso.org/standard/82075.html! Item was added: + ----- Method: CStandardLibrary class>>guessModuleName (in category 'preferences') ----- + guessModuleName + "The the platform's module name for the C library." + + | platform | + platform := FFIPlatformDescription current. + + platform isMacOS ifTrue: [ + ^ platform osVersionMajor >= 11 "Big Sur and beyond" + ifTrue:['libSystem.dylib'] + ifFalse: [platform osVersionMajor >= 10 + ifFalse: ['libc.dylib' "Mac OS 9"] + ifTrue: [platform osVersionMinor >= 7 "at least OS X 10.7 (Lion)" + ifTrue: ['libobjc.dylib'] + ifFalse: [platform osVersionMinor >= 5 "at least Mac OS X 10.5 (Leopard)" + ifTrue: ['libgcc_s.1.dylib'] + ifFalse: ['libc.dylib']]]]]. + + platform isWindows ifTrue: [ + ^ 'msvcrt.dll']. + + platform isUnix ifTrue: [ + ^ platform osVersion = 'linux-gnu' + ifTrue: ['libc.so.6'] + ifFalse: ['libc.so']]. + + ^ nil! Item was added: + ----- Method: CStandardLibrary class>>moduleName (in category 'preferences') ----- + moduleName + + ^ ModuleName ifNil: [self guessModuleName]! Item was added: + ----- Method: CStandardLibrary class>>moduleName: (in category 'preferences') ----- + moduleName: nameOrNil + + ModuleName := nameOrNil = String empty ifFalse: [nameOrNil]. + self clearAllCaches. + + "Check the provided name only if overwritten by clients. See #guessModuleName and FFIPlatformDescription class>> #startUp:." + ModuleName ifNotNil: [FFIPlatformDescription checkCStandardLibrary].! Item was added: + ----- Method: CStandardLibrary class>>resetDefault (in category 'instance creation') ----- + resetDefault + "Overwritten to release all function handles." + + super resetDefault. + CStandardLibrary methodsDo: [:m | m externalLibraryName: nil].! Item was added: + ----- Method: CStandardLibrary>>abs: (in category 'stdlib.h - integer arithmetics') ----- + abs: n + "Returns the absolute value of parameter n" + + + ^ self externalCallFailed ! Item was added: + ----- Method: CStandardLibrary>>bsearch:with:with:with:with: (in category 'stdlib.h - searching and sorting') ----- + bsearch: key with: base with: num with: size with: compar + + + ^ self externalCallFailed ! Item was added: + ----- Method: CStandardLibrary>>qsort:with:with:with: (in category 'stdlib.h - searching and sorting') ----- + qsort: base with: num with: size with: compar + + + ^ self externalCallFailed ! Item was added: + ----- Method: ExternalData>>isSequenceable (in category 'testing') ----- + isSequenceable + "The receiver implements #at: and #at:put:." + + ^ true! Item was changed: Object subclass: #FFIPlatformDescription instanceVariableNames: 'name osVersion subtype wordSize endianness' + classVariableNames: 'CheckCStandardLibraryOnStartUp CheckFFIOnStartUp LastPlatform' - classVariableNames: 'LastPlatform' poolDictionaries: '' category: 'FFI-Kernel-Support'! !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0! This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions). 1. DETECT PLATFORM CHANGE ON STARTUP This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType. 2. PLATFORM SPECIFICITY Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are: platform name > osVersion > subtype > wordSize So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize. 3. PLATFORM COMPATIBILITY Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible. Here is an interesting edge case of two compatible platform descriptions: | p1 p2 | p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil. p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8. p1 isCompatibleWith: p2. Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools. 4. FURTHER READING - all references to FFIPlatformDescription - all senders of #wordSize - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject ! Item was added: + ----- Method: FFIPlatformDescription class>>checkCStandardLibrary (in category 'system startup') ----- + checkCStandardLibrary + "Try to use C Standard Library. Warn if not possible." + + [ [self assert: [(CStandardLibrary default abs: -5) = 5] + ] ifError: [:msg | + self notify: 'C standard library not available. Please check module name in preferences.', String cr, String cr, msg] + ] fork. "Do not interrupt the startup list."! Item was added: + ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp (in category 'preferences') ----- + checkCStandardLibraryOnStartUp + + ^ CheckCStandardLibraryOnStartUp ifNil: [true]! Item was added: + ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp: (in category 'preferences') ----- + checkCStandardLibraryOnStartUp: aBoolean + + CheckCStandardLibraryOnStartUp := aBoolean.! Item was added: + ----- Method: FFIPlatformDescription class>>checkFFIOnStartUp (in category 'preferences') ----- + checkFFIOnStartUp + + ^ CheckFFIOnStartUp ifNil: [true]! Item was added: + ----- Method: FFIPlatformDescription class>>checkFFIOnStartUp: (in category 'preferences') ----- + checkFFIOnStartUp: aBoolean + + CheckFFIOnStartUp := aBoolean.! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull. ExternalType cleanupUnusedTypes ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." { ExternalAddress. ExternalType. ExternalStructure. ExternalPool } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]]. + self checkFFIOnStartUp ifTrue: [self checkFFI]. + self checkCStandardLibraryOnStartUp ifTrue: [self checkCStandardLibrary]].! - self checkFFI].! Item was added: + ----- Method: FFIPlatformDescription>>isMacOS (in category 'testing') ----- + isMacOS + + ^ self name = 'Mac OS'! Item was added: + ----- Method: FFIPlatformDescription>>osVersionBuild (in category 'accessing') ----- + osVersionBuild + "Answers the build version number for the platform. Only defined for macOS and Windows platforms. Usually 0 on Windows platforms." + + ^ (self osVersion findTokens: $.) second! Item was added: + ----- Method: FFIPlatformDescription>>osVersionMajor (in category 'accessing') ----- + osVersionMajor + "Answers the major version number for the platform. Only defined for macOS and Windows platforms." + + | token | + token := (self osVersion findTokens: $.) first. + self isMacOS + ifTrue: [ "e.g. Mac OS 90.3 92.2 109.1 1015.2 1100.0" + ^ ((token beginsWith: '9') + ifTrue: [token first] + ifFalse: [token first: 2]) asInteger]. + ^ token asInteger "e.g. Windows 10.0"! Item was added: + ----- Method: FFIPlatformDescription>>osVersionMinor (in category 'accessing') ----- + osVersionMinor + "Answers the minor version number for the platform. Only defined for macOS." + + | token | + token := (self osVersion findTokens: $.) first. + self isMacOS + ifTrue: [ "e.g. 90.3 92.2 109.1 1015.2 1100.0" + ^ ((token beginsWith: '9') + ifTrue: [token allButFirst: 1] + ifFalse: [token allButFirst: 2]) asInteger]. + ^ nil! Item was added: + CStandardLibrary subclass: #LibC + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel-Support'! + + !LibC commentStamp: 'mt 5/26/2021 10:09' prior: 0! + Just a synonym for convenient reference.! From commits at source.squeak.org Wed May 26 16:18:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:18:08 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.19.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.19.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.19 Author: mt Time: 26 May 2021, 6:18:08.303788 pm UUID: 07f5dc26-d1f1-6549-932e-42693011e920 Ancestors: FFI-Callbacks-mt.18 Adds callback-convenience for bsearch and qsort, which also serve as commentary and examples for other callbacks. Complements FFI-Kernel-mt.171. Moves qsort examples to new FFI-CallbacksTests package. =============== Diff against FFI-Callbacks-mt.18 =============== Item was added: + ----- Method: BlockClosure>>signature: (in category '*FFI-Callbacks') ----- + signature: signature + + ^ FFICallback + signature: signature + block: self! Item was added: + ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') ----- + bsearch: key in: array compare: block + + | result | + result := self + bsearch: key + with: array + with: array size + with: array contentType byteSize + with: (self compare: array contentType through: block) thunk. + result + setContentType: array contentType; + setSize: 1. + ^ result! Item was added: + ----- Method: CStandardLibrary>>compare:through: (in category '*FFI-Callbacks') ----- + compare: contentType through: evaluable + "Answers a callback for comparing the given contentType through the given evaluable, i.e., messages sends or blocks. Supports pointer types as contentType." + + + + | argType signature | + self assert: [evaluable numArgs = 2]. + + argType := contentType isPointerType + ifTrue: [(contentType asArrayType: nil)] + ifFalse: [contentType]. + + signature := ((thisContext method pragmaAt: #callback:) argumentAt: 1) copy. + signature at: 2 put: argType asPointerType. + signature at: 3 put: argType asPointerType. + + ^ evaluable signature: signature! Item was added: + ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') ----- + qsort: array compare: block + + ^ self + qsort: array + with: array size + with: array contentType byteSize + with: (self compare: array contentType through: block) thunk! Item was removed: - ----- Method: FFICallback class>>cdeclQsort:with:with:with: (in category 'examples') ----- - cdeclQsort: values with: number with: width with: callback - - - ^ self externalCallFailed! Item was removed: - ----- Method: FFICallback class>>exampleCqsort01 (in category 'examples') ----- - exampleCqsort01 - "Call the libc qsort function (which requires a callback)." - "FFICallback exampleCqsort01" - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type cb rand nElements values orig sort libcName knownLibcNames fn | - - knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll'). - libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'. - libcName = 0 ifTrue: [^ self]. - libcName := knownLibcNames at: libcName. - - rand := Random new. - type := ExternalType double. - nElements := 10. - values := type allocateExternal: nElements. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - "Fetch a local copy of the external data." - orig := values copy. - - "Construct the callback structure." - cb := FFICallback - signature: '' - "signature: #(int 'double*' 'double*')" - block: [ :arg1 :arg2 | - | a b | - a := arg1. - b := arg2. - (a - b) sign]. - - "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );" - fn := ExternalLibraryFunction - name: 'qsort' module: libcName - callType: ExternalLibraryFunction callTypeCDecl - returnType: ExternalType void - argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). - - "Invoke!!" - fn - invokeWith: values "getHandle" - with: nElements - with: type byteSize - with: cb thunk "getHandle". - - sort := values collect: [:each | each]. - values free. - ^orig -> sort! Item was removed: - ----- Method: FFICallback class>>exampleCqsort02 (in category 'examples') ----- - exampleCqsort02 - "Call the libc qsort function (which requires a callback)." - " - FFICallback exampleCqsort02 - " - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type rand nElements sizeofDouble values orig sort | - - rand := Random new. - type := ExternalType double. - sizeofDouble := type byteSize. - nElements := 10. - values := type allocateExternal: nElements. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - - "Fetch a local copy of the external data." - orig := values copy. - - "Invoke!!" - self - qsort: values with: values size with: values contentType byteSize - with: [ :arg1 :arg2 | - | a b | - a := arg1. - b := arg2. - (a - b) sign]. - - sort := values copy. - values free. - ^orig -> sort! Item was removed: - ----- Method: FFICallback class>>exampleCqsort03 (in category 'examples') ----- - exampleCqsort03 - "Call the libc qsort function (which requires a callback)." - " - FFICallback exampleCqsort03 - " - "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0" - - | type rand nElements values orig sort cb | - - rand := Random new. - type := ExternalType double. - nElements := 10. - values := type allocateExternal: nElements. - "Initialize external data and set size for enumeration." - 1 to: nElements do: [:i| values at: i put: rand next]. - - "Fetch a local copy of the external data." - orig := values copy. - - "Construct the callback structure." - cb := FFICallback - signature: '' - "signature: #(int 'double*' 'double*')" - block: [ :arg1 :arg2 | - | a b | - a := arg1. - b := arg2. - (a - b) sign]. - - - "Invoke!!" - self - cdeclQsort: values with: values size with: values contentType byteSize - with: cb thunk. - - sort := values collect: [:each | each]. - values free. - ^orig -> sort! Item was removed: - ----- Method: FFICallback class>>exampleCqsort04 (in category 'examples') ----- - exampleCqsort04 - " - FFICallback exampleCqsort04 - " - - | type in out fn cb | - type := ExternalType int32_t. - in := type allocateExternal: 10. - 1 to: in size do: [:each | - in at: each put: 100 atRandom]. - - cb := FFICallback - signature: '' - "signature: #(int 'double*' 'double*')" - block: [ :arg1 :arg2 | - | a b | - a := arg1. - b := arg2. - (a - b) sign]. - - fn := ExternalLibraryFunction - name: 'qsort' module: 'msvcrt.dll' - callType: ExternalLibraryFunction callTypeCDecl - returnType: ExternalType void - argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')). - - "Invoke!!" - [fn - invokeWith: in "getHandle" - with: in size - with: in contentType byteSize - with: cb thunk "getHandle"] - ifCurtailed: [in free]. - - out := in copy. - in free. - ^ out! Item was removed: - ----- Method: FFICallback class>>qsort:with:with:with: (in category 'examples') ----- - qsort: values with: number with: width with: block - "Indirection to define the signature for the provided block." - - - | callback | - callback := FFICallback - signature: ((thisContext method pragmaAt: #callback:) argumentAt: 1) - block: block. - - ^ self cdeclQsort: values with: number with: width with: callback thunk! From commits at source.squeak.org Wed May 26 16:19:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:19:46 0000 Subject: [squeak-dev] FFI: FFI-Tools-mt.37.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.37.mcz ==================== Summary ==================== Name: FFI-Tools-mt.37 Author: mt Time: 26 May 2021, 6:19:46.160788 pm UUID: 5465025e-bcf2-9546-8bc9-f70d9f588e50 Ancestors: FFI-Tools-mt.36 Minor fix for object explorer, which affects closing the tool on a local array of null-pointers such as "ExternalType int32_t asPointerType allocate: 10". =============== Diff against FFI-Tools-mt.36 =============== Item was changed: ----- Method: ExternalData>>explorerOkToClose (in category '*FFI-Tools') ----- explorerOkToClose "Overwritten to also check by content type. That is, a byte array full of pointers is also managed here." + ^ ((handle isExternalAddress and: [self isNull not]) or: [ + self contentType isPointerType and: [self anySatisfy: [:ea | ea isNull not]]]) - ^ ((handle isExternalAddress or: [self contentType isPointerType]) - and: [self isNull not]) ifTrue: [self confirmFree] ifFalse: [true]! From commits at source.squeak.org Wed May 26 16:20:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:20:42 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.50.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.50.mcz ==================== Summary ==================== Name: FFI-Tests-mt.50 Author: mt Time: 26 May 2021, 6:20:41.556788 pm UUID: 97fd9a82-3fc1-854d-9f95-d97718d3e9a8 Ancestors: FFI-Tests-mt.49 Complements #asPoint in FFITestPoint2 to be used in tests for convenience. =============== Diff against FFI-Tests-mt.49 =============== Item was added: + ----- Method: FFITestPoint2 class>>fromPoint: (in category 'instance creation') ----- + fromPoint: aPoint + + ^ self new + setX: aPoint x setY: aPoint y; + yourself! From commits at source.squeak.org Wed May 26 16:23:09 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:23:09 0000 Subject: [squeak-dev] FFI: FFI-CallbacksTests-mt.1.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.1.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.1 Author: mt Time: 26 May 2021, 6:23:09.127788 pm UUID: ca368808-aa20-a94f-8756-cb35faf36504 Ancestors: Adds some tests around callbacks using qsort and bsearch from the C standard library. Complements (and depends on): FFI-Kernel-mt.171 FFI-Callbacks-mt.19 FFI-Tests-mt.50 ==================== Snapshot ==================== SystemOrganization addCategory: #'FFI-CallbacksTests'! TestCase subclass: #FFICallbackTests instanceVariableNames: 'lib externalObjects' classVariableNames: '' poolDictionaries: '' category: 'FFI-CallbacksTests'! ----- Method: FFICallbackTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( test02SortArrayOfDoublesRaw "Checked on 32-bit. Coercing checks are too aggressive or just wrong." test04SortArrayOfIntegersRaw "See above." )! ----- Method: FFICallbackTests>>performTest (in category 'running') ----- performTest "Tests should opt-in to have more control." | prior1 prior2 | prior1 := ExternalType useArrayClasses. prior2 := ExternalData extraSizeChecks. [ExternalType useArrayClasses: false. ExternalData extraSizeChecks: true. super performTest] ensure: [ ExternalType useArrayClasses: prior1. ExternalData extraSizeChecks: prior2].! ----- Method: FFICallbackTests>>setUp (in category 'running') ----- setUp super setUp. lib := CStandardLibrary default. externalObjects := OrderedCollection new.! ----- Method: FFICallbackTests>>tearDown (in category 'running') ----- tearDown externalObjects do: [:ea | ea free]. super tearDown.! ----- Method: FFICallbackTests>>test01SortArrayOfDoubles (in category 'tests') ----- test01SortArrayOfDoubles | array unsorted sorted | unsorted := #(0.8332389864879751 0.5043604970280617 0.36114975224430435 0.8103526363890933 0.7802893776251926 0.5329258270112472 0.23437693854303543 0.509741853444245 0.0275989539897884 0.548561613276074). sorted := #(0.0275989539897884 0.23437693854303543 0.36114975224430435 0.5043604970280617 0.509741853444245 0.5329258270112472 0.548561613276074 0.7802893776251926 0.8103526363890933 0.8332389864879751). array := ExternalType double allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. self deny: (sorted hasEqualElements: array). lib qsort: array compare: [:a :b | (a - b) sign]. self assert: (sorted hasEqualElements: array).! ----- Method: FFICallbackTests>>test02SortArrayOfDoublesRaw (in category 'tests') ----- test02SortArrayOfDoublesRaw ExternalType useArrayClassesDuring: [self test01SortArrayOfDoubles].! ----- Method: FFICallbackTests>>test03SortArrayOfIntegers (in category 'tests') ----- test03SortArrayOfIntegers | array unsorted sorted | unsorted := #(3036962509 3319035228 2533963671 3440375993 2159145233 2156551592 3216768444 3368770086 3413300624 2615411192). sorted := #(2156551592 2159145233 2533963671 2615411192 3036962509 3216768444 3319035228 3368770086 3413300624 3440375993). array := ExternalType int64_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. self deny: (sorted hasEqualElements: array). lib qsort: array compare: [:a :b | (a - b) sign]. self assert: (sorted hasEqualElements: array).! ----- Method: FFICallbackTests>>test04SortArrayOfIntegersRaw (in category 'tests') ----- test04SortArrayOfIntegersRaw ExternalType useArrayClassesDuring: [self test03SortArrayOfIntegers].! ----- Method: FFICallbackTests>>test05SortArrayOfPointers (in category 'tests') ----- test05SortArrayOfPointers "Fill an array with pointers to atomics. Then sort that array. Note that #value reads from and #value: writes into the first element from ExternalData." | type array unsorted sorted | type := ExternalType int32_t. array := type asPointerType allocate: 10. unsorted := #(10 9 1 5 4 3 7 6 2 8). sorted := #(1 2 3 4 5 6 7 8 9 10). 1 to: array size do: [:index | array at: index put: ((externalObjects add: type allocateExternal) value: (unsorted at: index); yourself)]. self deny: (sorted hasEqualElements: (array collect: #value)). lib qsort: array compare: [:a :b | (a value - b value) sign]. self assert: (sorted hasEqualElements: (array collect: #value)).! ----- Method: FFICallbackTests>>test06SortArrayOfStructs (in category 'tests') ----- test06SortArrayOfStructs | array unsorted sorted compare | unsorted := {58 at 43 . 99 at 90 . 63 at 34 . 19 at 67 . 99 at 18 . 57 at 52 . 5 at 28 . 68 at 46 . 49 at 20 . 90 at 32}. sorted := {5 at 28 . 19 at 67 . 49 at 20 . 57 at 52 . 58 at 43 . 63 at 34 . 68 at 46 . 90 at 32 . 99 at 18 . 99 at 90}. compare := [:pt1 :pt2 | pt1 = pt2 ifTrue: [0] ifFalse: [ (pt1 x <= pt2 x and: [pt1 x ~= pt2 x or: [pt1 y <= pt2 y]]) ifTrue: [-1] ifFalse: [1]]]. array := FFITestPoint2 allocate: 10. 1 to: array size do: [:index | array at: index put: (FFITestPoint2 fromPoint: (unsorted at: index))]. self deny: (sorted hasEqualElements: (array collect: #asPoint)). lib qsort: array compare: [:ffiPt1 :ffiPt2 | compare value: ffiPt1 asPoint value: ffiPt2 asPoint]. self assert: (sorted hasEqualElements: (array collect: #asPoint)).! ----- Method: FFICallbackTests>>test07FindFirst (in category 'tests') ----- test07FindFirst | array key sorted result | array := ExternalType int32_t allocateExternal: 10. externalObjects add: array. key := ExternalType int32_t allocateExternal. externalObjects add: key. sorted := #(10 22 23 23 39 44 56 57 67 79). 1 to: array size do: [:index | array at: index put: (sorted at: index)]. key value: (sorted at: 7). result := lib bsearch: key in: array compare: [:a :b | (a - b) sign]. self deny: result isNull. self assert: key value equals: result value. self deny: (key ffiIdentical: result). self assert: ((array from: 7 to: 7) ffiIdentical: result). key value: 111. self deny: (sorted includes: key value). result := lib bsearch: key in: array compare: [:a :b | (a - b) sign]. self assert: result isNull.! From commits at source.squeak.org Wed May 26 16:39:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:39:08 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.172.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.172.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.172 Author: mt Time: 26 May 2021, 6:39:07.815386 pm UUID: 14335f5b-67ba-8d44-b22d-8879378801a4 Ancestors: FFI-Kernel-mt.171 Moves parser extension to "FFI-Pools" to be loaded before "FFI-Kernel" so that the latter may include external libraries with external functions such as libc and qsort. =============== Diff against FFI-Kernel-mt.171 =============== Item was removed: - ----- Method: Parser>>apicall (in category '*FFI-Kernel') ----- - apicall - - ^ self externalFunctionDeclaration! Item was removed: - ----- Method: Parser>>callback (in category '*FFI-Kernel') ----- - callback - - - | descriptorClass retType externalName args argType | - descriptorClass := ExternalFunction. - "Parse return type" - self advance. - retType := self externalType: descriptorClass. - retType == nil ifTrue:[^self expected:'return type']. - "Parse function name or index" - externalName := here. - - (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. - (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. - (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. - - (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. - args := WriteStream on: Array new. - [self match: #rightParenthesis] whileFalse:[ - argType := self externalType: descriptorClass. - argType == nil ifTrue:[^self expected:'argument']. - argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. - - self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). - ^true! Item was removed: - ----- Method: Parser>>cdecl (in category '*FFI-Kernel') ----- - cdecl - - ^ self externalFunctionDeclaration! Item was removed: - ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Kernel') ----- - externalFunctionDeclaration - "Parse the function declaration for a call to an external library. - - (1) Create an instance of ExternalLibraryFunction and install it as first literal. - (2) Add a pragma to primitive call 120. - " - | descriptorClass callType modifier retType externalName args argType module fn | - descriptorClass := cue environment - valueOf: #ExternalFunction - ifAbsent: [^ false]. - callType := descriptorClass callingConventionFor: here. - callType == nil ifTrue:[^false]. - [modifier := descriptorClass callingConventionModifierFor: token. - modifier notNil] whileTrue: - [self advance. - callType := callType bitOr: modifier]. - "Parse return type" - self advance. - retType := self externalType: descriptorClass. - retType == nil ifTrue:[^self expected:'return type']. - "Parse function name or index" - externalName := here. - (self match: #number) - ifFalse: [ "Consume all tokens as function name" - self advance. - externalName := externalName asSymbol]. - (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. - args := WriteStream on: Array new. - [self match: #rightParenthesis] whileFalse:[ - argType := self externalType: descriptorClass. - argType == nil ifTrue:[^self expected:'argument']. - argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. - (self matchToken: 'module:') ifTrue:[ - module := here. - (self match: #string) ifFalse:[^self expected: 'String']. - module := module asSymbol]. - - Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| - fn := xfn name: externalName - module: module - callType: callType - returnType: retType - argumentTypes: args contents. - self allocateLiteral: fn. - fn beWritableObject. "Undo the read-only setting in litIndex:"]. - (self matchToken: 'error:') - ifTrue: - [| errorCodeVariable | - errorCodeVariable := here. - (hereType == #string - or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. - self advance. - self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). - fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] - ifFalse: - [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. - ^true! Item was removed: - ----- Method: Parser>>externalType: (in category '*FFI-Kernel') ----- - externalType: descriptorClass - "Parse and return an external type. Ignore leading comma and 'const'." - - | xType typeName isArrayType tokenString | - self matchToken: ','. - self matchToken: 'const'. - typeName := here. "Note that pointer token is not yet parsed!!" - self advance. - (isArrayType := self matchToken: $[) - ifTrue: [ - (self matchToken: $]) - ifTrue: [typeName := typeName, '[]'] - ifFalse: [ - typeName := typeName, '[', here, ']'. - self advance. - (self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]]. - (xType := descriptorClass typeNamed: typeName) - ifNil: [ - "Raise an error if user is there" - self interactive ifTrue: [^nil]. - "otherwise go over it silently -- use an unknown struct type" - xType := descriptorClass newTypeNamed: typeName]. - isArrayType ifTrue: [ - xType := xType asPointerType]. - self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token." - tokenString := here asString. - ^ (tokenString first == $*) - ifTrue: [self advance. xType asPointerType] - ifFalse:[(tokenString beginsWith: '**') - ifTrue: [self advance. xType asPointerToPointerType] - ifFalse: [xType]]! From commits at source.squeak.org Wed May 26 16:39:31 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:39:31 0000 Subject: [squeak-dev] FFI: FFI-Pools-mt.28.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.28.mcz ==================== Summary ==================== Name: FFI-Pools-mt.28 Author: mt Time: 26 May 2021, 6:39:30.828386 pm UUID: 9faaf707-ff49-c547-91c4-9bdbcd3e5834 Ancestors: FFI-Pools-mt.27 Complements FFI-Kernel-mt.172 =============== Diff against FFI-Pools-mt.27 =============== Item was added: + ----- Method: Parser>>apicall (in category '*FFI-Pools') ----- + apicall + + ^ self externalFunctionDeclaration! Item was added: + ----- Method: Parser>>callback (in category '*FFI-Pools') ----- + callback + + + | descriptorClass retType externalName args argType | + descriptorClass := ExternalFunction. + "Parse return type" + self advance. + retType := self externalType: descriptorClass. + retType == nil ifTrue:[^self expected:'return type']. + "Parse function name or index" + externalName := here. + + (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. + (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. + (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. + + (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. + args := WriteStream on: Array new. + [self match: #rightParenthesis] whileFalse:[ + argType := self externalType: descriptorClass. + argType == nil ifTrue:[^self expected:'argument']. + argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. + + self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). + ^true! Item was added: + ----- Method: Parser>>cdecl (in category '*FFI-Pools') ----- + cdecl + + ^ self externalFunctionDeclaration! Item was added: + ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Pools') ----- + externalFunctionDeclaration + "Parse the function declaration for a call to an external library. + + (1) Create an instance of ExternalLibraryFunction and install it as first literal. + (2) Add a pragma to primitive call 120. + " + | descriptorClass callType modifier retType externalName args argType module fn | + descriptorClass := cue environment + valueOf: #ExternalFunction + ifAbsent: [^ false]. + callType := descriptorClass callingConventionFor: here. + callType == nil ifTrue:[^false]. + [modifier := descriptorClass callingConventionModifierFor: token. + modifier notNil] whileTrue: + [self advance. + callType := callType bitOr: modifier]. + "Parse return type" + self advance. + retType := self externalType: descriptorClass. + retType == nil ifTrue:[^self expected:'return type']. + "Parse function name or index" + externalName := here. + (self match: #number) + ifFalse: [ "Consume all tokens as function name" + self advance. + externalName := externalName asSymbol]. + (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. + args := WriteStream on: Array new. + [self match: #rightParenthesis] whileFalse:[ + argType := self externalType: descriptorClass. + argType == nil ifTrue:[^self expected:'argument']. + argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. + (self matchToken: 'module:') ifTrue:[ + module := here. + (self match: #string) ifFalse:[^self expected: 'String']. + module := module asSymbol]. + + Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| + fn := xfn name: externalName + module: module + callType: callType + returnType: retType + argumentTypes: args contents. + self allocateLiteral: fn. + fn beWritableObject. "Undo the read-only setting in litIndex:"]. + (self matchToken: 'error:') + ifTrue: + [| errorCodeVariable | + errorCodeVariable := here. + (hereType == #string + or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. + self advance. + self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). + fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] + ifFalse: + [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. + ^true! Item was added: + ----- Method: Parser>>externalType: (in category '*FFI-Pools') ----- + externalType: descriptorClass + "Parse and return an external type. Ignore leading comma and 'const'." + + | xType typeName isArrayType tokenString | + self matchToken: ','. + self matchToken: 'const'. + typeName := here. "Note that pointer token is not yet parsed!!" + self advance. + (isArrayType := self matchToken: $[) + ifTrue: [ + (self matchToken: $]) + ifTrue: [typeName := typeName, '[]'] + ifFalse: [ + typeName := typeName, '[', here, ']'. + self advance. + (self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]]. + (xType := descriptorClass typeNamed: typeName) + ifNil: [ + "Raise an error if user is there" + self interactive ifTrue: [^nil]. + "otherwise go over it silently -- use an unknown struct type" + xType := descriptorClass newTypeNamed: typeName]. + isArrayType ifTrue: [ + xType := xType asPointerType]. + self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token." + tokenString := here asString. + ^ (tokenString first == $*) + ifTrue: [self advance. xType asPointerType] + ifFalse:[(tokenString beginsWith: '**') + ifTrue: [self advance. xType asPointerToPointerType] + ifFalse: [xType]]! From commits at source.squeak.org Wed May 26 16:43:07 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:43:07 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.173.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.173.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.173 Author: mt Time: 26 May 2021, 6:43:06.758386 pm UUID: a4390742-4fe7-0a44-b077-b39954d28611 Ancestors: FFI-Kernel-mt.172 Adds a singleton interface to ExternalLibrary. =============== Diff against FFI-Kernel-mt.172 =============== Item was changed: ExternalObject subclass: #ExternalLibrary instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! + ExternalLibrary class + instanceVariableNames: 'default'! + !ExternalLibrary commentStamp: 'mt 6/8/2020 13:21' prior: 0! - !ExternalLibrary commentStamp: '' prior: 0! An external library bundles calls to functions from the same library. It is provided mainly as convenience since every external function can be fully specified by the name and the module it resides in. + Every external function that is defined in an external library by default will use the library it is defined in. This can always be modified by providing the appropriate module in the specification. + + Note that you will only get a valid handle *automatically* for the library if the module has not yet been loaded when making the first FFI call. After that, new instances of me must call #forceLoading to get the handle right. Consequently, it is advised to only have a single instance of your external library to reliably check #isLoaded.! + ExternalLibrary class + instanceVariableNames: 'default'! - Every external function that is defined in an external library by default will use the library it is defined in. This can always be modified by providing the appropriate module in the specification. ! Item was added: + ----- Method: ExternalLibrary class>>clearAllCaches (in category 'system startup') ----- + clearAllCaches + + self withAllSubclassesDo: [:libraryClass | + libraryClass clearCaches].! Item was added: + ----- Method: ExternalLibrary class>>clearCaches (in category 'system startup') ----- + clearCaches + + self resetDefault.! Item was added: + ----- Method: ExternalLibrary class>>default (in category 'instance access') ----- + default + + ^ default ifNil: [default := self new]! Item was added: + ----- Method: ExternalLibrary class>>platformChangedFrom:to: (in category 'system startup') ----- + platformChangedFrom: oldPlatform to: newPlatform + + self clearAllCaches.! Item was added: + ----- Method: ExternalLibrary class>>resetDefault (in category 'instance creation') ----- + resetDefault + + default := nil.! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull. ExternalType cleanupUnusedTypes ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." + { ExternalAddress. ExternalType. ExternalStructure. ExternalPool. ExternalLibrary } - { ExternalAddress. ExternalType. ExternalStructure. ExternalPool } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]]. self checkFFIOnStartUp ifTrue: [self checkFFI]. self checkCStandardLibraryOnStartUp ifTrue: [self checkCStandardLibrary]].! From commits at source.squeak.org Wed May 26 16:46:26 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:46:26 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.20.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.20.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.20 Author: mt Time: 26 May 2021, 6:46:25.775386 pm UUID: f8235d1d-8848-d04d-80c9-868dbc5f3f20 Ancestors: FFI-Callbacks-mt.19 Some preparations for code-generation in FFICallback to speed up callback evaluation. Fixes callback test #test05SortArrayOfPointers. =============== Diff against FFI-Callbacks-mt.19 =============== Item was changed: ExternalObject subclass: #FFICallback + instanceVariableNames: 'abi evaluableObject evaluator thunk argumentTypes resultType' - instanceVariableNames: 'abi type evaluableObject thunk argumentTypes resultType' classVariableNames: 'ThunkToCallbackMap' poolDictionaries: '' category: 'FFI-Callbacks'! Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." + | byteOffset args intArgs intPos floatArgs floatPos type | - | byteOffset args intArgs intPos floatArgs floatPos | handle := callbackContext stackPtr getHandle. type := callbackContext stackPtr contentType. byteOffset := 1. intArgs := callbackContext intRegArgs. intPos := 0. floatArgs := callbackContext floatRegArgs. floatPos := 0. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Read pointers from register value." isPointer ifFalse: ["data is already an integer"] ifTrue: [ data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) + type: argType asNonPointerType "contentType") value]] - type: argType asNonPointerType "contentType" size: 1) value]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := (argType handle: handle at: byteOffset) value. byteOffset := byteOffset + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. args at: argIndex put: data]. ^ self setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was removed: - ----- Method: FFICallback>>setArgData: (in category 'callback') ----- - setArgData: externalData - - handle := externalData getHandle. - type := externalData contentType. ! Item was changed: ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') ----- setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage abi := FFIPlatformDescription current abi. - handle := nil. - type := nil. evaluableObject := blockOrMessage. argumentTypes := moreExternalTypes. resultType := anExternalType. "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the pragma which specifies how many bytes to pop. See http://forum.world.st/Pharo-FFI-on-aarch64-arm64-td5096777.html#a5096786." thunk := FFICallbackMemory allocateExecutableBlock. self init__ccall. "self init__stdcall: 0." "(method pragmaAt: #calleepops:) ifNil: [self init__ccall] ifNotNil: [:pragma | self init__stdcall: (pragma argumentAt: 1)]." "numEvaluatorArgs := (evaluator := method selector) numArgs. self addToThunkTable" ThunkToCallbackMap at: thunk getHandle put: self! Item was changed: ----- Method: FFICallback>>valueInContext: (in category 'callback') ----- valueInContext: callbackContext " ^" + ^ evaluator + ifNil: [self evaluateDynamic: callbackContext] + ifNotNil: [evaluator perform: callbackContext]! - ^ self evaluateDynamic: callbackContext! From commits at source.squeak.org Wed May 26 16:50:03 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:50:03 0000 Subject: [squeak-dev] FFI: FFI-PoolsTests-mt.11.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-mt.11.mcz ==================== Summary ==================== Name: FFI-PoolsTests-mt.11 Author: mt Time: 26 May 2021, 6:50:02.802386 pm UUID: 8276584d-e807-414f-b17f-0b6537d11f44 Ancestors: FFI-PoolsTests-mt.10 Fixes #testDefaultDefinition and #testInheritance. =============== Diff against FFI-PoolsTests-mt.10 =============== Item was changed: ----- Method: FFIExternalSharedPoolTest>>definitionClass (in category 'defaults') ----- definitionClass + ^ ExternalPoolDefinition! - ^ FFIExternalSharedPoolDefinition! From commits at source.squeak.org Wed May 26 16:57:14 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 16:57:14 0000 Subject: [squeak-dev] FFI: FFI-Pools-mt.29.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.29.mcz ==================== Summary ==================== Name: FFI-Pools-mt.29 Author: mt Time: 26 May 2021, 6:57:13.954386 pm UUID: 35ffa57b-8d10-8148-80f8-dd10f3e1ccdf Ancestors: FFI-Pools-mt.28 Remove dependencies on "FFI-Kernel" classes. Use #environment instead of Smalltalk global. =============== Diff against FFI-Pools-mt.28 =============== Item was changed: ----- Method: Parser>>callback (in category '*FFI-Pools') ----- callback | descriptorClass retType externalName args argType | + descriptorClass := self environment classNamed: #ExternalFunction. - descriptorClass := ExternalFunction. "Parse return type" self advance. retType := self externalType: descriptorClass. retType == nil ifTrue:[^self expected:'return type']. "Parse function name or index" externalName := here. (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. args := WriteStream on: Array new. [self match: #rightParenthesis] whileFalse:[ argType := self externalType: descriptorClass. argType == nil ifTrue:[^self expected:'argument']. argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). ^true! Item was changed: ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Pools') ----- externalFunctionDeclaration "Parse the function declaration for a call to an external library. (1) Create an instance of ExternalLibraryFunction and install it as first literal. (2) Add a pragma to primitive call 120. " | descriptorClass callType modifier retType externalName args argType module fn | descriptorClass := cue environment valueOf: #ExternalFunction ifAbsent: [^ false]. callType := descriptorClass callingConventionFor: here. callType == nil ifTrue:[^false]. [modifier := descriptorClass callingConventionModifierFor: token. modifier notNil] whileTrue: [self advance. callType := callType bitOr: modifier]. "Parse return type" self advance. retType := self externalType: descriptorClass. retType == nil ifTrue:[^self expected:'return type']. "Parse function name or index" externalName := here. (self match: #number) ifFalse: [ "Consume all tokens as function name" self advance. externalName := externalName asSymbol]. (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. args := WriteStream on: Array new. [self match: #rightParenthesis] whileFalse:[ argType := self externalType: descriptorClass. argType == nil ifTrue:[^self expected:'argument']. argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. (self matchToken: 'module:') ifTrue:[ module := here. (self match: #string) ifFalse:[^self expected: 'String']. module := module asSymbol]. + self environment at: #ExternalLibraryFunction ifPresent:[:xfn| - Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn| fn := xfn name: externalName module: module callType: callType returnType: retType argumentTypes: args contents. self allocateLiteral: fn. fn beWritableObject. "Undo the read-only setting in litIndex:"]. (self matchToken: 'error:') ifTrue: [| errorCodeVariable | errorCodeVariable := here. (hereType == #string or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. self advance. self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] ifFalse: [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. ^true! From commits at source.squeak.org Wed May 26 19:03:05 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 19:03:05 0000 Subject: [squeak-dev] The Trunk: Sound-eem.81.mcz Message-ID: Eliot Miranda uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-eem.81.mcz ==================== Summary ==================== Name: Sound-eem.81 Author: eem Time: 26 May 2021, 12:03:03.709521 pm UUID: 43c1e089-1145-4a27-b5b8-f35e872fc99a Ancestors: Sound-eem.80 Better meterFrom:count:in: =============== Diff against Sound-eem.80 =============== Item was changed: ----- Method: SoundRecorder>>meterFrom:count:in: (in category 'private') ----- meterFrom: start count: count in: buffer "Update the meter level with the maximum signal level in the given range of the given buffer." + | max sample min | + count = 0 ifTrue: [^self]. "no new samples" + max := min := 0. + start to: start + count - 1 do: + [:i | - | last max sample | - count = 0 ifTrue: [^ self]. "no new samples" - last := start + count - 1. - max := 0. - start to: last do: [:i | sample := buffer at: i. + sample > max + ifTrue: [max := sample] + ifFalse: + [sample < min ifTrue: [min := sample]]]. + meterLevel := max max: min negated! - sample < 0 ifTrue: [sample := sample negated]. - sample > max ifTrue: [max := sample]]. - meterLevel := max. - ! From commits at source.squeak.org Thu May 27 07:31:08 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:31:08 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.174.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.174.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.174 Author: mt Time: 27 May 2021, 9:31:07.812843 am UUID: 13aff407-23c6-a04d-a83d-6d8abf6f524d Ancestors: FFI-Kernel-mt.173 Clean up yesterday's dependency hick-up. Sorry for the inconvenience. :-/ =============== Diff against FFI-Kernel-mt.173 =============== Item was removed: - ExternalLibrary subclass: #CStandardLibrary - instanceVariableNames: '' - classVariableNames: 'ModuleName' - poolDictionaries: '' - category: 'FFI-Kernel-Support'! - - !CStandardLibrary commentStamp: 'mt 5/26/2021 10:08' prior: 0! - The ISO C standard library, also known as "CRT" and "libc." - - Further reading: - https://www.gnu.org/software/libc/ - https://docs.microsoft.com/en-us/cpp/c-runtime-library - https://www.cplusplus.com/reference/clibrary/ - https://www.iso.org/standard/82075.html! Item was removed: - ----- Method: CStandardLibrary class>>guessModuleName (in category 'preferences') ----- - guessModuleName - "The the platform's module name for the C library." - - | platform | - platform := FFIPlatformDescription current. - - platform isMacOS ifTrue: [ - ^ platform osVersionMajor >= 11 "Big Sur and beyond" - ifTrue:['libSystem.dylib'] - ifFalse: [platform osVersionMajor >= 10 - ifFalse: ['libc.dylib' "Mac OS 9"] - ifTrue: [platform osVersionMinor >= 7 "at least OS X 10.7 (Lion)" - ifTrue: ['libobjc.dylib'] - ifFalse: [platform osVersionMinor >= 5 "at least Mac OS X 10.5 (Leopard)" - ifTrue: ['libgcc_s.1.dylib'] - ifFalse: ['libc.dylib']]]]]. - - platform isWindows ifTrue: [ - ^ 'msvcrt.dll']. - - platform isUnix ifTrue: [ - ^ platform osVersion = 'linux-gnu' - ifTrue: ['libc.so.6'] - ifFalse: ['libc.so']]. - - ^ nil! Item was removed: - ----- Method: CStandardLibrary class>>moduleName (in category 'preferences') ----- - moduleName - - ^ ModuleName ifNil: [self guessModuleName]! Item was removed: - ----- Method: CStandardLibrary class>>moduleName: (in category 'preferences') ----- - moduleName: nameOrNil - - ModuleName := nameOrNil = String empty ifFalse: [nameOrNil]. - self clearAllCaches. - - "Check the provided name only if overwritten by clients. See #guessModuleName and FFIPlatformDescription class>> #startUp:." - ModuleName ifNotNil: [FFIPlatformDescription checkCStandardLibrary].! Item was removed: - ----- Method: CStandardLibrary class>>resetDefault (in category 'instance creation') ----- - resetDefault - "Overwritten to release all function handles." - - super resetDefault. - CStandardLibrary methodsDo: [:m | m externalLibraryName: nil].! Item was removed: - ----- Method: CStandardLibrary>>abs: (in category 'stdlib.h - integer arithmetics') ----- - abs: n - "Returns the absolute value of parameter n" - - - ^ self externalCallFailed ! Item was removed: - ----- Method: CStandardLibrary>>bsearch:with:with:with:with: (in category 'stdlib.h - searching and sorting') ----- - bsearch: key with: base with: num with: size with: compar - - - ^ self externalCallFailed ! Item was removed: - ----- Method: CStandardLibrary>>qsort:with:with:with: (in category 'stdlib.h - searching and sorting') ----- - qsort: base with: num with: size with: compar - - - ^ self externalCallFailed ! Item was changed: ----- Method: ExternalLibrary class>>resetDefault (in category 'instance creation') ----- resetDefault + default := nil. + self methodsDo: [:m | m externalLibraryName: nil].! - default := nil.! Item was changed: Object subclass: #FFIPlatformDescription instanceVariableNames: 'name osVersion subtype wordSize endianness' + classVariableNames: 'CheckFFIOnStartUp LastPlatform' - classVariableNames: 'CheckCStandardLibraryOnStartUp CheckFFIOnStartUp LastPlatform' poolDictionaries: '' category: 'FFI-Kernel-Support'! !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0! This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions). 1. DETECT PLATFORM CHANGE ON STARTUP This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType. 2. PLATFORM SPECIFICITY Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are: platform name > osVersion > subtype > wordSize So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize. 3. PLATFORM COMPATIBILITY Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible. Here is an interesting edge case of two compatible platform descriptions: | p1 p2 | p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil. p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8. p1 isCompatibleWith: p2. Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools. 4. FURTHER READING - all references to FFIPlatformDescription - all senders of #wordSize - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject ! Item was removed: - ----- Method: FFIPlatformDescription class>>checkCStandardLibrary (in category 'system startup') ----- - checkCStandardLibrary - "Try to use C Standard Library. Warn if not possible." - - [ [self assert: [(CStandardLibrary default abs: -5) = 5] - ] ifError: [:msg | - self notify: 'C standard library not available. Please check module name in preferences.', String cr, String cr, msg] - ] fork. "Do not interrupt the startup list."! Item was removed: - ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp (in category 'preferences') ----- - checkCStandardLibraryOnStartUp - - ^ CheckCStandardLibraryOnStartUp ifNil: [true]! Item was removed: - ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp: (in category 'preferences') ----- - checkCStandardLibraryOnStartUp: aBoolean - - CheckCStandardLibraryOnStartUp := aBoolean.! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull. ExternalType cleanupUnusedTypes ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." { ExternalAddress. ExternalType. ExternalStructure. ExternalPool. ExternalLibrary } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]]. + self checkFFIOnStartUp ifTrue: [self checkFFI]].! - self checkFFIOnStartUp ifTrue: [self checkFFI]. - self checkCStandardLibraryOnStartUp ifTrue: [self checkCStandardLibrary]].! Item was removed: - CStandardLibrary subclass: #LibC - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Kernel-Support'! - - !LibC commentStamp: 'mt 5/26/2021 10:09' prior: 0! - Just a synonym for convenient reference.! Item was added: + ----- Method: Parser>>apicall (in category '*FFI-Kernel') ----- + apicall + + ^ self externalFunctionDeclaration! Item was added: + ----- Method: Parser>>callback (in category '*FFI-Kernel') ----- + callback + + + | descriptorClass retType externalName args argType | + descriptorClass := self environment classNamed: #ExternalFunction. + "Parse return type" + self advance. + retType := self externalType: descriptorClass. + retType == nil ifTrue:[^self expected:'return type']. + "Parse function name or index" + externalName := here. + + (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. + (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. + (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. + + (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. + args := WriteStream on: Array new. + [self match: #rightParenthesis] whileFalse:[ + argType := self externalType: descriptorClass. + argType == nil ifTrue:[^self expected:'argument']. + argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. + + self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). + ^true! Item was added: + ----- Method: Parser>>cdecl (in category '*FFI-Kernel') ----- + cdecl + + ^ self externalFunctionDeclaration! Item was added: + ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Kernel') ----- + externalFunctionDeclaration + "Parse the function declaration for a call to an external library. + + (1) Create an instance of ExternalLibraryFunction and install it as first literal. + (2) Add a pragma to primitive call 120. + " + | descriptorClass callType modifier retType externalName args argType module fn | + descriptorClass := cue environment + valueOf: #ExternalFunction + ifAbsent: [^ false]. + callType := descriptorClass callingConventionFor: here. + callType == nil ifTrue:[^false]. + [modifier := descriptorClass callingConventionModifierFor: token. + modifier notNil] whileTrue: + [self advance. + callType := callType bitOr: modifier]. + "Parse return type" + self advance. + retType := self externalType: descriptorClass. + retType == nil ifTrue:[^self expected:'return type']. + "Parse function name or index" + externalName := here. + (self match: #number) + ifFalse: [ "Consume all tokens as function name" + self advance. + externalName := externalName asSymbol]. + (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. + args := WriteStream on: Array new. + [self match: #rightParenthesis] whileFalse:[ + argType := self externalType: descriptorClass. + argType == nil ifTrue:[^self expected:'argument']. + argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. + (self matchToken: 'module:') ifTrue:[ + module := here. + (self match: #string) ifFalse:[^self expected: 'String']. + module := module asSymbol]. + + self environment at: #ExternalLibraryFunction ifPresent:[:xfn| + fn := xfn name: externalName + module: module + callType: callType + returnType: retType + argumentTypes: args contents. + self allocateLiteral: fn. + fn beWritableObject. "Undo the read-only setting in litIndex:"]. + (self matchToken: 'error:') + ifTrue: + [| errorCodeVariable | + errorCodeVariable := here. + (hereType == #string + or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. + self advance. + self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). + fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] + ifFalse: + [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. + ^true! Item was added: + ----- Method: Parser>>externalType: (in category '*FFI-Kernel') ----- + externalType: descriptorClass + "Parse and return an external type. Ignore leading comma and 'const'." + + | xType typeName isArrayType tokenString | + self matchToken: ','. + self matchToken: 'const'. + typeName := here. "Note that pointer token is not yet parsed!!" + self advance. + (isArrayType := self matchToken: $[) + ifTrue: [ + (self matchToken: $]) + ifTrue: [typeName := typeName, '[]'] + ifFalse: [ + typeName := typeName, '[', here, ']'. + self advance. + (self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]]. + (xType := descriptorClass typeNamed: typeName) + ifNil: [ + "Raise an error if user is there" + self interactive ifTrue: [^nil]. + "otherwise go over it silently -- use an unknown struct type" + xType := descriptorClass newTypeNamed: typeName]. + isArrayType ifTrue: [ + xType := xType asPointerType]. + self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token." + tokenString := here asString. + ^ (tokenString first == $*) + ifTrue: [self advance. xType asPointerType] + ifFalse:[(tokenString beginsWith: '**') + ifTrue: [self advance. xType asPointerToPointerType] + ifFalse: [xType]]! From commits at source.squeak.org Thu May 27 07:31:43 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:31:43 0000 Subject: [squeak-dev] FFI: FFI-Pools-mt.30.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.30.mcz ==================== Summary ==================== Name: FFI-Pools-mt.30 Author: mt Time: 27 May 2021, 9:31:42.419843 am UUID: 4ea34330-670f-f844-833b-349561dc6e3a Ancestors: FFI-Pools-mt.29 Complements FFI-Kernel-mt.174 =============== Diff against FFI-Pools-mt.29 =============== Item was removed: - ----- Method: Parser>>apicall (in category '*FFI-Pools') ----- - apicall - - ^ self externalFunctionDeclaration! Item was removed: - ----- Method: Parser>>callback (in category '*FFI-Pools') ----- - callback - - - | descriptorClass retType externalName args argType | - descriptorClass := self environment classNamed: #ExternalFunction. - "Parse return type" - self advance. - retType := self externalType: descriptorClass. - retType == nil ifTrue:[^self expected:'return type']. - "Parse function name or index" - externalName := here. - - (self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)']. - (self matchToken: #*) ifFalse:[^self expected:'function pointer (*)']. - (self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)']. - - (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. - args := WriteStream on: Array new. - [self match: #rightParenthesis] whileFalse:[ - argType := self externalType: descriptorClass. - argType == nil ifTrue:[^self expected:'argument']. - argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. - - self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}). - ^true! Item was removed: - ----- Method: Parser>>cdecl (in category '*FFI-Pools') ----- - cdecl - - ^ self externalFunctionDeclaration! Item was removed: - ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Pools') ----- - externalFunctionDeclaration - "Parse the function declaration for a call to an external library. - - (1) Create an instance of ExternalLibraryFunction and install it as first literal. - (2) Add a pragma to primitive call 120. - " - | descriptorClass callType modifier retType externalName args argType module fn | - descriptorClass := cue environment - valueOf: #ExternalFunction - ifAbsent: [^ false]. - callType := descriptorClass callingConventionFor: here. - callType == nil ifTrue:[^false]. - [modifier := descriptorClass callingConventionModifierFor: token. - modifier notNil] whileTrue: - [self advance. - callType := callType bitOr: modifier]. - "Parse return type" - self advance. - retType := self externalType: descriptorClass. - retType == nil ifTrue:[^self expected:'return type']. - "Parse function name or index" - externalName := here. - (self match: #number) - ifFalse: [ "Consume all tokens as function name" - self advance. - externalName := externalName asSymbol]. - (self match: #leftParenthesis) ifFalse:[^self expected:'argument list']. - args := WriteStream on: Array new. - [self match: #rightParenthesis] whileFalse:[ - argType := self externalType: descriptorClass. - argType == nil ifTrue:[^self expected:'argument']. - argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]]. - (self matchToken: 'module:') ifTrue:[ - module := here. - (self match: #string) ifFalse:[^self expected: 'String']. - module := module asSymbol]. - - self environment at: #ExternalLibraryFunction ifPresent:[:xfn| - fn := xfn name: externalName - module: module - callType: callType - returnType: retType - argumentTypes: args contents. - self allocateLiteral: fn. - fn beWritableObject. "Undo the read-only setting in litIndex:"]. - (self matchToken: 'error:') - ifTrue: - [| errorCodeVariable | - errorCodeVariable := here. - (hereType == #string - or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)']. - self advance. - self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)). - fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]] - ifFalse: - [self addPragma: (Pragma keyword: #primitive: arguments: #(120))]. - ^true! Item was removed: - ----- Method: Parser>>externalType: (in category '*FFI-Pools') ----- - externalType: descriptorClass - "Parse and return an external type. Ignore leading comma and 'const'." - - | xType typeName isArrayType tokenString | - self matchToken: ','. - self matchToken: 'const'. - typeName := here. "Note that pointer token is not yet parsed!!" - self advance. - (isArrayType := self matchToken: $[) - ifTrue: [ - (self matchToken: $]) - ifTrue: [typeName := typeName, '[]'] - ifFalse: [ - typeName := typeName, '[', here, ']'. - self advance. - (self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]]. - (xType := descriptorClass typeNamed: typeName) - ifNil: [ - "Raise an error if user is there" - self interactive ifTrue: [^nil]. - "otherwise go over it silently -- use an unknown struct type" - xType := descriptorClass newTypeNamed: typeName]. - isArrayType ifTrue: [ - xType := xType asPointerType]. - self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token." - tokenString := here asString. - ^ (tokenString first == $*) - ifTrue: [self advance. xType asPointerType] - ifFalse:[(tokenString beginsWith: '**') - ifTrue: [self advance. xType asPointerToPointerType] - ifFalse: [xType]]! From commits at source.squeak.org Thu May 27 07:37:21 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:37:21 0000 Subject: [squeak-dev] FFI: FFI-Libraries-mt.1.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Libraries to project FFI: http://source.squeak.org/FFI/FFI-Libraries-mt.1.mcz ==================== Summary ==================== Name: FFI-Libraries-mt.1 Author: mt Time: 27 May 2021, 9:37:20.525843 am UUID: a4ac2929-b61c-af4b-bfde-aba6092bec57 Ancestors: New package that provides a base layer for FFI-backed system functions. For now, there are only some rough sketches for platform-specific I/O and an excerpt from LibC to be used in tests. Another candidate for this package could be the interface to SDL2. Note that future development might reveal the need to split up this package. For now, we are fine, I suppose, since its contents only resemble a construction site. :-D ==================== Snapshot ==================== SystemOrganization addCategory: #'FFI-Libraries-LibC'! SystemOrganization addCategory: #'FFI-Libraries-MacOS'! SystemOrganization addCategory: #'FFI-Libraries-Win32'! SystemOrganization addCategory: #'FFI-Libraries-X11'! SharedPool subclass: #Win32Constants instanceVariableNames: '' classVariableNames: 'COLOR_ACTIVEBORDER COLOR_ACTIVECAPTION COLOR_APPWORKSPACE COLOR_BACKGROUND COLOR_BTNFACE COLOR_BTNHIGHLIGHT COLOR_BTNSHADOW COLOR_BTNTEXT COLOR_CAPTIONTEXT COLOR_GRAYTEXT COLOR_HIGHLIGHT COLOR_HIGHLIGHTTEXT COLOR_INACTIVEBORDER COLOR_INACTIVECAPTION COLOR_INACTIVECAPTIONTEXT COLOR_MENU COLOR_MENUTEXT COLOR_SCROLLBAR COLOR_WINDOW COLOR_WINDOWFRAME COLOR_WINDOWTEXT CS_BYTEALIGNCLIENT CS_BYTEALIGNWINDOW CS_CLASSDC CS_DBLCLKS CS_HREDRAW CS_NOCLOSE CS_OWNDC CS_PARENTDC CS_SAVEBITS CS_VREDRAW CW_USEDEFAULT GWL_STYLE HWND_BROADCAST WM_DESTROY WM_MOVE WS_BORDER WS_CAPTION WS_CHILD WS_CHILDWINDOW WS_CLIPCHILDREN WS_CLIPSIBLINGS WS_DISABLED WS_DLGFRAME WS_EX_ACCEPTFILES WS_EX_APPWINDOW WS_EX_CLIENTEDGE WS_EX_CONTEXTHELP WS_EX_CONTROLPARENT WS_EX_DLGMODALFRAME WS_EX_LEFT WS_EX_LEFTSCROLLBAR WS_EX_LTRREADING WS_EX_MDICHILD WS_EX_NOACTIVATE WS_EX_NOPARENTNOTIFY WS_EX_OVERLAPPEDWINDOW WS_EX_PALETTEWINDOW WS_EX_RIGHT WS_EX_RIGHTSCROLLBAR WS_EX_RTLREADING WS_EX_STATICEDGE WS_EX _TOOLWINDOW WS_EX_TOPMOST WS_EX_TRANSPARENT WS_EX_WINDOWEDGE WS_GROUP WS_HSCROLL WS_ICONIC WS_MAXIMIZE WS_MAXIMIZEBOX WS_MINIMIZE WS_MINIMIZEBOX WS_OVERLAPPED WS_OVERLAPPEDWINDOW WS_POPUP WS_POPUPWINDOW WS_SIZEBOX WS_SYSMENU WS_TABSTOP WS_THICKFRAME WS_TILED WS_TILEDWINDOW WS_VISIBLE WS_VSCROLL' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32Constants class>>initialize (in category 'pool initialization') ----- initialize "Win32Constants initialize" self initializeWindowConstants.! ----- Method: Win32Constants class>>initializeWindowConstants (in category 'pool initialization') ----- initializeWindowConstants GWL_STYLE := -16. WS_EX_ACCEPTFILES := 16r10. WS_EX_APPWINDOW := 16r40000. WS_EX_CLIENTEDGE := 16r200. WS_EX_CONTEXTHELP := 16r400. WS_EX_CONTROLPARENT := 16r10000. WS_EX_DLGMODALFRAME := 16r1. WS_EX_LEFT := 16r0. WS_EX_LEFTSCROLLBAR := 16r4000. WS_EX_LTRREADING := 16r0. WS_EX_MDICHILD := 16r40. WS_EX_NOACTIVATE := 16r8000000. WS_EX_NOPARENTNOTIFY := 16r4. WS_EX_OVERLAPPEDWINDOW := 16r300. WS_EX_PALETTEWINDOW := 16r188. WS_EX_RIGHT := 16r1000. WS_EX_RIGHTSCROLLBAR := 16r0. WS_EX_RTLREADING := 16r2000. WS_EX_STATICEDGE := 16r20000. WS_EX_TOOLWINDOW := 16r80. WS_EX_TOPMOST := 16r8. WS_EX_TRANSPARENT := 16r20. WS_EX_WINDOWEDGE := 16r100. WS_BORDER := 16r800000. WS_CAPTION := 16rC00000. WS_CHILD := 16r40000000. WS_CHILDWINDOW := 16r40000000. WS_CLIPCHILDREN := 16r2000000. WS_CLIPSIBLINGS := 16r4000000. WS_DISABLED := 16r8000000. WS_DLGFRAME := 16r400000. WS_GROUP := 16r20000. WS_HSCROLL := 16r100000. WS_ICONIC := 16r20000000. WS_MAXIMIZE := 16r1000000. WS_MAXIMIZEBOX := 16r10000. WS_MINIMIZE := 16r20000000. WS_MINIMIZEBOX := 16r20000. WS_OVERLAPPED := 16r0. WS_OVERLAPPEDWINDOW := 16rCF0000. WS_POPUP := 16r80000000. WS_POPUPWINDOW := 16r80880000. WS_SIZEBOX := 16r40000. WS_SYSMENU := 16r80000. WS_TABSTOP := 16r10000. WS_THICKFRAME := 16r40000. WS_TILED := 16r0. WS_TILEDWINDOW := 16rCF0000. WS_VISIBLE := 16r10000000. WS_VSCROLL := 16r200000. CS_BYTEALIGNCLIENT := 16r1000. CS_BYTEALIGNWINDOW := 16r2000. CS_CLASSDC := 16r40. CS_DBLCLKS := 16r8. CS_HREDRAW := 16r2. CS_NOCLOSE := 16r200. CS_OWNDC := 16r20. CS_PARENTDC := 16r80. CS_SAVEBITS := 16r800. CS_VREDRAW := 16r1. COLOR_ACTIVEBORDER := 10. COLOR_ACTIVECAPTION := 2. COLOR_APPWORKSPACE := 12. COLOR_BACKGROUND := 1. COLOR_BTNFACE := 15. COLOR_BTNHIGHLIGHT := 20. COLOR_BTNSHADOW := 16. COLOR_BTNTEXT := 18. COLOR_CAPTIONTEXT := 9. COLOR_GRAYTEXT := 17. COLOR_HIGHLIGHT := 13. COLOR_HIGHLIGHTTEXT := 14. COLOR_INACTIVEBORDER := 11. COLOR_INACTIVECAPTION := 3. COLOR_INACTIVECAPTIONTEXT := 19. COLOR_MENU := 4. COLOR_MENUTEXT := 7. COLOR_SCROLLBAR := 0. COLOR_WINDOW := 5. COLOR_WINDOWFRAME := 6. COLOR_WINDOWTEXT := 8. CW_USEDEFAULT := 16r80000000. HWND_BROADCAST := 16rFFFF. WM_DESTROY := 16r2. WM_MOVE := 16r3! SharedPool subclass: #Win32ShellErrors instanceVariableNames: 'errorNumber description' classVariableNames: 'ERROR_BAD_FORMAT ERROR_FILE_NOT_FOUND ERROR_PATH_NOT_FOUND OUT_OF_MEMORY_OR_RESOURCES SE_ERR_ACCESSDENIED SE_ERR_ACCOSINCOMPLETE SE_ERR_DDEBUSY SE_ERR_DDEFAIL SE_ERR_DDETIMEOUT SE_ERR_DDLNOTFOUND SE_ERR_FNF SE_ERR_NOASSOC SE_ERR_OOM SE_ERR_PNF SE_ERR_SHARE' poolDictionaries: '' category: 'FFI-Libraries-Win32'! Win32ShellErrors class instanceVariableNames: 'errors'! Win32ShellErrors class instanceVariableNames: 'errors'! ----- Method: Win32ShellErrors class>>initialize (in category 'as yet unclassified') ----- initialize self initializeWindowConstants! ----- Method: Win32ShellErrors class>>initializeWindowConstants (in category 'as yet unclassified') ----- initializeWindowConstants OUT_OF_MEMORY_OR_RESOURCES := self new errorNumber: 0; description: 'The operating system is out of memory or resources'. SE_ERR_FNF := self new errorNumber: 2; description: 'The specified file was not found'. SE_ERR_PNF := self new errorNumber: 3; description: 'The specified path was not found'. SE_ERR_ACCESSDENIED := self new errorNumber: 5; description: 'The operating system denied access to the specified file'. SE_ERR_OOM := self new errorNumber: 8; description: 'There was not enough memory to complete the operation'. ERROR_BAD_FORMAT := self new errorNumber: 11; description: 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image)'. SE_ERR_SHARE := self new errorNumber: 26; description: 'A sharing violation occurred'. SE_ERR_ACCOSINCOMPLETE := self new errorNumber: 27; description: 'The filename association is incomplete or invalid'. SE_ERR_DDETIMEOUT := self new errorNumber: 28; description: 'The DDE transaction could not be completed because the request timed out'. SE_ERR_DDEFAIL := self new errorNumber: 29; description: 'The DDE transaction failed'. SE_ERR_DDEBUSY := self new errorNumber: 30; description: 'The DDE transaction could not be completed because other DDE transactions were being processed'. SE_ERR_NOASSOC := self new errorNumber: 31; description: 'There is no application associated with the given filename extension'. SE_ERR_DDLNOTFOUND := self new errorNumber: 32; description: 'The specified dynamic-link library was not found'. errors := Dictionary new: (self allInstances size). self allInstances do: [:err| errors at: err errorNumber put: err ].! ----- Method: Win32ShellErrors class>>signal: (in category 'as yet unclassified') ----- signal: code | err | err := errors at: code ifAbsent: [Error signal: 'system error, code:', code]. Error signal: err errorString! ----- Method: Win32ShellErrors>>description (in category 'accessing') ----- description ^ description ! ----- Method: Win32ShellErrors>>description: (in category 'accessing') ----- description: anObject description := anObject. ! ----- Method: Win32ShellErrors>>errorNumber (in category 'accessing') ----- errorNumber ^ errorNumber ! ----- Method: Win32ShellErrors>>errorNumber: (in category 'accessing') ----- errorNumber: anObject errorNumber := anObject. ! ----- Method: Win32ShellErrors>>errorString (in category 'accessing') ----- errorString ^'system error, code: ', errorNumber, ' "', description, '"'! Object subclass: #Win32Error instanceVariableNames: 'errorCode' classVariableNames: 'ErrorCodes' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32Error class>>initialize (in category 'as yet unclassified') ----- initialize "Win32Error initialize" ErrorCodes := Dictionary new. ErrorCodes at: 203 put: #('ERROR_ENVVAR_NOT_FOUND' 'There was no environment variable with that name'); yourself! ----- Method: Win32Error class>>lastError (in category 'as yet unclassified') ----- lastError ^(self new) initializeWithLastError! ----- Method: Win32Error class>>win32GetLastError (in category 'as yet unclassified') ----- win32GetLastError "DWORD WINAPI GetLastError(void);" ^nil! ----- Method: Win32Error>>errorCode (in category 'as yet unclassified') ----- errorCode ^errorCode! ----- Method: Win32Error>>errorMessage (in category 'as yet unclassified') ----- errorMessage ^(ErrorCodes at: errorCode) at: 2 ifAbsent: ['Unknown Error: ' , errorCode]! ----- Method: Win32Error>>errorName (in category 'as yet unclassified') ----- errorName ^(ErrorCodes at: errorCode) at: 1 ifAbsent: ['ERROR_UNKNOWN_' , errorCode ]! ----- Method: Win32Error>>initializeWithLastError (in category 'as yet unclassified') ----- initializeWithLastError errorCode := self class win32GetLastError.! Object subclass: #Win32Utils instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! !Win32Utils commentStamp: 'tbn 8/22/2005 23:50' prior: 0! This is an utility class with helpfull methods for Win32 users. Note that it uses FFI and is platform dependent.! ----- Method: Win32Utils class>>apiFreeEnvironmentStrings: (in category 'api calls') ----- apiFreeEnvironmentStrings: extData "Win32Utils apiFreeEnvironmentStrings" ^self externalCallFailed! ----- Method: Win32Utils class>>apiGetEnvironmentStrings (in category 'api calls') ----- apiGetEnvironmentStrings "Win32Utils apiGetEnvironmentStrings" ^self externalCallFailed! ----- Method: Win32Utils class>>apiGetEnvironmentVariable:buffer:size: (in category 'api calls') ----- apiGetEnvironmentVariable: name buffer: buffer size: bufferSize "DWORD WINAPI GetEnvironmentVariable( __in_opt LPCTSTR lpName, __out_opt LPTSTR lpBuffer, __in DWORD nSize );" "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx" ^self externalCallFailed! ----- Method: Win32Utils class>>apiGetUserBuffer:size: (in category 'api calls') ----- apiGetUserBuffer: buffer size: bufferSize "BOOL WINAPI GetUserNameA( __out_opt LPSTR lpBuffer, __in LPDWORD pcbBuffer );" "https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-getusernamea" ^self externalCallFailed! ----- Method: Win32Utils class>>apiSetCursorPosX:y: (in category 'api calls') ----- apiSetCursorPosX: x y: y "this is apparently how to control the mouse cursor pragmatically on windows: http://lists.squeakfoundation.org/pipermail/squeak-dev/2011-February/157676.html " ^self externalCallFailed! ----- Method: Win32Utils class>>getCommonEnvironmentVariables (in category 'examples') ----- getCommonEnvironmentVariables "Returns a dictionary with common environment variables for Win32 systems" |map| map := Dictionary new. #('ALLUSERSPROFILE' 'APPDATA' 'COMPUTERNAME' 'COMSPEC' 'HOMEDRIVE' 'HOMEPATH' 'LOGONSERVER' 'SYSTEMDRIVE' 'OS' 'PATH' 'SYSTEMROOT' 'TEMP' 'TMP' 'USERDOMAIN' 'USERNAME' 'USERPROFILE' 'WINDIR') do: [:each | map at: each put: (self getEnvironmentVariable: each)]. ^map ! ----- Method: Win32Utils class>>getCurrentUser (in category 'accessing') ----- getCurrentUser " Win32Utils getCurrentUser " | nm sz | sz := (ByteArray new: 8). sz longAt: 1 put: 256 bigEndian: false. self apiGetUserBuffer: (nm := ByteArray new: 256) size: sz. ^(nm copyUpTo: 0) asString! ----- Method: Win32Utils class>>getEnvironmentVariable: (in category 'accessing') ----- getEnvironmentVariable: aString "Win32Utils getEnvironmentVariable: 'windir'" ^ self getEnvironmentVariable: aString ifAbsent: [nil]! ----- Method: Win32Utils class>>getEnvironmentVariable:buffer:ifAbsent: (in category 'accessing') ----- getEnvironmentVariable: name buffer: buffer ifAbsent: block "Win32Utils getEnvironmentVariable: 'APPDATA' " "Win32Utils getEnvironmentVariable: 'APPDATAx' " "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx " | retval err | retval := self apiGetEnvironmentVariable: name buffer: buffer size: buffer byteSize. retval = 0 ifTrue: [ err := Win32Error lastError. ^(err errorName = 'ERROR_ENVVAR_NOT_FOUND') ifTrue: [block value] ifFalse: [ self error: 'Problem with retrieving env var ' , name , '. Code is ' , err errorName. nil ] ]. ^(retval < buffer byteSize) ifTrue: [( buffer copyFrom: 1 to: retval ) asString] ifFalse: [ self getEnvironmentVariable: name buffer: (ByteArray new: retval) ifAbsent: block ]. ! ----- Method: Win32Utils class>>getEnvironmentVariable:ifAbsent: (in category 'accessing') ----- getEnvironmentVariable: name ifAbsent: block "Win32Utils getEnvironmentVariable: 'APPDATA' ifAbsent: [nil]" "Win32Utils getEnvironmentVariable: 'APPDATAx' ifAbsent: [5]" ^self getEnvironmentVariable: name buffer: (ByteArray new: 256) ifAbsent: block! ----- Method: Win32Utils class>>getEnvironmentVariables (in category 'accessing') ----- getEnvironmentVariables "Win32Utils getEnvironmentVariables" | externalData strs | externalData := self apiGetEnvironmentStrings. strs := externalData fromCStrings. self apiFreeEnvironmentStrings: externalData. ^strs ! ExternalPool subclass: #Win32Pool instanceVariableNames: '' classVariableNames: 'WIN32_WINNT_VISTA WIN32_WINNT_WIN10 WIN32_WINNT_WIN7 WIN32_WINNT_WIN8 WIN32_WINNT_WINXP' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32Pool class>>winver (in category 'definitions') ----- winver " self winver writePoolData. self winver readPoolData. " ')> ^ self poolDefinition! ----- Method: Win32Pool class>>winverData (in category 'definitions - data') ----- winverData "Automatically generated." " Win32Pool winver readPoolDataFrom: #methodSource. Win32Pool winver writePoolDataTo: #methodSource. " ^ { (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). Dictionary new at: #WIN32_WINNT_WIN7 put: 16r00000601; at: #WIN32_WINNT_WINXP put: 16r00000501; at: #WIN32_WINNT_VISTA put: 16r00000600; at: #WIN32_WINNT_WIN8 put: 16r00000602; at: #WIN32_WINNT_WIN10 put: 16r00000A00; yourself. } ! ExternalObject subclass: #MacOSShell instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-MacOS'! !MacOSShell commentStamp: 'spd 5/16/2010 22:33' prior: 0! I show how system functions can be called from within the image. WARNING: Under Snow Leopard, the VM (as of 4.2.4 beta) only searches its Resources folder for external libraries. See http://wiki.squeak.org/squeak/5846 for workarounds.! ----- Method: MacOSShell class>>escapeFileName: (in category 'utilities') ----- escapeFileName: aFileName "Try to make the argument suitable for use in 'system'. Just the simple stuff - backlash-prefix for obvious problems - quotes and white space." ^ String streamContents: [ : stream | aFileName do: [ : char | ('''" ()[]{}$&' includes: char) ifTrue: [ stream nextPut: $\ ]. stream nextPut: char. ]].! ----- Method: MacOSShell>>getenv: (in category 'basics') ----- getenv: aString self externalCallFailed! ----- Method: MacOSShell>>system: (in category 'basics') ----- system: aString "Note that the command will foreground-block the VM unless it ends with &" self externalCallFailed.! ExternalObject subclass: #Win32File instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32File class>>setReadOnly: (in category 'operations') ----- setReadOnly: fileString "Convenient shorthand." ^ (self new) setReadOnly: fileString! ----- Method: Win32File class>>setReadWrite: (in category 'operations') ----- setReadWrite: fileString "Convenient shorthand" ^ (self new) setReadWrite: fileString! ----- Method: Win32File>>getFileAttributes: (in category 'api calls') ----- getFileAttributes: fileString ^ self externalCallFailed! ----- Method: Win32File>>setFileAttributes:lpAttrs: (in category 'api calls') ----- setFileAttributes: fileString lpAttrs: aLong ^ self externalCallFailed! ----- Method: Win32File>>setReadOnly: (in category 'operations') ----- setReadOnly: fileString "Set FILE_READ_ONLY (bit 1)" | attrs | attrs := (self getFileAttributes: fileString). attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. (self setFileAttributes: fileString lpAttrs: (attrs bitOr: 1)) = 0 ifTrue: [ self error: 'Cannot set file attributes. System error.' ].! ----- Method: Win32File>>setReadWrite: (in category 'operations') ----- setReadWrite: fileString "Clear FILE_READ_ONLY (bit 1)" | attrs | attrs := (self getFileAttributes: fileString). attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. (self setFileAttributes: fileString lpAttrs: (attrs bitClear: 1)) = 0 ifTrue: [ self error: 'Cannot set file attributes. System error.' ].! ExternalObject subclass: #Win32Shell instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! !Win32Shell commentStamp: '' prior: 0! This class wrappes the Windows 32 shell. Try Win32Shell new shellOpen: 'c:\image.bmp' to open a document Win32Shell new shellOpen: 'c:\myprogram.exe' to start an executable Win32Shell new shellExplore: 'c:\' to explore a directory Win32Shell new shellFind: 'c:\' to initiate a search Note that this class is platform specific. ! ----- Method: Win32Shell>>error: (in category 'operations') ----- error: code Win32ShellErrors signal: code! ----- Method: Win32Shell>>shellExecute: (in category 'operations') ----- shellExecute: aFileString "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 0. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ----- Method: Win32Shell>>shellExecute:arguments:toPath: (in category 'operations') ----- shellExecute: aFileString arguments: arguments toPath: outputPath "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: arguments lpDirectory: outputPath nShowCmd: 0. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ----- Method: Win32Shell>>shellExecute:lpOperation:lpFile:lpParameters:lpDirectory:nShowCmd: (in category 'api calls') ----- shellExecute: hwnd lpOperation: opString lpFile: fileString lpParameters: parmString lpDirectory: dirString nShowCmd: anInteger "Opens or prints the specified file, which can be an executable or document file. HINSTANCE ShellExecute( HWND hwnd, // handle to parent window LPCTSTR lpOperation, // pointer to string that specifies operation to perform LPCTSTR lpFile, // pointer to filename or folder name string LPCTSTR lpParameters, // pointer to string that specifies executable-file parameters LPCTSTR lpDirectory, // pointer to string that specifies default directory INT nShowCmd // whether file is shown when opened );" ! ----- Method: Win32Shell>>shellExplore: (in category 'operations') ----- shellExplore: aPathString "Explores the folder specified by aPathString" | result | result := self shellExecute: nil lpOperation: 'explore' lpFile: aPathString lpParameters: nil lpDirectory: nil nShowCmd: 1. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ----- Method: Win32Shell>>shellFind: (in category 'operations') ----- shellFind: aPathString "Initiates a search starting from the specified directory." | result | result := self shellExecute: nil lpOperation: 'find' lpFile: nil lpParameters: nil lpDirectory: aPathString nShowCmd: 1. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ----- Method: Win32Shell>>shellOpen: (in category 'operations') ----- shellOpen: aFileString "Opens the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: nil lpDirectory: nil nShowCmd: 1. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ----- Method: Win32Shell>>shellOpen:arguments:toPath: (in category 'operations') ----- shellOpen: aFileString arguments: arguments toPath: outputPath "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, or a folder." | result fileUrlString | "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." fileUrlString := (aFileString asLowercase beginsWith: 'file:') ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] ifFalse: [aFileString]. result := self shellExecute: nil lpOperation: 'open' lpFile: fileUrlString lpParameters: arguments lpDirectory: outputPath nShowCmd: 1. (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! ExternalLibrary subclass: #CStandardLibrary instanceVariableNames: '' classVariableNames: 'CheckCStandardLibraryOnStartUp ModuleName' poolDictionaries: '' category: 'FFI-Libraries-LibC'! !CStandardLibrary commentStamp: 'mt 5/26/2021 10:08' prior: 0! The ISO C standard library, also known as "CRT" and "libc." Further reading: https://www.gnu.org/software/libc/ https://docs.microsoft.com/en-us/cpp/c-runtime-library https://www.cplusplus.com/reference/clibrary/ https://www.iso.org/standard/82075.html! ----- Method: CStandardLibrary class>>checkCStandardLibrary (in category 'preferences') ----- checkCStandardLibrary "Try to use C Standard Library. Warn if not possible." [ [self assert: [(self default abs: -5) = 5] ] ifError: [:msg | self notify: 'C standard library not available. Please check module name in preferences.', String cr, String cr, msg] ] fork. "Do not interrupt the startup list."! ----- Method: CStandardLibrary class>>checkCStandardLibraryOnStartUp (in category 'preferences') ----- checkCStandardLibraryOnStartUp ^ CheckCStandardLibraryOnStartUp ifNil: [true]! ----- Method: CStandardLibrary class>>checkCStandardLibraryOnStartUp: (in category 'preferences') ----- checkCStandardLibraryOnStartUp: aBoolean CheckCStandardLibraryOnStartUp := aBoolean.! ----- Method: CStandardLibrary class>>guessModuleName (in category 'preferences') ----- guessModuleName "The the platform's module name for the C library." | platform | platform := FFIPlatformDescription current. platform isMacOS ifTrue: [ ^ platform osVersionMajor >= 11 "Big Sur and beyond" ifTrue:['libSystem.dylib'] ifFalse: [platform osVersionMajor >= 10 ifFalse: ['libc.dylib' "Mac OS 9"] ifTrue: [platform osVersionMinor >= 7 "at least OS X 10.7 (Lion)" ifTrue: ['libobjc.dylib'] ifFalse: [platform osVersionMinor >= 5 "at least Mac OS X 10.5 (Leopard)" ifTrue: ['libgcc_s.1.dylib'] ifFalse: ['libc.dylib']]]]]. platform isWindows ifTrue: [ ^ 'msvcrt.dll']. platform isUnix ifTrue: [ ^ platform osVersion = 'linux-gnu' ifTrue: ['libc.so.6'] ifFalse: ['libc.so']]. ^ nil! ----- Method: CStandardLibrary class>>initialize (in category 'class initialization') ----- initialize " self initialize " Smalltalk addToStartUpList: self after: (Smalltalk classNamed: #FFIPlatformDescription).! ----- Method: CStandardLibrary class>>moduleName (in category 'preferences') ----- moduleName ^ ModuleName ifNil: [self guessModuleName]! ----- Method: CStandardLibrary class>>moduleName: (in category 'preferences') ----- moduleName: nameOrNil ModuleName := nameOrNil = String empty ifFalse: [nameOrNil = self guessModuleName ifFalse: [nameOrNil]]. self clearAllCaches. "Check the provided name only if overwritten by clients." ModuleName ifNotNil: [self checkCStandardLibrary].! ----- Method: CStandardLibrary class>>startUp: (in category 'system startup') ----- startUp: resuming resuming ifTrue: [ self checkCStandardLibraryOnStartUp ifTrue: [ self checkCStandardLibrary]].! ----- Method: CStandardLibrary class>>unload (in category 'class initialization') ----- unload Smalltalk removeFromStartUpList: self.! ----- Method: CStandardLibrary>>abs: (in category 'stdlib.h - integer arithmetics') ----- abs: n "Returns the absolute value of parameter n" ^ self externalCallFailed ! ----- Method: CStandardLibrary>>bsearch:with:with:with:with: (in category 'stdlib.h - searching and sorting') ----- bsearch: key with: base with: num with: size with: compar ^ self externalCallFailed ! ----- Method: CStandardLibrary>>qsort:with:with:with: (in category 'stdlib.h - searching and sorting') ----- qsort: base with: num with: size with: compar ^ self externalCallFailed ! CStandardLibrary subclass: #LibC instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-LibC'! !LibC commentStamp: 'mt 5/26/2021 10:09' prior: 0! Just a synonym for convenient reference.! ExternalTypeAlias subclass: #Win32Handle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! Win32Handle subclass: #Win32HDC instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32HDC>>apiDeleteDC: (in category 'api calls') ----- apiDeleteDC: aHDC ^self externalCallFailed! ----- Method: Win32HDC>>apiDrawFocusRect:with: (in category 'api calls') ----- apiDrawFocusRect: aHDC with: lpRect "Draws a rectangle in the style used to indicate that the rectangle has the focus." ^ self externalCallFailed! ----- Method: Win32HDC>>apiDrawFrameControl:with:with:with: (in category 'api calls') ----- apiDrawFrameControl: aHDC with: lpRect with: type with: state "Draws a frame control of the specified type and style" ^ self externalCallFailed! ----- Method: Win32HDC>>apiEllipse:with:with:with:with: (in category 'api calls') ----- apiEllipse: aHDC with: left with: top with: right with: bottom ^self externalCallFailed! ----- Method: Win32HDC>>apiExtFloodFill:with:with:with:with: (in category 'api calls') ----- apiExtFloodFill: aHDC with: x with: y with: colorref with: fillType "fills an area of the display surface with the current brush" ^ self externalCallFailed! ----- Method: Win32HDC>>apiFillRect:with:with: (in category 'api calls') ----- apiFillRect: aHDC with: lpRect with: brush "Fills a rectangle by using the specified brush. This function includes the left and top borders, but excludes the right and bottom borders of the rectangle. " ^ self externalCallFailed! ----- Method: Win32HDC>>apiFrameRect:with:with: (in category 'api calls') ----- apiFrameRect: aHDC with: lpRect with: brush "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." ^ self externalCallFailed! ----- Method: Win32HDC>>apiLineTo:with:with: (in category 'api calls') ----- apiLineTo: aHDC with: x with: y ^self externalCallFailed! ----- Method: Win32HDC>>apiMoveToEx:with:with:with: (in category 'api calls') ----- apiMoveToEx: aHDC with: x with: y with: pt ^self externalCallFailed! ----- Method: Win32HDC>>apiRectangle:with:with:with:with: (in category 'api calls') ----- apiRectangle: aHDC with: left with: top with: right with: bottom ^self externalCallFailed! ----- Method: Win32HDC>>apiRoundRect:with:with:with:with:with:with: (in category 'api calls') ----- apiRoundRect: aHDC with: left with: top with: right with: bottom with: width with: height "Draws a rectangle with rounded corners. The rectangle is outlined by using the current pen and filled by using the current brush" ^ self externalCallFailed! ----- Method: Win32HDC>>apiSelectObject:with: (in category 'api calls') ----- apiSelectObject: aHDC with: aHGDIOBJ ^self externalCallFailed! ----- Method: Win32HDC>>delete (in category 'initialize-release') ----- delete handle == nil ifFalse:[self apiDeleteDC: self]. handle := nil.! ----- Method: Win32HDC>>drawFocusRectangle: (in category 'drawing') ----- drawFocusRectangle: aRect "draws a rectangle in the style used to indicate that the rectangle has the focus" self apiDrawFocusRect: self with: (Win32Rectangle fromRectangle: aRect) ! ----- Method: Win32HDC>>drawFrameControl:type:style: (in category 'drawing') ----- drawFrameControl: aRect type: aType style: aStyle "Draws a frame control of the specified type and style (integer values)" self apiDrawFrameControl: self with: (Win32Rectangle fromRectangle: aRect) with: aType with: aStyle! ----- Method: Win32HDC>>ellipse: (in category 'drawing') ----- ellipse: aRect ^self apiEllipse: self with: aRect left with: aRect top with: aRect right with: aRect bottom! ----- Method: Win32HDC>>fillRectangle:color: (in category 'drawing') ----- fillRectangle: aRect color: aColor "fills an area of the display with the given color" | brush | brush := Win32HBrush createSolidBrush: aColor asColorref. self apiFillRect: self with: (Win32Rectangle fromRectangle: aRect) with: brush. brush delete! ----- Method: Win32HDC>>floodFillAt:boundaryColor:fillColor: (in category 'drawing') ----- floodFillAt: aPoint boundaryColor: aColor fillColor: anotherColor "fills an area of the display with the given color" | newBrush oldBrush | newBrush := Win32HBrush createSolidBrush: anotherColor asColorref. oldBrush := self selectObject: newBrush. (self apiExtFloodFill: self with: aPoint x with: aPoint y with: aColor asColorref with: 0) inspect. self selectObject: oldBrush. newBrush delete! ----- Method: Win32HDC>>frameRectangle:brush: (in category 'drawing') ----- frameRectangle: aRect brush: aBrush "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." self apiFrameRect: self with: (Win32Rectangle fromRectangle: aRect) with: aBrush. ! ----- Method: Win32HDC>>lineTo: (in category 'drawing') ----- lineTo: aPoint ^self apiLineTo: self with: aPoint x with: aPoint y! ----- Method: Win32HDC>>moveTo: (in category 'drawing') ----- moveTo: aPoint ^self apiMoveToEx: self with: aPoint x with: aPoint y with: nil! ----- Method: Win32HDC>>rectangle: (in category 'drawing') ----- rectangle: aRect ^self apiRectangle: self with: aRect left with: aRect top with: aRect right with: aRect bottom! ----- Method: Win32HDC>>roundRectangle:width:height: (in category 'drawing') ----- roundRectangle: aRect width: width height: height ^ self apiRoundRect: self with: aRect left with: aRect top with: aRect right with: aRect bottom with: width with: height! ----- Method: Win32HDC>>selectObject: (in category 'drawing') ----- selectObject: aHGDIOBJ ^self apiSelectObject: self with: aHGDIOBJ! Win32Handle subclass: #Win32HGDIObj instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! Win32HGDIObj subclass: #Win32HBrush instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32HBrush class>>apiCreateHatchBrush:with: (in category 'api calls') ----- apiCreateHatchBrush: aStyle with: colorref "Creates a logical brush that has the specified hatch pattern and color" ^ self externalCallFailed! ----- Method: Win32HBrush class>>backwardDiagonalWithColor: (in category 'hatch brushes') ----- backwardDiagonalWithColor: aColor "45-degree downward left-to-right hatch brush" ^ self createHatchBrush: 3 color: aColor! ----- Method: Win32HBrush class>>createHatchBrush:color: (in category 'instance creation') ----- createHatchBrush: aStyle color: aColor "Creates an instance of the receiver that has the specified hatch pattern and color" ^ self apiCreateHatchBrush: aStyle with: aColor asColorref! ----- Method: Win32HBrush class>>createSolidBrush: (in category 'instance creation') ----- createSolidBrush: aCOLORREF ^self externalCallFailed! ----- Method: Win32HBrush class>>crossWithColor: (in category 'hatch brushes') ----- crossWithColor: aColor "Horizontal and vertical crosshatch brush" ^ self createHatchBrush: 4 color: aColor! ----- Method: Win32HBrush class>>diagonalCrossWithColor: (in category 'hatch brushes') ----- diagonalCrossWithColor: aColor "45-degree crosshatch brush" ^ self createHatchBrush: 5 color: aColor! ----- Method: Win32HBrush class>>forwardDiagonalWithColor: (in category 'hatch brushes') ----- forwardDiagonalWithColor: aColor "45-degree upward left-to-right hatch brush" ^ self createHatchBrush: 2 color: aColor! ----- Method: Win32HBrush class>>horizontalWithColor: (in category 'hatch brushes') ----- horizontalWithColor: aColor "Horizontal hatch brush" ^ self createHatchBrush: 0 color: aColor! ----- Method: Win32HBrush class>>verticalWithColor: (in category 'hatch brushes') ----- verticalWithColor: aColor "Horizontal hatch brush" ^ self createHatchBrush: 1 color: aColor ! ----- Method: Win32HGDIObj>>apiDeleteObject: (in category 'api calls') ----- apiDeleteObject: aHGDIOBJ ^self externalCallFailed! ----- Method: Win32HGDIObj>>delete (in category 'initialize-release') ----- delete self apiDeleteObject: self! ----- Method: Win32Handle class>>originalTypeName (in category 'accessing') ----- originalTypeName "Win32Handle defineFields" "The following really means typedef void* Win32Handle; " ^ 'uintptr_t'! Win32Handle subclass: #Win32Window instanceVariableNames: '' classVariableNames: '' poolDictionaries: 'Win32Constants' category: 'FFI-Libraries-Win32'! !Win32Window commentStamp: '' prior: 0! Here's a simple Win32 example: | hwnd dc dst | hwnd _ Win32Window getFocus. "fetch the window currently having the focus" dc _ hwnd getDC. "grab the dc or the window" dst _ 100. dc moveTo: 0 at 0. "draw a rect" dc lineTo: dst at 0. dc lineTo: dst at dst. dc lineTo: 0 at dst. dc lineTo: 0 at 0. "and a cross" dc lineTo: dst at dst. dc moveTo: dst at 0. dc lineTo: 0 at dst. hwnd releaseDC: dc.! ----- Method: Win32Window class>>coloredEllipses (in category 'examples') ----- coloredEllipses "Win32Window coloredEllipses" "Draw a bunch of ellipses" | rnd pt1 pt2 w h colors newBrush oldBrush | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to COLORREF" colors := colors collect:[:c| (c red * 255) asInteger + ((c green * 255) asInteger << 8) + ((c blue * 255) asInteger << 16)]. rnd := Random new. w := Display width. h := Display height. self getFocus getHDCDuring:[:hDC| [Sensor anyButtonPressed] whileFalse:[ newBrush := Win32HBrush createSolidBrush: colors atRandom. oldBrush := hDC selectObject: newBrush. pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. hDC ellipse: (Rectangle encompassing: (Array with: pt1 with: pt2)). hDC selectObject: oldBrush. newBrush delete. ]. ]. Display forceToScreen.! ----- Method: Win32Window class>>coloredRectangles (in category 'examples') ----- coloredRectangles "Win32Window coloredRectangles" "Draw a bunch of ellipses" | rnd pt1 pt2 w h colors newBrush oldBrush n nPixels time r | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to COLORREF" colors := colors collect:[:c| (c red * 255) asInteger + ((c green * 255) asInteger << 8) + ((c blue * 255) asInteger << 16)]. rnd := Random new. w := Display width. h := Display height. self getFocus getHDCDuring:[:hDC| n := 0. nPixels := 0. time := Time millisecondClockValue. [Sensor anyButtonPressed] whileFalse:[ newBrush := Win32HBrush createSolidBrush: colors atRandom. oldBrush := hDC selectObject: newBrush. pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. hDC rectangle: (r := Rectangle encompassing: (Array with: pt1 with: pt2)). hDC selectObject: oldBrush. newBrush delete. n := n + 1. nPixels := nPixels + ((r right - r left) * (r bottom - r top)). (n \\ 100) = 0 ifTrue:[ 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) asStringWithCommas displayAt: 0 at 0]. ]. ]. Display forceToScreen.! ----- Method: Win32Window class>>getDesktopWindow (in category 'accessing') ----- getDesktopWindow "Return the HWND describing the desktop" ^self externalCallFailed! ----- Method: Win32Window class>>getFocus (in category 'accessing') ----- getFocus "Return the HWND currently having the input focus" ^self externalCallFailed! ----- Method: Win32Window class>>getMainWindowText: (in category 'examples') ----- getMainWindowText: aString "Returns the window text of the main window" self new getWindowText: Win32Window getFocus ! ----- Method: Win32Window class>>getWindowLong:index: (in category 'private') ----- getWindowLong: hwnd index: index "Retrieves information about the specified window." ^self externalCallFailed! ----- Method: Win32Window class>>getWindowStyle (in category 'private') ----- getWindowStyle "Returns the window style for the focus window" ^self getWindowLong: self getFocus index: GWL_STYLE ! ----- Method: Win32Window class>>setMainWindowText: (in category 'examples') ----- setMainWindowText: aString "Sets the window text of the main window" self new apiSetWindowText: Win32Window getFocus text: aString! ----- Method: Win32Window class>>setNonResizable (in category 'private') ----- setNonResizable " self setNonResizable " | newStyle | newStyle := self getWindowStyle bitClear: ((WS_SIZEBOX bitOr: WS_MINIMIZE) bitOr: WS_MAXIMIZE). self setWindowLong: self getFocus index: GWL_STYLE value: newStyle. ! ----- Method: Win32Window class>>setWindowLong:index:value: (in category 'private') ----- setWindowLong: hwnd index: index value: value "Sets information about the specified window." ^self externalCallFailed! ----- Method: Win32Window class>>win32Draw (in category 'examples') ----- win32Draw "Win32Window win32Draw" "Draw a bunch of lines using the Windows API" | hWnd hDC pt | hWnd := Win32Window getFocus. hDC := hWnd getDC. hDC moveTo: (hWnd screenToClient: Win32Point getCursorPos). [Sensor anyButtonPressed] whileFalse:[ pt := Win32Point getCursorPos. hWnd screenToClient: pt. hDC lineTo: pt. ]. hWnd releaseDC: hDC. Display forceToScreen.! ----- Method: Win32Window>>apiGetDC: (in category 'api calls') ----- apiGetDC: aHWND ^self externalCallFailed! ----- Method: Win32Window>>apiGetParent: (in category 'api calls') ----- apiGetParent: aWindow ^self externalCallFailed! ----- Method: Win32Window>>apiGetWindowText:buffer:maxCount: (in category 'api calls') ----- apiGetWindowText: handleWindow buffer: aBuffer maxCount: aNumber self externalCallFailed! ----- Method: Win32Window>>apiMessageBox:text:title:flags: (in category 'api calls') ----- apiMessageBox: aHWND text: aString title: aTitle flags: flags ^self externalCallFailed! ----- Method: Win32Window>>apiReleaseDC:with: (in category 'api calls') ----- apiReleaseDC: aHWND with: aHDC ^self externalCallFailed! ----- Method: Win32Window>>apiScreenToClient:with: (in category 'api calls') ----- apiScreenToClient: aHWND with: aPOINT ^self externalCallFailed! ----- Method: Win32Window>>apiSetWindowPosition:insertAfter:x:y:cx:cy:flags: (in category 'api calls') ----- apiSetWindowPosition: handleWindow insertAfter: handleAfterWindow x: x y: y cx: cx cy: cy flags: flags ^self primitiveFailed ! ----- Method: Win32Window>>apiSetWindowText:text: (in category 'api calls') ----- apiSetWindowText: handleWindow text: aString ^self externalCallFailed! ----- Method: Win32Window>>getDC (in category 'accessing') ----- getDC "Return the DC associated with the window" ^self apiGetDC: self! ----- Method: Win32Window>>getHDCDuring: (in category 'accessing') ----- getHDCDuring: aBlock "Provide a Win32 HDC during the execution of aBlock" | hDC | hDC := self getDC. [aBlock value: hDC] ensure:[self releaseDC: hDC].! ----- Method: Win32Window>>getParent (in category 'accessing') ----- getParent | wnd | wnd := self apiGetParent: self. ^wnd handle = 0 ifTrue:[nil] ifFalse:[wnd]! ----- Method: Win32Window>>getWindowText: (in category 'api calls') ----- getWindowText: handleWindow "self new getWindowText: Win32Window getFocus" |buffer maxSize | maxSize := 255. buffer := ByteArray new: maxSize. self apiGetWindowText: handleWindow buffer: buffer maxCount: maxSize. ^buffer asString ! ----- Method: Win32Window>>messageBox: (in category 'accessing') ----- messageBox: aString "Win32Window getFocus messageBox:'Hello World'" ^self messageBox: aString title: 'Squeak'! ----- Method: Win32Window>>messageBox:title: (in category 'accessing') ----- messageBox: aString title: aTitle "Win32Window getFocus messageBox:'Hello World' title:'News from Squeak:'" ^self messageBox: aString title: aTitle flags: 0! ----- Method: Win32Window>>messageBox:title:flags: (in category 'accessing') ----- messageBox: aString title: aTitle flags: flags "Win32Window getFocus messageBox:'Are you ready???' title:'News from Squeak:' flags: 3" ^self apiMessageBox: self text: aString title: aTitle flags: flags! ----- Method: Win32Window>>releaseDC: (in category 'accessing') ----- releaseDC: aHDC "Release the given DC" self apiReleaseDC: self with: aHDC! ----- Method: Win32Window>>screenToClient: (in category 'accessing') ----- screenToClient: aPoint self apiScreenToClient: self with: aPoint. ^aPoint! ExternalTypeAlias subclass: #X11ID instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-X11'! !X11ID commentStamp: 'mt 6/4/2020 19:16' prior: 0! I am an opaque handle in X11.! X11ID subclass: #X11Drawable instanceVariableNames: 'display xid' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-X11'! ----- Method: X11Drawable class>>display: (in category 'instance creation') ----- display: aX11Display ^ self new display: aX11Display! ----- Method: X11Drawable>>display (in category 'accessing') ----- display ^display! ----- Method: X11Drawable>>display: (in category 'accessing') ----- display: aDisplay display := aDisplay! ----- Method: X11Drawable>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: self class name; nextPut: $(; nextPutAll: self xid printStringHex; nextPut: $) ! ----- Method: X11Drawable>>xid (in category 'accessing') ----- xid ^ xid! ----- Method: X11Drawable>>xid: (in category 'accessing') ----- xid: anUnsignedInteger xid := anUnsignedInteger! ----- Method: X11ID class>>originalTypeName (in category 'field definition') ----- originalTypeName " self defineFields " ^ 'size_t' "or always uint32_t ??"! X11ID subclass: #X11Window instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-X11'! ExternalStructure subclass: #MacPixPatPtr instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-MacOS'! !MacPixPatPtr commentStamp: 'spd 5/16/2010 22:32' prior: 0! See class comment for MacRect.! ----- Method: MacPixPatPtr class>>fields (in category 'field definition') ----- fields "MacPixPatPtr defineFields" "The following really means typedef void* MacPixPatPtr; " ^#(nil 'void*') "For now this is just an opaque handle"! ----- Method: MacPixPatPtr class>>newPixPat (in category 'instance creation') ----- newPixPat ^self externalCallFailed! ----- Method: MacPixPatPtr>>apiDisposePixPat: (in category 'api calls') ----- apiDisposePixPat: aPixPat ^self externalCallFailed! ----- Method: MacPixPatPtr>>apiMakeRGBPat:with: (in category 'api calls') ----- apiMakeRGBPat: aPixPat with: aRGBColor ^self externalCallFailed! ----- Method: MacPixPatPtr>>dispose (in category 'initialize-release') ----- dispose handle == nil ifFalse:[ self apiDisposePixPat: self. handle := nil. ].! ----- Method: MacPixPatPtr>>makeRGBPattern: (in category 'accessing') ----- makeRGBPattern: aColor ^self apiMakeRGBPat: self with: (MacRGBColor fromColor: aColor)! ExternalStructure subclass: #MacPoint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-MacOS'! !MacPoint commentStamp: 'spd 5/16/2010 22:32' prior: 0! See class comment for MacRect.! ----- Method: MacPoint class>>apiLineTo:with: (in category 'api calls') ----- apiLineTo: x with: y ^self externalCallFailed! ----- Method: MacPoint class>>apiMoveTo:with: (in category 'api calls') ----- apiMoveTo: x with: y ^self externalCallFailed! ----- Method: MacPoint class>>fields (in category 'field definition') ----- fields "MacPoint defineFields" ^#( (v 'short') (h 'short') )! ----- Method: MacPoint class>>lineTo: (in category 'examples') ----- lineTo: aPoint "MacPoint moveTo: 0 at 0; lineTo: 100 at 100" ^self apiLineTo: aPoint x with: aPoint y ! ----- Method: MacPoint class>>macDraw (in category 'examples') ----- macDraw "MacPoint macDraw" | pt | pt := self new. pt getMousePoint. self moveTo: pt. [Sensor anyButtonPressed] whileFalse:[ pt getMousePoint. self lineTo: pt. ]. Display forceToScreen.! ----- Method: MacPoint class>>moveTo: (in category 'examples') ----- moveTo: aPoint "MacPoint moveTo: 0 at 0; lineTo: 100 at 100" ^self apiMoveTo: aPoint x with: aPoint y ! ----- Method: MacPoint>>apiGetMousePoint: (in category 'api calls') ----- apiGetMousePoint: aMacPoint ^self externalCallFailed! ----- Method: MacPoint>>getMousePoint (in category 'accessing') ----- getMousePoint ^self apiGetMousePoint: self! ----- Method: MacPoint>>x (in category 'accessing') ----- x ^self h! ----- Method: MacPoint>>x: (in category 'accessing') ----- x: anObject ^self h: anObject! ----- Method: MacPoint>>y (in category 'accessing') ----- y ^self v! ----- Method: MacPoint>>y: (in category 'accessing') ----- y: anObject ^self v: anObject! ExternalStructure subclass: #MacRGBColor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-MacOS'! !MacRGBColor commentStamp: 'spd 5/16/2010 22:31' prior: 0! See class comment for MacRect.! ----- Method: MacRGBColor class>>fields (in category 'field definition') ----- fields "MacRGBColor defineFields" ^#( (red 'ushort') (green 'ushort') (blue 'ushort') )! ----- Method: MacRGBColor class>>fromColor: (in category 'instance creation') ----- fromColor: aColor ^(self new) red: (aColor red * 16rFFFF) rounded; green: (aColor green * 16rFFFF) rounded; blue: (aColor blue * 16rFFFF) rounded; yourself! ExternalStructure subclass: #MacRect instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-MacOS'! !MacRect commentStamp: 'spd 5/16/2010 22:42' prior: 0! I, with my friends (MacPixPatPtr, MacPoint and MacRGBColor), show how to make calls into a Mac OS framework. The particular library I use in my examples, QuickDraw, is depreciated in OS X 10.4, but the examples still run as of OS X 10.6.2 See http://developer.apple.com/legacy/mac/library/documentation/Carbon/Reference/QuickDraw_Ref/Reference/reference.html for more information. WARNING: for Snow Leopard, see warning in MacOSShell! ----- Method: MacRect class>>apiFillCOval:with: (in category 'api calls') ----- apiFillCOval: r with: pat ^self externalCallFailed! ----- Method: MacRect class>>apiFillCRect:with: (in category 'api calls') ----- apiFillCRect: r with: pat ^self externalCallFailed! ----- Method: MacRect class>>apiFrameOval: (in category 'api calls') ----- apiFrameOval: r ^self externalCallFailed! ----- Method: MacRect class>>apiFrameRect: (in category 'api calls') ----- apiFrameRect: r ^self externalCallFailed! ----- Method: MacRect class>>coloredEllipses (in category 'examples') ----- coloredEllipses "MacRect coloredEllipses" | rnd w h colors n r pat v0 v1 | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to PixPats" colors := colors collect:[:c| MacPixPatPtr newPixPat makeRGBPattern: c]. rnd := Random new. w := Display width. h := Display height. n := 0. r := MacRect new. [Sensor anyButtonPressed] whileFalse:[ pat := colors atRandom. v0 := (rnd next * w) asInteger. v1 := (rnd next * w) asInteger. v0 < v1 ifTrue:[r left: v0; right: v1] ifFalse:[r left: v1; right: v0]. v0 := (rnd next * h) asInteger. v1 := (rnd next * h) asInteger. v0 < v1 ifTrue:[r top: v0; bottom: v1] ifFalse:[r top: v1; bottom: v0]. self apiFillCOval: r with: pat. self apiFrameOval: r. n := n + 1. (n \\ 10) = 0 ifTrue:[n printString displayAt: 0 at 0]. ]. colors do:[:c| c dispose]. Display forceToScreen.! ----- Method: MacRect class>>coloredRectangles (in category 'examples') ----- coloredRectangles "MacRect coloredRectangles" | rnd w h colors n r pat v0 v1 nPixels time | colors := Color colorNames collect:[:cName| (Color perform: cName)]. "convert to PixPats" colors := colors collect:[:c| MacPixPatPtr newPixPat makeRGBPattern: c]. rnd := Random new. w := Display width. h := Display height. n := 0. r := MacRect new. nPixels := 0. time := Time millisecondClockValue. [Sensor anyButtonPressed] whileFalse:[ pat := colors atRandom. v0 := (rnd next * w) asInteger. v1 := (rnd next * w) asInteger. v0 < v1 ifTrue:[r left: v0; right: v1] ifFalse:[r left: v1; right: v0]. v0 := (rnd next * h) asInteger. v1 := (rnd next * h) asInteger. v0 < v1 ifTrue:[r top: v0; bottom: v1] ifFalse:[r top: v1; bottom: v0]. self apiFillCRect: r with: pat. self apiFrameRect: r. n := n + 1. nPixels := nPixels + ((r right - r left) * (r bottom - r top)). (n \\ 100) = 0 ifTrue:[ 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) asStringWithCommas displayAt: 0 at 0]. ]. colors do:[:c| c dispose]. Display forceToScreen.! ----- Method: MacRect class>>fields (in category 'field definition') ----- fields "MacRect defineFields" ^#( (top 'short') (left 'short') (bottom 'short') (right 'short') )! ----- Method: MacRect class>>macDraw (in category 'examples') ----- macDraw "MacRect macDraw" ^MacPoint macDraw! ExternalStructure subclass: #Win32Point instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32Point class>>apiGetCursorPos: (in category 'api calls') ----- apiGetCursorPos: pt ^self externalCallFailed! ----- Method: Win32Point class>>fields (in category 'accessing') ----- fields "POINT defineFields" ^#( (x 'long') (y 'long') )! ----- Method: Win32Point class>>getCursorPos (in category 'instance creation') ----- getCursorPos | pt | pt := self new. self apiGetCursorPos: pt. ^pt! ----- Method: Win32Point>>asPoint (in category 'converting') ----- asPoint ^self x @ self y! ExternalStructure subclass: #Win32Rectangle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-Win32'! ----- Method: Win32Rectangle class>>fields (in category 'accessing') ----- fields "Win32Rectangle defineFields" ^ #(#(#left 'long') #(#top 'long') #(#right 'long') #(#bottom 'long') )! ----- Method: Win32Rectangle class>>fromRectangle: (in category 'instance creation') ----- fromRectangle: rc "returns an instance of the receiver from the given smalltalk rectangle" ^ self new left: rc left top: rc top right: rc right bottom: rc bottom ! ----- Method: Win32Rectangle>>left:top:right:bottom: (in category 'accessing') ----- left: left top: top right: right bottom: bottom "sets the coordinates of the receiver" self left: left. self top: top. self right: right. self bottom: bottom ! ExternalStructure subclass: #X11Display instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-X11'! ----- Method: X11Display class>>XOpenDisplay: (in category 'instance creation') ----- XOpenDisplay: displayName "X11Display XOpenDisplay: nil" ^self externalCallFailed! ----- Method: X11Display class>>coloredEllipses (in category 'examples') ----- coloredEllipses "X11Display coloredEllipses" | display window gc colors rnd w h pt1 pt2 r | display := X11Display XOpenDisplay: nil. window := display ourWindow. gc := X11GC on: window. colors := Color colorNames collect:[:n| (Color perform: n) pixelWordForDepth: 32]. rnd := Random new. w := Display width. h := Display height. [Sensor anyButtonPressed] whileFalse:[ pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. r := Rectangle encompassing: (Array with: pt1 with: pt2). gc foreground: colors atRandom. gc fillOval: r. gc foreground: 0. gc drawOval: r. display sync. ]. gc free. display closeDisplay. Display forceToScreen.! ----- Method: X11Display class>>coloredRectangles (in category 'examples') ----- coloredRectangles "X11Display coloredRectangles" | display window gc colors rnd w h pt1 pt2 r nPixels time n | display := X11Display XOpenDisplay: nil. window := display ourWindow. gc := X11GC on: window. colors := Color colorNames collect:[:cn| (Color perform: cn) pixelWordForDepth: 32]. rnd := Random new. w := Display width. h := Display height. n := 0. nPixels := 0. time := Time millisecondClockValue. [Sensor anyButtonPressed] whileFalse:[ pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. r := Rectangle encompassing: (Array with: pt1 with: pt2). gc foreground: colors atRandom. gc fillRectangle: r. gc foreground: 0. gc drawRectangle: r. display sync. n := n + 1. nPixels := nPixels + ((r right - r left) * (r bottom - r top)). (n \\ 100) = 0 ifTrue:[ 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) asStringWithCommas displayAt: 0 at 0]. ]. gc free. display closeDisplay. Display forceToScreen.! ----- Method: X11Display class>>fields (in category 'field definition') ----- fields "X11Display defineFields" "Note: The structure of Display is internal and only pointers to X11Display are used" ^#()! ----- Method: X11Display class>>new (in category 'instance creation') ----- new ^ self on: nil! ----- Method: X11Display class>>on: (in category 'instance creation') ----- on: aStringOrNil ^ self XOpenDisplay: aStringOrNil! ----- Method: X11Display class>>x11Draw (in category 'examples') ----- x11Draw "X11Display x11Draw" | display window gc nextPt lastPt ptr | display := X11Display XOpenDisplay: nil. window = display ourWindow. gc := X11GC on: window. gc foreground: 0. lastPt := nil. [ptr := display queryPointer: window. "{root. child. root pos. win pos. mask}" ptr last anyMask: 256] whileFalse:[ nextPt := ptr fourth. nextPt = lastPt ifFalse:[ lastPt ifNotNil: [ gc drawLineFrom: lastPt to: nextPt. display sync]. lastPt := nextPt]. ]. gc free. display closeDisplay. Display forceToScreen.! ----- Method: X11Display>>None (in category 'xlib calls') ----- None ^ 0! ----- Method: X11Display>>XCloseDisplay: (in category 'xlib calls') ----- XCloseDisplay: aDisplay ^self externalCallFailed! ----- Method: X11Display>>XDisplayString: (in category 'xlib calls') ----- XDisplayString: aDisplay ^self externalCallFailed! ----- Method: X11Display>>XFlush: (in category 'xlib calls') ----- XFlush: xDisplay ^self externalCallFailed! ----- Method: X11Display>>XGetInputFocus:with:with: (in category 'xlib calls') ----- XGetInputFocus: display with: focus with: revert ^self externalCallFailed! ----- Method: X11Display>>XQueryPointer:window:returnRoot:child:rootX:rootY:winX:winY:mask: (in category 'xlib calls') ----- XQueryPointer: display window: w returnRoot: root child: child rootX: rootX rootY: rootY winX: winX winY: winY mask: mask ^self externalCallFailed! ----- Method: X11Display>>XSync: (in category 'xlib calls') ----- XSync: xDisplay ^self externalCallFailed! ----- Method: X11Display>>XWarpPointer:sourceWindow:destWindow:sourceX:sourceY:sourceWidth:sourceHeight:destX:destY: (in category 'xlib calls') ----- XWarpPointer: display sourceWindow: srcWindowID destWindow: destWindowID sourceX: srcX sourceY: srcY sourceWidth: srcWidth sourceHeight: srcHeight destX: destX destY: destY ^self externalCallFailed! ----- Method: X11Display>>closeDisplay (in category 'initialize-release') ----- closeDisplay handle == nil ifFalse:[ self XCloseDisplay: self. handle := nil].! ----- Method: X11Display>>displayString (in category 'accessing') ----- displayString ^self XDisplayString: self! ----- Method: X11Display>>flush (in category 'initialize-release') ----- flush self XFlush: self! ----- Method: X11Display>>getInputFocus (in category 'accessing') ----- getInputFocus | focus revert | focus := WordArray new: 1. revert := WordArray new: 1. self XGetInputFocus: self with: focus with: revert. ^ X11Window new xid: focus first! ----- Method: X11Display>>ourWindow (in category 'accessing') ----- ourWindow "Guess the window to draw on." | window ptr child | window := self getInputFocus. ptr := self queryPointer: window. "{root. child. root pos. win pos. mask}" child := ptr second. child xid = 0 ifTrue: [^ window]. ^ child! ----- Method: X11Display>>queryPointer: (in category 'accessing') ----- queryPointer: aX11Window | root child rootX rootY winX winY mask | root := WordArray new: 1. child := WordArray new: 1. rootX := WordArray new: 1. rootY := WordArray new: 1. winX := WordArray new: 1. winY := WordArray new: 1. mask := WordArray new: 1. self XQueryPointer: self window: aX11Window xid returnRoot: root child: child rootX: rootX rootY: rootY winX: winX winY: winY mask: mask. ^{ X11Window new xid: root first. X11Window new xid: child first. rootX first @ rootY first. winX first @ winY first. mask first}! ----- Method: X11Display>>sync (in category 'initialize-release') ----- sync ^self XSync: self! ----- Method: X11Display>>warpPointerBy: (in category 'accessing') ----- warpPointerBy: aPoint "Moves the mouse pointer from its current location to its current location + aPoint. Generates a mouse move event if the squeak window is active" ^ self XWarpPointer: self sourceWindow: self None destWindow: self None sourceX: 0 sourceY: 0 sourceWidth: 0 sourceHeight: 0 destX: aPoint x destY: aPoint y! ----- Method: X11Display>>warpPointerFrom:in:To:in: (in category 'accessing') ----- warpPointerFrom: aRectangle in: sourceWindow To: aPoint in: destWindow "Moves the mouse pointer to aPoint relative to the top-left corner of a window" ^ self XWarpPointer: self sourceWindow: sourceWindow xid destWindow: destWindow xid sourceX: aRectangle left sourceY: aRectangle top sourceWidth: aRectangle width sourceHeight: aRectangle height destX: aPoint x destY: aPoint y! ----- Method: X11Display>>warpPointerTo:in: (in category 'accessing') ----- warpPointerTo: aPoint in: aWindow "Moves the mouse pointer to aPoint relative to the top-left corner of a window" ^ self XWarpPointer: self sourceWindow: self None destWindow: aWindow xid sourceX: 0 sourceY: 0 sourceWidth: 0 sourceHeight: 0 destX: aPoint x destY: aPoint y! ExternalStructure subclass: #X11GC instanceVariableNames: 'drawable' classVariableNames: '' poolDictionaries: '' category: 'FFI-Libraries-X11'! ----- Method: X11GC class>>XCreateGC:with:with:with: (in category 'xlib calls') ----- XCreateGC: xDisplay with: aDrawable with: valueMask with: values ^self externalCallFailed! ----- Method: X11GC class>>fields (in category 'field definition') ----- fields "X11GC defineFields" ^#( nil 'void*' )! ----- Method: X11GC class>>on: (in category 'instance creation') ----- on: aDrawable | xgc | xgc := self XCreateGC: aDrawable display with: aDrawable with: 0 with: nil. xgc drawable: aDrawable. ^xgc! ----- Method: X11GC>>XDrawArc:with:with:with:with:with:with:with:with: (in category 'xlib calls') ----- XDrawArc: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h with: a1 with: a2 ^self externalCallFailed! ----- Method: X11GC>>XDrawLine:with:with:with:with:with:with: (in category 'xlib calls') ----- XDrawLine: xDisplay with: aDrawable with: xGC with: x0 with: y0 with: x1 with: y1 ^self externalCallFailed! ----- Method: X11GC>>XDrawRectangle:with:with:with:with:with:with: (in category 'xlib calls') ----- XDrawRectangle: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h ^self externalCallFailed! ----- Method: X11GC>>XFillArc:with:with:with:with:with:with:with:with: (in category 'xlib calls') ----- XFillArc: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h with: a1 with: a2 ^self externalCallFailed! ----- Method: X11GC>>XFillRectangle:with:with:with:with:with:with: (in category 'xlib calls') ----- XFillRectangle: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h ^self externalCallFailed! ----- Method: X11GC>>XFreeGC:with: (in category 'xlib calls') ----- XFreeGC: xDisplay with: xGC ^self externalCallFailed! ----- Method: X11GC>>XSetBackground:with:with: (in category 'xlib calls') ----- XSetBackground: xDisplay with: xGC with: bg ^self externalCallFailed! ----- Method: X11GC>>XSetForeground:with:with: (in category 'xlib calls') ----- XSetForeground: xDisplay with: xGC with: fg ^self externalCallFailed! ----- Method: X11GC>>background: (in category 'drawing') ----- background: pixelValue self XSetBackground: self display with: self with: pixelValue! ----- Method: X11GC>>display (in category 'accessing') ----- display ^drawable display! ----- Method: X11GC>>drawLineFrom:to: (in category 'drawing') ----- drawLineFrom: pt1 to: pt2 self XDrawLine: self display with: drawable with: self with: pt1 x with: pt1 y with: pt2 x with: pt2 y! ----- Method: X11GC>>drawOval: (in category 'drawing') ----- drawOval: aRectangle self XDrawArc: self display with: drawable with: self with: aRectangle left with: aRectangle top with: aRectangle width with: aRectangle height with: 0 with: 64*360! ----- Method: X11GC>>drawRectangle: (in category 'drawing') ----- drawRectangle: aRectangle self XDrawRectangle: self display with: drawable with: self with: aRectangle left with: aRectangle top with: aRectangle width with: aRectangle height! ----- Method: X11GC>>drawable (in category 'accessing') ----- drawable ^drawable! ----- Method: X11GC>>drawable: (in category 'accessing') ----- drawable: aDrawable drawable := aDrawable! ----- Method: X11GC>>fillOval: (in category 'drawing') ----- fillOval: aRectangle self XFillArc: self display with: drawable with: self with: aRectangle left with: aRectangle top with: aRectangle width with: aRectangle height with: 0 with: 64*360! ----- Method: X11GC>>fillRectangle: (in category 'drawing') ----- fillRectangle: aRectangle self XFillRectangle: self display with: drawable with: self with: aRectangle left with: aRectangle top with: aRectangle width with: aRectangle height! ----- Method: X11GC>>foreground: (in category 'drawing') ----- foreground: pixelValue self XSetForeground: self display with: self with: pixelValue ! ----- Method: X11GC>>free (in category 'initialize-release') ----- free handle == nil ifFalse:[ self XFreeGC: self display with: self. handle := nil. ].! From commits at source.squeak.org Thu May 27 08:46:20 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 08:46:20 0000 Subject: [squeak-dev] The Trunk: Monticello-mt.748.mcz Message-ID: Marcel Taeumel uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-mt.748.mcz ==================== Summary ==================== Name: Monticello-mt.748 Author: mt Time: 27 May 2021, 10:46:18.792247 am UUID: 441ecd88-3291-424f-9259-0c2ff434d487 Ancestors: Monticello-ct.747 Improve FFI loading. There is clearly an extension point for Monticello missing. =============== Diff against Monticello-ct.747 =============== Item was changed: ----- Method: MCMethodDefinition>>isExternalStructureFieldDefinition (in category 'testing') ----- isExternalStructureFieldDefinition + ^ (selector = #fields or: [selector = #originalTypeName]) - ^ selector = #fields and: [classIsMeta and: [ (Smalltalk at: #ExternalStructure ifPresent: [:externalStructure | self actualClass theNonMetaClass inheritsFrom: externalStructure]) == true]] ! Item was changed: ----- Method: MCMethodDefinition>>postload (in category 'installing') ----- postload self isInitializer ifTrue: [self actualClass theNonMetaClass initialize]. self isExternalStructureFieldDefinition + ifTrue: [self actualClass theNonMetaClass doneCompiling].! - ifTrue: [[self actualClass theNonMetaClass compileFields] - ifError: [:msg | Transcript showln: '[FFI] ', msg]].! From commits at source.squeak.org Thu May 27 08:48:19 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 08:48:19 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.175.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.175.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.175 Author: mt Time: 27 May 2021, 10:48:18.236247 am UUID: 95c5280e-eb69-9748-8139-7835cd7e2f06 Ancestors: FFI-Kernel-mt.174 Complements Monticello-mt.748. Also removes some variable shadows. =============== Diff against FFI-Kernel-mt.174 =============== Item was changed: ----- Method: ExternalData>>from: (in category 'accessing') ----- from: firstIndex "Move the start of this array. Size not needed." + | byteOffset numElements byteSize | + byteOffset := ((firstIndex-1) * self contentType byteSize)+1. - | byteOffset numElements byteSize contentType | - contentType := self contentType. - byteOffset := ((firstIndex-1) * contentType byteSize)+1. numElements := (self size ifNotNil: [:sz | sz - firstIndex + 1 max: 0]). byteSize := numElements + ifNil: [self contentType byteSize] + ifNotNil: [numElements * self contentType byteSize]. - ifNil: [contentType byteSize] - ifNotNil: [numElements * contentType byteSize]. ^ ExternalData fromHandle: (handle structAt: byteOffset length: (byteSize ifNil: [1])) + type: self contentType - type: contentType size: numElements! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." + | byteOffset numElements byteSize | - | byteOffset numElements byteSize contentType | ExtraSizeChecks == true ifTrue: [ self sizeCheck: firstIndex. self sizeCheck: lastIndex]. + byteOffset := ((firstIndex-1) * self contentType byteSize)+1. - contentType := self contentType. - byteOffset := ((firstIndex-1) * contentType byteSize)+1. numElements := lastIndex - firstIndex + 1 max: 0. + byteSize := numElements * self contentType byteSize. - byteSize := numElements * contentType byteSize. ^ ExternalData fromHandle: (handle structAt: byteOffset length: byteSize) + type: self contentType - type: contentType size: numElements! Item was added: + ----- Method: ExternalStructure class>>compileFieldsSafely (in category 'field definition') ----- + compileFieldsSafely + + [self compileFields] + ifError: [:msg | Transcript showln: '[FFI] Field compilation failed: ', msg].! Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling "Base class changed to something that is an external structure now." + self compileFieldsSafely. + self externalType becomeKnownTypeSafely.! - [self compileFields] - ifError: [ "Ignore unfinished field specs" ]. - self externalType isUnknownType - ifTrue: [self externalType becomeKnownTypeSafely].! Item was added: + ----- Method: ExternalType>>becomeKnownTypeSafely (in category 'private') ----- + becomeKnownTypeSafely + "Ignore. We are already a known type." + + self assert: [self isUnknownType not].! Item was changed: ----- Method: ExternalUnknownType>>becomeKnownTypeSafely (in category 'construction') ----- becomeKnownTypeSafely "Give me some purpose. :-)" ^ [self becomeKnownType] + ifError: [:msg | + Transcript showln: '[FFI] Type still unknown: ', msg. - on: Error - do: [ self assert: [self isUnknownType]. self].! From commits at source.squeak.org Thu May 27 12:23:47 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 12:23:47 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.176.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.176.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.176 Author: mt Time: 27 May 2021, 2:23:46.798609 pm UUID: c7798b80-05bc-ba49-a177-790da21a663a Ancestors: FFI-Kernel-mt.175 Fixes #allocate for alias-to-array types. Fixes field access for alias-to-array types. Adds #pointer alias to quickly get a pointer type. Adds #type:at:(put:) as convenient way to fill a byte array with a mix of typed contents. =============== Diff against FFI-Kernel-mt.175 =============== Item was changed: ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-examples') ----- pointerAt: byteOffset "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + ^ ExternalType pointer handle: self at: byteOffset! - ^ ExternalType void asPointerType handle: self at: byteOffset! Item was changed: ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-examples') ----- pointerAt: byteOffset put: value "For documentation and convenient exploration only. Type-safe access to byte arrays or external addresses SHOULD happen via external objects that have a type set such as instances of ExternalStructure and ExternalData." + ^ ExternalType pointer handle: self at: byteOffset put: value! - ^ ExternalType void asPointerType handle: self at: byteOffset put: value! Item was added: + ----- Method: ByteArray>>type:at: (in category '*FFI-Kernel') ----- + type: spec at: byteOffset + "For convenience, when the receiver needs to filled with a mix of typed contents. See FFICallback for an example." + + ^ (ExternalType lookupType: spec) handle: self at: byteOffset! Item was added: + ----- Method: ByteArray>>type:at:put: (in category '*FFI-Kernel') ----- + type: spec at: byteOffset put: value + "For convenience, when the receiver needs to filled with a mix of typed contents. See FFICallback for an example." + + ^ (ExternalType lookupType: spec) handle: self at: byteOffset put: value! Item was changed: ----- Method: ExternalArrayType>>allocate (in category 'external data') ----- allocate + | data | + data := self contentType allocate: self size. + ^ self isTypeAlias + ifTrue: [referentClass fromHandle: data getHandle] + ifFalse: [data]! - ^ self contentType allocate: self size! Item was added: + ----- Method: ExternalTypeAlias>>at: (in category 'proxy') ----- + at: index + "Compatibility for alias-to-array types." + + ^ self value at: index! Item was added: + ----- Method: ExternalTypeAlias>>at:put: (in category 'proxy') ----- + at: index put: object + "Compatibility for alias-to-array types." + + ^ self value at: index put: object! From commits at source.squeak.org Thu May 27 12:26:10 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 12:26:10 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.177.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.177.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.177 Author: mt Time: 27 May 2021, 2:26:09.621609 pm UUID: 4cb498da-9e06-9343-943b-bcb208915b9c Ancestors: FFI-Kernel-mt.176 Adds #pointer alias to quickly get a pointer type. Adds type lookup for various type representations such as string, symbol, or struct class. =============== Diff against FFI-Kernel-mt.176 =============== Item was added: + ----- Method: ExternalType class>>lookupType: (in category 'instance lookup') ----- + lookupType: structClassOrTypeNameOrType + "Answers a type from the given spec, which can be a name, a struct class, or an actual type. Approximate being a struct class via #isBehavior." + + ^ structClassOrTypeNameOrType isString + ifTrue: [self typeNamed: structClassOrTypeNameOrType] + ifFalse: [structClassOrTypeNameOrType isBehavior + ifTrue: [structClassOrTypeNameOrType externalType] + ifFalse: [structClassOrTypeNameOrType]]! Item was added: + ----- Method: ExternalType class>>pointer (in category 'type constants - extra') ----- + pointer + "Answers a generic pointer type, that is, void*" + + ^ ExternalType void asPointerType! From commits at source.squeak.org Thu May 27 12:26:46 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 12:26:46 0000 Subject: [squeak-dev] FFI: FFI-Tests-mt.51.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.51.mcz ==================== Summary ==================== Name: FFI-Tests-mt.51 Author: mt Time: 27 May 2021, 2:26:45.499609 pm UUID: 14a23269-4dbc-7b4d-a13c-791d62924be1 Ancestors: FFI-Tests-mt.50 Complements FFI-Kernel-mt.176 and FFI-Kernel-mt.177 =============== Diff against FFI-Tests-mt.50 =============== Item was added: + ----- Method: ExternalTypeTests>>testAtomicTypeBySpec (in category 'tests - atomic types') ----- + testAtomicTypeBySpec + "Check whether the lookup of atomic types will yield the singleton instances of those types." + + ExternalType atomicTypes do: [:type | + self + assert: type + identical: (ExternalType lookupType: type typeName); + assert: type + identical: (ExternalType lookupType: type)].! Item was added: + ----- Method: ExternalTypeTests>>testPointerByShortcut (in category 'tests - pointer types') ----- + testPointerByShortcut + + | pointer | + pointer := ExternalType void asPointerType. + self + assert: pointer + identical: ExternalType pointer; + assert: pointer + identical: (ExternalType typeNamed: 'pointer'); + assert: pointer + identical: (ExternalType lookupType: pointer); + assert: pointer + identical: (ExternalType lookupType: #pointer).! Item was added: + ----- Method: ExternalTypeTests>>testStructTypeBySpec (in category 'tests - struct types') ----- + testStructTypeBySpec + + self classesForStructures do: [:structClass | | type | + type := structClass externalType. + self + assert: type + identical: (ExternalType lookupType: structClass)]! Item was changed: ----- Method: FFIAllocateTests>>lookupType: (in category 'running') ----- lookupType: structClassOrTypeNameOrType + ^ ExternalType lookupType: structClassOrTypeNameOrType! - ^ structClassOrTypeNameOrType isString - ifTrue: [ExternalType typeNamed: structClassOrTypeNameOrType] - ifFalse: [structClassOrTypeNameOrType isBehavior - ifTrue: [structClassOrTypeNameOrType externalType] - ifFalse: [structClassOrTypeNameOrType]]! Item was added: + ----- Method: FFIAllocateTests>>test06AliasForArrayAccess (in category 'tests - type alias') ----- + test06AliasForArrayAccess + + | array | + array := self allocate: FFITestAliasForInt32Array. + self assert: FFITestAliasForInt32Array identical: array class. + + self assert: 0 equals: (array at: 5). + array at: 5 put: 42. + self assert: 42 equals: (array at: 5).! From commits at source.squeak.org Thu May 27 12:29:06 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 12:29:06 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.178.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.178.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.178 Author: mt Time: 27 May 2021, 2:29:05.913609 pm UUID: ddf66c8a-450b-1641-a21a-987c508b1281 Ancestors: FFI-Kernel-mt.177 I missed the #allocateExternal case. Sorry, I forgot to run the tests before committing. My bad. :-( =============== Diff against FFI-Kernel-mt.177 =============== Item was changed: ----- Method: ExternalArrayType>>allocateExternal (in category 'external data') ----- allocateExternal + | data | + data := self contentType allocateExternal: self size. + ^ self isTypeAlias + ifTrue: [referentClass fromHandle: data getHandle] + ifFalse: [data]! - ^ self contentType allocateExternal: self size! From commits at source.squeak.org Thu May 27 14:59:49 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 14:59:49 0000 Subject: [squeak-dev] FFI: FFI-Libraries-mt.2.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Libraries to project FFI: http://source.squeak.org/FFI/FFI-Libraries-mt.2.mcz ==================== Summary ==================== Name: FFI-Libraries-mt.2 Author: mt Time: 27 May 2021, 4:59:48.550121 pm UUID: 191e8fd4-95c1-434c-8897-ff8a4b25477a Ancestors: FFI-Libraries-mt.1 Make bsearch and qsort callbacks type-safe. =============== Diff against FFI-Libraries-mt.1 =============== Item was changed: ----- Method: CStandardLibrary>>bsearch:with:with:with:with: (in category 'stdlib.h - searching and sorting') ----- bsearch: key with: base with: num with: size with: compar + - ^ self externalCallFailed ! Item was changed: ----- Method: CStandardLibrary>>qsort:with:with:with: (in category 'stdlib.h - searching and sorting') ----- qsort: base with: num with: size with: compar + - ^ self externalCallFailed ! From commits at source.squeak.org Thu May 27 15:00:18 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 15:00:18 0000 Subject: [squeak-dev] FFI: FFI-Pools-mt.31.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.31.mcz ==================== Summary ==================== Name: FFI-Pools-mt.31 Author: mt Time: 27 May 2021, 5:00:18.391121 pm UUID: d8a5ee3f-5f1e-4849-adfe-f13c2af13d19 Ancestors: FFI-Pools-mt.30 Remove instVar shadow. =============== Diff against FFI-Pools-mt.30 =============== Item was changed: ----- Method: ExternalTypePool class>>assuredPoolVarNameFor: (in category 'housekeeping') ----- assuredPoolVarNameFor: type + | poolVarName | + poolVarName := (self poolVarNameFor: type) asSymbol. + (self classPool includesKey: poolVarName) + ifFalse: [self addClassVarName: poolVarName]. + self classPool at: poolVarName put: type. + ^ poolVarName! - | name | - name := (self poolVarNameFor: type) asSymbol. - (self classPool includesKey: name) - ifFalse: [self addClassVarName: name]. - self classPool at: name put: type. - ^ name! From commits at source.squeak.org Thu May 27 15:04:20 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 15:04:20 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.21.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.21.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.21 Author: mt Time: 27 May 2021, 5:04:20.592121 pm UUID: 43e1fa9c-eeb3-d84b-880d-09025f299cff Ancestors: FFI-Callbacks-mt.20 Adds manual and automatic GC support for callbacks. Manual via #free is the default; see #qsort and #bsearch as examples. Use #newGC to automatically free the callback thunks once the evaluableObject (i.e. message send or block) got gc'ed. Also lifts FFICallback to be an actual type alias for byte[40], i.e. the thunk. =============== Diff against FFI-Callbacks-mt.20 =============== Item was changed: ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') ----- bsearch: key in: array compare: block + | result callback | + [result := self - | result | - result := self bsearch: key with: array with: array size with: array contentType byteSize + with: (callback := self compare: array contentType through: block). + ] ensure: [callback free]. - with: (self compare: array contentType through: block) thunk. result setContentType: array contentType; setSize: 1. ^ result! Item was changed: ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') ----- qsort: array compare: block + + | callback result | + [result := self - - ^ self qsort: array with: array size with: array contentType byteSize + with: (callback := self compare: array contentType through: block). + ] ensure: [callback free]. + ^ result! - with: (self compare: array contentType through: block) thunk! Item was removed: - ----- Method: ExternalData>>blockAt:byteSize: (in category '*FFI-Callbacks') ----- - blockAt: byteIndex byteSize: numBytes - "Given that the receiver manages a page of memory, answer a block of that memory to use." - ^ ExternalData - fromHandle: handle + (byteIndex - 1) - byteSize: numBytes! Item was changed: + ExternalTypeAlias subclass: #FFICallback + instanceVariableNames: 'evaluableObject evaluator argumentTypes resultType' + classVariableNames: 'EvaluableToCallbackMap ThunkToCallbackMap' + poolDictionaries: 'FFICallbackConstants' - ExternalObject subclass: #FFICallback - instanceVariableNames: 'abi evaluableObject evaluator thunk argumentTypes resultType' - classVariableNames: 'ThunkToCallbackMap' - poolDictionaries: '' category: 'FFI-Callbacks'! Item was changed: ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') ----- + evaluateCallbackForContext: callbackContext " ^ typeCode" - evaluateCallbackForContext: callbackContext " ^ typeCode" + ^ ThunkToCallbackMap - (ThunkToCallbackMap at: callbackContext thunkp getHandle + ifPresent: [:callback | callback valueInContext: callbackContext] + ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] + ! - ifAbsent: [^self error: 'could not locate Callback instance corresponding to thunk address']) - ifNil: [self error: 'Callback instance for this thunk address has been garbage collected'] - ifNotNil: - [:callback| - ^callback valueInContext: callbackContext]! Item was changed: ----- Method: FFICallback class>>initialize (in category 'class initialization') ----- initialize Smalltalk addToStartUpList: self after: FFIPlatformDescription. + self initializeCallbacks.! - ThunkToCallbackMap := WeakValueDictionary new.! Item was added: + ----- Method: FFICallback class>>initializeCallbacks (in category 'class initialization') ----- + initializeCallbacks + + ThunkToCallbackMap := Dictionary new. + EvaluableToCallbackMap := WeakIdentityKeyDictionary new. + EvaluableToCallbackMap finalizer: [:callback | callback free]. + WeakArray addWeakDependent: EvaluableToCallbackMap.! Item was added: + ----- Method: FFICallback class>>newGC (in category 'instance creation') ----- + newGC + + ^ self new beManaged; yourself! Item was added: + ----- Method: FFICallback class>>originalTypeName (in category 'field definition') ----- + originalTypeName + " + self defineFields. + " + ^ 'byte[{1}]' format: {MaxThunkSize}! Item was changed: ----- Method: FFICallback class>>startUp: (in category 'system startup') ----- startUp: resuming "Any thunks in the finalization registry at the time the image comes up in a new session MUST NOT be finalized and should immediately be discarded. Their thunk pointers are no longer valid." + resuming ifTrue: [self initializeCallbacks].! - resuming ifTrue: - [ThunkToCallbackMap := WeakValueDictionary new]! Item was added: + ----- Method: FFICallback>>beManaged (in category 'initialization') ----- + beManaged + "Mark the receiver to be free'd automatically when the #evaluableObject is gc'ed." + + self assert: [evaluableObject isNil]. + evaluableObject := WeakArray new: 1.! Item was added: + ----- Method: FFICallback>>evaluableObject (in category 'accessing') ----- + evaluableObject + + ^ self isManaged + ifTrue: [evaluableObject at: 1] + ifFalse: [evaluableObject]! Item was added: + ----- Method: FFICallback>>evaluableObject: (in category 'accessing') ----- + evaluableObject: anObject + + self isManaged + ifTrue: [ + self evaluableObject ifNotNil: [:o | EvaluableToCallbackMap removeKey: o]. + evaluableObject at: 1 put: anObject. + EvaluableToCallbackMap at: anObject put: self] + ifFalse: [ + evaluableObject := anObject].! Item was changed: ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." + | arguments stack stackType stackByteOffset intArgs intPos floatArgs floatPos | - | byteOffset args intArgs intPos floatArgs floatPos type | + stack := callbackContext stackPtr getHandle. + stackType := callbackContext stackPtr contentType. + stackByteOffset := 1. - handle := callbackContext stackPtr getHandle. - type := callbackContext stackPtr contentType. - byteOffset := 1. intArgs := callbackContext intRegArgs. intPos := 0. floatArgs := callbackContext floatRegArgs. floatPos := 0. + arguments := Array new: argumentTypes size. + 1 to: arguments size do: [:argIndex | - args := Array new: argumentTypes size. - 1 to: args size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Read pointers from register value." isPointer ifFalse: ["data is already an integer"] ifTrue: [ data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) type: argType asNonPointerType "contentType") value]] ifNil: [ "2) If nothing was read, read the argument from the stack." + data := (argType handle: stack at: stackByteOffset) value. + stackByteOffset := stackByteOffset + + ((stackType byteSize max: argType byteSize) roundUpTo: stackType byteAlignment)]. - data := (argType handle: handle at: byteOffset) value. - byteOffset := byteOffset - + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)]. + arguments at: argIndex put: data]. - args at: argIndex put: data]. ^ self + setResult: (self evaluableObject valueWithArguments: arguments) - setResult: (evaluableObject valueWithArguments: args) inContext: callbackContext! Item was added: + ----- Method: FFICallback>>free (in category 'initialization') ----- + free + + handle ifNil: [^ self]. + + ThunkToCallbackMap removeKey: handle. + self zeroMemory. + handle := nil. + ! Item was changed: ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') ----- init__ccall_ARM32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm32abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long r0, long r1, long r2, long r3, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "0x0 : mov r12, sp ; 0xe1a0c00d 0x4 : sub sp, sp, #16 ; 0xe24dd010 0x8 : str pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates 0xc : str r12, [sp,#4] ; 0xe58dc004 0x10 : str lr, [sp, #12] ; 0xe58de00c 0x14 : ldr r12, [pc, #8] ; 0xe59fc008 0x18 : blx r12 ; 0xe12fff3c 0x1c : add sp, sp, #12 ; 0xe28dd00c 0x20 : ldr pc, [sp], #4!! ; 0xe49df004 ; pop {pc} 0x24 : .word thunkEntry" + + handle "thunk" + type: #uint32_t at: 1 put: 16re1a0c00d; + type: #uint32_t at: 5 put: 16re24dd010; + type: #uint32_t at: 9 put: 16re58df000; "thunk+16; see above" + type: #uint32_t at: 13 put: 16re58dc004; + type: #uint32_t at: 17 put: 16re58de00c; + type: #uint32_t at: 21 put: 16re59fc008; + type: #uint32_t at: 25 put: 16re12fff3c; + type: #uint32_t at: 29 put: 16re28dd00c; + type: #uint32_t at: 33 put: 16re49df004; + type: #pointer at: 37 put: self thunkEntryAddress.! - self flag: #hidden. "mt: How is the thunk's handle stored to lookup this instance upon callback later?" - thunk getHandle - unsignedLongAt: 1 put: 16re1a0c00d; - unsignedLongAt: 5 put: 16re24dd010; - unsignedLongAt: 9 put: 16re58df000; - unsignedLongAt: 13 put: 16re58dc004; - unsignedLongAt: 17 put: 16re58de00c; - unsignedLongAt: 21 put: 16re59fc008; - unsignedLongAt: 25 put: 16re12fff3c; - unsignedLongAt: 29 put: 16re28dd00c; - unsignedLongAt: 33 put: 16re49df004; - pointerAt: 37 put: self thunkEntryAddress length: 4.! Item was changed: ----- Method: FFICallback>>init__ccall_IA32 (in category 'initialization - thunk prepare') ----- init__ccall_IA32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0x9090c30C thunk+21: ret 0xc3 thunk+22: nop 0x90 thunk+23: nop 0x90" + handle "thunk" + type: #uint32_t at: 1 put: 16rB8905454; + type: #pointer at: 5 put: self thunkEntryAddress; + type: #uint32_t at: 9 put: 16r68909090; + type: #pointer at: 13 put: handle; + type: #uint32_t at: 17 put: 16rC483D0FF; + type: #uint32_t at: 21 put: 16r9090C30C! - thunk getHandle - unsignedLongAt: 1 put: 16rB8905454; - pointerAt: 5 put: self thunkEntryAddress length: 4; - unsignedLongAt: 9 put: 16r68909090; - pointerAt: 13 put: thunk getHandle length: 4; - unsignedLongAt: 17 put: 16rC483D0FF; - unsignedLongAt: 21 put: 16r9090C30C! Item was changed: ----- Method: FFICallback>>init__ccall_X64 (in category 'initialization - thunk prepare') ----- init__ccall_X64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64sysvabicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. handle thunk+0xc: pushq %rax 50 thunk+0xd: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x17: callq *%rax ff d0 thunk+0x19: addq $0x18, %rsp 48 83 c4 18 thunk+0x1d: retq c3 thunk+0x1e: nop 90 thunk+0x1f: nop 90" + handle "thunk" + type: #uint32_t at: 1 put: 16rb8485454; + type: #pointer at: 5 put: handle; + type: #uint32_t at: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" + type: #pointer at: 16 put: self thunkEntryAddress; + type: #uint8_t at: 24 put: 16rff; "alignment" + type: #uint32_t at: 25 put: 16rc48348d0; + type: #uint32_t at: 29 put: 16r9090c318.! - thunk getHandle - unsignedLongAt: 1 put: 16rb8485454; - pointerAt: 5 put: thunk getHandle length: 8; - unsignedLongAt: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" - pointerAt: 16 put: self thunkEntryAddress length: 8; - unsignedByteAt: 24 put: 16rff; - unsignedLongAt: 25 put: 16rc48348d0; - unsignedLongAt: 29 put: 16r9090c318.! Item was changed: ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'initialization - thunk prepare') ----- init__ccall_X64Win64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. addressField thunk+0xc: pushq %rax 50 thunk+0xd: subq $0x20, %rsp 48 83 c4 e0 (this is addq -20 since the immediate is signed extended) thunk+0x11: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x1b: callq *%rax ff d0 thunk+0x1d: addq $0x38, %rsp 48 83 c4 38 thunk+0x21: retq c3 thunk+0x22: nop 90 thunk+0x23: nop 90" + handle "thunk" + type: #uint32_t at: 1 put: 16rb8485454; + type: #pointer at: 5 put: handle; + type: #uint32_t at: 13 put: 16rc4834850; + type: #uint32_t at: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" + type: #pointer at: 20 put: self thunkEntryAddress; + type: #uint8_t at: 28 put: 16rff; "alignment" + type: #uint32_t at: 29 put: 16rc48348d0; + type: #uint32_t at: 33 put: 16r9090c338.! - thunk getHandle - unsignedLongAt: 1 put: 16rb8485454; - pointerAt: 5 put: thunk getHandle length: 8; - unsignedLongAt: 13 put: 16rc4834850; - unsignedLongAt: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" - pointerAt: 20 put: self thunkEntryAddress length: 8; - unsignedByteAt: 28 put: 16rff; - unsignedLongAt: 29 put: 16rc48348d0; - unsignedLongAt: 33 put: 16r9090c338.! Item was changed: ----- Method: FFICallback>>init__stdcall_IA32: (in category 'initialization - thunk prepare') ----- init__stdcall_IA32: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes. (See #init__ccall_IA32 for more info)" "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0xBYTSc20C thunk+21: ret $bytes 0xc2 0xBY 0xTS" + handle "thunk" + type: #uint32_t at: 1 put: 16rB8905454; + type: #pointer at: 5 put: self thunkEntryAddress; + type: #uint32_t at: 9 put: 16r68909090; + type: #pointer at: 13 put: handle; + type: #uint32_t at: 17 put: 16rC483D0FF; + type: #uint16_t at: 21 put: 16rC20C; + type: #uint16_t at: 23 put: numBytes.! - thunk getHandle - unsignedLongAt: 1 put: 16rB8905454; - pointerAt: 5 put: self thunkEntryAddress length: 4; - unsignedLongAt: 9 put: 16r68909090; - pointerAt: 13 put: thunk getHandle length: 4; - unsignedLongAt: 17 put: 16rC483D0FF; - unsignedShortAt: 21 put: 16rC20C; - unsignedShortAt: 23 put: numBytes.! Item was added: + ----- Method: FFICallback>>isManaged (in category 'initialization') ----- + isManaged + "Answer whether the receiver will be free'd automatically when the #evaluableObject is gc'ed." + + ^ evaluableObject class isWeak + ! Item was added: + ----- Method: FFICallback>>printOn: (in category 'printing') ----- + printOn: stream + + stream nextPutAll: 'Thunk '. + handle printOn: stream.! Item was changed: ----- Method: FFICallback>>setResult:inContext: (in category 'callback') ----- setResult: anObject inContext: aCallbackContext "Set the result in the callback context. Add some fast checks to detect errors." resultType isPointerType ifTrue: [ "an ExternalStructure, an ExternalUnion, an ExternalData, ..." ^ aCallbackContext externalObjectResult: anObject]. resultType atomicType = 0 "void" ifTrue: ["Quick exit for void return type." ^ aCallbackContext voidResult]. anObject isInteger ifTrue: [ self assert: [resultType isIntegerType]. self flag: #todo. "mt: ABI #X64Win64 has special treatment for word64, too. But maybe it is not needed." + ^ (anObject isLarge and: [FFIPlatformDescription current abi = #IA32]) - ^ (anObject isLarge and: [abi = #IA32]) ifTrue: [aCallbackContext word64Result: anObject] ifFalse: [aCallbackContext wordResult: anObject]]. anObject isBoolean ifTrue: [ self assert: [resultType atomicType = 1 "bool"]. ^ aCallbackContext wordResult: anObject]. anObject isFloat ifTrue: [ self assert: [resultType atomicType >= 12 "float/double"]. ^ aCallbackContext floatResult: anObject]. self notify: 'Unkown result type.'. ^ aCallbackContext errorResult! Item was changed: ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') ----- setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage + self evaluableObject: blockOrMessage. - abi := FFIPlatformDescription current abi. - - evaluableObject := blockOrMessage. argumentTypes := moreExternalTypes. resultType := anExternalType. "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the pragma which specifies how many bytes to pop. See http://forum.world.st/Pharo-FFI-on-aarch64-arm64-td5096777.html#a5096786." + handle := FFICallbackMemory allocateExecutableBlock getHandle. + - thunk := FFICallbackMemory allocateExecutableBlock. self init__ccall. "self init__stdcall: 0." "(method pragmaAt: #calleepops:) ifNil: [self init__ccall] ifNotNil: [:pragma | self init__stdcall: (pragma argumentAt: 1)]." "numEvaluatorArgs := (evaluator := method selector) numArgs. self addToThunkTable" + ThunkToCallbackMap at: handle put: self! - ThunkToCallbackMap at: thunk getHandle put: self! Item was changed: ----- Method: FFICallback>>thunk (in category 'accessing') ----- thunk + ^ self value! - " self flag: #debugging. - ^ FFICallbackMemory new - externalPointer: thunk getHandle; - yourself" - ^ thunk! Item was changed: ----- Method: FFICallbackMemory class>>allocateExecutableBlock (in category 'executable pages') ----- allocateExecutableBlock | blockSize | blockSize := MaxThunkSize. AccessProtect critical: [ExecutablePages do: [:page | 1 to: page size - blockSize by: blockSize do: [:i| (page at: i) = 0 ifTrue: [page at: i put: 1. + ^ page from: i to: i + blockSize - 1]]]]. - ^ page blockAt: i byteSize: blockSize]]]]. AccessProtect critical: [ | newPage | newPage := ExecutablePages add: self allocateExecutablePage. + ^ (newPage from: 1 to: blockSize) - ^ (newPage blockAt: 1 byteSize: blockSize) at: 1 put: 1; yourself]! From commits at source.squeak.org Thu May 27 15:04:41 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 15:04:41 0000 Subject: [squeak-dev] FFI: FFI-CallbacksTests-mt.2.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.2.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.2 Author: mt Time: 27 May 2021, 5:04:41.572121 pm UUID: 0dd9372f-59fc-bd4e-8fd7-9836d999426e Ancestors: FFI-CallbacksTests-mt.1 Complements FFI-Callbacks-mt.21 =============== Diff against FFI-CallbacksTests-mt.1 =============== Item was added: + ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- + test08ManagedCallback + + | array unsorted sorted compare callback | + unsorted := #(71 66 33 77 16 63 91 54 48 52). + sorted := #(16 33 48 52 54 63 66 71 77 91). + + array := ExternalType int32_t allocate: 10. + 1 to: array size do: [:index | + array at: index put: (unsorted at: index)]. + + compare := [:a :b | (a - b) sign]. + callback := FFICallback newGC. + callback + setBlock: compare + signature: #(int32_t 'int32_t*' 'int32_t*'). + + lib + qsort: array + with: array size + with: array contentType byteSize + with: callback. + self assert: (sorted hasEqualElements: array). + + Smalltalk garbageCollect. + self deny: callback isNull. + compare := nil. + Smalltalk garbageCollect. + self assert: callback isNull.! From eliot.miranda at gmail.com Thu May 27 16:42:17 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Thu, 27 May 2021 09:42:17 -0700 Subject: [squeak-dev] The new object based UI is a disaster for certain tasks Message-ID: Hi All, there *must* be a simple way to avoid the object selection behaviour of the new print it. Here's a motivating example. Today I wanted to examine the difference between two classes in a particular package. (StackInterpreterSimulator organization categories select: [:c| c beginsWith: '*VM']) select: [:c| (StackInterpreterSimulator organization listAtCategoryNamed: c) ~= (CogVMSimulator organization listAtCategoryNamed: c)] #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user interface') Then I wanted to see what the difference was. An initial use of copyWithoutAll: gave me unexpected results. So I eyeballed the two categories: #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user interface') collect: [:c| {CogVMSimulator organization listAtCategoryNamed: c. StackInterpreterSimulator organization listAtCategoryNamed: c}] #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript #windowColorToUse) #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph #windowColorToUse)) #(#(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) #(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript #toggleTranscriptForSimulatorMorph: #utilitiesMenu:))) The first thing I was frustrated in was to add some carriage returns, so I could see. I wanted to format the output thus: #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript #windowColorToUse) #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph #windowColorToUse)) #(#(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) #(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript #toggleTranscriptForSimulatorMorph: #utilitiesMenu:))) Of course the only way I can do this is by cursor movement. Any attempt to click with the mouse inspects the underlying object. Annoying but not disastrous. I can use the cursor keys. So I am able with minor frustration to find that StackInterpreterSimulator implements openAsSimulatorMorph whereas CogVMSimulator does not. Now the disastem. i simply want to look at the implementation of openAsSimulatorMorph. So I want to select it and type command-M for implementors. But with the new interface I have to do cursor selection with shift, and it's getting ridiculously slow just to find the implementors of a selector. Surely the best way would be to allow normal textual interaction but use a modifier key to inspect the underlying object. I have to completely relearn my muscle memory and abandon my mouse to use this stuff. And that is a disaster for me. _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From eliot.miranda at gmail.com Thu May 27 16:53:45 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Thu, 27 May 2021 09:53:45 -0700 Subject: [squeak-dev] The new object based UI is a disaster for certain tasks In-Reply-To: References: Message-ID: On Thu, May 27, 2021 at 9:42 AM Eliot Miranda wrote: > Hi All, > > there *must* be a simple way to avoid the object selection behaviour > of the new print it. > OK, I get it. I have to do copy, paste and then the underlying object disappears. > Here's a motivating example. > > Today I wanted to examine the difference between two classes in a > particular package. > > (StackInterpreterSimulator organization categories select: [:c| c > beginsWith: '*VM']) select: > [:c| (StackInterpreterSimulator organization listAtCategoryNamed: c) ~= > (CogVMSimulator organization listAtCategoryNamed: c)] > #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user interface') > > Then I wanted to see what the difference was. An initial use of > copyWithoutAll: gave me unexpected results. So I eyeballed the two > categories: > > #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user > interface') collect: > [:c| {CogVMSimulator organization listAtCategoryNamed: c. > StackInterpreterSimulator organization listAtCategoryNamed: c}] > > #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript > #windowColorToUse) > #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph > #windowColorToUse)) #(#(#evaluatePrinter:on: #headFramePointer > #headStackPointer #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) > #(#evaluatePrinter:on: #headFramePointer #headStackPointer > #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript > #toggleTranscriptForSimulatorMorph: #utilitiesMenu:))) > > The first thing I was frustrated in was to add some carriage returns, so I > could see. I wanted to format the output thus: > > #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript #windowColorToUse) > #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph > #windowColorToUse)) > #(#(#evaluatePrinter:on: #headFramePointer #headStackPointer > #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) > #(#evaluatePrinter:on: #headFramePointer #headStackPointer > #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript > #toggleTranscriptForSimulatorMorph: #utilitiesMenu:))) > > Of course the only way I can do this is by cursor movement. Any attempt > to click with the mouse inspects the underlying object. Annoying but not > disastrous. I can use the cursor keys. So I am able with minor > frustration to find that StackInterpreterSimulator > implements openAsSimulatorMorph whereas CogVMSimulator does not. Now the > disastem. i simply want to look at the implementation > of openAsSimulatorMorph. So I want to select it and type command-M for > implementors. But with the new interface I have to do cursor selection > with shift, and it's getting ridiculously slow just to find the > implementors of a selector. > > Surely the best way would be to allow normal textual interaction but use a > modifier key to inspect the underlying object. I have to completely > relearn my muscle memory and abandon my mouse to use this stuff. And that > is a disaster for me. > > _,,,^..^,,,_ > best, Eliot > -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From maxleske at gmail.com Thu May 27 20:05:50 2021 From: maxleske at gmail.com (Max Leske) Date: Thu, 27 May 2021 22:05:50 +0200 Subject: [squeak-dev] Fuel projects, anyone? Message-ID: Hi everyone, I was made aware that there actually *are* people who use Fuel :) I rarely get feedback, apart from the spare bug report, so I was thrilled to hear about people who use it actively or even have applications in production that rely on Fuel. To celebrate that (and boost my own ego of course...) I've added a "Projects using Fuel" section to the readme on GitHub and I'd love to see more entries in that list! So please let me know (or open a PR!) if you think your project deserves some exposure ;) Here's the link: https://github.com/theseion/Fuel. Stay awesome and positive! Cheers, Max -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: OpenPGP digital signature URL: From tim at rowledge.org Thu May 27 22:03:14 2021 From: tim at rowledge.org (tim Rowledge) Date: Thu, 27 May 2021 15:03:14 -0700 Subject: [squeak-dev] Fuel projects, anyone? In-Reply-To: References: Message-ID: Whilst I don't (so far as I know!) use Fuel, we collectively ought to do a lot better at publicising our projects and their uses. > On 2021-05-27, at 1:05 PM, Max Leske wrote: > > Hi everyone, > > I was made aware that there actually are people who use Fuel :) I rarely get feedback, apart from the spare bug report, so I was thrilled to hear about people who use it actively or even have applications in production that rely on Fuel. > > To celebrate that (and boost my own ego of course...) I've added a "Projects using Fuel" section to the readme on GitHub and I'd love to see more entries in that list! So please let me know (or open a PR!) if you think your project deserves some exposure ;) > > Here's the link: https://github.com/theseion/Fuel. > > Stay awesome and positive! > > Cheers, > Max > > tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim No one is listening until you make a mistake From eliot.miranda at gmail.com Thu May 27 22:19:19 2021 From: eliot.miranda at gmail.com (Eliot Miranda) Date: Thu, 27 May 2021 15:19:19 -0700 Subject: [squeak-dev] 16-bit SoundBuffer Message-ID: Hi All, I'm looking for debugging help as I don't have time to look at this. Here's a change set that renames SoundBuffer to OldSOundBuffer and introduces an equivalent replacement that uses the native 16-bit format Spur supports, and hence provides faster access via jitted at: & at:put: primitives. Things seem to work except the one sound test that fails in writing the data to a file. If you have time or energy please take a look. AdvThanksance _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: 16BitSoundBuffer.st Type: application/octet-stream Size: 15346 bytes Desc: not available URL: From marcel.taeumel at hpi.de Fri May 28 05:40:52 2021 From: marcel.taeumel at hpi.de (Marcel Taeumel) Date: Fri, 28 May 2021 07:40:52 +0200 Subject: [squeak-dev] The new object based UI is a disaster for certain tasks In-Reply-To: References: Message-ID: Hi Eliot, cut/copy-and-paste removes it. And so does CMD+0. The preference is called "interactive print-it" and can be disabled. IMO, we should have a simple filter for such primitives that can easily inspected in their text form. Strings, Symbols, literal arrays.... http://forum.world.st/The-Inbox-Morphic-ct-1586-mcz-tp5106774p5129065.html [http://forum.world.st/The-Inbox-Morphic-ct-1586-mcz-tp5106774p5129065.html] Best, Marcel Am 27.05.2021 18:54:11 schrieb Eliot Miranda : On Thu, May 27, 2021 at 9:42 AM Eliot Miranda wrote: Hi All,     there *must* be a simple way to avoid the object selection behaviour of the new print it.  OK, I get it.  I have to do copy, paste and then the underlying object disappears. Here's a motivating example. Today I wanted to examine the difference between two classes in a particular package. (StackInterpreterSimulator organization categories select: [:c| c beginsWith: '*VM']) select: [:c| (StackInterpreterSimulator organization listAtCategoryNamed: c) ~= (CogVMSimulator organization listAtCategoryNamed: c)] #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user interface') Then I wanted to see what the difference was. An initial use of copyWithoutAll: gave me unexpected results.  So I eyeballed the two categories: #(#'*VMMakerUI-InterpreterSimulation-Morphic' #'*VMMakerUI-user interface') collect: [:c| {CogVMSimulator organization listAtCategoryNamed: c. StackInterpreterSimulator organization listAtCategoryNamed: c}]  #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript #windowColorToUse)  #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph #windowColorToUse)) #(#(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) #(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript #toggleTranscriptForSimulatorMorph: #utilitiesMenu:)))  The first thing I was frustrated in was to add some carriage returns, so I could see.  I wanted to format the output thus: #(#(#(#eventQueue #openAsMorph #openAsMorphNoTranscript #windowColorToUse) #(#eventQueue #openAsMorph #openAsMorphNoTranscript #openAsSimulatorMorph #windowColorToUse)) #(#(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #toggleTranscript #utilitiesMenu:) #(#evaluatePrinter:on: #headFramePointer #headStackPointer #printFrame:WithSP:on: #setClickStepBreakBlock #toggleTranscript #toggleTranscriptForSimulatorMorph: #utilitiesMenu:)))  Of course the only way I can do this is by cursor movement.  Any attempt to click with the mouse inspects the underlying object.  Annoying but not disastrous.  I can use the cursor keys.  So I am able with minor frustration to find that StackInterpreterSimulator implements openAsSimulatorMorph whereas CogVMSimulator does not.  Now the disastem.  i simply want to look at the implementation of openAsSimulatorMorph.  So I want to select it and type command-M for implementors.  But with the new interface I have to do cursor selection with shift, and it's getting ridiculously slow just to find the implementors of a selector. Surely the best way would be to allow normal textual interaction but use a modifier key to inspect the underlying object.  I have to completely relearn my muscle memory and abandon my mouse to use this stuff.  And that is a disaster for me. _,,,^..^,,,_ best, Eliot -- _,,,^..^,,,_ best, Eliot -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Fri May 28 09:15:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 09:15:39 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.22.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.22.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.22 Author: mt Time: 28 May 2021, 11:15:38.8907 am UUID: ed814637-f5b8-294e-8838-559202cd3716 Ancestors: FFI-Callbacks-mt.21 Clean up and document GC interface for FFI callbacks. Use the managed version for bsearch and qsort because both are short-living. =============== Diff against FFI-Callbacks-mt.21 =============== Item was added: + ----- Method: BlockClosure>>gcSignature: (in category '*FFI-Callbacks') ----- + gcSignature: signature + + ^ FFICallback + gcSignature: signature + block: self! Item was changed: ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') ----- bsearch: key in: array compare: block + | result | + result := self - | result callback | - [result := self bsearch: key with: array with: array size with: array contentType byteSize + with: (self compare: array contentType through: block). - with: (callback := self compare: array contentType through: block). - ] ensure: [callback free]. result setContentType: array contentType; setSize: 1. ^ result! Item was changed: ----- Method: CStandardLibrary>>compare:through: (in category '*FFI-Callbacks') ----- compare: contentType through: evaluable "Answers a callback for comparing the given contentType through the given evaluable, i.e., messages sends or blocks. Supports pointer types as contentType." | argType signature | self assert: [evaluable numArgs = 2]. argType := contentType isPointerType ifTrue: [(contentType asArrayType: nil)] ifFalse: [contentType]. signature := ((thisContext method pragmaAt: #callback:) argumentAt: 1) copy. signature at: 2 put: argType asPointerType. signature at: 3 put: argType asPointerType. + ^ evaluable gcSignature: signature! - ^ evaluable signature: signature! Item was changed: ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') ----- qsort: array compare: block + + ^ self - - | callback result | - [result := self qsort: array with: array size with: array contentType byteSize + with: (self compare: array contentType through: block)! - with: (callback := self compare: array contentType through: block). - ] ensure: [callback free]. - ^ result! Item was added: + ----- Method: FFICallback class>>gcMessage: (in category 'instance creation - managed') ----- + gcMessage: message + "Like #message: but automatically free'd when message gets garbage collected. Thus, the callback holds only weakly to the message and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setMessage: message; + yourself + ! Item was added: + ----- Method: FFICallback class>>gcSignature:block: (in category 'instance creation - managed') ----- + gcSignature: signature "" block: aBlock " ^" + "Like #signature:block: but automatically free'd when aBlock gets garbage collected. Thus, the callback holds only weakly to aBlock and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setBlock: aBlock + signature: signature; + yourself! Item was added: + ----- Method: FFICallback class>>gcSignature:message: (in category 'instance creation - managed') ----- + gcSignature: signature "" message: message " ^" + "Like #signature:message: but automatically free'd when message gets garbage collected. Thus, the callback holds only weakly to the message and the sender MUST take care of not loosing the reference as long as needed. BEWARE that any external library using a free'd NULL callback will most likely SEGFAULT." + + ^ self newGC + setMessage: message + signature: signature; + yourself! Item was added: + ----- Method: FFICallback class>>lookupCallbackForEvaluable: (in category 'instance lookup') ----- + lookupCallbackForEvaluable: evaluable + "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." + + ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was changed: ----- Method: FFICallback class>>message: (in category 'instance creation') ----- message: message " ^" + "Answers a new FFI callback for the given message (send). The callback signature will be looked up in the actual method's callback pragma." + ^ self new + setMessage: message; + yourself - setMessage: message ! Item was changed: + ----- Method: FFICallback class>>newGC (in category 'instance creation - managed') ----- - ----- Method: FFICallback class>>newGC (in category 'instance creation') ----- newGC ^ self new beManaged; yourself! Item was changed: ----- Method: FFICallback class>>signature:block: (in category 'instance creation') ----- + signature: signature "" block: aBlock " ^" + "Answers a new FFI callback for the given signature and block. The signature can have the form of a callback pragma, a list of type names, or a list of actual types. The first type is always the return type." + - signature: signature "" block: aBlock " ^" ^ self new setBlock: aBlock + signature: signature; + yourself! - signature: signature! Item was changed: ----- Method: FFICallback class>>signature:message: (in category 'instance creation') ----- + signature: signature "" message: message " ^" + "Answers a new FFI callback for the given signature and message (send). The signature can have the form of a callback pragma, a list of type names, or a list of actual types. The first type is always the return type." + - signature: signature "" message: message " ^" ^ self new setMessage: message + signature: signature; + yourself! - signature: signature! From commits at source.squeak.org Fri May 28 09:16:30 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 09:16:30 0000 Subject: [squeak-dev] FFI: FFI-CallbacksTests-mt.3.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.3.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.3 Author: mt Time: 28 May 2021, 11:16:30.0737 am UUID: c7b02b69-cc7d-5148-af00-423356b5bd8c Ancestors: FFI-CallbacksTests-mt.2 Complements FFI-Callbacks-mt.22 =============== Diff against FFI-CallbacksTests-mt.2 =============== Item was changed: ----- Method: FFICallbackTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + test02SortArrayOfDoublesRaw "Coercing checks are too aggressive or just wrong." - test02SortArrayOfDoublesRaw "Checked on 32-bit. Coercing checks are too aggressive or just wrong." test04SortArrayOfIntegersRaw "See above." )! Item was changed: ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- test08ManagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. + callback := compare gcSignature: #(int32_t 'int32_t*' 'int32_t*'). - callback := FFICallback newGC. - callback - setBlock: compare - signature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). + "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. + + "Callback depends on the existence of the compare block." + self + assert: callback + identical: (FFICallback lookupCallbackForEvaluable: compare). compare := nil. Smalltalk garbageCollect. self assert: callback isNull.! Item was added: + ----- Method: FFICallbackTests>>test09UnmanagedCallback (in category 'tests') ----- + test09UnmanagedCallback + + | array unsorted sorted compare callback | + unsorted := #(71 66 33 77 16 63 91 54 48 52). + sorted := #(16 33 48 52 54 63 66 71 77 91). + + array := ExternalType int32_t allocate: 10. + 1 to: array size do: [:index | + array at: index put: (unsorted at: index)]. + + compare := [:a :b | (a - b) sign]. + callback := compare signature: #(int32_t 'int32_t*' 'int32_t*'). + + lib + qsort: array + with: array size + with: array contentType byteSize + with: callback. + self assert: (sorted hasEqualElements: array). + + "Callback no longer needed but still there." + Smalltalk garbageCollect. + self deny: callback isNull. + + "Callback independent from the compare block." + self assert: (FFICallback lookupCallbackForEvaluable: compare) isNil. + compare := nil. + Smalltalk garbageCollect. + self deny: callback isNull. + + "Callback needs to be free'd manually." + callback free. + self assert: callback isNull.! From commits at source.squeak.org Fri May 28 10:52:04 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 10:52:04 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.179.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.179.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.179 Author: mt Time: 28 May 2021, 12:52:03.4977 pm UUID: c02c8260-e6ed-4845-a202-ddf2cd193be0 Ancestors: FFI-Kernel-mt.178 Adds #isStringType check to speed up ExternalData. Fixes access and code generation for array types and pointer-to-array types. =============== Diff against FFI-Kernel-mt.178 =============== Item was changed: ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset + | resultHandle | + resultHandle := handle structAt: byteOffset length: self byteSize. + ^ self isTypeAlias + ifTrue: [referentClass fromHandle: resultHandle] + ifFalse: [ExternalData fromHandle: resultHandle type: self]! - ^ ExternalData - fromHandle: (handle structAt: byteOffset length: self byteSize) - type: self! Item was added: + ----- Method: ExternalArrayType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset + ^ self isTypeAlias + ifTrue: [ + '^ {1} fromHandle: (handle structAt: {1} length: {2})' + format: { + referentClass name. + byteOffset. + self byteSize}] + ifFalse: [ + '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' + format: { + byteOffset. + self byteSize. + self storeStringForField}]! - ^ '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' - format: { - byteOffset. - self byteSize. - self storeStringForField}! Item was added: + ----- Method: ExternalAtomicType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was changed: ----- Method: ExternalData>>setContentType: (in category 'initialize-release') ----- setContentType: externalType + | newContentType | + (newContentType := externalType) isStringType ifTrue: [ + newContentType := newContentType asNonPointerType]. - externalType = ExternalType string ifTrue: [ - ^ self setContentType: externalType asNonPointerType]. + self setType: (newContentType isVoid + ifTrue: [newContentType "Size gets lost for void."] + ifFalse: [newContentType asArrayType: self size]).! - self setType: (externalType isVoid - ifTrue: [externalType "Size gets lost for void."] - ifFalse: [externalType asArrayType: self size]).! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- setType: externalType "Private. Set the type used to derive content and container types. If you want to change the content type later, use #setContentType:." + | newType isVoid | + (newType := externalType) isStringType ifTrue: [ + newType := newType asNonPointerType]. - externalType = ExternalType string ifTrue: [ - ^ self setType: externalType asNonPointerType]. + (isVoid := newType isVoid) ifTrue: [ + newType := newType asPointerType]. - externalType isVoid ifTrue: [ - ^ self setType: externalType asPointerType]. + (newType isArrayType or: [isVoid or: [newType asNonPointerType isVoid]]) + ifTrue: [type := newType "array type or void*"] + ifFalse: [type := (newType asArrayType: nil)]. - (externalType isArrayType or: [externalType asNonPointerType isVoid]) - ifTrue: [type := externalType "array type or void*"] - ifFalse: [type := (externalType asArrayType: nil)]. contentType := nil.! Item was changed: ----- Method: ExternalPointerType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset + | referentClassToUse | + referentClassToUse := self isPointerTypeForArray + ifFalse: [referentClass] + ifTrue: [self asNonPointerType isTypeAlias + ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]]. + ^ referentClassToUse - ^ referentClass ifNotNil: [ + referentClassToUse fromHandle: (handle pointerAt: byteOffset length: self byteSize)] - referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] ifNil: [ ExternalData fromHandle: (handle pointerAt: byteOffset length: self byteSize) type: self asNonPointerType "content type"]! Item was changed: ----- Method: ExternalPointerType>>isPointerTypeForArray (in category 'testing') ----- isPointerTypeForArray + "referentClass is currently nil for pointer-to-array types. All operations on referentClass should check this to then use the referentClass from the non-pointer type. Might be changed once array information are encoded in the headerWord." + - ^ self asNonPointerType isArrayType! Item was added: + ----- Method: ExternalPointerType>>isStringType (in category 'testing - special') ----- + isStringType + "If pointer to atomic, the atomic type is encoded directly in the headerWord. Might change in the future; use #asNonPointerType in that case." + + ^ self atomicType = FFITypeUnsignedChar! Item was changed: ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') ----- readFieldAt: byteOffset + + | referentClassToUse | + referentClassToUse := self isPointerTypeForArray + ifFalse: [referentClass] + ifTrue: [self asNonPointerType isTypeAlias + ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]]. - " - ExternalStructure defineAllFields. - " ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}' format: { + (referentClassToUse ifNil: [ExternalData]) name. - (referentClass ifNil: [ExternalData]) name. byteOffset. self byteSize. + referentClassToUse ifNotNil: [''] ifNil: [ - referentClass ifNotNil: [''] ifNil: [ ' type: ', self asNonPointerType "content type" storeStringForField]}! Item was added: + ----- Method: ExternalStructureType>>isStringType (in category 'testing - special') ----- + isStringType + + ^ false! Item was added: + ----- Method: ExternalType>>isStringType (in category 'testing - special') ----- + isStringType + + | type | + type := self atomicType. + ^ type = FFITypeUnsignedChar and: [self isPointerType]! From commits at source.squeak.org Fri May 28 10:54:06 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 10:54:06 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.23.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.23.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.23 Author: mt Time: 28 May 2021, 12:54:05.2767 pm UUID: 5829377d-876a-5747-a754-3d4c5f9f3257 Ancestors: FFI-Callbacks-mt.22 Minor speed-up for callback evaluation. =============== Diff against FFI-Callbacks-mt.22 =============== Item was changed: ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') ----- evaluateCallbackForContext: callbackContext " ^ typeCode" ^ ThunkToCallbackMap + at: callbackContext thunkp_address - at: callbackContext thunkp getHandle ifPresent: [:callback | callback valueInContext: callbackContext] ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] ! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( + (thunkp 'FFICallback*') - (thunkp 'void*') (stackPtr 'byte*') "was: char*" ), (FFIPlatformDescription current abiSend: #fields to: self), #( (nil 'void*') "was: savedCStackPointer" (nil 'void*') "was: savedCFramePointer" (rvs 'FFICallbackResult') (nil 'void*') "was: savedPrimFunctionPointer" (outerContext 'FFICallbackContext*') "jmp_buf trampoline --- for debugging only?" ) " typedef struct { void *thunkp; char *stackptr; long *intRegArgs; double *floatRegArgs; void *savedCStackPointer; void *savedCFramePointer; union { intptr_t vallong; struct { int low, high; } valleint64; struct { int high, low; } valbeint64; double valflt64; struct { void *addr; intptr_t size; } valstruct; } rvs; void *savedPrimFunctionPointer; jmp_buf trampoline; jmp_buf savedReenterInterpreter; } VMCallbackContext; "! Item was added: + ----- Method: FFICallbackContext class>>generateStructureFieldAccessorsFor:startingAt:type: (in category 'field definition - support') ----- + generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: type + "Overwritten to also generate a shortcut for thunkp + self defineFields. + " + super + generateStructureFieldAccessorsFor: fieldName + startingAt: byteOffset + type: type. + + fieldName = 'thunkp' ifTrue: [ + | shortcutCode shortcutSelector | + shortcutSelector := fieldName, '_address'. + shortcutCode := '{1}\ ^ handle pointerAt: {2} length: {3}' withCRs + format: { shortcutSelector . byteOffset . type byteSize }. + self maybeCompileAccessor: shortcutCode withSelector: shortcutSelector asSymbol].! From commits at source.squeak.org Fri May 28 14:50:43 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 14:50:43 0000 Subject: [squeak-dev] FFI: FFI-Callbacks-mt.24.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.24.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.24 Author: mt Time: 28 May 2021, 4:50:42.325735 pm UUID: 306ff3db-86cb-4c2b-8bc2-30505f1b8fda Ancestors: FFI-Callbacks-mt.23 Some clean up and minor refactoring. Since FFICallback is an alias for byte[40], should directly overwrite #fromHandle: to lookup the callback instance from our ThunkToCallbackMap. Deprecations: - FFICallback >> #thunk (obsolete, use FFICallback* type, not void*) - FFICallbackContext >> #thunkp (renamed to #callback) =============== Diff against FFI-Callbacks-mt.23 =============== Item was removed: - ----- Method: FFICallback class>>evaluateCallbackForContext: (in category 'instance lookup') ----- - evaluateCallbackForContext: callbackContext " ^ typeCode" - - ^ ThunkToCallbackMap - at: callbackContext thunkp_address - ifPresent: [:callback | callback valueInContext: callbackContext] - ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] - ! Item was added: + ----- Method: FFICallback class>>fromEvaluable: (in category 'instance lookup') ----- + fromEvaluable: evaluable + "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." + + ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was added: + ----- Method: FFICallback class>>fromHandle: (in category 'instance lookup') ----- + fromHandle: thunkAddress + + ^ ThunkToCallbackMap + at: thunkAddress + ifAbsent: [self error: 'could not locate Callback instance corresponding to thunk address'] + ! Item was removed: - ----- Method: FFICallback class>>getIntWithData:withData: (in category 'examples - signatures') ----- - getIntWithData: anExternalData1 withData: anExternalData2 - " - (FFICallback class >> #getIntWithData:withData:) pragmaAt: #callback: - " - "" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>getIntWithData:withData:withInt:withInt: (in category 'examples - signatures') ----- - getIntWithData: anExternalData1 withData: anExternalData2 withInt: anInteger1 withInt: anInteger2 - " - (FFICallback class >> #getIntWithData:withData:withInt:withInt:) pragmaAt: #callback: - " - "" - - self shouldNotImplement. - - - self flag: #todo: "Ignore macros, const, and '*,' comma" - "" - ! Item was removed: - ----- Method: FFICallback class>>getIntWithInt:withString: (in category 'examples - signatures') ----- - getIntWithInt: anInteger withString: aString - " - (FFICallback class >> #getIntWithInt:withString:) pragmaAt: #callback: - " - "" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>getVoidWithData:withDouble:withDouble: (in category 'examples - signatures') ----- - getVoidWithData: anExternalData withDouble: aFloat withDouble: anotherFloat - " - (FFICallback class >> #getVoidWithData:withDouble:withDouble:) pragmaAt: #callback: - " - "" - - self shouldNotImplement.! Item was removed: - ----- Method: FFICallback class>>lookupCallbackForEvaluable: (in category 'instance lookup') ----- - lookupCallbackForEvaluable: evaluable - "For managed callbacks, you can lookup the callback instance through the evaluable object you take care of." - - ^ EvaluableToCallbackMap at: evaluable ifAbsent: [nil]! Item was added: + ----- Method: FFICallback class>>new (in category 'instance creation') ----- + new + + ^ self basicNew! Item was changed: ----- Method: FFICallback class>>newGC (in category 'instance creation - managed') ----- newGC + ^ self basicNew + beManaged; + yourself! - ^ self new beManaged; yourself! Item was changed: + ----- Method: FFICallback>>beManaged (in category 'initialize-release') ----- - ----- Method: FFICallback>>beManaged (in category 'initialization') ----- beManaged "Mark the receiver to be free'd automatically when the #evaluableObject is gc'ed." self assert: [evaluableObject isNil]. evaluableObject := WeakArray new: 1.! Item was changed: + ----- Method: FFICallback>>evaluateDynamic: (in category 'evaluating') ----- - ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') ----- evaluateDynamic: callbackContext "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments." | arguments stack stackType stackByteOffset intArgs intPos floatArgs floatPos | stack := callbackContext stackPtr getHandle. stackType := callbackContext stackPtr contentType. stackByteOffset := 1. intArgs := callbackContext intRegArgs. intPos := 0. floatArgs := callbackContext floatRegArgs. floatPos := 0. arguments := Array new: argumentTypes size. 1 to: arguments size do: [:argIndex | | argType data isPointer | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) ifTrue: [intPos := intPos + 1. intArgs at: intPos] ifFalse: [(floatPos < floatArgs size and: [argType isFloatType]) ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]]. data ifNotNil: [ "1b) Read pointers from register value." isPointer ifFalse: ["data is already an integer"] ifTrue: [ data := (ExternalData fromHandle: (ExternalAddress fromInteger: data) type: argType asNonPointerType "contentType") value]] ifNil: [ "2) If nothing was read, read the argument from the stack." data := (argType handle: stack at: stackByteOffset) value. stackByteOffset := stackByteOffset + ((stackType byteSize max: argType byteSize) roundUpTo: stackType byteAlignment)]. arguments at: argIndex put: data]. ^ self setResult: (self evaluableObject valueWithArguments: arguments) inContext: callbackContext! Item was added: + ----- Method: FFICallback>>evaluator (in category 'accessing') ----- + evaluator + "Answers the one-argument selector that will be performed on the receiver on callback evaluation using a callback context." + + ^ evaluator! Item was added: + ----- Method: FFICallback>>evaluator: (in category 'accessing') ----- + evaluator: aSymbol + "Set the one-argument selector that will be performed on the receiver on callback evaluation using a callback context. Use it to call a custom evaluator added via method extension on the receiver's class." + + self assert: [aSymbol numArgs = 1]. + evaluator := aSymbol.! Item was changed: + ----- Method: FFICallback>>free (in category 'initialize-release') ----- - ----- Method: FFICallback>>free (in category 'initialization') ----- free handle ifNil: [^ self]. ThunkToCallbackMap removeKey: handle. self zeroMemory. handle := nil. ! Item was changed: + ----- Method: FFICallback>>init__ccall (in category 'private') ----- - ----- Method: FFICallback>>init__ccall (in category 'initialization - thunk prepare') ----- init__ccall "Initialize the receiver with a __ccall thunk." FFIPlatformDescription current abiSend: #'init_ccall' to: self.! Item was changed: + ----- Method: FFICallback>>init__ccall_ARM32 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') ----- init__ccall_ARM32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm32abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long r0, long r1, long r2, long r3, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "0x0 : mov r12, sp ; 0xe1a0c00d 0x4 : sub sp, sp, #16 ; 0xe24dd010 0x8 : str pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates 0xc : str r12, [sp,#4] ; 0xe58dc004 0x10 : str lr, [sp, #12] ; 0xe58de00c 0x14 : ldr r12, [pc, #8] ; 0xe59fc008 0x18 : blx r12 ; 0xe12fff3c 0x1c : add sp, sp, #12 ; 0xe28dd00c 0x20 : ldr pc, [sp], #4!! ; 0xe49df004 ; pop {pc} 0x24 : .word thunkEntry" handle "thunk" type: #uint32_t at: 1 put: 16re1a0c00d; type: #uint32_t at: 5 put: 16re24dd010; type: #uint32_t at: 9 put: 16re58df000; "thunk+16; see above" type: #uint32_t at: 13 put: 16re58dc004; type: #uint32_t at: 17 put: 16re58de00c; type: #uint32_t at: 21 put: 16re59fc008; type: #uint32_t at: 25 put: 16re12fff3c; type: #uint32_t at: 29 put: 16re28dd00c; type: #uint32_t at: 33 put: 16re49df004; type: #pointer at: 37 put: self thunkEntryAddress.! Item was changed: + ----- Method: FFICallback>>init__ccall_ARM64 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_ARM64 (in category 'initialization - thunk prepare') ----- init__ccall_ARM64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the Alien/IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/arm64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long x0, long x1, long x2, long x3, long x4, long x5, long x6, long x7, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." self shouldBeImplemented "self newCCall"! Item was changed: + ----- Method: FFICallback>>init__ccall_IA32 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_IA32 (in category 'initialization - thunk prepare') ----- init__ccall_IA32 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0x9090c30C thunk+21: ret 0xc3 thunk+22: nop 0x90 thunk+23: nop 0x90" handle "thunk" type: #uint32_t at: 1 put: 16rB8905454; type: #pointer at: 5 put: self thunkEntryAddress; type: #uint32_t at: 9 put: 16r68909090; type: #pointer at: 13 put: handle; type: #uint32_t at: 17 put: 16rC483D0FF; type: #uint32_t at: 21 put: 16r9090C30C! Item was changed: + ----- Method: FFICallback>>init__ccall_X64 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_X64 (in category 'initialization - thunk prepare') ----- init__ccall_X64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64sysvabicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, floating-point register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. handle thunk+0xc: pushq %rax 50 thunk+0xd: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x17: callq *%rax ff d0 thunk+0x19: addq $0x18, %rsp 48 83 c4 18 thunk+0x1d: retq c3 thunk+0x1e: nop 90 thunk+0x1f: nop 90" handle "thunk" type: #uint32_t at: 1 put: 16rb8485454; type: #pointer at: 5 put: handle; type: #uint32_t at: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" type: #pointer at: 16 put: self thunkEntryAddress; type: #uint8_t at: 24 put: 16rff; "alignment" type: #uint32_t at: 25 put: 16rc48348d0; type: #uint32_t at: 29 put: 16r9090c318.! Item was changed: + ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'private') ----- - ----- Method: FFICallback>>init__ccall_X64Win64 (in category 'initialization - thunk prepare') ----- init__ccall_X64Win64 "Initialize the receiver with a __ccall thunk. The thunk calls thunkEntry in the IA32ABI plugin, whose source is in platforms/Cross/plugins/IA32ABI/x64win64abicc.c. thunkEntry is the entry point for Callbacks. The objective of the thunk is to call thunkEntry with all arguments to the call of the thunk (registers and stack) as well as a pointer to the thunk itself. thunkEntry is as follows: long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp) thunkEntry then collects the various arguments (thunk, integer register arguments, stack pointer) in a VMCallbackContext and invokes the callback via invokeCallbackContext:." "thunk+0x0: pushq %rsp 54 thunk+0x1: pushq %rsp 54 thunk+0x4: movabsq $thunk, %rax 48 b8 b0..b7 eight bytes of thunk address a.k.a. addressField thunk+0xc: pushq %rax 50 thunk+0xd: subq $0x20, %rsp 48 83 c4 e0 (this is addq -20 since the immediate is signed extended) thunk+0x11: movabsq $thunkEntry, %rax 48 b8 b0..b7 eight bytes of the thunkEntry address thunk+0x1b: callq *%rax ff d0 thunk+0x1d: addq $0x38, %rsp 48 83 c4 38 thunk+0x21: retq c3 thunk+0x22: nop 90 thunk+0x23: nop 90" handle "thunk" type: #uint32_t at: 1 put: 16rb8485454; type: #pointer at: 5 put: handle; type: #uint32_t at: 13 put: 16rc4834850; type: #uint32_t at: 17 put: 16r00b848e0; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" type: #pointer at: 20 put: self thunkEntryAddress; type: #uint8_t at: 28 put: 16rff; "alignment" type: #uint32_t at: 29 put: 16rc48348d0; type: #uint32_t at: 33 put: 16r9090c338.! Item was changed: + ----- Method: FFICallback>>init__stdcall: (in category 'private') ----- - ----- Method: FFICallback>>init__stdcall: (in category 'initialization - thunk prepare') ----- init__stdcall: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes." FFIPlatformDescription current abiSend: #'init_stdcall' to: self with: numBytes.! Item was changed: + ----- Method: FFICallback>>init__stdcall_IA32: (in category 'private') ----- - ----- Method: FFICallback>>init__stdcall_IA32: (in category 'initialization - thunk prepare') ----- init__stdcall_IA32: numBytes "Initialize the receiver with a __stdcall thunk with numBytes argument bytes. (See #init__ccall_IA32 for more info)" "thunk: push %esp 0x54 0xa1905454 thunk+01: push %esp 0x54 thunk+02: nop 0x90 thunk+03: mov $thunkEntry,%eax 0xb8 0x00 0x00 0x00 0x00 0x00000000 - entry thunk+08: nop 0x90 0x68909090 thunk+09: nop 0x90 thunk+10: nop 0x90 thunk+11: push $thunk 0x68 0x00 0x00 0x00 0x00 0x00000000 - thunk thunk+16: call *%eax 0xff 0xd0 0xc483d0ff thunk+18: add $0xC,%esp 0x83 0xc4 0x0C 0xBYTSc20C thunk+21: ret $bytes 0xc2 0xBY 0xTS" handle "thunk" type: #uint32_t at: 1 put: 16rB8905454; type: #pointer at: 5 put: self thunkEntryAddress; type: #uint32_t at: 9 put: 16r68909090; type: #pointer at: 13 put: handle; type: #uint32_t at: 17 put: 16rC483D0FF; type: #uint16_t at: 21 put: 16rC20C; type: #uint16_t at: 23 put: numBytes.! Item was changed: + ----- Method: FFICallback>>isManaged (in category 'testing') ----- - ----- Method: FFICallback>>isManaged (in category 'initialization') ----- isManaged "Answer whether the receiver will be free'd automatically when the #evaluableObject is gc'ed." ^ evaluableObject class isWeak ! Item was changed: + ----- Method: FFICallback>>primThunkEntryAddress (in category 'private') ----- - ----- Method: FFICallback>>primThunkEntryAddress (in category 'initialization - thunk prepare') ----- primThunkEntryAddress "^" "Answer the address of the entry-point for thunk callbacks: IA32: long thunkEntry(void *thunkp, long *stackp); X64: long thunkEntry(long a0, long a1, long a2, long a3, long a4, long a5, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkp, sqIntptr_t *stackp); X64Win64 long long thunkEntry(long long rcx, long long rdx, long long r8, long long r9, void *thunkp, sqIntptr_t *stackp); ARM32: long long thunkEntry(long r0, long r1, long r2, long r3, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp); ARM64: long long thunkEntry(long x0, long x1, long x2, long x3, long x4, long x5, long x6, long x7, double d0, double d1, double d2, double d3, double d4, double d5, double d6, double d7, void *thunkpPlus16, sqIntptr_t *stackp); etc. This is the function a callback thunk/trampoline should call to initiate a callback." ^self primitiveFailed! Item was changed: + ----- Method: FFICallback>>setBlock: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setBlock: (in category 'initialization') ----- setBlock: aBlock "We cannot know the signature for an arbitrary block." self shouldNotImplement.! Item was changed: + ----- Method: FFICallback>>setBlock:signature: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setBlock:signature: (in category 'initialization') ----- setBlock: aBlock "" signature: signature "" self setTypes: (ExternalType lookupTypes: signature) evaluableObject: aBlock.! Item was changed: + ----- Method: FFICallback>>setMessage: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setMessage: (in category 'initialization') ----- setMessage: aMessageSend "Fetch the argTypes from pragma in method." | method | self assert: [aMessageSend receiver notNil]. method := aMessageSend receiver class lookupSelector: aMessageSend selector. self setTypes: ((method pragmaAt: #callback:) argumentAt: 1) evaluableObject: aMessageSend.! Item was changed: + ----- Method: FFICallback>>setMessage:signature: (in category 'initialize-release') ----- - ----- Method: FFICallback>>setMessage:signature: (in category 'initialization') ----- setMessage: aMessageSend signature: signature "Override the argTypes from pragma in method." self assert: [aMessageSend receiver notNil]. self setTypes: (ExternalType lookupTypes: signature) evaluableObject: aMessageSend.! Item was changed: + ----- Method: FFICallback>>setResult:inContext: (in category 'evaluating') ----- - ----- Method: FFICallback>>setResult:inContext: (in category 'callback') ----- setResult: anObject inContext: aCallbackContext "Set the result in the callback context. Add some fast checks to detect errors." resultType isPointerType ifTrue: [ "an ExternalStructure, an ExternalUnion, an ExternalData, ..." ^ aCallbackContext externalObjectResult: anObject]. resultType atomicType = 0 "void" ifTrue: ["Quick exit for void return type." ^ aCallbackContext voidResult]. anObject isInteger ifTrue: [ self assert: [resultType isIntegerType]. self flag: #todo. "mt: ABI #X64Win64 has special treatment for word64, too. But maybe it is not needed." ^ (anObject isLarge and: [FFIPlatformDescription current abi = #IA32]) ifTrue: [aCallbackContext word64Result: anObject] ifFalse: [aCallbackContext wordResult: anObject]]. anObject isBoolean ifTrue: [ self assert: [resultType atomicType = 1 "bool"]. ^ aCallbackContext wordResult: anObject]. anObject isFloat ifTrue: [ self assert: [resultType atomicType >= 12 "float/double"]. ^ aCallbackContext floatResult: anObject]. self notify: 'Unkown result type.'. ^ aCallbackContext errorResult! Item was changed: + ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'private') ----- - ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') ----- setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage self evaluableObject: blockOrMessage. argumentTypes := moreExternalTypes. resultType := anExternalType. "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the pragma which specifies how many bytes to pop. See http://forum.world.st/Pharo-FFI-on-aarch64-arm64-td5096777.html#a5096786." handle := FFICallbackMemory allocateExecutableBlock getHandle. self init__ccall. "self init__stdcall: 0." "(method pragmaAt: #calleepops:) ifNil: [self init__ccall] ifNotNil: [:pragma | self init__stdcall: (pragma argumentAt: 1)]." "numEvaluatorArgs := (evaluator := method selector) numArgs. self addToThunkTable" ThunkToCallbackMap at: handle put: self! Item was changed: + ----- Method: FFICallback>>setTypes:evaluableObject: (in category 'private') ----- - ----- Method: FFICallback>>setTypes:evaluableObject: (in category 'initialization') ----- setTypes: externalTypes evaluableObject: blockOrMessage self setResultType: externalTypes first argumentTypes: externalTypes allButFirst evaluableObject: blockOrMessage.! Item was changed: ----- Method: FFICallback>>thunk (in category 'accessing') ----- thunk + self deprecated: 'Type your callbacks as FFICallback* and use instances of FFICallback directly.'. ^ self value! Item was changed: + ----- Method: FFICallback>>thunkEntryAddress (in category 'private') ----- - ----- Method: FFICallback>>thunkEntryAddress (in category 'initialization - thunk prepare') ----- thunkEntryAddress ^ ExternalAddress fromInteger: self primThunkEntryAddress! Item was changed: + ----- Method: FFICallback>>valueInContext: (in category 'evaluating') ----- - ----- Method: FFICallback>>valueInContext: (in category 'callback') ----- valueInContext: callbackContext " ^" ^ evaluator ifNil: [self evaluateDynamic: callbackContext] ifNotNil: [evaluator perform: callbackContext]! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( + (callback 'FFICallback*') "was: thunkp void*" - (thunkp 'FFICallback*') (stackPtr 'byte*') "was: char*" ), (FFIPlatformDescription current abiSend: #fields to: self), #( (nil 'void*') "was: savedCStackPointer" (nil 'void*') "was: savedCFramePointer" (rvs 'FFICallbackResult') (nil 'void*') "was: savedPrimFunctionPointer" (outerContext 'FFICallbackContext*') "jmp_buf trampoline --- for debugging only?" ) " typedef struct { void *thunkp; char *stackptr; long *intRegArgs; double *floatRegArgs; void *savedCStackPointer; void *savedCFramePointer; union { intptr_t vallong; struct { int low, high; } valleint64; struct { int high, low; } valbeint64; double valflt64; struct { void *addr; intptr_t size; } valstruct; } rvs; void *savedPrimFunctionPointer; jmp_buf trampoline; jmp_buf savedReenterInterpreter; } VMCallbackContext; "! Item was removed: - ----- Method: FFICallbackContext class>>generateStructureFieldAccessorsFor:startingAt:type: (in category 'field definition - support') ----- - generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset type: type - "Overwritten to also generate a shortcut for thunkp - self defineFields. - " - super - generateStructureFieldAccessorsFor: fieldName - startingAt: byteOffset - type: type. - - fieldName = 'thunkp' ifTrue: [ - | shortcutCode shortcutSelector | - shortcutSelector := fieldName, '_address'. - shortcutCode := '{1}\ ^ handle pointerAt: {2} length: {3}' withCRs - format: { shortcutSelector . byteOffset . type byteSize }. - self maybeCompileAccessor: shortcutCode withSelector: shortcutSelector asSymbol].! Item was added: + ----- Method: FFICallbackContext>>thunkp (in category 'accessing') ----- + thunkp + + self deprecated: 'Use #callback directly'. + ^ self callback! Item was changed: ----- Method: FFICallbackMemory class>>invokeCallbackContext: (in category 'callbacks') ----- invokeCallbackContext: vmCallbackContextAddress "" "The low-level entry-point for callbacks sent from the VM/IA32ABI plugin. Evaluate the callback corresponding to the thunk referenced by vmCallbackContextAddress, a pointer to a VMCallbackContext32 or VMCallbackContext64, set up by the VM's thunkEntry routine. Return from the Callback via primSignal:andReturnAs:fromContext:. thisContext's sender is typically an FFI call-out context and is restored as the Process's top context on return. Therefore callbacks run on the process that did the call-out in which the callback occurred." | callbackContext typeCode helper | callbackContext := FFICallbackContext fromHandle: vmCallbackContextAddress. helper := self fromInteger: vmCallbackContextAddress. + [typeCode := callbackContext callback valueInContext: callbackContext] - [typeCode := FFICallback evaluateCallbackForContext: callbackContext] ifCurtailed: [self error: 'attempt to non-local return across a callback']. typeCode ifNil: [typeCode := callbackContext errorResult]. "Now attempt to return from a Callback. This must be done in LIFO order. The IA32ABI plugin maintains a linked list of vmCallbackContextAddresses to record this order. If vmCallbackContextAddress *is* that of the most recent Callback then the return will occur and the primitive will not return here. If vmCallbackContextAddress *is not* that of the most recent Callback the primitive will answer false, in which case this process waits on the lifoCallbackSemaphore which will be signalled by some other attempted Callback return. In any case (successful return from callback or answering false here), the primtive signals the first process waiting on the semaphore (which is after this one if this one was waiting), allowing the next process to attempt to return, and so on. Hence all nested callbacks should eventually return, and in the right order." [helper primSignal: LifoCallbackSemaphore andReturnAs: typeCode fromContext: thisContext] whileFalse: [LifoCallbackSemaphore wait]! From commits at source.squeak.org Fri May 28 14:51:32 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 14:51:32 0000 Subject: [squeak-dev] FFI: FFI-Kernel-mt.180.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.180.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.180 Author: mt Time: 28 May 2021, 4:51:31.579735 pm UUID: 62c92222-8259-4c75-8071-df970bef7363 Ancestors: FFI-Kernel-mt.179 Small bugfix. =============== Diff against FFI-Kernel-mt.179 =============== Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer + ^ (handle isExternalAddress or: [self isNull]) - ^ handle isExternalAddress ifTrue: [self] ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle)]! From commits at source.squeak.org Fri May 28 14:52:03 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Fri, 28 May 2021 14:52:03 0000 Subject: [squeak-dev] FFI: FFI-CallbacksTests-mt.4.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI: http://source.squeak.org/FFI/FFI-CallbacksTests-mt.4.mcz ==================== Summary ==================== Name: FFI-CallbacksTests-mt.4 Author: mt Time: 28 May 2021, 4:52:03.114735 pm UUID: ae1966df-d4d7-4464-947d-d1e4618d5e7d Ancestors: FFI-CallbacksTests-mt.3 Complements FFI-Callbacks-mt.24 =============== Diff against FFI-CallbacksTests-mt.3 =============== Item was changed: ----- Method: FFICallbackTests>>test08ManagedCallback (in category 'tests') ----- test08ManagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. callback := compare gcSignature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. "Callback depends on the existence of the compare block." self assert: callback + identical: (FFICallback fromEvaluable: compare). - identical: (FFICallback lookupCallbackForEvaluable: compare). compare := nil. Smalltalk garbageCollect. self assert: callback isNull.! Item was changed: ----- Method: FFICallbackTests>>test09UnmanagedCallback (in category 'tests') ----- test09UnmanagedCallback | array unsorted sorted compare callback | unsorted := #(71 66 33 77 16 63 91 54 48 52). sorted := #(16 33 48 52 54 63 66 71 77 91). array := ExternalType int32_t allocate: 10. 1 to: array size do: [:index | array at: index put: (unsorted at: index)]. compare := [:a :b | (a - b) sign]. callback := compare signature: #(int32_t 'int32_t*' 'int32_t*'). lib qsort: array with: array size with: array contentType byteSize with: callback. self assert: (sorted hasEqualElements: array). "Callback no longer needed but still there." Smalltalk garbageCollect. self deny: callback isNull. "Callback independent from the compare block." + self assert: (FFICallback fromEvaluable: compare) isNil. - self assert: (FFICallback lookupCallbackForEvaluable: compare) isNil. compare := nil. Smalltalk garbageCollect. self deny: callback isNull. "Callback needs to be free'd manually." callback free. self assert: callback isNull.! From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 17:00:14 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Fri, 28 May 2021 19:00:14 +0200 Subject: [squeak-dev] The Inbox: Morphic-ct.1771.mcz In-Reply-To: References: , Message-ID: Hi Marcel, yes, I also have thought about this pattern, but I actually don't see why it would be better or why Generator would be an anti-pattern. :-) Your approach requires one more selector than my approach. In general, I think that Generators are a promising way to objectify a lazily/partially evaluatable collection. Best, Christoph > Hi Christoph. > > Thanks. I think that the expected pattern is a little bit different, though. The explicit use of Generator is unfortunate but can be easily avoided. :-) > > allStringsAfter: morph do: block >    "..." > > allStringsAfter: morph >    ^ Array streamContents: [:stream | >       self allStringsAfter: morph do: [:string | >          stream nextPut: string]] > > hasStringsAfter: morph >    self allStringsAfter: morph do: [:string | ^ true]. >    ^ false > > Best, > Marcel > Am 25.05.2021 19:39:07 schrieb commits at source.squeak.org : > A new version of Morphic was added to project The Inbox: > http://source.squeak.org/inbox/Morphic-ct.1771.mcz > > ==================== Summary ==================== > > Name: Morphic-ct.1771 > Author: ct > Time: 25 May 2021, 7:38:48.072683 pm > UUID: 5a9ddaf0-a062-7047-b5b2-d2ae2da3fe15 > Ancestors: Morphic-mt.1769 > > Fixes a bottleneck when opening a yellow button menu on a morph that contains a very large number of subsub*morphs. On not-so-fast systems, this can be reproduced using: > > self systemNavigation browseAllSelect: #notNil > > On faster systems, you might need to write a small toolbuilder application to reproduce the bottleneck. I have an app with >10k list items in my image which actually blocked the image for several seconds when I yellow-clicked the window. > > Fixed the problem without duplicating the logic of #allStringsAfter: by using a generator. > > =============== Diff against Morphic-mt.1769 =============== > > Item was changed: > ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') ----- > addYellowButtonMenuItemsTo: aMenu event: evt > "Populate aMenu with appropriate menu items for a > yellow-button (context menu) click." > aMenu defaultTarget: self. > "" > Preferences noviceMode > ifFalse: [aMenu addStayUpItem]. > "" > self addModelYellowButtonItemsTo: aMenu event: evt. > "" > Preferences generalizedYellowButtonMenu > ifFalse: [^ self]. > "" > aMenu addLine. > aMenu add: 'inspect' translated action: #inspect. > "" > aMenu addLine. > self world selectedObject == self > ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] > ifFalse: [aMenu add: 'select' translated action: #addHalo]. > "" > (self isWorldMorph > or: [self mustBeBackmost > or: [self wantsToBeTopmost]]) > ifFalse: ["" > aMenu addLine. > aMenu add: 'send to back' translated action: #goBehind. > aMenu add: 'bring to front' translated action: #comeToFront. > self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. > "" > self isWorldMorph > ifFalse: ["" > Smalltalk > at: #NCAAConnectorMorph > ifPresent: [:connectorClass | > aMenu addLine. > aMenu add: 'connect to' translated action: #startWiring. > aMenu addLine]. > "" > > self isFullOnScreen > ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. > "" > Preferences noviceMode > ifFalse: ["" > self addLayoutMenuItems: aMenu hand: evt hand. > (owner notNil > and: [owner isTextMorph]) > ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]]. > "" > self isWorldMorph > ifFalse: ["" > aMenu addLine. > self addToggleItemsToHaloMenu: aMenu]. > "" > aMenu addLine. > self isWorldMorph > ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. > + (Generator on: [:gen | self streamAllStringsAfter: nil on: gen]) in: [:gen | > + "optimized!! #allStringsAfter: can be slow for large subtrees." > + gen atEnd ifFalse: [ > + aMenu add: 'copy text' translated action: #clipText]]. > - (self allStringsAfter: nil) isEmpty > - ifFalse: [aMenu add: 'copy text' translated action: #clipText]. > "" > self addExportMenuItems: aMenu hand: evt hand. > "" > (Preferences noviceMode not > and: [self isWorldMorph not]) > ifTrue: ["" > aMenu addLine. > aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. > "" > self addCustomMenuItems: aMenu hand: evt hand! > > Item was changed: > ----- Method: Morph>>allStringsAfter: (in category 'debug and other') ----- > + allStringsAfter: aSubmorph > - allStringsAfter: aSubmorph > - "return an OrderedCollection of strings of text in my submorphs. If aSubmorph is non-nil, begin with that container." > > + ^ OrderedCollection streamContents: [:stream | > + self streamAllStringsAfter: aSubmorph on: stream]! > - | list ok | > - list := OrderedCollection new. > - ok := aSubmorph isNil. > - self allMorphsDo: > - [:sub | | string | > - ok ifFalse: [ok := sub == aSubmorph]. "and do this one too" > - ok > - ifTrue: > - [(string := sub userString) ifNotNil: > - [string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]]. > - ^list! > > Item was added: > + ----- Method: Morph>>streamAllStringsAfter:on: (in category 'debug and other') ----- > + streamAllStringsAfter: aSubmorph on: aStream > + "Stream all strings of text in my submorphs on aStream. If aSubmorph is non-nil, begin with that container." > + > + | ok | > + ok := aSubmorph isNil. > + self allMorphsDo: [:sub | | string | > + ok ifFalse: [ok := sub == aSubmorph]. > + "and do this one too" > + ok ifTrue: [ > + (string := sub userString) > + ifNotNil: [string isString > + ifTrue: [aStream nextPut: string] > + ifFalse: [aStream nextPutAll: string]]]].! > > > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: > > From Marcel.Taeumel at hpi.de Fri May 28 17:12:35 2021 From: Marcel.Taeumel at hpi.de (Taeumel, Marcel) Date: Fri, 28 May 2021 17:12:35 +0000 Subject: [squeak-dev] The Inbox: Morphic-ct.1771.mcz In-Reply-To: References: , , Message-ID: I think that we are better off following the existing patterns to improve readability. The use of Generator is surprising and maybe difficult to understand. Keep it simple and common to the surrounding interface. Best, Marcel ________________________________ From: Thiede, Christoph Sent: Friday, May 28, 2021 7:00:14 PM To: squeak-dev at lists.squeakfoundation.org ; marcel.taeumel at hpi.de Subject: Re: The Inbox: Morphic-ct.1771.mcz Hi Marcel, yes, I also have thought about this pattern, but I actually don't see why it would be better or why Generator would be an anti-pattern. :-) Your approach requires one more selector than my approach. In general, I think that Generators are a promising way to objectify a lazily/partially evaluatable collection. Best, Christoph > Hi Christoph. > > Thanks. I think that the expected pattern is a little bit different, though. The explicit use of Generator is unfortunate but can be easily avoided. :-) > > allStringsAfter: morph do: block >   "..." > > allStringsAfter: morph >   ^ Array streamContents: [:stream | >    self allStringsAfter: morph do: [:string | >      stream nextPut: string]] > > hasStringsAfter: morph >   self allStringsAfter: morph do: [:string | ^ true]. >   ^ false > > Best, > Marcel > Am 25.05.2021 19:39:07 schrieb commits at source.squeak.org : > A new version of Morphic was added to project The Inbox: > http://source.squeak.org/inbox/Morphic-ct.1771.mcz > > ==================== Summary ==================== > > Name: Morphic-ct.1771 > Author: ct > Time: 25 May 2021, 7:38:48.072683 pm > UUID: 5a9ddaf0-a062-7047-b5b2-d2ae2da3fe15 > Ancestors: Morphic-mt.1769 > > Fixes a bottleneck when opening a yellow button menu on a morph that contains a very large number of subsub*morphs. On not-so-fast systems, this can be reproduced using: > > self systemNavigation browseAllSelect: #notNil > > On faster systems, you might need to write a small toolbuilder application to reproduce the bottleneck. I have an app with >10k list items in my image which actually blocked the image for several seconds when I yellow-clicked the window. > > Fixed the problem without duplicating the logic of #allStringsAfter: by using a generator. > > =============== Diff against Morphic-mt.1769 =============== > > Item was changed: > ----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') ----- > addYellowButtonMenuItemsTo: aMenu event: evt > "Populate aMenu with appropriate menu items for a > yellow-button (context menu) click." > aMenu defaultTarget: self. > "" > Preferences noviceMode > ifFalse: [aMenu addStayUpItem]. > "" > self addModelYellowButtonItemsTo: aMenu event: evt. > "" > Preferences generalizedYellowButtonMenu > ifFalse: [^ self]. > "" > aMenu addLine. > aMenu add: 'inspect' translated action: #inspect. > "" > aMenu addLine. > self world selectedObject == self > ifTrue: [aMenu add: 'deselect' translated action: #removeHalo] > ifFalse: [aMenu add: 'select' translated action: #addHalo]. > "" > (self isWorldMorph > or: [self mustBeBackmost > or: [self wantsToBeTopmost]]) > ifFalse: ["" > aMenu addLine. > aMenu add: 'send to back' translated action: #goBehind. > aMenu add: 'bring to front' translated action: #comeToFront. > self addEmbeddingMenuItemsTo: aMenu hand: evt hand]. > "" > self isWorldMorph > ifFalse: ["" > Smalltalk > at: #NCAAConnectorMorph > ifPresent: [:connectorClass | > aMenu addLine. > aMenu add: 'connect to' translated action: #startWiring. > aMenu addLine]. > "" > > self isFullOnScreen > ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]]. > "" > Preferences noviceMode > ifFalse: ["" > self addLayoutMenuItems: aMenu hand: evt hand. > (owner notNil > and: [owner isTextMorph]) > ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]]. > "" > self isWorldMorph > ifFalse: ["" > aMenu addLine. > self addToggleItemsToHaloMenu: aMenu]. > "" > aMenu addLine. > self isWorldMorph > ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:]. > + (Generator on: [:gen | self streamAllStringsAfter: nil on: gen]) in: [:gen | > + "optimized!! #allStringsAfter: can be slow for large subtrees." > + gen atEnd ifFalse: [ > + aMenu add: 'copy text' translated action: #clipText]]. > - (self allStringsAfter: nil) isEmpty > - ifFalse: [aMenu add: 'copy text' translated action: #clipText]. > "" > self addExportMenuItems: aMenu hand: evt hand. > "" > (Preferences noviceMode not > and: [self isWorldMorph not]) > ifTrue: ["" > aMenu addLine. > aMenu add: 'adhere to edge...' translated action: #adhereToEdge]. > "" > self addCustomMenuItems: aMenu hand: evt hand! > > Item was changed: > ----- Method: Morph>>allStringsAfter: (in category 'debug and other') ----- > + allStringsAfter: aSubmorph > - allStringsAfter: aSubmorph > - "return an OrderedCollection of strings of text in my submorphs. If aSubmorph is non-nil, begin with that container." > > + ^ OrderedCollection streamContents: [:stream | > + self streamAllStringsAfter: aSubmorph on: stream]! > - | list ok | > - list := OrderedCollection new. > - ok := aSubmorph isNil. > - self allMorphsDo: > - [:sub | | string | > - ok ifFalse: [ok := sub == aSubmorph]. "and do this one too" > - ok > - ifTrue: > - [(string := sub userString) ifNotNil: > - [string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]]. > - ^list! > > Item was added: > + ----- Method: Morph>>streamAllStringsAfter:on: (in category 'debug and other') ----- > + streamAllStringsAfter: aSubmorph on: aStream > + "Stream all strings of text in my submorphs on aStream. If aSubmorph is non-nil, begin with that container." > + > + | ok | > + ok := aSubmorph isNil. > + self allMorphsDo: [:sub | | string | > + ok ifFalse: [ok := sub == aSubmorph]. > + "and do this one too" > + ok ifTrue: [ > + (string := sub userString) > + ifNotNil: [string isString > + ifTrue: [aStream nextPut: string] > + ifFalse: [aStream nextPutAll: string]]]].! > > > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 17:54:07 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (Christoph Thiede) Date: Fri, 28 May 2021 12:54:07 -0500 (CDT) Subject: [squeak-dev] The Inbox: Morphic-ct.1718.mcz In-Reply-To: References: Message-ID: <1622224447688-0.post@n4.nabble.com> Hi Marcel, sorry, somehow I must have lost track of this discussion. :-) > What's exactly the benefit of putting this extra effort into the > implementation? Under which circumstances is that extra scrolling a > distraction? What do you want to do after "select all"? For all that we > know, it might be accidental in other systems. :-) I use this quite often in non-Squeak systems to copy/backup a text somewhere else but I want to keep reading it from the latest position. If the scrollbar jumps to another position in this case, I need to scroll back to the original position. This can, especially in longer texts, be a very tedious task ... Just stumbled again upon this. Another argument might be that neither jumping to the beginning nor jumping to the end of the text makes ultimate sense to me. > Yet, I do like "visual stability" for such interactions. Maybe we can find > a better "rule" to achieve that. Or maybe we can establish a paramter to > "selectFrom:to:". There is already "invisible selection". Maybe we can add > "stableSelection"? Or something like that. As mentioned earlier, I am very open to alternative implementations. :-) I'm not very deep in the editor's implementation, would you maybe like to propose a concrete pattern? Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 17:10:40 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Fri, 28 May 2021 19:10:40 +0200 Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination In-Reply-To: <1621447461345-0.post@n4.nabble.com> References: <1621288837863-0.post@n4.nabble.com>, <1621447461345-0.post@n4.nabble.com> Message-ID: <0c864182-c785-45ed-9420-454b2cf8ed7f@MX2018-DAG2.hpi.uni-potsdam.de> Hi Jaromir, hi Nicolas, thanks for your feedback. I think I see the conflict between useful clean-ups during termination on the one hand and way-too-clever clean-ups during abandoning an errored process on the other hand. Jaromir, your proposal to provide multiple selectors for modeling separate modes of termination sounds like a very good idea to me. But how many different modes do we actually need? So far I can count three modes: (i) run no unwind contexts (harhest possible way; currently only achievable by doing "suspendedContext privSender: nil" prior to terminating) (ii) run not-yet started unwind contexts (this is what I proposed in fix-Process-terminate.1.cs [1]) (iii) run all unwind contexts, including those that already have been started (this is the most friendly way that you implemented in #terminate recently) Can you please confirm whether this enumeration is correct and complete? What seems disputable to me are the following questions: 1. Which mode should we use in which situations? I think this debate could benefit from a few more concrete usage scenarios. I'm just collecting some here (thinking aloud): - Process Browser: We can provide multiple options in the process menu. - Debugger: I agree with you that Abandon should always run not-yet started unwind contexts but never resume halfway-executed unwind contexts. So this maps to to mode (ii) from above. - Skimming through most senders of #terminate in the image, they often orchestrate helper processes, deal with unhandled errors or timeouts, or do similar stuff - usually they should be very fine with the friendly version of #terminate, i.e. mode (iii) from above. I think. - Regarding option (1), I think you would need it extremely seldom but maybe in situations like when your stack contains a loop, your unwind contexts will cause a recursion/new error, or you deliberately want to prevent any unwind context from running. No objections against adding a small but decent button for this in the debugger. :-) Would you agree with these behaviors? Maybe you can add further examples to the list? 2. How should we name them? Direct proposal: (i) #kill and (iii) #terminate. After looking up the original behavior of #terminate in Squeak 5.3, I think it would be consistent to resume all halfway-executed unwind contexts in this method. So yes, I also withdraw my criticism about #testNestedUnwind. :-) But I don't have any good idea for version (ii) yet. Call it #abandon like in the debugger? Then again, #abandon is rather a verb from the Morphic language. Further possible vocables (according to my synonym thesaurus) include #end, #stop, #finish, #unwind, #abort, #exit. Please help... :-) Best, Christoph [1] http://forum.world.st/template/NamlServlet.jtp?macro=print_post&node=5129805 From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 18:54:51 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Fri, 28 May 2021 20:54:51 +0200 Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: <1621599766501-0.post@n4.nabble.com> References: <1621087561864-0.post@n4.nabble.com> <1621113654445-0.post@n4.nabble.com> , <1621599766501-0.post@n4.nabble.com> Message-ID: <8d483880-3b69-4f7a-be0d-c6824d6b965a@MX2018-DAG2.hpi.uni-potsdam.de> Hi Jaromir, preamble: Yes, I agree that we need something different than the current #terminate for the debugger's Abandon - see [1]. Correct me if I am wrong, but I think further termination details do not need to be discussed in this thread but only in [1]. :-) > This [proposal], I feel, introduces an incorrect semantics here: the real sender of the #cannotReturn: was the VM that tried to execute a non-local return and failed. For lack of other options (I guess) the VM set the #ensure: context as a sender of #cannotReturn: - my guess the main purpose of this link is to keep the stack chain available for unwind - but not for resuming the execution - so this is my objection. Thanks for the explanation. This is where our mental models appear to clash: I am not thinking of the VM as an instance that can be the sender of a method - the VM always resists on a meta-level apart from the actual code or stack trace. A sender has to be a context, and a context has to have things such a method, a pc, and a receiver - but what would these properties be for the VM itself? I would rather compare #cannotReturn: to #doesNotUnderstand:, which is a substitute for a different send/instruction in the causing method and validly has that causing method as a sender. You could also think of "^ foo" as a shortcut for "thisContext (home) return: foo" to make sense of this. > Proceeding after BlockCannotReturn actually means: Proceed as if no non-local return was ever there. Yes ... > This doesn't seem right to me but maybe there could be good a reason to do this in debugging, I don't know. ... my point here is: Proceeding from an error almost always doesn't seem "right". :-) It is always a decision by the debugging programmer to override the default control flow and switch to the "next plausible alternative control flow", i.e., resume as if the error would have never been raised. Applied to the attempt to return from a method, for me, this means to ignore the return (thinking of it in message sends: to ignore the "thisContext (home) return"). Yeah, and if there is no further statement after that return, my best understanding of the user's intention to "proceed" would be to return to the place from where the block has been invoked ... > I'm sending an alternative proposal to solve the infinite recursion of BlockCannotReturn Hm, in this example, you moved the relevant logic into Process >> #complete:to:. This means that BlockCannotReturn(Exception) >> #resumeUnchecked: will not have the same effect, won't it? :-( Also, can you convince me why you would need some extra state in the exception for this? Argh, here is another example which does not yet match my expectations: sender := thisContext swapSender: nil. true ifTrue: [^ 1]. "Proceed the BlockCannotReturn" thisContext privSender: sender. ^ 2 I think this should eventually answer 2. Apparently, the VM already has reset the pc in this example so we are helpless here. ^^ Best, Christoph [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-tp5129800p5130110.html From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 18:19:04 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Fri, 28 May 2021 20:19:04 +0200 Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1621869528589-0.post@n4.nabble.com> References: <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> <1621445932092-0.post@n4.nabble.com>, <1621869528589-0.post@n4.nabble.com> Message-ID: Hi Jaromir, you convinced me with regard to the behavior of #terminate as well as the current definition of #testNestedUnwind - see [1]. :-) I still think my counter-proposal is relevant, we just should put it into a method with a different name. Debugger's Abandon should then use this method instead of #terminate. But please let's discuss in [1], it's already hard enough to keep an overview. :D Regarding to your proposal: Please see my comments in [2] about your proposed change to BlockCannotReturn. > > Instead of reinventing the unwinding wheel in Process, I reused the existing logic from Context which is important deduplication. > Well, actually I didn't reinvent the unwind pattern but intentionally reused it with as few changes as possible - I think it improves readability because people easily recognize this pattern from #resume:, #resume:through:, #unwindTo and even the previous #terminate used the exact same pattern for an active process termination. Besides, using the same pattern for achieving a similar goal feels "safer" to me. A pattern is good, but reusing the same code is even better. :-) I still see some signification duplication between #runUntilErrorOrReturnFrom: and #runUnwindUntilErrorOrReturnFrom: as well as between Process >> #terminate and Context >> #unwindTo:. But Kernel-jar.1411 already is a good step into the right direction as far as I can tell. :-) What remains unacceptable or dangerous to me are your hard-coded exceptions in Process >> #complete:to:. If this is crucial to prevent akwards infinite recursions, we might not be immune against similar incidents for other kinds of recursion as well. Object >> #at:, for example, is no better than Object >> #doesNotUnderstand:. Actually, any exception or exception handler might produce a similar behavior. Could you provide a few concrete examples where this check is needed? Maybe we can find a more holistic solution to this issue. > Again, I wanted to make as few changes as possible; but agreed absolutely :) That is also a very reasonable goal which I had to learn myself the hard way. :) Keep going! :-) Best, Christoph [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-tp5129800p5130110.html [2] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-tp5129706p5130114.html From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 22:05:43 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Sat, 29 May 2021 00:05:43 +0200 Subject: [squeak-dev] The Inbox: KernelTests-jar.406.mcz In-Reply-To: References: Message-ID: <35301e9f-362b-403a-adbc-a2b145a39593@MX2018-DAG2.hpi.uni-potsdam.de> Hi Jaromir, thanks for writing these tests! Just a few comments here: - #testTerminateInEnsure uses underscore assignments. This is a deprecated syntax and apparently, in current Trunk images even disabled by default. Without turning on my #allowUnderscoreAsAssignment preference, I cannot even run the test in my image. Could you please convert this to modern `:=` assignments? - Also, there is no guarantee that in #testTerminateInEnsure, process will not have completed earlier, is it? This totally depends on the speed & implementation of the VM. We don't want this test to fail when running on a NSA machine or on your coffee machine in 2050, do we? ;P Did you consider using semaphores instead? :-) - #testTerminateInTerminate is very fancy. :D Best, Christoph From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 22:16:14 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Sat, 29 May 2021 00:16:14 +0200 Subject: [squeak-dev] The Inbox: ToolsTests-jar.105.mcz In-Reply-To: References: Message-ID: <16f58705-deae-44c9-94f9-4633cac6dc55@MX2018-DAG2.hpi.uni-potsdam.de> Apart from their homogenous test names (ideally, one could grasp the idea of a test just from its name), these tests look good to describe the current situation. :-) Nevertheless, it might be wise to defer them until we have decided on whether #abandon should really use #terminate, what do you think? See [1]. Best, Christoph [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html#a5130110 From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 22:51:13 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Sat, 29 May 2021 00:51:13 +0200 Subject: [squeak-dev] Tackling Context>>#runUntilErrorReturnFrom: (was: BUG/REGRESSION while debugging Generator >> #nextPut:) In-Reply-To: <1621273090858-0.post@n4.nabble.com> References: <9ed2db8e40684297b83d98e311e76a4b@student.hpi.uni-potsdam.de> <25a67367ce4f4ee68d0509659cb10c72@student.hpi.uni-potsdam.de> <1615231296272-0.post@n4.nabble.com> <1615566932862-0.post@n4.nabble.com> <1620851547306-0.post@n4.nabble.com> <1621102291419-0.post@n4.nabble.com>, <1621273090858-0.post@n4.nabble.com> Message-ID: <338376a1-b6bc-42a5-98ef-4770bbb225ae@MX2018-DAG2.hpi.uni-potsdam.de> Version 8 of the changeset reverts the change to #runUntilErrorOrReturnFrom: definitely. Thanks, Jaromir ... Best, Christoph ["runUntilErrorOrReturnFrom.8.cs"] -------------- next part -------------- A non-text attachment was scrubbed... Name: runUntilErrorOrReturnFrom.8.cs Type: application/octet-stream Size: 4115 bytes Desc: not available URL: From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 22:54:10 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Sat, 29 May 2021 00:54:10 +0200 Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <1621972319412-0.post@n4.nabble.com> References: <1620845299641-0.post@n4.nabble.com> , <1621972319412-0.post@n4.nabble.com> Message-ID: <683cf64d-952c-4c37-9f45-7392ff2aa77b@MX2018-DAG2.hpi.uni-potsdam.de> Hi Jaromir, > > \2: This was indeed a slip because I forgot to update the image. I have moved my patch to #findNextHandlerContext - it makes the method robust against bottom-contexts that do not have a sender (i.e., sender is nil). > > The changeset still seems to have the old version of #runUntilErrorOrReturnFrom: and #nextHandlerContext nixing Nicolas's changes made in the meantime... Version 8 removes roerf finally. :-) But I could not find any trace of #nextHandlerContext in the current changeset, did you maybe forget to revert the previous version before loading v7? > What would you think about this approach: because #return:from: supplies the first unwind context for #aboutToReturn:through: prematurely, how about to supply nil instead of the first unwind context and let #resume:through: find the first unwind context at precisely the right time? Correct me if I'm wrong, but this only would move the problem again, wouldn't it? If you press over too late, we would have the same problem again? I'd still prefer a holistic approach such as my #informDebuggerAboutContextSwitchTo: proposal. Or did miss anything different with your proposal? :-) Best, Christoph From christoph.thiede at student.hpi.uni-potsdam.de Fri May 28 23:02:27 2021 From: christoph.thiede at student.hpi.uni-potsdam.de (christoph.thiede at student.hpi.uni-potsdam.de) Date: Sat, 29 May 2021 01:02:27 +0200 Subject: [squeak-dev] [Sounds] How to turn off reverb In-Reply-To: References: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de>, Message-ID: <22fe19c9-3cec-494a-a881-8178aa81f6d8@MX2018-DAG2.hpi.uni-potsdam.de> > SoundPlayer stopReverb Fantastic! This was what I was searching for. > no reverb would make some FMSounds end badly): Hm ... I just haved tried this out at the example of brass: FMSound brass1 play And I have to tell that, both with default and without reverb, I can hear the abrupt end of the sound very clearly. IMHO it does not make a large difference, except for the fact that a pure tone should not have any reverb by definition. I am not an expert in sounds at all, but couldn't it be a more elegant solution to adjust the envelopes of the problematic sounds instead and to extend their release phase? I changed #brass1 like this: | snd p env | snd := FMSound new modulation: 0 ratio: 1. p := OrderedCollection new. - p add: 0 at 0.0; add: 30 at 0.8; add: 90 at 1.0; add: 120 at 0.9; add: 220 at 0.7; add: 320 at 0.9; add: 360 at 0.0. + p add: 0 at 0.0; add: 30 at 0.8; add: 90 at 1.0; add: 120 at 0.9; add: 220 at 0.7; add: 320 at 0.9; add: 440 at 0.0. snd addEnvelope: (VolumeEnvelope points: p loopStart: 4 loopEnd: 6). p := OrderedCollection new. p add: 0 at 0.5; add: 60 at 1.0; add: 120 at 0.8; add: 220 at 0.65; add: 320 at 0.8; add: 360 at 0.0. env := Envelope points: p loopStart: 3 loopEnd: 5. env target: snd; updateSelector: #modulation:; scale: 5.0. snd addEnvelope: env. (snd setPitch: 220.0 dur: 1.0 loudness: 0.5) play The only difference is that I moved the last envelope point 80 ms to the right. I can't hear any "plop" now any longer. My proposal is to turn off reverb in the SoundPlayer by default and to adjust the most problematic FMSounds manually instead. What do you think? :-) Best, Christoph From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 28 23:21:57 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 28 May 2021 23:21:57 +0000 Subject: [squeak-dev] The Trunk: Kernel-eem.1366.mcz In-Reply-To: References: <24f1800104c24bce9c173fb296a13f0b@student.hpi.uni-potsdam.de> <,> <1621183259431-0.post@n4.nabble.com> <,> <82645ec77f6945cd9f0573502173cac6@student.hpi.uni-potsdam.de> <,> <64c52ebc75c540d292c96ff0dee2118d@student.hpi.uni-potsdam.de>, Message-ID: <0a747c9d2c424e818e99d69540891b56@student.hpi.uni-potsdam.de> Hi Marcel, I think it is two completely different debates whether to use #isArray in the simulator, and whether to use it in general. In the simulator, the contract is pretty simple: You must not send any messages to the object under simulation because you must not make any assumptions about how the object will treat these messages. This #isArray in #isPrimFailToken: appears probably the single violation of that rule, and it makes the simulator unreliable as we have seen from multiple examples. Do you get my point? :-) Apart from that, the cleanness of ProtoObject is another ongoing story - which I also look forward to tackling later - I hope we can move on in this direction before the next release. But I do not think that we should mix both debates. Or am I missing your point? Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Mittwoch, 19. Mai 2021 18:19:41 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Well, that's another argument for my proposed fix, isn't it? :-) Only if you would make a case for removing #isArray from the entire image. I suppose. Maybe #isArray is like a trade-off. You do not want to have to compare classes, but it might not be a good idea to implement #isArray in your domain object. Hmm... To improve anything in this regard, I would suggest to widen our perspective on this issue. A list of the current challenges around ProtoObject (maybe in combination with object-as-method?) might be helpful to make informed decisions. This isolated discussion around "== Array" vs. "isArray" doesn't feel right. Best, Marcel Am 17.05.2021 13:08:07 schrieb Thiede, Christoph : Well, that's another argument for my proposed fix, isn't it? :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 12:54:50 An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Given any object of a class that reimplements #isArray in an erroneous way Given my recent slip in the FFI package, I have the feeling that #isArray has a really specific meaning for the class layout. No one should claim to also be an Array. :-D I mean, not even RawBitsArray does it. There is something going on. :-) Best, Marcel Am 17.05.2021 12:00:33 schrieb Thiede, Christoph : Hi Marcel, > Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Of course, here are you: Debug it: ObjectTracer on: Morph new In the trunk, this spawns an embarrassing number of additional debuggers while debugging the expression. With my proposed fix, not a single additional debugger is opened before you actually send a message to the morph. Here is another example. Given any object of a class that reimplements #isArray in an erroneous way, this will break the simulator, too: Object newSubclass compile: 'isArray ^self notYetImplemented'; new "step through this" > My impression was that even the BasicInspector struggled to deal with proxies. I think I have fixed this issue via Tools-ct.1056/ToolsTests-ct.105. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Taeumel, Marcel Gesendet: Montag, 17. Mai 2021 08:08 Uhr An: squeak-dev Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz > Are you thinking about proxies (usually implemented as ProtoObject)? To quote myself and expand the comment: Is this the only issue left that we are having with debugging/simulating ProtoObject? My impression was that even the BasicInspector struggled to deal with proxies. Well, it got better due to the mirror primitives in Context. Maybe an actual use case would help. Something bigger than "ProtoObject new isNil". Best, Marcel Am 17.05.2021 07:54:59 schrieb Marcel Taeumel : Hi Christoph. > The simulator should not stumble upon any objects that do not implement #isArray > in a conventional way. #isArray is implemented in Object. So, all objects can answer to that. Where do you see a problem? Are you thinking about proxies (usually implemented as ProtoObject)? Best, Marcel Am 16.05.2021 19:07:34 schrieb Thiede, Christoph : Sorry for the confusion. Kernel-ct.1369 has been moved to treated with all justification. I just uploaded Kernel-ct.1407 instead which fixes the mentioned problem. Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Thiede, Christoph Gesendet: Sonntag, 16. Mai 2021 18:40:59 An: squeak-dev at lists.squeakfoundation.org Betreff: Re: [squeak-dev] The Trunk: Kernel-eem.1366.mcz Hi all, in my humble opinion, this is still broken as of today in the Trunk. :-) The simulator should not stumble upon any objects that do not implement #isArray in a conventional way. The following should be debuggable, but at the moment, you get a DNU error from #isPrimFailToken: if you step through the expression: ProtoObject new isNil Efficiency is important, but IMHO correctness is even more important. Thus I think Kernel-ct.1369 is still relevant for the trunk. :-) Best, Christoph ----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Fri May 28 23:25:09 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Fri, 28 May 2021 23:25:09 +0000 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> , Message-ID: > In other words, your shared pool should indeed be a class. It doesn’t matter for using it, but it does matter for loading it reliably. Hmm, I am pretty sure that this would confuse Squot (which is also based on Monticello) ... For now, I have defined the shared pool in question as a Smalltalk global in my baseline preload script. Still, I don't think this solution is optimal. But I'll note it down for later. :-) Best, Christoph ________________________________ Von: Squeak-dev im Auftrag von Vanessa Freudenberg Gesendet: Dienstag, 18. Mai 2021 19:02:37 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] Unable to load class with pool dictionary using Monticello I’m certain we had a good reason to turn loadable shared pools into classes. I think (but I’m not entirely sure) it had to do with ensuring they had been properly initialized before executing code that depended on the constants declared in that pool. Class initialization of a designated class was TSTTCPW. In other words, your shared pool should indeed be a class. It doesn’t matter for using it, but it does matter for loading it reliably. I admit I could be misremembering, it’s been quite a while. –Vanessa– On Tue, May 18, 2021 at 05:42 Marcel Taeumel > wrote: Hi Christoph, > This error message does not make sense to me since MyPool is not a class > but a pool dictionary. You can use classes and global dictionaries as a shared pool. From the system's perspective, it does not make any difference as long as #bindingOf: etc. is implemented. See class-side of SharedPool class. If you use a class as a shared pool in another class, the class variables will be shared. :-) *** Yet, I think you found a bug. Maybe this was the reason why "FFI-Pools" exists in the first place. So that it can be loaded before "FFI-Kernel" xD Best, Marcel Am 18.05.2021 13:21:34 schrieb Thiede, Christoph >: Hi all, while loading a class (MyClass) with an attached pool dictionary (MyPool) today using Monticello, I encountered an error from MCPackageLoader which states: Warning: This package depends on the following classes: MyPool This error message does not make sense to me since MyPool is not a class but a pool dictionary. But in MCClassDefinition >> #requirements, all #poolDictionaries are explicitly added to the list of required items. If I exclude them from this list, I get a warning "The pool dictionary MyPool does not exist. Do you want it automatically created?" later from Class >> #sharing:. Is this a bug? I also tried to manually add the pool dictionary initialization (Smalltalk at: #MyPool put: Dictionary new) into the preamble of the package, but this preamble is also evaluated too late (i.e., not before the dependency warning is raised. Also, this feels a bit too redundant to me. Do we need a new subclass of MCDefinition to create pool dictionaries automatically? Or could we just remove the confirmation dialog in Class >> #sharing: so that new pools will automatically be created, especially in non-interactive CI contexts? Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim at rowledge.org Fri May 28 23:39:57 2021 From: tim at rowledge.org (tim Rowledge) Date: Fri, 28 May 2021 16:39:57 -0700 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Message-ID: <195CF13C-4CA6-49CB-9F06-495DDD1939C2@rowledge.org> I refer the honourable gentleman to the answer I gave on May 18 at 12:15pm PST. > On 2021-05-28, at 4:25 PM, Thiede, Christoph wrote: > > > In other words, your shared pool should indeed be a class. It doesn’t matter for using it, but it does matter for loading it reliably. > > > Hmm, I am pretty sure that this would confuse Squot (which is also based on Monticello) ... > > For now, I have defined the shared pool in question as a Smalltalk global in my baseline preload script. Still, I don't think this solution is optimal. But I'll note it down for later. :-) > > Best, > Christoph > Von: Squeak-dev im Auftrag von Vanessa Freudenberg > Gesendet: Dienstag, 18. Mai 2021 19:02:37 > An: The general-purpose Squeak developers list > Betreff: Re: [squeak-dev] Unable to load class with pool dictionary using Monticello > > I’m certain we had a good reason to turn loadable shared pools into classes. I think (but I’m not entirely sure) it had to do with ensuring they had been properly initialized before executing code that depended on the constants declared in that pool. Class initialization of a designated class was TSTTCPW. > > In other words, your shared pool should indeed be a class. It doesn’t matter for using it, but it does matter for loading it reliably. > > I admit I could be misremembering, it’s been quite a while. > > –Vanessa– > > > On Tue, May 18, 2021 at 05:42 Marcel Taeumel wrote: > Hi Christoph, > > > This error message does not make sense to me since MyPool is not a class > but a pool dictionary. > > You can use classes and global dictionaries as a shared pool. From the system's perspective, it does not make any difference as long as #bindingOf: etc. is implemented. See class-side of SharedPool class. If you use a class as a shared pool in another class, the class variables will be shared. :-) > > *** > > Yet, I think you found a bug. Maybe this was the reason why "FFI-Pools" exists in the first place. So that it can be loaded before "FFI-Kernel" xD > > Best, > Marcel >> Am 18.05.2021 13:21:34 schrieb Thiede, Christoph : >> Hi all, >> >> while loading a class (MyClass) with an attached pool dictionary (MyPool) today using Monticello, I encountered an error from MCPackageLoader which states: >> >> >> Warning: This package depends on the following classes: >> >> >> MyPool >> >> >> >> This error message does not make sense to me since MyPool is not a class but a pool dictionary. But in MCClassDefinition >> #requirements, all #poolDictionaries are explicitly added to the list of required items. If I exclude them from this list, I get a warning "The pool dictionary MyPool does not exist. Do you want it automatically created?" later from Class >> #sharing:. Is this a bug? >> >> I also tried to manually add the pool dictionary initialization (Smalltalk at: #MyPool put: Dictionary new) into the preamble of the package, but this preamble is also evaluated too late (i.e., not before the dependency warning is raised. Also, this feels a bit too redundant to me. >> >> Do we need a new subclass of MCDefinition to create pool dictionaries automatically? Or could we just remove the confirmation dialog in Class >> #sharing: so that new pools will automatically be created, especially in non-interactive CI contexts? >> >> Best, >> Christoph >> > > tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Calm down -- it's only ones and zeros. From asqueaker at gmail.com Fri May 28 23:48:17 2021 From: asqueaker at gmail.com (Chris Muller) Date: Fri, 28 May 2021 18:48:17 -0500 Subject: [squeak-dev] origin of MCVersionName (was: The Inbox: Morphic-ct.1586.mcz) Message-ID: Hi Marcel, > ... MCVersionName?! A domain-specific subclass of String? Well, I consider this design rather unfortunate. In such a case, on might be better of to favor composition over inheritance. That's an anti-pattern. Please do not do that in your projects. :-) ... I suspect an optimization for a database ... not sure. Chris? I introduced MCVersionName in 2011 as part of the work that unified the MCRepository hierarchy. At that time, external callers had become completely dependent on the only-used subclass, MCFileBasedRepository. So the MCVersionName design was partly for maintaining forward-compatibility for older versions within the MC legacy, but also because it's the soundest and simplest design. The importance of capturing explicit structure in "names" that have them (e.g., filenames, version names) is underrated. MC should have harvested the de facto structure into its code in the first place, but even then, before the legacy, I don't think composition would've been the optimal choice. The requirement calls for a pure scalar value that can be serialized to and from a human-readable filename, but with API access to its structure which the MCTools needed to get off the ground (out of the ditch). There are a lot of names. Composition would essentially require an unnecessarily heavy "ValueHolder" that would either need to be serialized or dynamically created all the time, disrupting the effieciency needed out of the (pre-Spur) tools of that time. Maybe some would argue that a bunch of extension methods on String is better, but I see domain-specific subclasses as merely a rarity, and not an anti-pattern. Best, Chris From commits at source.squeak.org Thu May 27 07:39:42 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:39:42 0000 Subject: [squeak-dev] FFI: FFI-Unix-mt.6.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Unix to project FFI: http://source.squeak.org/FFI/FFI-Unix-mt.6.mcz ==================== Summary ==================== Name: FFI-Unix-mt.6 Author: mt Time: 27 May 2021, 9:39:36.243843 am UUID: fcaa7554-f959-dc45-a8d6-36edaec594f9 Ancestors: FFI-Unix-mt.5 Empty commit. Package superseded by "FFI-Libraries" =============== Diff against FFI-Unix-mt.5 =============== Item was removed: - SystemOrganization addCategory: #'FFI-Unix-Examples'! Item was removed: - ExternalStructure subclass: #X11Display - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Unix-Examples'! Item was removed: - ----- Method: X11Display class>>XOpenDisplay: (in category 'instance creation') ----- - XOpenDisplay: displayName - "X11Display XOpenDisplay: nil" - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display class>>coloredEllipses (in category 'examples') ----- - coloredEllipses - "X11Display coloredEllipses" - | display window gc colors rnd w h pt1 pt2 r | - display := X11Display XOpenDisplay: nil. - window := display ourWindow. - gc := X11GC on: window. - colors := Color colorNames collect:[:n| (Color perform: n) pixelWordForDepth: 32]. - rnd := Random new. - w := Display width. - h := Display height. - [Sensor anyButtonPressed] whileFalse:[ - pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - r := Rectangle encompassing: (Array with: pt1 with: pt2). - gc foreground: colors atRandom. - gc fillOval: r. - gc foreground: 0. - gc drawOval: r. - display sync. - ]. - gc free. - display closeDisplay. - Display forceToScreen.! Item was removed: - ----- Method: X11Display class>>coloredRectangles (in category 'examples') ----- - coloredRectangles - "X11Display coloredRectangles" - | display window gc colors rnd w h pt1 pt2 r nPixels time n | - display := X11Display XOpenDisplay: nil. - window := display ourWindow. - gc := X11GC on: window. - colors := Color colorNames collect:[:cn| (Color perform: cn) pixelWordForDepth: 32]. - rnd := Random new. - w := Display width. - h := Display height. - n := 0. - nPixels := 0. - time := Time millisecondClockValue. - [Sensor anyButtonPressed] whileFalse:[ - pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - r := Rectangle encompassing: (Array with: pt1 with: pt2). - gc foreground: colors atRandom. - gc fillRectangle: r. - gc foreground: 0. - gc drawRectangle: r. - display sync. - n := n + 1. - nPixels := nPixels + ((r right - r left) * (r bottom - r top)). - (n \\ 100) = 0 ifTrue:[ - 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) - asStringWithCommas displayAt: 0 at 0]. - ]. - gc free. - display closeDisplay. - Display forceToScreen.! Item was removed: - ----- Method: X11Display class>>fields (in category 'field definition') ----- - fields - "X11Display defineFields" - "Note: The structure of Display is internal and only pointers to X11Display are used" - ^#()! Item was removed: - ----- Method: X11Display class>>new (in category 'instance creation') ----- - new - ^ self on: nil! Item was removed: - ----- Method: X11Display class>>on: (in category 'instance creation') ----- - on: aStringOrNil - ^ self XOpenDisplay: aStringOrNil! Item was removed: - ----- Method: X11Display class>>x11Draw (in category 'examples') ----- - x11Draw - "X11Display x11Draw" - | display window gc nextPt lastPt ptr | - display := X11Display XOpenDisplay: nil. - window = display ourWindow. - gc := X11GC on: window. - gc foreground: 0. - lastPt := nil. - [ptr := display queryPointer: window. "{root. child. root pos. win pos. mask}" - ptr last anyMask: 256] whileFalse:[ - nextPt := ptr fourth. - nextPt = lastPt ifFalse:[ - lastPt ifNotNil: [ - gc drawLineFrom: lastPt to: nextPt. - display sync]. - lastPt := nextPt]. - ]. - gc free. - display closeDisplay. - Display forceToScreen.! Item was removed: - ----- Method: X11Display>>None (in category 'xlib calls') ----- - None - ^ 0! Item was removed: - ----- Method: X11Display>>XCloseDisplay: (in category 'xlib calls') ----- - XCloseDisplay: aDisplay - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XDisplayString: (in category 'xlib calls') ----- - XDisplayString: aDisplay - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XFlush: (in category 'xlib calls') ----- - XFlush: xDisplay - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XGetInputFocus:with:with: (in category 'xlib calls') ----- - XGetInputFocus: display with: focus with: revert - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XQueryPointer:window:returnRoot:child:rootX:rootY:winX:winY:mask: (in category 'xlib calls') ----- - XQueryPointer: display window: w returnRoot: root child: child rootX: rootX rootY: rootY winX: winX winY: winY mask: mask - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XSync: (in category 'xlib calls') ----- - XSync: xDisplay - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>XWarpPointer:sourceWindow:destWindow:sourceX:sourceY:sourceWidth:sourceHeight:destX:destY: (in category 'xlib calls') ----- - XWarpPointer: display sourceWindow: srcWindowID destWindow: destWindowID sourceX: srcX sourceY: srcY sourceWidth: srcWidth sourceHeight: srcHeight destX: destX destY: destY - - ^self externalCallFailed! Item was removed: - ----- Method: X11Display>>closeDisplay (in category 'initialize-release') ----- - closeDisplay - handle == nil ifFalse:[ - self XCloseDisplay: self. - handle := nil].! Item was removed: - ----- Method: X11Display>>displayString (in category 'accessing') ----- - displayString - ^self XDisplayString: self! Item was removed: - ----- Method: X11Display>>flush (in category 'initialize-release') ----- - flush - self XFlush: self! Item was removed: - ----- Method: X11Display>>getInputFocus (in category 'accessing') ----- - getInputFocus - | focus revert | - focus := WordArray new: 1. - revert := WordArray new: 1. - self XGetInputFocus: self with: focus with: revert. - ^ X11Window new xid: focus first! Item was removed: - ----- Method: X11Display>>ourWindow (in category 'accessing') ----- - ourWindow - "Guess the window to draw on." - | window ptr child | - window := self getInputFocus. - ptr := self queryPointer: window. "{root. child. root pos. win pos. mask}" - child := ptr second. - child xid = 0 ifTrue: [^ window]. - ^ child! Item was removed: - ----- Method: X11Display>>queryPointer: (in category 'accessing') ----- - queryPointer: aX11Window - | root child rootX rootY winX winY mask | - root := WordArray new: 1. - child := WordArray new: 1. - rootX := WordArray new: 1. - rootY := WordArray new: 1. - winX := WordArray new: 1. - winY := WordArray new: 1. - mask := WordArray new: 1. - self XQueryPointer: self window: aX11Window xid returnRoot: root child: child - rootX: rootX rootY: rootY winX: winX winY: winY mask: mask. - ^{ - X11Window new xid: root first. - X11Window new xid: child first. - rootX first @ rootY first. - winX first @ winY first. - mask first}! Item was removed: - ----- Method: X11Display>>sync (in category 'initialize-release') ----- - sync - ^self XSync: self! Item was removed: - ----- Method: X11Display>>warpPointerBy: (in category 'accessing') ----- - warpPointerBy: aPoint - "Moves the mouse pointer from its current location to its current location + aPoint. Generates a mouse move event if the squeak window is active" - - ^ self XWarpPointer: self - sourceWindow: self None - destWindow: self None - sourceX: 0 sourceY: 0 sourceWidth: 0 sourceHeight: 0 - destX: aPoint x destY: aPoint y! Item was removed: - ----- Method: X11Display>>warpPointerFrom:in:To:in: (in category 'accessing') ----- - warpPointerFrom: aRectangle in: sourceWindow To: aPoint in: destWindow - "Moves the mouse pointer to aPoint relative to the top-left corner of a window" - - ^ self XWarpPointer: self - sourceWindow: sourceWindow xid - destWindow: destWindow xid - sourceX: aRectangle left sourceY: aRectangle top - sourceWidth: aRectangle width sourceHeight: aRectangle height - destX: aPoint x destY: aPoint y! Item was removed: - ----- Method: X11Display>>warpPointerTo:in: (in category 'accessing') ----- - warpPointerTo: aPoint in: aWindow - "Moves the mouse pointer to aPoint relative to the top-left corner of a window" - - ^ self XWarpPointer: self - sourceWindow: self None - destWindow: aWindow xid - sourceX: 0 sourceY: 0 sourceWidth: 0 sourceHeight: 0 - destX: aPoint x destY: aPoint y! Item was removed: - X11ID subclass: #X11Drawable - instanceVariableNames: 'display xid' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Unix-Examples'! Item was removed: - ----- Method: X11Drawable class>>display: (in category 'instance creation') ----- - display: aX11Display - ^ self new display: aX11Display! Item was removed: - ----- Method: X11Drawable>>display (in category 'accessing') ----- - display - ^display! Item was removed: - ----- Method: X11Drawable>>display: (in category 'accessing') ----- - display: aDisplay - display := aDisplay! Item was removed: - ----- Method: X11Drawable>>printOn: (in category 'printing') ----- - printOn: aStream - aStream - nextPutAll: self class name; - nextPut: $(; - nextPutAll: self xid printStringHex; - nextPut: $) ! Item was removed: - ----- Method: X11Drawable>>xid (in category 'accessing') ----- - xid - ^ xid! Item was removed: - ----- Method: X11Drawable>>xid: (in category 'accessing') ----- - xid: anUnsignedInteger - xid := anUnsignedInteger! Item was removed: - ExternalStructure subclass: #X11GC - instanceVariableNames: 'drawable' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Unix-Examples'! Item was removed: - ----- Method: X11GC class>>XCreateGC:with:with:with: (in category 'xlib calls') ----- - XCreateGC: xDisplay with: aDrawable with: valueMask with: values - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC class>>fields (in category 'field definition') ----- - fields - "X11GC defineFields" - ^#( nil 'void*' )! Item was removed: - ----- Method: X11GC class>>on: (in category 'instance creation') ----- - on: aDrawable - | xgc | - xgc := self XCreateGC: aDrawable display with: aDrawable with: 0 with: nil. - xgc drawable: aDrawable. - ^xgc! Item was removed: - ----- Method: X11GC>>XDrawArc:with:with:with:with:with:with:with:with: (in category 'xlib calls') ----- - XDrawArc: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h with: a1 with: a2 - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XDrawLine:with:with:with:with:with:with: (in category 'xlib calls') ----- - XDrawLine: xDisplay with: aDrawable with: xGC with: x0 with: y0 with: x1 with: y1 - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XDrawRectangle:with:with:with:with:with:with: (in category 'xlib calls') ----- - XDrawRectangle: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XFillArc:with:with:with:with:with:with:with:with: (in category 'xlib calls') ----- - XFillArc: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h with: a1 with: a2 - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XFillRectangle:with:with:with:with:with:with: (in category 'xlib calls') ----- - XFillRectangle: xDisplay with: xDrawable with: xGC with: x with: y with: w with: h - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XFreeGC:with: (in category 'xlib calls') ----- - XFreeGC: xDisplay with: xGC - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XSetBackground:with:with: (in category 'xlib calls') ----- - XSetBackground: xDisplay with: xGC with: bg - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>XSetForeground:with:with: (in category 'xlib calls') ----- - XSetForeground: xDisplay with: xGC with: fg - - ^self externalCallFailed! Item was removed: - ----- Method: X11GC>>background: (in category 'drawing') ----- - background: pixelValue - self XSetBackground: self display with: self with: pixelValue! Item was removed: - ----- Method: X11GC>>display (in category 'accessing') ----- - display - ^drawable display! Item was removed: - ----- Method: X11GC>>drawLineFrom:to: (in category 'drawing') ----- - drawLineFrom: pt1 to: pt2 - self XDrawLine: self display - with: drawable - with: self - with: pt1 x - with: pt1 y - with: pt2 x - with: pt2 y! Item was removed: - ----- Method: X11GC>>drawOval: (in category 'drawing') ----- - drawOval: aRectangle - self - XDrawArc: self display - with: drawable - with: self - with: aRectangle left - with: aRectangle top - with: aRectangle width - with: aRectangle height - with: 0 - with: 64*360! Item was removed: - ----- Method: X11GC>>drawRectangle: (in category 'drawing') ----- - drawRectangle: aRectangle - self - XDrawRectangle: self display - with: drawable - with: self - with: aRectangle left - with: aRectangle top - with: aRectangle width - with: aRectangle height! Item was removed: - ----- Method: X11GC>>drawable (in category 'accessing') ----- - drawable - ^drawable! Item was removed: - ----- Method: X11GC>>drawable: (in category 'accessing') ----- - drawable: aDrawable - drawable := aDrawable! Item was removed: - ----- Method: X11GC>>fillOval: (in category 'drawing') ----- - fillOval: aRectangle - self - XFillArc: self display - with: drawable - with: self - with: aRectangle left - with: aRectangle top - with: aRectangle width - with: aRectangle height - with: 0 - with: 64*360! Item was removed: - ----- Method: X11GC>>fillRectangle: (in category 'drawing') ----- - fillRectangle: aRectangle - self - XFillRectangle: self display - with: drawable - with: self - with: aRectangle left - with: aRectangle top - with: aRectangle width - with: aRectangle height! Item was removed: - ----- Method: X11GC>>foreground: (in category 'drawing') ----- - foreground: pixelValue - self XSetForeground: self display with: self with: pixelValue - ! Item was removed: - ----- Method: X11GC>>free (in category 'initialize-release') ----- - free - handle == nil ifFalse:[ - self XFreeGC: self display with: self. - handle := nil. - ].! Item was removed: - ExternalTypeAlias subclass: #X11ID - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Unix-Examples'! - - !X11ID commentStamp: 'mt 6/4/2020 19:16' prior: 0! - I am an opaque handle in X11.! Item was removed: - ----- Method: X11ID class>>originalTypeName (in category 'field definition') ----- - originalTypeName - " - self defineFields - " - ^ 'size_t' "or always uint32_t ??"! Item was removed: - X11ID subclass: #X11Window - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Unix-Examples'! From commits at source.squeak.org Wed May 26 07:46:37 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Wed, 26 May 2021 07:46:37 0000 Subject: [squeak-dev] FFI: FFI-Examples-mt.8.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Examples to project FFI: http://source.squeak.org/FFI/FFI-Examples-mt.8.mcz ==================== Summary ==================== Name: FFI-Examples-mt.8 Author: mt Time: 26 May 2021, 9:46:32.252346 am UUID: 81e572cb-66dd-ff44-b970-daa6042ffb09 Ancestors: FFI-Examples-mt.7 Moves remaining test examples to "FFI-Tests-Fixtures." This package is empty now and should no longer be used. =============== Diff against FFI-Examples-mt.7 =============== Item was removed: - SystemOrganization addCategory: #'FFI-Examples-X64'! Item was removed: - ExternalStructure subclass: #X64TestStruct - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Examples-X64'! Item was removed: - ----- Method: X64TestStruct class>>fields (in category 'field definition') ----- - fields - "X64TestStruct defineFields" - ^#( - (one 'longlong') - (two 'double') - (three 'longlong') - (four 'double') - (five 'longlong') - (six 'double') - (seven 'longlong') - (eight 'double') - (nine 'longlong') - (ten 'double') - (eleven 'longlong') - (twelve 'double') - (thirteen 'longlong') - (fourteen 'double') - (fifteen 'longlong') - (sixteen 'double') - )! Item was removed: - ----- Method: X64TestStruct>>eight (in category 'accessing') ----- - eight - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 57! Item was removed: - ----- Method: X64TestStruct>>eight: (in category 'accessing') ----- - eight: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 57 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>eleven (in category 'accessing') ----- - eleven - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 81! Item was removed: - ----- Method: X64TestStruct>>eleven: (in category 'accessing') ----- - eleven: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 81 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>fifteen (in category 'accessing') ----- - fifteen - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 113! Item was removed: - ----- Method: X64TestStruct>>fifteen: (in category 'accessing') ----- - fifteen: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 113 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>five (in category 'accessing') ----- - five - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 33! Item was removed: - ----- Method: X64TestStruct>>five: (in category 'accessing') ----- - five: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 33 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>four (in category 'accessing') ----- - four - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 25! Item was removed: - ----- Method: X64TestStruct>>four: (in category 'accessing') ----- - four: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 25 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>fourteen (in category 'accessing') ----- - fourteen - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 105! Item was removed: - ----- Method: X64TestStruct>>fourteen: (in category 'accessing') ----- - fourteen: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 105 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>nine (in category 'accessing') ----- - nine - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 65! Item was removed: - ----- Method: X64TestStruct>>nine: (in category 'accessing') ----- - nine: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 65 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>one (in category 'accessing') ----- - one - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 1! Item was removed: - ----- Method: X64TestStruct>>one: (in category 'accessing') ----- - one: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 1 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>seven (in category 'accessing') ----- - seven - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 49! Item was removed: - ----- Method: X64TestStruct>>seven: (in category 'accessing') ----- - seven: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 49 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>six (in category 'accessing') ----- - six - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 41! Item was removed: - ----- Method: X64TestStruct>>six: (in category 'accessing') ----- - six: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 41 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>sixteen (in category 'accessing') ----- - sixteen - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 121! Item was removed: - ----- Method: X64TestStruct>>sixteen: (in category 'accessing') ----- - sixteen: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 121 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>ten (in category 'accessing') ----- - ten - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 73! Item was removed: - ----- Method: X64TestStruct>>ten: (in category 'accessing') ----- - ten: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 73 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>thirteen (in category 'accessing') ----- - thirteen - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 97! Item was removed: - ----- Method: X64TestStruct>>thirteen: (in category 'accessing') ----- - thirteen: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 97 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>three (in category 'accessing') ----- - three - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle signedLongLongAt: 17! Item was removed: - ----- Method: X64TestStruct>>three: (in category 'accessing') ----- - three: anInteger - "This method was automatically generated. See X64TestStruct class>>fields." - - handle signedLongLongAt: 17 put: anInteger! Item was removed: - ----- Method: X64TestStruct>>twelve (in category 'accessing') ----- - twelve - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 89! Item was removed: - ----- Method: X64TestStruct>>twelve: (in category 'accessing') ----- - twelve: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 89 put: aFloat! Item was removed: - ----- Method: X64TestStruct>>two (in category 'accessing') ----- - two - "This method was automatically generated. See X64TestStruct class>>fields." - - ^handle doubleAt: 9! Item was removed: - ----- Method: X64TestStruct>>two: (in category 'accessing') ----- - two: aFloat - "This method was automatically generated. See X64TestStruct class>>fields." - - handle doubleAt: 9 put: aFloat! Item was removed: - ExternalStructure subclass: #X64TestStruct2 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Examples-X64'! Item was removed: - ----- Method: X64TestStruct2 class>>fields (in category 'field definition') ----- - fields - "X64TestStruct2 defineFields" - ^#( - (one #X64TestStruct) - (two #X64TestStruct) - )! Item was removed: - ----- Method: X64TestStruct2>>one (in category 'accessing') ----- - one - "This method was automatically generated. See X64TestStruct2 class>>fields." - - ^X64TestStruct fromHandle: (handle structAt: 1 length: 128)! Item was removed: - ----- Method: X64TestStruct2>>one: (in category 'accessing') ----- - one: aX64TestStruct - "This method was automatically generated. See X64TestStruct2 class>>fields." - - handle structAt: 1 put: aX64TestStruct getHandle length: 128.! Item was removed: - ----- Method: X64TestStruct2>>two (in category 'accessing') ----- - two - "This method was automatically generated. See X64TestStruct2 class>>fields." - - ^X64TestStruct fromHandle: (handle structAt: 129 length: 128)! Item was removed: - ----- Method: X64TestStruct2>>two: (in category 'accessing') ----- - two: aX64TestStruct - "This method was automatically generated. See X64TestStruct2 class>>fields." - - handle structAt: 129 put: aX64TestStruct getHandle length: 128.! Item was removed: - ExternalStructure subclass: #X64TestStruct3 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Examples-X64'! Item was removed: - ----- Method: X64TestStruct3 class>>fields (in category 'field definition') ----- - fields - "X64TestStruct3 defineFields" - ^#( - (one 'longlong') - (two 'double') - (three 'longlong') - (four 'double') - (five 'longlong') - (six 'double') - (seven 'longlong') - (eight 'double') - (nine 'longlong') - (ten 'double') - (eleven 'longlong') - (twelve 'double') - (thirteen 'longlong') - (fourteen 'double') - (fifteen 'longlong') - (sixteen 'double') - (seventeen #X64TestStruct) - (eighteen #X64TestStruct2) - (nineteen 'X64TestStruct*') - (twenty 'X64TestStruct2*') - )! Item was removed: - ----- Method: X64TestStruct3>>eight (in category 'accessing') ----- - eight - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 57! Item was removed: - ----- Method: X64TestStruct3>>eight: (in category 'accessing') ----- - eight: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 57 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>eighteen (in category 'accessing') ----- - eighteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^X64TestStruct2 fromHandle: (handle structAt: 257 length: 256)! Item was removed: - ----- Method: X64TestStruct3>>eighteen: (in category 'accessing') ----- - eighteen: aX64TestStruct2 - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle structAt: 257 put: aX64TestStruct2 getHandle length: 256.! Item was removed: - ----- Method: X64TestStruct3>>eleven (in category 'accessing') ----- - eleven - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 81! Item was removed: - ----- Method: X64TestStruct3>>eleven: (in category 'accessing') ----- - eleven: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 81 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>fifteen (in category 'accessing') ----- - fifteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 113! Item was removed: - ----- Method: X64TestStruct3>>fifteen: (in category 'accessing') ----- - fifteen: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 113 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>five (in category 'accessing') ----- - five - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 33! Item was removed: - ----- Method: X64TestStruct3>>five: (in category 'accessing') ----- - five: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 33 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>four (in category 'accessing') ----- - four - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 25! Item was removed: - ----- Method: X64TestStruct3>>four: (in category 'accessing') ----- - four: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 25 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>fourteen (in category 'accessing') ----- - fourteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 105! Item was removed: - ----- Method: X64TestStruct3>>fourteen: (in category 'accessing') ----- - fourteen: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 105 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>nine (in category 'accessing') ----- - nine - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 65! Item was removed: - ----- Method: X64TestStruct3>>nine: (in category 'accessing') ----- - nine: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 65 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>nineteen (in category 'accessing') ----- - nineteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^X64TestStruct fromHandle: (handle shortPointerAt: 513)! Item was removed: - ----- Method: X64TestStruct3>>nineteen: (in category 'accessing') ----- - nineteen: aX64TestStruct - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle shortPointerAt: 513 put: aX64TestStruct getHandle.! Item was removed: - ----- Method: X64TestStruct3>>one (in category 'accessing') ----- - one - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 1! Item was removed: - ----- Method: X64TestStruct3>>one: (in category 'accessing') ----- - one: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 1 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>seven (in category 'accessing') ----- - seven - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 49! Item was removed: - ----- Method: X64TestStruct3>>seven: (in category 'accessing') ----- - seven: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 49 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>seventeen (in category 'accessing') ----- - seventeen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^X64TestStruct fromHandle: (handle structAt: 129 length: 128)! Item was removed: - ----- Method: X64TestStruct3>>seventeen: (in category 'accessing') ----- - seventeen: aX64TestStruct - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle structAt: 129 put: aX64TestStruct getHandle length: 128.! Item was removed: - ----- Method: X64TestStruct3>>six (in category 'accessing') ----- - six - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 41! Item was removed: - ----- Method: X64TestStruct3>>six: (in category 'accessing') ----- - six: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 41 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>sixteen (in category 'accessing') ----- - sixteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 121! Item was removed: - ----- Method: X64TestStruct3>>sixteen: (in category 'accessing') ----- - sixteen: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 121 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>ten (in category 'accessing') ----- - ten - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 73! Item was removed: - ----- Method: X64TestStruct3>>ten: (in category 'accessing') ----- - ten: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 73 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>thirteen (in category 'accessing') ----- - thirteen - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 97! Item was removed: - ----- Method: X64TestStruct3>>thirteen: (in category 'accessing') ----- - thirteen: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 97 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>three (in category 'accessing') ----- - three - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle signedLongLongAt: 17! Item was removed: - ----- Method: X64TestStruct3>>three: (in category 'accessing') ----- - three: anInteger - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle signedLongLongAt: 17 put: anInteger! Item was removed: - ----- Method: X64TestStruct3>>twelve (in category 'accessing') ----- - twelve - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 89! Item was removed: - ----- Method: X64TestStruct3>>twelve: (in category 'accessing') ----- - twelve: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 89 put: aFloat! Item was removed: - ----- Method: X64TestStruct3>>twenty (in category 'accessing') ----- - twenty - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^X64TestStruct2 fromHandle: (handle shortPointerAt: 517)! Item was removed: - ----- Method: X64TestStruct3>>twenty: (in category 'accessing') ----- - twenty: aX64TestStruct2 - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle shortPointerAt: 517 put: aX64TestStruct2 getHandle.! Item was removed: - ----- Method: X64TestStruct3>>two (in category 'accessing') ----- - two - "This method was automatically generated. See X64TestStruct3 class>>fields." - - ^handle doubleAt: 9! Item was removed: - ----- Method: X64TestStruct3>>two: (in category 'accessing') ----- - two: aFloat - "This method was automatically generated. See X64TestStruct3 class>>fields." - - handle doubleAt: 9 put: aFloat! From commits at source.squeak.org Thu May 27 07:39:12 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:39:12 0000 Subject: [squeak-dev] FFI: FFI-Win32-mt.21.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-Win32 to project FFI: http://source.squeak.org/FFI/FFI-Win32-mt.21.mcz ==================== Summary ==================== Name: FFI-Win32-mt.21 Author: mt Time: 27 May 2021, 9:39:07.881843 am UUID: 406b22b7-68d4-4d4c-bb73-965b0ecbe9a6 Ancestors: FFI-Win32-nice.20 Empty commit. Package superseded by "FFI-Libraries" =============== Diff against FFI-Win32-nice.20 =============== Item was removed: - SystemOrganization addCategory: #'FFI-Win32-Examples'! Item was removed: - SharedPool subclass: #Win32Constants - instanceVariableNames: '' - classVariableNames: 'COLOR_ACTIVEBORDER COLOR_ACTIVECAPTION COLOR_APPWORKSPACE COLOR_BACKGROUND COLOR_BTNFACE COLOR_BTNHIGHLIGHT COLOR_BTNSHADOW COLOR_BTNTEXT COLOR_CAPTIONTEXT COLOR_GRAYTEXT COLOR_HIGHLIGHT COLOR_HIGHLIGHTTEXT COLOR_INACTIVEBORDER COLOR_INACTIVECAPTION COLOR_INACTIVECAPTIONTEXT COLOR_MENU COLOR_MENUTEXT COLOR_SCROLLBAR COLOR_WINDOW COLOR_WINDOWFRAME COLOR_WINDOWTEXT CS_BYTEALIGNCLIENT CS_BYTEALIGNWINDOW CS_CLASSDC CS_DBLCLKS CS_HREDRAW CS_NOCLOSE CS_OWNDC CS_PARENTDC CS_SAVEBITS CS_VREDRAW CW_USEDEFAULT GWL_STYLE HWND_BROADCAST WM_DESTROY WM_MOVE WS_BORDER WS_CAPTION WS_CHILD WS_CHILDWINDOW WS_CLIPCHILDREN WS_CLIPSIBLINGS WS_DISABLED WS_DLGFRAME WS_EX_ACCEPTFILES WS_EX_APPWINDOW WS_EX_CLIENTEDGE WS_EX_CONTEXTHELP WS_EX_CONTROLPARENT WS_EX_DLGMODALFRAME WS_EX_LEFT WS_EX_LEFTSCROLLBAR WS_EX_LTRREADING WS_EX_MDICHILD WS_EX_NOACTIVATE WS_EX_NOPARENTNOTIFY WS_EX_OVERLAPPEDWINDOW WS_EX_PALETTEWINDOW WS_EX_RIGHT WS_EX_RIGHTSCROLLBAR WS_EX_RTLREADING WS_EX_STATICEDGE WS_ EX_TOOLWINDOW WS_EX_TOPMOST WS_EX_TRANSPARENT WS_EX_WINDOWEDGE WS_GROUP WS_HSCROLL WS_ICONIC WS_MAXIMIZE WS_MAXIMIZEBOX WS_MINIMIZE WS_MINIMIZEBOX WS_OVERLAPPED WS_OVERLAPPEDWINDOW WS_POPUP WS_POPUPWINDOW WS_SIZEBOX WS_SYSMENU WS_TABSTOP WS_THICKFRAME WS_TILED WS_TILEDWINDOW WS_VISIBLE WS_VSCROLL' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Constants class>>initialize (in category 'pool initialization') ----- - initialize - "Win32Constants initialize" - self initializeWindowConstants.! Item was removed: - ----- Method: Win32Constants class>>initializeWindowConstants (in category 'pool initialization') ----- - initializeWindowConstants - GWL_STYLE := -16. - WS_EX_ACCEPTFILES := 16r10. - WS_EX_APPWINDOW := 16r40000. - WS_EX_CLIENTEDGE := 16r200. - WS_EX_CONTEXTHELP := 16r400. - WS_EX_CONTROLPARENT := 16r10000. - WS_EX_DLGMODALFRAME := 16r1. - WS_EX_LEFT := 16r0. - WS_EX_LEFTSCROLLBAR := 16r4000. - WS_EX_LTRREADING := 16r0. - WS_EX_MDICHILD := 16r40. - WS_EX_NOACTIVATE := 16r8000000. - WS_EX_NOPARENTNOTIFY := 16r4. - WS_EX_OVERLAPPEDWINDOW := 16r300. - WS_EX_PALETTEWINDOW := 16r188. - WS_EX_RIGHT := 16r1000. - WS_EX_RIGHTSCROLLBAR := 16r0. - WS_EX_RTLREADING := 16r2000. - WS_EX_STATICEDGE := 16r20000. - WS_EX_TOOLWINDOW := 16r80. - WS_EX_TOPMOST := 16r8. - WS_EX_TRANSPARENT := 16r20. - WS_EX_WINDOWEDGE := 16r100. - WS_BORDER := 16r800000. - WS_CAPTION := 16rC00000. - WS_CHILD := 16r40000000. - WS_CHILDWINDOW := 16r40000000. - WS_CLIPCHILDREN := 16r2000000. - WS_CLIPSIBLINGS := 16r4000000. - WS_DISABLED := 16r8000000. - WS_DLGFRAME := 16r400000. - WS_GROUP := 16r20000. - WS_HSCROLL := 16r100000. - WS_ICONIC := 16r20000000. - WS_MAXIMIZE := 16r1000000. - WS_MAXIMIZEBOX := 16r10000. - WS_MINIMIZE := 16r20000000. - WS_MINIMIZEBOX := 16r20000. - WS_OVERLAPPED := 16r0. - WS_OVERLAPPEDWINDOW := 16rCF0000. - WS_POPUP := 16r80000000. - WS_POPUPWINDOW := 16r80880000. - WS_SIZEBOX := 16r40000. - WS_SYSMENU := 16r80000. - WS_TABSTOP := 16r10000. - WS_THICKFRAME := 16r40000. - WS_TILED := 16r0. - WS_TILEDWINDOW := 16rCF0000. - WS_VISIBLE := 16r10000000. - WS_VSCROLL := 16r200000. - CS_BYTEALIGNCLIENT := 16r1000. - CS_BYTEALIGNWINDOW := 16r2000. - CS_CLASSDC := 16r40. - CS_DBLCLKS := 16r8. - CS_HREDRAW := 16r2. - CS_NOCLOSE := 16r200. - CS_OWNDC := 16r20. - CS_PARENTDC := 16r80. - CS_SAVEBITS := 16r800. - CS_VREDRAW := 16r1. - COLOR_ACTIVEBORDER := 10. - COLOR_ACTIVECAPTION := 2. - COLOR_APPWORKSPACE := 12. - COLOR_BACKGROUND := 1. - COLOR_BTNFACE := 15. - COLOR_BTNHIGHLIGHT := 20. - COLOR_BTNSHADOW := 16. - COLOR_BTNTEXT := 18. - COLOR_CAPTIONTEXT := 9. - COLOR_GRAYTEXT := 17. - COLOR_HIGHLIGHT := 13. - COLOR_HIGHLIGHTTEXT := 14. - COLOR_INACTIVEBORDER := 11. - COLOR_INACTIVECAPTION := 3. - COLOR_INACTIVECAPTIONTEXT := 19. - COLOR_MENU := 4. - COLOR_MENUTEXT := 7. - COLOR_SCROLLBAR := 0. - COLOR_WINDOW := 5. - COLOR_WINDOWFRAME := 6. - COLOR_WINDOWTEXT := 8. - CW_USEDEFAULT := 16r80000000. - HWND_BROADCAST := 16rFFFF. - WM_DESTROY := 16r2. - WM_MOVE := 16r3! Item was removed: - Object subclass: #Win32Error - instanceVariableNames: 'errorCode' - classVariableNames: 'ErrorCodes' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Error class>>initialize (in category 'as yet unclassified') ----- - initialize - "Win32Error initialize" - - ErrorCodes := Dictionary new. - ErrorCodes - at: 203 put: #('ERROR_ENVVAR_NOT_FOUND' 'There was no environment variable with that name'); - yourself! Item was removed: - ----- Method: Win32Error class>>lastError (in category 'as yet unclassified') ----- - lastError - - ^(self new) initializeWithLastError! Item was removed: - ----- Method: Win32Error class>>win32GetLastError (in category 'as yet unclassified') ----- - win32GetLastError - "DWORD WINAPI GetLastError(void);" - - - ^nil! Item was removed: - ----- Method: Win32Error>>errorCode (in category 'as yet unclassified') ----- - errorCode - - ^errorCode! Item was removed: - ----- Method: Win32Error>>errorMessage (in category 'as yet unclassified') ----- - errorMessage - - ^(ErrorCodes at: errorCode) at: 2 ifAbsent: ['Unknown Error: ' , errorCode]! Item was removed: - ----- Method: Win32Error>>errorName (in category 'as yet unclassified') ----- - errorName - - ^(ErrorCodes at: errorCode) at: 1 ifAbsent: ['ERROR_UNKNOWN_' , errorCode ]! Item was removed: - ----- Method: Win32Error>>initializeWithLastError (in category 'as yet unclassified') ----- - initializeWithLastError - - errorCode := self class win32GetLastError.! Item was removed: - ExternalObject subclass: #Win32File - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32File class>>setReadOnly: (in category 'operations') ----- - setReadOnly: fileString - "Convenient shorthand." - ^ (self new) setReadOnly: fileString! Item was removed: - ----- Method: Win32File class>>setReadWrite: (in category 'operations') ----- - setReadWrite: fileString - "Convenient shorthand" - ^ (self new) setReadWrite: fileString! Item was removed: - ----- Method: Win32File>>getFileAttributes: (in category 'api calls') ----- - getFileAttributes: fileString - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32File>>setFileAttributes:lpAttrs: (in category 'api calls') ----- - setFileAttributes: fileString lpAttrs: aLong - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32File>>setReadOnly: (in category 'operations') ----- - setReadOnly: fileString - "Set FILE_READ_ONLY (bit 1)" - | attrs | - attrs := (self getFileAttributes: fileString). - attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. - (self setFileAttributes: fileString lpAttrs: (attrs bitOr: 1)) = 0 ifTrue: [ - self error: 'Cannot set file attributes. System error.' - ].! Item was removed: - ----- Method: Win32File>>setReadWrite: (in category 'operations') ----- - setReadWrite: fileString - "Clear FILE_READ_ONLY (bit 1)" - | attrs | - attrs := (self getFileAttributes: fileString). - attrs < 0 ifTrue: [ self error: 'Cannot get file attributes. System error.' ]. - (self setFileAttributes: fileString lpAttrs: (attrs bitClear: 1)) = 0 ifTrue: [ - self error: 'Cannot set file attributes. System error.' - ].! Item was removed: - Win32HGDIObj subclass: #Win32HBrush - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32HBrush class>>apiCreateHatchBrush:with: (in category 'api calls') ----- - apiCreateHatchBrush: aStyle with: colorref - "Creates a logical brush that has the specified hatch pattern and color" - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HBrush class>>backwardDiagonalWithColor: (in category 'hatch brushes') ----- - backwardDiagonalWithColor: aColor - "45-degree downward left-to-right hatch brush" - ^ self createHatchBrush: 3 color: aColor! Item was removed: - ----- Method: Win32HBrush class>>createHatchBrush:color: (in category 'instance creation') ----- - createHatchBrush: aStyle color: aColor - "Creates an instance of the receiver that has the specified hatch pattern and color" - ^ self apiCreateHatchBrush: aStyle with: aColor asColorref! Item was removed: - ----- Method: Win32HBrush class>>createSolidBrush: (in category 'instance creation') ----- - createSolidBrush: aCOLORREF - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HBrush class>>crossWithColor: (in category 'hatch brushes') ----- - crossWithColor: aColor - "Horizontal and vertical crosshatch brush" - ^ self createHatchBrush: 4 color: aColor! Item was removed: - ----- Method: Win32HBrush class>>diagonalCrossWithColor: (in category 'hatch brushes') ----- - diagonalCrossWithColor: aColor - "45-degree crosshatch brush" - ^ self createHatchBrush: 5 color: aColor! Item was removed: - ----- Method: Win32HBrush class>>forwardDiagonalWithColor: (in category 'hatch brushes') ----- - forwardDiagonalWithColor: aColor - "45-degree upward left-to-right hatch brush" - ^ self createHatchBrush: 2 color: aColor! Item was removed: - ----- Method: Win32HBrush class>>horizontalWithColor: (in category 'hatch brushes') ----- - horizontalWithColor: aColor - "Horizontal hatch brush" - ^ self createHatchBrush: 0 color: aColor! Item was removed: - ----- Method: Win32HBrush class>>verticalWithColor: (in category 'hatch brushes') ----- - verticalWithColor: aColor - "Horizontal hatch brush" - ^ self createHatchBrush: 1 color: aColor ! Item was removed: - Win32Handle subclass: #Win32HDC - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32HDC>>apiDeleteDC: (in category 'api calls') ----- - apiDeleteDC: aHDC - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiDrawFocusRect:with: (in category 'api calls') ----- - apiDrawFocusRect: aHDC with: lpRect - "Draws a rectangle in the style used to indicate that the rectangle has - the focus." - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiDrawFrameControl:with:with:with: (in category 'api calls') ----- - apiDrawFrameControl: aHDC with: lpRect with: type with: state - "Draws a frame control of the specified type and style" - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiEllipse:with:with:with:with: (in category 'api calls') ----- - apiEllipse: aHDC with: left with: top with: right with: bottom - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiExtFloodFill:with:with:with:with: (in category 'api calls') ----- - apiExtFloodFill: aHDC with: x with: y with: colorref with: fillType - "fills an area of the display surface with the current brush" - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiFillRect:with:with: (in category 'api calls') ----- - apiFillRect: aHDC with: lpRect with: brush - "Fills a rectangle by using the specified brush. This function includes - the left and top borders, but excludes the right and bottom borders of - the rectangle. - " - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiFrameRect:with:with: (in category 'api calls') ----- - apiFrameRect: aHDC with: lpRect with: brush - "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiLineTo:with:with: (in category 'api calls') ----- - apiLineTo: aHDC with: x with: y - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiMoveToEx:with:with:with: (in category 'api calls') ----- - apiMoveToEx: aHDC with: x with: y with: pt - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiRectangle:with:with:with:with: (in category 'api calls') ----- - apiRectangle: aHDC with: left with: top with: right with: bottom - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiRoundRect:with:with:with:with:with:with: (in category 'api calls') ----- - apiRoundRect: aHDC with: left with: top with: right with: bottom with: width with: height - "Draws a rectangle with rounded corners. The rectangle is outlined by - using the current pen and filled by using the current brush" - - ^ self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>apiSelectObject:with: (in category 'api calls') ----- - apiSelectObject: aHDC with: aHGDIOBJ - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HDC>>delete (in category 'initialize-release') ----- - delete - handle == nil - ifFalse:[self apiDeleteDC: self]. - handle := nil.! Item was removed: - ----- Method: Win32HDC>>drawFocusRectangle: (in category 'drawing') ----- - drawFocusRectangle: aRect - "draws a rectangle in the style used to indicate that the rectangle has the focus" - - self - apiDrawFocusRect: self - with: (Win32Rectangle fromRectangle: aRect) - - ! Item was removed: - ----- Method: Win32HDC>>drawFrameControl:type:style: (in category 'drawing') ----- - drawFrameControl: aRect type: aType style: aStyle - "Draws a frame control of the specified type and style (integer values)" - self apiDrawFrameControl: self with: (Win32Rectangle fromRectangle: aRect) with: aType with: aStyle! Item was removed: - ----- Method: Win32HDC>>ellipse: (in category 'drawing') ----- - ellipse: aRect - ^self apiEllipse: self with: aRect left with: aRect top with: aRect right with: aRect bottom! Item was removed: - ----- Method: Win32HDC>>fillRectangle:color: (in category 'drawing') ----- - fillRectangle: aRect color: aColor - "fills an area of the display with the given color" - | brush | - - brush := Win32HBrush createSolidBrush: aColor asColorref. - self - apiFillRect: self - with: (Win32Rectangle fromRectangle: aRect) - with: brush. - brush delete! Item was removed: - ----- Method: Win32HDC>>floodFillAt:boundaryColor:fillColor: (in category 'drawing') ----- - floodFillAt: aPoint boundaryColor: aColor fillColor: anotherColor - "fills an area of the display with the given color" - | newBrush oldBrush | - newBrush := Win32HBrush createSolidBrush: anotherColor asColorref. - oldBrush := self selectObject: newBrush. - (self - apiExtFloodFill: self - with: aPoint x - with: aPoint y - with: aColor asColorref - with: 0) inspect. - self selectObject: oldBrush. - newBrush delete! Item was removed: - ----- Method: Win32HDC>>frameRectangle:brush: (in category 'drawing') ----- - frameRectangle: aRect brush: aBrush - "Draws a border around the specified rectangle by using the specified brush. The width and height of the border are always one logical unit." - - self - apiFrameRect: self - with: (Win32Rectangle fromRectangle: aRect) - with: aBrush. - ! Item was removed: - ----- Method: Win32HDC>>lineTo: (in category 'drawing') ----- - lineTo: aPoint - ^self apiLineTo: self with: aPoint x with: aPoint y! Item was removed: - ----- Method: Win32HDC>>moveTo: (in category 'drawing') ----- - moveTo: aPoint - ^self apiMoveToEx: self with: aPoint x with: aPoint y with: nil! Item was removed: - ----- Method: Win32HDC>>rectangle: (in category 'drawing') ----- - rectangle: aRect - ^self apiRectangle: self with: aRect left with: aRect top with: aRect right with: aRect bottom! Item was removed: - ----- Method: Win32HDC>>roundRectangle:width:height: (in category 'drawing') ----- - roundRectangle: aRect width: width height: height - ^ self - apiRoundRect: self - with: aRect left - with: aRect top - with: aRect right - with: aRect bottom - with: width - with: height! Item was removed: - ----- Method: Win32HDC>>selectObject: (in category 'drawing') ----- - selectObject: aHGDIOBJ - ^self apiSelectObject: self with: aHGDIOBJ! Item was removed: - Win32Handle subclass: #Win32HGDIObj - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32HGDIObj>>apiDeleteObject: (in category 'api calls') ----- - apiDeleteObject: aHGDIOBJ - - ^self externalCallFailed! Item was removed: - ----- Method: Win32HGDIObj>>delete (in category 'initialize-release') ----- - delete - self apiDeleteObject: self! Item was removed: - ExternalTypeAlias subclass: #Win32Handle - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Handle class>>originalTypeName (in category 'accessing') ----- - originalTypeName - "Win32Handle defineFields" - "The following really means - typedef void* Win32Handle; - " - ^ 'uintptr_t'! Item was removed: - ExternalStructure subclass: #Win32Point - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Point class>>apiGetCursorPos: (in category 'api calls') ----- - apiGetCursorPos: pt - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Point class>>fields (in category 'accessing') ----- - fields - "POINT defineFields" - ^#( - (x 'long') - (y 'long') - )! Item was removed: - ----- Method: Win32Point class>>getCursorPos (in category 'instance creation') ----- - getCursorPos - | pt | - pt := self new. - self apiGetCursorPos: pt. - ^pt! Item was removed: - ----- Method: Win32Point>>asPoint (in category 'converting') ----- - asPoint - ^self x @ self y! Item was removed: - ExternalPool subclass: #Win32Pool - instanceVariableNames: '' - classVariableNames: 'WIN32_WINNT_VISTA WIN32_WINNT_WIN10 WIN32_WINNT_WIN7 WIN32_WINNT_WIN8 WIN32_WINNT_WINXP' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Pool class>>winver (in category 'definitions') ----- - winver - " - self winver writePoolData. - self winver readPoolData. - " - - - - - ')> - - - - - - - ^ self poolDefinition! Item was removed: - ----- Method: Win32Pool class>>winverData (in category 'definitions - data') ----- - winverData - "Automatically generated." - - - " - Win32Pool winver readPoolDataFrom: #methodSource. - Win32Pool winver writePoolDataTo: #methodSource. - " - ^ { - (FFIPlatformDescription name: 'Win32' osVersion: '10.0' subtype: 'IX86' wordSize: 4). - Dictionary new - at: #WIN32_WINNT_WIN7 put: 16r00000601; - at: #WIN32_WINNT_WINXP put: 16r00000501; - at: #WIN32_WINNT_VISTA put: 16r00000600; - at: #WIN32_WINNT_WIN8 put: 16r00000602; - at: #WIN32_WINNT_WIN10 put: 16r00000A00; - yourself. - } - ! Item was removed: - ExternalStructure subclass: #Win32Rectangle - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! Item was removed: - ----- Method: Win32Rectangle class>>fields (in category 'accessing') ----- - fields - "Win32Rectangle defineFields" - ^ #(#(#left 'long') #(#top 'long') #(#right 'long') #(#bottom 'long') )! Item was removed: - ----- Method: Win32Rectangle class>>fromRectangle: (in category 'instance creation') ----- - fromRectangle: rc - "returns an instance of the receiver from the given smalltalk rectangle" - ^ self new left: rc left top: rc top right: rc right bottom: rc bottom ! Item was removed: - ----- Method: Win32Rectangle>>left:top:right:bottom: (in category 'accessing') ----- - left: left top: top right: right bottom: bottom - "sets the coordinates of the receiver" - - self left: left. - self top: top. - self right: right. - self bottom: bottom ! Item was removed: - ExternalObject subclass: #Win32Shell - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! - - !Win32Shell commentStamp: '' prior: 0! - This class wrappes the Windows 32 shell. - - Try - Win32Shell new shellOpen: 'c:\image.bmp' to open a document - Win32Shell new shellOpen: 'c:\myprogram.exe' to start an executable - Win32Shell new shellExplore: 'c:\' to explore a directory - Win32Shell new shellFind: 'c:\' to initiate a search - - Note that this class is platform specific. - - ! Item was removed: - ----- Method: Win32Shell>>error: (in category 'operations') ----- - error: code - Win32ShellErrors signal: code! Item was removed: - ----- Method: Win32Shell>>shellExecute: (in category 'operations') ----- - shellExecute: aFileString - "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, - or a folder." - | result fileUrlString | - "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." - fileUrlString := (aFileString asLowercase beginsWith: 'file:') - ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] - ifFalse: [aFileString]. - - result := self shellExecute: nil - lpOperation: 'open' - lpFile: fileUrlString - lpParameters: nil - lpDirectory: nil - nShowCmd: 0. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - ----- Method: Win32Shell>>shellExecute:arguments:toPath: (in category 'operations') ----- - shellExecute: aFileString arguments: arguments toPath: outputPath - "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, - or a folder." - | result fileUrlString | - "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." - fileUrlString := (aFileString asLowercase beginsWith: 'file:') - ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] - ifFalse: [aFileString]. - - result := self shellExecute: nil - lpOperation: 'open' - lpFile: fileUrlString - lpParameters: arguments - lpDirectory: outputPath - nShowCmd: 0. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - ----- Method: Win32Shell>>shellExecute:lpOperation:lpFile:lpParameters:lpDirectory:nShowCmd: (in category 'api calls') ----- - shellExecute: hwnd lpOperation: opString lpFile: fileString lpParameters: parmString lpDirectory: dirString nShowCmd: anInteger - "Opens or prints the specified file, which can be an executable or document file. - HINSTANCE ShellExecute( - HWND hwnd, // handle to parent window - LPCTSTR lpOperation, // pointer to string that specifies operation to perform - LPCTSTR lpFile, // pointer to filename or folder name string - LPCTSTR lpParameters, // pointer to string that specifies executable-file parameters - LPCTSTR lpDirectory, // pointer to string that specifies default directory - INT nShowCmd // whether file is shown when opened - );" - ! Item was removed: - ----- Method: Win32Shell>>shellExplore: (in category 'operations') ----- - shellExplore: aPathString - "Explores the folder specified by aPathString" - - | result | - result := self shellExecute: nil - lpOperation: 'explore' - lpFile: aPathString - lpParameters: nil - lpDirectory: nil - nShowCmd: 1. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - ----- Method: Win32Shell>>shellFind: (in category 'operations') ----- - shellFind: aPathString - "Initiates a search starting from the specified directory." - - | result | - result := self shellExecute: nil - lpOperation: 'find' - lpFile: nil - lpParameters: nil - lpDirectory: aPathString - nShowCmd: 1. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - ----- Method: Win32Shell>>shellOpen: (in category 'operations') ----- - shellOpen: aFileString - "Opens the file specified by aFileString. The file can be an executable file, a document file, - or a folder." - | result fileUrlString | - "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." - fileUrlString := (aFileString asLowercase beginsWith: 'file:') - ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] - ifFalse: [aFileString]. - - result := self shellExecute: nil - lpOperation: 'open' - lpFile: fileUrlString - lpParameters: nil - lpDirectory: nil - nShowCmd: 1. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - ----- Method: Win32Shell>>shellOpen:arguments:toPath: (in category 'operations') ----- - shellOpen: aFileString arguments: arguments toPath: outputPath - "Opens (without opening a window) the file specified by aFileString. The file can be an executable file, a document file, - or a folder." - | result fileUrlString | - "@@@@ CHECKME - jrd - Hackity, hack, hack, hack. Apparently the Win32 url parser doesn't handle %-encoded colons in file paths properly. So we do the conversion ourselves. I'm not sure if the real problem is that we shouldnt be encoding the colons in the first place." - fileUrlString := (aFileString asLowercase beginsWith: 'file:') - ifTrue: [(aFileString copyReplaceAll: '%3A' with: ':') copyReplaceAll: '%3a' with: ':' ] - ifFalse: [aFileString]. - - result := self shellExecute: nil - lpOperation: 'open' - lpFile: fileUrlString - lpParameters: arguments - lpDirectory: outputPath - nShowCmd: 1. - (result <= 32 and: [result >= 0]) ifTrue: [self error: result]! Item was removed: - SharedPool subclass: #Win32ShellErrors - instanceVariableNames: 'errorNumber description' - classVariableNames: 'ERROR_BAD_FORMAT ERROR_FILE_NOT_FOUND ERROR_PATH_NOT_FOUND OUT_OF_MEMORY_OR_RESOURCES SE_ERR_ACCESSDENIED SE_ERR_ACCOSINCOMPLETE SE_ERR_DDEBUSY SE_ERR_DDEFAIL SE_ERR_DDETIMEOUT SE_ERR_DDLNOTFOUND SE_ERR_FNF SE_ERR_NOASSOC SE_ERR_OOM SE_ERR_PNF SE_ERR_SHARE' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! - Win32ShellErrors class - instanceVariableNames: 'errors'! - Win32ShellErrors class - instanceVariableNames: 'errors'! Item was removed: - ----- Method: Win32ShellErrors class>>initialize (in category 'as yet unclassified') ----- - initialize - self initializeWindowConstants! Item was removed: - ----- Method: Win32ShellErrors class>>initializeWindowConstants (in category 'as yet unclassified') ----- - initializeWindowConstants - OUT_OF_MEMORY_OR_RESOURCES := self new errorNumber: 0; description: 'The operating system is out of memory or resources'. - SE_ERR_FNF := self new errorNumber: 2; description: 'The specified file was not found'. - SE_ERR_PNF := self new errorNumber: 3; description: 'The specified path was not found'. - SE_ERR_ACCESSDENIED := self new errorNumber: 5; description: 'The operating system denied access to the specified file'. - SE_ERR_OOM := self new errorNumber: 8; description: 'There was not enough memory to complete the operation'. - ERROR_BAD_FORMAT := self new errorNumber: 11; description: 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image)'. - SE_ERR_SHARE := self new errorNumber: 26; description: 'A sharing violation occurred'. - SE_ERR_ACCOSINCOMPLETE := self new errorNumber: 27; description: 'The filename association is incomplete or invalid'. - SE_ERR_DDETIMEOUT := self new errorNumber: 28; description: 'The DDE transaction could not be completed because the request timed out'. - SE_ERR_DDEFAIL := self new errorNumber: 29; description: 'The DDE transaction failed'. - SE_ERR_DDEBUSY := self new errorNumber: 30; description: 'The DDE transaction could not be completed because other DDE transactions were being processed'. - SE_ERR_NOASSOC := self new errorNumber: 31; description: 'There is no application associated with the given filename extension'. - SE_ERR_DDLNOTFOUND := self new errorNumber: 32; description: 'The specified dynamic-link library was not found'. - errors := Dictionary new: (self allInstances size). - self allInstances do: [:err| - errors at: err errorNumber put: err - ].! Item was removed: - ----- Method: Win32ShellErrors class>>signal: (in category 'as yet unclassified') ----- - signal: code - | err | - err := errors at: code ifAbsent: [Error signal: 'system error, code:', code]. - Error signal: err errorString! Item was removed: - ----- Method: Win32ShellErrors>>description (in category 'accessing') ----- - description - - ^ description - ! Item was removed: - ----- Method: Win32ShellErrors>>description: (in category 'accessing') ----- - description: anObject - - description := anObject. - ! Item was removed: - ----- Method: Win32ShellErrors>>errorNumber (in category 'accessing') ----- - errorNumber - - ^ errorNumber - ! Item was removed: - ----- Method: Win32ShellErrors>>errorNumber: (in category 'accessing') ----- - errorNumber: anObject - - errorNumber := anObject. - ! Item was removed: - ----- Method: Win32ShellErrors>>errorString (in category 'accessing') ----- - errorString - ^'system error, code: ', errorNumber, ' "', description, '"'! Item was removed: - Object subclass: #Win32Utils - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Win32-Examples'! - - !Win32Utils commentStamp: 'tbn 8/22/2005 23:50' prior: 0! - This is an utility class with helpfull methods for Win32 users. Note that it uses FFI and is - platform dependent.! Item was removed: - ----- Method: Win32Utils class>>apiFreeEnvironmentStrings: (in category 'api calls') ----- - apiFreeEnvironmentStrings: extData - "Win32Utils apiFreeEnvironmentStrings" - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Utils class>>apiGetEnvironmentStrings (in category 'api calls') ----- - apiGetEnvironmentStrings - "Win32Utils apiGetEnvironmentStrings" - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Utils class>>apiGetEnvironmentVariable:buffer:size: (in category 'api calls') ----- - apiGetEnvironmentVariable: name buffer: buffer size: bufferSize - "DWORD WINAPI GetEnvironmentVariable( - __in_opt LPCTSTR lpName, - __out_opt LPTSTR lpBuffer, - __in DWORD nSize - );" - "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx" - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Utils class>>apiGetUserBuffer:size: (in category 'api calls') ----- - apiGetUserBuffer: buffer size: bufferSize - "BOOL WINAPI GetUserNameA( - __out_opt LPSTR lpBuffer, - __in LPDWORD pcbBuffer - );" - "https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-getusernamea" - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Utils class>>apiSetCursorPosX:y: (in category 'api calls') ----- - apiSetCursorPosX: x y: y - "this is apparently how to control the mouse cursor pragmatically on windows: - http://lists.squeakfoundation.org/pipermail/squeak-dev/2011-February/157676.html - " - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Utils class>>getCommonEnvironmentVariables (in category 'examples') ----- - getCommonEnvironmentVariables - "Returns a dictionary with common environment variables for Win32 systems" - - |map| - map := Dictionary new. - #('ALLUSERSPROFILE' 'APPDATA' 'COMPUTERNAME' 'COMSPEC' 'HOMEDRIVE' 'HOMEPATH' 'LOGONSERVER' - 'SYSTEMDRIVE' 'OS' 'PATH' 'SYSTEMROOT' 'TEMP' 'TMP' 'USERDOMAIN' 'USERNAME' 'USERPROFILE' 'WINDIR') - do: [:each | map at: each put: (self getEnvironmentVariable: each)]. - ^map - ! Item was removed: - ----- Method: Win32Utils class>>getCurrentUser (in category 'accessing') ----- - getCurrentUser - " - Win32Utils getCurrentUser - " - | nm sz | - sz := (ByteArray new: 8). - sz longAt: 1 put: 256 bigEndian: false. - self apiGetUserBuffer: (nm := ByteArray new: 256) size: sz. - ^(nm copyUpTo: 0) asString! Item was removed: - ----- Method: Win32Utils class>>getEnvironmentVariable: (in category 'accessing') ----- - getEnvironmentVariable: aString - "Win32Utils getEnvironmentVariable: 'windir'" - - ^ self getEnvironmentVariable: aString ifAbsent: [nil]! Item was removed: - ----- Method: Win32Utils class>>getEnvironmentVariable:buffer:ifAbsent: (in category 'accessing') ----- - getEnvironmentVariable: name buffer: buffer ifAbsent: block - "Win32Utils getEnvironmentVariable: 'APPDATA' " - "Win32Utils getEnvironmentVariable: 'APPDATAx' " - "http://msdn.microsoft.com/en-us/library/ms683188(VS.85).aspx " - - | retval err | - retval := self apiGetEnvironmentVariable: name buffer: buffer size: buffer byteSize. - retval = 0 - ifTrue: [ - err := Win32Error lastError. - ^(err errorName = 'ERROR_ENVVAR_NOT_FOUND') - ifTrue: [block value] - ifFalse: [ - self error: 'Problem with retrieving env var ' , name , '. Code is ' , err errorName. - nil - ] - ]. - ^(retval < buffer byteSize) - ifTrue: [( buffer copyFrom: 1 to: retval ) asString] - ifFalse: [ self getEnvironmentVariable: name buffer: (ByteArray new: retval) ifAbsent: block ]. - ! Item was removed: - ----- Method: Win32Utils class>>getEnvironmentVariable:ifAbsent: (in category 'accessing') ----- - getEnvironmentVariable: name ifAbsent: block - "Win32Utils getEnvironmentVariable: 'APPDATA' ifAbsent: [nil]" - "Win32Utils getEnvironmentVariable: 'APPDATAx' ifAbsent: [5]" - - ^self getEnvironmentVariable: name buffer: (ByteArray new: 256) ifAbsent: block! Item was removed: - ----- Method: Win32Utils class>>getEnvironmentVariables (in category 'accessing') ----- - getEnvironmentVariables - "Win32Utils getEnvironmentVariables" - - | externalData strs | - externalData := self apiGetEnvironmentStrings. - strs := externalData fromCStrings. - self apiFreeEnvironmentStrings: externalData. - ^strs - ! Item was removed: - Win32Handle subclass: #Win32Window - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: 'Win32Constants' - category: 'FFI-Win32-Examples'! - - !Win32Window commentStamp: '' prior: 0! - Here's a simple Win32 example: - | hwnd dc dst | - hwnd _ Win32Window getFocus. "fetch the window currently having the focus" - dc _ hwnd getDC. "grab the dc or the window" - dst _ 100. - dc moveTo: 0 at 0. - "draw a rect" - dc lineTo: dst at 0. dc lineTo: dst at dst. dc lineTo: 0 at dst. dc lineTo: 0 at 0. - "and a cross" - dc lineTo: dst at dst. dc moveTo: dst at 0. dc lineTo: 0 at dst. - hwnd releaseDC: dc.! Item was removed: - ----- Method: Win32Window class>>coloredEllipses (in category 'examples') ----- - coloredEllipses "Win32Window coloredEllipses" - "Draw a bunch of ellipses" - | rnd pt1 pt2 w h colors newBrush oldBrush | - colors := Color colorNames collect:[:cName| (Color perform: cName)]. - "convert to COLORREF" - colors := colors collect:[:c| - (c red * 255) asInteger + - ((c green * 255) asInteger << 8) + - ((c blue * 255) asInteger << 16)]. - rnd := Random new. - w := Display width. - h := Display height. - self getFocus getHDCDuring:[:hDC| - [Sensor anyButtonPressed] whileFalse:[ - newBrush := Win32HBrush createSolidBrush: colors atRandom. - oldBrush := hDC selectObject: newBrush. - pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - hDC ellipse: (Rectangle encompassing: (Array with: pt1 with: pt2)). - hDC selectObject: oldBrush. - newBrush delete. - ]. - ]. - Display forceToScreen.! Item was removed: - ----- Method: Win32Window class>>coloredRectangles (in category 'examples') ----- - coloredRectangles "Win32Window coloredRectangles" - "Draw a bunch of ellipses" - | rnd pt1 pt2 w h colors newBrush oldBrush n nPixels time r | - colors := Color colorNames collect:[:cName| (Color perform: cName)]. - "convert to COLORREF" - colors := colors collect:[:c| - (c red * 255) asInteger + - ((c green * 255) asInteger << 8) + - ((c blue * 255) asInteger << 16)]. - rnd := Random new. - w := Display width. - h := Display height. - self getFocus getHDCDuring:[:hDC| - n := 0. - nPixels := 0. - time := Time millisecondClockValue. - [Sensor anyButtonPressed] whileFalse:[ - newBrush := Win32HBrush createSolidBrush: colors atRandom. - oldBrush := hDC selectObject: newBrush. - pt1 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - pt2 := (rnd next * w) asInteger @ (rnd next * h) asInteger. - hDC rectangle: (r := Rectangle encompassing: (Array with: pt1 with: pt2)). - hDC selectObject: oldBrush. - newBrush delete. - n := n + 1. - nPixels := nPixels + ((r right - r left) * (r bottom - r top)). - (n \\ 100) = 0 ifTrue:[ - 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) - asStringWithCommas displayAt: 0 at 0]. - ]. - ]. - Display forceToScreen.! Item was removed: - ----- Method: Win32Window class>>getDesktopWindow (in category 'accessing') ----- - getDesktopWindow - "Return the HWND describing the desktop" - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window class>>getFocus (in category 'accessing') ----- - getFocus - "Return the HWND currently having the input focus" - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window class>>getMainWindowText: (in category 'examples') ----- - getMainWindowText: aString - "Returns the window text of the main window" - - self new getWindowText: Win32Window getFocus ! Item was removed: - ----- Method: Win32Window class>>getWindowLong:index: (in category 'private') ----- - getWindowLong: hwnd index: index - "Retrieves information about the specified window." - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window class>>getWindowStyle (in category 'private') ----- - getWindowStyle - "Returns the window style for the focus window" - - ^self getWindowLong: self getFocus index: GWL_STYLE - ! Item was removed: - ----- Method: Win32Window class>>setMainWindowText: (in category 'examples') ----- - setMainWindowText: aString - "Sets the window text of the main window" - - self new apiSetWindowText: Win32Window getFocus text: aString! Item was removed: - ----- Method: Win32Window class>>setNonResizable (in category 'private') ----- - setNonResizable - " - self setNonResizable - " - | newStyle | - newStyle := self getWindowStyle bitClear: ((WS_SIZEBOX bitOr: WS_MINIMIZE) bitOr: WS_MAXIMIZE). - self setWindowLong: self getFocus index: GWL_STYLE value: newStyle. - ! Item was removed: - ----- Method: Win32Window class>>setWindowLong:index:value: (in category 'private') ----- - setWindowLong: hwnd index: index value: value - "Sets information about the specified window." - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window class>>win32Draw (in category 'examples') ----- - win32Draw "Win32Window win32Draw" - "Draw a bunch of lines using the Windows API" - | hWnd hDC pt | - hWnd := Win32Window getFocus. - hDC := hWnd getDC. - hDC moveTo: (hWnd screenToClient: Win32Point getCursorPos). - [Sensor anyButtonPressed] whileFalse:[ - pt := Win32Point getCursorPos. - hWnd screenToClient: pt. - hDC lineTo: pt. - ]. - hWnd releaseDC: hDC. - Display forceToScreen.! Item was removed: - ----- Method: Win32Window>>apiGetDC: (in category 'api calls') ----- - apiGetDC: aHWND - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiGetParent: (in category 'api calls') ----- - apiGetParent: aWindow - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiGetWindowText:buffer:maxCount: (in category 'api calls') ----- - apiGetWindowText: handleWindow buffer: aBuffer maxCount: aNumber - - - self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiMessageBox:text:title:flags: (in category 'api calls') ----- - apiMessageBox: aHWND text: aString title: aTitle flags: flags - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiReleaseDC:with: (in category 'api calls') ----- - apiReleaseDC: aHWND with: aHDC - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiScreenToClient:with: (in category 'api calls') ----- - apiScreenToClient: aHWND with: aPOINT - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>apiSetWindowPosition:insertAfter:x:y:cx:cy:flags: (in category 'api calls') ----- - apiSetWindowPosition: handleWindow insertAfter: handleAfterWindow x: x y: y cx: cx cy: cy flags: flags - - - ^self primitiveFailed ! Item was removed: - ----- Method: Win32Window>>apiSetWindowText:text: (in category 'api calls') ----- - apiSetWindowText: handleWindow text: aString - - - ^self externalCallFailed! Item was removed: - ----- Method: Win32Window>>getDC (in category 'accessing') ----- - getDC - "Return the DC associated with the window" - ^self apiGetDC: self! Item was removed: - ----- Method: Win32Window>>getHDCDuring: (in category 'accessing') ----- - getHDCDuring: aBlock - "Provide a Win32 HDC during the execution of aBlock" - | hDC | - hDC := self getDC. - [aBlock value: hDC] ensure:[self releaseDC: hDC].! Item was removed: - ----- Method: Win32Window>>getParent (in category 'accessing') ----- - getParent - | wnd | - wnd := self apiGetParent: self. - ^wnd handle = 0 ifTrue:[nil] ifFalse:[wnd]! Item was removed: - ----- Method: Win32Window>>getWindowText: (in category 'api calls') ----- - getWindowText: handleWindow - "self new getWindowText: Win32Window getFocus" - - |buffer maxSize | - maxSize := 255. - buffer := ByteArray new: maxSize. - self apiGetWindowText: handleWindow buffer: buffer maxCount: maxSize. - ^buffer asString ! Item was removed: - ----- Method: Win32Window>>messageBox: (in category 'accessing') ----- - messageBox: aString - "Win32Window getFocus messageBox:'Hello World'" - ^self messageBox: aString title: 'Squeak'! Item was removed: - ----- Method: Win32Window>>messageBox:title: (in category 'accessing') ----- - messageBox: aString title: aTitle - "Win32Window getFocus messageBox:'Hello World' title:'News from Squeak:'" - ^self messageBox: aString title: aTitle flags: 0! Item was removed: - ----- Method: Win32Window>>messageBox:title:flags: (in category 'accessing') ----- - messageBox: aString title: aTitle flags: flags - "Win32Window getFocus messageBox:'Are you ready???' title:'News from Squeak:' flags: 3" - ^self apiMessageBox: self text: aString title: aTitle flags: flags! Item was removed: - ----- Method: Win32Window>>releaseDC: (in category 'accessing') ----- - releaseDC: aHDC - "Release the given DC" - self apiReleaseDC: self with: aHDC! Item was removed: - ----- Method: Win32Window>>screenToClient: (in category 'accessing') ----- - screenToClient: aPoint - self apiScreenToClient: self with: aPoint. - ^aPoint! From commits at source.squeak.org Thu May 27 07:38:44 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Thu, 27 May 2021 07:38:44 0000 Subject: [squeak-dev] FFI: FFI-MacOS-mt.7.mcz Message-ID: Marcel Taeumel uploaded a new version of FFI-MacOS to project FFI: http://source.squeak.org/FFI/FFI-MacOS-mt.7.mcz ==================== Summary ==================== Name: FFI-MacOS-mt.7 Author: mt Time: 27 May 2021, 9:38:37.994843 am UUID: c98e6ccf-2976-e641-9e41-5677a927e82c Ancestors: FFI-MacOS-mt.6 Empty commit. Package superseded by "FFI-Libraries" =============== Diff against FFI-MacOS-mt.6 =============== Item was removed: - SystemOrganization addCategory: #'FFI-MacOS-Examples'! Item was removed: - ExternalObject subclass: #MacOSShell - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-MacOS-Examples'! - - !MacOSShell commentStamp: 'spd 5/16/2010 22:33' prior: 0! - I show how system functions can be called from within the image. - - WARNING: Under Snow Leopard, the VM (as of 4.2.4 beta) only searches its Resources folder for external libraries. - - See http://wiki.squeak.org/squeak/5846 for workarounds.! Item was removed: - ----- Method: MacOSShell class>>escapeFileName: (in category 'utilities') ----- - escapeFileName: aFileName - - "Try to make the argument suitable for use in 'system'. - Just the simple stuff - backlash-prefix for obvious problems - quotes and white space." - - ^ String streamContents: [ : stream | - aFileName do: [ : char | - ('''" ()[]{}$&' includes: char) ifTrue: [ - stream nextPut: $\ - ]. - stream nextPut: char. - ]].! Item was removed: - ----- Method: MacOSShell>>getenv: (in category 'basics') ----- - getenv: aString - - self externalCallFailed! Item was removed: - ----- Method: MacOSShell>>system: (in category 'basics') ----- - system: aString - "Note that the command will foreground-block the VM unless it ends with &" - - self externalCallFailed.! Item was removed: - ExternalStructure subclass: #MacPixPatPtr - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-MacOS-Examples'! - - !MacPixPatPtr commentStamp: 'spd 5/16/2010 22:32' prior: 0! - See class comment for MacRect.! Item was removed: - ----- Method: MacPixPatPtr class>>fields (in category 'field definition') ----- - fields - "MacPixPatPtr defineFields" - "The following really means - typedef void* MacPixPatPtr; - " - ^#(nil 'void*') "For now this is just an opaque handle"! Item was removed: - ----- Method: MacPixPatPtr class>>newPixPat (in category 'instance creation') ----- - newPixPat - - ^self externalCallFailed! Item was removed: - ----- Method: MacPixPatPtr>>apiDisposePixPat: (in category 'api calls') ----- - apiDisposePixPat: aPixPat - - ^self externalCallFailed! Item was removed: - ----- Method: MacPixPatPtr>>apiMakeRGBPat:with: (in category 'api calls') ----- - apiMakeRGBPat: aPixPat with: aRGBColor - - ^self externalCallFailed! Item was removed: - ----- Method: MacPixPatPtr>>dispose (in category 'initialize-release') ----- - dispose - handle == nil ifFalse:[ - self apiDisposePixPat: self. - handle := nil. - ].! Item was removed: - ----- Method: MacPixPatPtr>>makeRGBPattern: (in category 'accessing') ----- - makeRGBPattern: aColor - ^self apiMakeRGBPat: self with: (MacRGBColor fromColor: aColor)! Item was removed: - ExternalStructure subclass: #MacPoint - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-MacOS-Examples'! - - !MacPoint commentStamp: 'spd 5/16/2010 22:32' prior: 0! - See class comment for MacRect.! Item was removed: - ----- Method: MacPoint class>>apiLineTo:with: (in category 'api calls') ----- - apiLineTo: x with: y - - ^self externalCallFailed! Item was removed: - ----- Method: MacPoint class>>apiMoveTo:with: (in category 'api calls') ----- - apiMoveTo: x with: y - - ^self externalCallFailed! Item was removed: - ----- Method: MacPoint class>>fields (in category 'field definition') ----- - fields - "MacPoint defineFields" - ^#( - (v 'short') - (h 'short') - )! Item was removed: - ----- Method: MacPoint class>>lineTo: (in category 'examples') ----- - lineTo: aPoint - "MacPoint moveTo: 0 at 0; lineTo: 100 at 100" - ^self apiLineTo: aPoint x with: aPoint y - ! Item was removed: - ----- Method: MacPoint class>>macDraw (in category 'examples') ----- - macDraw - "MacPoint macDraw" - | pt | - pt := self new. - pt getMousePoint. - self moveTo: pt. - [Sensor anyButtonPressed] whileFalse:[ - pt getMousePoint. - self lineTo: pt. - ]. - Display forceToScreen.! Item was removed: - ----- Method: MacPoint class>>moveTo: (in category 'examples') ----- - moveTo: aPoint - "MacPoint moveTo: 0 at 0; lineTo: 100 at 100" - ^self apiMoveTo: aPoint x with: aPoint y - ! Item was removed: - ----- Method: MacPoint>>apiGetMousePoint: (in category 'api calls') ----- - apiGetMousePoint: aMacPoint - - ^self externalCallFailed! Item was removed: - ----- Method: MacPoint>>getMousePoint (in category 'accessing') ----- - getMousePoint - ^self apiGetMousePoint: self! Item was removed: - ----- Method: MacPoint>>h (in category 'accessing') ----- - h - "This method was automatically generated. See MacPoint class>>fields." - - ^handle signedShortAt: 3! Item was removed: - ----- Method: MacPoint>>h: (in category 'accessing') ----- - h: anInteger - "This method was automatically generated. See MacPoint class>>fields." - - handle signedShortAt: 3 put: anInteger! Item was removed: - ----- Method: MacPoint>>v (in category 'accessing') ----- - v - "This method was automatically generated. See MacPoint class>>fields." - - ^handle signedShortAt: 1! Item was removed: - ----- Method: MacPoint>>v: (in category 'accessing') ----- - v: anInteger - "This method was automatically generated. See MacPoint class>>fields." - - handle signedShortAt: 1 put: anInteger! Item was removed: - ----- Method: MacPoint>>x (in category 'accessing') ----- - x - ^self h! Item was removed: - ----- Method: MacPoint>>x: (in category 'accessing') ----- - x: anObject - ^self h: anObject! Item was removed: - ----- Method: MacPoint>>y (in category 'accessing') ----- - y - ^self v! Item was removed: - ----- Method: MacPoint>>y: (in category 'accessing') ----- - y: anObject - ^self v: anObject! Item was removed: - ExternalStructure subclass: #MacRGBColor - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-MacOS-Examples'! - - !MacRGBColor commentStamp: 'spd 5/16/2010 22:31' prior: 0! - See class comment for MacRect.! Item was removed: - ----- Method: MacRGBColor class>>fields (in category 'field definition') ----- - fields - "MacRGBColor defineFields" - ^#( - (red 'ushort') - (green 'ushort') - (blue 'ushort') - )! Item was removed: - ----- Method: MacRGBColor class>>fromColor: (in category 'instance creation') ----- - fromColor: aColor - ^(self new) - red: (aColor red * 16rFFFF) rounded; - green: (aColor green * 16rFFFF) rounded; - blue: (aColor blue * 16rFFFF) rounded; - yourself! Item was removed: - ----- Method: MacRGBColor>>blue (in category 'accessing') ----- - blue - "This method was automatically generated. See MacRGBColor class>>fields." - - ^handle unsignedShortAt: 5! Item was removed: - ----- Method: MacRGBColor>>blue: (in category 'accessing') ----- - blue: anInteger - "This method was automatically generated. See MacRGBColor class>>fields." - - handle unsignedShortAt: 5 put: anInteger! Item was removed: - ----- Method: MacRGBColor>>green (in category 'accessing') ----- - green - "This method was automatically generated. See MacRGBColor class>>fields." - - ^handle unsignedShortAt: 3! Item was removed: - ----- Method: MacRGBColor>>green: (in category 'accessing') ----- - green: anInteger - "This method was automatically generated. See MacRGBColor class>>fields." - - handle unsignedShortAt: 3 put: anInteger! Item was removed: - ----- Method: MacRGBColor>>red (in category 'accessing') ----- - red - "This method was automatically generated. See MacRGBColor class>>fields." - - ^handle unsignedShortAt: 1! Item was removed: - ----- Method: MacRGBColor>>red: (in category 'accessing') ----- - red: anInteger - "This method was automatically generated. See MacRGBColor class>>fields." - - handle unsignedShortAt: 1 put: anInteger! Item was removed: - ExternalStructure subclass: #MacRect - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-MacOS-Examples'! - - !MacRect commentStamp: 'spd 5/16/2010 22:42' prior: 0! - I, with my friends (MacPixPatPtr, MacPoint and MacRGBColor), show how to make calls into a Mac OS framework. - - The particular library I use in my examples, QuickDraw, is depreciated in OS X 10.4, but the examples still run as of OS X 10.6.2 - See http://developer.apple.com/legacy/mac/library/documentation/Carbon/Reference/QuickDraw_Ref/Reference/reference.html for more information. - - WARNING: for Snow Leopard, see warning in MacOSShell! Item was removed: - ----- Method: MacRect class>>apiFillCOval:with: (in category 'api calls') ----- - apiFillCOval: r with: pat - - ^self externalCallFailed! Item was removed: - ----- Method: MacRect class>>apiFillCRect:with: (in category 'api calls') ----- - apiFillCRect: r with: pat - - ^self externalCallFailed! Item was removed: - ----- Method: MacRect class>>apiFrameOval: (in category 'api calls') ----- - apiFrameOval: r - - ^self externalCallFailed! Item was removed: - ----- Method: MacRect class>>apiFrameRect: (in category 'api calls') ----- - apiFrameRect: r - - ^self externalCallFailed! Item was removed: - ----- Method: MacRect class>>coloredEllipses (in category 'examples') ----- - coloredEllipses "MacRect coloredEllipses" - | rnd w h colors n r pat v0 v1 | - colors := Color colorNames collect:[:cName| (Color perform: cName)]. - "convert to PixPats" - colors := colors collect:[:c| MacPixPatPtr newPixPat makeRGBPattern: c]. - rnd := Random new. - w := Display width. - h := Display height. - n := 0. - r := MacRect new. - [Sensor anyButtonPressed] whileFalse:[ - pat := colors atRandom. - v0 := (rnd next * w) asInteger. - v1 := (rnd next * w) asInteger. - v0 < v1 ifTrue:[r left: v0; right: v1] ifFalse:[r left: v1; right: v0]. - v0 := (rnd next * h) asInteger. - v1 := (rnd next * h) asInteger. - v0 < v1 ifTrue:[r top: v0; bottom: v1] ifFalse:[r top: v1; bottom: v0]. - self apiFillCOval: r with: pat. - self apiFrameOval: r. - n := n + 1. - (n \\ 10) = 0 ifTrue:[n printString displayAt: 0 at 0]. - ]. - colors do:[:c| c dispose]. - Display forceToScreen.! Item was removed: - ----- Method: MacRect class>>coloredRectangles (in category 'examples') ----- - coloredRectangles "MacRect coloredRectangles" - | rnd w h colors n r pat v0 v1 nPixels time | - colors := Color colorNames collect:[:cName| (Color perform: cName)]. - "convert to PixPats" - colors := colors collect:[:c| MacPixPatPtr newPixPat makeRGBPattern: c]. - rnd := Random new. - w := Display width. - h := Display height. - n := 0. - r := MacRect new. - nPixels := 0. - time := Time millisecondClockValue. - [Sensor anyButtonPressed] whileFalse:[ - pat := colors atRandom. - v0 := (rnd next * w) asInteger. - v1 := (rnd next * w) asInteger. - v0 < v1 ifTrue:[r left: v0; right: v1] ifFalse:[r left: v1; right: v0]. - v0 := (rnd next * h) asInteger. - v1 := (rnd next * h) asInteger. - v0 < v1 ifTrue:[r top: v0; bottom: v1] ifFalse:[r top: v1; bottom: v0]. - self apiFillCRect: r with: pat. - self apiFrameRect: r. - n := n + 1. - nPixels := nPixels + ((r right - r left) * (r bottom - r top)). - (n \\ 100) = 0 ifTrue:[ - 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) - asStringWithCommas displayAt: 0 at 0]. - ]. - colors do:[:c| c dispose]. - Display forceToScreen.! Item was removed: - ----- Method: MacRect class>>fields (in category 'field definition') ----- - fields - "MacRect defineFields" - ^#( - (top 'short') - (left 'short') - (bottom 'short') - (right 'short') - )! Item was removed: - ----- Method: MacRect class>>macDraw (in category 'examples') ----- - macDraw - "MacRect macDraw" - ^MacPoint macDraw! Item was removed: - ----- Method: MacRect>>bottom (in category 'accessing') ----- - bottom - "This method was automatically generated. See MacRect class>>fields." - - ^handle signedShortAt: 5! Item was removed: - ----- Method: MacRect>>bottom: (in category 'accessing') ----- - bottom: anInteger - "This method was automatically generated. See MacRect class>>fields." - - handle signedShortAt: 5 put: anInteger! Item was removed: - ----- Method: MacRect>>left (in category 'accessing') ----- - left - "This method was automatically generated. See MacRect class>>fields." - - ^handle signedShortAt: 3! Item was removed: - ----- Method: MacRect>>left: (in category 'accessing') ----- - left: anInteger - "This method was automatically generated. See MacRect class>>fields." - - handle signedShortAt: 3 put: anInteger! Item was removed: - ----- Method: MacRect>>right (in category 'accessing') ----- - right - "This method was automatically generated. See MacRect class>>fields." - - ^handle signedShortAt: 7! Item was removed: - ----- Method: MacRect>>right: (in category 'accessing') ----- - right: anInteger - "This method was automatically generated. See MacRect class>>fields." - - handle signedShortAt: 7 put: anInteger! Item was removed: - ----- Method: MacRect>>top (in category 'accessing') ----- - top - "This method was automatically generated. See MacRect class>>fields." - - ^handle signedShortAt: 1! Item was removed: - ----- Method: MacRect>>top: (in category 'accessing') ----- - top: anInteger - "This method was automatically generated. See MacRect class>>fields." - - handle signedShortAt: 1 put: anInteger! From m at jaromir.net Sat May 29 06:59:27 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 01:59:27 -0500 (CDT) Subject: [squeak-dev] The Inbox: ToolsTests-jar.105.mcz In-Reply-To: <16f58705-deae-44c9-94f9-4633cac6dc55@MX2018-DAG2.hpi.uni-potsdam.de> References: <16f58705-deae-44c9-94f9-4633cac6dc55@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <1622271567433-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > Apart from their homogenous test names (ideally, one could grasp the idea > of a test just from its name), these tests look good to describe the > current situation. :-) Nevertheless, it might be wise to defer them until > we have decided on whether #abandon should really use #terminate, what do > you think? See [1]. > > Best, > Christoph > > [1] > http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-td5129800.html#a5130110 Yes indeed; depending on the outcome of [1] we can adjust the names and the contents. Thanks for taking a look at the tests. I wanted to learn to write them finally :) best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sat May 29 07:34:13 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 02:34:13 -0500 (CDT) Subject: [squeak-dev] The Inbox: KernelTests-jar.406.mcz In-Reply-To: <35301e9f-362b-403a-adbc-a2b145a39593@MX2018-DAG2.hpi.uni-potsdam.de> References: <35301e9f-362b-403a-adbc-a2b145a39593@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <1622273653519-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > Hi Jaromir, > > thanks for writing these tests! Just a few comments here: > > - #testTerminateInEnsure uses underscore assignments. This is a deprecated > syntax and apparently, in current Trunk images even disabled by default. > Without turning on my #allowUnderscoreAsAssignment preference, I cannot > even run the test in my image. Could you please convert this to modern > `:=` assignments? Thanks for noticing! That's a shame ;) I must have uploaded the original Cuis version I was testing (Juan brought my attention to the test). I'm testing #terminate in parallel in both Squeak and Cuis to catch potential irregularities (unfortunately Pharo diverged a bit too much for an "easy" parallel implementation). Christoph Thiede wrote > - Also, there is no guarantee that in #testTerminateInEnsure, process will > not have completed earlier, is it? This totally depends on the speed & > implementation of the VM. We don't want this test to fail when running on > a NSA machine or on your coffee machine in 2050, do we? ;P Did you > consider using semaphores instead? :-) This is the original Martin McClure's test, I didn't do any refinements yet but I share your concerns ;) Christoph Thiede wrote > - #testTerminateInTerminate is very fancy. :D Well, it gave me a real scare when I realized what happens when termination is interrupted and terminated in the middle. Fortunately the fix is so easy :) Thanks very much for your comments, best, > Best, > Christoph ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sat May 29 09:17:34 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 04:17:34 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: References: <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> <1621445932092-0.post@n4.nabble.com> <1621869528589-0.post@n4.nabble.com> Message-ID: <1622279854421-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote >> > Instead of reinventing the unwinding wheel in Process, I reused the >> existing logic from Context which is important deduplication. >> Well, actually I didn't reinvent the unwind pattern but intentionally >> reused it with as few changes as possible - I think it improves >> readability because people easily recognize this pattern from #resume:, >> #resume:through:, #unwindTo and even the previous #terminate used the >> exact same pattern for > an active process termination. Besides, using the same pattern for > achieving a similar goal feels "safer" to me. > > A pattern is good, but reusing the same code is even better. :-) I still > see some signification duplication between #runUntilErrorOrReturnFrom: and > #runUnwindUntilErrorOrReturnFrom: as well as between Process >> #terminate > and Context >> #unwindTo:. But Kernel-jar.1411 already is a good step into > the right direction as far as I can tell. :-) Yes, I was wondering why I couldn't get rid of the duplication and now I think it's because there really are two distinct unwind semantics : one "light" for regular returns and one "heavy" for termination. Both are very similar yet each require a slightly different behavior - that's why the duality #runUntilErrorOrReturnFrom / #runUnwindUntilErrorOrReturnFrom or #complete: / #complete:to: and #unwindTo: / #terminate. With regards to #unwindTo: - I haven't tested it yet but I'm wondering whether it wouldn't have the same unwind problem with non-local returns as the original #terminate and require a similar fix? Christoph Thiede wrote > What remains unacceptable or dangerous to me are your hard-coded > exceptions in Process >> #complete:to:. If this is crucial to prevent > akwards infinite recursions, we might not be immune against similar > incidents for other kinds of recursion as well. Object >> #at:, for > example, is no better than Object >> #doesNotUnderstand:. Actually, any > exception or exception handler might produce a similar behavior. Could you > provide a few concrete examples where this check is needed? Maybe we can > find a more holistic solution to this issue. Yes, this bothers me as well. I consider two common sources of infinite recursions: (1) MessageNotUnderstood - #doesNotUnderstand is intentionally written so that it resends the unknown message to facilitate writing new methods while debugging. So for the moment to recover termination from this error I suggested to deal with it on an individual basis - i.e. skip the unwind block with the error. (and yes, you're right this only applies to the "heavy" version of unwinding) (2) BlockCannonReturn - we'll discuss this in [2] But in general - yes, any method/exception purposefully (or not) written to create a loop will break this patch (I admit it is just a patch really). I extracted it to #complete:to: to make #terminate clean; this is a WIP; I wish there was a holistic solution to this - maybe checking for exception recursion by default? :) Christoph Thiede wrote >> Again, I wanted to make as few changes as possible; but agreed absolutely >> :) > > That is also a very reasonable goal which I had to learn myself the hard > way. :) Keep going! :-) > > Best, > Christoph [1] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-tp5129800p5130110.html [2] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-tp5129706p5130114.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sat May 29 09:38:40 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 04:38:40 -0500 (CDT) Subject: [squeak-dev] stepping over non local return in a protected block In-Reply-To: <683cf64d-952c-4c37-9f45-7392ff2aa77b@MX2018-DAG2.hpi.uni-potsdam.de> References: <1620845299641-0.post@n4.nabble.com> <1621972319412-0.post@n4.nabble.com> <683cf64d-952c-4c37-9f45-7392ff2aa77b@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <1622281120751-0.post@n4.nabble.com> Christoph Thiede wrote > Hi Jaromir, > >> > \2: This was indeed a slip because I forgot to update the image. I have >> moved my patch to #findNextHandlerContext - it makes the method robust >> against bottom-contexts that do not have a sender (i.e., sender is nil). >> >> The changeset still seems to have the old version of >> #runUntilErrorOrReturnFrom: and #nextHandlerContext nixing Nicolas's >> changes made in the meantime... > > Version 8 removes roerf finally. :-) But I could not find any trace of > #nextHandlerContext in the current changeset, did you maybe forget to > revert the previous version before loading v7? yes indeed, I forgot to remove the previous version, sorry for confusion, everything's fine :) Christoph Thiede wrote >> What would you think about this approach: because #return:from: supplies >> the first unwind context for #aboutToReturn:through: prematurely, how >> about to supply nil instead of the first unwind context and let >> #resume:through: find the first unwind context at precisely the right >> time? > > Correct me if I'm wrong, but this only would move the problem again, > wouldn't it? If you press over too late, we would have the same problem > again? I'd still prefer a holistic approach such as my > #informDebuggerAboutContextSwitchTo: proposal. Or did miss anything > different with your proposal? :-) Well, I thought the fix really solved the bug, not just pushed it further away :) I couldn't reproduce the incorrect stepOver behavior any longer but I may have missed some example - do you have something in mind? I'll comment further in [1]; I hope I'm not wrong here - please send a counterexample if you find one :) best, Jaromir Christoph Thiede wrote > Best, > Christoph [1] http://forum.world.st/BUG-REGRESSION-while-debugging-Generator-gt-gt-nextPut-td5108125i20.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From lewis at mail.msen.com Sat May 29 13:02:08 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Sat, 29 May 2021 09:02:08 -0400 Subject: [squeak-dev] The Inbox: KernelTests-jar.406.mcz In-Reply-To: <1622273653519-0.post@n4.nabble.com> References: <35301e9f-362b-403a-adbc-a2b145a39593@MX2018-DAG2.hpi.uni-potsdam.de> <1622273653519-0.post@n4.nabble.com> Message-ID: <20210529130208.GA22765@shell.msen.com> Hi Jaromir, On Sat, May 29, 2021 at 02:34:13AM -0500, Jaromir Matas wrote: > Hi Christoph, > > > Christoph Thiede wrote > > Hi Jaromir, > > > > thanks for writing these tests! Just a few comments here: > > > > - #testTerminateInEnsure uses underscore assignments. This is a deprecated > > syntax and apparently, in current Trunk images even disabled by default. > > Without turning on my #allowUnderscoreAsAssignment preference, I cannot > > even run the test in my image. Could you please convert this to modern > > `:=` assignments? > > Thanks for noticing! That's a shame ;) I must have uploaded the original > Cuis version I was testing (Juan brought my attention to the test). I'm > testing #terminate in parallel in both Squeak and Cuis to catch potential > irregularities (unfortunately Pharo diverged a bit too much for an "easy" > parallel implementation). > You may not need it for the work you are doing, but it is worth knowing that the FixUnderscores utility can be used for updating from _ to := assignments without losing the original author stamps. You can find it on SqueakMap. From the world menu, open a SqueakMap Catalog browser. Right-click on the left side panel and de-select the "New safely-available packages" box. Scroll down the long list of packages until you find FixUnderscores. Install version 1.0, and ignore any warnings about compatibility. Once installed you can use the FixUnderscores>>fixPackage: method to update the underscores in an given package. For moving code the other way from Squeak to Cuis, you can use any convenient text editor (such as vi on unix) to replace all occurencees of := with _. You also will want to convert to line endings for Cuis conventions, which you can do with unix sed or directly in the Cuis file browser before filing in the code. Dave From m at jaromir.net Sat May 29 15:26:28 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 10:26:28 -0500 (CDT) Subject: [squeak-dev] The Inbox: KernelTests-jar.406.mcz In-Reply-To: <20210529130208.GA22765@shell.msen.com> References: <35301e9f-362b-403a-adbc-a2b145a39593@MX2018-DAG2.hpi.uni-potsdam.de> <1622273653519-0.post@n4.nabble.com> <20210529130208.GA22765@shell.msen.com> Message-ID: <1622301988301-0.post@n4.nabble.com> Hi David, David T. Lewis wrote > Hi Jaromir, > > On Sat, May 29, 2021 at 02:34:13AM -0500, Jaromir Matas wrote: >> Hi Christoph, >> >> >> Christoph Thiede wrote >> > Hi Jaromir, >> > >> > thanks for writing these tests! Just a few comments here: >> > >> > - #testTerminateInEnsure uses underscore assignments. This is a >> deprecated >> > syntax and apparently, in current Trunk images even disabled by >> default. >> > Without turning on my #allowUnderscoreAsAssignment preference, I cannot >> > even run the test in my image. Could you please convert this to modern >> > `:=` assignments? >> >> Thanks for noticing! That's a shame ;) I must have uploaded the original >> Cuis version I was testing (Juan brought my attention to the test). I'm >> testing #terminate in parallel in both Squeak and Cuis to catch potential >> irregularities (unfortunately Pharo diverged a bit too much for an "easy" >> parallel implementation). >> > > You may not need it for the work you are doing, but it is worth knowing > that the FixUnderscores utility can be used for updating from _ to := > assignments without losing the original author stamps. > > You can find it on SqueakMap. From the world menu, open a SqueakMap > Catalog browser. Right-click on the left side panel and de-select the > "New safely-available packages" box. Scroll down the long list of > packages until you find FixUnderscores. Install version 1.0, and ignore > any warnings about compatibility. > > Once installed you can use the FixUnderscores>>fixPackage: method to > update the underscores in an given package. > > For moving code the other way from Squeak to Cuis, you can use any > convenient text editor (such as vi on unix) to replace all occurencees > of := with _. You also will want to convert > > to > > line endings > for Cuis conventions, which you can do with unix sed or directly in > the Cuis file browser before filing in the code. > > Dave Cool, thanks! (and thanks, Vanessa) I now see Squeak automatically replaces underscores in the copy/pasted or filed-in code - but only for viewing; the source still contains the original underscores (that's why I unwittingly uploaded the test with underscores...). I've now tried to file-in with underscores -> see := in the browser -> file out and underscores still there. So the tool really comes in handy here and preserving the original author/timestamp is cool too. Thanks again. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sat May 29 19:31:13 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 14:31:13 -0500 (CDT) Subject: [squeak-dev] The semantics of halfway-executed unwind contexts during process termination In-Reply-To: <0c864182-c785-45ed-9420-454b2cf8ed7f@MX2018-DAG2.hpi.uni-potsdam.de> References: <1621288837863-0.post@n4.nabble.com> <1621447461345-0.post@n4.nabble.com> <0c864182-c785-45ed-9420-454b2cf8ed7f@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <1622316673785-0.post@n4.nabble.com> Hi Christoph, > Jaromir, your proposal to provide multiple selectors for modeling separate > modes of termination sounds like a very good idea to me. But how many > different modes do we actually need? So far I can count three modes: > > (i) run no unwind contexts (harshest possible way; currently only > achievable by doing "suspendedContext privSender: nil" prior to > terminating) > (ii) run not-yet started unwind contexts (this is what I proposed in > fix-Process-terminate.1.cs [1]) > (iii) run all unwind contexts, including those that already have been > started (this is the most friendly way that you implemented in #terminate > recently) I think this is it. Litereally minutes ago had to use privSender: nil to get rid of a debugger :) Fully terminate really is too strong to recover from fatal errors. > ... my point here is: Proceeding from an error almost always doesn't seem > "right". :-) It is always a decision by the debugging programmer to > override the default control flow and switch to the "next plausible > alternative control flow", i.e., resume as if the error would have never > been raised. yes - I'd add: even an error may quite often be completely benign, like 'Transcript show: 1/0' - possibly a typo so you just may want to Proceed or fully terminate. In case the error damages a whole subsequent chain of events, you're absolutely right a full termination seems a silly option and a light version of terminate may be the most appropriate. So I fully agree the decision which termination mode it is stays with the user - so I'm all for giving the user the choices you suggested. > \1. Which mode should we use in which situations? > > I think this debate could benefit from a few more concrete usage > scenarios. I'm just collecting some here (thinking aloud): > > \- Process Browser: We can provide multiple options in the process menu. > \- Debugger: I agree with you that Abandon should always run not-yet > started unwind contexts but never resume halfway-executed unwind contexts. > So this maps to to mode (ii) from above. > \- Skimming through most senders of #terminate in the image, they often > orchestrate helper processes, deal with unhandled errors or timeouts, or > do similar stuff - usually they should be very fine with the friendly > version of #terminate, i.e. mode (iii) from above. I think. > \- Regarding option (1), I think you would need it extremely seldom but > maybe in situations like when your stack contains a loop, your unwind > contexts will cause a recursion/new error, or you deliberately want to > prevent any unwind context from running. No objections against adding a > small but decent button for this in the debugger. :-) > > Would you agree with these behaviors? Maybe you can add further examples > to the list? Yes Process Browser - the right click menu could provide all options Debugger - Abandon could be the lightweight version you proposed. Why not have a proper Abandon button for it? The right click menu on a context could offer the Kill option (next to 'peel to first like this'); no button necessary. Now the question is what should be under the "window close" red-circle-x - heavyweight terminate? I'm thinking this scenario: if the debugger returns after closing the window you start thinking what happened and use Abandon; if it still doesn't help you go right-click and kill it? My usual scenario is (limited experience however): look at something in the debugger (on a healthy process) and close the window (i.e. full termination is appropriate and I'd even say preferable). If something goes wrong - then I'd welcome a hint there are options - thus the proper Abandon button - what do you think? > \2. How should we name them? > > Direct proposal: (i) #kill and (iii) #terminate. > After looking up the original behavior of #terminate in Squeak 5.3, I > think it would be consistent to resume all halfway-executed unwind > contexts in this method. So yes, I also withdraw my criticism about > #testNestedUnwind. :-) > > But I don't have any good idea for version (ii) yet. Call it #abandon like > in the debugger? Then again, #abandon is rather a verb from the Morphic > language. Further possible vocables (according to my synonym thesaurus) > include #end, #stop, #finish, #unwind, #abort, #exit. Please help... :-) I'd probably go with something like #terminateLight because it's a proper process termination including unwinds except the ones currently in progress - so it is a light version of #terminate :) I've checked VisualWorks: they chose #terminateUnsafely for this type of termination which I don't like much, it sounds too negative; the real meaning is rather #terminateAsSafelyAsPossibleGivenTheCircumstances ;). I'm wondering whether #unwindTo: (used ony by Generator) is bugged (with regard to dealing with non-local returns), and could be fixed/unified with your approach. Look at these examples: ``` p := [[Processor activeProcess suspend] valueUninterruptably] fork. Processor yield. p suspendedContext unwindTo: nil ``` or ``` p := [[:exit | [Processor activeProcess suspend] ensure: [exit value]] valueWithExit] fork. Processor yield. p suspendedContext unwindTo: nil ``` If you do `p terminate` instead of `p suspendedContext unwindTo: nil`, it works fine, but #unwindTo causes a block cannot return error - I think it's the same bug all over again :) #value evaluates the non-local return on the wrong stack... Regarding our cannot return discussion - I have to think about it and I'll post my reply later in [1] to keep it separate :) Thanks again and regards, [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html#a5130114 ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Sat May 29 21:03:40 2021 From: m at jaromir.net (Jaromir Matas) Date: Sat, 29 May 2021 16:03:40 -0500 (CDT) Subject: [squeak-dev] Tackling Context>>#runUntilErrorReturnFrom: (was: BUG/REGRESSION while debugging Generator >> #nextPut:) In-Reply-To: <1621102291419-0.post@n4.nabble.com> References: <9ed2db8e40684297b83d98e311e76a4b@student.hpi.uni-potsdam.de> <25a67367ce4f4ee68d0509659cb10c72@student.hpi.uni-potsdam.de> <1615231296272-0.post@n4.nabble.com> <1615566932862-0.post@n4.nabble.com> <1620851547306-0.post@n4.nabble.com> <1621102291419-0.post@n4.nabble.com> Message-ID: <1622322220251-0.post@n4.nabble.com> Hi Christoph, Christoph Thiede wrote > Hi all, hi Jaromir, > > with regard to the bug mentioned in [1], I have updated the changeset from > above: runUntilErrorOrReturnFrom.cs > <http://forum.world.st/file/t372205/runUntilErrorOrReturnFrom.cs> > > Basically, I inserted a send to #informDebuggerAboutContextSwitchTo: in > the > loop body of Context >> #resume:through: as well. > > I could not find any regressions from the previous changeset, but since > this > is a very low-level method, any crash tests will be appreciated. I believe > that in the past a similar approach has crashed my image, but I could not > reproduce this any longer today ... > > I am also - still :-) - very excited to hear your feedback and thoughts on > the general approach. In my message from above, I have highlighted two > bold > questions, it would be great if some of our Kernel experts could find a > few > minutes for them. Nicolas? Eliot? Jaromir? :-) > > Best, > Christoph > > [1] > http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html > > > > ----- > Carpe Squeak! > -- > Sent from: http://forum.world.st/Squeak-Dev-f45488.html Unless I'm mistaken I believe the issue from [1] is just a bug described in [2], not a general issue. The implementation simply forgot to consider the inserted guard contexts and can be fixed fully (I hope) by amending #resume:through: and #return:from: as proposed in [1]. In such case including #resume:through: in your changeset is not necessary. You're addressing here a fundamental problem stemming from manipulating contexts by #jump, #swapSender (and who knows what else) breaking the linear order of context chains. On one hand it's amazing you can catch and deal with those situations, on the other hand there are "false positives", I mean catching harmless jumps and stopping the debugger unexpectedly e.g. during debugging regular #terminate using "well behaving" jumps :) I'm wondering: would it be possible to somehow recognize "harmless" or "well known" jumps so that the changeset can let them be and only interrupt "unknown" patterns or those somehow recognized as dangerous? This is a very interesting problem and I look forward to your further discoveries :) best regards, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From jrmaffeo at gmail.com Sun May 30 02:26:26 2021 From: jrmaffeo at gmail.com (John-Reed Maffeo) Date: Sat, 29 May 2021 19:26:26 -0700 Subject: [squeak-dev] Squeak5.3-19 fails to open on Raspberry Pi Message-ID: Tested using Squeak5.3-19 for a fresh installation of RAS[BERRY PI OS (32-BIT) obtained using Raspberry Pi Imager v.1.6.1 The squeak install file was downloaded from: http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip NOTE: Squeak5.2-18234-32bit-201810190412-ARMv6.zip does not have this issue. --- command start pi at raspberrypi:~/Squeak5.3-19435-32bit-202003021730-ARMv6 $ ./squeak.sh Using /home/pi/Squeak5.3-19435-32bit-202003021730-ARMv6/bin/squeak... pthread_setschedparam failed: Operation not permitted This VM uses a separate heartbeat thread to update its internal clock and handle events. For best operation, this thread should run at a higher priority, however the VM was unable to change the priority. The effect is that heavily loaded systems may experience some latency issues. If this occurs, please create the appropriate configuration file in /etc/security/limits.d/ as shown below: cat <setGCParameters 0xd3a9d0: a(n) SmalltalkImage 0x7e8a67e8 I SmalltalkImage>snapshot:andQuit:withExitCode:embedded: 0xd3a9d0: a(n) SmalltalkImage 0x31d16d0 s SmalltalkImage>snapshot:andQuit:embedded: 0x31d26f8 s SmalltalkImage>snapshot:andQuit: 0x31d27b8 s [] in ReleaseBuilder class>saveAndQuit 0x31d2890 s WorldState>runStepMethodsIn: 0x31d2920 s PasteUpMorph>runStepMethods 0x31d29f0 s WorldState>doOneCycleNowFor: 0x31d2a50 s WorldState>doOneCycleFor: 0x31d2ac0 s PasteUpMorph>doOneCycle 0x31d2b20 s [] in MorphicProject>spawnNewProcess 0x31d2b80 s [] in BlockClosure>newProcess Most recent primitives basicNew size at: basicNew: decompress:fromByteArray:at: beCursorWithMask: vmParameterAt: fractionPart truncated stack page bytes 4096 available headroom 2788 minimum unused headroom 3740 (Recursive not understood error encountered) Aborted -------------- next part -------------- An HTML attachment was scrubbed... URL: From jakres+squeak at gmail.com Sun May 30 07:59:47 2021 From: jakres+squeak at gmail.com (Jakob Reschke) Date: Sun, 30 May 2021 09:59:47 +0200 Subject: [squeak-dev] Unable to load class with pool dictionary using Monticello In-Reply-To: References: <748b4244e2c04673bd6d439cf9cb042e@student.hpi.uni-potsdam.de> Message-ID: Hi Christoph, Thiede, Christoph schrieb am Sa., 29. Mai 2021, 01:25: > > In other words, your shared pool should indeed be a class. It doesn’t > matter for using it, but it does matter for loading it reliably. > > Hmm, I am pretty sure that this would confuse Squot (which is also based > on Monticello) ... > > Why do you think so? The fact that it is still based on Monticello in that regard would imply to me that the class as pool dictionary approach should be better there too. Kind regards, Jakob -------------- next part -------------- An HTML attachment was scrubbed... URL: From m at jaromir.net Sun May 30 16:50:52 2021 From: m at jaromir.net (Jaromir Matas) Date: Sun, 30 May 2021 11:50:52 -0500 (CDT) Subject: [squeak-dev] The Inbox: Kernel-ct.1405.mcz In-Reply-To: <8d483880-3b69-4f7a-be0d-c6824d6b965a@MX2018-DAG2.hpi.uni-potsdam.de> References: <1621087561864-0.post@n4.nabble.com> <1621113654445-0.post@n4.nabble.com> <1621599766501-0.post@n4.nabble.com> <8d483880-3b69-4f7a-be0d-c6824d6b965a@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <1622393452836-0.post@n4.nabble.com> Hi Christoph, > > ... my point here is: Proceeding from an error almost always doesn't seem > "right". :-) It is always a decision by the debugging programmer to > override the default control flow and switch to the "next plausible > alternative control flow", i.e., resume as if the error would have never > been raised. Applied to the attempt to return from a method, for me, this > means to ignore the return (thinking of it in message sends: to ignore the > "thisContext (home) return"). Yeah, and if there is no further statement > after that return, my best understanding of the user's intention to > "proceed" would be to return to the place from where the block has been > invoked ... Agreed :) The more I think about it the more I like it ;) And well, the non-local return could have been a typo anyways... so actually, this makes the best sense and preserves all options open for the user - perfect! > Also, can you convince me why you would need some extra state in the > exception for this? No, I hated adding an extra state :) The only thing I really need for the full #terminate to work correctly is a way to distinguish between normal proceeding the computation and resuming the unwind procedure when the BlockCannotReturn error occurs inside an unwind block currently being evaluated. All I need then is a Warning the computation proceeds beyond the BlockCannotReturn; here's what I mean: ``` cannotReturn: result closureOrNil ifNotNil: [ | resumptionValue | resumptionValue := self cannotReturn: result to: self home sender. ProceedBlockCannotReturn new signal: 'This block has ended, continue with sender?'. self pc > self endPC ifTrue: [ "This block has ended, continue with sender" thisContext privSender: self sender]. ^ resumptionValue]. Processor debugWithTitle: 'Computation has been terminated!' translated full: false ``` So if you're fine with this addition, full #terminate would recognize when it's beyond BlockCannotReturn and would continue unwinding the non-local return accordingly. I think it's useful to warn the user about such an unusual (and new) option as Proceeding safely beyond BlockCannotReturn anyway :) > > Argh, here is another example which does not yet match my expectations: > ``` > sender := thisContext swapSender: nil. > true ifTrue: [^ 1]. "Proceed the BlockCannotReturn" > thisContext privSender: sender. > ^ 2 > ``` > I think this should eventually answer 2. Apparently, the VM already has > reset the pc in this example so we are helpless here. There's something wrong with this example :) (or my understanding of it) 1) if you print-it or do-it you get Computation terminated instead of Block cannot return 2) so I wrapped it in [] value ``` [sender := thisContext swapSender: nil. true ifTrue: [^ 1]. "Proceed the BlockCannotReturn" thisContext privSender: sender. ^ 2] value ``` Now it raises BlockCannotReturn and returns 2 with your changeset (if Proceeded)... BUT if you debug it and: A) step through the ^1 - you get Message not understood B) step into ^1 - you don't get any error and can happily continue I'm confused... Many thanks for your comments and your proposed solution to cannot return; I'll update #terminate and remove my previous attempts from the Inbox. best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From tim at rowledge.org Sun May 30 18:17:22 2021 From: tim at rowledge.org (tim Rowledge) Date: Sun, 30 May 2021 11:17:22 -0700 Subject: [squeak-dev] Squeak5.3-19 fails to open on Raspberry Pi In-Reply-To: References: Message-ID: <54D3351C-AC31-4CEE-8631-C0512B1B3970@rowledge.org> As it happens I've just done a completely fresh load on an old Pi. J-R is correct - this doesn't work. > On 2021-05-29, at 7:26 PM, John-Reed Maffeo wrote: > > Tested using Squeak5.3-19 for a fresh installation of RAS[BERRY PI OS (32-BIT) obtained using Raspberry Pi Imager v.1.6.1 > > The squeak install file was downloaded from: > http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip So, first observation in my case - Chrome stinks. Go ti squeak.org and click on the initial link that claims to download the ARMv6 linux system and .... nothing happens at all. Go to the downloads page and try there. Nothing happens at all. Is that a problem with our page code? Or just that, as mentioned above, Chrome is junk? I eventually got a download from the files.squeak.org page, via the 5.3/Squeak5.3-19435-32bit/ directory. And here we stumble across another longstanding issue with unix stuff. Just where should the files go? And how do we (ie not-expert users) get them there? The zip file seems to be setup such that it will just create a directory named after the zip file and drop everything there. Given the bin/lib/shared directory names I can't help thinking that files are really intended to go to... what /usr/bin, /usr/lib, /usr/shared ? Or /usr/local etc? Or /var etc? Where? I realise the primary intent of unix has always been to destroy people's dreams but this stuff just infuriates me. So, let's say we just accept the irritating Squeak5.3-19435-32bit-blahblahblah directory name and open a terminal there. I'd say there really ought to be a README of some sort right there to give new users a clue. Let's try running squeak.sh for grins - ooh, it actually has permissions set, so that's good ... BOOM. Right, so there is the rtprio thing. This annoys me because I am certain from my older notes that we didn't used to have a problem with this on Raspbian. It has also become a real issue on the ubuntu systems I have to use for work - where ubuntu appears to flat out refuse to pay attention to the /etc/security/limits.d file Is there no way we can manage this better? Some install process script that does the check and creates the file and requests the user do the reboot thing? I note that the apt-get install package/script/doohickey provided by RPF does this. > > Recursive not understood error encountered > > /home/pi/Squeak5.3-19435-32bit-202003021730-ARMv6/bin/squeak > Squeak VM version: 5.0-202003021730 Tue Mar 3 09:42:45 UTC 2020 gcc 4.9.2 [Production Spur VM] > Built from: CoInterpreter VMMaker.oscog-nice.2712 uuid: da64ef0b-fb0a-4770-ac16-f9b448234615 Mar 3 2020 > With: StackToRegisterMappingCogit VMMaker.oscog-eem.2719 uuid: e40f3e94-3a54-411b-9613-5d19114ea131 Mar 3 2020 > Revision: VM: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git > Date: Mon Mar 2 18:30:55 2020 CommitHash: 6a0bc96 > Plugins: 202003021730 https://github.com/OpenSmalltalk/opensmalltalk-vm.git > Build host: Linux travis-job-97835d24-79f4-41d1-b7e9-c81bd8bf7149 4.4.0-104-generic #127~14.04.1-Ubuntu SMP Mon Dec 11 12:44:15 UTC 2017 armv7l GNU/Linux > plugin path: /home/pi/Squeak5.3-19435-32bit-202003021730-ARMv6/bin/ [default: /home/pi/Squeak5.3-19435-32bit-202003021730-ARMv6/bin/] This is a VM bug that got fixed. The fixed VM really ought to be included in the 5.3 package and the squeak.org pages updated. My email records tell me we solved this on or about March 20 2020. The 19435 zip package claims to date from 16 April 2020, so evidently something happened to prevent the fixed VM from getting in there? I see that even in the http://files.squeak.org/5.3/Squeak5.3-19458-32bit/Squeak5.3-19458-32bit-202003021730-ARMv6.zip the VM is the broken 202003021730 version. What did we screw up and what can we do to fix it ASAP? tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: RDL: Rotate Disk Left From commits at source.squeak.org Sun May 30 18:18:11 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Sun, 30 May 2021 18:18:11 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1413.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1413.mcz ==================== Summary ==================== Name: Kernel-jar.1413 Author: jar Time: 30 May 2021, 8:18:06.050183 pm UUID: 0d967c44-059c-f140-bbe1-ccff3f237457 Ancestors: Kernel-nice.1402 fix a bug in #return:from: preventing the debugger to correctly step over a non-local return in a protected block like this: [^2] ensure: [Transcript cr; show: 'done']. Stepping over ^2 or the subsequent #return:through or #resume:through: erroneously raised a BlockCannotReturn error. The error is described in detail in Kernel-nice.1407 and discussed in http://forum.world.st/stepping-over-non-local-return-in-a-protected-block-td5128777.html =============== Diff against Kernel-nice.1402 =============== Item was changed: ----- Method: Context>>resume:through: (in category 'controlling') ----- resume: value through: firstUnwindCtxt "Unwind thisContext to self and resume with value as result of last send. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext." | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: value to: self]. + ctxt := firstUnwindCtxt ifNil: [thisContext findNextUnwindContextUpTo: self]. - ctxt := firstUnwindCtxt. [ctxt isNil] whileFalse: [(ctxt tempAt: 2) ifNil: [ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. thisContext terminateTo: ctxt. unwindBlock value]. ctxt := ctxt findNextUnwindContextUpTo: self]. thisContext terminateTo: self. ^value ! Item was changed: ----- Method: Context>>return:from: (in category 'instruction decoding') ----- return: value from: aSender "For simulation. Roll back self to aSender and return value from it. Execute any unwind blocks on the way. ASSUMES aSender is a sender of self" | newTop | aSender isDead ifTrue: [^self send: #cannotReturn: to: self with: {value}]. newTop := aSender sender. (self findNextUnwindContextUpTo: newTop) ifNotNil: + [^self send: #aboutToReturn:through: to: self with: {value. nil}]. - [:unwindProtectCtxt| - ^self send: #aboutToReturn:through: to: self with: {value. unwindProtectCtxt}]. self releaseTo: newTop. newTop ifNotNil: [newTop push: value]. ^newTop! From asqueaker at gmail.com Mon May 31 02:55:17 2021 From: asqueaker at gmail.com (Chris Muller) Date: Sun, 30 May 2021 21:55:17 -0500 Subject: [squeak-dev] Scroll-wheel via RFB? Message-ID: Does anyone know how to make RFB responsive to the scroll wheel? This is essential to be able to develop in a remote headless image. Thanks. - Chris From lecteur at zogotounga.net Mon May 31 07:36:04 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Mon, 31 May 2021 09:36:04 +0200 Subject: [squeak-dev] [Sounds] How to turn off reverb In-Reply-To: <22fe19c9-3cec-494a-a881-8178aa81f6d8@MX2018-DAG2.hpi.uni-potsdam.de> References: <213da47a86954bcabcf978c225daa628@student.hpi.uni-potsdam.de> <22fe19c9-3cec-494a-a881-8178aa81f6d8@MX2018-DAG2.hpi.uni-potsdam.de> Message-ID: <4644e414-1b2f-90a8-5413-03af5208cdf6@zogotounga.net> > FMSound brass1 play > > And I have to tell that, both with default and without reverb, I can hear the abrupt end of the sound very clearly. Well without reverb there is a definitely non-musical harsh noise. With reverb on, the sound still does stop abruptly, but more musically. This makes all the difference to me. But I do agree that overall the FMSounds releases are not graceful :) > IMHO it does not make a large difference, except for the fact that a pure tone should not have any reverb by definition. A FMSound is not a pure tone. A pure tone is a sinusoid, which ends with a clear click (a very non-musical noise). Now anyway the reverb is used only when playing a sound, not when processing it - here it is not part of the FMSound itself: you will not see the reverb in the waveform or the spectrogram. From a musical perspective, there is always some reverb. Nobody plays a concerto in an anechoic chamber. So you can think of the default reverb setting as the sound of the Squeak room itself - when just playing sounds like, for a game, it is nicer to have one. And when we need Squeak to behave like an anechoic chamber, we can just turn the reverb off. > > I am not an expert in sounds at all, but couldn't it be a more elegant solution to adjust the envelopes of the problematic sounds instead and to extend their release phase? > > I changed #brass1 like this: > > | snd p env | > snd := FMSound new modulation: 0 ratio: 1. > p := OrderedCollection new. > - p add: 0 at 0.0; add: 30 at 0.8; add: 90 at 1.0; add: 120 at 0.9; add: 220 at 0.7; add: 320 at 0.9; add: 360 at 0.0. > + p add: 0 at 0.0; add: 30 at 0.8; add: 90 at 1.0; add: 120 at 0.9; add: 220 at 0.7; add: 320 at 0.9; add: 440 at 0.0. > snd addEnvelope: (VolumeEnvelope points: p loopStart: 4 loopEnd: 6). > > p := OrderedCollection new. > p add: 0 at 0.5; add: 60 at 1.0; add: 120 at 0.8; add: 220 at 0.65; add: 320 at 0.8; add: 360 at 0.0. > env := Envelope points: p loopStart: 3 loopEnd: 5. > env target: snd; updateSelector: #modulation:; scale: 5.0. > snd addEnvelope: env. > > (snd setPitch: 220.0 dur: 1.0 loudness: 0.5) play > > The only difference is that I moved the last envelope point 80 ms to the right. I can't hear any "plop" now any longer. Right, but the duration of the sound cannot be considered to be one second anymore - it is much closer to 0.9 seconds (where it was around 0.95 before, so already too short). See the attached pictures: SoundElementEditor1.png is the current waveform, SoundElementEditor2.png the one you propose. See how it ends prematurely? I would say 390 at 0.0 for the last point is better. It still sounds good, but does not shorten the sound as much. For composition, it is important that a sound lasts as long as it claims to last. Else, the phrasing articulations cannot be right - you would hear a staccato when a legato is asked for. So a sound release should happen after the sound nominal duration (which is not the case at the moment) > My proposal is to turn off reverb in the SoundPlayer by default and to adjust the most problematic FMSounds manually instead. What do you think? :-) My counter-proposal would be to keep the default reverb and give it the settings it has in muO :) And then, if you want to tweak some sounds, have their nominal duration respected. So I would vote for having releases after nominal duration, but this means a mechanism would then be needed to differentiate the nominal duration from the duration you get from the raw number of samples. This mechanism exists in muO. In fact it is rather difficult for me to give any specific piece of advice about how music should be handled in Squeak proper, because my own way to do this has been to implement a much vaster and deeper framework where many different perspectives work together. Not to say it is perfect, but it is thorough - one thing lead to another and I could talk for hours... Best, Stef -------------- next part -------------- A non-text attachment was scrubbed... Name: SoundElementEditor1.png Type: image/png Size: 6969 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: SoundElementEditor2.png Type: image/png Size: 6950 bytes Desc: not available URL: From lewis at mail.msen.com Mon May 31 14:55:05 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Mon, 31 May 2021 10:55:05 -0400 Subject: [squeak-dev] Squeak5.3-19 fails to open on Raspberry Pi In-Reply-To: <54D3351C-AC31-4CEE-8631-C0512B1B3970@rowledge.org> References: <54D3351C-AC31-4CEE-8631-C0512B1B3970@rowledge.org> Message-ID: <20210531145505.GA68628@shell.msen.com> On Sun, May 30, 2021 at 11:17:22AM -0700, tim Rowledge wrote: > As it happens I've just done a completely fresh load on an old Pi. J-R is correct - this doesn't work. > > > > On 2021-05-29, at 7:26 PM, John-Reed Maffeo wrote: > > > > Tested using Squeak5.3-19 for a fresh installation of RAS[BERRY PI OS (32-BIT) obtained using Raspberry Pi Imager v.1.6.1 > > > > The squeak install file was downloaded from: > > http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip > > So, first observation in my case - Chrome stinks. Go ti squeak.org and click on the initial link that claims to download the ARMv6 linux system and .... nothing happens at all. Go to the downloads page and try there. Nothing happens at all. Is that a problem with our page code? Or just that, as mentioned above, Chrome is junk? > > I eventually got a download from the files.squeak.org page, via the 5.3/Squeak5.3-19435-32bit/ directory. > I notice that there is a newer one on files.squeak.org. Assuming that the newer one works, it may be that the only problem is that our download button is pointing here: http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip but it should instead be this: http://files.squeak.org/5.3/Squeak5.3-19458-32bit/Squeak5.3-19458-32bit-202003021730-ARMv6.zip Dave From bruce.oneel at pckswarms.ch Mon May 31 15:43:07 2021 From: bruce.oneel at pckswarms.ch (Bruce O'Neel) Date: Mon, 31 May 2021 17:43:07 +0200 Subject: [squeak-dev] Squeak5.3-19 fails to open on Raspberry Pi In-Reply-To: <20210531145505.GA68628@shell.msen.com> References: <54D3351C-AC31-4CEE-8631-C0512B1B3970@rowledge.org> <20210531145505.GA68628@shell.msen.com> Message-ID: HI, Sadly the 19458 version has the same problem.  It is a VM problem and it's the same VM. cheers bruce On 2021-05-31T16:55:05.000+02:00, David T. Lewis wrote: > On Sun, May 30, 2021 at 11:17:22AM -0700, tim Rowledge wrote: >>  As it happens I've just done a completely fresh load on an old Pi. >>  J-R is correct - this doesn't work. >>   >>>   On 2021-05-29, at 7:26 PM, John-Reed Maffeo  >>>   wrote: >>>    >>>   Tested using Squeak5.3-19 for a fresh installation of RAS[BERRY >>>   PI OS (32-BIT) obtained using Raspberry Pi Imager v.1.6.1 >>>    >>>   The squeak install file was downloaded from: >>>   files.squeak.org/5.3/Squeak... >>>   [http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip] >>   >>  So, first observation in my case - Chrome stinks. Go ti squeak.org >>  and click on the initial link that claims to download the ARMv6 >>  linux system and .... nothing happens at all. Go to the downloads >>  page and try there. Nothing happens at all. Is that a problem with >>  our page code? Or just that, as mentioned above, Chrome is junk? >>   >>  I eventually got a download from the files.squeak.org page, via >>  the 5.3/Squeak5.3-19435-32bit/ directory. >  > I notice that there is a newer one on files.squeak.org. Assuming > that the newer one works, it may be that the only problem is that > our download button is pointing here: > files.squeak.org/5.3/Squeak... > [http://files.squeak.org/5.3/Squeak5.3-19435-32bit/Squeak5.3-19435-32bit-202003021730-ARMv6.zip] >  > but it should instead be this: > files.squeak.org/5.3/Squeak... > [http://files.squeak.org/5.3/Squeak5.3-19458-32bit/Squeak5.3-19458-32bit-202003021730-ARMv6.zip] >  > Dave -------------- next part -------------- An HTML attachment was scrubbed... URL: From Christoph.Thiede at student.hpi.uni-potsdam.de Mon May 31 15:54:50 2021 From: Christoph.Thiede at student.hpi.uni-potsdam.de (Thiede, Christoph) Date: Mon, 31 May 2021 15:54:50 +0000 Subject: [squeak-dev] Speech.sar is missing Message-ID: <29b21719adf749ce848df158d43d852e@student.hpi.uni-potsdam.de> Hi all, I tried to load the Speech package from SqueakMap into a current Trunk image, but the installation fails because the Speech-Phonetics category seems to be missing in the SAR package. Would it be possible to update the SAR with this package or is the dependency structure more complicated than I am assuming? Thanks in advance! Best, Christoph -------------- next part -------------- An HTML attachment was scrubbed... URL: From lewis at mail.msen.com Mon May 31 16:20:57 2021 From: lewis at mail.msen.com (David T. Lewis) Date: Mon, 31 May 2021 12:20:57 -0400 Subject: [squeak-dev] Speech.sar is missing In-Reply-To: <29b21719adf749ce848df158d43d852e@student.hpi.uni-potsdam.de> References: <29b21719adf749ce848df158d43d852e@student.hpi.uni-potsdam.de> Message-ID: <20210531162057.GA79806@shell.msen.com> Hi Christoph, On Mon, May 31, 2021 at 03:54:50PM +0000, Thiede, Christoph wrote: > Hi all, > > > I tried to load the Speech package from SqueakMap into a current Trunk > image, but the installation fails because the Speech-Phonetics category > seems to be missing in the SAR package. Would it be possible to update > the SAR with this package or is the dependency structure more complicated > than I am assuming? > I don't know if this helps, but you can download a copy of the SAR file: $ wget http://wiki.squeak.org/squeak/uploads/651/Speech.sar The file will be in zip format, so you can unzip it to work with the Smalltalk files directly. The Speech package was included in early Squeak images, so you may want to try running some old images from files.squeak.org on SqueakJS (http://try.squeak.org) to find out how it originally worked. IIRC it requires the Klatt plugin to do sound generation. That plugin is not included in any of our current VMs, and it was probably never updated to run on 64-bit systems, so it may be a challenge to get Speech running on current Trunk. Dave From tim at rowledge.org Mon May 31 16:52:32 2021 From: tim at rowledge.org (tim Rowledge) Date: Mon, 31 May 2021 09:52:32 -0700 Subject: [squeak-dev] Squeak5.3-19 fails to open on Raspberry Pi In-Reply-To: References: <54D3351C-AC31-4CEE-8631-C0512B1B3970@rowledge.org> <20210531145505.GA68628@shell.msen.com> Message-ID: > On 2021-05-31, at 8:43 AM, Bruce O'Neel wrote: > > HI, > > Sadly the 19458 version has the same problem. It is a VM problem and it's the same VM. Yup. Somehow after working out the fix we failed to put the fixed VM into the package. tim -- tim Rowledge; tim at rowledge.org; http://www.rowledge.org/tim Strange OpCodes: HEM: Hide Evidence of Malfunction From lecteur at zogotounga.net Mon May 31 18:46:55 2021 From: lecteur at zogotounga.net (=?UTF-8?Q?St=c3=a9phane_Rollandin?=) Date: Mon, 31 May 2021 20:46:55 +0200 Subject: [squeak-dev] Speech.sar is missing In-Reply-To: <29b21719adf749ce848df158d43d852e@student.hpi.uni-potsdam.de> References: <29b21719adf749ce848df158d43d852e@student.hpi.uni-potsdam.de> Message-ID: <6c1aa55a-ab2a-bbb7-24b0-70351c4d7274@zogotounga.net> Speech is included in muO. You can fetch a ready-to-go image there: http://www.zogotounga.net/comp/squeak/sqgeo.htm Stef From duke.j.david at gmail.com Mon May 31 20:49:01 2021 From: duke.j.david at gmail.com (David Duke) Date: Mon, 31 May 2021 21:49:01 +0100 Subject: [squeak-dev] Balloon3D? Message-ID: Following links from the Baloon3d page on squeak.org: http://map.squeak.org/package/178bd01c-f698-41ab-9c73-d9278c65c241/default there are/were versions for (1-1.0.3 , 2-1.0.4 ) --however both links end on pages with broken links to sars Baloon3d home also has a dead link to a 'Balloon3D' removal package. Qs: is there a copy of the original Baloon3D packages out there somewhere that might be used to build a new package, or is it necessary/desirable to start again? - any papers or design info that capture key decisions? I'm aware that 3D on Squeak was in a way supeceded by Croquet/Cobalt However that has a rather different use-case. - I'm not too bothered by h/w acceleration. - an elegant/customisable renderer is of more interest so happy to have more of it in Smalltalk provided speed is tolerable thanks, David Duke -------------- next part -------------- An HTML attachment was scrubbed... URL: From vanessa at codefrau.net Mon May 31 21:10:03 2021 From: vanessa at codefrau.net (Vanessa Freudenberg) Date: Mon, 31 May 2021 14:10:03 -0700 Subject: [squeak-dev] Balloon3D? In-Reply-To: References: Message-ID: https://www.squeaksource.com/Balloon3D.html ... but nobody has looked at it in a long time, and the "Squeak3D" plugin is not part of the current VM builds I think. It certainly has not been ported to 64 bits. That plugin contains the non-h/w accelerated primitives. I don't think it works without those primitives (even though with today's JIT VM it might even be usable). Vanessa On Mon, May 31, 2021 at 1:49 PM David Duke wrote: > Following links from the Baloon3d page on squeak.org: > http://map.squeak.org/package/178bd01c-f698-41ab-9c73-d9278c65c241/default > there are/were versions for (1-1.0.3 > > , 2-1.0.4 > > ) > --however both links end on pages with broken links to sars > > Baloon3d home also has a dead link to a 'Balloon3D' removal package. > > Qs: is there a copy of the original Baloon3D packages out there somewhere > that > might be used to build a new package, or is it necessary/desirable to > start again? > - any papers or design info that capture key decisions? > > I'm aware that 3D on Squeak was in a way supeceded by Croquet/Cobalt > However that has a rather different use-case. > - I'm not too bothered by h/w acceleration. > - an elegant/customisable renderer is of more interest so happy to have > more of > it in Smalltalk provided speed is tolerable > > thanks, > David Duke > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From commits at source.squeak.org Mon May 31 21:20:01 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 31 May 2021 21:20:01 0000 Subject: [squeak-dev] The Inbox: KernelTests-jar.407.mcz Message-ID: A new version of KernelTests was added to project The Inbox: http://source.squeak.org/inbox/KernelTests-jar.407.mcz ==================== Summary ==================== Name: KernelTests-jar.407 Author: jar Time: 31 May 2021, 11:19:58.858017 pm UUID: 8bb4554a-971d-ea49-9396-6a0c1625fb5b Ancestors: KernelTests-nice.404 Add a test #testTerminateInEnsure presented by Martin McClure at 2019 Smalltalk conference. Test unwind when a process gets terminated inside the #ensure unwind block. Complement latest #terminate in the Inbox. Supersede KernelTests-jar.405 - fix underscores from Cuis =============== Diff against KernelTests-nice.404 =============== Item was added: + ----- Method: ProcessTest>>testTerminateInEnsure (in category 'tests') ----- + testTerminateInEnsure + "As shown in + Martin McClure's 'Threads, Critical Sections, and Termination' (Smalltalks 2019 conference) + https://youtu.be/AvM5YrjK9AE + at 23:17 + self new testTerminateInEnsure + " + | process count random delay | + random := Random new. + 10 timesRepeat: [ + process := [ + count := 0. + [] ensure: [ + 10 timesRepeat: [ + count := count + 1. + 1000000 timesRepeat: [12 factorial]]. + count := count + 1] + ] forkAt: Processor activeProcess priority - 1. + delay := (random next * 100) asInteger + 10. "avoid 0-ms delay" + (Delay forMilliseconds: delay) wait. + self assert: process isTerminated not. + process terminate. + process priority: Processor activeProcess priority + 1. + self + assert: process isTerminated; + assert: count equals: 11 ]! From commits at source.squeak.org Mon May 31 21:29:38 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 31 May 2021 21:29:38 0000 Subject: [squeak-dev] The Inbox: Tests-jar.466.mcz Message-ID: A new version of Tests was added to project The Inbox: http://source.squeak.org/inbox/Tests-jar.466.mcz ==================== Summary ==================== Name: Tests-jar.466 Author: jar Time: 31 May 2021, 11:29:34.089017 pm UUID: 3f2953a1-9d10-a044-88af-c9019346c388 Ancestors: Tests-jar.463 Add a set of tests for nested unwind semantics during termination. Complement latest #terminate in the Inbox. Supersede Tests-jar.465 - add a small improvement - terminate from a helper process =============== Diff against Tests-jar.463 =============== Item was added: + TestCase subclass: #ProcessTerminateUnwindTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-Exceptions'! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminateEnsureAsTopContext (in category 'tests') ----- + testTerminateEnsureAsTopContext + "Test #ensure unwind block is executed even when #ensure context is on stack's top." + + | p1 p2 p3 x1 x2 x3 | + x1 := x2 := x3 := false. + + "p1 is at the beginning of the ensure block and the unwind block hasn't run yet" + p1 := Process + forBlock: [[] ensure: [x1 := x1 not]] + runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) isNil]]. + + "p2 has already set complete to true (tempAt: 2) but the unwind block hasn't run yet" + p2 := Process + forBlock: [[] ensure: [x2 := x2 not]] + runUntil: [:ctx | ctx isUnwindContext and: [(ctx tempAt: 2) notNil]]. + + "p3 has already set complete to true AND the unwind block has run already run; + we have to verify the unwind block is not executed again during termination" + p3 := Process + forBlock: [[] ensure: [x3 := x3 not]] + runUntil: [:ctx | ctx isUnwindContext and: [ctx willReturn]]. + + "make sure all processes are running and only the p3's unwind block has finished" + self deny: p1 isTerminated | p2 isTerminated | p3 isTerminated. + self deny: x1 | x2. + self assert: x3. "p3 has already run its unwind block; we test it won't run it again" + "terminate all processes and verify all unwind blocks have finished correctly" + p1 terminate. p2 terminate. p3 terminate. + self assert: p1 isTerminated & p2 isTerminated & p3 isTerminated. + self assert: x1 & x2 & x3! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind1 (in category 'tests') ----- + testTerminationDuringNestedUnwind1 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind2 (in category 'tests') ----- + testTerminationDuringNestedUnwind2 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind3 (in category 'tests') ----- + testTerminationDuringNestedUnwind3 + "Terminate runnable process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor yield] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind4 (in category 'tests') ----- + testTerminationDuringNestedUnwind4 + "Terminate runnable process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor yield. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isRunnable. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind5 (in category 'tests') ----- + testTerminationDuringNestedUnwind5 + "Terminate active process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [Processor activeProcess terminate] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now let the termination continue and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind6 (in category 'tests') ----- + testTerminationDuringNestedUnwind6 + "Terminate active process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + Processor activeProcess terminate. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p suspended itself and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now let the termination continue and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind7 (in category 'tests') ----- + testTerminationDuringNestedUnwind7 + "Terminate blocked process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 semaphore | + x1 := x2 := x3 := x4 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [semaphore wait] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwind8 (in category 'tests') ----- + testTerminationDuringNestedUnwind8 + "Terminate blocked process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 semaphore | + x1 := x2 := x3 := x4 := false. + semaphore := Semaphore new. + p := + [ + [ + [ ] ensure: [ + [ ] ensure: [ + semaphore wait. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] newProcess. + p resume. + Processor yield. + "make sure p is runnable and none of the unwind blocks has finished yet" + self assert: p isBlocked. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn1 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn1 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true. return value]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x3. + self deny: x2 & x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn2 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn2 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true. return value]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x3. + self deny: x2 & x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn3 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn3 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true. return value] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn4 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn4 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true. return value] + ] ensure: [ + x3 := true]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn5 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn5 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true. return value]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn6 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn6 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true. return value]. + x4 := true. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn7 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn7 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [Processor activeProcess suspend] ensure: [ + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. return value. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! Item was added: + ----- Method: ProcessTerminateUnwindTests>>testTerminationDuringNestedUnwindWithReturn8 (in category 'tests') ----- + testTerminationDuringNestedUnwindWithReturn8 + "Terminate suspended process. + Test all nested unwind blocks are correctly unwound; + all unwind blocks halfway through their execution should be completed." + + | p x1 x2 x3 x4 | + x1 := x2 := x3 := x4 := false. + p := + [ + [:return | + [ + [ ] ensure: [ + [] ensure: [ + Processor activeProcess suspend. + x1 := true]. + x2 := true] + ] ensure: [ + x3 := true]. + x4 := true. return value. + ] valueWithExit + ] newProcess. + p resume. + Processor yield. + "make sure p is suspended and none of the unwind blocks has finished yet" + self assert: p isSuspended. + self deny: x1 | x2 | x3 | x4. + "now terminate the process and make sure all unwind blocks have finished" + [p terminate] forkAt: Processor activePriority + 1. + self assert: p isTerminated. + self assert: x1 & x2 & x3. + self deny: x4.! From commits at source.squeak.org Mon May 31 21:39:39 2021 From: commits at source.squeak.org (commits at source.squeak.org) Date: Mon, 31 May 2021 21:39:39 0000 Subject: [squeak-dev] The Inbox: Kernel-jar.1414.mcz Message-ID: A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1414.mcz ==================== Summary ==================== Name: Kernel-jar.1414 Author: jar Time: 31 May 2021, 11:39:35.749017 pm UUID: f300b29f-3257-e049-b139-8c05240cb97f Ancestors: Kernel-jar.1413 finalize #terminate: solution: - integrate Christoph's solution of BlockCannotReturn's infinite recursion problem - solve a situation when a process gets terminated in the middle of unwinding another process - supersede and replace Kernel-jar.1412 and Kernel-jar.1411 - complemented by: KernelTests-jar.406, KernelTests-jar.407, Tests-jar.466, ToolsTests-jar.105 Please remove Kernel-jar.1412, Kernel-jar.1411, KernelTests-jar.405, Tests-jar.465 from the Inbox. Summary and discussion about the bugs and changes in #terminate: http://forum.world.st/Solving-multiple-termination-bugs-summary-amp-proposal-td5128285.html =============== Diff against Kernel-jar.1413 =============== Item was changed: ----- Method: Context>>cannotReturn: (in category 'private-exceptions') ----- cannotReturn: result + closureOrNil ifNotNil: [ + | resumptionValue | + resumptionValue := self cannotReturn: result to: self home sender. + ProceedBlockCannotReturn new signal: 'This block has ended, continue with sender?'. + self pc > self endPC ifTrue: [ + "This block has ended, continue with sender" + thisContext privSender: self sender]. + ^ resumptionValue]. - closureOrNil ifNotNil: [^ self cannotReturn: result to: self home sender]. Processor debugWithTitle: 'Computation has been terminated!!' translated full: false.! Item was added: + ----- Method: Context>>runUnwindUntilErrorOrReturnFrom: (in category 'private') ----- + runUnwindUntilErrorOrReturnFrom: aSender + "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." + "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." + + | error ctxt here topContext | + here := thisContext. + + "Insert ensure and exception handler contexts under aSender" + error := nil. + ctxt := aSender insertSender: (Context + contextOn: UnhandledError do: [:ex | + error ifNil: [ + error := ex exception. + topContext := thisContext. + here jump. + ex signalerContext restart "re-signal the error when jumped back"] + ifNotNil: [ex pass] + ]). + ctxt := ctxt insertSender: (Context + contextEnsure: [error ifNil: [ + topContext := thisContext. + here jump] + ]). + self jump. "Control jumps to self" + + "Control resumes here once above ensure block or exception handler is executed" + ^ error ifNil: [ + "No error was raised, return the sender of the above ensure context (see Note 1)" + {ctxt sender. nil} + + ] ifNotNil: [ + "Error was raised, remove inserted above contexts then return signaler context" + aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" + {topContext. error} + ] + + "Note 1: It doesn't matter 'ctxt sender' is not a proper top context because #terminate will use it only as a starting point in the search for the next unwind context and computation will never return here. Removing the inserted ensure context (i.e. ctxt) by stepping until popped (as in #runUntilErrorOrReturnFrom:) when executing non-local returns is not applicable here and would fail testTerminationDuringNestedUnwindWithReturn1 through 4."! Item was added: + Warning subclass: #ProceedBlockCannotReturn + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Exceptions'! Item was added: + ----- Method: Process>>complete:to: (in category 'private') ----- + complete: topContext to: aContext + "Run topContext on behalf of self on topContext's stack until aContext is popped or an unhandled + error is raised. Return self's new top context. Note: topContext must be a stack top context. + This method is meant to be called primarily by Process>>#terminate." + + | pair top error | + pair := Processor activeProcess + evaluate: [topContext runUnwindUntilErrorOrReturnFrom: aContext] + onBehalfOf: self. + top := pair first. + error := pair second. + "If an error was detected jump back to the debugged process and re-signal the error; + some errors may require a special care - see notes below." + error ifNotNil: [ + error class == ProceedBlockCannotReturn ifTrue: [^top]. "do not jump back" + error class == MessageNotUnderstood ifTrue: [error initialize]. "reset reachedDefaultHandler" + top jump]. + ^top + + "Note 1: To prevent an infinite recursion of the MessageNotUnderstood error, reset reachedDefaultHandler before jumping back; this will prevent #doesNotUnderstand: from resending the unknown message. + Note 2; To prevent returning from the BlockCannotReturn error, do not jump back when ProceedBlockCannotReturn warning has been raised."! Item was changed: ----- Method: Process>>terminate (in category 'changing process state') ----- terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating. If the process is in the middle of a critical: critical section, release it properly." + | oldList top ctxt outerMost newTop unwindBlock | + "If terminating the active process, suspend it first and terminate it as a suspended process." - | ctxt unwindBlock oldList outerMost | self isActiveProcess ifTrue: [ - "If terminating the active process, suspend it first and terminate it as a suspended process." [self terminate] fork. ^self suspend]. + [] ensure: ["Execute termination as an unwind block to ensure it completes even if terminated; + see testTerminateInTerminate." + "Always suspend the process first so it doesn't accidentally get woken up. + N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al + then the process is blocked, and if it is nil then the process is already suspended." + oldList := self suspend. + suspendedContext ifNil: [^self]. "self is already terminated" + "Release any method marked with the pragma. + The argument is whether the process is runnable." + self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). - "Always suspend the process first so it doesn't accidentally get woken up. - N.B. If oldList is a LinkedList then the process is runnable. If it is a Semaphore/Mutex et al - then the process is blocked, and if it is nil then the process is already suspended." - oldList := self suspend. - suspendedContext ifNotNil: - ["Release any method marked with the pragma. - The argument is whether the process is runnable." - self releaseCriticalSection: (oldList isNil or: [oldList class == LinkedList]). + top := suspendedContext. + suspendedContext := nil. "disable this process while running its stack in active process below" "If terminating a process halfways through an unwind, try to complete that unwind block first; + if there are multiple such nested unwind blocks, try to complete the outer-most one; nested + unwind blocks will be completed in the process (see testTerminationDuringUnwind, testNestedUnwind). + Note: Halfway-through blocks have already set the complete variable (tempAt: 2) in their defining + #ensure:/#ifCurtailed contexts from nil to true; we'll search for the bottom-most one. + Note: #findNextUnwindContextUpTo: starts searching from the receiver's sender but the receiver + itself may be an unwind context (see testTerminateEnsureAsTopContext)." + ctxt := top. + ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. + [ctxt isNil] whileFalse: [ + (ctxt tempAt:2) ifNotNil: [ + outerMost := ctxt]. + ctxt := ctxt findNextUnwindContextUpTo: nil]. + outerMost ifNotNil: [newTop := self complete: top to: outerMost]. - if there are multiple such nested unwind blocks, try to complete the outer-most one; the inner - blocks will be completed in the process." - ctxt := suspendedContext. - [(ctxt := ctxt findNextUnwindContextUpTo: nil) isNil] whileFalse: - "Contexts under evaluation have already set their complete (tempAt: 2) to true." - [(ctxt tempAt:2) ifNotNil: [outerMost := ctxt]]. - outerMost ifNotNil: [ - "This is the outer-most unwind context currently under evaluation; - let's find an inner context executing outerMost's argument block (tempAt: 1)" - (suspendedContext findContextSuchThat: [:ctx | - ctx closure == (outerMost tempAt: 1)]) ifNotNil: [:inner | - "Let's finish the unfinished unwind context only (i.e. up to inner) and return here" - suspendedContext runUntilErrorOrReturnFrom: inner. - "Update the receiver's suspendedContext (the previous step reset its sender to nil); - return, if the execution stack reached its bottom (e.g. in case of non-local returns)." - (suspendedContext := outerMost sender) ifNil: [^self]]]. + "By now no halfway-through unwind blocks are on the stack. Create a new top context for each + pending unwind block (tempAt: 1) and execute it on the unwind block's stack. + Note: using #value instead of #complete:to: would lead to incorrect evaluation of non-local returns. + Note: newTop sender points to the former outerMost sender, i.e. the next unexplored context." + ctxt := newTop ifNil: [top] ifNotNil: [newTop sender]. - "Now all unwind blocks caught halfway through have been completed; - let's execute the ones still pending. Note: #findNextUnwindContextUpTo: starts - searching from the receiver's sender but the receiver itself may be an unwind context." - ctxt := suspendedContext. ctxt isUnwindContext ifFalse: [ctxt := ctxt findNextUnwindContextUpTo: nil]. [ctxt isNil] whileFalse: [ (ctxt tempAt: 2) ifNil: [ ctxt tempAt: 2 put: true. unwindBlock := ctxt tempAt: 1. + top := unwindBlock asContextWithSender: ctxt. + self complete: top to: top]. + ctxt := ctxt findNextUnwindContextUpTo: nil] + ]! - "Create a context for the unwind block and execute it on the unwind block's stack. - Note: using #value instead of #runUntilErrorOrReturnFrom: would lead to executing - the unwind on the wrong stack preventing the correct execution of non-local returns." - suspendedContext := unwindBlock asContextWithSender: ctxt. - suspendedContext runUntilErrorOrReturnFrom: suspendedContext]. - ctxt := ctxt findNextUnwindContextUpTo: nil]. - - "Reset the context's pc and sender to nil for the benefit of isTerminated." - suspendedContext terminate]! From m at jaromir.net Mon May 31 21:59:25 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 31 May 2021 16:59:25 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1622279854421-0.post@n4.nabble.com> References: <1618126794263-0.post@n4.nabble.com> <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> <1621445932092-0.post@n4.nabble.com> <1621869528589-0.post@n4.nabble.com> <1622279854421-0.post@n4.nabble.com> Message-ID: <1622498365411-0.post@n4.nabble.com> Hi All, I've sent an updated version of #teminate integrating Christoph's solution of BlockCannotReturn recursion problem (in [1]), along with a battery of tests exploring termination of nested ensure and cascading errors behavior (Debugger tests are for info and a final version can wait until releasing Christoph's proposal in [2]). It's pretty much final, I hope... Any complaints about #terminate - please shout ;) [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html [2] http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-tp5129800p5130110.html best, ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html From m at jaromir.net Mon May 31 22:01:46 2021 From: m at jaromir.net (Jaromir Matas) Date: Mon, 31 May 2021 17:01:46 -0500 (CDT) Subject: [squeak-dev] Solving multiple termination bugs - summary & proposal In-Reply-To: <1622498365411-0.post@n4.nabble.com> References: <1619375410272-0.post@n4.nabble.com> <1620672559968-0.post@n4.nabble.com> <1620820041440-0.post@n4.nabble.com> <1620855596237-0.post@n4.nabble.com> <1621271371954-0.post@n4.nabble.com> <1621445932092-0.post@n4.nabble.com> <1621869528589-0.post@n4.nabble.com> <1622279854421-0.post@n4.nabble.com> <1622498365411-0.post@n4.nabble.com> Message-ID: <1622498506402-0.post@n4.nabble.com> Jaromir Matas wrote > Hi All, > I've sent an updated version of #teminate integrating Christoph's solution > of BlockCannotReturn recursion problem (in [1]), along with a battery of > tests exploring termination of nested ensure and cascading errors behavior > (Debugger tests are for info and a final version can wait until releasing > Christoph's proposal in [2]). > > It's pretty much final, I hope... > > Any complaints about #terminate - please shout ;) > > [1] http://forum.world.st/The-Inbox-Kernel-ct-1405-mcz-td5129706.html > [2] > http://forum.world.st/The-semantics-of-halfway-executed-unwind-contexts-during-process-termination-tp5129800p5130110.html > > best, Here's the link: http://forum.world.st/The-Inbox-Kernel-jar-1414-mcz-td5130198.html ----- ^[^ Jaromir -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html