Created
September 19, 2019 20:04
-
-
Save sebres/a63a856933b2a0c3820031bdba0d83a2 to your computer and use it in GitHub Desktop.
Tcl/C ffi -- example illustrating how simple one can create C-binding within tcl using ffidl
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## ------------------------------------------------------------------------------- | |
## ::uuid -- Generate UUID | |
## | |
## Example illustrating how simple one can create C-binding within tcl using ffidl | |
## ------------------------------------------------------------------------------- | |
# ::uuid creator (with on demand binding): | |
proc ::uuid {args} { | |
# create _fdl_uuid binding to UuidCreate : | |
ffidl::callout ::_fdl_uuid {pointer-var} int [ffidl::symbol rpcrt4.dll UuidCreate] stdcall | |
# create wrapper (uuid as hex) : | |
proc ::uuid {args} { | |
set b [::binary format x16] | |
# check returns RPC_S_OK(0) or RPC_S_UUID_LOCAL_ONLY(1824): | |
if {[set ret [::_fdl_uuid b]] ni {0 1824}} { | |
return -code error "generate UUID failed with code $ret" | |
} | |
if {![llength $args]} { | |
binary encode hex $b | |
} else { | |
binary encode {*}$args $b | |
} | |
} | |
::uuid {*}$args | |
} | |
## ---------------------------------------------------- | |
## Usage examples: | |
## ---------------------------------------------------- | |
% uuid; # default hex | |
db5c2944f9be3c4ba2956751515d706e | |
% uuid hex; # as hex | |
8f4d437a541d814484a6e023e4963ad6 | |
% uuid uuencode | |
0%9!=W1FH;4^22VP>QP07RP | |
% uuid base64 | |
Jz9L4ibAa0WKoRTBu41YfQ== | |
## More examples (works only with extended [binary encode]): | |
% uuid 0; # as binary (base 0) | |
°ÔH¨>6MÞ^Þk§gm | |
% uuid basex 62; # base(x) 62 | |
Eefwuky3GtfvPnupfi0yl2 | |
% uuid basex 93; # base(x) 93 | |
@Z|B.RF];@BGE$&8Rh:1 | |
## ---------------------------------------------------- | |
## (Last but not least) the performance: | |
## ---------------------------------------------------- | |
% timerate {uuid 0} | |
0.973097 µs/# 983435 # 1027646 #/sec 956.978 net-ms | |
% timerate {uuid} | |
1.197945 µs/# 805353 # 834762 #/sec 964.769 net-ms |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment