Packages April 2021

packages@lists.squeakfoundation.org

1 participants
226 discussions

The Trunk: KernelTests-nice.403.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.403.mcz ==================== Summary ==================== Name: KernelTests-nice.403 Author: nice Time: 30 April 2021, 10:07:18.128533 pm UUID: 6c2a630e-15b7-461c-8bdc-86190918cc71 Ancestors: KernelTests-nice.402 Add two tests for isDenormal and isFinite =============== Diff against KernelTests-nice.402 =============== Item was added: + ----- Method: FloatTest>>testIsDenormal (in category 'tests - characterization') ----- + testIsDenormal + self assert: Float fminNormalized predecessor isDenormal. + self assert: Float fminDenormalized isDenormal. + self assert: Float fminDenormalized negated isDenormal. + + self deny: Float fminNormalized isDenormal. + self deny: 0.0 isDenormal. + self deny: 1.0 isDenormal. + self deny: Float fmax isDenormal. + self deny: Float infinity isDenormal. + self deny: Float negativeInfinity isDenormal. + self deny: Float nan isDenormal.! Item was added: + ----- Method: FloatTest>>testIsFinite (in category 'tests - characterization') ----- + testIsFinite + self assert: Float fminDenormalized isFinite. + self assert: 0.0 isFinite. + self assert: Float pi negated isFinite. + self assert: Float fmax isFinite. + + self deny: Float infinity isFinite. + self deny: Float negativeInfinity isFinite. + self deny: Float nan isFinite.!

1 0

The Trunk: Kernel-nice.1397.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1397.mcz ==================== Summary ==================== Name: Kernel-nice.1397 Author: nice Time: 30 April 2021, 9:48:57.972338 pm UUID: df20ab21-bba8-4919-b4a1-d2c7a6c6e8de Ancestors: Kernel-mt.1396, Kernel-jar.1395 merge Kernel-jar.1395 (fix outer) =============== Diff against Kernel-mt.1396 =============== Item was changed: ----- Method: Exception>>outer (in category 'handling') ----- outer "Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)." + | prevOuterContext currHandlerContext | - | prevOuterContext | self isResumable ifTrue: [ + currHandlerContext := handlerContext. prevOuterContext := outerContext. outerContext := thisContext contextTag. ]. self pass. ! 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." | 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 ]. !

1 0

The Trunk: Kernel-jar.1395.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-jar.1395.mcz ==================== Summary ==================== Name: Kernel-jar.1395 Author: jar Time: 30 April 2021, 12:25:17.561362 am UUID: 0f589a20-6b8e-a94b-9dbc-9b3f91c84ce8 Ancestors: Kernel-nice.1394 Fix a bug in Exception>>#outer causing a return to an incorrect handler context. Explanation in: http://forum.world.st/A-bug-in-Exception-gt-gt-outer-causing-a-return-to-an… =============== Diff against Kernel-nice.1394 =============== Item was changed: ----- Method: Exception>>outer (in category 'handling') ----- outer "Evaluate the enclosing exception action and return to here instead of signal if it resumes (see #resumeUnchecked:)." + | prevOuterContext currHandlerContext | - | prevOuterContext | self isResumable ifTrue: [ + currHandlerContext := handlerContext. prevOuterContext := outerContext. outerContext := thisContext contextTag. ]. self pass. ! 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." | 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 ]. !

1 0

The Trunk: Tests-nice.460.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-nice.460.mcz ==================== Summary ==================== Name: Tests-nice.460 Author: nice Time: 30 April 2021, 9:36:50.260749 pm UUID: 2996ccbb-9955-4399-ace4-4a61c14fc0d0 Ancestors: Tests-nice.459 Integrate test from Jaromir showing the expected behavior of outer. Thanks Jaromir. See https://source.squeak.org/treated/Tests-jar.454.diff https://source.squeak.org/treated/Tests-jar.455.diff https://source.squeak.org/treated/Tests-jar.456.diff =============== Diff against Tests-nice.459 =============== Item was added: + ----- Method: ExceptionTester>>doubleOuterTestResults (in category 'signaledException results') ----- + doubleOuterTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleOuterDefaultReturnTest (in category 'signaledException tests') ----- + simpleOuterDefaultReturnTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse" + self doSomethingExceptional] + on: MyTestNotification + do: [:ex | ex outer]. self doSomethingElse] + on: MyTestNotification + do: [:ex | self doYetAnotherThing. ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleOuterDefaultReturnTestResults (in category 'signaledException results') ----- + simpleOuterDefaultReturnTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTester>>simpleOuterReturnTest (in category 'signaledException tests') ----- + simpleOuterReturnTest + "uses #resume" + + [[self doSomething. + MyTestNotification signal. + "self doSomethingElse" + self doSomethingExceptional] + on: MyTestNotification + do: [:ex | ex outer. ex return]. self doSomethingElse] + on: MyTestNotification + do: [:ex | self doYetAnotherThing. ex resume]! Item was added: + ----- Method: ExceptionTester>>simpleOuterReturnTestResults (in category 'signaledException results') ----- + simpleOuterReturnTestResults + + ^OrderedCollection new + add: self doSomethingString; + add: self doYetAnotherThingString; + add: self doSomethingElseString; + yourself! Item was added: + ----- Method: ExceptionTests>>testDoubleOuterDoubleResumeTest (in category 'tests - ExceptionTester') ----- + testDoubleOuterDoubleResumeTest + + | path | + path := ''. + [path := path, '1'. + [path := path, '2'. + [1/0] on: ZeroDivide do: [:ex | ex outer. path := path, '5'. ex return]. + path := path, '6' + ] on: ZeroDivide do: [:ex | ex outer. path := path, '4'. ex resume]. + path := path, '7' + ] on: ZeroDivide do: [:ex | path := path, '3'. ex resume]. + self assert: path = '1234567'! Item was added: + ----- Method: ExceptionTests>>testDoubleOuterTest (in category 'tests - ExceptionTester') ----- + testDoubleOuterTest + self assertSuccess: (ExceptionTester new runTest: #doubleOuterTest ) ! Item was added: + ----- Method: ExceptionTests>>testSimpleOuterReturn (in category 'tests - ExceptionTester') ----- + testSimpleOuterReturn + self assertSuccess: (ExceptionTester new runTest: #simpleOuterReturnTest ) !

1 0

FFI: FFI-Callbacks-mt.5.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.5.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.5 Author: mt Time: 30 April 2021, 7:10:05.967986 pm UUID: 32dde9ab-5acb-384f-bade-83c10c63ecec Ancestors: FFI-Callbacks-mt.4 Merges 2020/21 updates from VMMaker/Alien plugin: - #voidResult - #oopAt:put: (not yet compatible with SqueakFFI) - #mostRecentCallbackContext + field "outerContext" for debugging - better comments - detect new ABI #ARM64 And simplify the existing #evaluateDynamic again. There is still logic missing when to switch between registers. =============== Diff against FFI-Callbacks-mt.4 =============== Item was changed: ----- Method: FFICallback class>>initialize (in category 'class initialization') ----- initialize + Smalltalk addToStartUpList: self after: FFIPlatformDescription. ThunkToCallbackMap := WeakValueDictionary new.! Item was added: + ----- 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: + [ThunkToCallbackMap := WeakValueDictionary new]! 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." | offset args | offset := 1. args := Array new: argumentTypes size. 1 to: args size do: [:argIndex | | argType data | argType := argumentTypes at: argIndex. + data := argType handle: handle at: offset. - - argType isPointerType - ifTrue: [ - data := (type handle: handle at: offset). - - argType referentClass "pointer to atomic" - ifNil: [data := data asType: argType] - ifNotNil: [:structClass | "pointer to external structure or union" - argType isTypeAliasToPointer - ifTrue: [data := structClass fromHandle: data getHandle asByteArrayPointer] - ifFalse: [data := structClass fromHandle: data getHandle]] ] - ifFalse: [ "non-pointer type" - self flag: #floats. "mt: When should we switch to callbackContext floatRegArgs?" - data := argType handle: handle at: offset. - - argType isAtomic - ifFalse: ["structure type, most likely type alias to pointer" - data := argType referentClass - fromHandle: (ExternalAddress fromInteger: data) asByteArrayPointer] - ifTrue: [ argType isTypeAlias - ifTrue: [ "alias to atomic type" - data := argType referentClass fromHandle: data] - ifFalse: [ "atomic, non-pointer type" - data := data ";-)"]] ]. - 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! - 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." <abi: #ARM32> <evaluator> + | 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 setArgData: callbackContext intRegArgs. ^ self evaluateDynamic: callbackContext! Item was added: + ----- 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." + <abi: #ARM64> <evaluator> + + | 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." + <abi: 'IA32'> <evaluator> - <abi: #IA32> <evaluator> + self setArgData: callbackContext stackPtr. + ^ self evaluateDynamic: callbackContext! - | stackPtr offset args | - stackPtr := callbackContext stackPtr. "For IA32, all arguments are on the stack." - - handle := stackPtr getHandle. - type := stackPtr contentType. "intptr_t" - - offset := 1. - args := Array new: argumentTypes size. - - 1 to: args size do: [:argIndex | - | argType data | - argType := argumentTypes at: argIndex. - 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_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." <abi: #X64> <evaluator> + | 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 setArgData: callbackContext 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." <abi: #X64Win64> <evaluator> + + | 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 setArgData: callbackContext intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>setArgData: (in category 'callback') ----- setArgData: externalData handle := externalData getHandle. + type := externalData contentType. ! - type := externalData externalType. ! Item was changed: ----- Method: FFICallbackContext class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( (thunkp 'void*') (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; "! Item was changed: + ----- Method: FFICallbackContext>>voidResult (in category 'callback result') ----- - ----- Method: FFICallbackContext>>voidResult (in category 'callback result - convenience') ----- voidResult + "Actually return garbage." + ^ ResultTypeWord! - self flag: #discuss. "mt: Is this the expected answer in the IA32ABI plugin?" - ^ self wordResult: 0! Item was added: + ----- Method: FFICallbackMemory class>>forOop (in category 'instance creation') ----- + forOop + " DANGEROUS!! Use during callbacks only or oop will be come invalid!! + object := Morph new. + handle := FFICallbackMemory forOop. + handle oopAt: 1 put: object. + handle oopAt: 1. + " + + ^ self new + sizeFieldPut: ExternalAddress wordSize; + yourself ! Item was changed: ----- Method: FFICallbackMemory class>>invokeCallbackContext: (in category 'callbacks') ----- + invokeCallbackContext: vmCallbackContextAddress "<Integer>" - invokeCallbackContext: vmCallbackContextAddress "<Integer>" "^<FFICallbackReturnValue>" "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." + - a pointer to a FFICallbackContext, set up by the VM's thunkEntry - routine. Return to C via primSignal:andReturnAs:fromContext:. thisContext's sender is the - call-out context." | callbackContext typeCode helper | callbackContext := FFICallbackContext fromHandle: vmCallbackContextAddress. helper := self fromInteger: vmCallbackContextAddress. [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]! - "Now attempt to return to C. The primitive will answer false if this is not the most recent Callback, - in which case we should wait on the lifoCallbackSemaphore which will be signalled when the most - recent callback successfully returns. If this is the most recent callback the primitive will signal all - the processes waiting on the lifoCallbackSemaphore, one of which will be the next most recent. - Hence all nested callbacks will end up returning in the right order." - [helper primSignal: LifoCallbackSemaphore andReturnAs: typeCode fromContext: thisContext] whileFalse: - [LifoCallbackSemaphore wait]! Item was added: + ----- Method: FFICallbackMemory class>>mostRecentCallbackContext (in category 'callbacks') ----- + mostRecentCallbackContext + + ^ FFICallbackContext fromHandle: self primMostRecentCallbackContextAddress! Item was added: + ----- Method: FFICallbackMemory class>>primMostRecentCallbackContextAddress (in category 'callbacks') ----- + primMostRecentCallbackContextAddress + "Answer the address of the mostRecentCallbackContext, which will be 0 if no callback is running. + Does not fail (if the plugin is present and implements the primitive)." + <primitive: 'primMostRecentCallbackContext' module: 'IA32ABI' error: ec> + self primitiveFailed.! Item was changed: ----- Method: FFICallbackMemory 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: + [ ExecutablePages := Set new. + LifoCallbackSemaphore := Semaphore new ]! - ["AllocatedThunks removeAll." - ExecutablePages := Set new]! Item was added: + ----- Method: FFICallbackMemory>>oopAt: (in category 'alien compatibility') ----- + oopAt: byteOffset + "Access for callbacks that want to exchange Smalltalk objects." + <primitive: 'primOopAt' module: 'IA32ABI' error: errorCode> + ^self primitiveFailed! Item was added: + ----- Method: FFICallbackMemory>>oopAt:put: (in category 'alien compatibility') ----- + oopAt: byteOffset put: value + "Access for callbacks that want to exchange Smalltalk objects." + <primitive: 'primOopAtPut' module: 'IA32ABI' error: errorCode> + ^self primitiveFailed! Item was changed: ----- Method: FFICallbackMemory>>primSignal:andReturnAs:fromContext: (in category 'callbacks') ----- + primSignal: aSemaphore andReturnAs: typeCode fromContext: context + "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 return from + the callback and do not return here. If vmCallbackContextAddress *is not* that of + the most recent Callback then succeed but answer false. In either case, signal the + first process waiting on aSemaphore. See Alien class>> invokeCallbackContext: + for a full explanation. Fail if the arguments are not of the expected type." - primSignal: aSemaphore "<Semaphore>" andReturnAs: typeCode "<SmallInteger>" fromContext: context "<MethodContext>" <primitive: 'primReturnAsFromContextThrough' module: 'IA32ABI' error: ec> ^ self primitiveFailed! Item was changed: ----- Method: FFICallbackResult class>>fields (in category 'field definition') ----- fields " self defineFields. " ^ #( (booleanResult 'bool') (floatResult 'double') (positiveIntegerResult 'uintptr_t') (integerResult 'intptr_t') + "(oopResult 'oop')" "Not yet working. Needs new atomic oop type to then call #oopAt:put: on ByteArray or ExternalAddress. See AtomicSelectors. Still, the IA32ABI plugin needs the Alien-form of a byte array. See FFICallbackMemory and its #oopAt:(put:) implementation. Maybe in the future Squeak FFI supports this interface on its regular handles, too." )! Item was changed: ----- Method: FFIPlatformDescription>>abi (in category '*FFI-Callbacks') ----- abi | processor | processor := self subtype asLowercase. + (#('aarch64' 'arm64') includes: processor) + ifTrue: [^ #ARM64 "#ARMv8 ???"]. (processor = 'arm' or: [(processor beginsWith: 'armv') and: [processor fifth <= $7]]) + ifTrue: [^ #ARM32]. - ifTrue: [^ #'ARM32']. (processor first = $i and: [processor = 'intel' or: ['i#86' match: processor]]) + ifTrue: [^ #IA32]. - ifTrue: [^ #'IA32']. (processor first = $x and: [processor = 'x64' or: [('x86#64*' match: processor)]]) + ifTrue: [^ self isWindows ifTrue: [#X64Win64] ifFalse: [#X64]]. - ifTrue: [^ self isWindows ifTrue: [#'X64Win64'] ifFalse: [#'X64']]. ^ #'UNKNOWN_ABI'!

1 0

FFI: FFI-Callbacks-mt.4.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.4.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.4 Author: mt Time: 30 April 2021, 4:06:12.828442 pm UUID: 549fb596-a536-c944-a48c-646844ddd6ac Ancestors: FFI-Callbacks-mt.3 Continues work on callback evaluation: - Lets ABI be a symbol, not a string. - Adds pool for callback constants. - Adds stub for ARM64 ABI - Adds more docs in #primTrunkEntryAddress - Minor change in callback setup - Clarify argument types and result types - Adds stubs for word64 and struct results - Adds #endianness message to platform description =============== Diff against FFI-Callbacks-mt.3 =============== Item was changed: ExternalObject subclass: #FFICallback + instanceVariableNames: 'abi type evaluableObject thunk argumentTypes resultType' - instanceVariableNames: 'abi type evaluableObject thunk argTypes' classVariableNames: 'ThunkToCallbackMap' poolDictionaries: '' category: 'FFI-Callbacks'! Item was removed: - ----- Method: FFICallback class>>maxThunkSize (in category 'constants') ----- - maxThunkSize - "see FFICallbackThunk initialize & initializeStdcall:; must be big enough for the largest thunk created" - ^ 40! 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." | offset args | offset := 1. + args := Array new: argumentTypes size. - args := Array new: argTypes size - 1. "Skip return type" 1 to: args size do: [:argIndex | | argType data | + argType := argumentTypes at: argIndex. - argType := argTypes at: argIndex + 1. "Skip return type" argType isPointerType ifTrue: [ data := (type handle: handle at: offset). argType referentClass "pointer to atomic" ifNil: [data := data asType: argType] ifNotNil: [:structClass | "pointer to external structure or union" argType isTypeAliasToPointer ifTrue: [data := structClass fromHandle: data getHandle asByteArrayPointer] ifFalse: [data := structClass fromHandle: data getHandle]] ] ifFalse: [ "non-pointer type" self flag: #floats. "mt: When should we switch to callbackContext floatRegArgs?" data := argType handle: handle at: offset. argType isAtomic ifFalse: ["structure type, most likely type alias to pointer" data := argType referentClass fromHandle: (ExternalAddress fromInteger: data) asByteArrayPointer] ifTrue: [ argType isTypeAlias ifTrue: [ "alias to atomic type" data := argType referentClass fromHandle: data] ifFalse: [ "atomic, non-pointer type" data := data ";-)"]] ]. args at: argIndex put: data. 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." + <abi: #ARM32> <evaluator> - <abi: 'ARM32'> <evaluator> self setArgData: callbackContext 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." + <abi: #IA32> <evaluator> - <abi: 'IA32'> <evaluator> + | stackPtr offset args | + stackPtr := callbackContext stackPtr. "For IA32, all arguments are on the stack." + + handle := stackPtr getHandle. + type := stackPtr contentType. "intptr_t" + + offset := 1. + args := Array new: argumentTypes size. + + 1 to: args size do: [:argIndex | + | argType data | + argType := argumentTypes at: argIndex. + 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! - 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." + <abi: #X64> <evaluator> - <abi: 'X64'> <evaluator> self setArgData: callbackContext 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." + <abi: #X64Win64> <evaluator> - <abi: 'X64Win64'> <evaluator> self setArgData: callbackContext intRegArgs. ^ self evaluateDynamic: callbackContext! Item was changed: ----- Method: FFICallback>>init__ccall_ARM32 (in category 'initialization - thunk prepare') ----- init__ccall_ARM32 + <abi: #ARM32> <init> - <abi: 'ARM32'> <init> "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 <thunk+0>: mov r12, sp ; 0xe1a0c00d 0x4 <thunk+4>: sub sp, sp, #16 ; 0xe24dd010 0x8 <thunk+8>: str pc, [sp, #0] ; 0xe58df000 N.B. passes thunk+16; thunkEntry compensates 0xc <thunk+12>: str r12, [sp,#4] ; 0xe58dc004 0x10 <thunk+16>: str lr, [sp, #12] ; 0xe58de00c 0x14 <thunk+20>: ldr r12, [pc, #8] ; 0xe59fc008 0x18 <thunk+24>: blx r12 ; 0xe12fff3c 0x1c <thunk+28>: add sp, sp, #12 ; 0xe28dd00c 0x20 <thunk+32>: ldr pc, [sp], #4!! ; 0xe49df004 ; pop {pc} 0x24 <thunk+36>: .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; shortPointerAt: 37 put: self thunkEntryAddress.! Item was added: + ----- Method: FFICallback>>init__ccall_ARM64 (in category 'initialization - thunk prepare') ----- + init__ccall_ARM64 + <abi: #ARM64> <init> + "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 + <abi: #IA32> <init> - <abi: 'IA32'> <init> "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; shortPointerAt: 5 put: self thunkEntryAddress; unsignedLongAt: 9 put: 16r68909090; 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 + <abi: #X64> <init> - <abi: 'X64'> <init> "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; longPointerAt: 5 put: thunk getHandle; unsignedLongAt: 13 put: 16r00b84850; "00 is the first byte of the 64-bit constant the movabsq/0x48 opcode moves" 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 + <abi: #X64Win64> <init> - <abi: 'X64Win64'> <init> "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; 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" 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 + <abi: #IA32> <init> - <abi: 'IA32'> <init> "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; shortPointerAt: 5 put: self thunkEntryAddress; unsignedLongAt: 9 put: 16r68909090; shortPointerAt: 13 put: thunk getHandle; unsignedLongAt: 17 put: 16rC483D0FF; unsignedShortAt: 21 put: 16rC20C; unsignedShortAt: 23 put: numBytes.! Item was changed: ----- Method: FFICallback>>primThunkEntryAddress (in category 'initialization - thunk prepare') ----- primThunkEntryAddress "^<Integer>" "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); - x86: long thunkEntry(void *thunkp, long *stackp); - x64: long thunkEntry(long a, long b, long c, long d, long, e, long f, - double d0, double d1, double d2, double d3, - double d4, double d5, double d6, double d7, - void *thunkp, long *stackp); - ARM: long thunkEntry(long a, long b, long c, long d, - double d0, double d1, double d2, double d3, - double d4, double d5, double d6, double d7, - void *thunkp, long *stackp); etc. This is the function a callback thunk/trampoline should call to initiate a callback." <primitive: 'primThunkEntryAddress' module: 'IA32ABI' error: errorCode> ^self primitiveFailed! Item was removed: - ----- Method: FFICallback>>setArgTypes:evaluableObject: (in category 'initialization') ----- - setArgTypes: externalTypes evaluableObject: blockOrMessage - - - abi := FFIPlatformDescription current abi. - handle := nil. - type := nil. - - evaluableObject := blockOrMessage. - argTypes := externalTypes. - - - - - - "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the <calleepops: N> 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>>setBlock:signature: (in category 'initialization') ----- setBlock: aBlock "<BlockClosure>" signature: signature "<String>" self + setTypes: (ExternalType lookupTypes: signature) - setArgTypes: (ExternalType lookupTypes: signature) evaluableObject: aBlock.! Item was changed: ----- Method: FFICallback>>setMessage: (in category 'initialization') ----- setMessage: aMessageSend "Fetch the argTypes from <callback: ...> pragma in method." | method | self assert: [aMessageSend receiver notNil]. method := aMessageSend receiver class lookupSelector: aMessageSend selector. self + setTypes: ((method pragmaAt: #callback:) argumentAt: 1) - setArgTypes: ((method pragmaAt: #callback:) argumentAt: 1) evaluableObject: aMessageSend.! Item was changed: ----- Method: FFICallback>>setMessage:signature: (in category 'initialization') ----- setMessage: aMessageSend signature: signature "Override the argTypes from <callback: ...> pragma in method." self assert: [aMessageSend receiver notNil]. self + setTypes: (ExternalType lookupTypes: signature) - setArgTypes: (ExternalType lookupTypes: signature) evaluableObject: aMessageSend.! 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." - argTypes first 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]]. - self assert: [argTypes first isIntegerType]. - ^ aCallbackContext wordResult: anObject]. anObject isBoolean ifTrue: [ + self assert: [resultType atomicType = 1 "bool"]. - self assert: [argTypes first atomicType = 1 "bool"]. ^ aCallbackContext wordResult: anObject]. anObject isFloat ifTrue: [ + self assert: [resultType atomicType >= 12 "float/double"]. - self assert: [argTypes first atomicType >= 12 "float/double"]. ^ aCallbackContext floatResult: anObject]. + self notify: 'Unkown result type.'. + ^ aCallbackContext errorResult! - "Try to push pointer for external object." - ^ aCallbackContext externalObjectResult: anObject! Item was added: + ----- 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 <calleepops: N> 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 added: + ----- Method: FFICallback>>setTypes:evaluableObject: (in category 'initialization') ----- + setTypes: externalTypes evaluableObject: blockOrMessage + + self + setResultType: externalTypes first + argumentTypes: externalTypes allButFirst + evaluableObject: blockOrMessage.! Item was added: + SharedPool subclass: #FFICallbackConstants + instanceVariableNames: '' + classVariableNames: 'MaxThunkSize ResultTypeDouble ResultTypeStruct ResultTypeWord ResultTypeWord64' + poolDictionaries: '' + category: 'FFI-Callbacks'! Item was added: + ----- Method: FFICallbackConstants class>>initialize (in category 'class initialization') ----- + initialize + " + self initialize. + " + + "Callback return types. See vmCallback.h" + ResultTypeWord := 1. + ResultTypeWord64 := 2. + ResultTypeDouble := 3. + ResultTypeStruct := 4. + + "See FFICallbackThunk initialize & initializeStdcall:; must be big enough for the largest thunk created" + MaxThunkSize := 40.! Item was changed: ExternalStructure subclass: #FFICallbackContext instanceVariableNames: '' classVariableNames: '' + poolDictionaries: 'FFICallbackConstants' - poolDictionaries: '' 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>>errorResult (in category 'callback result - convenience') ----- - ----- Method: FFICallbackContext>>errorResult (in category 'callback result') ----- errorResult ^ self wordResult: -1! Item was changed: + ----- Method: FFICallbackContext>>externalObjectResult: (in category 'callback result - convenience') ----- - ----- Method: FFICallbackContext>>externalObjectResult: (in category 'callback result') ----- externalObjectResult: anExternalObject "ExternalStructure, ExternalUnion, ExternalData ... handle MUST BE an ExternalAddress" ^ self pointerResult: anExternalObject getHandle! Item was changed: ----- Method: FFICallbackContext>>floatResult: (in category 'callback result') ----- floatResult: aFloat + self flag: #floatVsDouble. "mt: What about result types that expect single-precision floats?" self rvs floatResult: aFloat. + ^ ResultTypeDouble! - ^ 3! Item was changed: + ----- Method: FFICallbackContext>>pointerResult: (in category 'callback result - convenience') ----- - ----- Method: FFICallbackContext>>pointerResult: (in category 'callback result') ----- pointerResult: anExternalAddress ^ self wordResult: anExternalAddress asInteger! Item was added: + ----- Method: FFICallbackContext>>structResult: (in category 'callback result') ----- + structResult: anObject + + self shouldBeImplemented. + ^ ResultTypeStruct! Item was changed: + ----- Method: FFICallbackContext>>voidResult (in category 'callback result - convenience') ----- - ----- Method: FFICallbackContext>>voidResult (in category 'callback result') ----- voidResult self flag: #discuss. "mt: Is this the expected answer in the IA32ABI plugin?" ^ self wordResult: 0! Item was added: + ----- Method: FFICallbackContext>>word64Result: (in category 'callback result') ----- + word64Result: anInteger + "Separate the integer into high-and-low (big endian) or low-and-high (little endian)." + + self shouldBeImplemented. "mt: See platforms\Cross\plugins\IA32ABI" + + self assert: [anInteger isLarge]. + self assert: [FFIPlatformDescription current wordSize = 4 + or: [FFIPlatformDescription current abi = 'X64Win64']]. + + FFIPlatformDescription current endianness caseOf: { + [ #little ] -> []. + [ #big ] -> []. + }. + + + ^ ResultTypeWord64! Item was changed: ----- Method: FFICallbackContext>>wordResult: (in category 'callback result') ----- wordResult: aValue - "Accept any value in the -2^31 to 2^32-1 range or booleans." aValue isBoolean ifTrue: [self rvs booleanResult: aValue]. aValue isInteger ifTrue: [aValue >= 0 ifTrue: [self rvs positiveIntegerResult: aValue] ifFalse: [self rvs integerResult: aValue]]. + ^ ResultTypeWord! - ^1! Item was changed: ByteArray variableByteSubclass: #FFICallbackMemory instanceVariableNames: '' classVariableNames: 'AccessProtect AllocatedThunks ExecutablePages LifoCallbackSemaphore' + poolDictionaries: 'FFICallbackConstants' - poolDictionaries: '' category: 'FFI-Callbacks'! !FFICallbackMemory commentStamp: 'mt 6/17/2020 12:24' prior: 0! Interface for memory allocation using the IA32ABI plugin. Also used as a compatibility layer for Alien. *** An instance of FFICallbackThunk is a reference to a machine-code thunk/trampoline that calls-back into the VM. The reference can be passed to C code which can use it as a function pointer through which to call-back into Smalltalk. The machine-code thunk/trampoline is different for each instance, hence its address is a unique key that can be used to assocuate the Smalltalk side of the call-back (e.g. a block) with the thunk. Since thunks must be executable and some OSs may not provide default execute permission on memory returned by malloc we may not be able to use malloc directly. Instead we rely on a primitive to provide memory that is guaranteed to be executable. ExternalAddress class>>allocateExecutablePage answers an instance of ExternalData that references an executable piece of memory that is some (possiby unitary) multiple of the pagesize. Class-side code then parcels out pieces of a page to individual thunks. These pieces are recycled when thunks are reclaimed. Sinc e the first byte of a thunk is non-zero we can use it as a flag indicating if the piece is in use or not. See FFICallback for the higher-level construct that represents a Smalltalk block to be run in response to a callback. Callbacks wrap instances of FFICallbackThunk and FFICallbackContext instances that describe the stack layout and register contents for receiving callback arguments. Class Variables AccessProtect <Semaphore> critical section for ExecutablePages (de)allocation AllocatedThunks <AlienWeakTable of <FFICallbackThunk -> Integer>> - weak collection of thunks, used to return thunk storage to the executable page pool. ExecutablePages <Set of: Alien "executable page"> - collection of pages with execute permissions used to provide executable thunks! Item was changed: ----- Method: FFICallbackMemory class>>allocateExecutableBlock (in category 'executable pages') ----- allocateExecutableBlock | blockSize | + blockSize := MaxThunkSize. - blockSize := FFICallback 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 blockAt: i byteSize: blockSize]]]]. AccessProtect critical: [ | newPage | newPage := ExecutablePages add: self allocateExecutablePage. ^ (newPage blockAt: 1 byteSize: blockSize) at: 1 put: 1; yourself]! Item was changed: ----- Method: FFIPlatformDescription>>abi (in category '*FFI-Callbacks') ----- abi | processor | processor := self subtype asLowercase. (processor = 'arm' or: [(processor beginsWith: 'armv') and: [processor fifth <= $7]]) + ifTrue: [^ #'ARM32']. - ifTrue: [^ 'ARM32']. (processor first = $i and: [processor = 'intel' or: ['i#86' match: processor]]) + ifTrue: [^ #'IA32']. - ifTrue: [^ 'IA32']. (processor first = $x and: [processor = 'x64' or: [('x86#64*' match: processor)]]) + ifTrue: [^ self isWindows ifTrue: [#'X64Win64'] ifFalse: [#'X64']]. - ifTrue: [^ self isWindows ifTrue: ['X64Win64'] ifFalse: ['X64']]. + ^ #'UNKNOWN_ABI'! - ^ 'UNKNOWN'! Item was added: + ----- Method: FFIPlatformDescription>>endianness (in category '*FFI-Callbacks') ----- + endianness + + ^ Smalltalk endianness!

1 0

FFI: FFI-Kernel-mt.121.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.121.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.121 Author: mt Time: 30 April 2021, 4:02:17.500442 pm UUID: d2b4689e-ac74-5843-9526-b4e752914eb5 Ancestors: FFI-Kernel-mt.120 Fixes off-by-one regression. =============== Diff against FFI-Kernel-mt.120 =============== 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. 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"]. ^ 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) - fromHandle: (handle copyFrom: byteOffset to: byteOffset+byteSize) type: newType) size: numElements; yourself]]!

1 0

The Trunk: Morphic-mt.1767.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

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.'!

1 0

The Trunk: Tools-mt.1053.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1053.mcz ==================== Summary ==================== Name: Tools-mt.1053 Author: mt Time: 30 April 2021, 10:06:23.164936 am UUID: 5f61f12c-2895-c046-a679-a626a257a6d7 Ancestors: Tools-mt.1052 Adds our common interface for tools to ChangeSetBrowser. =============== Diff against Tools-mt.1052 =============== Item was added: + ----- Method: ChangeSetBrowser class>>on: (in category 'instance creation') ----- + on: aChangeSet + + ^ self new + myChangeSet: aChangeSet; + yourself! Item was added: + ----- Method: ChangeSetBrowser class>>openOn: (in category 'instance creation') ----- + openOn: aChangeSet + + ^ ToolBuilder open: (self on: aChangeSet)! Item was added: + ----- Method: ChangeSetBrowser class>>openOnCurrent (in category 'instance creation') ----- + openOnCurrent + + ^ self openOn: ChangeSet current!

1 0

The Trunk: Tools-mt.1052.mcz
by commits＠source.squeak.org 30 Apr '21

30 Apr '21

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1052.mcz ==================== Summary ==================== Name: Tools-mt.1052 Author: mt Time: 30 April 2021, 9:42:59.802936 am UUID: 7051fe94-6d06-724b-a1db-f1e369ab228e Ancestors: Tools-mt.1051 After taking a look at Squeak 3.9, I figured out what ChangeSetBrowser is supposed to look like. :-D (You can invoke it from the regular ChangeSorter via CMD+SHIFT+B in the list of change sets. Or the context menu there.) =============== Diff against Tools-mt.1051 =============== Item was added: + ----- Method: ChangeSetBrowser>>buildWith: (in category 'toolbuilder') ----- + buildWith: builder + + | max windowSpec | + max := self wantsOptionalButtons ifTrue:[0.42] ifFalse:[0.5]. + windowSpec := self buildWindowWith: builder specs: { + (0.0(a)0.0 corner: 0.5@max) -> [self buildClassListWith: builder]. + (0.5(a)0.0 corner: 1.0@max) -> [self buildMessageListWith: builder]. + (0.0@max corner: 1.0(a)1.0) -> [self buildCodePaneWith: builder] }. + ^ builder build: windowSpec!

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2021