Merged changes between child workspace "/home/escoffon/ws/tcl8.0" and

 parent workspace "/ws/tcl8.0".

4 files changed, 242 insertions, 40 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index 77719ee..d9fa893 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: %Z% $Id: tcl.h,v 1.7 1998/06/29 18:08:50 welch Exp $ 
+ * SCCS: %Z% $Id: tcl.h,v 1.8 1998/07/01 19:08:21 escoffon Exp $ 
  */
 
 #ifndef _TCL
@@ -70,10 +70,6 @@
 #   ifndef USE_TCLALLOC
 #	define USE_TCLALLOC 1
 #   endif
-#   ifndef STRINGIFY
-#	define STRINGIFY(x)	    STRINGIFY1(x)
-#	define STRINGIFY1(x)	    #x
-#   endif
 #endif /* __WIN32__ */
 
 /*
@@ -93,6 +89,34 @@
 #   endif
 #endif
 
+/*
+ * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
+ * quotation marks), JOIN joins two arguments.
+ */
+
+#define VERBATIM(x) x
+#ifdef _MSC_VER
+# define STRINGIFY(x) STRINGIFY1(x)
+# define STRINGIFY1(x) #x
+# define JOIN(a,b) JOIN1(a,b)
+# define JOIN1(a,b) a##b
+#else
+# ifdef RESOURCE_INCLUDED
+#  define STRINGIFY(x) STRINGIFY1(x)
+#  define STRINGIFY1(x) #x
+#  define JOIN(a,b) JOIN1(a,b)
+#  define JOIN1(a,b) a##b
+# else
+#  ifdef __STDC__
+#   define STRINGIFY(x) #x
+#   define JOIN(a,b) a##b
+#  else
+#   define STRINGIFY(x) "x"
+#   define JOIN(a,b) VERBATIM(a)VERBATIM(b)
+#  endif
+# endif
+#endif
+
 /* 
  * A special definition used to allow this header file to be included 
  * in resource files so that they can get obtain version information from
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 40813ec..e8db382 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * SCCS: %Z% $Id: tclBasic.c,v 1.4 1998/06/29 17:32:09 welch Exp $ 
+ * SCCS: %Z% $Id: tclBasic.c,v 1.5 1998/07/01 19:09:11 escoffon Exp $ 
  */
 
 #include "tclInt.h"
@@ -3494,8 +3494,8 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
 
 	    auxDataPtr = compEnv.auxDataArrayPtr;
 	    for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
-		if (auxDataPtr->freeProc != NULL) {
-		    auxDataPtr->freeProc(auxDataPtr->clientData);
+		if (auxDataPtr->type->freeProc != NULL) {
+		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
 		}
 		auxDataPtr++;
 	    }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 48b5641..4c40d64 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -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.
  *
- * SCCS: @(#) tclCompile.c 1.80 97/09/18 18:23:30
+ * SCCS: %Z% $Id: tclCompile.c,v 1.6 1998/07/01 19:12:42 escoffon Exp $ 
  */
 
 #include "tclInt.h"
@@ -352,6 +352,14 @@ unsigned char tclTypeTable[] = {
 };
 
 /*
+ * Table of all AuxData types.
+ */
+
+static Tcl_HashTable auxDataTypeTable;
+static int auxDataTypeTableInitialized = 0;    /* 0 means not yet
+                                                * initialized. */
+
+/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -418,6 +426,16 @@ Tcl_ObjType tclByteCodeType = {
     UpdateStringOfByteCode,	/* updateStringProc */
     SetByteCodeFromAny		/* setFromAnyProc */
 };
+
+/*
+ * The structures below define the AuxData types defined in this file.
+ */
+
+AuxDataType tclForeachInfoType = {
+    "ForeachInfo",				/* name */
+    DupForeachInfo,				/* dupProc */
+    FreeForeachInfo				/* freeProc */
+};
 
 /*
  *----------------------------------------------------------------------
@@ -966,8 +984,8 @@ TclCleanupByteCode(codePtr)
 
     auxDataPtr = codePtr->auxDataArrayPtr;
     for (i = 0;  i < numAuxDataItems;  i++) {
-	if (auxDataPtr->freeProc != NULL) {
-	    auxDataPtr->freeProc(auxDataPtr->clientData);
+	if (auxDataPtr->type->freeProc != NULL) {
+	    auxDataPtr->type->freeProc(auxDataPtr->clientData);
 	}
 	auxDataPtr++;
     }
@@ -1077,8 +1095,8 @@ SetByteCodeFromAny(interp, objPtr)
 
 	auxDataPtr = compEnv.auxDataArrayPtr;
 	for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
-	    if (auxDataPtr->freeProc != NULL) {
-		auxDataPtr->freeProc(auxDataPtr->clientData);
+	    if (auxDataPtr->type->freeProc != NULL) {
+            auxDataPtr->type->freeProc(auxDataPtr->clientData);
 	    }
 	    auxDataPtr++;
 	}
@@ -4533,7 +4551,7 @@ TclCompileForeachCmd(interp, string, lastChar, flags, envPtr)
 	infoPtr->varLists[i] = varListPtr;
     }
     infoIndex = TclCreateAuxData((ClientData) infoPtr,
-            DupForeachInfo, FreeForeachInfo, envPtr);
+            &tclForeachInfoType, envPtr);
 
     /*
      * Emit code to store each value list into the associated temporary.
@@ -7447,17 +7465,12 @@ CreateExceptionRange(type, envPtr)
  */
 
 int
-TclCreateAuxData(clientData, dupProc, freeProc, envPtr)
+TclCreateAuxData(clientData, typePtr, envPtr)
     ClientData clientData;	/* The compilation auxiliary data to store
-				 * in the new aux data record. */
-    AuxDataDupProc *dupProc;	/* Procedure to call to duplicate the
-				 * compilation aux data when the containing
-				 * ByteCode structure is duplicated. */
-    AuxDataFreeProc *freeProc;	/* Procedure to call to free the
-				 * compilation aux data when the containing
-				 * ByteCode structure is freed.  */
+                             * in the new aux data record. */
+    AuxDataType *typePtr;	/* Pointer to the type to attach to this AuxData */
     register CompileEnv *envPtr;/* Points to the CompileEnv for which a new
-				 * aux data structure is to be allocated. */
+                                 * aux data structure is to be allocated. */
 {
     int index;			/* Index for the new AuxData structure. */
     register AuxData *auxDataPtr;
@@ -7493,9 +7506,8 @@ TclCreateAuxData(clientData, dupProc, freeProc, envPtr)
     envPtr->auxDataArrayNext++;
     
     auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
+    auxDataPtr->type = typePtr;
     auxDataPtr->clientData = clientData;
-    auxDataPtr->dupProc  = dupProc;
-    auxDataPtr->freeProc = freeProc;
     return index;
 }
 
@@ -7806,5 +7818,145 @@ TclGetInstructionTable()
 {
     return &instructionTable[0];
 }
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclRegisterAuxDataType --
+ *
+ *	This procedure is called to register a new AuxData type
+ *	in the table of all AuxData types supported by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The type is registered in the AuxData type table. If there was already
+ *	a type with the same name as in typePtr, it is replaced with the
+ *	new type.
+ *
+ *--------------------------------------------------------------
+ */
 
+void
+TclRegisterAuxDataType(typePtr)
+    AuxDataType *typePtr;	/* Information about object type;
+                             * storage must be statically
+                             * allocated (must live forever). */
+{
+    register Tcl_HashEntry *hPtr;
+    int new;
 
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    /*
+     * If there's already a type with the given name, remove it.
+     */
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
+    }
+
+    /*
+     * Now insert the new object type.
+     */
+
+    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
+    if (new) {
+        Tcl_SetHashValue(hPtr, typePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetAuxDataType --
+ *
+ *	This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ *	If an AuxData type with name matching "typeName" is found, a pointer
+ *	to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+AuxDataType *
+TclGetAuxDataType(typeName)
+    char *typeName;		/* Name of AuxData type to look up. */
+{
+    register Tcl_HashEntry *hPtr;
+    AuxDataType *typePtr = NULL;
+
+    if (!auxDataTypeTableInitialized) {
+        TclInitAuxDataTypeTable();
+    }
+
+    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
+    }
+
+    return typePtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TclInitAuxDataTypeTable --
+ *
+ *	This procedure is invoked to perform once-only initialization of
+ *	the AuxData type table. It also registers the AuxData types defined in 
+ *	this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initializes the table of defined AuxData types "auxDataTypeTable" with
+ *	builtin AuxData types defined in this file.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TclInitAuxDataTypeTable()
+{
+    auxDataTypeTableInitialized = 1;
+
+    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
+    TclRegisterAuxDataType(&tclForeachInfoType);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeAuxDataTypeTable --
+ *
+ *	This procedure is called by Tcl_Finalize after all exit handlers
+ *	have been run to free up storage associated with the table of AuxData
+ *	types.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deletes all entries in the hash table of AuxData types, "auxDataTypeTable".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeAuxDataTypeTable()
+{
+    if (auxDataTypeTableInitialized) {
+        Tcl_DeleteHashTable(&auxDataTypeTable);
+        auxDataTypeTableInitialized = 0;
+    }
+}
diff --git a/unix/configure.in b/unix/configure.in
index 3a77cb2..21b9867 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -2,7 +2,7 @@ dnl	This file is an input file used by the GNU "autoconf" program to
 dnl	generate the file "configure", which is run during Tcl installation
 dnl	to configure the system for the local environment.
 AC_INIT(../generic/tcl.h)
-# SCCS: @(#) configure.in 1.144 97/11/20 12:39:44
+# SCCS: %Z% $Id: configure.in,v 1.4 1998/07/01 19:17:08 escoffon Exp $ 
 
 TCL_VERSION=8.0
 TCL_MAJOR_VERSION=8
@@ -655,6 +655,8 @@ fullSrcDir=`cd $srcdir; pwd`
 TCL_SHARED_LIB_SUFFIX=""
 TCL_UNSHARED_LIB_SUFFIX=""
 TCL_LIB_VERSIONS_OK=ok
+CFLAGS_DEBUG=-g
+CFLAGS_OPTIMIZE=-O
 case $system in
     AIX-4.[[2-9]])
 	SHLIB_CFLAGS=""
@@ -666,7 +668,7 @@ case $system in
 	LD_FLAGS=""
 	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
 	AIX=yes
-	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
 	;;
     AIX-*)
 	SHLIB_CFLAGS=""
@@ -677,7 +679,7 @@ case $system in
 	DL_LIBS="-lld"
 	LD_FLAGS=""
 	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
 	;;
     BSD/OS-2.1*|BSD/OS-3*)
 	SHLIB_CFLAGS=""
@@ -721,7 +723,7 @@ case $system in
 	DL_LIBS=""
 	LD_FLAGS="-Wl,-D,08000000"
 	LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-	TCL_SHARED_LIB_SUFFIX='${VERSION}.a'
+	TCL_SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
 	;;
     IRIX-5.*|IRIX-6.*)
 	SHLIB_CFLAGS=""
@@ -793,7 +795,7 @@ case $system in
 	    DL_LIBS=""
 	    LD_FLAGS=""
 	    LD_SEARCH_FLAGS=""
-	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`\$\{DBGX\}.so.1.0'
 	], [
 	    SHLIB_CFLAGS=""
 	    SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
@@ -803,12 +805,12 @@ case $system in
 	    DL_LIBS=""
 	    LD_FLAGS=""
 	    LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
-	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	    TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`\$\{DBGX\}.a'
 	])
 
 	# FreeBSD doesn't handle version numbers with dots.
 
-	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`\$\{DBGX\}.a'
 	TCL_LIB_VERSIONS_OK=nodots
 	;;
     NEXTSTEP-*)
@@ -903,8 +905,8 @@ case $system in
 	# requires an extra version number at the end of .so file names.
 	# So, the library has to have a name like libtcl75.so.1.0
 
-	TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.so.1.0'
-	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`.a'
+	TCL_SHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`\$\{DBGX\}.so.1.0'
+	TCL_UNSHARED_LIB_SUFFIX='`echo ${VERSION} | tr -d .`\$\{DBGX\}.a'
 	TCL_LIB_VERSIONS_OK=nodots
 	;;
     SunOS-5*)
@@ -1081,6 +1083,18 @@ if test "$DL_OBJS" != "tclLoadNone.o" ; then
     fi
 fi
 
+# Set the default compiler switches based on the --enable-symbols option
+
+AC_ARG_ENABLE(symbols, [  --enable-symbols        build with debugging symbols],
+    [tcl_ok=$enableval], [tcl_ok=no])
+if test "$tcl_ok" = "yes"; then
+    CFLAGS_DEFAULT=CFLAGS_DEBUG
+    DBGX=g
+else
+    CFLAGS_DEFAULT=CFLAGS_OPTIMIZE
+    DBGX=""
+fi
+
 #--------------------------------------------------------------------
 #	The statements below check for systems where POSIX-style
 #	non-blocking I/O (O_NONBLOCK) doesn't work or is unimplemented. 
@@ -1139,10 +1153,10 @@ esac
 
 realRanlib=$RANLIB
 if test "$TCL_SHARED_LIB_SUFFIX" = "" ; then
-    TCL_SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
+    TCL_SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}${SHLIB_SUFFIX}'
 fi
 if test "$TCL_UNSHARED_LIB_SUFFIX" = "" ; then
-    TCL_UNSHARED_LIB_SUFFIX='${VERSION}.a'
+    TCL_UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
 fi
 AC_ARG_ENABLE(shared,
     [  --enable-shared         build libtcl as a shared library],
@@ -1177,17 +1191,23 @@ else
     MAKE_LIB="ar cr ${TCL_LIB_FILE} \${OBJS}"
 fi
 
+# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
+# so that the backslashes quoting the DBX braces are dropped.
+
+eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
+eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
+
 # Note:  in the following variable, it's important to use the absolute
 # path name of the Tcl directory rather than "..":  this is because
 # AIX remembers this path and will attempt to use it at run-time to look
 # up the Tcl library.
 
 if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
-    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}"
-    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}"
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl${VERSION}\${DBGX}"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl${VERSION}\${DBGX}"
 else
-    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`"
-    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`"
+    TCL_BUILD_LIB_SPEC="-L`pwd` -ltcl`echo ${VERSION} | tr -d .`\${DBGX}"
+    TCL_LIB_SPEC="-L${exec_prefix}/lib -ltcl`echo ${VERSION} | tr -d .`\${DBGX}"
 fi
 
 #--------------------------------------------------------------------
@@ -1204,6 +1224,12 @@ else
 fi
 
 AC_SUBST(BUILD_DLTEST)
+AC_SUBST(CFLAGS_DEBUG)
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(CFLAGS_OPTIMIZE)
+AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
+AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(DBGX)
 AC_SUBST(DL_LIBS)
 AC_SUBST(DL_OBJS)
 AC_SUBST(LD_FLAGS)