Tcl Source Code

Check-in Differences
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Difference From 2fa10e0214 To b086c08897c35f04

2013-03-27
15:46
renumber flag values, improve doc. check-in: 8e182c8395 user: jan.nijtmans tags: initsubsystems2
10:49
merge-mark check-in: 8da6d71781 user: jan.nijtmans tags: trunk
07:51
Version with all TCL_INIT_CREATE_XXX flags back check-in: b086c08897 user: jan.nijtmans tags: initsubsystems2
2013-03-26
18:00
merge trunk so review patch/diff is smaller check-in: 0dd323deff user: dgp tags: initsubsystems
10:46
Don't initialize the encoding subsystem any more in Tcl_InitSubsystems(). check-in: 95b6e24fda user: jan.nijtmans tags: initsubsystems2
2013-03-22
23:08
Update to tzdata2013b check-in: 2fa10e0214 user: venkat tags: trunk
23:05
Update to tzdata2013b check-in: 15d1b83223 user: venkat tags: core-8-5-branch
13:22
If TCL_NO_DEPRECATED is defined, don't depend on Tcl_CreateMathFunc()/Tcl_SaveResult() in testcases ... check-in: 8c696d0203 user: jan.nijtmans tags: trunk

Changes to doc/InitStubs.3.

79
80
81
82
83
84
85




86
87
88
89
an exact version match or not.  If \fIexact\fR is 0, then the
extension is indicating that newer versions of Tcl are acceptable
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.




.SH "SEE ALSO"
Tk_InitStubs
.SH KEYWORDS
stubs







>
>
>
>




79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
an exact version match or not.  If \fIexact\fR is 0, then the
extension is indicating that newer versions of Tcl are acceptable
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.









































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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 <tcl.h>\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

Changes to generic/tcl.h.

2405
2406
2407
2408
2409
2410
2411










2412
2413
2414
2415
2416
2417
2418
    Tcl_PkgInitStubsCheck(interp, version, exact)
#endif

/*
 * TODO - tommath stubs export goes here!
 */











/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))







>
>
>
>
>
>
>
>
>
>







2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
    Tcl_PkgInitStubsCheck(interp, version, exact)
#endif

/*
 * 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]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))

Changes to generic/tclEncoding.c.

1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424

1425
1426
1427















1428
























































1429
1430
1431
1432
1433
1434
1435

    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FindExecutable --
 *
 *	This function computes the absolute path name of the current
 *	application, given its argv[0] value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The absolute pathname for the application is computed and stored to be
 *	returned later be [info nameofexecutable].

 *
 *---------------------------------------------------------------------------
 */















#undef Tcl_FindExecutable
























































void
Tcl_FindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    TclInitSubsystems();
    TclpSetInitialEncodings();







|

|
|






|
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_InitSubsystems/Tcl_FindExecutable --
 *
 *	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 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). */
{
    TclInitSubsystems();
    TclpSetInitialEncodings();

Changes to generic/tclStubLib.c.

69
70
71
72
73
74
75




76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113

    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
	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 (tclStubsPtr->hooks) {
	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
    } else {
	tclPlatStubsPtr = NULL;







>
>
>
>
|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
	iPtr->result = "interpreter uses an incompatible stubs mechanism";
	iPtr->freeProc = TCL_STATIC;
	return NULL;
    }

    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;
    } else {
	tclPlatStubsPtr = NULL;