From 9f80e538be5be980c7e52789ff2162b08db46823 Mon Sep 17 00:00:00 2001 From: nijtmans Date: Fri, 5 Feb 2010 20:53:12 +0000 Subject: 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. --- ChangeLog | 14 ++++++++++++++ generic/tclBasic.c | 8 ++++---- generic/tclOO.c | 6 +++--- generic/tclOOStubInit.c | 14 ++++++-------- generic/tclStubInit.c | 31 +++++++++++-------------------- generic/tclTest.c | 6 +++--- generic/tclTomMathInterface.c | 6 +++--- tools/genStubs.tcl | 21 ++++++++++++++++++--- 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 + + * 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 * 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 -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" -- cgit v0.12