Index: doc/InitStubs.3 ================================================================== --- doc/InitStubs.3 +++ doc/InitStubs.3 @@ -81,9 +81,13 @@ as long as they have the same major version number as \fIversion\fR; non-zero means that only the specified \fIversion\fR is acceptable. \fBTcl_InitStubs\fR returns a string containing the actual version of Tcl satisfying the request, or NULL if the Tcl version is not acceptable, does not support stubs, or any other error condition occurred. +.PP +If \fBTcl_InitStubs\fR is called with as first argument the +pseudo interpreter returned by \fBTcl_InitSubsystems(0)\fR, then +the \fIversion\fR and \fIexact\fR parameters have no effect. .SH "SEE ALSO" Tk_InitStubs .SH KEYWORDS stubs ADDED doc/InitSubSyst.3 Index: doc/InitSubSyst.3 ================================================================== --- /dev/null +++ doc/InitSubSyst.3 @@ -0,0 +1,116 @@ +'\" +'\" Copyright (c) 1995-1996 Sun Microsystems, Inc. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.so man.macros +.TH Tcl_InitSubsystems 3 8.6.1 Tcl "Tcl Library Procedures" +.BS +.SH NAME +Tcl_InitSubsystems \- initialize the Tcl library. +.SH SYNOPSIS +.nf +\fB#include \fR +.sp +Tcl_Interp * +\fBTcl_InitSubsystems\fR(\fIflags\fR, \fI...\fR) +.SH ARGUMENTS +.AS int flags +.AP int flags in +Any combination of flags which indicate whether a custom panicProc +is registered, a custom initialization function is executed and/or +a real interpreter is created. +The value 0 can be used if Tcl is used as utility library only. +.BE + +.SH DESCRIPTION +.PP +The \fBTcl_InitSubsystems\fR procedure initializes the Tcl +library. This procedure is typically invoked as the very +first thing in the application's main program. +Its \fBflags\fR argument controls exactly what is initialized, +and what additional arguments are expected. +.PP +The call \fBTcl_InitSubsystems(0)\fR does the same as +\fBTcl_FindExecutable(NULL)\fR, except that a Tcl_Interp * +is returned which can be used only by \fBTcl_InitStubs\fR +to initialize the stub table. This opens up the Tcl Stub +technology for Tcl embedders, which now can dynamically +load the Tcl shared library and use functions in it +without ever creating an interpreter. E.g. the +following code can be compiled with -DUSE_TCL_STUBS: +.CS +Tcl_Interp *interp, *(*initSubSystems)(int, ...); +const char *version; +void *handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL); +initSubSystems = dlsym(handle, "Tcl_InitSubsystems"); +version = Tcl_InitStubs(initSubSystems(0), NULL, 0); +/* At this point, Tcl C API calls without interp are ready for use */ +interp = Tcl_CreateInterp(); /* Now we have a real interpreter */ +Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */ +.CE +This is equivalent to (without dynamical loading) +.CS +Tcl_Interp *interp; +const char *version; +version = Tcl_InitStubs(Tcl_InitSubSystems(0), NULL, 0); +/* At this point, Tcl C API calls without interp are ready for use */ +interp = Tcl_CreateInterp(); /* Now we have a real interpreter */ +Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */ +.CE +The function \fBTcl_CreateInterp\fR, or any other Tcl function you +would like to call, no longer needs to be searched for in the +shared library. It can be called directly through the stub table. +Note that the stub table needs to be initialized twice, in order +to be sure that you can call all functions without limitations +after the real interpreter is created. +.PP +If you supply the flag \fBTCL_INIT_PANIC\fR to \fBTcl_InitSubsystems\fR, +the function expects an additional argument, a custom panicProc. +This is equivalent to calling \fBTcl_SetPanicProc\fR immediately +before \fBTcl_InitSubsystems\fR, except that you possibly cannot do +that yet if it requires an initialized stub table. Of course you +could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR, +but then panics which could be produced by the initialization +itself still use the default panic procedure. +.PP +If you supply the flag \fBTCL_INIT_CUSTOM\fR to \fBTcl_InitSubsystems\fR, +the function expects two additional arguments: ClientData and a +custom proc. The proc will be supplied two arguments, the (pseudo +or real) Tcl interpreter and ClientData. The given function will +be executed just before the encodings are initialized. +.PP +If you supply one of the flags \fBTCL_INIT_CREATE\fR, \fBTCL_INIT_CREATE_UTF8\fR or +\fBTCL_INIT_CREATE_UNICODE\fR to \fBTcl_InitSubsystems\fR, the function +gets two additional parameters, argc and argv. Then a real +Tcl interpreter will be created. If argc > 0 then the variables +\fBargc\fR and \fBargv\fR will be set in this interpreter. The 3 +variants assume a different encoding for the arguments, except for +\fIargv[0]\fR which is always assumed to be in the system encoding. +So, the above example code could be simplified to: +.CS +Tcl_Interp *interp = Tcl_InitSubSystems(TCL_INIT_CREATE, 0, NULL); +Tcl_InitStubs(interp, TCL_VERSION, 0); /* initialize the stub table */ +.CE +.PP +If the \fBTCL_INIT_PANIC\fR and one of the \fBTCL_INIT_CREATE\fR +flags are used in combination, the \fBpanicProc\fR argument comes +before the argc/argv arguments. +.PP +The reason for \fBargv[0]\fR always using the system encoding is that this way, +argv[0] can be derived directly from the main() (or mainw, on Windows) +arguments without any processing. \fBTCL_INIT_CREATE_UNICODE\fR is really only +useful on Windows. But on Windows, the argv[0] parameter is not used for +determining the value of [info executable] anyway. Modern UNIX system already +have UTF-8 as system encoding, so \fBTCL_INIT_CREATE_UTF8\fR would have the same +effect as \fBTCL_INIT_CREATE\fR, only slightly faster. Other parameters can be +preprocessed at will by the application, and if the application uses unicode +or UTF-8 internally there is no need to convert it back to the system encoding. +.PP +The interpreter returned by Tcl_InitSubsystems(0) or passed to the +TCL_INIT_CUSTOM function cannot be passed to any other function than +Tcl_InitStubs(). Tcl functions with an "interp" argument can only +be called if the function supports passing NULL. +.SH KEYWORDS +binary, executable file Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -2407,10 +2407,20 @@ /* * TODO - tommath stubs export goes here! */ +/* Tcl_InitSubsystems, see TIP #414 */ + +#define TCL_INIT_PANIC (1) /* Set Panic proc */ +#define TCL_INIT_CUSTOM (2) /* Do custom initialization. */ +#define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */ +#define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */ +#define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */ + +EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...); + /* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ Index: generic/tclEncoding.c ================================================================== --- generic/tclEncoding.c +++ generic/tclEncoding.c @@ -1409,25 +1409,97 @@ } /* *--------------------------------------------------------------------------- * - * Tcl_FindExecutable -- + * Tcl_InitSubsystems/Tcl_FindExecutable -- * - * This function computes the absolute path name of the current - * application, given its argv[0] value. + * This function initializes everything needed for the Tcl library + * to be able to operate. * * Results: * None. * * Side effects: * The absolute pathname for the application is computed and stored to be - * returned later be [info nameofexecutable]. + * returned later by [info nameofexecutable]. The system encoding is + * determined and stored to be returned later by [encoding system] * *--------------------------------------------------------------------------- */ +MODULE_SCOPE const TclStubs tclStubs; + +/* Dummy const structure returned by Tcl_InitSubsystems, + * which looks like an Tcl_Interp, but in reality is not. + * It contains just enough for Tcl_InitStubs to be able + * to initialize the stub table. */ +static const struct { + /* A real interpreter has interp->result/freeProc here: */ + const char version[sizeof(struct {char *r; void (*f)(void);})]; + int errorLine; + const struct TclStubs *stubTable; +} dummyInterp = { + TCL_PATCH_LEVEL, TCL_STUB_MAGIC, &tclStubs +}; + #undef Tcl_FindExecutable +Tcl_Interp * +Tcl_InitSubsystems(int flags, ...) +{ + va_list argList; + int argc = 0; + void **argv = NULL; + Tcl_Interp *interp = (Tcl_Interp *) &dummyInterp; + + va_start(argList, flags); + if (flags & TCL_INIT_PANIC) { + Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *)); + } + TclInitSubsystems(); + if (flags & TCL_INIT_CREATE) { + argc = va_arg(argList, int); + argv = va_arg(argList, void **); + interp = Tcl_CreateInterp(); + } + if (flags & TCL_INIT_CUSTOM) { + ClientData clientData = va_arg(argList, ClientData); + void (*fn)(Tcl_Interp *, ClientData) = va_arg(argList, + void (*)(Tcl_Interp *, ClientData)); + fn(interp, clientData); + } + va_end(argList); + + TclpSetInitialEncodings(); + TclpFindExecutable(argv ? argv[0] : NULL); + if ((flags&TCL_INIT_CREATE) && (--argc >= 0)) { + Tcl_Obj *argvPtr; + + Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); + argvPtr = Tcl_NewListObj(argc, NULL); + if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UTF8) { + while (argc--) { + Tcl_ListObjAppendElement(NULL, argvPtr, + Tcl_NewStringObj(*++argv, -1)); + } + } else if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UNICODE) { + while (argc--) { + Tcl_ListObjAppendElement(NULL, argvPtr, + Tcl_NewUnicodeObj(*++argv, -1)); + } + } else { + Tcl_DString ds; + + while (argc--) { + Tcl_ExternalToUtfDString(NULL, *++argv, -1, &ds); + Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds)); + } + } + Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); + } + return interp; +} + void Tcl_FindExecutable( const char *argv0) /* The value of the application's argv[0] * (native). */ { Index: generic/tclStubLib.c ================================================================== --- generic/tclStubLib.c +++ generic/tclStubLib.c @@ -71,41 +71,46 @@ iPtr->result = "interpreter uses an incompatible stubs mechanism"; iPtr->freeProc = TCL_STATIC; return NULL; } - actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); - if (actualVersion == NULL) { - return NULL; - } - if (exact) { - const char *p = version; - int count = 0; - - while (*p) { - count += !isDigit(*p++); - } - if (count == 1) { - const char *q = actualVersion; - - p = version; - while (*p && (*p == *q)) { - p++; q++; - } - if (*p || isDigit(*q)) { - /* Construct error message */ - stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); - return NULL; - } - } else { - actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); - if (actualVersion == NULL) { - return NULL; - } - } - } - tclStubsPtr = (TclStubs *)pkgData; + if(iPtr->errorLine == TCL_STUB_MAGIC) { + actualVersion = (const char *)interp; + tclStubsPtr = stubsPtr; + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData); + if (actualVersion == NULL) { + return NULL; + } + if (exact) { + const char *p = version; + int count = 0; + + while (*p) { + count += !isDigit(*p++); + } + if (count == 1) { + const char *q = actualVersion; + + p = version; + while (*p && (*p == *q)) { + p++; q++; + } + if (*p || isDigit(*q)) { + /* Construct error message */ + stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + return NULL; + } + } else { + actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); + if (actualVersion == NULL) { + return NULL; + } + } + } + tclStubsPtr = (const TclStubs *)pkgData; + } if (tclStubsPtr->hooks) { tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;