Tcl Source Code

Check-in [f2fa121e89]
Login

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

Overview
Comment:Merge trunk Rename TclInitStubs back to Tcl_InitStubs, for easier compatibility with Tcl 8.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: f2fa121e898b796c691b644a86682f574b8fae6a
User & Date: jan.nijtmans 2013-01-25 09:12:32
Context
2013-01-25
12:58
merge trunk Add -Wwrite-strings to compiler options, so we can guarantee correct "const" usage. check-in: b23d78bcae user: jan.nijtmans tags: novem
10:04
merge novem. Some more fixes. Closed-Leaf check-in: 0d1a1f9a92 user: jan.nijtmans tags: novem-unversioned-stub
09:12
Merge trunk Rename TclInitStubs back to Tcl_InitStubs, for easier compatibility with Tcl 8. check-in: f2fa121e89 user: jan.nijtmans tags: novem
2013-01-24
22:02
new version of cpuid, which doesn't use the edi register any more. Hopefully that works better on so... check-in: 08080f56f1 user: jan.nijtmans tags: trunk
10:37
Convert Tcl_GetIndexFromObj implementation to macro check-in: 039696e2d8 user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.h.

2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211

2212
2213
2214

2215
2216
2217
2218
2219
2220
2221
2222
/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */

const char *		TclInitStubs(Tcl_Interp *interp, const char *version,
			    int exact, const char *tclversion, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);

/*
 * When not using stubs, make it a macro.
 */

#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \

	    TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \

	    TclInitStubs(interp, TCL_PATCH_LEVEL, 1, TCL_VERSION, TCL_STUB_MAGIC)
#endif
#else
#define Tcl_InitStubs(interp, version, exact) \
    Tcl_PkgInitStubsCheck(interp, version, exact)
#endif

/*







|




<
<
<
<



>
|


>
|







2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204




2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, const char *tclversion, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);





#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)((interp), (version), (exact)|(int)sizeof(size_t), \
	TCL_VERSION, TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, 1|(int)sizeof(size_t), \
	TCL_VERSION, TCL_STUB_MAGIC)
#endif
#else
#define Tcl_InitStubs(interp, version, exact) \
    Tcl_PkgInitStubsCheck(interp, version, exact)
#endif

/*

Changes to generic/tclCkalloc.c.

152
153
154
155
156
157
158




159
160
161
162
163
164
165

void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();




    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclDumpMemoryInfo --







>
>
>
>







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
#ifndef TCL_THREADS
	/* Silence compiler warning */
	(void)ckallocMutexPtr;
#endif
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclDumpMemoryInfo --

Changes to generic/tclExecute.c.

6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962
6963
6964
6965
6966

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
	    goto instEvalStk;
	    NEXT_INST_F(9, 0, 0);
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr
#undef initCatchTop







<







6952
6953
6954
6955
6956
6957
6958

6959
6960
6961
6962
6963
6964
6965

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
	    goto instEvalStk;

	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr
#undef initCatchTop

Changes to generic/tclStubLib.c.

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

#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)

/*
 *----------------------------------------------------------------------
 *
 * TclInitStubs --
 *
 *	Tries to initialise the stub table pointers and ensures that the
 *	correct version of Tcl is loaded.
 *
 * Results:
 *	The actual version of Tcl that satisfies the request, or NULL to
 *	indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */
#undef Tcl_InitStubs
MODULE_SCOPE const char *
TclInitStubs(
    Tcl_Interp *interp,
    const char *version,
    int exact,
    const char *tclversion,
    int magic)
{
    Interp *iPtr = (Interp *) interp;







|















|







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

#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitStubs --
 *
 *	Tries to initialise the stub table pointers and ensures that the
 *	correct version of Tcl is loaded.
 *
 * Results:
 *	The actual version of Tcl that satisfies the request, or NULL to
 *	indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */
#undef Tcl_InitStubs
MODULE_SCOPE const char *
Tcl_InitStubs(
    Tcl_Interp *interp,
    const char *version,
    int exact,
    const char *tclversion,
    int magic)
{
    Interp *iPtr = (Interp *) interp;
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
	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) {







|







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
    if (exact&1) {
	const char *p = version;
	int count = 0;

	while (*p) {
	    count += !ISDIGIT(*p++);
	}
	if (count == 1) {
98
99
100
101
102
103
104



105




106
107
108
109
110
111
112
	} 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;







>
>
>
|
>
>
>
>







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {
		return NULL;
	    }
	}
    }

    if (stubsPtr->reserved77) {
	/* We are running Tcl 8. Do some additional checks here. */
	tclStubsPtr = (TclStubs *)pkgData;
    } else {
	/* We are running Tcl 9. Do some additional checks here. */
	tclStubsPtr = stubsPtr;
    }

    if (tclStubsPtr->hooks) {
	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
    } else {
	tclPlatStubsPtr = NULL;

Changes to unix/tclUnixCompat.c.

989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
    unsigned int index,		/* Which CPUID value to retrieve. */
    unsigned int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

    /* See: <http://en.wikipedia.org/wiki/CPUID> */
#if defined(HAVE_CPUID)
    __asm__ __volatile__("mov %%ebx, %%edi     \n\t" /* save %ebx */
                 "cpuid            \n\t"
                 "mov %%ebx, %%esi   \n\t" /* save what cpuid just put in %ebx */
                 "mov %%edi, %%ebx  \n\t" /* restore the old %ebx */
                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index) : "edi","ebx");
    status = TCL_OK;
#endif
    return status;
}

/*
 * Local Variables:







|

<
|

|







989
990
991
992
993
994
995
996
997

998
999
1000
1001
1002
1003
1004
1005
1006
1007
    unsigned int index,		/* Which CPUID value to retrieve. */
    unsigned int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

    /* See: <http://en.wikipedia.org/wiki/CPUID> */
#if defined(HAVE_CPUID)
    __asm__ __volatile__("mov %%ebx, %%esi     \n\t" /* save %ebx */
                 "cpuid            \n\t"

                 "xchg %%esi, %%ebx   \n\t" /* restore the old %ebx */
                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index));
    status = TCL_OK;
#endif
    return status;
}

/*
 * Local Variables: