Fossil SCM

Refinements to the Tcl stubs integration.

mistachkin 2012-09-28 20:15 UTC tclStubsV2

Commit a0b3507d6c975d9b177fc837b4976fb51fb35bb8

Parent ba91fe5f9e999b9…

6 files changed +3 +17 -1 +143 -52 +17 -1 +17 -1 +5

~ src/main.c ~ src/makemake.tcl ~ src/th_tcl.c ~ win/Makefile.mingw ~ win/Makefile.mingw.mistachkin ~ win/fossil.rc

M src/main.c

		--- src/main.c
		+++ src/main.c
		@@ -90,10 +90,13 @@
90	90	** "th_tcl.c".
91	91	*/
92	92	struct TclContext {
93	93	int argc;
94	94	char **argv;
	95	+ void *library;
	96	+ void xFindExecutable; / see tcl_FindExecutableProc in th_tcl.c */
	97	+ void xCreateInterp; / see tcl_CreateInterpProc in th_tcl.c */
95	98	Tcl_Interp *interp;
96	99	};
97	100	#endif
98	101
99	102	/*
100	103

	--- src/main.c
	+++ src/main.c
	@@ -90,10 +90,13 @@
90	** "th_tcl.c".
91	*/
92	struct TclContext {
93	int argc;
94	char **argv;



95	Tcl_Interp *interp;
96	};
97	#endif
98
99	/*
100

	--- src/main.c
	+++ src/main.c
	@@ -90,10 +90,13 @@
90	** "th_tcl.c".
91	*/
92	struct TclContext {
93	int argc;
94	char **argv;
95	void *library;
96	void xFindExecutable; / see tcl_FindExecutableProc in th_tcl.c */
97	void xCreateInterp; / see tcl_CreateInterpProc in th_tcl.c */
98	Tcl_Interp *interp;
99	};
100	#endif
101
102	/*
103

M src/makemake.tcl

+17 -1

		--- src/makemake.tcl
		+++ src/makemake.tcl
		@@ -375,10 +375,14 @@
375	375	# FOSSIL_ENABLE_SSL = 1
376	376
377	377	#### Enable scripting support via Tcl/Tk
378	378	#
379	379	# FOSSIL_ENABLE_TCL = 1
	380	+
	381	+#### Load Tcl using the stubs mechanism
	382	+#
	383	+# FOSSIL_ENABLE_TCL_STUBS = 1
380	384
381	385	#### Use the Tcl source directory instead of the install directory?
382	386	# This is useful when Tcl has been compiled statically with MinGW.
383	387	#
384	388	FOSSIL_TCL_SOURCE = 1
		@@ -424,11 +428,15 @@
424	428	TCLINCDIR = $(TCLDIR)/include
425	429	TCLLIBDIR = $(TCLDIR)/lib
426	430
427	431	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
428	432	#
	433	+ifdef FOSSIL_ENABLE_TCL_STUBS
429	434	LIBTCL = -ltclstub86
	435	+else
	436	+LIBTCL = -ltcl86
	437	+endif
430	438
431	439	#### C Compile and options for use in building executables that
432	440	# will run on the target platform. This is usually the same
433	441	# as BCC, unless you are cross-compiling. This C compiler builds
434	442	# the finished binary for fossil. The BCC compiler above is used
		@@ -464,12 +472,20 @@
464	472	RCC += -DFOSSIL_ENABLE_SSL=1
465	473	endif
466	474
467	475	# With Tcl support
468	476	ifdef FOSSIL_ENABLE_TCL
469		-TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
	477	+TCC += -DFOSSIL_ENABLE_TCL=1
470	478	RCC += -DFOSSIL_ENABLE_TCL=1
	479	+# Either statically linked or via stubs
	480	+ifdef FOSSIL_ENABLE_TCL_STUBS
	481	+TCC += -DUSE_TCL_STUBS
	482	+RCC += -DUSE_TCL_STUBS
	483	+else
	484	+TCC += -DSTATIC_BUILD
	485	+RCC += -DSTATIC_BUILD
	486	+endif
471	487	endif
472	488
473	489	# With JSON support
474	490	ifdef FOSSIL_ENABLE_JSON
475	491	TCC += -DFOSSIL_ENABLE_JSON=1
476	492

	--- src/makemake.tcl
	+++ src/makemake.tcl
	@@ -375,10 +375,14 @@
375	# FOSSIL_ENABLE_SSL = 1
376
377	#### Enable scripting support via Tcl/Tk
378	#
379	# FOSSIL_ENABLE_TCL = 1




380
381	#### Use the Tcl source directory instead of the install directory?
382	# This is useful when Tcl has been compiled statically with MinGW.
383	#
384	FOSSIL_TCL_SOURCE = 1
	@@ -424,11 +428,15 @@
424	TCLINCDIR = $(TCLDIR)/include
425	TCLLIBDIR = $(TCLDIR)/lib
426
427	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
428	#

429	LIBTCL = -ltclstub86



430
431	#### C Compile and options for use in building executables that
432	# will run on the target platform. This is usually the same
433	# as BCC, unless you are cross-compiling. This C compiler builds
434	# the finished binary for fossil. The BCC compiler above is used
	@@ -464,12 +472,20 @@
464	RCC += -DFOSSIL_ENABLE_SSL=1
465	endif
466
467	# With Tcl support
468	ifdef FOSSIL_ENABLE_TCL
469	TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
470	RCC += -DFOSSIL_ENABLE_TCL=1








471	endif
472
473	# With JSON support
474	ifdef FOSSIL_ENABLE_JSON
475	TCC += -DFOSSIL_ENABLE_JSON=1
476

	--- src/makemake.tcl
	+++ src/makemake.tcl
	@@ -375,10 +375,14 @@
375	# FOSSIL_ENABLE_SSL = 1
376
377	#### Enable scripting support via Tcl/Tk
378	#
379	# FOSSIL_ENABLE_TCL = 1
380
381	#### Load Tcl using the stubs mechanism
382	#
383	# FOSSIL_ENABLE_TCL_STUBS = 1
384
385	#### Use the Tcl source directory instead of the install directory?
386	# This is useful when Tcl has been compiled statically with MinGW.
387	#
388	FOSSIL_TCL_SOURCE = 1
	@@ -424,11 +428,15 @@
428	TCLINCDIR = $(TCLDIR)/include
429	TCLLIBDIR = $(TCLDIR)/lib
430
431	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
432	#
433	ifdef FOSSIL_ENABLE_TCL_STUBS
434	LIBTCL = -ltclstub86
435	else
436	LIBTCL = -ltcl86
437	endif
438
439	#### C Compile and options for use in building executables that
440	# will run on the target platform. This is usually the same
441	# as BCC, unless you are cross-compiling. This C compiler builds
442	# the finished binary for fossil. The BCC compiler above is used
	@@ -464,12 +472,20 @@
472	RCC += -DFOSSIL_ENABLE_SSL=1
473	endif
474
475	# With Tcl support
476	ifdef FOSSIL_ENABLE_TCL
477	TCC += -DFOSSIL_ENABLE_TCL=1
478	RCC += -DFOSSIL_ENABLE_TCL=1
479	# Either statically linked or via stubs
480	ifdef FOSSIL_ENABLE_TCL_STUBS
481	TCC += -DUSE_TCL_STUBS
482	RCC += -DUSE_TCL_STUBS
483	else
484	TCC += -DSTATIC_BUILD
485	RCC += -DSTATIC_BUILD
486	endif
487	endif
488
489	# With JSON support
490	ifdef FOSSIL_ENABLE_JSON
491	TCC += -DFOSSIL_ENABLE_JSON=1
492

M src/th_tcl.c

+143 -52

		--- src/th_tcl.c
		+++ src/th_tcl.c
		@@ -32,17 +32,11 @@
32	32	((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
33	33	/*
34	34	** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
35	35	** Tcl_EvalObjv instead of invoking the objProc directly.
36	36	*/
37		-#define USE_TCL_EVALOBJV 1
38		-#endif
39		-
40		-#ifdef _WIN32
41		-# include <windows.h>
42		-#else
43		-# include <dlfcn.h>
	37	+# define USE_TCL_EVALOBJV 1
44	38	#endif
45	39
46	40	/*
47	41	** These macros are designed to reduce the redundant code required to marshal
48	42	** arguments from TH1 to Tcl.
		@@ -71,10 +65,76 @@
71	65	** context.
72	66	*/
73	67	#define GET_CTX_TCL_INTERP(ctx) \
74	68	((struct TclContext *)(ctx))->interp
75	69
	70	+/*
	71	+** Define the Tcl shared library name, some exported function names, and some
	72	+** cross-platform macros for use with the Tcl stubs mechanism, when enabled.
	73	+ */
	74	+#if defined(USE_TCL_STUBS)
	75	+# if defined(_WIN32)
	76	+# define WIN32_LEAN_AND_MEAN
	77	+# include <windows.h>
	78	+# ifndef TCL_LIBRARY_NAME
	79	+# define TCL_LIBRARY_NAME "tcl86.dll\0"
	80	+# endif
	81	+# ifndef TCL_MINOR_OFFSET
	82	+# define TCL_MINOR_OFFSET (4)
	83	+# endif
	84	+# ifndef dlopen
	85	+# define dlopen(a,b) (void *)LoadLibrary((a));
	86	+# endif
	87	+# ifndef dlsym
	88	+# define dlsym(a,b) GetProcAddress((HANDLE)(a),(b));
	89	+# endif
	90	+# ifndef dlclose
	91	+# define dlclose(a) FreeLibrary((HANDLE)(a));
	92	+# endif
	93	+# else
	94	+# include <dlfcn.h>
	95	+# if defined(__CYGWIN__)
	96	+# ifndef TCL_LIBRARY_NAME
	97	+# define TCL_LIBRARY_NAME "libtcl8.6.dll\0"
	98	+# endif
	99	+# ifndef TCL_MINOR_OFFSET
	100	+# define TCL_MINOR_OFFSET (8)
	101	+# endif
	102	+# elif defined(__APPLE__)
	103	+# ifndef TCL_LIBRARY_NAME
	104	+# define TCL_LIBRARY_NAME "libtcl8.6.dylib\0"
	105	+# endif
	106	+# ifndef TCL_MINOR_OFFSET
	107	+# define TCL_MINOR_OFFSET (8)
	108	+# endif
	109	+# else
	110	+# ifndef TCL_LIBRARY_NAME
	111	+# define TCL_LIBRARY_NAME "libtcl8.6.so\0"
	112	+# endif
	113	+# ifndef TCL_MINOR_OFFSET
	114	+# define TCL_MINOR_OFFSET (8)
	115	+# endif
	116	+# endif /* defined(__CYGWIN__) */
	117	+# endif /* defined(_WIN32) */
	118	+# ifndef TCL_FINDEXECUTABLE_NAME
	119	+# define TCL_FINDEXECUTABLE_NAME "_Tcl_FindExecutable"
	120	+# endif
	121	+# ifndef TCL_CREATEINTERP_NAME
	122	+# define TCL_CREATEINTERP_NAME "_Tcl_CreateInterp"
	123	+# endif
	124	+#endif /* defined(USE_TCL_STUBS) */
	125	+
	126	+/*
	127	+** The function pointer types for Tcl_FindExecutable and Tcl_CreateInterp are
	128	+** needed when the Tcl library is being loaded dynamically by a stubs-enabled
	129	+** application (i.e. the inverse of using a stubs-enabled package). These are
	130	+** the only Tcl API functions that MUST be called prior to being able to call
	131	+** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).
	132	+ */
	133	+typedef void (tcl_FindExecutableProc) (CONST char * argv0);
	134	+typedef Tcl_Interp *(tcl_CreateInterpProc) (void);
	135	+
76	136	/*
77	137	** Creates and initializes a Tcl interpreter for use with the specified TH1
78	138	** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
79	139	** by the caller. This must be declared here because quite a few functions in
80	140	** this file need to use it before it can be defined.
		@@ -108,10 +168,13 @@
108	168	** copied from and should be kept in sync with the one in "main.c".
109	169	*/
110	170	struct TclContext {
111	171	int argc;
112	172	char **argv;
	173	+ void *library;
	174	+ tcl_FindExecutableProc *xFindExecutable;
	175	+ tcl_CreateInterpProc *xCreateInterp;
113	176	Tcl_Interp *interp;
114	177	};
115	178
116	179	/*
117	180	** Syntax:
		@@ -381,10 +444,77 @@
381	444	/* Remove the Tcl integration commands. */
382	445	for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
383	446	Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
384	447	}
385	448	}
	449	+
	450	+/*
	451	+** When Tcl stubs support is enabled, attempts to dynamically load the Tcl
	452	+** shared library and fetch the function pointers necessary to create an
	453	+** interpreter and initialize the stubs mechanism; otherwise, simply setup
	454	+** the function pointers provided by the caller with the statically linked
	455	+** functions.
	456	+ */
	457	+static int loadTcl(
	458	+ Th_Interp *interp,
	459	+ void **pLibrary,
	460	+ tcl_FindExecutableProc **pxFindExecutable,
	461	+ tcl_CreateInterpProc **pxCreateInterp
	462	+){
	463	+#if defined(USE_TCL_STUBS)
	464	+ char fileName[] = TCL_LIBRARY_NAME;
	465	+#endif
	466	+ if( !pLibrary \|\| !pxFindExecutable \|\| !pxCreateInterp ){
	467	+ Th_ErrorMessage(interp,
	468	+ "Invalid Tcl loader argument(s)", (const char *)"", 0);
	469	+ return TH_ERROR;
	470	+ }
	471	+#if defined(USE_TCL_STUBS)
	472	+ do {
	473	+ void *library = dlopen(fileName, RTLD_NOW \| RTLD_GLOBAL);
	474	+ if( library ){
	475	+ tcl_FindExecutableProc *xFindExecutable;
	476	+ tcl_CreateInterpProc *xCreateInterp;
	477	+ const char *procName = TCL_FINDEXECUTABLE_NAME;
	478	+ xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName + 1);
	479	+ if( !xFindExecutable ){
	480	+ xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName);
	481	+ }
	482	+ if( !xFindExecutable ){
	483	+ Th_ErrorMessage(interp,
	484	+ "Could not locate Tcl_FindExecutable", (const char *)"", 0);
	485	+ dlclose(library);
	486	+ return TH_ERROR;
	487	+ }
	488	+ procName = TCL_CREATEINTERP_NAME;
	489	+ xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName + 1);
	490	+ if( !xCreateInterp ){
	491	+ xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName);
	492	+ }
	493	+ if( !xCreateInterp ){
	494	+ Th_ErrorMessage(interp,
	495	+ "Could not locate Tcl_CreateInterp", (const char *)"", 0);
	496	+ dlclose(library);
	497	+ return TH_ERROR;
	498	+ }
	499	+ *pLibrary = library;
	500	+ *pxFindExecutable = xFindExecutable;
	501	+ *pxCreateInterp = xCreateInterp;
	502	+ return TH_OK;
	503	+ }
	504	+ } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
	505	+ Th_ErrorMessage(interp,
	506	+ "Could not load Tcl shared library \"" TCL_LIBRARY_NAME "\"",
	507	+ (const char *)"", 0);
	508	+ return TH_ERROR;
	509	+#else
	510	+ *pLibrary = 0;
	511	+ *pxFindExecutable = Tcl_FindExecutable;
	512	+ *pxCreateInterp = Tcl_CreateInterp;
	513	+ return TH_OK;
	514	+#endif
	515	+}
386	516
387	517	/*
388	518	** Sets the "argv0", "argc", and "argv" script variables in the Tcl interpreter
389	519	** based on the supplied command line arguments.
390	520	*/
		@@ -451,70 +581,31 @@
451	581	){
452	582	struct TclContext tclContext = (struct TclContext )pContext;
453	583	int argc;
454	584	char **argv;
455	585	char *argv0 = 0;
456		-#ifdef USE_TCL_STUBS
457		-#ifdef _WIN32
458		- WCHAR lib[] = L"tcl87.dll";
459		-#define minver lib[4]
460		-#define dlopen(a,b) (void *)LoadLibraryW(a);
461		-#define dlsym(a,b) GetProcAddress((HANDLE)(a),b);
462		-#else
463		-#ifdef __CYGWIN__
464		- char lib[] = "libtcl8.7.dll";
465		-#else
466		- char lib[] = "libtcl8.7.so";
467		-#endif
468		-#define minver lib[8]
469		-#endif
470		- void *handle = NULL;
471		- void (findExecutable)(const char ) = 0;
472		- Tcl_Interp (createInterp)() = 0;
473		-#endif /* USE_TCL_STUBS */
474	586	Tcl_Interp *tclInterp;
475	587
476	588	if ( !tclContext ){
477	589	Th_ErrorMessage(interp,
478	590	"Invalid Tcl context", (const char *)"", 0);
479	591	return TH_ERROR;
480	592	}
481	593	if ( tclContext->interp ){
482	594	return TH_OK;
	595	+ }
	596	+ if( loadTcl(interp, &tclContext->library, &tclContext->xFindExecutable,
	597	+ &tclContext->xCreateInterp)!=TH_OK ){
	598	+ return TH_ERROR;
483	599	}
484	600	argc = tclContext->argc;
485	601	argv = tclContext->argv;
486	602	if( argc>0 && argv ){
487	603	argv0 = argv[0];
488	604	}
489		-#ifdef USE_TCL_STUBS
490		- while( --minver>'3' ){
491		- handle = dlopen(lib, RTLD_NOW \| RTLD_LOCAL);
492		- if( handle ) {
493		- const char *sym = "_Tcl_FindExecutable";
494		- findExecutable = (void ()(const char )) dlsym(handle, sym+1);
495		- if (!findExecutable)
496		- findExecutable = (void ()(const char )) dlsym(handle, sym);
497		- sym = "_Tcl_CreateInterp";
498		- createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym+1);
499		- if (!createInterp)
500		- createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym);
501		- break;
502		- }
503		- }
504		- if( !handle ){
505		- Th_ErrorMessage(interp,
506		- "Could not create Tcl interpreter", (const char *)"", 0);
507		- return TH_ERROR;
508		- }
509		-# undef Tcl_FindExecutable
510		-# define Tcl_FindExecutable findExecutable
511		-# undef Tcl_CreateInterp
512		-# define Tcl_CreateInterp createInterp
513		-#endif /* USE_TCL_STUBS */
514		- Tcl_FindExecutable(argv0);
515		- tclInterp = Tcl_CreateInterp();
	605	+ tclContext->xFindExecutable(argv0);
	606	+ tclInterp = tclContext->xCreateInterp();
516	607	if( !tclInterp \|\| !Tcl_InitStubs(tclInterp, "8.4", 0)
517	608	\|\| Tcl_InterpDeleted(tclInterp) ){
518	609	Th_ErrorMessage(interp,
519	610	"Could not create Tcl interpreter", (const char *)"", 0);
520	611	return TH_ERROR;
521	612

	--- src/th_tcl.c
	+++ src/th_tcl.c
	@@ -32,17 +32,11 @@
32	((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
33	/*
34	** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
35	** Tcl_EvalObjv instead of invoking the objProc directly.
36	*/
37	#define USE_TCL_EVALOBJV 1
38	#endif
39
40	#ifdef _WIN32
41	# include <windows.h>
42	#else
43	# include <dlfcn.h>
44	#endif
45
46	/*
47	** These macros are designed to reduce the redundant code required to marshal
48	** arguments from TH1 to Tcl.
	@@ -71,10 +65,76 @@
71	** context.
72	*/
73	#define GET_CTX_TCL_INTERP(ctx) \
74	((struct TclContext *)(ctx))->interp
75


































































76	/*
77	** Creates and initializes a Tcl interpreter for use with the specified TH1
78	** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
79	** by the caller. This must be declared here because quite a few functions in
80	** this file need to use it before it can be defined.
	@@ -108,10 +168,13 @@
108	** copied from and should be kept in sync with the one in "main.c".
109	*/
110	struct TclContext {
111	int argc;
112	char **argv;



113	Tcl_Interp *interp;
114	};
115
116	/*
117	** Syntax:
	@@ -381,10 +444,77 @@
381	/* Remove the Tcl integration commands. */
382	for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
383	Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
384	}
385	}



































































386
387	/*
388	** Sets the "argv0", "argc", and "argv" script variables in the Tcl interpreter
389	** based on the supplied command line arguments.
390	*/
	@@ -451,70 +581,31 @@
451	){
452	struct TclContext tclContext = (struct TclContext )pContext;
453	int argc;
454	char **argv;
455	char *argv0 = 0;
456	#ifdef USE_TCL_STUBS
457	#ifdef _WIN32
458	WCHAR lib[] = L"tcl87.dll";
459	#define minver lib[4]
460	#define dlopen(a,b) (void *)LoadLibraryW(a);
461	#define dlsym(a,b) GetProcAddress((HANDLE)(a),b);
462	#else
463	#ifdef __CYGWIN__
464	char lib[] = "libtcl8.7.dll";
465	#else
466	char lib[] = "libtcl8.7.so";
467	#endif
468	#define minver lib[8]
469	#endif
470	void *handle = NULL;
471	void (findExecutable)(const char ) = 0;
472	Tcl_Interp (createInterp)() = 0;
473	#endif /* USE_TCL_STUBS */
474	Tcl_Interp *tclInterp;
475
476	if ( !tclContext ){
477	Th_ErrorMessage(interp,
478	"Invalid Tcl context", (const char *)"", 0);
479	return TH_ERROR;
480	}
481	if ( tclContext->interp ){
482	return TH_OK;




483	}
484	argc = tclContext->argc;
485	argv = tclContext->argv;
486	if( argc>0 && argv ){
487	argv0 = argv[0];
488	}
489	#ifdef USE_TCL_STUBS
490	while( --minver>'3' ){
491	handle = dlopen(lib, RTLD_NOW \| RTLD_LOCAL);
492	if( handle ) {
493	const char *sym = "_Tcl_FindExecutable";
494	findExecutable = (void ()(const char )) dlsym(handle, sym+1);
495	if (!findExecutable)
496	findExecutable = (void ()(const char )) dlsym(handle, sym);
497	sym = "_Tcl_CreateInterp";
498	createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym+1);
499	if (!createInterp)
500	createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym);
501	break;
502	}
503	}
504	if( !handle ){
505	Th_ErrorMessage(interp,
506	"Could not create Tcl interpreter", (const char *)"", 0);
507	return TH_ERROR;
508	}
509	# undef Tcl_FindExecutable
510	# define Tcl_FindExecutable findExecutable
511	# undef Tcl_CreateInterp
512	# define Tcl_CreateInterp createInterp
513	#endif /* USE_TCL_STUBS */
514	Tcl_FindExecutable(argv0);
515	tclInterp = Tcl_CreateInterp();
516	if( !tclInterp \|\| !Tcl_InitStubs(tclInterp, "8.4", 0)
517	\|\| Tcl_InterpDeleted(tclInterp) ){
518	Th_ErrorMessage(interp,
519	"Could not create Tcl interpreter", (const char *)"", 0);
520	return TH_ERROR;
521

	--- src/th_tcl.c
	+++ src/th_tcl.c
	@@ -32,17 +32,11 @@
32	((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 6))
33	/*
34	** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
35	** Tcl_EvalObjv instead of invoking the objProc directly.
36	*/
37	# define USE_TCL_EVALOBJV 1






38	#endif
39
40	/*
41	** These macros are designed to reduce the redundant code required to marshal
42	** arguments from TH1 to Tcl.
	@@ -71,10 +65,76 @@
65	** context.
66	*/
67	#define GET_CTX_TCL_INTERP(ctx) \
68	((struct TclContext *)(ctx))->interp
69
70	/*
71	** Define the Tcl shared library name, some exported function names, and some
72	** cross-platform macros for use with the Tcl stubs mechanism, when enabled.
73	*/
74	#if defined(USE_TCL_STUBS)
75	# if defined(_WIN32)
76	# define WIN32_LEAN_AND_MEAN
77	# include <windows.h>
78	# ifndef TCL_LIBRARY_NAME
79	# define TCL_LIBRARY_NAME "tcl86.dll\0"
80	# endif
81	# ifndef TCL_MINOR_OFFSET
82	# define TCL_MINOR_OFFSET (4)
83	# endif
84	# ifndef dlopen
85	# define dlopen(a,b) (void *)LoadLibrary((a));
86	# endif
87	# ifndef dlsym
88	# define dlsym(a,b) GetProcAddress((HANDLE)(a),(b));
89	# endif
90	# ifndef dlclose
91	# define dlclose(a) FreeLibrary((HANDLE)(a));
92	# endif
93	# else
94	# include <dlfcn.h>
95	# if defined(__CYGWIN__)
96	# ifndef TCL_LIBRARY_NAME
97	# define TCL_LIBRARY_NAME "libtcl8.6.dll\0"
98	# endif
99	# ifndef TCL_MINOR_OFFSET
100	# define TCL_MINOR_OFFSET (8)
101	# endif
102	# elif defined(__APPLE__)
103	# ifndef TCL_LIBRARY_NAME
104	# define TCL_LIBRARY_NAME "libtcl8.6.dylib\0"
105	# endif
106	# ifndef TCL_MINOR_OFFSET
107	# define TCL_MINOR_OFFSET (8)
108	# endif
109	# else
110	# ifndef TCL_LIBRARY_NAME
111	# define TCL_LIBRARY_NAME "libtcl8.6.so\0"
112	# endif
113	# ifndef TCL_MINOR_OFFSET
114	# define TCL_MINOR_OFFSET (8)
115	# endif
116	# endif /* defined(__CYGWIN__) */
117	# endif /* defined(_WIN32) */
118	# ifndef TCL_FINDEXECUTABLE_NAME
119	# define TCL_FINDEXECUTABLE_NAME "_Tcl_FindExecutable"
120	# endif
121	# ifndef TCL_CREATEINTERP_NAME
122	# define TCL_CREATEINTERP_NAME "_Tcl_CreateInterp"
123	# endif
124	#endif /* defined(USE_TCL_STUBS) */
125
126	/*
127	** The function pointer types for Tcl_FindExecutable and Tcl_CreateInterp are
128	** needed when the Tcl library is being loaded dynamically by a stubs-enabled
129	** application (i.e. the inverse of using a stubs-enabled package). These are
130	** the only Tcl API functions that MUST be called prior to being able to call
131	** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).
132	*/
133	typedef void (tcl_FindExecutableProc) (CONST char * argv0);
134	typedef Tcl_Interp *(tcl_CreateInterpProc) (void);
135
136	/*
137	** Creates and initializes a Tcl interpreter for use with the specified TH1
138	** interpreter. Stores the created Tcl interpreter in the Tcl context supplied
139	** by the caller. This must be declared here because quite a few functions in
140	** this file need to use it before it can be defined.
	@@ -108,10 +168,13 @@
168	** copied from and should be kept in sync with the one in "main.c".
169	*/
170	struct TclContext {
171	int argc;
172	char **argv;
173	void *library;
174	tcl_FindExecutableProc *xFindExecutable;
175	tcl_CreateInterpProc *xCreateInterp;
176	Tcl_Interp *interp;
177	};
178
179	/*
180	** Syntax:
	@@ -381,10 +444,77 @@
444	/* Remove the Tcl integration commands. */
445	for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
446	Th_RenameCommand(th1Interp, aCommand[i].zName, -1, NULL, 0);
447	}
448	}
449
450	/*
451	** When Tcl stubs support is enabled, attempts to dynamically load the Tcl
452	** shared library and fetch the function pointers necessary to create an
453	** interpreter and initialize the stubs mechanism; otherwise, simply setup
454	** the function pointers provided by the caller with the statically linked
455	** functions.
456	*/
457	static int loadTcl(
458	Th_Interp *interp,
459	void **pLibrary,
460	tcl_FindExecutableProc **pxFindExecutable,
461	tcl_CreateInterpProc **pxCreateInterp
462	){
463	#if defined(USE_TCL_STUBS)
464	char fileName[] = TCL_LIBRARY_NAME;
465	#endif
466	if( !pLibrary \|\| !pxFindExecutable \|\| !pxCreateInterp ){
467	Th_ErrorMessage(interp,
468	"Invalid Tcl loader argument(s)", (const char *)"", 0);
469	return TH_ERROR;
470	}
471	#if defined(USE_TCL_STUBS)
472	do {
473	void *library = dlopen(fileName, RTLD_NOW \| RTLD_GLOBAL);
474	if( library ){
475	tcl_FindExecutableProc *xFindExecutable;
476	tcl_CreateInterpProc *xCreateInterp;
477	const char *procName = TCL_FINDEXECUTABLE_NAME;
478	xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName + 1);
479	if( !xFindExecutable ){
480	xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName);
481	}
482	if( !xFindExecutable ){
483	Th_ErrorMessage(interp,
484	"Could not locate Tcl_FindExecutable", (const char *)"", 0);
485	dlclose(library);
486	return TH_ERROR;
487	}
488	procName = TCL_CREATEINTERP_NAME;
489	xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName + 1);
490	if( !xCreateInterp ){
491	xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName);
492	}
493	if( !xCreateInterp ){
494	Th_ErrorMessage(interp,
495	"Could not locate Tcl_CreateInterp", (const char *)"", 0);
496	dlclose(library);
497	return TH_ERROR;
498	}
499	*pLibrary = library;
500	*pxFindExecutable = xFindExecutable;
501	*pxCreateInterp = xCreateInterp;
502	return TH_OK;
503	}
504	} while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
505	Th_ErrorMessage(interp,
506	"Could not load Tcl shared library \"" TCL_LIBRARY_NAME "\"",
507	(const char *)"", 0);
508	return TH_ERROR;
509	#else
510	*pLibrary = 0;
511	*pxFindExecutable = Tcl_FindExecutable;
512	*pxCreateInterp = Tcl_CreateInterp;
513	return TH_OK;
514	#endif
515	}
516
517	/*
518	** Sets the "argv0", "argc", and "argv" script variables in the Tcl interpreter
519	** based on the supplied command line arguments.
520	*/
	@@ -451,70 +581,31 @@
581	){
582	struct TclContext tclContext = (struct TclContext )pContext;
583	int argc;
584	char **argv;
585	char *argv0 = 0;


















586	Tcl_Interp *tclInterp;
587
588	if ( !tclContext ){
589	Th_ErrorMessage(interp,
590	"Invalid Tcl context", (const char *)"", 0);
591	return TH_ERROR;
592	}
593	if ( tclContext->interp ){
594	return TH_OK;
595	}
596	if( loadTcl(interp, &tclContext->library, &tclContext->xFindExecutable,
597	&tclContext->xCreateInterp)!=TH_OK ){
598	return TH_ERROR;
599	}
600	argc = tclContext->argc;
601	argv = tclContext->argv;
602	if( argc>0 && argv ){
603	argv0 = argv[0];
604	}
605	tclContext->xFindExecutable(argv0);
606	tclInterp = tclContext->xCreateInterp();

























607	if( !tclInterp \|\| !Tcl_InitStubs(tclInterp, "8.4", 0)
608	\|\| Tcl_InterpDeleted(tclInterp) ){
609	Th_ErrorMessage(interp,
610	"Could not create Tcl interpreter", (const char *)"", 0);
611	return TH_ERROR;
612

M win/Makefile.mingw

+17 -1

		--- win/Makefile.mingw
		+++ win/Makefile.mingw
		@@ -47,10 +47,14 @@
47	47	# FOSSIL_ENABLE_SSL = 1
48	48
49	49	#### Enable scripting support via Tcl/Tk
50	50	#
51	51	# FOSSIL_ENABLE_TCL = 1
	52	+
	53	+#### Load Tcl using the stubs mechanism
	54	+#
	55	+# FOSSIL_ENABLE_TCL_STUBS = 1
52	56
53	57	#### Use the Tcl source directory instead of the install directory?
54	58	# This is useful when Tcl has been compiled statically with MinGW.
55	59	#
56	60	FOSSIL_TCL_SOURCE = 1
		@@ -96,11 +100,15 @@
96	100	TCLINCDIR = $(TCLDIR)/include
97	101	TCLLIBDIR = $(TCLDIR)/lib
98	102
99	103	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
100	104	#
	105	+ifdef FOSSIL_ENABLE_TCL_STUBS
101	106	LIBTCL = -ltclstub86
	107	+else
	108	+LIBTCL = -ltcl86
	109	+endif
102	110
103	111	#### C Compile and options for use in building executables that
104	112	# will run on the target platform. This is usually the same
105	113	# as BCC, unless you are cross-compiling. This C compiler builds
106	114	# the finished binary for fossil. The BCC compiler above is used
		@@ -136,12 +144,20 @@
136	144	RCC += -DFOSSIL_ENABLE_SSL=1
137	145	endif
138	146
139	147	# With Tcl support
140	148	ifdef FOSSIL_ENABLE_TCL
141		-TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
	149	+TCC += -DFOSSIL_ENABLE_TCL=1
142	150	RCC += -DFOSSIL_ENABLE_TCL=1
	151	+# Either statically linked or via stubs
	152	+ifdef FOSSIL_ENABLE_TCL_STUBS
	153	+TCC += -DUSE_TCL_STUBS
	154	+RCC += -DUSE_TCL_STUBS
	155	+else
	156	+TCC += -DSTATIC_BUILD
	157	+RCC += -DSTATIC_BUILD
	158	+endif
143	159	endif
144	160
145	161	# With JSON support
146	162	ifdef FOSSIL_ENABLE_JSON
147	163	TCC += -DFOSSIL_ENABLE_JSON=1
148	164

	--- win/Makefile.mingw
	+++ win/Makefile.mingw
	@@ -47,10 +47,14 @@
47	# FOSSIL_ENABLE_SSL = 1
48
49	#### Enable scripting support via Tcl/Tk
50	#
51	# FOSSIL_ENABLE_TCL = 1




52
53	#### Use the Tcl source directory instead of the install directory?
54	# This is useful when Tcl has been compiled statically with MinGW.
55	#
56	FOSSIL_TCL_SOURCE = 1
	@@ -96,11 +100,15 @@
96	TCLINCDIR = $(TCLDIR)/include
97	TCLLIBDIR = $(TCLDIR)/lib
98
99	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
100	#

101	LIBTCL = -ltclstub86



102
103	#### C Compile and options for use in building executables that
104	# will run on the target platform. This is usually the same
105	# as BCC, unless you are cross-compiling. This C compiler builds
106	# the finished binary for fossil. The BCC compiler above is used
	@@ -136,12 +144,20 @@
136	RCC += -DFOSSIL_ENABLE_SSL=1
137	endif
138
139	# With Tcl support
140	ifdef FOSSIL_ENABLE_TCL
141	TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
142	RCC += -DFOSSIL_ENABLE_TCL=1








143	endif
144
145	# With JSON support
146	ifdef FOSSIL_ENABLE_JSON
147	TCC += -DFOSSIL_ENABLE_JSON=1
148

	--- win/Makefile.mingw
	+++ win/Makefile.mingw
	@@ -47,10 +47,14 @@
47	# FOSSIL_ENABLE_SSL = 1
48
49	#### Enable scripting support via Tcl/Tk
50	#
51	# FOSSIL_ENABLE_TCL = 1
52
53	#### Load Tcl using the stubs mechanism
54	#
55	# FOSSIL_ENABLE_TCL_STUBS = 1
56
57	#### Use the Tcl source directory instead of the install directory?
58	# This is useful when Tcl has been compiled statically with MinGW.
59	#
60	FOSSIL_TCL_SOURCE = 1
	@@ -96,11 +100,15 @@
100	TCLINCDIR = $(TCLDIR)/include
101	TCLLIBDIR = $(TCLDIR)/lib
102
103	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
104	#
105	ifdef FOSSIL_ENABLE_TCL_STUBS
106	LIBTCL = -ltclstub86
107	else
108	LIBTCL = -ltcl86
109	endif
110
111	#### C Compile and options for use in building executables that
112	# will run on the target platform. This is usually the same
113	# as BCC, unless you are cross-compiling. This C compiler builds
114	# the finished binary for fossil. The BCC compiler above is used
	@@ -136,12 +144,20 @@
144	RCC += -DFOSSIL_ENABLE_SSL=1
145	endif
146
147	# With Tcl support
148	ifdef FOSSIL_ENABLE_TCL
149	TCC += -DFOSSIL_ENABLE_TCL=1
150	RCC += -DFOSSIL_ENABLE_TCL=1
151	# Either statically linked or via stubs
152	ifdef FOSSIL_ENABLE_TCL_STUBS
153	TCC += -DUSE_TCL_STUBS
154	RCC += -DUSE_TCL_STUBS
155	else
156	TCC += -DSTATIC_BUILD
157	RCC += -DSTATIC_BUILD
158	endif
159	endif
160
161	# With JSON support
162	ifdef FOSSIL_ENABLE_JSON
163	TCC += -DFOSSIL_ENABLE_JSON=1
164

M win/Makefile.mingw.mistachkin

+17 -1

		--- win/Makefile.mingw.mistachkin
		+++ win/Makefile.mingw.mistachkin
		@@ -47,10 +47,14 @@
47	47	FOSSIL_ENABLE_SSL = 1
48	48
49	49	#### Enable scripting support via Tcl/Tk
50	50	#
51	51	# FOSSIL_ENABLE_TCL = 1
	52	+
	53	+#### Load Tcl using the stubs mechanism
	54	+#
	55	+# FOSSIL_ENABLE_TCL_STUBS = 1
52	56
53	57	#### Use the Tcl source directory instead of the install directory?
54	58	# This is useful when Tcl has been compiled statically with MinGW.
55	59	#
56	60	FOSSIL_TCL_SOURCE = 1
		@@ -96,11 +100,15 @@
96	100	TCLINCDIR = $(TCLDIR)/include
97	101	TCLLIBDIR = $(TCLDIR)/lib
98	102
99	103	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
100	104	#
	105	+ifdef FOSSIL_ENABLE_TCL_STUBS
101	106	LIBTCL = -ltclstub86
	107	+else
	108	+LIBTCL = -ltcl86
	109	+endif
102	110
103	111	#### C Compile and options for use in building executables that
104	112	# will run on the target platform. This is usually the same
105	113	# as BCC, unless you are cross-compiling. This C compiler builds
106	114	# the finished binary for fossil. The BCC compiler above is used
		@@ -136,12 +144,20 @@
136	144	RCC += -DFOSSIL_ENABLE_SSL=1
137	145	endif
138	146
139	147	# With Tcl support
140	148	ifdef FOSSIL_ENABLE_TCL
141		-TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
	149	+TCC += -DFOSSIL_ENABLE_TCL=1
142	150	RCC += -DFOSSIL_ENABLE_TCL=1
	151	+# Either statically linked or via stubs
	152	+ifdef FOSSIL_ENABLE_TCL_STUBS
	153	+TCC += -DUSE_TCL_STUBS
	154	+RCC += -DUSE_TCL_STUBS
	155	+else
	156	+TCC += -DSTATIC_BUILD
	157	+RCC += -DSTATIC_BUILD
	158	+endif
143	159	endif
144	160
145	161	# With JSON support
146	162	ifdef FOSSIL_ENABLE_JSON
147	163	TCC += -DFOSSIL_ENABLE_JSON=1
148	164

	--- win/Makefile.mingw.mistachkin
	+++ win/Makefile.mingw.mistachkin
	@@ -47,10 +47,14 @@
47	FOSSIL_ENABLE_SSL = 1
48
49	#### Enable scripting support via Tcl/Tk
50	#
51	# FOSSIL_ENABLE_TCL = 1




52
53	#### Use the Tcl source directory instead of the install directory?
54	# This is useful when Tcl has been compiled statically with MinGW.
55	#
56	FOSSIL_TCL_SOURCE = 1
	@@ -96,11 +100,15 @@
96	TCLINCDIR = $(TCLDIR)/include
97	TCLLIBDIR = $(TCLDIR)/lib
98
99	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
100	#

101	LIBTCL = -ltclstub86



102
103	#### C Compile and options for use in building executables that
104	# will run on the target platform. This is usually the same
105	# as BCC, unless you are cross-compiling. This C compiler builds
106	# the finished binary for fossil. The BCC compiler above is used
	@@ -136,12 +144,20 @@
136	RCC += -DFOSSIL_ENABLE_SSL=1
137	endif
138
139	# With Tcl support
140	ifdef FOSSIL_ENABLE_TCL
141	TCC += -DFOSSIL_ENABLE_TCL=1 -DUSE_TCL_STUBS
142	RCC += -DFOSSIL_ENABLE_TCL=1








143	endif
144
145	# With JSON support
146	ifdef FOSSIL_ENABLE_JSON
147	TCC += -DFOSSIL_ENABLE_JSON=1
148

	--- win/Makefile.mingw.mistachkin
	+++ win/Makefile.mingw.mistachkin
	@@ -47,10 +47,14 @@
47	FOSSIL_ENABLE_SSL = 1
48
49	#### Enable scripting support via Tcl/Tk
50	#
51	# FOSSIL_ENABLE_TCL = 1
52
53	#### Load Tcl using the stubs mechanism
54	#
55	# FOSSIL_ENABLE_TCL_STUBS = 1
56
57	#### Use the Tcl source directory instead of the install directory?
58	# This is useful when Tcl has been compiled statically with MinGW.
59	#
60	FOSSIL_TCL_SOURCE = 1
	@@ -96,11 +100,15 @@
100	TCLINCDIR = $(TCLDIR)/include
101	TCLLIBDIR = $(TCLDIR)/lib
102
103	#### Tcl: Which Tcl library do we want to use (8.4, 8.5, 8.6, etc)?
104	#
105	ifdef FOSSIL_ENABLE_TCL_STUBS
106	LIBTCL = -ltclstub86
107	else
108	LIBTCL = -ltcl86
109	endif
110
111	#### C Compile and options for use in building executables that
112	# will run on the target platform. This is usually the same
113	# as BCC, unless you are cross-compiling. This C compiler builds
114	# the finished binary for fossil. The BCC compiler above is used
	@@ -136,12 +144,20 @@
144	RCC += -DFOSSIL_ENABLE_SSL=1
145	endif
146
147	# With Tcl support
148	ifdef FOSSIL_ENABLE_TCL
149	TCC += -DFOSSIL_ENABLE_TCL=1
150	RCC += -DFOSSIL_ENABLE_TCL=1
151	# Either statically linked or via stubs
152	ifdef FOSSIL_ENABLE_TCL_STUBS
153	TCC += -DUSE_TCL_STUBS
154	RCC += -DUSE_TCL_STUBS
155	else
156	TCC += -DSTATIC_BUILD
157	RCC += -DSTATIC_BUILD
158	endif
159	endif
160
161	# With JSON support
162	ifdef FOSSIL_ENABLE_JSON
163	TCC += -DFOSSIL_ENABLE_JSON=1
164

M win/fossil.rc

		--- win/fossil.rc
		+++ win/fossil.rc
		@@ -90,10 +90,15 @@
90	90	#ifdef FOSSIL_ENABLE_SSL
91	91	VALUE "SslEnabled", "Yes, " OPENSSL_VERSION_TEXT "\0"
92	92	#endif
93	93	#ifdef FOSSIL_ENABLE_TCL
94	94	VALUE "TclEnabled", "Yes, Tcl " TCL_PATCH_LEVEL "\0"
	95	+#ifdef FOSSIL_ENABLE_TCL_STUBS
	96	+ VALUE "TclStubsEnabled", "Yes\0"
	97	+#else
	98	+ VALUE "TclStubsEnabled", "No\0"
	99	+#endif
95	100	#endif
96	101	#ifdef FOSSIL_ENABLE_JSON
97	102	VALUE "JsonEnabled", "Yes, cson\0"
98	103	#endif
99	104	END
100	105

	--- win/fossil.rc
	+++ win/fossil.rc
	@@ -90,10 +90,15 @@
90	#ifdef FOSSIL_ENABLE_SSL
91	VALUE "SslEnabled", "Yes, " OPENSSL_VERSION_TEXT "\0"
92	#endif
93	#ifdef FOSSIL_ENABLE_TCL
94	VALUE "TclEnabled", "Yes, Tcl " TCL_PATCH_LEVEL "\0"





95	#endif
96	#ifdef FOSSIL_ENABLE_JSON
97	VALUE "JsonEnabled", "Yes, cson\0"
98	#endif
99	END
100

	--- win/fossil.rc
	+++ win/fossil.rc
	@@ -90,10 +90,15 @@
90	#ifdef FOSSIL_ENABLE_SSL
91	VALUE "SslEnabled", "Yes, " OPENSSL_VERSION_TEXT "\0"
92	#endif
93	#ifdef FOSSIL_ENABLE_TCL
94	VALUE "TclEnabled", "Yes, Tcl " TCL_PATCH_LEVEL "\0"
95	#ifdef FOSSIL_ENABLE_TCL_STUBS
96	VALUE "TclStubsEnabled", "Yes\0"
97	#else
98	VALUE "TclStubsEnabled", "No\0"
99	#endif
100	#endif
101	#ifdef FOSSIL_ENABLE_JSON
102	VALUE "JsonEnabled", "Yes, cson\0"
103	#endif
104	END
105

Fossil SCM

Keyboard Shortcuts