api[node-ffi] 03 S8FFI

NativeObject
 subclass: #S8FFI
 category: #S8FFI!
S8FFI comment: '
	Implement access to Native Foreign Functions
	@2016 Alejandro Reimondo - [email protected]
	See https://github.com/TooTallNate/node-ffi
'!
#(	FFICIF FFICIFVar
) do: [:each| NodeBuffer subclass: each category: #S8FFI ]!
NativeObject subclass: #S8FFILibrary category: #S8FFI!
#(	FFILibrary FFIDynamicLibrary
) do: [:each| S8FFILibrary subclass: each category: #S8FFI ]!
#(	FFICallback
	FFIFunction FFIForeignFunction FFIVariadicForeignFunction
) do: [:each| NativeObject subclass: each category: #S8FFI ]!

S8FFI class instanceVariableNames: #current!
S8FFI class buildAccessors: #(
	#(current initialize 'self new')
)!
! S8FFI class methodsFor: #accessing !
currentOrNil
	" Returns the current instance (or nil). "

	^current! !

! S8FFI methodsFor: #private !
initializeHandle
	" Private - Initialize the handle of the receiver. "

	[	handle := self require: #ffi
	] on: Error do: [
		handle := self require: #S8FFI
	]! !

S8FFI buildGetters: #(
	version
)!

! S8FFI methodsFor: #constants !
rtld: selector
	" Returns the RTLD_ constant value. "

	| key |
	key := #RTLD_ ,selector asUppercase.
	^self handle basicAt: key ifAbsent: [
		self error: 'Missing/invalid constant name'
	]! !

! S8FFI class methodsFor: #constants !
abi: selector
	" Returns the FFI_<selector>_ABI constant value. "

	^self current abi: selector! !

! S8FFI methodsFor: #constants !
abi: selector
	" Returns the FFI_<selector>_ABI constant value. "

	selector isString ifFalse: [ ^selector ].
	^self ffi: selector asUppercase ,#_ABI! !

! S8FFI methodsFor: #constants !
ffi: selector
	" Returns the FFI_<selector> constant value. "

	| key |
	selector isString ifFalse: [ ^selector ].
	key := #FFI_ ,selector asUppercase.
	^self handle basicAt: key ifAbsent: [
		self error: 'Missing/invalid FFI constant name'
	]! !

! S8FFI methodsFor: #query !
hasObjC
	^self handle basicAt: #HAS_OBJC! !

! S8FFI methodsFor: #constants !
libExt
	^self handle basicAt: #LIB_EXT! !

! S8FFI class methodsFor: #constants !
libExt
	^self current libExt! !

! S8FFI methodsFor: #accessing !
s8Ref
	^self handle basicAt: #S8Ref! !

! S8FFI methodsFor: #accessing !
s8Struct
	^self handle basicAt: #S8Struct! !

! S8FFI methodsFor: #accessing !
functionNamed: functionName

	^self handle
		basicAt: functionName
		ifAbsent: [ self error: functionName ,' function not found' ]! !

! S8FFI methodsFor: #functions !
cif: rtype types: types abi: abi

	^FFICIF @((self functionNamed: #CIF)
		value: rtype json
		value: types json
		value: (self abi: abi) json)! !

! S8FFI methodsFor: #functions !
cifVar: rtype types: types numFixedArgs: numFixedArgs abi: abi

	^FFICIFVar @ ((self functionNamed: #CIF_var)
		value: rtype json value: types json
		value: numFixedArgs
		value: (self abi: abi) json)! !

! S8FFI methodsFor: #functions !
callback: retType argTypes: argTypes abi: abi function: aBlock

	^FFICallback @((self functionNamed: #Callback)
		value: retType json value: argTypes handles
		value: (self abi: abi) json value: aBlock)! !

! S8FFI methodsFor: #functions !
dynamicLibrary: path mode: mode

	^FFIDynamicLibrary @ ((self functionNamed: #DynamicLibrary)
		value: path value: mode json)! !

! S8FFI methodsFor: #functions !
dynamicLibrary: path

	^FFIDynamicLibrary @ ((self functionNamed: #DynamicLibrary) value: path)! !

! S8FFI methodsFor: #functions !
foreignFunction: funcPtr returnType: returnType
	argTypes: argTypes abi: abi

	^FFIForeignFunction @ ((self functionNamed: #ForeignFunction)
		value: funcPtr json
		value: returnType json
		value: argTypes handles
		value: (self abi: abi) json)! !

! S8FFI methodsFor: #functions !
function: returnType argTypes: argTypes abi: abi

	^FFIFunction @ ((self functionNamed: #Function)
		value: returnType json
		value: argTypes handles
		value: (self abi: abi) json)! !

! S8FFI methodsFor: #functions !
library: libfile functions: funcs lib: lib

	^FFILibrary @ ((self functionNamed: #Library)
		value: libfile json
		value: funcs json
		value: lib json)! !

! S8FFI methodsFor: #functions !
library: libfile functions: funcs

	^FFILibrary @ ((self functionNamed: #Library)
		value: libfile json
		value: funcs json)! !

! S8FFI methodsFor: #functions !
variadicForeignFunction: funcPtr returnType: returnType
	fixedArgTypes: fixedArgTypes abi: abi

	^FFIVariadicForeignFunction @((self functionNamed: #VariadicForeignFunction)
		value: funcPtr json
		value: returnType json
		value: fixedArgTypes handles
		value: (self abi: abi) json)! !

! S8FFI methodsFor: #functions !
ffiType: type

	^(self functionNamed: #ffiType)
		value: type json! !

FFIDynamicLibrary buildFunctions: #(
	#(#get: #(symbol) NodeBuffer)
	#(#get:ifAbsent: #(symbol #(callback json)) NodeBuffer)
)!

S8FFILibrary class instanceVariableNames: #current !
S8FFILibrary class buildAccessors: #(
	#(current initialize 'self defaultInstance')
)!

! S8FFILibrary class methodsFor: #accessing !
currentOrNil
	" Returns the current instance of the receiver (or nil). "

	^current! !

! S8FFILibrary class methodsFor: #defaults !
defaultInstance
	" Private - Returns an instance of the receiver constructed from default spec. "

	| lib |
	lib := S8FFI current
		library: self libraryName
		functions: self spec.
	^lib notNil ifTrue: [ self @ lib handle ]! !

! S8FFILibrary class methodsFor: #spec !
libraryName
	" Private - Returns the name of the library file. "

	^self name asLowercase! !

! S8FFILibrary class methodsFor: #spec !
spec
	" Private - Returns the specification of the library functions. "

	^self implementedBySubclass: #spec! !

! S8FFILibrary class methodsFor: #builders !
buildSpec: specs
	" Build spec method. "

	^self build: #Spec -> specs doing: [
		self buildSpecMethod: specs
	]! !

! S8FFILibrary class methodsFor: #builders !
buildSpecMethod: tuples
	" Private - Build (class) method to define spec from tuples. "

	| stream functions |
	stream := '' stream.
	tuples do: [:each|
		(each isArray and: [each size = 2]) ifFalse: [
			self error: 'Invalid tuple ' ,each toString
		].
		(each second isArray and: [each second size = 2]) ifFalse: [
			self error: 'Invalid function types in ' ,each toString
		].
		stream
			nextPut: $(; nextPutAll: each first asLiteral;
			nextPutAll: ' -> ';nextPutAll: each second asLiteral;
			nextPut: $)
	] separatedBy: [ stream nextPutAll: ',';cr;tab;tab ].
	functions := stream contents.
	functions trimBlanks isEmpty ifTrue: [ self error: 'Empty specification literal' ].
	^self class
		implement: #spec
		comment: 'Return the specification of the library functions.'
		as: '^' ,functions category: #spec! !

! S8FFILibrary class methodsFor: #spec !
specLiteral
	" Private - Returns the specification literal of library file.
	The literal must be an array like:
	#(
		#(fnName #(returnType #(#(argName argType)...) ))
		...
	)
	"

	^self implementedBySubclass: #specLiteral! !

! S8FFILibrary class methodsFor: #builders !
buildFromLiteral
	" Build the interface from the specification literal provided by the receiver. "

	^self buildFromLiteral: self specLiteral! !

! S8FFILibrary class methodsFor: #builders !
buildFromLiteral: specs
	" Build the interface from the specification literal. "

	^self build: #FromLiteral -> specs doing: [
		(self buildSpec: (self specFromLiteral: specs))
		,(self buildFunctions: (self functionsFromLiteral: specs))
	]! !

! S8FFILibrary class methodsFor: #spec !
specFromLiteral: spec
	" Private - Return the types in spec definition. "

	(spec isArray and: [spec size = 2]) ifFalse: [ self error: 'Invalid function spec ',spec ].
	spec first isString ifFalse: [ self error: 'FFI return type must be a String' ].
	spec second isArray ifFalse: [ self error: 'FFI arguments must be an Array' ].
	^Array with: spec first with: (spec second collect: [:arg|
		arg isArray ifTrue: [ arg last ] ifFalse: [ arg ]
	])! !

! S8FFILibrary class methodsFor: #spec !
specFromLiteral: specs
	" Private - Return the spec syntetized from specs literal. "

	^specs collect: [:row|
		(row isArray and: [row size = 2]) ifFalse: [ self error: 'Invalid row ',row ].
		row first isString ifFalse: [ self error: 'First must be a function name' ].
		Array with: row first with: (self specTypesIn: row second)
	]! !

! S8FFILibrary class methodsFor: #spec !
specTypesIn: spec
	" Private - Returns the types to define a ffi function. "

	(spec isArray and: [spec size = 2]) ifFalse: [ self error: 'Invalid function spec ',spec printString ].
	spec first isString ifFalse: [ self error: 'First must be a return type' ].
	^Array
		with: (self validFFIReturnTypeFor: spec first)
		with: (spec second collect: [:arg|
			self validFFITypeFor: (arg isString
				ifTrue: [ arg ] ifFalse: [ arg last ])
		])! !

! S8FFILibrary class methodsFor: #spec !
validFFIReturnTypeFor: selector
	" Private - Validate the type selector and returns the FFI type for call return. "

	^self validFFITypeFor: selector! !

! S8FFILibrary class methodsFor: #spec !
validFFITypeFor: selector
	" Private - Validate the type selector and returns the FFI type for selector.
	The default implementation do simple type conversion.
	This method can be refined to validate the existence (and creation on demmand) of the type.
	"

	selector isString ifFalse: [ self error: 'Type selector must be a String' ].
	selector = #bool ifTrue: [ ^#int ].
	^selector! !

! S8FFILibrary class methodsFor: #spec !
functionsFromLiteral: specs
	" Private - Return the spec syntetized from specs literal. "

	^specs collect: [:row| | item returnType |
		(row isArray and: [row size = 2]) ifFalse: [ self error: 'Invalid row ',row ].
		row first isString ifFalse: [ self error: 'First must be a function name' ].
		item := Array
			with: (self selectorForFFICall: row first with: row second second)
			with: (self argumentsForFFICall: row first with: row second second).
		returnType := self functionReturnType: row second first in: row.
		returnType notNil ifTrue: [ item add: returnType ].
		item
	]! !

! S8FFILibrary class methodsFor: #spec !
functionReturnType: ffiType in: ffiFunctionSpec
	" Private - Return the builder return type for ffiType (or nil). "

	(ffiType = 'void*') ifTrue: [ ^#NodeBuffer ].
	ffiType = #bool ifTrue: [ ^#Boolean ].
	(ffiType isString and: [(ffiType includes: $*) not]) ifTrue: [ ^nil ].
	^self complexFunctionReturnType: ffiType in: ffiFunctionSpec! !

! S8FFILibrary class methodsFor: #spec !
complexFunctionReturnType: ffiType in: ffiFunctionSpec
	" Private - Return the builder return type for ffiType (or nil). "

self print: '// complexFunctionReturnType: ',ffiType printString ,' in: ' ,ffiFunctionSpec asLiteral.

	^self implementedBySubclass: #complexFunctionReturnType:in: ! !

! S8FFILibrary class methodsFor: #spec !
selectorForFFICall: ffiName with: args
	" Private - Return the data to build the function. "

	| tail |
	args isEmpty ifTrue: [ ^ffiName ].
	args size = 1 ifTrue: [ ^ffiName ,$: ].
	tail := (args copyFrom: 2 to: args size) inject: '' into: [:total :each|
		total ,(each isString ifTrue: [each] ifFalse: [each first]) ,$:
	].
	^ffiName ,$: ,tail ! !

! S8FFILibrary class methodsFor: #spec !
argumentsForFFICall: ffiName with: args
	" Private - Return the data to build the function. "

	^args collect: [:each|
		self argumentTypeFromFFI: (each isString
			ifTrue: [each] ifFalse: [each first])
	]! !

! S8FFILibrary class methodsFor: #spec !
argumentTypeFromFFI: ffiType
	" Private - Return the API type for ffiType. "

	ffiType = #bool ifTrue: [ ^#int ].
	^ffiType ! !