tcc4tcl (Tiny C Compiler for Tcl) is a Tcl extension that provides an interface to [TCC]. It is a fork of [tcltcc] by Mark Janssen. It is licensed under the terms of the [LGPL] v2.1 (or later). Homepage: http://chiselapp.com/user/rkeene/repository/tcc4tcl/index **tcc version** [AMG]: The current version of tcc4tcl (0.30) directly includes a patched copy of tcc 0.9.26 from early 2013. The most recent version of tcc is 0.9.27 from late 2017. I would very much like to upgrade to 0.9.27 because of the many improvements, but doing so breaks virtually all the tcc patches found in [http://chiselapp.com/user/rkeene/repository/tcc4tcl/dir?ci=trunk&name=build/tcc-patches/0.9.26]. **Access to more symbols** [AMG]: The C code has access to Tcl and Tk symbols just fine, but other than that, the only available symbols are: `printf`, `fprintf`, `fopen`, and `fclose`. These are listed in `tcc_syms` in `tccrun.c`. It's clear that this list is present as only an example of how to add symbols. I'm very much wishing for the ability to extend this list without editing the tcc source. In fact, many of the symbols I want to access may not even be available during the compilation and linking of tcc4tcl since they'll come from other dynamically loaded extension libraries. Mostly [SQLite]. To do this, I extended the `add_symbol` command to allow dynamic symbol lookups, implemented using [Tcl_LoadFile]() or dlsym(), depending on context. Tcl_LoadFile() is used when the symbol comes from a library. dlsym() is used when the symbol is baked into the interpreter (or is in a library loaded using [[load -global]]); however, this doesn't work in Windows. Here's the patch against tcc4tcl version c1a5de894b [http://chiselapp.com/user/rkeene/repository/tcc4tcl/info/c1a5de894bd47d13]. Warning: this patch contains tabs and end-of-line whitespace! <> Patch ======none diff -ur tcc4tcl-0.30~/tcc4tcl.c tcc4tcl-0.30/tcc4tcl.c --- tcc4tcl-0.30~/tcc4tcl.c 2019-06-11 12:25:16.849343862 -0500 +++ tcc4tcl-0.30/tcc4tcl.c 2019-06-11 19:34:35.721853441 -0500 @@ -19,6 +19,10 @@ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ +#ifndef _WIN32 +# include +#endif + #include #include #include "tcc.h" @@ -28,6 +32,9 @@ int relocated; }; +static Tcl_HashTable Tcc4tclHandles; +static int Tcc4tclHandlesInitialized; + static void Tcc4tclErrorFunc(Tcl_Interp * interp, char * msg) { Tcl_AppendResult(interp, msg, "\n", NULL); } @@ -58,6 +65,7 @@ static int Tcc4tclHandleCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){ Tcl_WideInt val; + Tcl_Obj *expr_o; Tcl_Obj *val_o; void *val_p; int index; @@ -127,27 +135,110 @@ tcc_add_library_path(s, Tcl_GetString(objv[2])); return TCL_OK; } - case TCC4TCL_ADD_SYMBOL: - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "symbol value"); + case TCC4TCL_ADD_SYMBOL: { + Tcl_LoadHandle handle; + Tcl_HashEntry *entry; + static const char *const switches[] = {"-library", "-lookup", NULL}; + enum {LIBRARY, LOOKUP} match; + Tcl_Obj *library = NULL; + const char *lookup[2] = {NULL, NULL}; + int i; + int new; + + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "symbol ?value? " + "?-library libraryName? ?-lookup lookupName?"); return TCL_ERROR; } - rv = Tcl_ExprObj(interp, Tcl_ObjPrintf("wide(%s)", Tcl_GetString(objv[3])), &val_o); - if (rv != TCL_OK) { - return TCL_ERROR; + /* + * [tcc add_symbol symbol value]. The value is the symbol address. + */ + if (objc == 4) { + expr_o = Tcl_ObjPrintf("wide(%s)", Tcl_GetString(objv[3])); + rv = Tcl_ExprObj(interp, expr_o, &val_o); + Tcl_DecrRefCount(expr_o); + if (rv != TCL_OK) { + return TCL_ERROR; + } + rv = Tcl_GetWideIntFromObj(interp, val_o, &val); + Tcl_DecrRefCount(val_o); + if (rv != TCL_OK) { + return TCL_ERROR; + } + tcc_add_symbol(s, Tcl_GetString(objv[2]), (void *)val); + return TCL_OK; } - rv = Tcl_GetWideIntFromObj(interp, val_o, &val); - if (rv != TCL_OK) { - return TCL_ERROR; + /* + * [tcc add_symbol symbol ?-switches ...?]. Parse switches to + * obtain the library and lookup symbol names, if given. + */ + lookup[0] = Tcl_GetString(objv[2]); + for (i = 3; i < objc; i += 2) { + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0, + (int *)&match) != TCL_OK) { + return TCL_ERROR; + } else if (i == objc - 1) { + Tcl_Obj *error = Tcl_NewStringObj( + "missing value for switch: ", -1); + Tcl_AppendObjToObj(error, objv[i]); + Tcl_SetObjResult(interp, error); + return TCL_ERROR; + } else if (match == LIBRARY) { + library = objv[i + 1]; + } else if (match == LOOKUP) { + lookup[0] = Tcl_GetString(objv[i + 1]); + } } - val_p = (void *) val; + if (library) { + /* + * -library was specified. First, search the handle table for + * the already-opened library. If not found, open the library + * and add it to the table, looking up the symbol as a side + * effect. If found, look up the symbol using the existing + * handle. In either case, fail if the symbol is missing. + */ + entry = Tcl_CreateHashEntry(&Tcc4tclHandles, library, &new); + if (new) { + if (Tcl_LoadFile(interp, library, lookup, 0, &val_p, + &handle) != TCL_OK) { + Tcl_DeleteHashEntry(entry); + return TCL_ERROR; + } + Tcl_SetHashValue(entry, handle); + } else if (!(val_p = Tcl_FindSymbol(interp, + (Tcl_LoadHandle)Tcl_GetHashValue(entry), *lookup))) { + return TCL_ERROR; + } + } else { + /* + * -library was not specified. If dlsym() is available, use + * dlsym() to look up the symbol in the current process image. + * This includes symbols statically and dynamically linked into + * the current process (assuming they weren't marked "static"; + * be mindful of the double meaning of that word!), plus symbols + * in libraries loaded by [load -global] or Tcl_LoadFile() using + * the TCL_LOAD_GLOBAL flag. + */ +#ifndef _WIN32 + dlerror(); + val_p = dlsym(RTLD_DEFAULT, Tcl_GetString(objv[objc - 1])); + if (!val_p && (str = dlerror())) { + Tcl_SetResult(interp, str, TCL_VOLATILE); + return TCL_ERROR; + } +#else + Tcl_SetResult(interp, "-library required on this platform", + TCL_STATIC); + return TCL_ERROR; +#endif + } - tcc_add_symbol(s,Tcl_GetString(objv[2]), val_p); + tcc_add_symbol(s, Tcl_GetString(objv[2]), val_p); return TCL_OK; - case TCC4TCL_COMMAND: + } case TCC4TCL_COMMAND: if (objc != 4 && objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "tclname cname ?clientData?"); return TCL_ERROR; @@ -319,7 +410,29 @@ } #endif + if (!Tcc4tclHandlesInitialized) { + Tcc4tclHandlesInitialized = 1; + Tcl_InitHashTable(&Tcc4tclHandles, TCL_STRING_KEYS); + } + Tcl_CreateObjCommand(interp, "tcc4tcl", Tcc4tclCreateCmd, NULL, NULL); return TCL_OK; } + +int Tcc4tcl_Unload(Tcl_Interp *interp, int flags) { + if (flags & TCL_UNLOAD_DETACH_FROM_PROCESS) { + Tcl_HashSearch search; + Tcl_HashEntry *entry; + + entry = Tcl_FirstHashEntry(&Tcc4tclHandles, &search); + while (entry) { + Tcl_FSUnloadFile(interp, (Tcl_LoadHandle)Tcl_GetHashValue(entry)); + entry = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&Tcc4tclHandles); + Tcc4tclHandlesInitialized = 0; + } + + return TCL_OK; +} diff -ur tcc4tcl-0.30~/tcc4tcl.tcl tcc4tcl-0.30/tcc4tcl.tcl --- tcc4tcl-0.30~/tcc4tcl.tcl 2019-06-11 12:25:16.850344362 -0500 +++ tcc4tcl-0.30/tcc4tcl.tcl 2019-06-11 13:54:07.764711760 -0500 @@ -46,7 +46,7 @@ } } - array set $handle [list code "" type $type filename $output package $pkgName add_inc_path "" add_lib_path "" add_lib "" add_macros "" add_files ""] + array set $handle [list code "" type $type filename $output package $pkgName add_inc_path "" add_lib_path "" add_lib "" add_symbol "" add_macros "" add_files ""] proc $handle {cmd args} [string map [list @@HANDLE@@ $handle] { set handle {@@HANDLE@@} @@ -63,7 +63,7 @@ set callcmd ::tcc4tcl::_$cmd if {[info command $callcmd] == ""} { - return -code error "unknown or ambiguous subcommand \"$cmd\": must be cwrap, ccode, cproc, ccommand, delete, linktclcommand, code, tk, add_include_path, add_library_path, add_library, process_command_line, or go" + return -code error "unknown or ambiguous subcommand \"$cmd\": must be cwrap, ccode, cproc, ccommand, delete, linktclcommand, code, tk, add_include_path, add_library_path, add_library, add_symbol, process_command_line, or go" } uplevel 1 [list $callcmd $handle {*}$args] @@ -118,6 +118,12 @@ lappend state(add_lib) {*}$args } + proc _add_symbol {handle args} { + upvar #0 $handle state + + lappend state(add_symbol) $args + } + proc _add_file {handle args} { upvar #0 $handle state @@ -618,6 +624,10 @@ tcc add_file $addFile } + foreach addSymbol $state(add_symbol) { + tcc add_symbol {*}$addSymbol + } + switch -- $state(type) { "memory" { tcc compile $code ====== <> <> Simple testing ====== package require tcc4tcl set tcc [tcc4tcl::new] $tcc add_symbol sin $tcc add_symbol cos $tcc ccode {#include } $tcc cproc sin {double x} double {return sin(x);} $tcc cproc cos {double x} double {return cos(x);} $tcc go sin [expr {asin(0.123)}] cos [expr {acos(0.456)}] ====== <> <> Complex testing ====== package require tcc4tcl package require sqlite3 set tcc [tcc4tcl::new] $tcc ccode { #include "sqlite3.h" int testCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { sqlite3 *db; sqlite3_stmt *stmt; int rc; if ((rc = sqlite3_open_v2(NULL, &db, SQLITE_OPEN_READWRITE, NULL)) != SQLITE_OK) { Tcl_SetResult(interp, sqlite3_errstr(rc), TCL_VOLATILE); return TCL_ERROR; } sqlite3_prepare_v2(db, "SELECT sqlite_version()", -1, &stmt, NULL); if (!stmt) { Tcl_SetResult(interp, sqlite3_errcode(db), TCL_VOLATILE); sqlite3_close(db); return TCL_ERROR; } if (sqlite3_step(stmt) != SQLITE_ROW) { Tcl_SetResult(interp, sqlite3_errcode(db), TCL_VOLATILE); sqlite3_close(db); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(sqlite3_column_text(stmt, 0), sqlite3_column_bytes(stmt, 0))); if (sqlite3_finalize(stmt) != SQLITE_OK) { Tcl_SetResult(interp, sqlite3_errcode(db), TCL_VOLATILE); sqlite3_close(db); return TCL_ERROR; } if ((rc = sqlite3_close(db)) != SQLITE_OK) { Tcl_SetResult(interp, sqlite3_errstr(rc), TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; } } set lib [file join [info nameofexecutable] lib/sqlite3.28.0/libsqlite3.28.0.so] $tcc add_symbol sqlite3_open_v2 -library $lib $tcc add_symbol sqlite3_prepare_v2 -library $lib $tcc add_symbol sqlite3_step -library $lib $tcc add_symbol sqlite3_column_text -library $lib $tcc add_symbol sqlite3_column_bytes -library $lib $tcc add_symbol sqlite3_finalize -library $lib $tcc add_symbol sqlite3_close -library $lib $tcc add_symbol sqlite3_errstr -library $lib $tcc add_symbol sqlite3_errcode -library $lib $tcc linktclcommand test testCmd $tcc go test ====== <> This doesn't quite work on Windows. Not only is dlsym() missing, meaning that I can't find symbols already linked into the process, but the Tcl_LoadFile() approach is failing as well. If I try to add symbols for a package that's already loaded, I get a permissions error. I'm guessing that Tcl_LoadFile() is trying to read the file a second time, yet Windows is locking it. Shouldn't Tcl_LoadFile() just point to the already-open library? If I try to add symbols before loading the package, I get farther, but nevertheless all my symbol lookups fail. Maybe there need to be leading and/or trailing underscores. (That's what the `-lookup` switch is for, to allow the looked-up name to not match the name referenced within the C program.) However, these underscores don't show up in the output of `nm`, so I'm not sure that's really what's going on. There's trouble on Linux too, at least in combination with [VFS] ([tclkit]) and [https://wiki.tcl-lang.org/page/SQLite#20e9baa5f956abff873b287bf6581259ecb0494945f77f9bae973b2f9ecb22cb%|%sharing a database connection between Tcl and C%|%]. [[`package require sqlite3`]] invokes [[`load libsqlite3.*.so`]] which invokes Tcl_LoadFile() which is forced to copy `libsqlite3.*.so` to a temporary file to pass to dlopen(). Later on, [[`$tcc add_symbol sqlite3_* -library .../libsqlite3.*.so`]] calls Tcl_LoadFile() as well, not having access to the handle produced by the first call to dlopen(). Thus, SQLite is loaded twice, and the function pointers associated with the second are for code linked to a separate copy of all the static and global variables. This prevents sharing SQLite connections between Tcl and C, since Tcl and C are linked to separate copies of SQLite. tclLoad.c actually does keep track of handles associated with already-loaded libraries, which can be looked up by package name ("Sqlite3" in this case). However, there is no API to access this table other than the [unload] command which has obvious and undesirable side effects. The three solutions I can think of are: 1. Statically link SQLite with the interpreter so the `-library` switch (therefore Tcl_LoadFile()) need not be used. 2. Load SQLite using the `-global` switch to [[load]], so once again `-library` is not needed. 3. Bypass [[`package require sqlite3`]] in favor of manually copying `libsqlite3.*.so` to a [file tempfile] file (guaranteed native filesystem), [load]ing it, then passing that same file to tcc for its own symbol lookups, then finally deleting the file. I've tried (3) and it works. The trouble with (1) is it's a change to the way my Tclkit is built, and office security procedures make it hard for me to publish new binaries (which by the way is a part of my motivation to integrate tcc). Both (1) and (2) seem to be fundamentally incompatible with Windows due to requiring dlsym(RTLD_DEFAULT). **32-bit Windows link failure** [AMG]: With tcc4tcl 0.30 (tcc 0.9.26) compiled with 32-bit MXE GCC 5.4.0, or with the official build [http://teapot.rkeene.org/package/name/tcc4tcl/ver/0.22/arch/win32-ix86/file.zip] (tried with [https://www.activestate.com/products/activetcl/downloads/thank-you/?dl=https://downloads.activestate.com/ActiveTcl/releases/8.5.18.0/ActiveTcl8.5.18.0.298892-win32-ix86-threaded.exe]), I get the following error: ====== % tcc4tcl::cproc test {Tcl_WideInt a int b} Tcl_WideInt {return a << b;} tcc: error: undefined symbol '__ashldi3' relocating failed ====== This is only a problem in Windows, not Linux. The cause is twofold. (1) gcc is prefixing all the symbol names in libtcc1.a with an extra underscore that tcc is not expecting, and (2) gcc is producing PE-format object files, and tcc only knows how to link ELF object files. The solution is to apply this patch: <> Patch ======none diff -ur tcc4tcl-0.30-old/Makefile.in tcc4tcl-0.30-new/Makefile.in --- tcc4tcl-0.30-old/Makefile.in 2017-10-13 15:37:05.000000000 -0500 +++ tcc4tcl-0.30-new/Makefile.in 2019-03-13 15:04:27.510092464 -0500 @@ -8,6 +8,8 @@ CPP = @CPP@ AR = @AR@ RANLIB = @RANLIB@ +OBJCOPY = @OBJCOPY@ +OBJDUMP = @OBJDUMP@ CFLAGS = @CFLAGS@ @SHOBJFLAGS@ CPPFLAGS = @CPPFLAGS@ -I$(shell cd @srcdir@ && pwd) -I$(shell cd @srcdir@ && pwd)/tcc -I$(shell pwd)/tcc @DEFS@ @SHOBJCPPFLAGS@ LDFLAGS = @LDFLAGS@ @@ -29,7 +31,7 @@ host_os = @host_os@ @SET_MAKE@ -all: $(TARGET) tcc/libtcc1.a +all: $(TARGET) tcc/libtcc1-elf.a tcc/config.h: if [ "$(srcdir)" = "." ]; then \ @@ -46,6 +48,17 @@ -$(MAKE) -C tcc tcc@EXEEXT@ $(MAKE) -C tcc libtcc1.a +# tcc supports dynamically loading object code from ELF, not from PE, so on some +# platforms it is necessary to convert its runtime support library to ELF. +tcc/libtcc1-elf.a: tcc/libtcc1.a + if $(OBJDUMP) -a $< | grep -q ' file format pei\?-x86-64$$'; then \ + $(OBJCOPY) --remove-leading-char -O elf64-x86-64 $< $@; \ + elif $(OBJDUMP) -a $< | grep -q ' file format pei\?-i386$$'; then \ + $(OBJCOPY) --remove-leading-char -O elf32-i386 $< $@; \ + else \ + cp -f $< $@; \ + fi + tcc4tcl.o: $(srcdir)/tcc4tcl.c $(srcdir)/tcc/tcc.h $(srcdir)/tcc/libtcc.h tcc/config.h $(CC) $(CPPFLAGS) $(CFLAGS) -o tcc4tcl.o -c $(srcdir)/tcc4tcl.c @@ -60,7 +73,7 @@ -$(RANLIB) tcc4tcl-static.new.a mv tcc4tcl-static.new.a tcc4tcl-static.a -install: $(TARGET) pkgIndex.tcl $(srcdir)/tcc4tcl.tcl $(srcdir)/tcc4critcl.tcl tcc/libtcc1.a $(shell echo $(srcdir)/tcc/include/*) $(shell echo $(srcdir)/tcc/win32/lib/*.c) $(srcdir)/headers.awk $(srcdir)/patch-headers.sh +install: $(TARGET) pkgIndex.tcl $(srcdir)/tcc4tcl.tcl $(srcdir)/tcc4critcl.tcl tcc/libtcc1-elf.a $(shell echo $(srcdir)/tcc/include/*) $(shell echo $(srcdir)/tcc/win32/lib/*.c) $(srcdir)/headers.awk $(srcdir)/patch-headers.sh $(INSTALL) -d "$(DESTDIR)$(PACKAGE_INSTALL_DIR)" $(INSTALL) -d "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/lib" $(INSTALL) -d "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/include" @@ -68,7 +81,7 @@ $(INSTALL) -m 0644 pkgIndex.tcl "$(DESTDIR)$(PACKAGE_INSTALL_DIR)" $(INSTALL) -m 0644 $(srcdir)/tcc4tcl.tcl "$(DESTDIR)$(PACKAGE_INSTALL_DIR)" $(INSTALL) -m 0644 $(srcdir)/tcc4critcl.tcl "$(DESTDIR)$(PACKAGE_INSTALL_DIR)" - $(INSTALL) -m 0644 tcc/libtcc1.a "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/lib" + $(INSTALL) -m 0644 tcc/libtcc1-elf.a "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/lib/libtcc1.a" $(INSTALL) -m 0644 $(shell echo $(srcdir)/tcc/win32/lib/*.c) "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/lib" $(INSTALL) -m 0644 $(shell echo $(srcdir)/tcc/include/*) "$(DESTDIR)$(PACKAGE_INSTALL_DIR)/include" @if ! echo "_WIN32" | $(CPP) $(CPPFLAGS) - | grep '^_WIN32$$' >/dev/null; then \ diff -ur tcc4tcl-0.30-old/configure.ac tcc4tcl-0.30-new/configure.ac --- tcc4tcl-0.30-old/configure.ac 2017-10-13 15:37:16.000000000 -0500 +++ tcc4tcl-0.30-new/configure.ac 2019-03-13 15:06:59.156101031 -0500 @@ -39,6 +39,7 @@ TARGET="tcc4tcl-static.a" fi +AC_CHECK_TOOL([OBJDUMP], [objdump]) AC_SUBST(TARGET) AC_SUBST(TCC4TCL_TARGET) AC_SUBST(TCC_EXTRA_CFLAGS) diff -ur tcc4tcl-0.30-old/test.tcl tcc4tcl-0.30-new/test.tcl --- tcc4tcl-0.30-old/test.tcl 2017-10-13 15:37:05.000000000 -0500 +++ tcc4tcl-0.30-new/test.tcl 2019-03-13 15:09:06.231108210 -0500 @@ -15,6 +15,9 @@ # This should work tcc4tcl::cproc test3 {int i} int { return(i+42); } +# Check for libtcc1 functionality +tcc4tcl::cproc testlibtcc1 {double x} int { return(x); } + # Multiple arguments tcc4tcl::cproc add {int a int b} int { return(a+b); } ====== <> Be cautious with this patch since it intentionally contains tabs and end-of-line whitespace, all of which have been stripped off by the wiki. Let me know if you want the original file with correct formatting. After applying the patch, run "autoconf" to regenerate the configure script. I have confirmed that the above patch fixes 32-bit Windows and does not break 64-bit Windows, 32-bit Linux, or 64-bit Linux. Note: Even though I say that the error only happens on 32-bit Windows, as far as I can tell, this is only because libtcc1 is not needed as much on 64-bit Windows. If I dug deeper, I could probably find a test case that would break 64-bit Windows too, i.e. a case where libtcc1 is used on both 32- and 64-bit CPUs. **Variadic arguments** [AMG]: Is there any facility to access a cproc command's full objv argument list? Answer: No. Bypass `cproc` and instead use `ccode` directly to create functions matching the signature shown below. Then use `linktclcommand` to arrange for [Tcl_CreateObjCommand] to be called on those functions. Note that the created Tcl commands are in the global namespace by default, not in the current [namespace eval] namespace, unless the namespace is explicitly given in the command name. ======c typedef int Tcl_ObjCmdProc( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); ====== **Compilation** [dbohdan] 2015-03-16: As of version 0.23 you can compile tcc4tcl on Linux thus: ======none #!/bin/sh set -e version=0.23 release="tcc4tcl-$version" url="http://rkeene.org/devel/tcc4tcl/${release}.tar.gz" curl "$url" -o "${release}.tar.gz" # -O may not be unavailable. tar zxvf "$release.tar.gz" cd $release ./configure make ====== [dbohdan]: Updated the script once more to hammer [Roy Keene]'s server less. <> Extension