summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclOO.c6
-rw-r--r--generic/tclOOStubInit.c14
-rw-r--r--generic/tclStubInit.c31
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclTomMathInterface.c6
-rw-r--r--tools/genStubs.tcl21
8 files changed, 62 insertions, 44 deletions
diff --git a/ChangeLog b/ChangeLog
index 0ad5239..78963fe 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2010-02-05 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * tools/genStubs.tcl: Follow-up to earlier commit today:
+ Eliminate the need for an extra Stubs Pointer
+ for adressing a static stub table: Just change
+ the exported table from static to MODULE_SCOPE.
+ * generic/tclBasic.c
+ * generic/tclOO.c
+ * generic/tclTomMathInterface.c
+ * generic/tcl*Decls.h (regenerated)
+ * generic/tclStubInit.c (regenerated)
+ * generic/tclOOStubInit.c (regenerated)
+ * generic/tclTest.c (minor formatting)
+
2010-02-05 Donal K. Fellows <dkf@users.sf.net>
* generic/tclVar.c: More consistency in errorcode generation.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 08414c8..c2a8363 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.440 2010/02/02 16:12:00 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.441 2010/02/05 20:53:12 nijtmans Exp $
*/
#include "tclInt.h"
@@ -167,7 +167,7 @@ static Tcl_NRPostProc TEOV_RestoreVarFrame;
static Tcl_NRPostProc TEOV_RunLeaveTraces;
static Tcl_NRPostProc YieldToCallback;
-MODULE_SCOPE const TclStubs *const tclConstStubsPtr;
+MODULE_SCOPE const TclStubs tclConstStubs;
/*
* The following structure define the commands in the Tcl core.
@@ -677,7 +677,7 @@ Tcl_CreateInterp(void)
* Initialise the stub table pointer.
*/
- iPtr->stubTable = tclConstStubsPtr;
+ iPtr->stubTable = &tclConstStubs;
/*
* Initialize the ensemble error message rewriting support.
@@ -906,7 +906,7 @@ Tcl_CreateInterp(void)
*/
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL,
- (ClientData) tclConstStubsPtr);
+ (ClientData) &tclConstStubs);
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
diff --git a/generic/tclOO.c b/generic/tclOO.c
index c7bab53..f52ff35 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOO.c,v 1.29 2010/02/02 09:51:47 dkf Exp $
+ * RCS: @(#) $Id: tclOO.c,v 1.30 2010/02/05 20:53:12 nijtmans Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -136,7 +136,7 @@ static char initScript[] =
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */
-MODULE_SCOPE const TclOOStubs * const tclOOConstStubPtr;
+MODULE_SCOPE const TclOOStubs tclOOConstStubs;
/*
* Convenience macro for getting the foundation from an interpreter.
@@ -182,7 +182,7 @@ TclOOInit(
}
return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION,
- (ClientData) tclOOConstStubPtr);
+ (ClientData) &tclOOConstStubs);
}
/*
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index 3039aa2..0ed32b2 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -1,5 +1,5 @@
/*
- * $Id: tclOOStubInit.c,v 1.8 2010/01/25 20:26:18 nijtmans Exp $
+ * $Id: tclOOStubInit.c,v 1.9 2010/02/05 20:53:12 nijtmans Exp $
*
* This file is (mostly) automatically generated from tclOO.decls.
* It is compiled and linked in with the tclOO package proper.
@@ -10,9 +10,11 @@
#endif
#include "tclOOInt.h"
+MODULE_SCOPE const TclOOStubs tclOOConstStubs;
+
/* !BEGIN!: Do not edit below this line. */
-static const TclOOIntStubs tclOOIntStubs = {
+static const TclOOIntStubs tclOOIntConstStubs = {
TCL_STUB_MAGIC,
NULL,
TclOOGetDefineCmdContext, /* 0 */
@@ -34,10 +36,10 @@ static const TclOOIntStubs tclOOIntStubs = {
};
static const TclOOStubHooks tclOOStubHooks = {
- &tclOOIntStubs
+ &tclOOIntConstStubs
};
-static const TclOOStubs tclOOStubs = {
+const TclOOStubs tclOOConstStubs = {
TCL_STUB_MAGIC,
&tclOOStubHooks,
Tcl_CopyObjectInstance, /* 0 */
@@ -72,7 +74,3 @@ static const TclOOStubs tclOOStubs = {
};
/* !END!: Do not edit above this line. */
-
-MODULE_SCOPE const TclOOStubs * const tclOOConstStubPtr;
-const TclOOStubs * const tclOOConstStubPtr = &tclOOStubs;
-
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 40b5e89..7314c94 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.185 2009/09/24 17:19:18 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.186 2010/02/05 20:53:12 nijtmans Exp $
*/
#include "tclInt.h"
@@ -41,9 +41,11 @@
* below should be made in the generic/tcl.decls script.
*/
+MODULE_SCOPE const TclStubs tclConstStubs;
+
/* !BEGIN!: Do not edit below this line. */
-static const TclIntStubs tclIntStubs = {
+static const TclIntStubs tclIntConstStubs = {
TCL_STUB_MAGIC,
NULL,
NULL, /* 0 */
@@ -296,7 +298,7 @@ static const TclIntStubs tclIntStubs = {
TclResetRewriteEnsemble, /* 247 */
};
-static const TclIntPlatStubs tclIntPlatStubs = {
+static const TclIntPlatStubs tclIntPlatConstStubs = {
TCL_STUB_MAGIC,
NULL,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
@@ -372,7 +374,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
#endif /* MACOSX */
};
-static const TclPlatStubs tclPlatStubs = {
+static const TclPlatStubs tclPlatConstStubs = {
TCL_STUB_MAGIC,
NULL,
#ifdef __WIN32__ /* WIN */
@@ -385,7 +387,7 @@ static const TclPlatStubs tclPlatStubs = {
#endif /* MACOSX */
};
-static const TclTomMathStubs tclTomMathStubs = {
+const TclTomMathStubs tclTomMathConstStubs = {
TCL_STUB_MAGIC,
NULL,
TclBN_epoch, /* 0 */
@@ -452,12 +454,12 @@ static const TclTomMathStubs tclTomMathStubs = {
};
static const TclStubHooks tclStubHooks = {
- &tclPlatStubs,
- &tclIntStubs,
- &tclIntPlatStubs
+ &tclPlatConstStubs,
+ &tclIntConstStubs,
+ &tclIntPlatConstStubs
};
-static const TclStubs tclStubs = {
+const TclStubs tclConstStubs = {
TCL_STUB_MAGIC,
&tclStubHooks,
Tcl_PkgProvideEx, /* 0 */
@@ -1114,14 +1116,3 @@ static const TclStubs tclStubs = {
};
/* !END!: Do not edit above this line. */
-
-/*
- * Module-scope pointers to the main static stubs tables, used for package
- * initialization via Tcl_PkgProvideEx().
- */
-
-MODULE_SCOPE const TclStubs * const tclConstStubsPtr;
-MODULE_SCOPE const TclTomMathStubs * const tclTomMathConstStubsPtr;
-
-const TclStubs * const tclConstStubsPtr = &tclStubs;
-const TclTomMathStubs * const tclTomMathConstStubsPtr = &tclTomMathStubs;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 192e7e2..793dccc 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.143 2009/12/16 23:26:01 nijtmans Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.144 2010/02/05 20:53:12 nijtmans Exp $
*/
#undef STATIC_BUILD
@@ -2227,7 +2227,7 @@ ExitProcOdd(
sprintf(buf, "odd %d\n", PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
- Tcl_Panic("ExitProcOdd: unable to write to stdout");
+ Tcl_Panic("ExitProcOdd: unable to write to stdout");
}
}
@@ -2241,7 +2241,7 @@ ExitProcEven(
sprintf(buf, "even %d\n", PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
- Tcl_Panic("ExitProcEven: unable to write to stdout");
+ Tcl_Panic("ExitProcEven: unable to write to stdout");
}
}
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index ddd5908..2c03346 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -11,14 +11,14 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTomMathInterface.c,v 1.11 2008/04/16 14:49:29 das Exp $
+ * RCS: @(#) $Id: tclTomMathInterface.c,v 1.12 2010/02/05 20:53:12 nijtmans Exp $
*/
#include "tclInt.h"
#include "tommath.h"
#include <limits.h>
-MODULE_SCOPE const TclTomMathStubs * const tclTomMathConstStubsPtr;
+MODULE_SCOPE const TclTomMathStubs tclTomMathConstStubs;
/*
*----------------------------------------------------------------------
@@ -45,7 +45,7 @@ TclTommath_Init(
/* TIP #268: Full patchlevel instead of just major.minor */
if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
- (ClientData) tclTomMathConstStubsPtr) != TCL_OK) {
+ (ClientData) &tclTomMathConstStubs) != TCL_OK) {
return TCL_ERROR;
}
return TCL_OK;
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index b76285f..0e4ba79 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: genStubs.tcl,v 1.35 2010/02/05 10:03:24 nijtmans Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.36 2010/02/05 20:53:12 nijtmans Exp $
package require Tcl 8.4
@@ -972,7 +972,9 @@ proc genStubs::emitHeader {name} {
proc genStubs::emitInit {name textVar} {
variable stubs
variable hooks
+ variable interfaces
upvar $textVar text
+ set root 1
set capName [string toupper [string index $name 0]]
append capName [string range $name 1 end]
@@ -981,12 +983,25 @@ proc genStubs::emitInit {name textVar} {
append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
set sep " "
foreach sub $hooks($name) {
- append text $sep "&${sub}Stubs"
+ append text $sep "&${sub}ConstStubs"
set sep ",\n "
}
append text "\n\};\n"
}
- append text "\nstatic const ${capName}Stubs ${name}Stubs = \{\n"
+ foreach intf [array names interfaces] {
+ if {[info exists hooks($intf)]} {
+ if {$name in $hooks($intf)} {
+ set root 0
+ break;
+ }
+ }
+ }
+
+ if {$root} {
+ append text "\nconst ${capName}Stubs ${name}ConstStubs = \{\n"
+ } else {
+ append text "\nstatic const ${capName}Stubs ${name}ConstStubs = \{\n"
+ }
append text " TCL_STUB_MAGIC,\n"
if {[info exists hooks($name)]} {
append text " &${name}StubHooks,\n"
generated by cgit v0.12 at 2024-11-18 20:19:05 (GMT)