First pass at integrating stubs mechanism from 8.0.

1 files changed, 88 insertions, 18 deletions

diff --git a/generic/tclResult.c b/generic/tclResult.c
index 3f09149..c48fb96 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.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: tclResult.c,v 1.1.2.3 1999/02/10 23:31:19 stanton Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.1.2.3.2.1 1999/03/08 20:14:11 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -430,7 +430,7 @@ Tcl_GetObjResult(interp)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendResult --
+ * Tcl_AppendResultVA --
  *
  *	Append a variable number of strings onto the interpreter's string
  *	result.
@@ -440,8 +440,8 @@ Tcl_GetObjResult(interp)
  *
  * Side effects:
  *	The result of the interpreter given by the first argument is
- *	extended by the strings given by the second and following arguments
- *	(up to a terminating NULL argument).
+ *	extended by the strings in the va_list (up to a terminating NULL
+ *	argument).
  *
  *	If the string result is empty, the object result is moved to the
  *	string result, then the object result is reset.
@@ -450,10 +450,13 @@ Tcl_GetObjResult(interp)
  */
 
 void
-Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_AppendResultVA (interp, argList)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
+				 * return value. */
+    va_list argList;		/* Variable argument list. */
 {
-    va_list argList;
-    Interp *iPtr;
+    Interp *iPtr = (Interp *) interp;
+    va_list tmpArgList;
     char *string;
     int newSpace;
 
@@ -462,7 +465,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
      * string result, then reset the object result.
      */
 
-    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
     if (*(iPtr->result) == 0) {
 	Tcl_SetResult((Tcl_Interp *) iPtr,
 	        TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)),
@@ -473,15 +475,15 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
      * Scan through all the arguments to see how much space is needed.
      */
 
+    tmpArgList = argList;
     newSpace = 0;
     while (1) {
-	string = va_arg(argList, char *);
+	string = va_arg(tmpArgList, char *);
 	if (string == NULL) {
 	    break;
 	}
 	newSpace += strlen(string);
     }
-    va_end(argList);
 
     /*
      * If the append buffer isn't already setup and large enough to hold
@@ -499,7 +501,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
      * buffer.
      */
 
-    TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
     while (1) {
 	string = va_arg(argList, char *);
 	if (string == NULL) {
@@ -508,6 +509,38 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
 	iPtr->appendUsed += strlen(string);
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppendResult --
+ *
+ *	Append a variable number of strings onto the interpreter's string
+ *	result.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The result of the interpreter given by the first argument is
+ *	extended by the strings given by the second and following arguments
+ *	(up to a terminating NULL argument).
+ *
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    Tcl_Interp *interp;
+    va_list argList;
+
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    Tcl_AppendResultVA(interp, argList);
     va_end(argList);
 }
 
@@ -792,7 +825,7 @@ ResetObjResult(iPtr)
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SetErrorCode --
+ * Tcl_SetErrorCodeVA --
  *
  *	This procedure is called to record machine-readable information
  *	about an error that is about to be returned.
@@ -809,21 +842,22 @@ ResetObjResult(iPtr)
  *
  *----------------------------------------------------------------------
  */
-	/* VARARGS2 */
+
 void
-Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+Tcl_SetErrorCodeVA (interp, argList)
+    Tcl_Interp *interp;		/* Interpreter in which to access the errorCode
+				 * variable. */
+    va_list argList;		/* Variable argument list. */
 {
-    va_list argList;
     char *string;
     int flags;
-    Interp *iPtr;
+    Interp *iPtr = (Interp *) interp;
 
     /*
      * Scan through the arguments one at a time, appending them to
      * $errorCode as list elements.
      */
 
-    iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
     flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
     while (1) {
 	string = va_arg(argList, char *);
@@ -834,13 +868,49 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 		(char *) NULL, string, flags);
 	flags |= TCL_APPEND_VALUE;
     }
-    va_end(argList);
     iPtr->flags |= ERROR_CODE_SET;
 }
 
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_SetErrorCode --
+ *
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The errorCode global variable is modified to hold all of the
+ *	arguments to this procedure, in a list form with each argument
+ *	becoming one element of the list.  A flag is set internally
+ *	to remember that errorCode has been set, so the variable doesn't
+ *	get set automatically when the error is returned.
+ *
+ *----------------------------------------------------------------------
+ */
+	/* VARARGS2 */
+void
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+{
+    Tcl_Interp *interp;
+    va_list argList;
+
+    /*
+     * Scan through the arguments one at a time, appending them to
+     * $errorCode as list elements.
+     */
+
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    Tcl_SetErrorCodeVA(interp, argList);
+    va_end(argList);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_SetObjErrorCode --
  *
  *	This procedure is called to record machine-readable information