Check-in [e98c176999]
Overview
Comment:Updated to mount vfs::zip VFS from DLL into /.KITDLL_USER

Updated to mount vfs::zip VFS from application into /.KITDLL_APP

Minor cleanup and added comments

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:e98c176999aa8cb963e567bac7b01e1365f8db7c
User & Date: rkeene on 2010-10-01 20:20:09
Other Links: manifest | tags
Context
2010-10-01
20:45
Updated to include a "package ifneeded" script for Tk on Win32 in addition to other platforms, if Tk built statically. check-in: d3373882b3 user: rkeene tags: trunk
20:20
Updated to mount vfs::zip VFS from DLL into /.KITDLL_USER

Updated to mount vfs::zip VFS from application into /.KITDLL_APP

Minor cleanup and added comments check-in: e98c176999 user: rkeene tags: trunk

20:18
Updated Tcl build to export DLL functionality when building KitDLL check-in: 07648651bc user: rkeene tags: trunk
Changes

Modified kitdll/buildsrc/kitdll-0.0/Makefile.in from [0b69684cf7] to [1e7d1c5fcd].

    50     50   	rm -f tclsh.o tclsh tclsh.exe
    51     51   	rm -f wish.o wish wish.exe
    52     52   
    53     53   distclean: clean
    54     54   	rm -f config.status config.log
    55     55   	rm -f *~
    56     56   	rm -f Makefile
           57  +	rm -rf starpack.vfs
    57     58   
    58     59   mrproper: distclean
    59     60   
    60     61   .PHONY: all clean distclean

Modified kitdll/buildsrc/kitdll-0.0/aclocal.m4 from [8720922151] to [5c684392af].

   252    252   
   253    253   		AC_MSG_RESULT([${libfiles}])
   254    254   	done
   255    255   
   256    256   	AC_SUBST(WISH_CFLAGS)
   257    257   	AC_SUBST(ARCHS)
   258    258   ])
          259  +
          260  +AC_DEFUN(DC_CHECK_FOR_ACCEPTABLE_DLADDR, [
          261  +	AC_CHECK_HEADERS(dlfcn.h)
          262  +	AC_CHECK_FUNCS(dladdr)
          263  +
          264  +	AC_MSG_CHECKING([for acceptable dladdr])
          265  +
          266  +	AC_LINK_IFELSE(
          267  +		AC_LANG_PROGRAM([[
          268  +#ifdef HAVE_DLFCN_H
          269  +#include <dlfcn.h>
          270  +#endif
          271  +			]], [[
          272  +char *x;
          273  +Dl_info syminfo;
          274  +dladdr((void *) 0, &syminfo);
          275  +x = syminfo.dli_fname;
          276  +			]]
          277  +		),
          278  +		[
          279  +			AC_MSG_RESULT([found])
          280  +			AC_DEFINE(HAVE_ACCEPTABLE_DLADDR, [1], [Define to 1 if you have an acceptable dladdr implementation with dli_fname])
          281  +		], [
          282  +			AC_MSG_RESULT([not found])
          283  +		]
          284  +	)
          285  +])

Modified kitdll/buildsrc/kitdll-0.0/boot.tcl from [05bce6a79b] to [31a964e643].

     1      1   proc tclInit {} {
     2      2   	rename tclInit {}
     3      3   
     4      4   	global auto_path tcl_library tcl_libPath
     5         -	global tcl_version tcl_rcFileName
            5  +	global tcl_version
     6      6     
     7      7   	# Set path where to mount VFS
     8         -	set noe "/.KITDLL_TCL"
            8  +	set tcl_mountpoint "/.KITDLL_TCL"
     9      9   
    10         -	set tcl_library [file join $noe lib tcl$tcl_version]
    11         -	set tcl_libPath [list $tcl_library [file join $noe lib]]
           10  +	set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
           11  +	set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]
    12     12   
    13     13   	# get rid of a build residue
    14     14   	unset -nocomplain ::tclDefaultLibrary
    15     15   
    16     16   	# the following code only gets executed once on startup
    17         -	if {[info exists tcl_rcFileName]} {
           17  +	if {[info exists ::initVFS]} {
    18     18   		set vfsHandler [list ::vfs::kitdll::vfshandler tcl]
    19     19   
    20     20   		# alter path to find encodings
    21     21   		if {[info tclversion] eq "8.4"} {
    22     22   			load {} pwb
    23     23   			librarypath [info library]
    24     24   		} else {
................................................................................
    46     46   			}
    47     47   		}
    48     48   
    49     49   		# now remount the executable with the correct encoding
    50     50   		vfs::filesystem unmount [lindex [::vfs::filesystem info] 0]
    51     51   
    52     52   		# Resolve symlinks
    53         -		set noe [file dirname [file normalize [file join $noe __dummy__]]]
           53  +		set tcl_mountpoint [file dirname [file normalize [file join $tcl_mountpoint __dummy__]]]
    54     54   
    55         -		set tcl_library [file join $noe lib tcl$tcl_version]
    56         -		set tcl_libPath [list $tcl_library [file join $noe lib]]
           55  +		set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
           56  +		set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]
           57  +
           58  +		vfs::filesystem mount $tcl_mountpoint $vfsHandler
    57     59   
    58         -		vfs::filesystem mount $noe $vfsHandler
    59     60   	}
    60         -  
           61  +
    61     62   	# load config settings file if present
    62     63   	namespace eval ::vfs { variable tclkit_version 1 }
    63         -	catch { uplevel #0 [list source [file join $noe config.tcl]] }
           64  +	catch { uplevel #0 [list source [file join $tcl_mountpoint config.tcl]] }
    64     65   
    65     66   	uplevel #0 [list source [file join $tcl_library init.tcl]]
    66     67     
    67     68   	# reset auto_path, so that init.tcl's search outside of tclkit is cancelled
    68     69   	set auto_path $tcl_libPath
    69     70   
    70     71   	# This loads everything needed for "clock scan" to work
    71     72   	# "clock scan" is used within "vfs::zip", which may be
    72     73   	# loaded before this is run causing the root VFS to break
    73     74   	catch { clock scan }
           75  +
           76  +	# Load these, the original Tclkit does so it should be safe.
           77  +	uplevel #0 [list source [file join $tcl_mountpoint lib vfs vfsUtils.tcl]]
           78  +
           79  +	# Now that the initialization is complete, mount the user VFS if needed
           80  +	## Mount the VFS from the Shared Object
           81  +	if {[info exists ::initVFS] && [info exists ::tclKitFilename]} {
           82  +		catch {
           83  +			package require vfs::zip
           84  +
           85  +			vfs::zip::Mount $::tclKitFilename "/.KITDLL_USER"
           86  +
           87  +			lappend auto_path [file normalize "/.KITDLL_USER/lib"]
           88  +		}
           89  +	}
           90  +
           91  +	## Mount the VFS from executable
           92  +	if {[info exists ::initVFS]} {
           93  +		catch {
           94  +			package require vfs::zip
           95  +
           96  +			vfs::zip::Mount [info nameofexecutable] "/.KITDLL_APP"
           97  +
           98  +			lappend auto_path [file normalize "/.KITDLL_APP/lib"]
           99  +		}
          100  +	}
          101  +
          102  +	# Clean up after the kitInit.c:preInitCmd
          103  +	unset -nocomplain ::initVFS ::tclKitFilename
    74    104   }

Modified kitdll/buildsrc/kitdll-0.0/configure.ac from [b8d6fe9340] to [1f754d4d41].

    33     33   
    34     34   dnl Find extra objects we need to link as a part of "libtclkit"
    35     35   AC_SUBST(EXTRA_OBJS)
    36     36   
    37     37   dnl Check for optional headers
    38     38   AC_HEADER_STDC
    39     39   AC_CHECK_HEADERS(unistd.h string.h strings.h)
           40  +
           41  +dnl Check for optional system calls
           42  +AC_CHECK_FUNCS(readlink)
           43  +
           44  +dnl Check for acceptable dladdr so we can find ourselves on UNIX
           45  +DC_CHECK_FOR_ACCEPTABLE_DLADDR
    40     46   
    41     47   dnl Produce output
    42     48   AC_OUTPUT(Makefile)

Modified kitdll/buildsrc/kitdll-0.0/kitInit.c from [6d34381c61] to [1913b3a1f3].

     5      5   #endif /* KIT_INCLUDES_TK */
     6      6   
     7      7   #ifdef _WIN32
     8      8   #  define WIN32_LEAN_AND_MEAN
     9      9   #  include <windows.h>
    10     10   #  undef WIN32_LEAN_AND_MEAN
    11     11   #endif /* _WIN32 */
           12  +
           13  +#ifdef HAVE_STRING_H
           14  +#  include <string.h>
           15  +#endif
           16  +#ifdef HAVE_STRINGS_H
           17  +#  include <strings.h>
           18  +#endif
           19  +#ifdef HAVE_DLFCN_H
           20  +#  include <dlfcn.h>
           21  +#endif
    12     22   
    13     23   #include "tclInt.h"
    14     24   
    15     25   #if defined(HAVE_TCL_GETENCODINGNAMEFROMENVIRONMENT) && defined(HAVE_TCL_SETSYSTEMENCODING)
    16     26   #  define TCLKIT_CAN_SET_ENCODING 1
           27  +#endif
           28  +#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
           29  +#  define TCLKIT_REQUIRE_TCLEXECUTABLENAME 1
    17     30   #endif
    18     31   #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
    19     32   #  define KIT_INCLUDES_PWB 1
    20     33   #endif
    21     34   
    22     35   Tcl_AppInitProc Vfs_Init, Rechan_Init;
    23     36   Tcl_AppInitProc Vfs_kitdll_data_tcl_Init;
................................................................................
    27     40   #ifdef TCL_THREADS
    28     41   Tcl_AppInitProc Thread_Init;
    29     42   #endif
    30     43   #ifdef _WIN32
    31     44   Tcl_AppInitProc Dde_Init, Registry_Init;
    32     45   #endif
    33     46   
           47  +/*
           48  + * This Tcl code is invoked whenever Tcl_Init() is called on an
           49  + * interpreter.  It should mount up the VFS and make everything ready for
           50  + * that interpreter to do its job.
           51  + */
    34     52   static char *preInitCmd =
    35     53   "proc tclKitInit {} {\n"
    36     54   	"rename tclKitInit {}\n"
    37     55   	"load {} tclkit::init\n"
    38     56   	"load {} rechan\n"
    39     57   	"load {} vfs\n"
    40     58   	"load {} vfs_kitdll_data_tcl\n"
    41     59   #include "vfs_kitdll.tcl.h"
    42         -	"vfs::kitdll::Mount tcl /.KITDLL_TCL\n"
           60  +	"if {![file exists \"/.KITDLL_TCL/boot.tcl\"]} {\n"
           61  +		"vfs::kitdll::Mount tcl /.KITDLL_TCL\n"
           62  +		"set ::initVFS 1\n"
           63  +	"}\n"
    43     64   	"set f [open \"/.KITDLL_TCL/boot.tcl\"]\n"
    44     65   	"set s [read $f]\n"
    45     66   	"close $f\n"
    46     67   	"::tclkit::init::initInterp\n"
    47     68   	"rename ::tclkit::init::initInterp {}\n"
    48     69   	"uplevel #0 $s\n"
    49     70   #if defined(KIT_INCLUDES_TK) && defined(KIT_TK_VERSION)
................................................................................
    54     75   #ifdef _WIN32
    55     76   	"catch {load {} dde}\n"
    56     77   	"catch {load {} registry}\n"
    57     78   #endif /* _WIN32 */
    58     79   "}\n"
    59     80   "tclKitInit";
    60     81   
           82  +#ifdef HAVE_ACCEPTABLE_DLADDR
           83  +/* Symbol to resolve against dladdr() */
           84  +static void _tclkit_dummy_func(void) {
           85  +	return;
           86  +}
           87  +
           88  +int main(int argc, char **argv);
           89  +#endif /* HAVE_ACCEPTABLE_DLADDR */
           90  +
           91  +/*
           92  + * This function will return a pathname we can open() to treat as a VFS,
           93  + * hopefully
           94  + */
           95  +static char *find_tclkit_dll_path(void) {
           96  +#ifdef HAVE_ACCEPTABLE_DLADDR
           97  +	Dl_info syminfo;
           98  +	int dladdr_ret;
           99  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          100  +#ifdef _WIN32
          101  +	TCHAR modulename[8192];
          102  +	DWORD gmfn_ret;
          103  +#endif /* _WIN32 */
          104  +
          105  +#ifdef HAVE_ACCEPTABLE_DLADDR
          106  +	dladdr_ret = dladdr(&_tclkit_dummy_func, &syminfo);
          107  +	if (dladdr_ret != 0) {
          108  +		if (syminfo.dli_fname && syminfo.dli_fname[0] != '\0') {
          109  +			return(strdup(syminfo.dli_fname));
          110  +		}
          111  +	}
          112  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          113  +
          114  +#ifdef _WIN32
          115  +	gmfn_ret = GetModuleFileName(TclWinGetTclInstance(), modulename, sizeof(modulename) / sizeof(modulename[0]) - 1);
          116  +
          117  +	if (gmfn_ret != 0) {
          118  +		return(strdup(modulename));
          119  +	}
          120  +#endif /* _WIN32 */
          121  +
          122  +	return(NULL);
          123  +}
          124  +
          125  +/* SetExecName --
          126  +	
          127  +   Hack to get around Tcl bug 1224888.
          128  +*/
          129  +static void SetExecName(Tcl_Interp *interp, const char *path) {
          130  +#ifdef TCLKIT_REQUIRE_TCLEXECUTABLENAME
          131  +	tclExecutableName = strdup(path);
          132  +#endif  
          133  +	Tcl_FindExecutable(path);
          134  +
          135  +	return;
          136  +}
          137  +	
          138  +static void FindAndSetExecName(Tcl_Interp *interp) {
          139  +	int len = 0;
          140  +	Tcl_Obj *execNameObj;
          141  +	Tcl_Obj *lobjv[1];
          142  +#ifdef HAVE_READLINK
          143  +	ssize_t readlink_ret;
          144  +	char exe_buf[4096];
          145  +#endif /* HAVE_READLINK */
          146  +#ifdef HAVE_ACCEPTABLE_DLADDR
          147  +	Dl_info syminfo;
          148  +	int dladdr_ret;
          149  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          150  +
          151  +#ifdef HAVE_READLINK
          152  +	if (Tcl_GetNameOfExecutable() == NULL) {
          153  +		readlink_ret = readlink("/proc/self/exe", exe_buf, sizeof(exe_buf) - 1);
          154  +		
          155  +		if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) {
          156  +			exe_buf[readlink_ret] = '\0';
          157  +			
          158  +			SetExecName(interp, exe_buf);
          159  +			
          160  +			return;
          161  +		}
          162  +	}
          163  +	
          164  +	if (Tcl_GetNameOfExecutable() == NULL) {
          165  +		readlink_ret = readlink("/proc/curproc/file", exe_buf, sizeof(exe_buf) - 1);												 
          166  +
          167  +		if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) {
          168  +			exe_buf[readlink_ret] = '\0';
          169  +
          170  +			if (strcmp(exe_buf, "unknown") != 0) {
          171  +				SetExecName(interp, exe_buf);
          172  +
          173  +				return;
          174  +			}
          175  +		}
          176  +	}
          177  +#endif /* HAVE_READLINK */
          178  +
          179  +#ifdef HAVE_ACCEPTABLE_DLADDR
          180  +	if (Tcl_GetNameOfExecutable() == NULL) {
          181  +		dladdr_ret = dladdr(&main, &syminfo);
          182  +		if (dladdr_ret != 0) {
          183  +			SetExecName(interp, syminfo.dli_fname);
          184  +		}
          185  +	}
          186  +#endif /* HAVE_ACCEPTABLE_DLADDR */
          187  +
          188  +	if (Tcl_GetNameOfExecutable() == NULL) {
          189  +		lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
          190  +		execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv);
          191  +
          192  +		SetExecName(interp, Tcl_GetStringFromObj(execNameObj, &len));
          193  +
          194  +		return;
          195  +	}
          196  +
          197  +	return;
          198  +}
          199  +
          200  +
          201  +/*
          202  + * This function exists to allow C code to initialize a particular
          203  + * interpreter.
          204  + */
    61    205   static int tclkit_init_initinterp(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          206  +	char *kitdll_path;
          207  +
    62    208   #ifdef _WIN32
    63    209   	Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
    64    210   #else   
    65    211   	Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
    66    212   #endif
          213  +
          214  +	kitdll_path = find_tclkit_dll_path();
          215  +	if (kitdll_path != NULL) {
          216  +		Tcl_SetVar(interp, "tclKitFilename", kitdll_path, TCL_GLOBAL_ONLY);
          217  +
          218  +		free(kitdll_path);
          219  +	}
          220  +
          221  +	FindAndSetExecName(interp);
    67    222   
    68    223   #ifdef TCLKIT_CAN_SET_ENCODING
    69    224   	/* Set the encoding from the Environment */
    70    225   	Tcl_GetEncodingNameFromEnvironment(&encodingName);
    71    226   	Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName));
    72    227   	Tcl_SetVar(interp, "tclkit_system_encoding", Tcl_DStringValue(&encodingName), 0);
    73    228   	Tcl_DStringFree(&encodingName);
    74    229   #endif  
    75    230   
    76    231   	return(TCL_OK);
    77    232   }
    78    233   
          234  +/*
          235  + * Create a package for initializing a particular interpreter.  This is
          236  + * our hook to have Tcl invoke C commands when creating an interpreter.
          237  + * The preInitCmd will load the package in the new interpreter and invoke
          238  + * this function.
          239  + */
    79    240   int Tclkit_init_Init(Tcl_Interp *interp) {
    80    241   	Tcl_Command tclCreatComm_ret;
    81    242   	int tclPkgProv_ret;
    82    243   
    83    244   	tclCreatComm_ret = Tcl_CreateObjCommand(interp, "::tclkit::init::initInterp", tclkit_init_initinterp, NULL, NULL);
    84    245   	if (!tclCreatComm_ret) {
    85    246   		return(TCL_ERROR);
................................................................................
    86    247   	}
    87    248   
    88    249   	tclPkgProv_ret = Tcl_PkgProvide(interp, "tclkit::init", "1.0");
    89    250   
    90    251   	return(tclPkgProv_ret);
    91    252   }
    92    253   
          254  +/*
          255  + * Initialize the Tcl system when we are loaded, that way Tcl functions
          256  + * are ready to be used when invoked.
          257  + */
    93    258   void __attribute__((constructor)) _Tclkit_Init(void) {
    94    259   	Tcl_StaticPackage(0, "tclkit::init", Tclkit_init_Init, NULL);
    95    260   	Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
    96    261   	Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
    97    262   	Tcl_StaticPackage(0, "vfs_kitdll_data_tcl", Vfs_kitdll_data_tcl_Init, NULL);
    98    263   #ifdef KIT_INCLUDES_PWB
    99    264   	Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);