Version 1 of Cross-version voodoo

Updated 2002-07-12 23:07:42

JH This page is dedicated to some of the magic needed to support cross-version compiling of Tcl extensions, either with stubs support or just general source compatability. In some cases this is to handle extensions that need to access private data structures in Tcl (which should be avoided at all costs), in others its just to enable support of features in source even when compiling against an older version of Tcl.


TclX has a special TclX_CreateObjCommand that takes extra arguments in order to not overwrite existing commands unless specified. This is for commands like fork and system that also exist in expect. This included code of the form:

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     if ((flags & TCLX_CMD_REDEFINE) ||
              !(Tcl_FindHashEntry(&globalNsPtr->cmdTable, cmdName)
                   ....

The problem here is that this address of the cmdTable is determined at compile time, and also used by Tcl_FindHashEntry, which is a macro:

 #define Tcl_FindHashEntry(tablePtr, key) (*((tablePtr)->findProc))(tablePtr, key)

From 8.3 to 8.4, the size of Tcl_HashTable grew by one pointer, and the private Namespace structure included several of these in it, meaning the compile time offset calculations won't work across the 8.3/8.4 version boundary. There is no problem when building with 8.4 and running in 8.4, or the same with 8.3. However, as we want Tclx to work with stubs, I created the following pointer voodoo to handle this situation.

 -----8<-----8<---extracted from tclExtdInt.h---8<-----8<-----
 extern void *
 TclX_StructOffset _ANSI_ARGS_((void *nsPtr, size_t offset,
         unsigned int offType));

 /*
  * Macro to use to fill in "offset" fields of a structure.
  * Computes number of bytes from beginning of structure to a given field.
  * Based off Tk_Offset
  */

 #ifdef offsetof
 #  define TclX_Offset(type, field) ((size_t) offsetof(type, field))
 #else
 #  define TclX_Offset(type, field) ((size_t) ((char *) &((type *) 0)->field))
 #endif
 -----8<-----8<---extracted from tclExtdInt.h---8<-----8<-----

 /*--------------------------------------------------------------------------
  * TclX_CreateObjCommand --
  *
  * Handles the creation of TclX commands. Used for commands who come
  * in conflict with other extensions.
  *
  * Parameters:
  *   o Like Tcl_CreateObjCommand
  *   o flags - Additional flags to control the behaviour of the procedure.
  *--------------------------------------------------------------------------
  */

 int
 TclX_CreateObjCommand (interp, cmdName, proc, clientData, deleteProc, flags)
     Tcl_Interp*        interp;
     char*              cmdName;
     Tcl_ObjCmdProc*    proc;
     ClientData         clientData;
     Tcl_CmdDeleteProc* deleteProc;
     int                flags;
 {
     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
     Tcl_HashTable *gTblPtr, *cTblPtr;
     /* we only need to make this calculation once */
     static size_t offset = TclX_Offset(Namespace, cmdTable);
     char cmdnamebuf[80];

     /*
  • Use a function to adjust the offset into the Namespace that we want,
  • to handle compiling and running across the 8.3/8.4 boundary.
      */
     gTblPtr = (Tcl_HashTable *) TclX_StructOffset(globalNsPtr, offset, 0);
     cTblPtr = (Tcl_HashTable *) TclX_StructOffset(currNsPtr, offset, 0);
     if ((flags & TCLX_CMD_REDEFINE) ||
              !(Tcl_FindHashEntry(gTblPtr, cmdName) ||
                      Tcl_FindHashEntry(cTblPtr, cmdName))) {
          Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc);
     }
     if (!(cmdName[0] == 't' && cmdName[1] == 'c' && cmdName[2] == 'l' &&
              cmdName[3] == 'x') && !(flags & TCLX_CMD_NOPREFIX)) {
          sprintf(cmdnamebuf, "tclx_%s", cmdName);
          Tcl_CreateObjCommand(interp, cmdnamebuf, proc, clientData, deleteProc);
     }

     return TCL_OK;
 }

 /*--------------------------------------------------------------------------
  * TclX_StructOffset --
  *
  * Handles offsets into a private structure, which has changed in size from
  * 8.3 to 8.4.  In this example, only Namespace is supported, but you could
  * easily make use of offType to switch on the offsets that would be needed.
  *
  *--------------------------------------------------------------------------
  */

 void *
 TclX_StructOffset(nsPtr, offset, offType)
     void *nsPtr;
     size_t offset;
     unsigned int offType;
 {
     int major, minor, patchlevel, release, i;
     static size_t nsOffs[] = {
          TclX_Offset(Namespace, varTable), sizeof(void *),
          TclX_Offset(Namespace, cmdTable), sizeof(void *),
          TclX_Offset(Namespace, childTable), sizeof(void *),
          0, 0
     };

     /*
    • Get the version so we can runtime switch on available functionality.
    • 8.0 is the lowest we compile with, so use that assumption.
      */
     Tcl_GetVersion(&major, &minor, &patchlevel, &release);

 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 4
     /*
    • Headers are <= 8.3 for offset calculations, so we only need to
    • adjust for 8.4+ interpreters.
      */
     if ((major > 8) || (minor > 3)) {
          for (i = 0; nsOffs[i] != 0; i += 2) {
              if (offset > nsOffs[i]) {
                  offset += nsOffs[i+1];
              }
          }
     }
 #else
     /*
    • Headers are >= 8.4 for offset calculations, so we only need to
    • adjust for 8.3- interpreters.
      */
     if ((major == 8) && (minor < 4)) {
          for (i = 0; nsOffs[i] != 0; i += 2) {
              if (offset > nsOffs[i]) {
                  offset -= nsOffs[i+1];
              }
          }
     }
 #endif
     return (void *)((size_t) nsPtr + offset);
 }


Explain here the use of CONST84 for easy 8.3-/8.4+ source compatability ...

 #ifndef CONST84
 #  define CONST84
 #endif

Adding CONST84 ...


Explain here the stubs magic to enable recognition of different channel types of features in versions of Tcl past the one we have headers for ...