critcl_howto_use(3tcl) | C Runtime In Tcl (CriTcl) | critcl_howto_use(3tcl) |
critcl_howto_use - How To Use CriTcl
Be welcome to the C Runtime In Tcl (short: CriTcl), a system for embedding and using C code from within Tcl [http://core.tcl-lang.org/tcl] scripts.
This document assumes the presence of a working CriTcl installation.
If that is missing follow the instructions on How To Install CriTcl.
To create a minimal working package
# -*- tcl -*- # Critcl support, absolutely necessary. package require critcl # Bail out early if the compile environment is not suitable. if {![critcl::compiling]} { error "Unable to build project, no proper compiler found." } # Information for the teapot.txt meta data file put into a generated package. # Free form strings. critcl::license {Andreas Kupries} {Under a BSD license} critcl::summary {The first CriTcl-based package} critcl::description { This package is the first example of a CriTcl-based package. It contains all the necessary and conventionally useful pieces. } critcl::subject example {critcl package} critcl::subject {basic critcl} # Minimal Tcl version the package should load into. critcl::tcl 8.6 # Use to activate Tcl memory debugging #critcl::debug memory # Use to activate building and linking with symbols (for gdb, etc.) #critcl::debug symbols # ## #### ######### ################ ######################### ## A hello world, directly printed to stdout. Bypasses Tcl's channel system. critcl::cproc hello {} void { printf("hello world\n"); } # ## #### ######### ################ ######################### # Forcing compilation, link, and loading now. critcl::msg -nonewline { Building ...} if {![critcl::load]} { error "Building and loading the project failed." } # Name and version the package. Just like for every kind of Tcl package. package provide critcl-example 1
critcl -keep -debug all -pkg example.tcl
This compiles the example and installs it into a "lib/" sub directory of the working directory, generating output similar to
Config: linux-x86_64-gcc Build: linux-x86_64-gcc Target: linux-x86_64 Source: example.tcl (provide critcl-example 1) Building ... Library: example.so (tclStubsPtr => const TclStubs *tclStubsPtr;) (tclPlatStubsPtr => const TclPlatStubs *tclPlatStubsPtr;) Package: lib/example Files left in /home/aku/.critcl/pkg2567272.1644845439
The -keep option suppressed the cleanup of the generated C files, object files, compiler log, etc. normally done at the end of building.
% ls -l /home/aku/.critcl/pkg2567272.1644845439 total 36 -rw-r--r-- 1 aku aku 1260 Feb 14 18:30 v3118_00000000000000000000000000000004.c -rw-r--r-- 1 aku aku 2096 Feb 14 18:30 v3118_00000000000000000000000000000004_pic.o -rw-r--r-- 1 aku aku 1728 Feb 14 18:30 v3118_00000000000000000000000000000009.c -rw-r--r-- 1 aku aku 2448 Feb 14 18:30 v3118_00000000000000000000000000000009_pic.o -rwxr-xr-x 1 aku aku 14424 Feb 14 18:30 v3118_00000000000000000000000000000009.so -rw-r--r-- 1 aku aku 1725 Feb 14 18:30 v3118.log
The option -debug, with argument all activated Tcl's memory debugging and caused the generation of the symbol tables needed by gdb or any other debugger. The alternate arguments memory and symbols activate just one of the these.
When the package command is invoked the terminal will show hello world, followed by the prompt.
Commands: critcl::compiling, critcl::cproc, critcl::description, critcl::license, critcl::load, critcl::msg, critcl::subject, critcl::summary, critcl::tcl.
Make a copy of "example.tcl" before going through the sub-sections. Keep it as a save point to return to from the editing done in the sub-section.
A function taking neither arguments nor returning results is not very useful.
critcl::cproc hello {double x} void { /* double x; */ printf("hello world, we have %f\n", x); }
The changed command is now expecting an argument, and we gave it none.
Retry by entering
hello 5
Further try and enter
hello world
These checks (argument count, argument type) are implemented in the translation layer CriTcl generates for the C function. The function body is never invoked.
A function taking neither arguments nor returning results is not very useful.
critcl::cproc twice {double x} double { return 2*x; }
twice 4
An important limitation of the commands implemented so far is that they cannot fail. The types used so far (void, double) and related scalar types can return only a value of the specified type, and nothing else. They have no ability to signal an error to the Tcl script.
We will come back to this after knowing a bit more about the more complex argument and result types.
Of interest to the eager reader: CriTcl cproc Type Reference
critcl::cproc hello {{double > 5 < 22} x} void { /* double x, range 6-21; */ printf("hello world, we have %f\n", x); }
Note that the limiting values have to be proper constant numbers acceptable by the base type. Symbolic values are not accepted.
Here the argument x of the changed function will reject all values outside of the interval 6 to 21.
Tcl prides itself on the fact that Everything Is A String. So how are string values passed into C functions ?
critcl::cproc hello {pstring x} void { /* critcl_pstring x (.s, .len, .o); */ printf("hello world, from %s (%d bytes)\n", x.s, x.len); }
critcl::cproc hello {char* x} void { /* char* x; */ printf("hello world, from %s\n", x); }
Tcl prides itself on the fact that Everything Is A String. So how are string values returned from C functions ?
critcl::cproc twice {double x} char* { char buf [lb]40[rb]; sprintf(buf, "%f", 2*x); return buf; }
twice 4
While the C code is certainly allowed to allocate the string on the heap if it so wishes, this comes with the responsibility to free the string as well. Abrogation of that responsibility will cause memory leaks.
The type char* is recommended to be used with static string buffers, string constants and the like.
Replace the definition of twice with
critcl::cproc twice {double x} string { char* buf = Tcl_Alloc (40); sprintf(buf, "%f", 2*x); return buf; }
Now the translation layer takes ownership of the string from the C code and transfers that ownership to the Tcl interpreter. This means that the string will be released when the Tcl interpreter is done with it. The C code has no say in the lifecycle of the string any longer, and having the C code releasing the string will cause issues. Dangling pointers and associated memory corruption and crashes.
Even as a string-oriented language Tcl is capable of handling more complex structures. The first of it, with Tcl since the beginning are lists. Sets of values indexed by a numeric value.
In C parlance, arrays.
critcl::cproc hello {list x} void { /* critcl_list x (.o, .v, .c); */ printf("hello world, %d elements in (%s)\n", x.c, Tcl_GetString (x.o)); }
The field .v, not used above, is the C array holding the Tcl_Obj* pointers to the list elements.
As mentioned at the end of section List Arguments the basic list type places no constraints on the size of the list, nor on the type of the elements.
Both kind of constraints can be done however, alone or together.
critcl::cproc hello {[5] x} void { /* critcl_list x (.o, .v, .c); */ printf("hello world, %d elements in (%s)\n", x.c, Tcl_GetString (x.o)); }
int[]
[]int
int[5]
[5]int
int a[]
int a[5]
When the set of predefined argument types is not enough the oldest way of handling the situation is falling back to the structures used by Tcl to manage values, i.e. Tcl_Obj*.
critcl::cproc hello {object x} void { /* Tcl_Obj* x */ int len; char* str = Tcl_GetStringFromObj (x, &len); printf("hello world, from %s (%d bytes)\n", str, len); }
In other words, the C code becomes responsible for handling the reference counts correctly, for duplicating shared Tcl_Obj* structures before modifying them, etc.
One thing the C code is allowed to do without restriction is to shimmer the internal representation of the value as needed, through the associated Tcl API functions. For example Tcl_GetWideIntFromObj and the like. It actually has to be allowed to do so, as the type checking done as part of such conversions is now the responsibility of the C code as well.
For the predefined types this is all hidden in the translation layer generated by CriTcl.
If more than one command has to perform the same kind of checking and/or conversion it is recommended to move the core of the code into proper C functions for proper sharing among the commands.
We will come back to this.
When the set of predefined result types is not enough the oldest way of handling the situation is falling back to the structures used by Tcl to manage values, i.e. Tcl_Obj*.
Two builtin types are provided for this, to handle different reference counting requirements.
critcl::cproc twice {double x} object0 { return Tcl_NewDoubleObj(2*x); }
This value is passed directly to Tcl for its use, without any changes. Tcl increments the reference count and thus takes ownership. The value is still unshared.
It would be extremely detrimental if the translation layer had decremented the reference count before passing the value. This action would release the memory and then leave Tcl with a dangling pointer and the associated memory corruption bug to come.
critcl::cproc twice {double x} object { Tcl_Obj* result = Tcl_NewDoubleObj(2*x); Tcl_IncrRefCount (result); return result; }
Note, the order matters. If the value has only one reference then decrementing it before Tcl increments it would again release the value, and again leave Tcl with a dangling pointer.
Also, not decrementing the reference count at all causes the inverse problem to the memory corruption issues of before, memory leaks.
critcl::cproc sqrt { Tcl_Interp* interp double x } object0 { if (x < 0) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("Expected double >=0, but got \"%d\"", x)); Tcl_SetErrorCode (interp, "EXAMPLE", "BAD", "DOMAIN", NULL); return NULL; } return Tcl_NewDoubleObj(sqrt(x)); }
Using functions from Tcl's public C API taking an interpreter argument in the function body is a situation where this is needed.
critcl::cproc hello {bytes x} void { /* critcl_bytes x (.s, .len, .o); */ printf("hello world, with %d bytes \n data: ", x.len); for (i = 0; i < x.len; i++) { printf(" %02x", x.s[i]); if (i % 16 == 15) printf ("\ndata: "); } if (i % 16 != 0) printf ("\n"); }
# P5 3 3 255 \n ... critcl::cdata cross3x3pgm { 80 52 32 51 32 51 32 50 53 53 10 0 255 0 255 255 255 0 255 0 }
This determines which Tcl headers all files are compiled against, and what version of the public Tcl API is available to the C code.
Currently 8.4, 8.5 and 8.6 are supported.
If not specified 8.4 is assumed.
critcl::cproc greetings::hello {} void { printf("hello world\n"); } critcl::cproc greetings::hi {} void { printf("hi you\n"); }
namespace eval greetings { namespace export hello hi namespace ensemble create }
critcl::tsources example-policy.tcl
The commands in the namespace have been registered as methods of the ensemble.
They can now be invoked as
greetings hello greetings hi
New commands: critcl::tsources
critcl::debug memory ;# Activate Tcl memory debugging (-DTCL_MEM_DEBUG) critcl::debug symbols ;# Activate building and linking with debugger symbols (-g) critcl::debug all ;# Shorthand for both `memory` and `symbols`.
For the purpose of this HowTo assume that this path is "/home/aku/opt/ActiveTcl/lib/tcl8.6"
critcl -libdir /home/aku/opt/ActiveTcl/lib/tcl8.6 -pkg example.tcl
% find /home/aku/opt/ActiveTcl/lib/tcl8.6/example/ /home/aku/opt/ActiveTcl/lib/tcl8.6/example/ /home/aku/opt/ActiveTcl/lib/tcl8.6/example/pkgIndex.tcl /home/aku/opt/ActiveTcl/lib/tcl8.6/example/critcl-rt.tcl /home/aku/opt/ActiveTcl/lib/tcl8.6/example/license.terms /home/aku/opt/ActiveTcl/lib/tcl8.6/example/linux-x86_64 /home/aku/opt/ActiveTcl/lib/tcl8.6/example/linux-x86_64/example.so /home/aku/opt/ActiveTcl/lib/tcl8.6/example/teapot.txt
To create a minimal package wrapping an external library
# -*- tcl -*- # Critcl support, absolutely necessary. package require critcl # Bail out early if the compile environment is not suitable. if {![critcl::compiling]} { error "Unable to build project, no proper compiler found." } # Information for the teapot.txt meta data file put into a generated package. # Free form strings. critcl::license {Andreas Kupries} {Under a BSD license} critcl::summary {The second CriTcl-based package} critcl::description { This package is the second example of a CriTcl-based package. It contains all the necessary and conventionally useful pieces for wrapping an external library. } critcl::subject {external library usage} example {critcl package} critcl::subject {wrapping external library} # Minimal Tcl version the package should load into. critcl::tcl 8.6 # Locations for headers and shared library of the library to wrap. # Required only for non-standard locations, i.e. where CC is not searching by default. critcl::cheaders -I/usr/include critcl::clibraries -L/usr/lib/x86_64-linux-gnu critcl::clibraries -lzstd # Import library API, i.e. headers. critcl::include zstd.h # ## #### ######### ################ ######################### ## (De)compression using Zstd ## Data to (de)compress is passed in and returned as Tcl byte arrays. critcl::cproc compress { Tcl_Interp* ip bytes data int {level ZSTD_CLEVEL_DEFAULT} } object0 { /* critcl_bytes data; (.s, .len, .o) */ Tcl_Obj* error_message; int max = ZSTD_maxCLevel(); if ((level < 1) || (level > max)) { error_message = Tcl_ObjPrintf ("level must be integer between 1 and %d", max); goto err; } size_t dest_sz = ZSTD_compressBound (data.len); void* dest_buf = Tcl_Alloc(dest_sz); if (!dest_buf) { error_message = Tcl_NewStringObj ("can't allocate memory to compress data", -1); goto err; } size_t compressed_size = ZSTD_compress (dest_buf, dest_sz, data.s, data.len, level); if (ZSTD_isError (compressed_size)) { Tcl_Free(dest_buf); error_message = Tcl_ObjPrintf ("zstd encoding error: %s", ZSTD_getErrorName (compressed_size)); goto err; } Tcl_Obj* compressed = Tcl_NewByteArrayObj (dest_buf, compressed_size); Tcl_Free (dest_buf); return compressed; err: Tcl_SetObjResult (ip, error_message); return 0; } critcl::cproc decompress { Tcl_Interp* ip bytes data } object0 { Tcl_Obj* error_message; size_t dest_sz = ZSTD_getDecompressedSize (data.s, data.len); if (dest_sz == 0) { error_message = Tcl_NewStringObj("invalid data", -1); goto err; } void* dest_buf = Tcl_Alloc (dest_sz); if (!dest_buf) { error_message = Tcl_NewStringObj("failed to allocate decompression buffer", -1); goto err; } size_t decompressed_size = ZSTD_decompress (dest_buf, dest_sz, data.s, data.len); if (decompressed_size != dest_sz) { Tcl_Free (dest_buf); error_message = Tcl_ObjPrintf("zstd decoding error: %s", ZSTD_getErrorName (decompressed_size)); goto err; } Tcl_Obj* decompressed = Tcl_NewByteArrayObj (dest_buf, dest_sz); Tcl_Free (dest_buf); return decompressed; err: Tcl_SetObjResult (ip, error_message); return 0; } # ## #### ######### ################ ######################### # Forcing compilation, link, and loading now. critcl::msg -nonewline { Building ...} if {![critcl::load]} { error "Building and loading the project failed." } # Name and version the package. Just like for every kind of Tcl package. package provide critcl-example 1
Attention. The commands take and return binary data. This may look very bad in the terminal.
set a [compress {hhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhhello wwwwwwwworld}] decompress $a
New commands: critcl::cheaders, critcl::clibraries, critcl::include.
int {level ZSTD_CLEVEL_DEFAULT}
They are literally pasted into the generated C code.
They bypass any argument validation done in the generated translation layer. This means that it is possible to use a value an invoker of the command cannot use from Tcl.
Look at
critcl::cproc default_or_not {int {x 0}} void { if !has_x { printf("called with default\n"); return } printf("called with %d\n", x); }
Any argument x with a default causes CriTcl to create a hidden argument has_x, of type int (boolean). This argument is set to 1 when x was filled from defaults, and 0 else.
critcl::argtype zstd_compression_level { /* argtype: `int` */ if (Tcl_GetIntFromObj (interp, @@, &@A) != TCL_OK) return TCL_ERROR; /* additional validation */ int max = ZSTD_maxCLevel(); if ((@A < 1) || (@A > max)) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("zstd compression level must be integer between 1 and %d", max)); return TCL_ERROR; } /* @@: current objv[] element ** @A: name of argument variable for transfer to C function ** interp: predefined variable, access to current interp - error messages, etc. */ } int int ;# C types of transfer variable and function argument. critcl::cproc compress { Tcl_Interp* ip bytes data zstd_compression_level {level ZSTD_CLEVEL_DEFAULT} } object0 { /* critcl_bytes data; (.s, .len, .o) */ /* int level; validated to be in range 1...ZSTD_maxCLevel() */ Tcl_Obj* error_message; size_t dest_sz = ZSTD_compressBound (data.len); void* dest_buf = Tcl_Alloc(dest_sz); if (!dest_buf) { error_message = Tcl_NewStringObj ("can't allocate memory to compress data", -1); goto err; } size_t compressed_size = ZSTD_compress (dest_buf, dest_sz, data.s, data.len, level); if (ZSTD_isError (compressed_size)) { Tcl_Free(dest_buf); error_message = Tcl_ObjPrintf ("zstd encoding error: %s", ZSTD_getErrorName (compressed_size)); goto err; } Tcl_Obj* compressed = Tcl_NewByteArrayObj (dest_buf, compressed_size); Tcl_Free (dest_buf); return compressed; err: Tcl_SetObjResult (ip, error_message); return 0; }
In the original example the level argument of the function was validated in the function itself. This may detract from the funtionality of interest itself, especially if there are lots of arguments requiring validation. If the same kind of argument is used in multiple places this causes code duplication in the functions as well.
Use a custom argument type as defined by the modification to move this kind of validation out of the function, and enhance readability.
Code duplication however is only partially adressed. While there is no duplication in the visible definitions the C code of the new argument type is replicated for each use of the type.
critcl::code { int GetCompressionLevel (Tcl_Interp* interp, Tcl_Obj* obj, int* level) { if (Tcl_GetIntFromObj (interp, obj, level) != TCL_OK) return TCL_ERROR; int max = ZSTD_maxCLevel(); if ((*level < 1) || (*level > max)) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("zstd compression level must be integer between 1 and %d", max)); return TCL_ERROR; } return TCL_OK; } } critcl::argtype zstd_compression_level { if (GetCompressionLevel (@@, &@A) != TCL_OK) return TCL_ERROR; } int int
Now only the calls to the new validation function are replicated. The function itself exists only once.
critcl::csources example.c critcl::ccode { extern int GetCompressionLevel (Tcl_Interp* interp, Tcl_Obj* obj, int* level); }
When mixing C and Tcl code the different kind of indentation rules for these languages may come into strong conflict. Further, very large blocks of C code may reduce overall readability.
critcl::include example.h
critcl::ccode { #include "example.h" }
Then replace it with
critcl::source example-check.tcl
Attention Tcl's builtin command source is not suitable for importing the separate file due to how CriTcl uses the information from info script to key various internal datastructures.
critcl::cconst version char* ZSTD_VERSION_STRING critcl::cconst min-level int 1 critcl::cconst max-level int ZSTD_maxCLevel()
This enables it do to away with the internal helper function it would need and generate if critcl::cproc had been used instead. For example
critcl::cproc version {} char* { return ZSTD_VERSION_STRING; }
critcl::ccode { typedef struct vec2 { double x; double y; } vec2; typedef vec2* vec2ptr; int GetVecFromObj (Tcl_Interp* interp, Tcl_Obj* obj, vec2ptr* vec) { int len; if (Tcl_ListObjLength (interp, obj, &len) != TCL_OK) return TCL_ERROR; if (len != 2) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("Expected 2 elements, got %d", len)); return TCL_ERROR; } Tcl_Obj* lv[2]; if (Tcl_ListObjGetElements (interp, obj, &lv) != TCL_OK) return TCL_ERROR; double x, y; if (Tcl_GetDoubleFromObj (interp, lv[0], &x) != TCL_OK) return TCL_ERROR; if (Tcl_GetDoubleFromObj (interp, lv[1], &y) != TCL_OK) return TCL_ERROR; *vec = Tcl_Alloc (sizeof (vec2)); (*vec)->x = x; (*vec)->y = y; return TCL_OK; } } critcl::argtype vec2 { if (GetVecFromObj (interp, @@, &@A) != TCL_OK) return TCL_ERROR; } vec2ptr vec2ptr critcl::argtyperelease vec2 { /* @A : C variable holding the data to release */ Tcl_Free ((char*) @A); } critcl::cproc norm {vec2 vector} double { double norm = hypot (vector->x, vector->y); return norm; }
Both can be done better.
We will come back to this after explaining how to return structures to Tcl.
critcl::resulttype vec2 { /* rv: result value of function, interp: current Tcl interpreter */ if (rv == NULL) return TCL_ERROR; Tcl_Obj* lv[2]; lv[0] = Tcl_NewDoubleObj (rv->x); lv[1] = Tcl_NewDoubleObj (rv->y); Tcl_SetObjResult (interp, Tcl_NewListObj (2, lv)); Tcl_Free (rv); return TCL_OK; } vec2ptr ;# C result type critcl::cproc add {vec2 a vec2 b} vec2 { vec2ptr z = Tcl_Alloc (sizeof (vec2)); z->x = a->x + b->x; z->y = a->y + b->y; return z; }
Both can be done better. This is explained in the next section.
critcl::ccode { typedef struct vec2 { double x; double y; } vec2; typedef vec2* vec2ptr; /* -- Core vector structure management -- */ static vec2ptr Vec2New (double x, double y) { vec2ptr vec = Tcl_Alloc (sizeof (vec2)); vec->x = x; vec->y = y; return vec; } static vec2ptr Vec2Copy (vec2ptr src) { vec2ptr vec = Tcl_Alloc (sizeof (vec2)); *vec = *src return vec; } static void Vec2Release (vec2ptr vec) { Tcl_Free ((char*) vec); } /* -- Tcl value type for vec2 -- Tcl_ObjType -- */ static void Vec2Free (Tcl_Obj* obj); static void Vec2StringOf (Tcl_Obj* obj); static void Vec2Dup (Tcl_Obj* obj, Tcl_Obj* dst); static int Vec2FromAny (Tcl_Interp* interp, Tcl_Obj* obj); Tcl_ObjType vec2_objtype = { "vec2", Vec2Free, Vec2Dup, Vec2StringOf, Vec2FromAny }; static void Vec2Free (Tcl_Obj* obj) { Vec2Release ((vec2ptr) obj->internalRep.otherValuePtr); } static void Vec2Dup (Tcl_Obj* obj, Tcl_Obj* dst) { vec2ptr vec = (vec2ptr) obj->internalRep.otherValuePtr; dst->internalRep.otherValuePtr = Vec2Copy (vec); dst->typePtr = &vec2_objtype; } static void Vec2StringOf (Tcl_Obj* obj) { vec2ptr vec = (vec2ptr) obj->internalRep.otherValuePtr; /* Serialize vector data to string (list of two doubles) */ Tcl_DString ds; Tcl_DStringInit (&ds); char buf [TCL_DOUBLE_SPACE]; Tcl_PrintDouble (0, vec->x, buf); Tcl_DStringAppendElement (&ds, buf); Tcl_PrintDouble (0, vec->y, buf); Tcl_DStringAppendElement (&ds, buf); int length = Tcl_DStringLength (ds); /* Set string representation */ obj->length = length; obj->bytes = Tcl_Alloc(length+1); memcpy (obj->bytes, Tcl_DStringValue (ds), length); obj->bytes[length] = '\0'; /* ** : package require critcl::cutil ;# get C utilities ** : critcl::cutil::alloc ;# Activate allocation utilities ** : (Internally cheaders, include) ** : Then all of the above can be written as STREP_DS (obj, ds); ** : STREP_DS = STRing REP from DString */ Tcl_DStringFree (&ds); } static int Vec2FromAny (Tcl_Interp* interp, Tcl_Obj* obj) { /* Change intrep of obj to vec2 structure. ** A Tcl list of 2 doubles is used as an intermediary intrep. */ int len; if (Tcl_ListObjLength (interp, obj, &len) != TCL_OK) return TCL_ERROR; if (len != 2) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("Expected 2 elements, got %d", len)); return TCL_ERROR; } Tcl_Obj* lv[2]; if (Tcl_ListObjGetElements (interp, obj, &lv) != TCL_OK) return TCL_ERROR; double x, y; if (Tcl_GetDoubleFromObj (interp, lv[0], &x) != TCL_OK) return TCL_ERROR; if (Tcl_GetDoubleFromObj (interp, lv[1], &y) != TCL_OK) return TCL_ERROR; obj->internalRep.otherValuePtr = (void*) Vec2New (x, y); obj->typePtr = &vec2_objtype; return TCL_OK; } /* -- (un)packing structures from/into Tcl values -- */ int GetVecFromObj (Tcl_Interp* interp, Tcl_Obj* obj, vec2ptr* vec) { if (obj->typePtr != &vec2_objtype) { if (Vec2FromAny (interp, obj) != TCL_OK) return TCL_ERROR; } *vec = (vec2ptr) obj->internalRep.otherValuePtr; return TCL_OK; } Tcl_Obj* NewVecObj (vec2ptr vec) { Tcl_Obj* obj = Tcl_NewObj (); Tcl_InvalidateStringRep (obj); obj->internalRep.otherValuePtr = Vec2Copy (vec); obj->typePtr = &vec2_objtype; return obj; } } critcl::argtype vec2 { if (GetVecFromObj (interp, @@, &@A) != TCL_OK) return TCL_ERROR; } vec2ptr vec2ptr critcl::resulttype vec2 { /* rv: result value of function, interp: current Tcl interpreter */ Tcl_SetObjResult (interp, NewVecObj (&rv)); return TCL_OK; } vec2 critcl::cproc norm {vec2 vector} double { double norm = hypot (vector->x, vector->y); return norm; } critcl::cproc add {vec2 a vec2 b} vec2 { vec2 z; z.x = a->x + b->x; z.y = a->y + b->y; return z; }
The two functions NewVecObj and GetVecFromObj pack and unpack the structures from and into Tcl_Obj* values. The latter performs the complex deserialization into a structure if and only if needed, i.e. when the TclObj* value has no intrep, or the intrep for a different type. This process of changing the intrep of a Tcl value is called shimmering.
Intreps cache the interpretation of Tcl_Obj* values as a specific kind of type. Here vec2. This reduces conversion effort and memory churn, as intreps are kept by the Tcl interpreter as long as possible and needed.
We will address this in the next section.
Packages: critcl::cutil
critcl::ccode { typedef struct vec2 { unsigned int rc; double x; double y; } vec2; typedef vec2* vec2ptr; /* -- Core vector structure management -- */ static vec2ptr Vec2New (double x, double y) { vec2ptr vec = Tcl_Alloc (sizeof (vec2)); vec->rc = 0; vec->x = x; vec->y = y; return vec; } static vec2ptr Vec2Copy (vec2ptr src) { scr->rc ++; return src; } static void Vec2Release (vec2ptr vec) { if (vec->rc > 1) { vec->rc --; return; } Tcl_Free ((char*) vec); } /* -- Vector obj type -- */ static void Vec2Free (Tcl_Obj* obj); static void Vec2StringOf (Tcl_Obj* obj); static void Vec2Dup (Tcl_Obj* obj, Tcl_Obj* dst); static int Vec2FromAny (Tcl_Interp* interp, Tcl_Obj* obj); Tcl_ObjType vec2_objtype = { "vec2", Vec2Free, Vec2Dup, Vec2StringOf, Vec2FromAny }; static void Vec2Free (Tcl_Obj* obj) { Vec2Release ((vec2ptr) obj->internalRep.otherValuePtr); } static void Vec2Dup (Tcl_Obj* obj, Tcl_Obj* dst) { vec2ptr vec = (vec2ptr) obj->internalRep.otherValuePtr; dst->internalRep.otherValuePtr = Vec2Copy (vec); dst->typePtr = &vec2_objtype; } static void Vec2StringOf (Tcl_Obj* obj) { vec2ptr vec = (vec2ptr) obj->internalRep.otherValuePtr; /* Serialize vector data to string (list of two doubles) */ Tcl_DString ds; Tcl_DStringInit (&ds); char buf [TCL_DOUBLE_SPACE]; Tcl_PrintDouble (0, vec->x, buf); Tcl_DStringAppendElement (&ds, buf); Tcl_PrintDouble (0, vec->y, buf); Tcl_DStringAppendElement (&ds, buf); int length = Tcl_DStringLength (ds); /* Set string representation */ obj->length = length; obj->bytes = Tcl_Alloc(length+1); memcpy (obj->bytes, Tcl_DStringValue (ds), length); obj->bytes[length] = '\0'; /* ** : package require critcl::cutil ;# get C utilities ** : critcl::cutil::alloc ;# Activate allocation utilities ** : (Internally cheaders, include) ** : Then all of the above can be written as STREP_DS (obj, ds); ** : STREP_DS = STRing REP from DString */ Tcl_DStringFree (&ds); } static int Vec2FromAny (Tcl_Interp* interp, Tcl_Obj* obj) { /* Change internal rep of obj to vector structure. ** A Tcl list of 2 doubles is used as intermediary int rep. */ int len; if (Tcl_ListObjLength (interp, obj, &len) != TCL_OK) return TCL_ERROR; if (len != 2) { Tcl_SetObjResult (interp, Tcl_ObjPrintf ("Expected 2 elements, got %d", len)); return TCL_ERROR; } Tcl_Obj* lv[2]; if (Tcl_ListObjGetElements (interp, obj, &lv) != TCL_OK) return TCL_ERROR; double x, y; if (Tcl_GetDoubleFromObj (interp, lv[0], &x) != TCL_OK) return TCL_ERROR; if (Tcl_GetDoubleFromObj (interp, lv[1], &y) != TCL_OK) return TCL_ERROR; obj->internalRep.otherValuePtr = (void*) Vec2New (x, y); obj->typePtr = &vec2_objtype; return TCL_OK; } /* (un)packing structures from/into Tcl values -- */ int GetVecFromObj (Tcl_Interp* interp, Tcl_Obj* obj, vec2ptr* vec) { if (obj->typePtr != &vec2_objtype) { if (VecFromAny (interp, obj) != TCL_OK) return TCL_ERROR; } *vec = (vec2ptr) obj->internalRep.otherValuePtr; return TCL_OK; } Tcl_Obj* NewVecObj (vec2ptr vec) { Tcl_Obj* obj = Tcl_NewObj (); Tcl_InvalidateStringRep (obj); obj->internalRep.otherValuePtr = Vec2Copy (vec); obj->typePtr = &vec2_objtype; return obj; } } critcl::argtype vec2 { if (GetVecFromObj (interp, @@, &@A) != TCL_OK) return TCL_ERROR; } vec2ptr vec2ptr critcl::resulttype vec2 { /* rv: result value of function, interp: current Tcl interpreter */ Tcl_SetObjResult (interp, NewVecObj (rv)); return TCL_OK; } vec2ptr critcl::cproc norm {vec2 vector} double { double norm = hypot (vector->x, vector->y); return norm; } critcl::cproc add {vec2 a vec2 b} vec2 { return Vec2New (a->x + b->x, a->y + b->y); }
Packages: critcl::cutil
This is true even if the external structure is not reference counted by itself.
To reference count a structure S without such simply wrap S into a local structure which provides the reference count and has a field for S (pointer or value).
This section demonstrates how to convert from any kind of enumeration provided by an external library to Tcl strings, and the converse.
package require critcl::emap # no header included due to use of literal ints instead of symbolic names critcl::emap::def yaml_sequence_style_t { any 0 block 1 flow 2 } # encode: style to int critcl::cproc encode {yaml_sequence_style_t style} int { return style; } # decode: int to style critcl::cproc decode {int style} yaml_sequence_style_t { return style; }
In other words, it is perfectly ok to use the symbolic names provided by the header file of the external library.
Attention This however comes at a loss in efficiency. As CriTcl then has no insight into the covered range of ints, gaps, etc. it has to perform a linear search when mapping from C to Tcl. When it knows the exact integer values it can use a table lookup instead.
Attention It also falls back to a search if a lookup table would contain more than 50 entries.
Packages: critcl::emap
This section demonstrates how to convert from any kind of bit-mapped flags provided by an external library to lists of Tcl strings, and the converse.
# http://man7.org/linux/man-pages/man7/inotify.7.html package require critcl::bitmap # critcl::cheaders - n/a, header is in system directories critcl::include sys/inotify.h critcl::bitmap::def tcl_inotify_events { accessed IN_ACCESS all IN_ALL_EVENTS attribute IN_ATTRIB closed IN_CLOSE closed-nowrite IN_CLOSE_NOWRITE closed-write IN_CLOSE_WRITE created IN_CREATE deleted IN_DELETE deleted-self IN_DELETE_SELF dir-only IN_ONLYDIR dont-follow IN_DONT_FOLLOW modified IN_MODIFY move IN_MOVE moved-from IN_MOVED_FROM moved-self IN_MOVE_SELF moved-to IN_MOVED_TO oneshot IN_ONESHOT open IN_OPEN overflow IN_Q_OVERFLOW unmount IN_UNMOUNT } { all closed move oneshot } # encode: flag set to int critcl::cproc encode {tcl_inotify_events e} int { return e; } # decode: int to flag set critcl::cproc decode {int e} tcl_inotify_events { return e; }
It is noted that the four strings all, closed, move, and oneshot cannot be converted from C flags to list of strings, only from list to bits.
In other words, it is perfectly ok to use the symbolic names provided by the header file of the external library. As shown.
Packages: critcl::bitmap
Multiple arguments are allowed, and multiple calls as well. The information accumulates.
Arguments of the form "-Idirectory" register the directory directly.
For arguments of the form "path" the directory holding the path is registered. In other words, it is assumed to be the full path of a header file, and not a directory.
critcl::cheaders -I/usr/local/include critcl::cheaders local/types.h critcl::cheaders other-support/*.h
Multiple arguments are allowed, and multiple calls as well. The information accumulates.
Arguments of the form "-Ldirectory" register a directory.
Arguments of the form "-lname" register a shared libary to link to by name. The library will be looked for in both standard and registered directories.
Arguments of the form "-path" register a shared libary to link to by full path.
critcl::clibraries -L/usr/lib/x86_64-linux-gnu critcl::clibraries -lzstd critcl::clibraries /usr/lib/x86_64-linux-gnu/libzstd.so
Attention Using the command on other platforms is ok, and will be ignored.
We will come back to this.
critcl::cflags -DBYTE_ORDER=bigendian
critcl::ldflags -
This is addressed by the next section.
if {[critcl::check { #include <FOO.h> }]} { Do stuff with FOO.h present. } else { Do stuff without FOO.h }
All header and library paths which were registered with CriTcl before using critcl::check take part in the attempted compilation.
Use the package critcl::util and various convenience commands it provides.
Use the same command to set the package author.
Both arguments are free form text.
The arguments of both commands are free form text.
Attention Contrary to the other commands the arguments accumulate.
critcl -help
critcl -show
critcl -show -target NAME
critcl -targets
Jean Claude Wippler, Steve Landers, Andreas Kupries
This document, and the package it describes, will undoubtedly contain bugs and other problems. Please report them at https://github.com/andreas-kupries/critcl/issues. Ideas for enhancements you may have for either package, application, and/or the documentation are also very welcome and should be reported at https://github.com/andreas-kupries/critcl/issues as well.
C code, Embedded C Code, calling C code from Tcl, code generator, compile & run, compiler, dynamic code generation, dynamic compilation, generate package, linker, on demand compilation, on-the-fly compilation
Glueing/Embedded C code
Copyright (c) Jean-Claude Wippler Copyright (c) Steve Landers Copyright (c) 2011-2024 Andreas Kupries
3.3.1 | doc |