Packages May 2020

packages@lists.squeakfoundation.org

1 participants
97 discussions

The Trunk: Chronology-Core-ul.55.mcz
by commits＠source.squeak.org 31 May '20

31 May '20

Levente Uzonyi uploaded a new version of Chronology-Core to project The Trunk: http://source.squeak.org/trunk/Chronology-Core-ul.55.mcz ==================== Summary ==================== Name: Chronology-Core-ul.55 Author: ul Time: 31 May 2020, 12:10:20.250221 am UUID: ea36b609-177c-405a-b64e-9988deb3d26e Ancestors: Chronology-Core-nice.52 Automatically update the time zone cached by the VM every 30 minutes: - copied and modified Eliot's accessor to primitive 243 to do the actual updating (Time class >> #primitiveUpdateTimeZone) - update happens when Time class >> #posixMicrosecondClockWithOffset or Time class >> #posixMicrosecondClockWithOffset: are sent. Other low-level accessors of the VM time zone are not updating the cached time zone value (e.g. Time class >> #localMicrosecondClockPrimitive) - actual update happens in Time class >> #updateTimeZoneCacheAt: - postscript activates the update mechanism which can be turned off by evaluating [ Time classPool at: #UpdateVMTimeZoneCacheAt put: nil ] Other changes: - do not send Time class >> #initialize from DateAndTime class >> #startUp:. Let Time have its own #startUp: method instead. Postscript adds Time to the startUpList before DateAndTime. - do not send super initialize from DateAndTime class >> #initialize - do not send #automaticTimezone to DateAndTime on startup, because that's just an accessor with no side effects - do not overwrite set variables in Time class >> #initialize - assert that the value passed to Time class >> #clockPolicy: is one of the known values =============== Diff against Chronology-Core-nice.52 =============== Item was changed: ----- Method: DateAndTime class>>initialize (in category 'initialize-release') ----- initialize - super initialize. - ClockProvider := Time. PosixEpochJulianDays := 2440588. InitializeFromPrimitive := self canInitializeFromPrimitive. Smalltalk addToStartUpList: self. self startUp: true ! Item was changed: ----- Method: DateAndTime class>>startUp: (in category 'system startup') ----- startUp: startingAfresh "Set local timezone" startingAfresh ifTrue: [InitializeFromPrimitive := self canInitializeFromPrimitive. Time initialize. "set LastClockTick to 0". + self now]! - self now. - self automaticTimezone]! Item was changed: Magnitude subclass: #Time instanceVariableNames: 'seconds nanos' + classVariableNames: 'ClockPolicy HighResClockTicksPerMillisecond LastClockTick UpdateVMTimeZoneCacheAt UseHighResClockForTiming' - classVariableNames: 'ClockPolicy HighResClockTicksPerMillisecond LastClockTick UseHighResClockForTiming' poolDictionaries: 'ChronologyConstants' category: 'Chronology-Core'! !Time commentStamp: 'dew 10/23/2004 17:58' prior: 0! This represents a particular point in time during any given day. For example, '5:19:45 pm'. If you need a point in time on a particular day, use DateAndTime. If you need a duration of time, use Duration. ! Item was changed: ----- Method: Time class>>clockPolicy: (in category 'class initialization') ----- clockPolicy: aSymbol "When sequencial calls are made to DateAndTime now, it may be desirable to force the system clock to be monotonic, and it may be desirable for the clock to appear to be strictly increasing with no repeat values. The ClockPolicy identifies which of several possible strategies to use. Allowable values are #acceptPlatformTime #monotonicAllowDuplicates #monotonicForceMicrosecondIncrement #monotonicForceNanosecondIncrement " + self assert: ( + #( + acceptPlatformTime + monotonicAllowDuplicates + monotonicForceMicrosecondIncrement + monotonicForceNanosecondIncrement) includes: aSymbol). ClockPolicy := aSymbol! Item was changed: ----- Method: Time class>>initialize (in category 'class initialization') ----- initialize + " self initialize " - "Time initialize" + LastClockTick ifNil: [ LastClockTick := 0 ]. - "Initialize at startup time to protect for the case of an image saved with bad LastClockTick" - LastClockTick := 0. + HighResClockTicksPerMillisecond ifNil: [ HighResClockTicksPerMillisecond := 0 ]. - HighResClockTicksPerMillisecond := 0. + ClockPolicy ifNil: [ + "self clockPolicy: #acceptPlatformTime." + self clockPolicy: #monotonicAllowDuplicates. + "self clockPolicy: #monotonicForceMicrosecondIncrement." + "self clockPolicy: #monotonicForceNanosecondIncrement." ]! - "self clockPolicy: #acceptPlatformTime." - self clockPolicy: #monotonicAllowDuplicates. - "self clockPolicy: #monotonicForceMicrosecondIncrement." - "self clockPolicy: #monotonicForceNanosecondIncrement." - ! Item was changed: ----- Method: Time class>>posixMicrosecondClockWithOffset (in category 'clock') ----- posixMicrosecondClockWithOffset "Answer an array with local microseconds since the Posix epoch and the current seconds offset from GMT in the local time zone." + | array posixUtcValue | - | array utcValue | array := self primPosixMicrosecondClockWithOffset. + posixUtcValue := array at: 1. + (self updateTimeZoneCacheAt: posixUtcValue) ifTrue: [ "Time zone may have changed: fetch again." + self primPosixMicrosecondClockWithOffset: array. + posixUtcValue := array at: 1 ]. ClockPolicy caseOf: { [#acceptPlatformTime] -> [^ array] . [#monotonicAllowDuplicates] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := array at: 1. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [array at: 1 put: LastClockTick]] . [#monotonicForceMicrosecondIncrement] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := array at: 1. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [LastClockTick := LastClockTick + 1. "add one microsecond" array at: 1 put: LastClockTick]] . [#monotonicForceNanosecondIncrement] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := array at: 1. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [LastClockTick := LastClockTick + (1 / 1000). "add one nanosecond" array at: 1 put: LastClockTick]] } otherwise: []. + ^array! - ^array - - ! Item was changed: ----- Method: Time class>>posixMicrosecondClockWithOffset: (in category 'clock') ----- posixMicrosecondClockWithOffset: aDateAndTime "Initialize aDateAndTime initialized with local microseconds since the Posix epoch and the current seconds offset from GMT in the local time zone." + | posixUtcValue | - - | utcValue | self primPosixMicrosecondClockWithOffset: aDateAndTime. + posixUtcValue := aDateAndTime utcMicroseconds. + (self updateTimeZoneCacheAt: posixUtcValue) ifTrue: [ "Time zone may have changed: fetch again." + self primPosixMicrosecondClockWithOffset: aDateAndTime . + posixUtcValue := aDateAndTime utcMicroseconds ]. ClockPolicy caseOf: { [#acceptPlatformTime] -> [^ aDateAndTime] . [#monotonicAllowDuplicates] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := aDateAndTime utcMicroseconds. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [aDateAndTime utcMicroseconds: LastClockTick]] . [#monotonicForceMicrosecondIncrement] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := aDateAndTime utcMicroseconds. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [LastClockTick := LastClockTick + 1. "add one microsecond" aDateAndTime utcMicroseconds: LastClockTick]] . [#monotonicForceNanosecondIncrement] -> [ + posixUtcValue > LastClockTick + ifTrue: [LastClockTick := posixUtcValue] - utcValue := aDateAndTime utcMicroseconds. - utcValue > LastClockTick - ifTrue: [LastClockTick := utcValue] ifFalse: [LastClockTick := LastClockTick + (1 / 1000). "add one nanosecond" aDateAndTime utcMicroseconds: LastClockTick]] } otherwise: []. + ^aDateAndTime! - ^aDateAndTime - ! Item was added: + ----- Method: Time class>>primitiveUpdateTimeZone (in category 'clock') ----- + primitiveUpdateTimeZone + "Update the VMs notion of the current time zone. The VM sets its notion + of the time zone once at start-up. If one wants the VM to keep its notion + up-to-date arrange to invoke this primitive periodically." + + <primitive: 243> + ^nil "Return nil instead of self to indicate that the primitive failed."! Item was added: + ----- Method: Time class>>startUp: (in category 'system startup') ----- + startUp: resuming + + resuming ifTrue: [ + LastClockTick := 0 ]! Item was added: + ----- Method: Time class>>updateTimeZoneCacheAt: (in category 'clock') ----- + updateTimeZoneCacheAt: posixUtcMicrosecondClock + "Tell the VM to update its cached time zone value if the POSIX UTC time reached the valute stored in UpdateVMTimeZoneCacheAt has been reached. Assume that posixUtcMicrosecondClock is an integer with the current POSIX UTC microsecond clock value. Return true when the cache was updated to indicate that the time zone may have changed." + + | updateInterval | + UpdateVMTimeZoneCacheAt ifNil: [ + "Automatic update is disabled." + ^false ]. + posixUtcMicrosecondClock < UpdateVMTimeZoneCacheAt ifTrue: [ ^false ]. + self primitiveUpdateTimeZone ifNil: [ + "The primitive failed." + ^false ]. + updateInterval := 1800000000. "This could be a preference but 30 minutes matches all upcoming DST change times." + UpdateVMTimeZoneCacheAt := posixUtcMicrosecondClock // updateInterval + 1 * updateInterval "Round up posixUtcMicrosecondClock to the next multiple of updateInterval.". + ^true! Item was changed: + (PackageInfo named: 'Chronology-Core') postscript: '"Make sure UpdateVMTimeZoneCacheAt of Time is initialized." + Time classPool at: #UpdateVMTimeZoneCacheAt put: 0. + "Separated Time''s startup duties from DateAndTime." + Smalltalk addToStartUpList: Time before: DateAndTime'! - (PackageInfo named: 'Chronology-Core') postscript: 'DateAndTime startUp: true. - HashedCollection rehashAll. - '!

1 0

FFI: FFI-Kernel-mt.79.mcz
by commits＠source.squeak.org 30 May '20

30 May '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.79.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.79 Author: mt Time: 30 May 2020, 4:56:51.283231 pm UUID: 2191ddfe-e9ae-844c-bf19-71cc0ab214dd Ancestors: FFI-Kernel-mt.77 Fixes a bug with wrong byte alignment for double and longlong and ulonglong on 32-bit non-ARM Unix-based platforms. Start documenting Squeak FFI's relationship to "int" and "long" with the flag #ffiLongVsInt. If you spot an implication somewhere, just put this flag in the code. Because byte alignment is stored in atomic types, re-initialize those if the platform changed on image start up. This also affects structure types. (Skip mt.78 because that number rests in our treated inbox for now.) =============== Diff against FFI-Kernel-mt.77 =============== Item was changed: ----- Method: ExternalStructure class>>install (in category 'system startup') ----- install + "Resume the system on a new platform. Recompile all structures to account for different word size etc." - "Resume the system on a new platform. Recompile all structures to accound for different word size etc." self recompileStructures.! Item was changed: ----- Method: ExternalType class>>initializeAtomicTypes (in category 'class initialization') ----- initializeAtomicTypes "ExternalType initialize" + | atomicType byteSize type typeName byteAlignment | + self flag: #ffiLongVsInt. "For a discussion about long vs. int see http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squea…." + #( "name atomic id byte size byte alignment" ('void' 0 0 0) ('bool' 1 1 1) ('byte' 2 1 1) ('sbyte' 3 1 1) ('ushort' 4 2 2) ('short' 5 2 2) + "!!!!!!" ('ulong' 6 4 "!!!!!!" 4) + "!!!!!!" ('long' 7 4 "!!!!!!" 4) + ('ulonglong' 8 8 8) "v.i." + ('longlong' 9 8 8) "v.i." - ('ulong' 6 4 4) - ('long' 7 4 4) - ('ulonglong' 8 8 8) - ('longlong' 9 8 8) ('char' 10 1 1) ('schar' 11 1 1) ('float' 12 4 4) + ('double' 13 8 8) "v.i." + "TODO: ('longdouble' 14 10 16? 4?)" - ('double' 13 8 8) ) do:[:typeSpec| | compiled | typeName := typeSpec first. atomicType := typeSpec second. byteSize := typeSpec third. byteAlignment := typeSpec fourth. + + "0) On 32-bits Windows and MacOS, double and long long have an alignment of 8. But on 32-bit Linux, their alignment is 4. But not on a 32-bit Raspberry Pi OS." + (FFIPlatformDescription current wordSize = 4 + and: [FFIPlatformDescription current isUnix + and: [FFIPlatformDescription current isARM not]]) ifTrue: [ + (#('double' 'longlong' 'ulonglong') includes: typeName) ifTrue: [ + byteAlignment := 4]]. + + "1) Regular type" - "On 32 bits Windows and MacOS, double and long have an alignment of 8. But on Linux, their alignment is 4" - (FFIPlatformDescription current wordSize = 4 and: [FFIPlatformDescription current isUnix]) ifTrue: [ - (#('double longlong ulonglong') includes: typeName) ifTrue: [ - byteAlignment := 4 - ] - ]. compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr: (atomicType bitShift: FFIAtomicTypeShift)). type := (AtomicTypes at: typeName). + type + compiledSpec: compiled; - type compiledSpec: compiled; byteAlignment: byteAlignment. + + "2) Pointer type" compiled := WordArray with: ((self pointerSpec bitOr: FFIFlagAtomic) bitOr: (atomicType bitShift: FFIAtomicTypeShift)). type asPointerType byteAlignment: self pointerAlignment; compiledSpec: compiled. ].! Item was added: + ----- Method: ExternalType class>>platformChangedFrom:to: (in category 'system startup') ----- + platformChangedFrom: lastPlatform to: currentPlatform + "Byte size or byte alignment for atomic types might be different on the new platform." + + self initializeAtomicTypes. + self initializeStructureTypes.! 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] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." + { ExternalType. ExternalAddress. ExternalObject. FFIExternalSharedPool } - self flag: #discuss. "mt: Maybe directly call ExternalStructure?" - { ExternalAddress. ExternalObject. FFIExternalSharedPool } do: [:cls | cls platformChangedFrom: lastPlatform to: currentPlatform] ]]] ].!

1 0

FFI: FFI-Pools-mt.17.mcz
by commits＠source.squeak.org 28 May '20

28 May '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.17.mcz ==================== Summary ==================== Name: FFI-Pools-mt.17 Author: mt Time: 28 May 2020, 10:52:12.071313 am UUID: 35276a12-4bcf-044c-9a7f-8c440d94fc5d Ancestors: FFI-Pools-mt.16 Avoid external pool initialization when the basic FFI mechansim is loaded. Not sure this is useful anyway because actual external pools have to define their own #initialize to be updated on code-load time if the FFI mechanism is already loaded. This should also fix the VMMaker build script again. =============== Diff against FFI-Pools-mt.16 =============== Item was changed: ----- Method: FFIExternalSharedPool class>>initialize (in category 'class initialization') ----- initialize "self initialize" + "self initializeAllFromGeneratedProgramOutput"! - self initializeAllFromGeneratedProgramOutput!

1 0

FFI: FFI-Pools-mt.16.mcz
by commits＠source.squeak.org 28 May '20

28 May '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-mt.16.mcz ==================== Summary ==================== Name: FFI-Pools-mt.16 Author: mt Time: 28 May 2020, 9:20:47.243479 am UUID: ff3070e5-d241-6346-95a1-3b809f56a4bd Ancestors: FFI-Pools-mt.15 Moves interpretation of <ffiExternalSharedPool> pragma to the definition class where all other pragmas are interpreted and documented already. Adds simple way to explore pool definitions by calling the method that holds the definition pragmas: MyExternalPool class >> #win32ExamplePool <ffiExternalSharedPool> <ffiPlatformName: 'Win32'> ^ self poolDefinition =============== Diff against FFI-Pools-mt.15 =============== Item was changed: ----- Method: FFIExternalSharedPool class>>definitions (in category 'accessing') ----- definitions - | definitions | + | definitions | definitions := OrderedCollection with: self defaultDefinition. self class methodsDo: [:each | + (self definitionClass fromMethod: each) ifNotNil: [:poolDefinition | + definitions add: poolDefinition]]. - (each pragmaAt: #ffiExternalSharedPool) - ifNotNil: [ - definitions addLast: - (self definitionClass fromMethod: each)]]. + ^ definitions! - ^ definitions asArray.! Item was added: + ----- Method: FFIExternalSharedPool class>>poolDefinition (in category 'accessing') ----- + poolDefinition + "For convenience. Answer the result of this call in definition methods to support debugging." + + thisContext sender method ifNotNil: [:poolDefinitionMethod | + (self definitionClass fromMethod: poolDefinitionMethod) + ifNotNil: [:poolDefinition | ^ poolDefinition]]. + + self error: 'Sender is no valid pool definition!!'.! Item was changed: ----- Method: FFIExternalSharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- fromMethod: aCompiledMethod | definition | + (aCompiledMethod pragmaAt: #ffiExternalSharedPool) + ifNil: [^ nil]. + definition := self name: aCompiledMethod selector. "Squeak does not have #pragmasDo:" aCompiledMethod pragmas do: [:each | (self whichCategoryIncludesSelector: each keyword) == #'pragmas' ifTrue: [ definition perform: each keyword withArguments: each arguments]]. ^ definition.!

1 0

FFI: FFI-PoolsTests-mt.8.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-mt.8.mcz ==================== Summary ==================== Name: FFI-PoolsTests-mt.8 Author: mt Time: 27 May 2020, 5:26:20.340043 pm UUID: 02248816-81b6-254a-a91f-bcf8d9382533 Ancestors: FFI-PoolsTests-mt.7 Fixes typo "Genreator" -> "Generator". =============== Diff against FFI-PoolsTests-mt.7 =============== Item was changed: ----- Method: FFITestInheritanceExternalSharedPool class>>override (in category 'definitions') ----- override <ffiExternalSharedPool> <ffiInheritsFrom: #empty> <ffiPlatformName: 'testName' osVersion: 'testOSVersion' subtype: 'testSubtype' wordSize: 16> <ffiCCompiler: 'testCompiler'> <ffiCFlags: 'testFlags'> <ffiCHeaders: #('<testHeader.h>' '"testLocalHeader.h"' 'testImplicitGlobalHeader.h')> + <ffiProgramGenerator: #FFITestExternalSharedPoolProgramGenerator> - <ffiProgramGenerator: #FFITestExternalSharedPoolProgramGenreator> <ffiVariable: #One type: #Float>!

1 0

FFI: FFI-PoolsTests-monty.2.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-monty.2.mcz ==================== Summary ==================== Name: FFI-PoolsTests-monty.2 Author: monty Time: 30 March 2018, 2:25:31.60082 am UUID: 6d75440b-fd24-0d00-abe8-a2260f24d7b0 Ancestors: FFI-PoolsTests-monty.1 updated for FFISharedPool renaming =============== Diff against FFI-PoolsTests-monty.1 =============== Item was added: + FFIExternalSharedPool subclass: #FFITestDirectLoopExternalSharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-PoolsTests'! Item was added: + ----- Method: FFITestDirectLoopExternalSharedPool class>>one (in category 'definitions') ----- + one + <ffiExternalSharedPool> + <ffiInheritsFrom: #two>! Item was added: + ----- Method: FFITestDirectLoopExternalSharedPool class>>two (in category 'definitions') ----- + two + <ffiExternalSharedPool> + <ffiInheritsFrom: #one>! Item was removed: - FFISharedPool subclass: #FFITestDirectLoopSharedPool - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-PoolsTests'! Item was removed: - ----- Method: FFITestDirectLoopSharedPool class>>one (in category 'definitions') ----- - one - <ffiSharedPool> - <ffiInheritsFrom: #two>! Item was removed: - ----- Method: FFITestDirectLoopSharedPool class>>two (in category 'definitions') ----- - two - <ffiSharedPool> - <ffiInheritsFrom: #one>! Item was added: + FFIExternalSharedPool subclass: #FFITestIndirectLoopExternalSharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-PoolsTests'! Item was added: + ----- Method: FFITestIndirectLoopExternalSharedPool class>>one (in category 'accessing structure variables') ----- + one + <ffiExternalSharedPool> + <ffiInheritsFrom: #three>! Item was added: + ----- Method: FFITestIndirectLoopExternalSharedPool class>>three (in category 'definitions') ----- + three + <ffiExternalSharedPool> + <ffiInheritsFrom: #two>! Item was added: + ----- Method: FFITestIndirectLoopExternalSharedPool class>>two (in category 'definitions') ----- + two + <ffiExternalSharedPool> + <ffiInheritsFrom: #one>! Item was removed: - FFISharedPool subclass: #FFITestIndirectLoopSharedPool - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-PoolsTests'! Item was removed: - ----- Method: FFITestIndirectLoopSharedPool class>>one (in category 'accessing structure variables') ----- - one - <ffiSharedPool> - <ffiInheritsFrom: #three>! Item was removed: - ----- Method: FFITestIndirectLoopSharedPool class>>three (in category 'definitions') ----- - three - <ffiSharedPool> - <ffiInheritsFrom: #two>! Item was removed: - ----- Method: FFITestIndirectLoopSharedPool class>>two (in category 'definitions') ----- - two - <ffiSharedPool> - <ffiInheritsFrom: #one>! Item was added: + FFIExternalSharedPool subclass: #FFITestStandardExternalSharedPool + instanceVariableNames: '' + classVariableNames: 'EAGAIN EPERM EWOULDBLOCK M_PI ULONG_MAX' + poolDictionaries: '' + category: 'FFI-PoolsTests'! Item was added: + ----- Method: FFITestStandardExternalSharedPool class>>one (in category 'definitions') ----- + one + <ffiExternalSharedPool> + <ffiPlatformName: 'unix'> + <ffiCHeaders: #('<math.h>' '<limits.h>')> + <ffiVariable: #M_PI type: #Float> + <ffiVariable: #ULONG_MAX type: #LargePositiveInteger>! Item was added: + ----- Method: FFITestStandardExternalSharedPool class>>three (in category 'definitions') ----- + three + <ffiExternalSharedPool> + <ffiInheritsFrom: #two> + <ffiCCompiler: 'gcc'> + <ffiVariable: #EAGAIN type: #Integer> + <ffiVariable: #EWOULDBLOCK type: #Integer> + <ffiVariable: #EPERM type: #Boolean>! Item was added: + ----- Method: FFITestStandardExternalSharedPool class>>two (in category 'definitions') ----- + two + <ffiExternalSharedPool> + <ffiPlatformName: 'unix' wordSize: 4> + <ffiCCompiler: 'gcc'> + <ffiCFlags: '-Wall -o'> + <ffiCHeaders: #('<math.h>' '<limits.h>' '<assert.h>')> + <ffiVariable: #M_PI type: #Float> + <ffiVariable: #ULONG_MAX type: #LargePositiveInteger> + <ffiVariable: #EAGAIN type: nil> + <ffiVariable: #EWOULDBLOCK type: nil>! Item was removed: - FFISharedPool subclass: #FFITestStandardSharedPool - instanceVariableNames: '' - classVariableNames: 'EAGAIN EPERM EWOULDBLOCK M_PI ULONG_MAX' - poolDictionaries: '' - category: 'FFI-PoolsTests'! Item was removed: - ----- Method: FFITestStandardSharedPool class>>one (in category 'definitions') ----- - one - <ffiSharedPool> - <ffiPlatformName: 'unix'> - <ffiCHeaders: #('<math.h>' '<limits.h>')> - <ffiVariable: #M_PI type: #Float> - <ffiVariable: #ULONG_MAX type: #LargePositiveInteger>! Item was removed: - ----- Method: FFITestStandardSharedPool class>>three (in category 'definitions') ----- - three - <ffiSharedPool> - <ffiInheritsFrom: #two> - <ffiCCompiler: 'gcc'> - <ffiVariable: #EAGAIN type: #Integer> - <ffiVariable: #EWOULDBLOCK type: #Integer> - <ffiVariable: #EPERM type: #Boolean>! Item was removed: - ----- Method: FFITestStandardSharedPool class>>two (in category 'definitions') ----- - two - <ffiSharedPool> - <ffiPlatformName: 'unix' wordSize: 4> - <ffiCCompiler: 'gcc'> - <ffiCFlags: '-Wall -o'> - <ffiCHeaders: #('<math.h>' '<limits.h>' '<assert.h>')> - <ffiVariable: #M_PI type: #Float> - <ffiVariable: #ULONG_MAX type: #LargePositiveInteger> - <ffiVariable: #EAGAIN type: nil> - <ffiVariable: #EWOULDBLOCK type: nil>! Item was added: + FFIExternalSharedPool subclass: #FFITestUnknownReferenceExternalSharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-PoolsTests'! Item was added: + ----- Method: FFITestUnknownReferenceExternalSharedPool class>>one (in category 'definitions') ----- + one + <ffiExternalSharedPool> + <ffiInheritsFrom: #unknown>! Item was removed: - FFISharedPool subclass: #FFITestUnknownReferenceSharedPool - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-PoolsTests'! Item was removed: - ----- Method: FFITestUnknownReferenceSharedPool class>>one (in category 'definitions') ----- - one - <ffiSharedPool> - <ffiInheritsFrom: #unknown>!

1 0

FFI: FFI-Pools-monty.9.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-monty.9.mcz ==================== Summary ==================== Name: FFI-Pools-monty.9 Author: monty Time: 30 March 2018, 2:25:00.511178 am UUID: 22106a09-fd24-0d00-abe7-71ab0f24d7b0 Ancestors: FFI-Pools-monty.8 renamed every FFISharedPool* class to FFIExternalSharedPool to be more descriptive and avoid conflicting with OSSubProcess. Class comments, generated code prefixes, and the program directory name were also modified for consistency =============== Diff against FFI-Pools-monty.6 =============== Item was added: + ----- Method: Boolean class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitBooleanOutputCodeFor: aVariableName! Item was removed: - ----- Method: Boolean class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitBooleanOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Character class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitCharacterOutputCodeFor: aVariableName! Item was removed: - ----- Method: Character class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitCharacterOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Class>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self! Item was removed: - ----- Method: Class>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - ^ self! Item was added: + SharedPool subclass: #FFIExternalSharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + FFIExternalSharedPool class + instanceVariableNames: 'lastPlatform'! + + !FFIExternalSharedPool commentStamp: 'monty 3/30/2018 02:00' prior: 0! + This is a base class for external FFI SharedPools that use the output of automatically generated C programs to initialize their pool variables.! + FFIExternalSharedPool class + instanceVariableNames: 'lastPlatform'! Item was added: + ----- Method: FFIExternalSharedPool class>>compileGeneratedSourceFile:to:forDefinition: (in category 'private') ----- + compileGeneratedSourceFile: aSourcePathString to: aProgramPathString forDefinition: aDefinition + self + executeExternalCommand: '{1} {2} {3} {4}' + format: + {aDefinition cCompiler. + aDefinition cFlags. + aProgramPathString. + aSourcePathString} + description: 'compile generated source code'! Item was added: + ----- Method: FFIExternalSharedPool class>>declareUndeclaredClassVariableNamed: (in category 'private') ----- + declareUndeclaredClassVariableNamed: aVariableName + (self respondsTo: #addClassVarNamed:) + ifTrue: [ + "for Pharo" + self addClassVarNamed: aVariableName] + ifFalse: [ + "for Squeak" + self addClassVarName: aVariableName]! Item was added: + ----- Method: FFIExternalSharedPool class>>definitionClass (in category 'defaults') ----- + definitionClass + ^ FFIExternalSharedPoolDefinition! Item was added: + ----- Method: FFIExternalSharedPool class>>definitionResolverClass (in category 'defaults') ----- + definitionResolverClass + ^ FFIExternalSharedPoolDefinitionResolver! Item was added: + ----- Method: FFIExternalSharedPool class>>definitions (in category 'accessing') ----- + definitions + | definitions | + + definitions := + OrderedCollection with: + (self definitionClass fromClass: self). + + self class methodsDo: [:each | + (each pragmaAt: #ffiExternalSharedPool) + ifNotNil: [ + definitions addLast: + (self definitionClass fromMethod: each)]]. + + ^ definitions asArray.! Item was added: + ----- Method: FFIExternalSharedPool class>>ensureDirectoryExists: (in category 'private') ----- + ensureDirectoryExists: aDirectoryPath + ^ self environment + at: #FileDirectory + ifPresent: [:fileDirectory | + "use Squeak's FileDirectory" + fileDirectory default assureExistenceOfPath: aDirectoryPath] + ifAbsent: [ + "use Pharo's FileSystem" + aDirectoryPath asFileReference ensureCreateDirectory]! Item was added: + ----- Method: FFIExternalSharedPool class>>errorFailedCommandTo: (in category 'private') ----- + errorFailedCommandTo: aDescription + self error: 'Command executed to ', aDescription, ' failed'! Item was added: + ----- Method: FFIExternalSharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- + errorOSProcessRequiredTo: aDescription + self error: + 'The OSProcess library is needed to execute command to ', aDescription! Item was added: + ----- Method: FFIExternalSharedPool class>>errorSavedPlatform:isNotCompatibleWith: (in category 'private') ----- + errorSavedPlatform: aSavedPlatform isNotCompatibleWith: aCurrentPlatform + self error: + ('The saved platform is incompatible with the current platform: {1} ~= {2}' + format: {aSavedPlatform. aCurrentPlatform})! Item was added: + ----- Method: FFIExternalSharedPool class>>executeExternalCommand:description: (in category 'private') ----- + executeExternalCommand: aCommandString description: aDescription + | commandProcess | + + commandProcess := + (self environment + at: #OSProcess + ifAbsent: [self errorOSProcessRequiredTo: aDescription]) + waitForCommand: aCommandString. + commandProcess succeeded + ifFalse: [self errorFailedCommandTo: aDescription].! Item was added: + ----- Method: FFIExternalSharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- + executeExternalCommand: aString format: aCollection description: aDescription + ^ self + executeExternalCommand: (aString format: aCollection) + description: aDescription! Item was added: + ----- Method: FFIExternalSharedPool class>>generateAllPrograms (in category 'generating') ----- + generateAllPrograms + "self generateAllPrograms" + + self allSubclassesDo: [:each | + each generateProgram]! Item was added: + ----- Method: FFIExternalSharedPool class>>generateProgram (in category 'generating') ----- + generateProgram + "self generateProgram" + + | currentPlatform preferredDefinition sourceFilePath | + + currentPlatform := self platformClass current. + preferredDefinition := + self preferredResolvedDefinitionForPlatform: currentPlatform. + sourceFilePath := self generatedSourceFilePath. + + self ensureDirectoryExists: self generatedProgramDirectory. + self + generateSourceFile: sourceFilePath + forDefinition: preferredDefinition. + self + compileGeneratedSourceFile: sourceFilePath + to: self generatedProgramPath + forDefinition: preferredDefinition.! Item was added: + ----- Method: FFIExternalSharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- + generateSourceFile: aSourceFilePath forDefinition: aDefinition + self + writeStreamOnNewFileAt: aSourceFilePath + do: [:writeStream | + aDefinition generateProgramOn: writeStream]! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramDirectory (in category 'defaults') ----- + generatedProgramDirectory + ^ self vmPath, 'FFIExternalSharedPools/'! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramExtension (in category 'defaults') ----- + generatedProgramExtension + ^ self platformClass isCurrentlyWindows + ifTrue: ['.exe'] + ifFalse: ['']! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramName (in category 'defaults') ----- + generatedProgramName + ^ self name asString, self generatedProgramExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedProgramPath (in category 'defaults') ----- + generatedProgramPath + ^ self generatedProgramDirectory, self generatedProgramName! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- + generatedSourceFileExtension + ^ '.c'! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFileName (in category 'defaults') ----- + generatedSourceFileName + ^ self name asString, self generatedSourceFileExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>generatedSourceFilePath (in category 'defaults') ----- + generatedSourceFilePath + ^ self generatedProgramDirectory, self generatedSourceFileName! Item was added: + ----- Method: FFIExternalSharedPool class>>initialize (in category 'class initialization') ----- + initialize + "self initialize" + + self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was added: + ----- Method: FFIExternalSharedPool class>>lastPlatform (in category 'accessing') ----- + lastPlatform + ^ lastPlatform! Item was added: + ----- Method: FFIExternalSharedPool class>>lastPlatform: (in category 'accessing') ----- + lastPlatform: aPlatform + lastPlatform := aPlatform! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFileExtension (in category 'defaults') ----- + outputFileExtension + ^ '.st'! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFileName (in category 'defaults') ----- + outputFileName + ^ self name asString, self outputFileExtension! Item was added: + ----- Method: FFIExternalSharedPool class>>outputFilePath (in category 'defaults') ----- + outputFilePath + ^ self generatedProgramDirectory, self outputFileName! Item was added: + ----- Method: FFIExternalSharedPool class>>platformClass (in category 'defaults') ----- + platformClass + ^ FFIExternalSharedPoolPlatform! Item was added: + ----- Method: FFIExternalSharedPool class>>preferredResolvedDefinitionForPlatform: (in category 'accessing') ----- + preferredResolvedDefinitionForPlatform: aPlatform + | compatibleResolvedDefinitions | + + compatibleResolvedDefinitions := + self resolvedDefinitions select: [:each | + each platform isCompatibleWith: aPlatform]. + + compatibleResolvedDefinitions sort: [:a :b | + a isMorePlatformSpecificThan: b]. + + ^ compatibleResolvedDefinitions first.! Item was added: + ----- Method: FFIExternalSharedPool class>>readAndEvaluatedGeneratedProgramOutput (in category 'reading') ----- + readAndEvaluatedGeneratedProgramOutput + | generatedProgramOutput | + + generatedProgramOutput := + [self readGeneratedProgramOutput] + on: FileDoesNotExistException + do: [:error | nil]. + "try again, this time running the program first to create the output file" + generatedProgramOutput + ifNil: [ + generatedProgramOutput := + self + runGeneratedProgram; + readGeneratedProgramOutput]. + + ^ self compilerClass evaluate: generatedProgramOutput.! Item was added: + ----- Method: FFIExternalSharedPool class>>readGeneratedProgramOutput (in category 'private') ----- + readGeneratedProgramOutput + ^ self + readStreamOnExistingFileAt: self outputFilePath + do: [:readStream | + readStream upToEnd]! Item was added: + ----- Method: FFIExternalSharedPool class>>readStreamOnExistingFileAt:do: (in category 'private') ----- + readStreamOnExistingFileAt: aPathString do: aBlock + | readStream | + + readStream := StandardFileStream readOnlyFileNamed: aPathString. + ^ [ + readStream ascii. + aBlock value: readStream] + ensure: [readStream close].! Item was added: + ----- Method: FFIExternalSharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeAllSubclassesFromGeneratedProgramOutput + | currentPlatform | + + currentPlatform := self platformClass current. + self allSubclassesDo: [:each | + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform].! Item was added: + ----- Method: FFIExternalSharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutput + "self reinitializeFromGeneratedProgramOutput" + + self reinitializeFromGeneratedProgramOutputForPlatform: + self platformClass current! Item was added: + ----- Method: FFIExternalSharedPool class>>reinitializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutputForPlatform: aPlatform + | outputArray outputPlatform outputVariableDictionary classVariableDictionary | + + outputArray := + self readAndEvaluatedGeneratedProgramOutput. + outputPlatform := outputArray first. + outputVariableDictionary := outputArray second. + + (outputPlatform isCompatibleWith: aPlatform) + ifFalse: [ + self + errorSavedPlatform: outputPlatform + isNotCompatibleWith: aPlatform]. + + classVariableDictionary := self classPool. + outputVariableDictionary keysAndValuesDo: [:key :value | + classVariableDictionary + at: key + ifAbsent: [self declareUndeclaredClassVariableNamed: key]. + classVariableDictionary + at: key + put: value]. + + self lastPlatform: aPlatform.! Item was added: + ----- Method: FFIExternalSharedPool class>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + ^ (self definitionResolverClass + class: self + definitions: self definitions) resolvedDefinitions! Item was added: + ----- Method: FFIExternalSharedPool class>>runGeneratedProgram (in category 'running') ----- + runGeneratedProgram + "self runGeneratedProgram" + + self + executeExternalCommand: 'cd {1}; ./{2} {3}' + format: + {self generatedProgramDirectory. + self generatedProgramName. + self outputFilePath} + description: 'run generated program'! Item was added: + ----- Method: FFIExternalSharedPool class>>startUp: (in category 'system startup') ----- + startUp: isResuming + isResuming + ifTrue: [| currentPlatform | + currentPlatform := self platformClass current. + self allSubclassesDo: [:each | + each lastPlatform = currentPlatform + ifFalse: [ + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform]]] + ifFalse: [self reinitializeAllSubclassesFromGeneratedProgramOutput]! Item was added: + ----- Method: FFIExternalSharedPool class>>vmPath (in category 'defaults') ----- + vmPath + ^ (Smalltalk respondsTo: #vmPath) + ifTrue: [ + "for Squeak" + Smalltalk vmPath] + ifFalse: [ + "for Pharo" + Smalltalk vm path]! Item was added: + ----- Method: FFIExternalSharedPool class>>writeStreamOnNewFileAt:do: (in category 'private') ----- + writeStreamOnNewFileAt: aPathString do: aBlock + | writeStream | + + "use #forceNewFileNamed: to ensure truncation of existing files before writing" + writeStream := StandardFileStream forceNewFileNamed: aPathString. + ^ [ + writeStream ascii. + aBlock value: writeStream] + ensure: [writeStream close].! Item was added: + Object subclass: #FFIExternalSharedPoolDefinition + instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolDefinition commentStamp: 'monty 3/30/2018 02:01' prior: 0! + This class stores parsed FFIExternalSharedPool definitions. It can inherit from another definition with #inheritFrom:, and generate a program with #generateProgramOn:. + + The supported pragmas for methods defining FFIExternalSharedPools are in the "pragmas" category.! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- + defaultCCompiler + ^ 'cc'! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- + defaultCFlags + ^ '-o'! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- + defaultCHeaders + ^ #()! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- + defaultPlatform + ^ self platformClass empty! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- + defaultProgramGeneratorClass + ^ FFIExternalSharedPoolProgramGenerator! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- + defaultVariableType + ^ Integer! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>fromClass: (in category 'instance creation') ----- + fromClass: aClass + | definition | + + (definition := self new) + cCompiler: self defaultCCompiler; + cFlags: self defaultCFlags; + cHeaders: self defaultCHeaders; + platform: self defaultPlatform; + programGeneratorClass: self defaultProgramGeneratorClass. + + aClass classPool keysDo: [:each | + definition + variablesAndTypesAt: each + put: self defaultVariableType]. + + ^ definition.! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- + fromMethod: aCompiledMethod + | definition | + + definition := self name: aCompiledMethod selector. + + "Squeak does not have #pragmasDo:" + aCompiledMethod pragmas do: [:each | + (self whichCategoryIncludesSelector: each keyword) == #'pragmas' + ifTrue: [ + definition + perform: each keyword + withArguments: each arguments]]. + + ^ definition.! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>name: (in category 'instance creation') ----- + name: aSelector + ^ self new name: aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition class>>platformClass (in category 'defaults') ----- + platformClass + ^ FFIExternalSharedPoolPlatform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cCompiler (in category 'accessing') ----- + cCompiler + ^ cCompiler ifNil: [cCompiler := '']! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cCompiler: (in category 'accessing') ----- + cCompiler: aString + cCompiler := aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cFlags (in category 'accessing') ----- + cFlags + ^ cFlags ifNil: [cFlags := '']! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cFlags: (in category 'accessing') ----- + cFlags: aString + cFlags := aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders ifNil: [cHeaders := #()]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cHeaders: (in category 'accessing') ----- + cHeaders: aHeaderPathCollection + cHeaders := + aHeaderPathCollection asArray + select: [:each | each notEmpty] + thenCollect: [:each | + (each first == $" + or: [each first == $<]) + ifTrue: [each] + ifFalse: ['<', each, '>']]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- + cHeadersDo: aBlock + self cHeaders do: aBlock! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- + ffiCCompiler: aString + self cCompiler: aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- + ffiCFlags: aString + self cFlags: aString! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- + ffiCHeaders: aHeaderPathCollection + self cHeaders: aHeaderPathCollection! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiExternalSharedPool (in category 'pragmas') ----- + ffiExternalSharedPool + "this pragma identifies a method defining an external shared pool"! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- + ffiInheritsFrom: aSelector + self inheritsFrom: aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- + ffiPlatformName: aName + self platform: + (self platformClass name: aName)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + self platform: + (self platformClass + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString + wordSize: aWordSize)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName wordSize: aWordSize + self platform: + (self platformClass + name: aName + wordSize: aWordSize)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiProgramGenerator: (in category 'pragmas') ----- + ffiProgramGenerator: aClassName + self programGeneratorClass: + (self class environment at: aClassName asSymbol)! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- + ffiVariable: aVariableName type: aType + self + variablesAndTypesAt: aVariableName + put: aType! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- + generateProgramOn: aStream + (self programGeneratorClass + on: aStream + definition: self) generate! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>inheritFrom: (in category 'inheriting') ----- + inheritFrom: aDefinition + self cCompiler + ifEmpty: [self cCompiler: aDefinition cCompiler]. + self cFlags + ifEmpty: [self cFlags: aDefinition cFlags]. + self cHeaders + ifEmpty: [self cHeaders: aDefinition cHeaders]. + self platform + ifNil: [self platform: aDefinition platform]. + self programGeneratorClass + ifNil: [self programGeneratorClass: aDefinition programGeneratorClass]. + + aDefinition variablesAndTypesDo: [:key :value | + self + variablesAndTypesAt: key + ifAbsentPut: value].! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- + inheritsFrom + ^ inheritsFrom! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- + inheritsFrom: aSelector + inheritsFrom := aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>isDefault (in category 'testing') ----- + isDefault + ^ self name isNil! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- + isMorePlatformSpecificThan: aDefinition + ^ aDefinition isDefault + or: [self platform isMoreSpecificThan: aDefinition platform]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>name: (in category 'accessing') ----- + name: aSelector + name := aSelector! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platform (in category 'accessing') ----- + platform + ^ platform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platform: (in category 'accessing') ----- + platform: aPlatform + platform := aPlatform! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>platformClass (in category 'defaults') ----- + platformClass + ^ self class platformClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + + aStream nextPut: $(. + self isDefault + ifTrue: [aStream nextPutAll: 'default'] + ifFalse: [aStream print: self name]. + aStream nextPut: $).! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- + programGeneratorClass + ^ programGeneratorClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- + programGeneratorClass: aClass + programGeneratorClass := aClass! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- + variablesAndTypes + ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- + variablesAndTypes: anAssociationCollection + variablesAndTypes := Dictionary new. + anAssociationCollection associationsDo: [:each | + self + variablesAndTypesAt: each key + put: each value].! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [nil]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsent: aBlock + ^ self variablesAndTypes + at: aVaraibleName asSymbol + ifAbsent: aBlock! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [ + self + variablesAndTypesAt: aVaraibleName + put: aBlock value]! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName put: aClassOrNil + ^ self variablesAndTypes + at: aVaraibleName asSymbol + put: aClassOrNil asFFIExternalSharedPoolType! Item was added: + ----- Method: FFIExternalSharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- + variablesAndTypesDo: aTwoArgumentBlock + self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was added: + Object subclass: #FFIExternalSharedPoolDefinitionResolver + instanceVariableNames: 'class definitions definitionsByName defaultDefinition unresolvedDefinitions visitedDefintions' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolDefinitionResolver commentStamp: 'monty 3/30/2018 02:01' prior: 0! + This class resolves FFIExternalSharedPoolDefinition inheritance dependencies.! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- + class: aClass definitions: aDefinitionCollection + ^ self new + setClass: aClass + definitions: aDefinitionCollection! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- + errorLoopInDefinitions + self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- + errorUnknownReferenceInDefinition: aDefinition + self error: + ('Unknown reference to definition #{1} in definition #{2} from class {3}' + format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- + resolveDefinition: aDefinition + aDefinition inheritsFrom + ifNil: [aDefinition inheritFrom: defaultDefinition] + ifNotNil: [:inheritsFrom | | inheritedDefinition | + inheritedDefinition := + definitionsByName + at: inheritsFrom + ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. + + (visitedDefintions includes: inheritedDefinition) + ifTrue: [self errorLoopInDefinitions]. + visitedDefintions add: inheritedDefinition. + + (unresolvedDefinitions includes: inheritedDefinition) + ifTrue: [self resolveDefinition: inheritedDefinition]. + + aDefinition inheritFrom: inheritedDefinition]. + + unresolvedDefinitions remove: aDefinition.! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + [unresolvedDefinitions isEmpty] + whileFalse: [| definition | + definition := unresolvedDefinitions anyOne. + visitedDefintions := Set with: definition. + self resolveDefinition: definition]. + + ^ definitions.! Item was added: + ----- Method: FFIExternalSharedPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- + setClass: aClass definitions: aDefinitionCollection + class := aClass. + definitions := aDefinitionCollection. + definitionsByName := Dictionary new. + unresolvedDefinitions := Set new. + definitions do: [:each | + each isDefault + ifTrue: [defaultDefinition := each] + ifFalse: [ + definitionsByName + at: each name + put: each. + unresolvedDefinitions add: each]].! Item was added: + Object subclass: #FFIExternalSharedPoolPlatform + instanceVariableNames: 'name osVersion subtype wordSize' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolPlatform commentStamp: 'monty 3/30/2018 02:00' prior: 0! + A class for storing the platform information for an FFIExternalSharedPool! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>current (in category 'instance creation') ----- + current + ^ self + name: self currentName + osVersion: self currentOSVersion + subtype: self currentSubtype + wordSize: self currentWordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>currentName (in category 'accessing') ----- + currentName + "self currentName" + + ^ Smalltalk os platformName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>currentOSVersion (in category 'accessing') ----- + currentOSVersion + "self currentOSVersion" + + "'Smalltalk os version' and 'Smalltalk osVersion' are not portable to Pharo. + On Squeak: + Smalltalk osVersion = (Smalltalk getSystemAttribute: 1002) asString" + ^ (Smalltalk getSystemAttribute: 1002) asString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>currentSubtype (in category 'accessing') ----- + currentSubtype + "self currentSubtype" + + "'Smalltalk platformSubtype' is not portable to Pharo. + On Squeak: + Smalltalk platformSubtype = (Smalltalk getSystemAttribute: 1003) asString" + ^ (Smalltalk getSystemAttribute: 1003) asString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- + currentWordSize + "self currentWordSize" + + ^ Smalltalk wordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>empty (in category 'instance creation') ----- + empty + ^ self new! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- + isCurrentlyWindows + ^ self currentName asLowercase beginsWith: 'win'! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name: (in category 'instance creation') ----- + name: aName + ^ self new name: aName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString + ^ self new + name: aName; + osVersion: anOSVersionString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name:osVersion:subtype: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name:osVersion:subtype:wordSize: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString; + wordSize: aWordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- + name: aName wordSize: aWordSize + ^ self new + name: aName; + wordSize: aWordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>= (in category 'comparing') ----- + = anObject + self == anObject + ifTrue: [^ true]. + + self species == anObject species + ifFalse: [^ false]. + + ^ self name = anObject name + and: [self osVersion = anObject osVersion + and: [self subtype = anObject subtype + and: [self wordSize = anObject wordSize]]].! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasName (in category 'testing') ----- + hasName + ^ self name notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasOSVersion (in category 'testing') ----- + hasOSVersion + ^ self osVersion notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasSubtype (in category 'testing') ----- + hasSubtype + ^ self subtype notEmpty! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hasWordSize (in category 'testing') ----- + hasWordSize + ^ self wordSize notNil! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>hash (in category 'comparing') ----- + hash + ^ (((self species hash bitXor: + self name hash) bitXor: + self osVersion hash) bitXor: + self subtype hash) bitXor: + self wordSize hash! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>isCompatibleWith: (in category 'testing') ----- + isCompatibleWith: aPlatform + self == aPlatform + ifTrue: [^ true]. + + (self name = aPlatform name + or: [self hasName not + or: [aPlatform hasName not]]) + ifFalse: [^ false]. + + (self osVersion = aPlatform osVersion + or: [self hasOSVersion not + or: [aPlatform hasOSVersion not]]) + ifFalse: [^ false]. + + (self subtype = aPlatform subtype + or: [self hasSubtype not + or: [aPlatform hasSubtype not]]) + ifFalse: [^ false]. + + (self wordSize = aPlatform wordSize + or: [self hasWordSize not + or: [aPlatform hasWordSize not]]) + ifFalse: [^ false]. + + ^ true.! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>isMoreSpecificThan: (in category 'testing') ----- + isMoreSpecificThan: aPlatform + self == aPlatform + ifTrue: [^ false]. + + (self hasName + and: [aPlatform hasName not]) + ifTrue: [^ true]. + + (self hasOSVersion + and: [aPlatform hasOSVersion not]) + ifTrue: [^ true]. + + (self hasSubtype + and: [aPlatform hasSubtype not]) + ifTrue: [^ true]. + + (self hasWordSize + and: [aPlatform hasWordSize not]) + ifTrue: [^ true]. + + ^ false.! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>name (in category 'accessing') ----- + name + ^ name ifNil: [name := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>name: (in category 'accessing') ----- + name: aName + name := aName! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>osVersion (in category 'accessing') ----- + osVersion + ^ osVersion ifNil: [osVersion := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>osVersion: (in category 'accessing') ----- + osVersion: anOSVersionString + osVersion := anOSVersionString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>printOn: (in category 'printing') ----- + printOn: aStream + self storeOn: aStream! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>storeOn: (in category 'printing') ----- + storeOn: aStream + aStream + nextPut: $(; + nextPutAll: self class name asString; + nextPutAll: ' name: '; + print: self name; + nextPutAll: ' osVersion: '; + print: self osVersion; + nextPutAll: ' subtype: '; + print: self subtype; + nextPutAll: ' wordSize: '; + print: self wordSize; + nextPut: $).! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>subtype (in category 'accessing') ----- + subtype + ^ subtype ifNil: [subtype := '']! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>subtype: (in category 'accessing') ----- + subtype: aSubtypeString + subtype := aSubtypeString! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>wordSize (in category 'accessing') ----- + wordSize + ^ wordSize! Item was added: + ----- Method: FFIExternalSharedPoolPlatform>>wordSize: (in category 'accessing') ----- + wordSize: aWordSize + wordSize := aWordSize! Item was added: + Object subclass: #FFIExternalSharedPoolProgramGenerator + instanceVariableNames: 'stream definition' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFIExternalSharedPoolProgramGenerator commentStamp: 'monty 3/30/2018 02:00' prior: 0! + This class generates a program to output an evaluable Smalltalk representation of an FFIExternalSharedPoolDefinition.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator class>>new (in category 'instance creation') ----- + new + self shouldNotImplement! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- + on: aStream definition: aDefinition + ^ self basicNew initialize + setStream: aStream + definition: aDefinition ! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>contents (in category 'accessing') ----- + contents + ^ self stream contents! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- + defaultHeaders + ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>definition (in category 'accessing') ----- + definition + ^ definition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emit: (in category 'emitting') ----- + emit: aCharacter + self stream nextPut: aCharacter! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- + emitAll: aString + self stream nextPutAll: aString asString! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- + emitAll: aTemplateString format: aSequenceableCollectionOrDictionary + "works similar to String>>#format:, except it uses '${xxx}' syntax + for macro expansion, which is more convenient for C" + + | templateReadStream | + + templateReadStream := aTemplateString asString readStream. + [templateReadStream atEnd] + whileFalse: [| nextChar | + ((nextChar := templateReadStream next) == $$ + and: [templateReadStream peekFor: ${]) + ifTrue: [| key | + key := templateReadStream upTo: $}. + self emitAll: + (aSequenceableCollectionOrDictionary at: + (aSequenceableCollectionOrDictionary isDictionary + ifTrue: [key] + ifFalse: [key asUnsignedInteger])) asString] + ifFalse: [self emit: nextChar]].! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- + emitBooleanOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitCharacterOutputCodeFor: (in category 'emitting - output code') ----- + emitCharacterOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ul asCharacter)", (unsigned long) ((${2} < 0) ? 0 : ${2}))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitEndMainFunctionDefinition + self + emitAll: + ' + if (fflush(file) !!= 0) { + ${1}("Can''t flush file", errno); + return EXIT_FAILURE; + } + if (file !!= stdout) { + if (fclose(file) !!= 0) { + ${1}("Can''t close file", errno); + return EXIT_FAILURE; + } + } + + return EXIT_SUCCESS; + } + ' + format: {self errorFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- + emitEndOutputCode + self + emitAll: + ' ${1}(file, "}\n"); + ' + format: {self printfFunctionName} + ! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- + emitEpilog + self emitEndMainFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- + emitErrorFunctionDefinition + self + emitAll: ' + static void ${1}(const char *message, int error) + { + fprintf(stderr, "%s: %s\n", message, strerror(error)); + ${2} + } + ' + format: { + self errorFunctionName. + self generatedProgramExitsOnError + ifTrue: ['exit(EXIT_FAILURE);'] + ifFalse: ['/* no exit on error */']}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFileComment (in category 'emitting') ----- + emitFileComment + self + emitAll: '/* + * This file was automatically generated by ${1}. + * ''${2}'' + * ''${3}'' + */ + + ' + format: {self class name. DateAndTime now. Smalltalk version}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- + emitFloatOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(Float ffiExternalSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- + emitFunctionDefinitions + self + emitErrorFunctionDefinition; + emitPrintfFunctionDefinition; + emitPutcFunctionDefinition; + emitStringOutputFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- + emitHeader: aHeaderPath + self + emitAll: '#include ${1} + ' + format: {aHeaderPath}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- + emitHeaders + self defaultHeaders do: [:each | + self emitHeader: each]. + self definition cHeadersDo: [:each | + self emitHeader: each].! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ld)", (long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- + emitOutputCode + self + emitStartOutputCode; + emitPlatformOutputCode; + emitVariableOutputCode; + emitEndOutputCode! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPlatformOutputCode (in category 'emitting - output code') ----- + emitPlatformOutputCode + self + emitAll: + ' ${1}(file, "\t%s.\n", + ' + format: {self printfFunctionName}. + "serialize the store string as a C string literal with proper escaping" + self + emitStringLiteral: self definition platform storeString; + emitAll: '); + '. + ! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- + emitPrintfFunctionDefinition + self + emitAll: ' + static int ${1}(FILE *file, const char *format, ...) + { + va_list ap; + int rv; + + va_start(ap, format); + if ((rv = vfprintf(file, format, ap)) >= 0) { + va_end(ap); + } else { + int err = errno; /* save errno */ + va_end(ap); + ${2}("Can''t print to file", err); + } + + return rv; + } + ' + format: {self printfFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- + emitProlog + self + emitFileComment; + emitHeaders; + emitFunctionDefinitions; + emitStartMainFunctionDefinition! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- + emitPutcFunctionDefinition + self + emitAll: ' + static int ${1}(int c, FILE *file) + { + int rv; + + if ((rv = fputc(c, file)) == EOF) + ${2}("Can''t print to file", errno); + + return rv; + } + ' + format: {self putcFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitStartMainFunctionDefinition + self + emitAll: ' + int main(int argc, char *argv[]) + { + FILE *file; + + if (argc > 1) { + if ((file = fopen(argv[1], "wb")) == NULL) { + ${1}("Can''t open file", errno); + return EXIT_FAILURE; + } + } else { + file = stdout; + } + + ' + format: {self errorFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- + emitStartOutputCode + self + emitAll: + ' ${1}(file, "{\n"); + ' + format: {self printfFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- + emitStringLiteral: aString + self emit: $". + aString do: [:each | + (each == $" + or: [each == $\]) + ifTrue: [self emit: $\]. + self emit: each]. + self emit: $".! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- + emitStringOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, ${2})' + format: {self stringOutputFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- + emitStringOutputFunctionDefinition + self + emitAll: ' + static void ${1}(FILE *file, const char *s) + { + ${2}(file, "(''"); + while (*s !!= ''\0'') { + if (*s == ''\'''') + ${3}(''\'''', file); /* escape the subquote */ + ${3}(*s++, file); + } + ${2}(file, "'')"); + } + ' + format: + {self stringOutputFunctionName. + self printfFunctionName. + self putcFunctionName}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitUnsignedIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitVariableOutputCode (in category 'emitting - output code') ----- + emitVariableOutputCode + | emittedVariableOutputCode | + + self + emitAll: + ' ${1}(file, "\tDictionary new\n"); + ' + format: {self printfFunctionName}. + + emittedVariableOutputCode := false. + self definition variablesAndTypesDo: [:key :value | + value + ifNotNil: [ + self + emitVariableOutputCodeFor: key + type: value. + emittedVariableOutputCode := true]]. + + emittedVariableOutputCode + ifTrue: [ + self + emitAll: + ' ${1}(file, "\t\tyourself\n"); + ' + format: {self printfFunctionName}].! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>emitVariableOutputCodeFor:type: (in category 'emitting - output code') ----- + emitVariableOutputCodeFor: aVariableName type: aType + self + emitAll: + ' ${1}(file, "\t\tat: #%s put: ", "${2}"); + ' + format: {self printfFunctionName. aVariableName}. + + aType + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName + with: self. + + self + emitAll: + '; + ${1}(file, ";\n"); + ' + format: {self printfFunctionName}.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- + errorFunctionName + ^ self functionNamed: 'Error'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- + functionNamed: aPartialFunctionName + ^ self functionNamespace, aPartialFunctionName! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- + functionNamespace + ^ 'ffiExternalSharedPool'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>generate (in category 'generating') ----- + generate + self + emitProlog; + emitOutputCode; + emitEpilog! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- + generatedProgramExitsOnError + ^ true! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- + printfFunctionName + ^ self functionNamed: 'Printf'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- + putcFunctionName + ^ self functionNamed: 'Putc'! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- + setStream: aStream definition: aDefinition + stream := aStream. + definition := aDefinition.! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>stream (in category 'accessing') ----- + stream + ^ stream! Item was added: + ----- Method: FFIExternalSharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- + stringOutputFunctionName + ^ self functionNamed: 'OutputString'! Item was removed: - SharedPool subclass: #FFISharedPool - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - FFISharedPool class - instanceVariableNames: 'lastPlatform'! - - !FFISharedPool commentStamp: 'monty 3/25/2018 03:57' prior: 0! - This is a base class for FFI SharedPools that use the output of automatically generated C programs to initialize their pool variables.! - FFISharedPool class - instanceVariableNames: 'lastPlatform'! Item was removed: - ----- Method: FFISharedPool class>>compileGeneratedSourceFile:to:forDefinition: (in category 'private') ----- - compileGeneratedSourceFile: aSourcePathString to: aProgramPathString forDefinition: aDefinition - self - executeExternalCommand: '{1} {2} {3} {4}' - format: - {aDefinition cCompiler. - aDefinition cFlags. - aProgramPathString. - aSourcePathString} - description: 'compile generated source code'! Item was removed: - ----- Method: FFISharedPool class>>definitions (in category 'accessing') ----- - definitions - | definitions | - - definitions := - OrderedCollection with: - (FFISharedPoolDefinition fromClass: self). - - self class methodsDo: [:each | - (each pragmaAt: #ffiSharedPool) - ifNotNil: [ - definitions addLast: - (FFISharedPoolDefinition fromMethod: each)]]. - - ^ definitions asArray.! Item was removed: - ----- Method: FFISharedPool class>>ensureDirectoryExists: (in category 'private') ----- - ensureDirectoryExists: aDirectoryPath - ^ self environment - at: #FileDirectory - ifPresent: [:fileDirectory | - "use Squeak's FileDirectory" - fileDirectory default assureExistenceOfPath: aDirectoryPath] - ifAbsent: [ - "use Pharo's FileSystem" - aDirectoryPath asFileReference ensureCreateDirectory]! Item was removed: - ----- Method: FFISharedPool class>>errorFailedCommandTo: (in category 'private') ----- - errorFailedCommandTo: aDescription - self error: 'Command executed to ', aDescription, ' failed'! Item was removed: - ----- Method: FFISharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- - errorOSProcessRequiredTo: aDescription - self error: - 'The OSProcess library is needed to execute command to ', aDescription! Item was removed: - ----- Method: FFISharedPool class>>errorSavedPlatform:isNotCompatibleWith: (in category 'private') ----- - errorSavedPlatform: aSavedPlatform isNotCompatibleWith: aCurrentPlatform - self error: - ('The saved platform is incompatible with the current platform: {1} ~= {2}' - format: {aSavedPlatform. aCurrentPlatform})! Item was removed: - ----- Method: FFISharedPool class>>executeExternalCommand:description: (in category 'private') ----- - executeExternalCommand: aCommandString description: aDescription - | commandProcess | - - commandProcess := - (self environment - at: #OSProcess - ifAbsent: [self errorOSProcessRequiredTo: aDescription]) - waitForCommand: aCommandString. - commandProcess succeeded - ifFalse: [self errorFailedCommandTo: aDescription].! Item was removed: - ----- Method: FFISharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- - executeExternalCommand: aString format: aCollection description: aDescription - ^ self - executeExternalCommand: (aString format: aCollection) - description: aDescription! Item was removed: - ----- Method: FFISharedPool class>>generateAllPrograms (in category 'generating') ----- - generateAllPrograms - "self generateAllPrograms" - - self allSubclassesDo: [:each | - each generateProgram]! Item was removed: - ----- Method: FFISharedPool class>>generateProgram (in category 'generating') ----- - generateProgram - "self generateProgram" - - | currentPlatform preferredDefinition sourceFilePath | - - currentPlatform := FFISharedPoolPlatform current. - preferredDefinition := - self preferredResolvedDefinitionForPlatform: currentPlatform. - sourceFilePath := self generatedSourceFilePath. - - self ensureDirectoryExists: self generatedProgramDirectory. - self - generateSourceFile: sourceFilePath - forDefinition: preferredDefinition. - self - compileGeneratedSourceFile: sourceFilePath - to: self generatedProgramPath - forDefinition: preferredDefinition.! Item was removed: - ----- Method: FFISharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- - generateSourceFile: aSourceFilePath forDefinition: aDefinition - self - writeStreamOnNewFileAt: aSourceFilePath - do: [:writeStream | - aDefinition generateProgramOn: writeStream]! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramDirectory (in category 'defaults') ----- - generatedProgramDirectory - ^ self vmPath, 'FFISharedPools/'! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramExtension (in category 'defaults') ----- - generatedProgramExtension - ^ FFISharedPoolPlatform isCurrentlyWindows - ifTrue: ['.exe'] - ifFalse: ['']! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramName (in category 'defaults') ----- - generatedProgramName - ^ self name asString, self generatedProgramExtension! Item was removed: - ----- Method: FFISharedPool class>>generatedProgramPath (in category 'defaults') ----- - generatedProgramPath - ^ self generatedProgramDirectory, self generatedProgramName! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- - generatedSourceFileExtension - ^ '.c'! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFileName (in category 'defaults') ----- - generatedSourceFileName - ^ self name asString, self generatedSourceFileExtension! Item was removed: - ----- Method: FFISharedPool class>>generatedSourceFilePath (in category 'defaults') ----- - generatedSourceFilePath - ^ self generatedProgramDirectory, self generatedSourceFileName! Item was removed: - ----- Method: FFISharedPool class>>initialize (in category 'class initialization') ----- - initialize - "self initialize" - - self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was removed: - ----- Method: FFISharedPool class>>lastPlatform (in category 'accessing') ----- - lastPlatform - ^ lastPlatform! Item was removed: - ----- Method: FFISharedPool class>>lastPlatform: (in category 'accessing') ----- - lastPlatform: aPlatform - lastPlatform := aPlatform! Item was removed: - ----- Method: FFISharedPool class>>outputFileExtension (in category 'defaults') ----- - outputFileExtension - ^ '.st'! Item was removed: - ----- Method: FFISharedPool class>>outputFileName (in category 'defaults') ----- - outputFileName - ^ self name asString, self outputFileExtension! Item was removed: - ----- Method: FFISharedPool class>>outputFilePath (in category 'defaults') ----- - outputFilePath - ^ self generatedProgramDirectory, self outputFileName! Item was removed: - ----- Method: FFISharedPool class>>preferredResolvedDefinitionForPlatform: (in category 'accessing') ----- - preferredResolvedDefinitionForPlatform: aPlatform - | compatibleResolvedDefinitions | - - compatibleResolvedDefinitions := - self resolvedDefinitions select: [:each | - each platform isCompatibleWith: aPlatform]. - - compatibleResolvedDefinitions sort: [:a :b | - a isMorePlatformSpecificThan: b]. - - ^ compatibleResolvedDefinitions first.! Item was removed: - ----- Method: FFISharedPool class>>readAndEvaluatedGeneratedProgramOutput (in category 'reading') ----- - readAndEvaluatedGeneratedProgramOutput - | generatedProgramOutput | - - generatedProgramOutput := - [self readGeneratedProgramOutput] - on: FileDoesNotExistException - do: [:error | nil]. - "try again, this time running the program first to create the output file" - generatedProgramOutput - ifNil: [ - generatedProgramOutput := - self - runGeneratedProgram; - readGeneratedProgramOutput]. - - ^ self compilerClass evaluate: generatedProgramOutput.! Item was removed: - ----- Method: FFISharedPool class>>readGeneratedProgramOutput (in category 'private') ----- - readGeneratedProgramOutput - ^ self - readStreamOnExistingFileAt: self outputFilePath - do: [:readStream | - readStream upToEnd]! Item was removed: - ----- Method: FFISharedPool class>>readStreamOnExistingFileAt:do: (in category 'private') ----- - readStreamOnExistingFileAt: aPathString do: aBlock - | readStream | - - readStream := StandardFileStream readOnlyFileNamed: aPathString. - ^ [ - readStream ascii. - aBlock value: readStream] - ensure: [readStream close].! Item was removed: - ----- Method: FFISharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- - reinitializeAllSubclassesFromGeneratedProgramOutput - | currentPlatform | - - currentPlatform := FFISharedPoolPlatform current. - self allSubclassesDo: [:each | - each reinitializeFromGeneratedProgramOutputForPlatform: - currentPlatform].! Item was removed: - ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- - reinitializeFromGeneratedProgramOutput - "self reinitializeFromGeneratedProgramOutput" - - self reinitializeFromGeneratedProgramOutputForPlatform: - FFISharedPoolPlatform current! Item was removed: - ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- - reinitializeFromGeneratedProgramOutputForPlatform: aPlatform - | outputArray outputPlatform outputVariableDictionary | - - outputArray := - self readAndEvaluatedGeneratedProgramOutput. - outputPlatform := outputArray first. - outputVariableDictionary := outputArray second. - - (outputPlatform isCompatibleWith: aPlatform) - ifFalse: [ - self - errorSavedPlatform: outputPlatform - isNotCompatibleWith: aPlatform]. - - outputVariableDictionary keysAndValuesDo: [:key :value | - self classPool - at: key - put: value]. - - self lastPlatform: aPlatform.! Item was removed: - ----- Method: FFISharedPool class>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - ^ (FFISharedPoolDefinitionResolver - class: self - definitions: self definitions) resolvedDefinitions! Item was removed: - ----- Method: FFISharedPool class>>runGeneratedProgram (in category 'running') ----- - runGeneratedProgram - "self runGeneratedProgram" - - self - executeExternalCommand: 'cd {1}; ./{2} {3}' - format: - {self generatedProgramDirectory. - self generatedProgramName. - self outputFilePath} - description: 'run generated program'! Item was removed: - ----- Method: FFISharedPool class>>startUp: (in category 'system startup') ----- - startUp: isResuming - isResuming - ifTrue: [| currentPlatform | - currentPlatform := FFISharedPoolPlatform current. - self allSubclassesDo: [:each | - each lastPlatform = currentPlatform - ifFalse: [ - each reinitializeFromGeneratedProgramOutputForPlatform: - currentPlatform]]] - ifFalse: [self reinitializeAllSubclassesFromGeneratedProgramOutput]! Item was removed: - ----- Method: FFISharedPool class>>vmPath (in category 'defaults') ----- - vmPath - ^ (Smalltalk respondsTo: #vmPath) - ifTrue: [ - "for Squeak" - Smalltalk vmPath] - ifFalse: [ - "for Pharo" - Smalltalk vm path]! Item was removed: - ----- Method: FFISharedPool class>>writeStreamOnNewFileAt:do: (in category 'private') ----- - writeStreamOnNewFileAt: aPathString do: aBlock - | writeStream | - - "use #forceNewFileNamed: to ensure truncation of existing files before writing" - writeStream := StandardFileStream forceNewFileNamed: aPathString. - ^ [ - writeStream ascii. - aBlock value: writeStream] - ensure: [writeStream close].! Item was removed: - Object subclass: #FFISharedPoolDefinition - instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFISharedPoolDefinition commentStamp: 'monty 3/29/2018 03:36' prior: 0! - This class stores parsed FFISharedPool definitions. It can inherit from another definition with #inheritFrom:, and generate a program with #generateProgramOn:. - - The supported pragmas for methods defining FFISharedPools are in the "pragmas" category.! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- - defaultCCompiler - ^ 'cc'! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- - defaultCFlags - ^ '-o'! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- - defaultCHeaders - ^ #()! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- - defaultPlatform - ^ FFISharedPoolPlatform empty! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- - defaultProgramGeneratorClass - ^ FFISharedPoolProgramGenerator! Item was removed: - ----- Method: FFISharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- - defaultVariableType - ^ Integer! Item was removed: - ----- Method: FFISharedPoolDefinition class>>fromClass: (in category 'instance creation') ----- - fromClass: aClass - | definition | - - (definition := self new) - cCompiler: self defaultCCompiler; - cFlags: self defaultCFlags; - cHeaders: self defaultCHeaders; - platform: self defaultPlatform; - programGeneratorClass: self defaultProgramGeneratorClass. - - aClass classPool keysDo: [:each | - definition - variablesAndTypesAt: each - put: self defaultVariableType]. - - ^ definition.! Item was removed: - ----- Method: FFISharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- - fromMethod: aCompiledMethod - | definition | - - definition := self name: aCompiledMethod selector. - - "Squeak does not have #pragmasDo:" - aCompiledMethod pragmas do: [:each | - (self whichCategoryIncludesSelector: each keyword) == #'pragmas' - ifTrue: [ - definition - perform: each keyword - withArguments: each arguments]]. - - ^ definition.! Item was removed: - ----- Method: FFISharedPoolDefinition class>>name: (in category 'instance creation') ----- - name: aSelector - ^ self new name: aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>cCompiler (in category 'accessing') ----- - cCompiler - ^ cCompiler ifNil: [cCompiler := '']! Item was removed: - ----- Method: FFISharedPoolDefinition>>cCompiler: (in category 'accessing') ----- - cCompiler: aString - cCompiler := aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>cFlags (in category 'accessing') ----- - cFlags - ^ cFlags ifNil: [cFlags := '']! Item was removed: - ----- Method: FFISharedPoolDefinition>>cFlags: (in category 'accessing') ----- - cFlags: aString - cFlags := aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>cHeaders (in category 'accessing') ----- - cHeaders - ^ cHeaders ifNil: [cHeaders := #()]! Item was removed: - ----- Method: FFISharedPoolDefinition>>cHeaders: (in category 'accessing') ----- - cHeaders: aHeaderPathCollection - cHeaders := - aHeaderPathCollection asArray - select: [:each | each notEmpty] - thenCollect: [:each | - (each first == $" - or: [each first == $<]) - ifTrue: [each] - ifFalse: ['<', each, '>']]! Item was removed: - ----- Method: FFISharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- - cHeadersDo: aBlock - self cHeaders do: aBlock! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- - ffiCCompiler: aString - self cCompiler: aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- - ffiCFlags: aString - self cFlags: aString! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- - ffiCHeaders: aHeaderPathCollection - self cHeaders: aHeaderPathCollection! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- - ffiInheritsFrom: aSelector - self inheritsFrom: aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- - ffiPlatformName: aName - self platform: - (FFISharedPoolPlatform name: aName)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString - self platform: - (FFISharedPoolPlatform - name: aName - osVersion: anOSVersionString)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString - self platform: - (FFISharedPoolPlatform - name: aName - osVersion: anOSVersionString - subtype: aSubtypeString)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- - ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize - self platform: - (FFISharedPoolPlatform - name: aName - osVersion: anOSVersionString - subtype: aSubtypeString - wordSize: aWordSize)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- - ffiPlatformName: aName wordSize: aWordSize - self platform: - (FFISharedPoolPlatform - name: aName - wordSize: aWordSize)! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiProgramGeneratorClass: (in category 'pragmas') ----- - ffiProgramGeneratorClass: aClass - self programGeneratorClass: aClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiSharedPool (in category 'pragmas') ----- - ffiSharedPool! Item was removed: - ----- Method: FFISharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- - ffiVariable: aVariableName type: aType - self - variablesAndTypesAt: aVariableName - put: aType! Item was removed: - ----- Method: FFISharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- - generateProgramOn: aStream - (self programGeneratorClass - on: aStream - definition: self) generate! Item was removed: - ----- Method: FFISharedPoolDefinition>>inheritFrom: (in category 'inheriting') ----- - inheritFrom: aDefinition - self cCompiler - ifEmpty: [self cCompiler: aDefinition cCompiler]. - self cFlags - ifEmpty: [self cFlags: aDefinition cFlags]. - self cHeaders - ifEmpty: [self cHeaders: aDefinition cHeaders]. - self platform - ifNil: [self platform: aDefinition platform]. - self programGeneratorClass - ifNil: [self programGeneratorClass: aDefinition programGeneratorClass]. - - aDefinition variablesAndTypesDo: [:key :value | - self - variablesAndTypesAt: key - ifAbsentPut: value].! Item was removed: - ----- Method: FFISharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- - inheritsFrom - ^ inheritsFrom! Item was removed: - ----- Method: FFISharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- - inheritsFrom: aSelector - inheritsFrom := aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>isDefault (in category 'testing') ----- - isDefault - ^ self name isNil! Item was removed: - ----- Method: FFISharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- - isMorePlatformSpecificThan: aDefinition - ^ aDefinition isDefault - or: [self platform isMoreSpecificThan: aDefinition platform]! Item was removed: - ----- Method: FFISharedPoolDefinition>>name (in category 'accessing') ----- - name - ^ name! Item was removed: - ----- Method: FFISharedPoolDefinition>>name: (in category 'accessing') ----- - name: aSelector - name := aSelector! Item was removed: - ----- Method: FFISharedPoolDefinition>>platform (in category 'accessing') ----- - platform - ^ platform! Item was removed: - ----- Method: FFISharedPoolDefinition>>platform: (in category 'accessing') ----- - platform: aPlatform - platform := aPlatform! Item was removed: - ----- Method: FFISharedPoolDefinition>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - - aStream nextPut: $(. - self isDefault - ifTrue: [aStream nextPutAll: 'default'] - ifFalse: [aStream print: self name]. - aStream nextPut: $).! Item was removed: - ----- Method: FFISharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- - programGeneratorClass - ^ programGeneratorClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- - programGeneratorClass: aClass - programGeneratorClass := aClass! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- - variablesAndTypes - ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- - variablesAndTypes: anAssociationCollection - variablesAndTypes := Dictionary new. - anAssociationCollection associationsDo: [:each | - self - variablesAndTypesAt: each key - put: each value].! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName - ^ self - variablesAndTypesAt: aVaraibleName - ifAbsent: [nil]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName ifAbsent: aBlock - ^ self variablesAndTypes - at: aVaraibleName asSymbol - ifAbsent: aBlock! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock - ^ self - variablesAndTypesAt: aVaraibleName - ifAbsent: [ - self - variablesAndTypesAt: aVaraibleName - put: aBlock value]! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- - variablesAndTypesAt: aVaraibleName put: aClassOrNil - ^ self variablesAndTypes - at: aVaraibleName asSymbol - put: aClassOrNil asFFISharedPoolType! Item was removed: - ----- Method: FFISharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- - variablesAndTypesDo: aTwoArgumentBlock - self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was removed: - Object subclass: #FFISharedPoolDefinitionResolver - instanceVariableNames: 'class definitions definitionsByName defaultDefinition unresolvedDefinitions visitedDefintions' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFISharedPoolDefinitionResolver commentStamp: 'monty 3/29/2018 03:37' prior: 0! - This class resolves FFISharedPoolDefinition inheritance dependencies.! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- - class: aClass definitions: aDefinitionCollection - ^ self new - setClass: aClass - definitions: aDefinitionCollection! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- - errorLoopInDefinitions - self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- - errorUnknownReferenceInDefinition: aDefinition - self error: - ('Unknown reference to definition #{1} in definition #{2} from class {3}' - format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- - resolveDefinition: aDefinition - aDefinition inheritsFrom - ifNil: [aDefinition inheritFrom: defaultDefinition] - ifNotNil: [:inheritsFrom | | inheritedDefinition | - inheritedDefinition := - definitionsByName - at: inheritsFrom - ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. - - (visitedDefintions includes: inheritedDefinition) - ifTrue: [self errorLoopInDefinitions]. - visitedDefintions add: inheritedDefinition. - - (unresolvedDefinitions includes: inheritedDefinition) - ifTrue: [self resolveDefinition: inheritedDefinition]. - - aDefinition inheritFrom: inheritedDefinition]. - - unresolvedDefinitions remove: aDefinition.! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- - resolvedDefinitions - [unresolvedDefinitions isEmpty] - whileFalse: [| definition | - definition := unresolvedDefinitions anyOne. - visitedDefintions := Set with: definition. - self resolveDefinition: definition]. - - ^ definitions.! Item was removed: - ----- Method: FFISharedPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- - setClass: aClass definitions: aDefinitionCollection - class := aClass. - definitions := aDefinitionCollection. - definitionsByName := Dictionary new. - unresolvedDefinitions := Set new. - definitions do: [:each | - each isDefault - ifTrue: [defaultDefinition := each] - ifFalse: [ - definitionsByName - at: each name - put: each. - unresolvedDefinitions add: each]].! Item was removed: - Object subclass: #FFISharedPoolPlatform - instanceVariableNames: 'name osVersion subtype wordSize' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFISharedPoolPlatform commentStamp: 'monty 3/25/2018 04:31' prior: 0! - A class for storing the platform information for an FFISharedPool! Item was removed: - ----- Method: FFISharedPoolPlatform class>>current (in category 'instance creation') ----- - current - ^ self - name: self currentName - osVersion: self currentOSVersion - subtype: self currentSubtype - wordSize: self currentWordSize! Item was removed: - ----- Method: FFISharedPoolPlatform class>>currentName (in category 'accessing') ----- - currentName - "self currentName" - - ^ Smalltalk os platformName! Item was removed: - ----- Method: FFISharedPoolPlatform class>>currentOSVersion (in category 'accessing') ----- - currentOSVersion - "self currentOSVersion" - - "'Smalltalk os version' and 'Smalltalk osVersion' are not portable to Pharo. - On Squeak: - Smalltalk osVersion = (Smalltalk getSystemAttribute: 1002) asString" - ^ (Smalltalk getSystemAttribute: 1002) asString! Item was removed: - ----- Method: FFISharedPoolPlatform class>>currentSubtype (in category 'accessing') ----- - currentSubtype - "self currentSubtype" - - "'Smalltalk platformSubtype' is not portable to Pharo. - On Squeak: - Smalltalk platformSubtype = (Smalltalk getSystemAttribute: 1003) asString" - ^ (Smalltalk getSystemAttribute: 1003) asString! Item was removed: - ----- Method: FFISharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- - currentWordSize - "self currentWordSize" - - ^ Smalltalk wordSize! Item was removed: - ----- Method: FFISharedPoolPlatform class>>empty (in category 'instance creation') ----- - empty - ^ self new! Item was removed: - ----- Method: FFISharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- - isCurrentlyWindows - ^ self currentName asLowercase beginsWith: 'win'! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name: (in category 'instance creation') ----- - name: aName - ^ self new name: aName! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- - name: aName osVersion: anOSVersionString - ^ self new - name: aName; - osVersion: anOSVersionString! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype: (in category 'instance creation') ----- - name: aName osVersion: anOSVersionString subtype: aSubtypeString - ^ self new - name: aName; - osVersion: anOSVersionString; - subtype: aSubtypeString! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype:wordSize: (in category 'instance creation') ----- - name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize - ^ self new - name: aName; - osVersion: anOSVersionString; - subtype: aSubtypeString; - wordSize: aWordSize! Item was removed: - ----- Method: FFISharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- - name: aName wordSize: aWordSize - ^ self new - name: aName; - wordSize: aWordSize! Item was removed: - ----- Method: FFISharedPoolPlatform>>= (in category 'comparing') ----- - = anObject - self == anObject - ifTrue: [^ true]. - - self species == anObject species - ifFalse: [^ false]. - - ^ self name = anObject name - and: [self osVersion = anObject osVersion - and: [self subtype = anObject subtype - and: [self wordSize = anObject wordSize]]].! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasName (in category 'testing') ----- - hasName - ^ self name notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasOSVersion (in category 'testing') ----- - hasOSVersion - ^ self osVersion notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasSubtype (in category 'testing') ----- - hasSubtype - ^ self subtype notEmpty! Item was removed: - ----- Method: FFISharedPoolPlatform>>hasWordSize (in category 'testing') ----- - hasWordSize - ^ self wordSize notNil! Item was removed: - ----- Method: FFISharedPoolPlatform>>hash (in category 'comparing') ----- - hash - ^ (((self species hash bitXor: - self name hash) bitXor: - self osVersion hash) bitXor: - self subtype hash) bitXor: - self wordSize hash! Item was removed: - ----- Method: FFISharedPoolPlatform>>isCompatibleWith: (in category 'testing') ----- - isCompatibleWith: aPlatform - self == aPlatform - ifTrue: [^ true]. - - (self name = aPlatform name - or: [self hasName not - or: [aPlatform hasName not]]) - ifFalse: [^ false]. - - (self osVersion = aPlatform osVersion - or: [self hasOSVersion not - or: [aPlatform hasOSVersion not]]) - ifFalse: [^ false]. - - (self subtype = aPlatform subtype - or: [self hasSubtype not - or: [aPlatform hasSubtype not]]) - ifFalse: [^ false]. - - (self wordSize = aPlatform wordSize - or: [self hasWordSize not - or: [aPlatform hasWordSize not]]) - ifFalse: [^ false]. - - ^ true.! Item was removed: - ----- Method: FFISharedPoolPlatform>>isMoreSpecificThan: (in category 'testing') ----- - isMoreSpecificThan: aPlatform - self == aPlatform - ifTrue: [^ false]. - - (self hasName - and: [aPlatform hasName not]) - ifTrue: [^ true]. - - (self hasOSVersion - and: [aPlatform hasOSVersion not]) - ifTrue: [^ true]. - - (self hasSubtype - and: [aPlatform hasSubtype not]) - ifTrue: [^ true]. - - (self hasWordSize - and: [aPlatform hasWordSize not]) - ifTrue: [^ true]. - - ^ false.! Item was removed: - ----- Method: FFISharedPoolPlatform>>name (in category 'accessing') ----- - name - ^ name ifNil: [name := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>name: (in category 'accessing') ----- - name: aName - name := aName! Item was removed: - ----- Method: FFISharedPoolPlatform>>osVersion (in category 'accessing') ----- - osVersion - ^ osVersion ifNil: [osVersion := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>osVersion: (in category 'accessing') ----- - osVersion: anOSVersionString - osVersion := anOSVersionString! Item was removed: - ----- Method: FFISharedPoolPlatform>>printOn: (in category 'printing') ----- - printOn: aStream - self storeOn: aStream! Item was removed: - ----- Method: FFISharedPoolPlatform>>storeOn: (in category 'printing') ----- - storeOn: aStream - aStream - nextPut: $(; - nextPutAll: self class name asString; - nextPutAll: ' name: '; - print: self name; - nextPutAll: ' osVersion: '; - print: self osVersion; - nextPutAll: ' subtype: '; - print: self subtype; - nextPutAll: ' wordSize: '; - print: self wordSize; - nextPut: $).! Item was removed: - ----- Method: FFISharedPoolPlatform>>subtype (in category 'accessing') ----- - subtype - ^ subtype ifNil: [subtype := '']! Item was removed: - ----- Method: FFISharedPoolPlatform>>subtype: (in category 'accessing') ----- - subtype: aSubtypeString - subtype := aSubtypeString! Item was removed: - ----- Method: FFISharedPoolPlatform>>wordSize (in category 'accessing') ----- - wordSize - ^ wordSize! Item was removed: - ----- Method: FFISharedPoolPlatform>>wordSize: (in category 'accessing') ----- - wordSize: aWordSize - wordSize := aWordSize! Item was removed: - Object subclass: #FFISharedPoolProgramGenerator - instanceVariableNames: 'stream definition' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Pools'! - - !FFISharedPoolProgramGenerator commentStamp: 'monty 3/28/2018 03:11' prior: 0! - This class generates a program to output an evaluable Smalltalk representation of an FFISharedPoolDefinition.! Item was removed: - ----- Method: FFISharedPoolProgramGenerator class>>new (in category 'instance creation') ----- - new - self shouldNotImplement! Item was removed: - ----- Method: FFISharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- - on: aStream definition: aDefinition - ^ self basicNew initialize - setStream: aStream - definition: aDefinition ! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>contents (in category 'accessing') ----- - contents - ^ self stream contents! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- - defaultHeaders - ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>definition (in category 'accessing') ----- - definition - ^ definition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emit: (in category 'emitting') ----- - emit: aCharacter - self stream nextPut: aCharacter! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- - emitAll: aString - self stream nextPutAll: aString asString! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- - emitAll: aTemplateString format: aSequenceableCollectionOrDictionary - "works similar to String>>#format:, except it uses '${xxx}' syntax - for macro expansion, which is more convenient for C" - - | templateReadStream | - - templateReadStream := aTemplateString asString readStream. - [templateReadStream atEnd] - whileFalse: [| nextChar | - ((nextChar := templateReadStream next) == $$ - and: [templateReadStream peekFor: ${]) - ifTrue: [| key | - key := templateReadStream upTo: $}. - self emitAll: - (aSequenceableCollectionOrDictionary at: - (aSequenceableCollectionOrDictionary isDictionary - ifTrue: [key] - ifFalse: [key asUnsignedInteger])) asString] - ifFalse: [self emit: nextChar]].! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- - emitBooleanOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitCharacterOutputCodeFor: (in category 'emitting - output code') ----- - emitCharacterOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%ul asCharacter)", (unsigned long) ((${2} < 0) ? 0 : ${2}))' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- - emitEndMainFunctionDefinition - self - emitAll: - ' - if (file !!= stdout) { - if (fclose(file) !!= 0) { - ${1}("Can''t close file", errno); - return EXIT_FAILURE; - } - } - - return EXIT_SUCCESS; - } - ' format: {self errorFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- - emitEndOutputCode - self - emitAll: - ' ${1}(file, "}\n"); - ' - format: {self printfFunctionName} - ! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- - emitEpilog - self emitEndMainFunctionDefinition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- - emitErrorFunctionDefinition - self - emitAll: ' - static void ${1}(const char *message, int error) - { - fprintf(stderr, "%s: %s\n", message, strerror(error)); - ${2} - } - ' - format: { - self errorFunctionName. - self generatedProgramExitsOnError - ifTrue: ['exit(EXIT_FAILURE);'] - ifFalse: ['/* no exit on error */']}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitFileComment (in category 'emitting') ----- - emitFileComment - self - emitAll: '/* - * This file was automatically generated by ${1}. - * ''${2}'' - * ''${3}'' - */ - - ' - format: {self class name. DateAndTime now. Smalltalk version}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- - emitFloatOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(Float ffiSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- - emitFunctionDefinitions - self - emitErrorFunctionDefinition; - emitPrintfFunctionDefinition; - emitPutcFunctionDefinition; - emitStringOutputFunctionDefinition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- - emitHeader: aHeaderPath - self - emitAll: '#include ${1} - ' - format: {aHeaderPath}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- - emitHeaders - self defaultHeaders do: [:each | - self emitHeader: each]. - self definition cHeadersDo: [:each | - self emitHeader: each].! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%ld)", (long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- - emitOutputCode - self - emitStartOutputCode; - emitPlatformOutputCode; - emitVariableOutputCode; - emitEndOutputCode! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitPlatformOutputCode (in category 'emitting - output code') ----- - emitPlatformOutputCode - self - emitAll: - ' ${1}(file, "\t%s.\n", - ' - format: {self printfFunctionName}. - "serialize the store string as a C string literal with proper escaping" - self - emitStringLiteral: self definition platform storeString; - emitAll: '); - '. - ! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- - emitPrintfFunctionDefinition - self - emitAll: ' - static int ${1}(FILE *file, const char *format, ...) - { - va_list ap; - int rv; - - va_start(ap, format); - if ((rv = vfprintf(file, format, ap)) >= 0) { - va_end(ap); - } else { - int err = errno; /* save errno */ - va_end(ap); - ${2}("Can''t print to file", err); - } - - return rv; - } - ' - format: {self printfFunctionName. self errorFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- - emitProlog - self - emitFileComment; - emitHeaders; - emitFunctionDefinitions; - emitStartMainFunctionDefinition! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- - emitPutcFunctionDefinition - self - emitAll: ' - static int ${1}(int c, FILE *file) - { - int rv; - - if ((rv = fputc(c, file)) == EOF) - ${2}("Can''t print to file", errno); - - return rv; - } - ' - format: {self putcFunctionName. self errorFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- - emitStartMainFunctionDefinition - self - emitAll: ' - int main(int argc, char *argv[]) - { - FILE *file; - - if (argc > 1) { - if ((file = fopen(argv[1], "wb")) == NULL) { - ${1}("Can''t open file", errno); - return EXIT_FAILURE; - } - } else { - file = stdout; - } - - ' - format: {self errorFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- - emitStartOutputCode - self - emitAll: - ' ${1}(file, "{\n"); - ' - format: {self printfFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- - emitStringLiteral: aString - self emit: $". - aString do: [:each | - (each == $" - or: [each == $\]) - ifTrue: [self emit: $\]. - self emit: each]. - self emit: $".! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- - emitStringOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, ${2})' - format: {self stringOutputFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- - emitStringOutputFunctionDefinition - self - emitAll: ' - static void ${1}(FILE *file, const char *s) - { - ${2}(file, "(''"); - while (*s !!= ''\0'') { - if (*s == ''\'''') - ${3}(''\'''', file); /* escape the subquote */ - ${3}(*s++, file); - } - ${2}(file, "'')"); - } - ' - format: - {self stringOutputFunctionName. - self printfFunctionName. - self putcFunctionName}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- - emitUnsignedIntegerOutputCodeFor: anIdentifier - self - emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' - format: {self printfFunctionName. anIdentifier}! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCode (in category 'emitting - output code') ----- - emitVariableOutputCode - | emittedVariableOutputCode | - - self - emitAll: - ' ${1}(file, "\tDictionary new\n"); - ' - format: {self printfFunctionName}. - - emittedVariableOutputCode := false. - self definition variablesAndTypesDo: [:key :value | - value - ifNotNil: [ - self - emitVariableOutputCodeFor: key - type: value. - emittedVariableOutputCode := true]]. - - emittedVariableOutputCode - ifTrue: [ - self - emitAll: - ' ${1}(file, "\t\tyourself\n"); - ' - format: {self printfFunctionName}].! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCodeFor:type: (in category 'emitting - output code') ----- - emitVariableOutputCodeFor: aVariableName type: aType - self - emitAll: - ' ${1}(file, "\t\tat: #%s put: ", "${2}"); - ' - format: {self printfFunctionName. aVariableName}. - - aType - ffiSharedPoolGenerateOutputCodeFor: aVariableName - with: self. - - self - emitAll: - '; - ${1}(file, ";\n"); - ' - format: {self printfFunctionName}.! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- - errorFunctionName - ^ self functionNamed: 'Error'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- - functionNamed: aPartialFunctionName - ^ self functionNamespace, aPartialFunctionName! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- - functionNamespace - ^ 'ffiSharedPool'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>generate (in category 'generating') ----- - generate - self - emitProlog; - emitOutputCode; - emitEpilog! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- - generatedProgramExitsOnError - ^ true! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- - printfFunctionName - ^ self functionNamed: 'Printf'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- - putcFunctionName - ^ self functionNamed: 'Putc'! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- - setStream: aStream definition: aDefinition - stream := aStream. - definition := aDefinition.! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>stream (in category 'accessing') ----- - stream - ^ stream! Item was removed: - ----- Method: FFISharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- - stringOutputFunctionName - ^ self functionNamed: 'OutputString'! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitFloatOutputCodeFor: aVariableName! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolReadFrom: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolReadFrom: aStreamOrString + ^ self + ffiExternalSharedPoolReadFrom: aStreamOrString + ifFail: [nil]! Item was added: + ----- Method: Float class>>ffiExternalSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolReadFrom: aStreamOrString ifFail: aBlock + "This method is a wrapper around #readFrom:ifFail: that adds support + for C's printf() printed float representations of nan and +/- infinity" + + | readStream startPosition isNegative | + + readStream := + aStreamOrString isStream + ifTrue: [aStreamOrString] + ifFalse: [aStreamOrString readStream]. + startPosition := readStream position. + + (isNegative := readStream peekFor: $-) + ifFalse: [readStream peekFor: $+]. + + ((readStream nextMatchAll: 'infinity') + or: [(readStream nextMatchAll: 'INFINITY') + or: [(readStream nextMatchAll: 'inf') + or: [(readStream nextMatchAll: 'INF')]]]) + ifTrue: [ + ^ isNegative + ifTrue: [self negativeInfinity] + ifFalse: [self infinity]]. + + ((readStream nextMatchAll: 'nan') + or: [readStream nextMatchAll: 'NAN']) + ifTrue: [^ self nan]. + + readStream position: startPosition. + ^ self + readFrom: readStream + ifFail: aBlock.! Item was removed: - ----- Method: Float class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitFloatOutputCodeFor: aPoolVariableName! Item was removed: - ----- Method: Float class>>ffiSharedPoolReadFrom: (in category '*FFI-Pools') ----- - ffiSharedPoolReadFrom: aStreamOrString - ^ self - ffiSharedPoolReadFrom: aStreamOrString - ifFail: [nil]! Item was removed: - ----- Method: Float class>>ffiSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- - ffiSharedPoolReadFrom: aStreamOrString ifFail: aBlock - | readStream startPosition isNegative | - - readStream := - aStreamOrString isStream - ifTrue: [aStreamOrString] - ifFalse: [aStreamOrString readStream]. - startPosition := readStream position. - - (isNegative := readStream peekFor: $-) - ifFalse: [readStream peekFor: $+]. - - ((readStream nextMatchAll: 'infinity') - or: [(readStream nextMatchAll: 'INFINITY') - or: [(readStream nextMatchAll: 'inf') - or: [(readStream nextMatchAll: 'INF')]]]) - ifTrue: [ - ^ isNegative - ifTrue: [self negativeInfinity] - ifFalse: [self infinity]]. - - ((readStream nextMatchAll: 'nan') - or: [readStream nextMatchAll: 'NAN']) - ifTrue: [^ self nan]. - - readStream position: startPosition. - ^ self - readFrom: readStream - ifFail: aBlock.! Item was added: + ----- Method: Integer class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: Integer class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: LargePositiveInteger class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitUnsignedIntegerOutputCodeFor: aVariableName! Item was removed: - ----- Method: LargePositiveInteger class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitUnsignedIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Object>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + self error: 'Cannot convert object to type'! Item was removed: - ----- Method: Object>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - self error: 'Cannot convert object to type'! Item was added: + ----- Method: Object>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + self error: 'Cannot generate output code for ', self class name asString! Item was removed: - ----- Method: Object>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - self error: 'Cannot generate output code for ', self class name asString! Item was added: + ----- Method: String class>>ffiExternalSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiExternalSharedPoolGenerateOutputCodeFor: aVariableName with: aProgramGenerator + aProgramGenerator emitStringOutputCodeFor: aVariableName! Item was removed: - ----- Method: String class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- - ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator - aProgramGenerator emitStringOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: String>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self class environment + at: self asSymbol + ifAbsent: [self error: 'Cannot convert object to type']! Item was removed: - ----- Method: String>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - ^ self class environment - at: self asSymbol - ifAbsent: [self error: 'Cannot convert object to type']! Item was added: + ----- Method: UndefinedObject>>asFFIExternalSharedPoolType (in category '*FFI-Pools') ----- + asFFIExternalSharedPoolType + ^ self! Item was removed: - ----- Method: UndefinedObject>>asFFISharedPoolType (in category '*FFI-Pools') ----- - asFFISharedPoolType - ^ self!

1 0

FFI: FFI-PoolsTests-monty.1.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of FFI-PoolsTests to project FFI: http://source.squeak.org/FFI/FFI-PoolsTests-monty.1.mcz ==================== Summary ==================== Name: FFI-PoolsTests-monty.1 Author: monty Time: 29 March 2018, 3:33:37.642076 am UUID: c51bf9e0-e924-0d00-a9ba-bb910f3fa160 Ancestors: some FFISharedPool test classes ==================== Snapshot ==================== SystemOrganization addCategory: #'FFI-PoolsTests'! FFISharedPool subclass: #FFITestDirectLoopSharedPool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-PoolsTests'! ----- Method: FFITestDirectLoopSharedPool class>>one (in category 'definitions') ----- one <ffiSharedPool> <ffiInheritsFrom: #two>! ----- Method: FFITestDirectLoopSharedPool class>>two (in category 'definitions') ----- two <ffiSharedPool> <ffiInheritsFrom: #one>! FFISharedPool subclass: #FFITestIndirectLoopSharedPool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-PoolsTests'! ----- Method: FFITestIndirectLoopSharedPool class>>one (in category 'accessing structure variables') ----- one <ffiSharedPool> <ffiInheritsFrom: #three>! ----- Method: FFITestIndirectLoopSharedPool class>>three (in category 'definitions') ----- three <ffiSharedPool> <ffiInheritsFrom: #two>! ----- Method: FFITestIndirectLoopSharedPool class>>two (in category 'definitions') ----- two <ffiSharedPool> <ffiInheritsFrom: #one>! FFISharedPool subclass: #FFITestStandardSharedPool instanceVariableNames: '' classVariableNames: 'EAGAIN EPERM EWOULDBLOCK M_PI ULONG_MAX' poolDictionaries: '' category: 'FFI-PoolsTests'! ----- Method: FFITestStandardSharedPool class>>one (in category 'definitions') ----- one <ffiSharedPool> <ffiPlatformName: 'unix'> <ffiCHeaders: #('<math.h>' '<limits.h>')> <ffiVariable: #M_PI type: #Float> <ffiVariable: #ULONG_MAX type: #LargePositiveInteger>! ----- Method: FFITestStandardSharedPool class>>three (in category 'definitions') ----- three <ffiSharedPool> <ffiInheritsFrom: #two> <ffiCCompiler: 'gcc'> <ffiVariable: #EAGAIN type: #Integer> <ffiVariable: #EWOULDBLOCK type: #Integer> <ffiVariable: #EPERM type: #Boolean>! ----- Method: FFITestStandardSharedPool class>>two (in category 'definitions') ----- two <ffiSharedPool> <ffiPlatformName: 'unix' wordSize: 4> <ffiCCompiler: 'gcc'> <ffiCFlags: '-Wall -o'> <ffiCHeaders: #('<math.h>' '<limits.h>' '<assert.h>')> <ffiVariable: #M_PI type: #Float> <ffiVariable: #ULONG_MAX type: #LargePositiveInteger> <ffiVariable: #EAGAIN type: nil> <ffiVariable: #EWOULDBLOCK type: nil>! FFISharedPool subclass: #FFITestUnknownReferenceSharedPool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FFI-PoolsTests'! ----- Method: FFITestUnknownReferenceSharedPool class>>one (in category 'definitions') ----- one <ffiSharedPool> <ffiInheritsFrom: #unknown>!

1 0

FFI: FFI-Pools-monty.6.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of FFI-Pools to project FFI: http://source.squeak.org/FFI/FFI-Pools-monty.6.mcz ==================== Summary ==================== Name: FFI-Pools-monty.6 Author: monty Time: 29 March 2018, 4:08:57.771498 am UUID: 30ba575f-ea24-0d00-8ca3-7a300bae9894 Ancestors: FFI-Pools-monty.5 use #compilerClass for Squeak compatibility =============== Diff against FFI-Pools-TorstenBergmann.4 =============== Item was added: + ----- Method: Boolean class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitBooleanOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Character class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitCharacterOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Class>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self! Item was added: + SharedPool subclass: #FFISharedPool + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + FFISharedPool class + instanceVariableNames: 'lastPlatform'! + + !FFISharedPool commentStamp: 'monty 3/25/2018 03:57' prior: 0! + This is a base class for FFI SharedPools that use the output of automatically generated C programs to initialize their pool variables.! + FFISharedPool class + instanceVariableNames: 'lastPlatform'! Item was added: + ----- Method: FFISharedPool class>>compileGeneratedSourceFile:to:forDefinition: (in category 'private') ----- + compileGeneratedSourceFile: aSourcePathString to: aProgramPathString forDefinition: aDefinition + self + executeExternalCommand: '{1} {2} {3} {4}' + format: + {aDefinition cCompiler. + aDefinition cFlags. + aProgramPathString. + aSourcePathString} + description: 'compile generated source code'! Item was added: + ----- Method: FFISharedPool class>>definitions (in category 'accessing') ----- + definitions + | definitions | + + definitions := + OrderedCollection with: + (FFISharedPoolDefinition fromClass: self). + + self class methodsDo: [:each | + (each pragmaAt: #ffiSharedPool) + ifNotNil: [ + definitions addLast: + (FFISharedPoolDefinition fromMethod: each)]]. + + ^ definitions asArray.! Item was added: + ----- Method: FFISharedPool class>>ensureDirectoryExists: (in category 'private') ----- + ensureDirectoryExists: aDirectoryPath + ^ self environment + at: #FileDirectory + ifPresent: [:fileDirectory | + "use Squeak's FileDirectory" + fileDirectory default assureExistenceOfPath: aDirectoryPath] + ifAbsent: [ + "use Pharo's FileSystem" + aDirectoryPath asFileReference ensureCreateDirectory]! Item was added: + ----- Method: FFISharedPool class>>errorFailedCommandTo: (in category 'private') ----- + errorFailedCommandTo: aDescription + self error: 'Command executed to ', aDescription, ' failed'! Item was added: + ----- Method: FFISharedPool class>>errorOSProcessRequiredTo: (in category 'private') ----- + errorOSProcessRequiredTo: aDescription + self error: + 'The OSProcess library is needed to execute command to ', aDescription! Item was added: + ----- Method: FFISharedPool class>>errorSavedPlatform:isNotCompatibleWith: (in category 'private') ----- + errorSavedPlatform: aSavedPlatform isNotCompatibleWith: aCurrentPlatform + self error: + ('The saved platform is incompatible with the current platform: {1} ~= {2}' + format: {aSavedPlatform. aCurrentPlatform})! Item was added: + ----- Method: FFISharedPool class>>executeExternalCommand:description: (in category 'private') ----- + executeExternalCommand: aCommandString description: aDescription + | commandProcess | + + commandProcess := + (self environment + at: #OSProcess + ifAbsent: [self errorOSProcessRequiredTo: aDescription]) + waitForCommand: aCommandString. + commandProcess succeeded + ifFalse: [self errorFailedCommandTo: aDescription].! Item was added: + ----- Method: FFISharedPool class>>executeExternalCommand:format:description: (in category 'private') ----- + executeExternalCommand: aString format: aCollection description: aDescription + ^ self + executeExternalCommand: (aString format: aCollection) + description: aDescription! Item was added: + ----- Method: FFISharedPool class>>generateAllPrograms (in category 'generating') ----- + generateAllPrograms + "self generateAllPrograms" + + self allSubclassesDo: [:each | + each generateProgram]! Item was added: + ----- Method: FFISharedPool class>>generateProgram (in category 'generating') ----- + generateProgram + "self generateProgram" + + | currentPlatform preferredDefinition sourceFilePath | + + currentPlatform := FFISharedPoolPlatform current. + preferredDefinition := + self preferredResolvedDefinitionForPlatform: currentPlatform. + sourceFilePath := self generatedSourceFilePath. + + self ensureDirectoryExists: self generatedProgramDirectory. + self + generateSourceFile: sourceFilePath + forDefinition: preferredDefinition. + self + compileGeneratedSourceFile: sourceFilePath + to: self generatedProgramPath + forDefinition: preferredDefinition.! Item was added: + ----- Method: FFISharedPool class>>generateSourceFile:forDefinition: (in category 'private') ----- + generateSourceFile: aSourceFilePath forDefinition: aDefinition + self + writeStreamOnNewFileAt: aSourceFilePath + do: [:writeStream | + aDefinition generateProgramOn: writeStream]! Item was added: + ----- Method: FFISharedPool class>>generatedProgramDirectory (in category 'defaults') ----- + generatedProgramDirectory + ^ self vmPath, 'FFISharedPools/'! Item was added: + ----- Method: FFISharedPool class>>generatedProgramExtension (in category 'defaults') ----- + generatedProgramExtension + ^ FFISharedPoolPlatform isCurrentlyWindows + ifTrue: ['.exe'] + ifFalse: ['']! Item was added: + ----- Method: FFISharedPool class>>generatedProgramName (in category 'defaults') ----- + generatedProgramName + ^ self name asString, self generatedProgramExtension! Item was added: + ----- Method: FFISharedPool class>>generatedProgramPath (in category 'defaults') ----- + generatedProgramPath + ^ self generatedProgramDirectory, self generatedProgramName! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFileExtension (in category 'defaults') ----- + generatedSourceFileExtension + ^ '.c'! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFileName (in category 'defaults') ----- + generatedSourceFileName + ^ self name asString, self generatedSourceFileExtension! Item was added: + ----- Method: FFISharedPool class>>generatedSourceFilePath (in category 'defaults') ----- + generatedSourceFilePath + ^ self generatedProgramDirectory, self generatedSourceFileName! Item was added: + ----- Method: FFISharedPool class>>initialize (in category 'class initialization') ----- + initialize + "self initialize" + + self reinitializeAllSubclassesFromGeneratedProgramOutput! Item was added: + ----- Method: FFISharedPool class>>lastPlatform (in category 'accessing') ----- + lastPlatform + ^ lastPlatform! Item was added: + ----- Method: FFISharedPool class>>lastPlatform: (in category 'accessing') ----- + lastPlatform: aPlatform + lastPlatform := aPlatform! Item was added: + ----- Method: FFISharedPool class>>outputFileExtension (in category 'defaults') ----- + outputFileExtension + ^ '.st'! Item was added: + ----- Method: FFISharedPool class>>outputFileName (in category 'defaults') ----- + outputFileName + ^ self name asString, self outputFileExtension! Item was added: + ----- Method: FFISharedPool class>>outputFilePath (in category 'defaults') ----- + outputFilePath + ^ self generatedProgramDirectory, self outputFileName! Item was added: + ----- Method: FFISharedPool class>>preferredResolvedDefinitionForPlatform: (in category 'accessing') ----- + preferredResolvedDefinitionForPlatform: aPlatform + | compatibleResolvedDefinitions | + + compatibleResolvedDefinitions := + self resolvedDefinitions select: [:each | + each platform isCompatibleWith: aPlatform]. + + compatibleResolvedDefinitions sort: [:a :b | + a isMorePlatformSpecificThan: b]. + + ^ compatibleResolvedDefinitions first.! Item was added: + ----- Method: FFISharedPool class>>readAndEvaluatedGeneratedProgramOutput (in category 'reading') ----- + readAndEvaluatedGeneratedProgramOutput + | generatedProgramOutput | + + generatedProgramOutput := + [self readGeneratedProgramOutput] + on: FileDoesNotExistException + do: [:error | nil]. + "try again, this time running the program first to create the output file" + generatedProgramOutput + ifNil: [ + generatedProgramOutput := + self + runGeneratedProgram; + readGeneratedProgramOutput]. + + ^ self compilerClass evaluate: generatedProgramOutput.! Item was added: + ----- Method: FFISharedPool class>>readGeneratedProgramOutput (in category 'private') ----- + readGeneratedProgramOutput + ^ self + readStreamOnExistingFileAt: self outputFilePath + do: [:readStream | + readStream upToEnd]! Item was added: + ----- Method: FFISharedPool class>>readStreamOnExistingFileAt:do: (in category 'private') ----- + readStreamOnExistingFileAt: aPathString do: aBlock + | readStream | + + readStream := StandardFileStream readOnlyFileNamed: aPathString. + ^ [ + readStream ascii. + aBlock value: readStream] + ensure: [readStream close].! Item was added: + ----- Method: FFISharedPool class>>reinitializeAllSubclassesFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeAllSubclassesFromGeneratedProgramOutput + | currentPlatform | + + currentPlatform := FFISharedPoolPlatform current. + self allSubclassesDo: [:each | + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform].! Item was added: + ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutput (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutput + "self reinitializeFromGeneratedProgramOutput" + + self reinitializeFromGeneratedProgramOutputForPlatform: + FFISharedPoolPlatform current! Item was added: + ----- Method: FFISharedPool class>>reinitializeFromGeneratedProgramOutputForPlatform: (in category 'class initialization') ----- + reinitializeFromGeneratedProgramOutputForPlatform: aPlatform + | outputArray outputPlatform outputVariableDictionary | + + outputArray := + self readAndEvaluatedGeneratedProgramOutput. + outputPlatform := outputArray first. + outputVariableDictionary := outputArray second. + + (outputPlatform isCompatibleWith: aPlatform) + ifFalse: [ + self + errorSavedPlatform: outputPlatform + isNotCompatibleWith: aPlatform]. + + outputVariableDictionary keysAndValuesDo: [:key :value | + self classPool + at: key + put: value]. + + self lastPlatform: aPlatform.! Item was added: + ----- Method: FFISharedPool class>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + ^ (FFISharedPoolDefinitionResolver + class: self + definitions: self definitions) resolvedDefinitions! Item was added: + ----- Method: FFISharedPool class>>runGeneratedProgram (in category 'running') ----- + runGeneratedProgram + "self runGeneratedProgram" + + self + executeExternalCommand: 'cd {1}; ./{2} {3}' + format: + {self generatedProgramDirectory. + self generatedProgramName. + self outputFilePath} + description: 'run generated program'! Item was added: + ----- Method: FFISharedPool class>>startUp: (in category 'system startup') ----- + startUp: isResuming + isResuming + ifTrue: [| currentPlatform | + currentPlatform := FFISharedPoolPlatform current. + self allSubclassesDo: [:each | + each lastPlatform = currentPlatform + ifFalse: [ + each reinitializeFromGeneratedProgramOutputForPlatform: + currentPlatform]]] + ifFalse: [self reinitializeAllSubclassesFromGeneratedProgramOutput]! Item was added: + ----- Method: FFISharedPool class>>vmPath (in category 'defaults') ----- + vmPath + ^ (Smalltalk respondsTo: #vmPath) + ifTrue: [ + "for Squeak" + Smalltalk vmPath] + ifFalse: [ + "for Pharo" + Smalltalk vm path]! Item was added: + ----- Method: FFISharedPool class>>writeStreamOnNewFileAt:do: (in category 'private') ----- + writeStreamOnNewFileAt: aPathString do: aBlock + | writeStream | + + "use #forceNewFileNamed: to ensure truncation of existing files before writing" + writeStream := StandardFileStream forceNewFileNamed: aPathString. + ^ [ + writeStream ascii. + aBlock value: writeStream] + ensure: [writeStream close].! Item was added: + Object subclass: #FFISharedPoolDefinition + instanceVariableNames: 'name inheritsFrom variablesAndTypes platform cFlags cCompiler cHeaders programGeneratorClass' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolDefinition commentStamp: 'monty 3/29/2018 03:36' prior: 0! + This class stores parsed FFISharedPool definitions. It can inherit from another definition with #inheritFrom:, and generate a program with #generateProgramOn:. + + The supported pragmas for methods defining FFISharedPools are in the "pragmas" category.! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCCompiler (in category 'defaults') ----- + defaultCCompiler + ^ 'cc'! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCFlags (in category 'defaults') ----- + defaultCFlags + ^ '-o'! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultCHeaders (in category 'defaults') ----- + defaultCHeaders + ^ #()! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultPlatform (in category 'defaults') ----- + defaultPlatform + ^ FFISharedPoolPlatform empty! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultProgramGeneratorClass (in category 'defaults') ----- + defaultProgramGeneratorClass + ^ FFISharedPoolProgramGenerator! Item was added: + ----- Method: FFISharedPoolDefinition class>>defaultVariableType (in category 'defaults') ----- + defaultVariableType + ^ Integer! Item was added: + ----- Method: FFISharedPoolDefinition class>>fromClass: (in category 'instance creation') ----- + fromClass: aClass + | definition | + + (definition := self new) + cCompiler: self defaultCCompiler; + cFlags: self defaultCFlags; + cHeaders: self defaultCHeaders; + platform: self defaultPlatform; + programGeneratorClass: self defaultProgramGeneratorClass. + + aClass classPool keysDo: [:each | + definition + variablesAndTypesAt: each + put: self defaultVariableType]. + + ^ definition.! Item was added: + ----- Method: FFISharedPoolDefinition class>>fromMethod: (in category 'instance creation') ----- + fromMethod: aCompiledMethod + | definition | + + definition := self name: aCompiledMethod selector. + + "Squeak does not have #pragmasDo:" + aCompiledMethod pragmas do: [:each | + (self whichCategoryIncludesSelector: each keyword) == #'pragmas' + ifTrue: [ + definition + perform: each keyword + withArguments: each arguments]]. + + ^ definition.! Item was added: + ----- Method: FFISharedPoolDefinition class>>name: (in category 'instance creation') ----- + name: aSelector + ^ self new name: aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>cCompiler (in category 'accessing') ----- + cCompiler + ^ cCompiler ifNil: [cCompiler := '']! Item was added: + ----- Method: FFISharedPoolDefinition>>cCompiler: (in category 'accessing') ----- + cCompiler: aString + cCompiler := aString! Item was added: + ----- Method: FFISharedPoolDefinition>>cFlags (in category 'accessing') ----- + cFlags + ^ cFlags ifNil: [cFlags := '']! Item was added: + ----- Method: FFISharedPoolDefinition>>cFlags: (in category 'accessing') ----- + cFlags: aString + cFlags := aString! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeaders (in category 'accessing') ----- + cHeaders + ^ cHeaders ifNil: [cHeaders := #()]! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeaders: (in category 'accessing') ----- + cHeaders: aHeaderPathCollection + cHeaders := + aHeaderPathCollection asArray + select: [:each | each notEmpty] + thenCollect: [:each | + (each first == $" + or: [each first == $<]) + ifTrue: [each] + ifFalse: ['<', each, '>']]! Item was added: + ----- Method: FFISharedPoolDefinition>>cHeadersDo: (in category 'enumerating') ----- + cHeadersDo: aBlock + self cHeaders do: aBlock! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCCompiler: (in category 'pragmas') ----- + ffiCCompiler: aString + self cCompiler: aString! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCFlags: (in category 'pragmas') ----- + ffiCFlags: aString + self cFlags: aString! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiCHeaders: (in category 'pragmas') ----- + ffiCHeaders: aHeaderPathCollection + self cHeaders: aHeaderPathCollection! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiInheritsFrom: (in category 'pragmas') ----- + ffiInheritsFrom: aSelector + self inheritsFrom: aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName: (in category 'pragmas') ----- + ffiPlatformName: aName + self platform: + (FFISharedPoolPlatform name: aName)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:osVersion:subtype:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + self platform: + (FFISharedPoolPlatform + name: aName + osVersion: anOSVersionString + subtype: aSubtypeString + wordSize: aWordSize)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiPlatformName:wordSize: (in category 'pragmas') ----- + ffiPlatformName: aName wordSize: aWordSize + self platform: + (FFISharedPoolPlatform + name: aName + wordSize: aWordSize)! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiProgramGeneratorClass: (in category 'pragmas') ----- + ffiProgramGeneratorClass: aClass + self programGeneratorClass: aClass! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiSharedPool (in category 'pragmas') ----- + ffiSharedPool! Item was added: + ----- Method: FFISharedPoolDefinition>>ffiVariable:type: (in category 'pragmas') ----- + ffiVariable: aVariableName type: aType + self + variablesAndTypesAt: aVariableName + put: aType! Item was added: + ----- Method: FFISharedPoolDefinition>>generateProgramOn: (in category 'generating') ----- + generateProgramOn: aStream + (self programGeneratorClass + on: aStream + definition: self) generate! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritFrom: (in category 'inheriting') ----- + inheritFrom: aDefinition + self cCompiler + ifEmpty: [self cCompiler: aDefinition cCompiler]. + self cFlags + ifEmpty: [self cFlags: aDefinition cFlags]. + self cHeaders + ifEmpty: [self cHeaders: aDefinition cHeaders]. + self platform + ifNil: [self platform: aDefinition platform]. + self programGeneratorClass + ifNil: [self programGeneratorClass: aDefinition programGeneratorClass]. + + aDefinition variablesAndTypesDo: [:key :value | + self + variablesAndTypesAt: key + ifAbsentPut: value].! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritsFrom (in category 'accessing') ----- + inheritsFrom + ^ inheritsFrom! Item was added: + ----- Method: FFISharedPoolDefinition>>inheritsFrom: (in category 'accessing') ----- + inheritsFrom: aSelector + inheritsFrom := aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>isDefault (in category 'testing') ----- + isDefault + ^ self name isNil! Item was added: + ----- Method: FFISharedPoolDefinition>>isMorePlatformSpecificThan: (in category 'testing') ----- + isMorePlatformSpecificThan: aDefinition + ^ aDefinition isDefault + or: [self platform isMoreSpecificThan: aDefinition platform]! Item was added: + ----- Method: FFISharedPoolDefinition>>name (in category 'accessing') ----- + name + ^ name! Item was added: + ----- Method: FFISharedPoolDefinition>>name: (in category 'accessing') ----- + name: aSelector + name := aSelector! Item was added: + ----- Method: FFISharedPoolDefinition>>platform (in category 'accessing') ----- + platform + ^ platform! Item was added: + ----- Method: FFISharedPoolDefinition>>platform: (in category 'accessing') ----- + platform: aPlatform + platform := aPlatform! Item was added: + ----- Method: FFISharedPoolDefinition>>printOn: (in category 'printing') ----- + printOn: aStream + super printOn: aStream. + + aStream nextPut: $(. + self isDefault + ifTrue: [aStream nextPutAll: 'default'] + ifFalse: [aStream print: self name]. + aStream nextPut: $).! Item was added: + ----- Method: FFISharedPoolDefinition>>programGeneratorClass (in category 'accessing') ----- + programGeneratorClass + ^ programGeneratorClass! Item was added: + ----- Method: FFISharedPoolDefinition>>programGeneratorClass: (in category 'accessing') ----- + programGeneratorClass: aClass + programGeneratorClass := aClass! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypes (in category 'accessing') ----- + variablesAndTypes + ^ variablesAndTypes ifNil: [variablesAndTypes := Dictionary new]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypes: (in category 'accessing') ----- + variablesAndTypes: anAssociationCollection + variablesAndTypes := Dictionary new. + anAssociationCollection associationsDo: [:each | + self + variablesAndTypesAt: each key + put: each value].! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [nil]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsent: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsent: aBlock + ^ self variablesAndTypes + at: aVaraibleName asSymbol + ifAbsent: aBlock! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:ifAbsentPut: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName ifAbsentPut: aBlock + ^ self + variablesAndTypesAt: aVaraibleName + ifAbsent: [ + self + variablesAndTypesAt: aVaraibleName + put: aBlock value]! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesAt:put: (in category 'accessing') ----- + variablesAndTypesAt: aVaraibleName put: aClassOrNil + ^ self variablesAndTypes + at: aVaraibleName asSymbol + put: aClassOrNil asFFISharedPoolType! Item was added: + ----- Method: FFISharedPoolDefinition>>variablesAndTypesDo: (in category 'enumerating') ----- + variablesAndTypesDo: aTwoArgumentBlock + self variablesAndTypes keysAndValuesDo: aTwoArgumentBlock! Item was added: + Object subclass: #FFISharedPoolDefinitionResolver + instanceVariableNames: 'class definitions definitionsByName defaultDefinition unresolvedDefinitions visitedDefintions' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolDefinitionResolver commentStamp: 'monty 3/29/2018 03:37' prior: 0! + This class resolves FFISharedPoolDefinition inheritance dependencies.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver class>>class:definitions: (in category 'instance creation') ----- + class: aClass definitions: aDefinitionCollection + ^ self new + setClass: aClass + definitions: aDefinitionCollection! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>errorLoopInDefinitions (in category 'private') ----- + errorLoopInDefinitions + self error: 'Class ', class name asString, ' has a loop in its definitions'! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>errorUnknownReferenceInDefinition: (in category 'private') ----- + errorUnknownReferenceInDefinition: aDefinition + self error: + ('Unknown reference to definition #{1} in definition #{2} from class {3}' + format: {aDefinition inheritsFrom. aDefinition name. class name})! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>resolveDefinition: (in category 'private') ----- + resolveDefinition: aDefinition + aDefinition inheritsFrom + ifNil: [aDefinition inheritFrom: defaultDefinition] + ifNotNil: [:inheritsFrom | | inheritedDefinition | + inheritedDefinition := + definitionsByName + at: inheritsFrom + ifAbsent: [self errorUnknownReferenceInDefinition: aDefinition]. + + (visitedDefintions includes: inheritedDefinition) + ifTrue: [self errorLoopInDefinitions]. + visitedDefintions add: inheritedDefinition. + + (unresolvedDefinitions includes: inheritedDefinition) + ifTrue: [self resolveDefinition: inheritedDefinition]. + + aDefinition inheritFrom: inheritedDefinition]. + + unresolvedDefinitions remove: aDefinition.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>resolvedDefinitions (in category 'accessing') ----- + resolvedDefinitions + [unresolvedDefinitions isEmpty] + whileFalse: [| definition | + definition := unresolvedDefinitions anyOne. + visitedDefintions := Set with: definition. + self resolveDefinition: definition]. + + ^ definitions.! Item was added: + ----- Method: FFISharedPoolDefinitionResolver>>setClass:definitions: (in category 'initialization') ----- + setClass: aClass definitions: aDefinitionCollection + class := aClass. + definitions := aDefinitionCollection. + definitionsByName := Dictionary new. + unresolvedDefinitions := Set new. + definitions do: [:each | + each isDefault + ifTrue: [defaultDefinition := each] + ifFalse: [ + definitionsByName + at: each name + put: each. + unresolvedDefinitions add: each]].! Item was added: + Object subclass: #FFISharedPoolPlatform + instanceVariableNames: 'name osVersion subtype wordSize' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolPlatform commentStamp: 'monty 3/25/2018 04:31' prior: 0! + A class for storing the platform information for an FFISharedPool! Item was added: + ----- Method: FFISharedPoolPlatform class>>current (in category 'instance creation') ----- + current + ^ self + name: self currentName + osVersion: self currentOSVersion + subtype: self currentSubtype + wordSize: self currentWordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentName (in category 'accessing') ----- + currentName + "self currentName" + + ^ Smalltalk os platformName! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentOSVersion (in category 'accessing') ----- + currentOSVersion + "self currentOSVersion" + + "'Smalltalk os version' and 'Smalltalk osVersion' are not portable to Pharo. + On Squeak: + Smalltalk osVersion = (Smalltalk getSystemAttribute: 1002) asString" + ^ (Smalltalk getSystemAttribute: 1002) asString! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentSubtype (in category 'accessing') ----- + currentSubtype + "self currentSubtype" + + "'Smalltalk platformSubtype' is not portable to Pharo. + On Squeak: + Smalltalk platformSubtype = (Smalltalk getSystemAttribute: 1003) asString" + ^ (Smalltalk getSystemAttribute: 1003) asString! Item was added: + ----- Method: FFISharedPoolPlatform class>>currentWordSize (in category 'accessing') ----- + currentWordSize + "self currentWordSize" + + ^ Smalltalk wordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>empty (in category 'instance creation') ----- + empty + ^ self new! Item was added: + ----- Method: FFISharedPoolPlatform class>>isCurrentlyWindows (in category 'testing') ----- + isCurrentlyWindows + ^ self currentName asLowercase beginsWith: 'win'! Item was added: + ----- Method: FFISharedPoolPlatform class>>name: (in category 'instance creation') ----- + name: aName + ^ self new name: aName! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString + ^ self new + name: aName; + osVersion: anOSVersionString! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:osVersion:subtype:wordSize: (in category 'instance creation') ----- + name: aName osVersion: anOSVersionString subtype: aSubtypeString wordSize: aWordSize + ^ self new + name: aName; + osVersion: anOSVersionString; + subtype: aSubtypeString; + wordSize: aWordSize! Item was added: + ----- Method: FFISharedPoolPlatform class>>name:wordSize: (in category 'instance creation') ----- + name: aName wordSize: aWordSize + ^ self new + name: aName; + wordSize: aWordSize! Item was added: + ----- Method: FFISharedPoolPlatform>>= (in category 'comparing') ----- + = anObject + self == anObject + ifTrue: [^ true]. + + self species == anObject species + ifFalse: [^ false]. + + ^ self name = anObject name + and: [self osVersion = anObject osVersion + and: [self subtype = anObject subtype + and: [self wordSize = anObject wordSize]]].! Item was added: + ----- Method: FFISharedPoolPlatform>>hasName (in category 'testing') ----- + hasName + ^ self name notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasOSVersion (in category 'testing') ----- + hasOSVersion + ^ self osVersion notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasSubtype (in category 'testing') ----- + hasSubtype + ^ self subtype notEmpty! Item was added: + ----- Method: FFISharedPoolPlatform>>hasWordSize (in category 'testing') ----- + hasWordSize + ^ self wordSize notNil! Item was added: + ----- Method: FFISharedPoolPlatform>>hash (in category 'comparing') ----- + hash + ^ (((self species hash bitXor: + self name hash) bitXor: + self osVersion hash) bitXor: + self subtype hash) bitXor: + self wordSize hash! Item was added: + ----- Method: FFISharedPoolPlatform>>isCompatibleWith: (in category 'testing') ----- + isCompatibleWith: aPlatform + self == aPlatform + ifTrue: [^ true]. + + (self name = aPlatform name + or: [self hasName not + or: [aPlatform hasName not]]) + ifFalse: [^ false]. + + (self osVersion = aPlatform osVersion + or: [self hasOSVersion not + or: [aPlatform hasOSVersion not]]) + ifFalse: [^ false]. + + (self subtype = aPlatform subtype + or: [self hasSubtype not + or: [aPlatform hasSubtype not]]) + ifFalse: [^ false]. + + (self wordSize = aPlatform wordSize + or: [self hasWordSize not + or: [aPlatform hasWordSize not]]) + ifFalse: [^ false]. + + ^ true.! Item was added: + ----- Method: FFISharedPoolPlatform>>isMoreSpecificThan: (in category 'testing') ----- + isMoreSpecificThan: aPlatform + self == aPlatform + ifTrue: [^ false]. + + (self hasName + and: [aPlatform hasName not]) + ifTrue: [^ true]. + + (self hasOSVersion + and: [aPlatform hasOSVersion not]) + ifTrue: [^ true]. + + (self hasSubtype + and: [aPlatform hasSubtype not]) + ifTrue: [^ true]. + + (self hasWordSize + and: [aPlatform hasWordSize not]) + ifTrue: [^ true]. + + ^ false.! Item was added: + ----- Method: FFISharedPoolPlatform>>name (in category 'accessing') ----- + name + ^ name ifNil: [name := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>name: (in category 'accessing') ----- + name: aName + name := aName! Item was added: + ----- Method: FFISharedPoolPlatform>>osVersion (in category 'accessing') ----- + osVersion + ^ osVersion ifNil: [osVersion := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>osVersion: (in category 'accessing') ----- + osVersion: anOSVersionString + osVersion := anOSVersionString! Item was added: + ----- Method: FFISharedPoolPlatform>>printOn: (in category 'printing') ----- + printOn: aStream + self storeOn: aStream! Item was added: + ----- Method: FFISharedPoolPlatform>>storeOn: (in category 'printing') ----- + storeOn: aStream + aStream + nextPut: $(; + nextPutAll: self class name asString; + nextPutAll: ' name: '; + print: self name; + nextPutAll: ' osVersion: '; + print: self osVersion; + nextPutAll: ' subtype: '; + print: self subtype; + nextPutAll: ' wordSize: '; + print: self wordSize; + nextPut: $).! Item was added: + ----- Method: FFISharedPoolPlatform>>subtype (in category 'accessing') ----- + subtype + ^ subtype ifNil: [subtype := '']! Item was added: + ----- Method: FFISharedPoolPlatform>>subtype: (in category 'accessing') ----- + subtype: aSubtypeString + subtype := aSubtypeString! Item was added: + ----- Method: FFISharedPoolPlatform>>wordSize (in category 'accessing') ----- + wordSize + ^ wordSize! Item was added: + ----- Method: FFISharedPoolPlatform>>wordSize: (in category 'accessing') ----- + wordSize: aWordSize + wordSize := aWordSize! Item was added: + Object subclass: #FFISharedPoolProgramGenerator + instanceVariableNames: 'stream definition' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Pools'! + + !FFISharedPoolProgramGenerator commentStamp: 'monty 3/28/2018 03:11' prior: 0! + This class generates a program to output an evaluable Smalltalk representation of an FFISharedPoolDefinition.! Item was added: + ----- Method: FFISharedPoolProgramGenerator class>>new (in category 'instance creation') ----- + new + self shouldNotImplement! Item was added: + ----- Method: FFISharedPoolProgramGenerator class>>on:definition: (in category 'instance creation') ----- + on: aStream definition: aDefinition + ^ self basicNew initialize + setStream: aStream + definition: aDefinition ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>contents (in category 'accessing') ----- + contents + ^ self stream contents! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>defaultHeaders (in category 'defaults') ----- + defaultHeaders + ^ #('<errno.h>' '<stdarg.h>' '<stddef.h>' '<stdio.h>' '<stdlib.h>' '<string.h>')! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>definition (in category 'accessing') ----- + definition + ^ definition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emit: (in category 'emitting') ----- + emit: aCharacter + self stream nextPut: aCharacter! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitAll: (in category 'emitting') ----- + emitAll: aString + self stream nextPutAll: aString asString! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitAll:format: (in category 'emitting') ----- + emitAll: aTemplateString format: aSequenceableCollectionOrDictionary + "works similar to String>>#format:, except it uses '${xxx}' syntax + for macro expansion, which is more convenient for C" + + | templateReadStream | + + templateReadStream := aTemplateString asString readStream. + [templateReadStream atEnd] + whileFalse: [| nextChar | + ((nextChar := templateReadStream next) == $$ + and: [templateReadStream peekFor: ${]) + ifTrue: [| key | + key := templateReadStream upTo: $}. + self emitAll: + (aSequenceableCollectionOrDictionary at: + (aSequenceableCollectionOrDictionary isDictionary + ifTrue: [key] + ifFalse: [key asUnsignedInteger])) asString] + ifFalse: [self emit: nextChar]].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitBooleanOutputCodeFor: (in category 'emitting - output code') ----- + emitBooleanOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%s)", (${2} ? "true" : "false"))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitCharacterOutputCodeFor: (in category 'emitting - output code') ----- + emitCharacterOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ul asCharacter)", (unsigned long) ((${2} < 0) ? 0 : ${2}))' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEndMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitEndMainFunctionDefinition + self + emitAll: + ' + if (file !!= stdout) { + if (fclose(file) !!= 0) { + ${1}("Can''t close file", errno); + return EXIT_FAILURE; + } + } + + return EXIT_SUCCESS; + } + ' format: {self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEndOutputCode (in category 'emitting - output code') ----- + emitEndOutputCode + self + emitAll: + ' ${1}(file, "}\n"); + ' + format: {self printfFunctionName} + ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitEpilog (in category 'emitting') ----- + emitEpilog + self emitEndMainFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitErrorFunctionDefinition (in category 'emitting - function definitions') ----- + emitErrorFunctionDefinition + self + emitAll: ' + static void ${1}(const char *message, int error) + { + fprintf(stderr, "%s: %s\n", message, strerror(error)); + ${2} + } + ' + format: { + self errorFunctionName. + self generatedProgramExitsOnError + ifTrue: ['exit(EXIT_FAILURE);'] + ifFalse: ['/* no exit on error */']}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFileComment (in category 'emitting') ----- + emitFileComment + self + emitAll: '/* + * This file was automatically generated by ${1}. + * ''${2}'' + * ''${3}'' + */ + + ' + format: {self class name. DateAndTime now. Smalltalk version}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFloatOutputCodeFor: (in category 'emitting - output code') ----- + emitFloatOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(Float ffiSharedPoolReadFrom: ''%Lg'')", (long double) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitFunctionDefinitions (in category 'emitting - function definitions') ----- + emitFunctionDefinitions + self + emitErrorFunctionDefinition; + emitPrintfFunctionDefinition; + emitPutcFunctionDefinition; + emitStringOutputFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitHeader: (in category 'emitting - headers') ----- + emitHeader: aHeaderPath + self + emitAll: '#include ${1} + ' + format: {aHeaderPath}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitHeaders (in category 'emitting - headers') ----- + emitHeaders + self defaultHeaders do: [:each | + self emitHeader: each]. + self definition cHeadersDo: [:each | + self emitHeader: each].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%ld)", (long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitOutputCode (in category 'emitting - output code') ----- + emitOutputCode + self + emitStartOutputCode; + emitPlatformOutputCode; + emitVariableOutputCode; + emitEndOutputCode! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPlatformOutputCode (in category 'emitting - output code') ----- + emitPlatformOutputCode + self + emitAll: + ' ${1}(file, "\t%s.\n", + ' + format: {self printfFunctionName}. + "serialize the store string as a C string literal with proper escaping" + self + emitStringLiteral: self definition platform storeString; + emitAll: '); + '. + ! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPrintfFunctionDefinition (in category 'emitting - function definitions') ----- + emitPrintfFunctionDefinition + self + emitAll: ' + static int ${1}(FILE *file, const char *format, ...) + { + va_list ap; + int rv; + + va_start(ap, format); + if ((rv = vfprintf(file, format, ap)) >= 0) { + va_end(ap); + } else { + int err = errno; /* save errno */ + va_end(ap); + ${2}("Can''t print to file", err); + } + + return rv; + } + ' + format: {self printfFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitProlog (in category 'emitting') ----- + emitProlog + self + emitFileComment; + emitHeaders; + emitFunctionDefinitions; + emitStartMainFunctionDefinition! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitPutcFunctionDefinition (in category 'emitting - function definitions') ----- + emitPutcFunctionDefinition + self + emitAll: ' + static int ${1}(int c, FILE *file) + { + int rv; + + if ((rv = fputc(c, file)) == EOF) + ${2}("Can''t print to file", errno); + + return rv; + } + ' + format: {self putcFunctionName. self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStartMainFunctionDefinition (in category 'emitting - function definitions') ----- + emitStartMainFunctionDefinition + self + emitAll: ' + int main(int argc, char *argv[]) + { + FILE *file; + + if (argc > 1) { + if ((file = fopen(argv[1], "wb")) == NULL) { + ${1}("Can''t open file", errno); + return EXIT_FAILURE; + } + } else { + file = stdout; + } + + ' + format: {self errorFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStartOutputCode (in category 'emitting - output code') ----- + emitStartOutputCode + self + emitAll: + ' ${1}(file, "{\n"); + ' + format: {self printfFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringLiteral: (in category 'emitting') ----- + emitStringLiteral: aString + self emit: $". + aString do: [:each | + (each == $" + or: [each == $\]) + ifTrue: [self emit: $\]. + self emit: each]. + self emit: $".! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputCodeFor: (in category 'emitting - output code') ----- + emitStringOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, ${2})' + format: {self stringOutputFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitStringOutputFunctionDefinition (in category 'emitting - function definitions') ----- + emitStringOutputFunctionDefinition + self + emitAll: ' + static void ${1}(FILE *file, const char *s) + { + ${2}(file, "(''"); + while (*s !!= ''\0'') { + if (*s == ''\'''') + ${3}(''\'''', file); /* escape the subquote */ + ${3}(*s++, file); + } + ${2}(file, "'')"); + } + ' + format: + {self stringOutputFunctionName. + self printfFunctionName. + self putcFunctionName}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitUnsignedIntegerOutputCodeFor: (in category 'emitting - output code') ----- + emitUnsignedIntegerOutputCodeFor: anIdentifier + self + emitAll: '${1}(file, "(%lu)", (unsigned long) ${2})' + format: {self printfFunctionName. anIdentifier}! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCode (in category 'emitting - output code') ----- + emitVariableOutputCode + | emittedVariableOutputCode | + + self + emitAll: + ' ${1}(file, "\tDictionary new\n"); + ' + format: {self printfFunctionName}. + + emittedVariableOutputCode := false. + self definition variablesAndTypesDo: [:key :value | + value + ifNotNil: [ + self + emitVariableOutputCodeFor: key + type: value. + emittedVariableOutputCode := true]]. + + emittedVariableOutputCode + ifTrue: [ + self + emitAll: + ' ${1}(file, "\t\tyourself\n"); + ' + format: {self printfFunctionName}].! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>emitVariableOutputCodeFor:type: (in category 'emitting - output code') ----- + emitVariableOutputCodeFor: aVariableName type: aType + self + emitAll: + ' ${1}(file, "\t\tat: #%s put: ", "${2}"); + ' + format: {self printfFunctionName. aVariableName}. + + aType + ffiSharedPoolGenerateOutputCodeFor: aVariableName + with: self. + + self + emitAll: + '; + ${1}(file, ";\n"); + ' + format: {self printfFunctionName}.! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>errorFunctionName (in category 'defaults') ----- + errorFunctionName + ^ self functionNamed: 'Error'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>functionNamed: (in category 'defaults') ----- + functionNamed: aPartialFunctionName + ^ self functionNamespace, aPartialFunctionName! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>functionNamespace (in category 'defaults') ----- + functionNamespace + ^ 'ffiSharedPool'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>generate (in category 'generating') ----- + generate + self + emitProlog; + emitOutputCode; + emitEpilog! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>generatedProgramExitsOnError (in category 'testing') ----- + generatedProgramExitsOnError + ^ true! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>printfFunctionName (in category 'defaults') ----- + printfFunctionName + ^ self functionNamed: 'Printf'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>putcFunctionName (in category 'defaults') ----- + putcFunctionName + ^ self functionNamed: 'Putc'! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>setStream:definition: (in category 'initialization') ----- + setStream: aStream definition: aDefinition + stream := aStream. + definition := aDefinition.! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>stream (in category 'accessing') ----- + stream + ^ stream! Item was added: + ----- Method: FFISharedPoolProgramGenerator>>stringOutputFunctionName (in category 'defaults') ----- + stringOutputFunctionName + ^ self functionNamed: 'OutputString'! Item was added: + ----- Method: Float class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitFloatOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Float class>>ffiSharedPoolReadFrom: (in category '*FFI-Pools') ----- + ffiSharedPoolReadFrom: aStreamOrString + ^ self + ffiSharedPoolReadFrom: aStreamOrString + ifFail: [nil]! Item was added: + ----- Method: Float class>>ffiSharedPoolReadFrom:ifFail: (in category '*FFI-Pools') ----- + ffiSharedPoolReadFrom: aStreamOrString ifFail: aBlock + | readStream startPosition isNegative | + + readStream := + aStreamOrString isStream + ifTrue: [aStreamOrString] + ifFalse: [aStreamOrString readStream]. + startPosition := readStream position. + + (isNegative := readStream peekFor: $-) + ifFalse: [readStream peekFor: $+]. + + ((readStream nextMatchAll: 'infinity') + or: [(readStream nextMatchAll: 'INFINITY') + or: [(readStream nextMatchAll: 'inf') + or: [(readStream nextMatchAll: 'INF')]]]) + ifTrue: [ + ^ isNegative + ifTrue: [self negativeInfinity] + ifFalse: [self infinity]]. + + ((readStream nextMatchAll: 'nan') + or: [readStream nextMatchAll: 'NAN']) + ifTrue: [^ self nan]. + + readStream position: startPosition. + ^ self + readFrom: readStream + ifFail: aBlock.! Item was added: + ----- Method: Integer class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: LargePositiveInteger class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitUnsignedIntegerOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: Object>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + self error: 'Cannot convert object to type'! Item was added: + ----- Method: Object>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + self error: 'Cannot generate output code for ', self class name asString! Item was added: + ----- Method: String class>>ffiSharedPoolGenerateOutputCodeFor:with: (in category '*FFI-Pools') ----- + ffiSharedPoolGenerateOutputCodeFor: aPoolVariableName with: aProgramGenerator + aProgramGenerator emitStringOutputCodeFor: aPoolVariableName! Item was added: + ----- Method: String>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self class environment + at: self asSymbol + ifAbsent: [self error: 'Cannot convert object to type']! Item was added: + ----- Method: UndefinedObject>>asFFISharedPoolType (in category '*FFI-Pools') ----- + asFFISharedPoolType + ^ self!

1 0

The Trunk: Morphic-mt.1662.mcz
by commits＠source.squeak.org 27 May '20

27 May '20

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1662.mcz ==================== Summary ==================== Name: Morphic-mt.1662 Author: mt Time: 27 May 2020, 4:30:03.194043 pm UUID: 3e759a12-fae1-084f-8fb2-28de0dc8460b Ancestors: Morphic-mt.1661 Adds "recover method versions" to Extras menu. Complements Tools-mt.970. =============== Diff against Morphic-mt.1661 =============== Item was changed: ----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category 'submenu - extras') ----- extrasMenuOn: aDockingBar aDockingBar addItem: [ :it| it contents: 'Extras' translated; addSubMenu: [:menu| menu addItem:[:item| item contents: 'Recover Changes' translated; help: 'Recover changes after a crash' translated; icon: MenuIcons smallDocumentClockIcon; target: ChangeList; selector: #browseRecentLog]. + menu addItem:[:item| + item + contents: 'Recover Method Versions' translated; + help: 'Recover versions of deleted methods' translated; + target: ChangeList; + selector: #browseMethodVersions]. menu addLine. menu addItem:[:item| item contents: 'Themes & Colors' translated; subMenuUpdater: self selector: #themesAndWindowColorsOn: ]. menu addItem:[:item| item contents: 'Language' translated; subMenuUpdater: self selector: #languageTranslatorsOn: ]. menu addItem:[:item| item contents: 'Set Author Initials' translated; help: 'Sets the author initials' translated; icon: MenuIcons smallUserQuestionIcon; target: Utilities; selector: #setAuthorInitials]. menu addItem:[:item| item contents: 'Restore Display (r)' translated; help: 'Redraws the entire display' translated; target: Project current; selector: #restoreDisplay]. menu addItem:[:item| item contents: 'Rebuild Menus' translated; help: 'Rebuilds the menu bar' translated; target: TheWorldMainDockingBar; selector: #updateInstances]. menu addLine. menu addItem:[:item| item contents: 'Start Profiler' translated; help: 'Starts the profiler' translated; icon: MenuIcons smallTimerIcon; target: self; selector: #startMessageTally]. menu addItem:[:item| item contents: 'Collect Garbage' translated; help: 'Run the garbage collector and report space usage' translated; target: Utilities; selector: #garbageCollectAndReport]. menu addItem:[:item| item contents: 'Purge Undo Records' translated; help: 'Save space by removing all the undo information remembered in all projects' translated; target: CommandHistory; selector: #resetAllHistory]. menu addItem:[:item| item contents: 'VM statistics' translated; help: 'Virtual Machine information' translated; target: self; selector: #vmStatistics]. menu addLine. menu addItem:[:item| item contents: 'Graphical Imports' translated; help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated; target: (Imports default); selector: #viewImages]. menu addItem:[:item| item contents: 'Standard Graphics Library' translated; help: 'Lets you view and change the system''s standard library of graphics' translated; target: ScriptingSystem; selector: #inspectFormDictionary]. menu addItem:[:item| item contents: 'Annotation Setup' translated; help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated; target: Preferences; selector: #editAnnotations]. menu addItem:[:item| item contents: 'Browse My Changes' translated; help: 'Browse all of my changes since the last time #condenseSources was run.' translated; target: SystemNavigation new; selector: #browseMyChanges]. ] ]! Item was changed: + (PackageInfo named: 'Morphic') postscript: 'TheWorldMainDockingBar updateInstances.'! - (PackageInfo named: 'Morphic') postscript: '"Set a smoother scrolling, especially useful for trackpads" - HandMorph minimumWheelDelta: 20. - Smalltalk sendMouseWheelEvents: true.'!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2020