ADDED aclocal/dlsym.m4 Index: aclocal/dlsym.m4 ================================================================== --- aclocal/dlsym.m4 +++ aclocal/dlsym.m4 @@ -0,0 +1,36 @@ +AC_DEFUN([TCC4TCL_FIND_DLOPEN], [ + AC_CHECK_HEADERS_ONCE([dlfcn.h]) + + AC_SEARCH_LIBS([dlsym], [dl dld], [ + AC_DEFINE([HAVE_DLSYM], [1], [Have the dlsym function]) + ], [ + AC_CHECK_HEADERS([windows.h]) + + AC_MSG_CHECKING([for working EnumProcessModules]) + SAVE_LIBS="$LIBS" + LIBS="$LIBS -lpsapi" + AC_LINK_IFELSE([ + AC_LANG_PROGRAM([ +#ifdef HAVE_WINDOWS_H +# include +#endif +#include + ], [ +HANDLE cur_proc; +DWORD needed; + +needed = 0; + +cur_proc = GetCurrentProcess(); +EnumProcessModules(cur_proc, NULL, 0, &needed); + ] + )], [ + AC_DEFINE([HAVE_ENUMPROCESSMODULES], [1], [Have the EnumProcessModules function]) + AC_DEFINE([HAVE_PSAPI_H], [1], [Have the psapi.h header file]) + AC_MSG_RESULT([found]) + ], [ + LIBS="$SAVE_LIBS" + AC_MSG_RESULT([not found]) + ]) + ]) +]) ADDED build/build-platform Index: build/build-platform ================================================================== --- build/build-platform +++ build/build-platform @@ -0,0 +1,79 @@ +#! /bin/bash + +platform="$1" +shift + +if [ -z "${platform}" ]; then + echo "Platforms:" +fi + +for dir in work/libtclkit-*/ __fail__; do + if [ "${dir}" == '__fail__' ]; then + if [ -z "${platform}" ]; then + exit 0 + fi + + echo "No such platform: ${platform}" >&2 + + exit 1 + fi + + dir="$(echo "${dir}" | sed 's@/$@@')" + dir_platform="$(basename "${dir}-" | sed 's@^libtclkit-[^-]*-@@;s@-notk-@-@g;s@-xcompile-@-@g;s@-kitdll-@-@;s@-sdk-@-@g;s@-$@@')" + + if [ -z "${platform}" ]; then + echo " $dir_platform" + else + if [ "${dir_platform}" = "${platform}" ]; then + break + fi + fi +done +dir="$(pwd)/${dir}" + +case "${platform}" in + linux-i386) + platform="x86_64-redhat5-linux 32" + ;; + linux-mipsel) + platform="mipsel-unknown-linux-uclibc" + ;; + solaris-amd64) + platform="i386-pc-solaris2.10 64" + ;; + solaris-i386) + platform="i386-pc-solaris2.10" + ;; + win32-i586) + platform="i586-mingw32msvc" + ;; + win64-amd64) + platform="x86_64-w64-mingw32" + ;; + android-arm) + platform="arm-android9-linux-androideabi" + ;; + netbsd-amd64) + platform="x86_64-unknown-netbsd5" + ;; + '') + exit 0 + ;; + *) + echo "Unknown platform: ${platform}" >&2 + + exit 1 + ;; +esac + +TCLKIT_SDK_DIR="${dir}" +export TCLKIT_SDK_DIR + +make distclean +eval `~/root/cross-compilers/setup-cc $platform` + +platform="$(echo "${platform}" | cut -f1 -d ' ')" + +./configure --host="${platform}" --libdir="$(pwd)/INST" --with-tcl="${dir}/lib" "$@" +make +make install Index: configure.ac ================================================================== --- configure.ac +++ configure.ac @@ -10,11 +10,11 @@ dnl Determine system information DC_CHK_OS_INFO dnl Determine if a shared or static build is requested -AC_ARG_ENABLE([shared], AS_HELP_STRING([--disble-shared], [build static library instead of shared library]), [ +AC_ARG_ENABLE([shared], AS_HELP_STRING([--disable-shared], [build static library instead of shared library]), [ if test "$enableval" = "no"; then TCC4TCL_TARGET=static else TCC4TCL_TARGET=shared fi @@ -67,10 +67,13 @@ *) HOST_PATH_SEPARATOR=':' ;; esac AC_SUBST(HOST_PATH_SEPARATOR) + +dnl Determine how to lookup symbols at runtime +TCC4TCL_FIND_DLOPEN dnl Perform Tcl Extension required stuff TCLEXT_INIT dnl This must be done last since it breaks the compilation Index: tcc4tcl.c ================================================================== --- tcc4tcl.c +++ tcc4tcl.c @@ -20,10 +20,19 @@ */ #include #include #include "tcc.h" +#ifdef HAVE_DLFCN_H +#include +#endif +#ifdef HAVE_PSAPI_H +# ifdef HAVE_WINDOWS_H +# include +# endif +# include +#endif struct TclTCCState { TCCState *s; int relocated; }; @@ -57,17 +66,21 @@ TCCState *s; Tcl_Obj *sym_addr; static CONST char *options[] = { "add_include_path", "add_file", "add_library", "add_library_path", "add_symbol", "command", "compile", - "define", "get_symbol", "output_file", "undefine", (char *) NULL + "define", "get_symbol", "output_file", "undefine", + "add_runtime_sym", + (char *) NULL }; enum options { - TCLTCC_ADD_INCLUDE, TCLTCC_ADD_FILE, TCLTCC_ADD_LIBRARY, - TCLTCC_ADD_LIBRARY_PATH, TCLTCC_ADD_SYMBOL, TCLTCC_COMMAND, TCLTCC_COMPILE, - TCLTCC_DEFINE, TCLTCC_GET_SYMBOL, TCLTCC_OUTPUT_FILE, TCLTCC_UNDEFINE + TCC4TCL_ADD_INCLUDE, TCC4TCL_ADD_FILE, TCC4TCL_ADD_LIBRARY, + TCC4TCL_ADD_LIBRARY_PATH, TCC4TCL_ADD_SYMBOL, TCC4TCL_COMMAND, TCC4TCL_COMPILE, + TCC4TCL_DEFINE, TCC4TCL_GET_SYMBOL, TCC4TCL_OUTPUT_FILE, TCC4TCL_UNDEFINE, + TCC4TCL_ADD_RUNTIME_SYM }; + char *str; ts = (struct TclTCCState *) cdata; s = ts->s; if (objc < 2) { @@ -78,19 +91,19 @@ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { - case TCLTCC_ADD_INCLUDE: + case TCC4TCL_ADD_INCLUDE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } else { tcc_add_include_path(s, Tcl_GetString(objv[2])); return TCL_OK; } - case TCLTCC_ADD_FILE: + case TCC4TCL_ADD_FILE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "filename"); return TCL_ERROR; } else { if(tcc_add_file(s, Tcl_GetString(objv[2]))!=0) { @@ -97,38 +110,38 @@ return TCL_ERROR; } else { return TCL_OK; } } - case TCLTCC_ADD_LIBRARY: + case TCC4TCL_ADD_LIBRARY: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "lib"); return TCL_ERROR; } else { tcc_add_library(s, Tcl_GetString(objv[2])); return TCL_OK; } - case TCLTCC_ADD_LIBRARY_PATH: + case TCC4TCL_ADD_LIBRARY_PATH: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } else { tcc_add_library_path(s, Tcl_GetString(objv[2])); return TCL_OK; } -#if 0 - case TCLTCC_ADD_SYMBOL: + case TCC4TCL_ADD_SYMBOL: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "symbol value"); return TCL_ERROR; } - Tcl_GetLongFromObj(interp,objv[3], &val); + + Tcl_GetLongFromObj(interp, objv[3], &val); + val_p = (void *) val; - tcc_add_symbol(s,Tcl_GetString(objv[2]),val); + tcc_add_symbol(s,Tcl_GetString(objv[2]), val_p); return TCL_OK; -#endif - case TCLTCC_COMMAND: + case TCC4TCL_COMMAND: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "tclname cname"); return TCL_ERROR; } if (!ts->relocated) { @@ -147,11 +160,11 @@ } /*printf("symbol: %x\n",val); */ Tcl_CreateObjCommand(interp,Tcl_GetString(objv[2]),val_p,NULL,NULL); return TCL_OK; - case TCLTCC_COMPILE: + case TCC4TCL_COMPILE: if(ts->relocated == 1) { Tcl_AppendResult(interp, "code already relocated, cannot compile more",NULL); return TCL_ERROR; } if (objc != 3) { @@ -167,18 +180,18 @@ return TCL_ERROR; } else { return TCL_OK; } } - case TCLTCC_DEFINE: + case TCC4TCL_DEFINE: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "symbol value"); return TCL_ERROR; } tcc_define_symbol(s,Tcl_GetString(objv[2]),Tcl_GetString(objv[3])); return TCL_OK; - case TCLTCC_GET_SYMBOL: + case TCC4TCL_GET_SYMBOL: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "symbol"); return TCL_ERROR; } if (!ts->relocated) { @@ -195,11 +208,11 @@ return TCL_ERROR; } sym_addr = Tcl_NewWideIntObj((Tcl_WideInt) val_p); Tcl_SetObjResult(interp, sym_addr); return TCL_OK; - case TCLTCC_OUTPUT_FILE: + case TCC4TCL_OUTPUT_FILE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "filename"); return TCL_ERROR; } if (ts->relocated) { @@ -216,17 +229,66 @@ Tcl_AppendResult(interp, "output to file failed", NULL); return TCL_ERROR; } else { return TCL_OK; } - case TCLTCC_UNDEFINE: + case TCC4TCL_UNDEFINE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "symbol"); return TCL_ERROR; } tcc_undefine_symbol(s,Tcl_GetString(objv[2])); return TCL_OK; + case TCC4TCL_ADD_RUNTIME_SYM: + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "symbol_name"); + return(TCL_ERROR); + } + + str = Tcl_GetString(objv[2]); +#ifdef HAVE_DLSYM + val_p = dlsym(NULL, str); +#elif defined(HAVE_ENUMPROCESSMODULES) + val_p = NULL; + { + HANDLE cur_proc; + HMODULE *modules; + DWORD needed, i; + + needed = 0; + + cur_proc = GetCurrentProcess(); + EnumProcessModules(cur_proc, NULL, 0, &needed); + + if (needed > 0) { + modules = (void *) ckalloc(needed); + if (EnumProcessModules(cur_proc, modules, needed, &needed)) { + for (i = 0; i < (needed / sizeof(HMODULE)); i++) { + val_p = (void *) GetProcAddress(modules[i], str); + + if (val_p) { + break; + } + } + } + + ckfree((void *) modules); + } + } +#else + val_p = NULL; +#endif + + if (val_p == NULL) { + Tcl_AppendResult(interp, "symbol not found", NULL); + + return(TCL_ERROR); + } + + tcc_add_symbol(s, Tcl_GetString(objv[2]), val_p); + + return(TCL_OK); default: Tcl_Panic("internal error during option lookup"); } return TCL_OK; } @@ -269,10 +331,12 @@ ts->relocated = 0; /*printf("type: %d\n", index); */ tcc_set_output_type(s,index); Tcl_CreateObjCommand(interp,Tcl_GetString(objv[objc-1]),Tcc4tclHandleCmd,ts,Tcc4tclCCommandDeleteProc); + + Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; } int Tcc4tcl_Init(Tcl_Interp *interp) { Index: tcc4tcl.tcl ================================================================== --- tcc4tcl.tcl +++ tcc4tcl.tcl @@ -354,16 +354,16 @@ return $code } #--------------------------------------------------------------------- -proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} { +proc ::tcc4tcl::cproc {name adefs rtype {body "#"} {addfuncs ""}} { foreach {code cbody} [wrap $name $adefs $rtype $body] break ::tcc4tcl::ccode $code - uplevel 1 [list ::tcc4tcl::ccommand $name {dummy ip objc objv} $cbody] + uplevel 1 [list ::tcc4tcl::ccommand $name {dummy ip objc objv} $cbody $addfuncs] } #--------------------------------------------------------------------- proc ::tcc4tcl::cdata {name data} { # Extract bytes from data @@ -407,11 +407,11 @@ return $name } #------------------------------------------------------------------- -proc ::tcc4tcl::ccommand {procname anames args} { +proc ::tcc4tcl::ccommand {procname anames body {addfuncs ""}} { variable tcc # Fully qualified proc name if {[string match "::*" $procname]} { # procname is already absolute @@ -460,12 +460,20 @@ } set tcc(code) "" append code "int $cname (ClientData $v(clientdata),Tcl_Interp *$v(interp)," append code "int $v(objc),Tcl_Obj *CONST $v(objv)\[\]) {" "\n" - append code [lindex $args end] "\n" + append code $body "\n" append code "}" "\n" + + if {[llength $addfuncs] > 0} { + set tcc(cc) [tcc4tcl::new] + + foreach addfunc $addfuncs { + $tcc(cc) add_runtime_sym $addfunc + } + } if {[catch { uplevel 1 [list tcc4tcl::cc $code] } err]} { unset tcc(cc) Index: test ================================================================== --- test +++ test @@ -15,11 +15,31 @@ # This should work tcc4tcl::cproc test3 {int i} int { return(i+42); } # Multiple arguments tcc4tcl::cproc add {int a int b} int { return(a+b); } + +# Add external functions +tcc4tcl::cproc mkdir {char* dir} ok { + int rv; + + rv = mkdir(dir); + if (rv == 0) { + return(TCL_OK); + }; + + return(TCL_ERROR); +} [list mkdir] + puts [test 1] puts [test1 1] puts [test3 1] puts [::bob::test1 1] puts [add [test 1] 1] + +catch { + puts [mkdir "/"] +} err +if {$err != ""} { + error "\[mkdir\] did not return the expected error" +}