Wiki page
[jimff] by
grable
2018-11-24 13:09:35.
D 2018-11-24T13:09:35.437
L jimff
P b1a97cfa9c5d6f40b66c47bc65ed6d5c3cb35acd00f550c1be28f228097281db
U grable
W 3473
<b>jimff</b>
A foreign function interface extension for <a href="http://jim.tcl.tk">jimtcl</a> using the excellent <a href="https://www.gnu.org/software/libffcall">ffcall</a> library and the platform dynamic library loader.
<a href="/wiki?name=Typetags">Typetag information</a>.
<pre>
> lappend auto_path .
> package require jimff
>
> jimff ff
>
> ff::info -help
ff::load ?-noerror? library... | -self
ff::import ?-function | -variable | -pointer? ?-self | library? {name ?alias?} typetag
ff::callback ?name? command typetag | -update name command
ff::pointer -alloc size | -realloc pointer newsize | -free pointer | -forget pointer | -take pointer ?size? | -size pointer ?newsize? | -null ?pointer? | -validate pointer
ff::unwrap ?-packed? pointer typetag ?varNames...?
ff::wrap ?-packed? pointer typetag values...
ff::gets pointer ?offset? ?varName?
ff::read pointer ?offset? length
ff::write pointer ?offset? string
ff::copy destination ?offset? source ?offset? length
ff::info -help | -libraries | -symbols ?library? | -functions ?library? | -variables ?library? | -callbacks ?-typetags | -commands?
ff::free
>
> ff::info -typetags
v {void}
b {unsigned char}
c {signed char}
C {unsigned char}
s {short}
S {unsigned short}
i {signed int}
I {unsigned int}
l {signed long}
L {unsigned long}
w {signed long long}
W {unsigned long long}
q {signed long long}
Q {unsigned long long}
f {float}
d {double}
p {void*}
P {void*}
x {callback_t}
z {const char*}
Z {char*}
a {int32_t | float | void*}
A {int64_t | double | void*}
>
> set lib [ff::load test_lib.dll]
>
> ff::import -function $lib {__malloc malloc} Pi
> ff::import -function $lib {__strcpy strcpy} ppz
> ff::import -function $lib {__strcat strcat} ppz
> ff::import -function $lib {__free free} vP
>
> ff::import -function test_callback vzx
> set test_1 [ff::callback test_1 iizd] ;# note the use of 'd' here instead of float, because of promotion rules
>
> set p [malloc 64]
> strcpy $p "Hello"
> strcat $p " World!"
> puts p=[ff::gets $p]
p=Hello World!
>
> proc test_1 {i z f} {
> puts "\ti=$i"
> puts "\tz=\"$z\""
> puts "\tf=$f"
> expr $i + 1
> }
> test_callback "message" $test_1
begin test_callback message
i=1
z="2"
f=3.0
result=2
end
</pre>
<hr>
<b>test_lib.c</b> - <i>test_lib.dll</i>
<pre>
typedef intptr_t (*callback_fn)();
__declspec(dllexport) void test_callback( const char* msg, callback_fn callback) {
printf("begin test_callback %s\n", msg);
printf( "result=%d\n", callback( 1, "2", 3.0));
printf( "end\n");
}
__declspec(dllexport) void* __malloc( size_t size) { return malloc(size); }
__declspec(dllexport) void __free( void* p) { free(p); }
__declspec(dllexport) char* __strcpy( char* dst, const char* src) { return strcpy( dst, src); }
__declspec(dllexport) char* __strcat( char* dst, const char* src) { return strcat( dst, src); }
</pre>
Z 9be05c7bedb79aad892bcc012749b004