Tcl Source Code

Check-in [29cc0feeb2]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge updates from HEAD
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 29cc0feeb262c62f98476658f71677b1de5197d5
User & Date: dgp 2005-09-15 20:58:38
Context
2005-09-16
15:35
[kennykb-numerics-branch]
* generic/tclTomMath.h: Added mp_cmp_d to routines from ...
check-in: f5324453ec user: dgp tags: kennykb-numerics-branch
2005-09-15
20:58
merge updates from HEAD check-in: 29cc0feeb2 user: dgp tags: kennykb-numerics-branch
2005-09-12
19:39
uninitialized vars are bad, mm'kay? check-in: 948d18b8f7 user: dgp tags: kennykb-numerics-branch
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to ChangeLog.

            1  +2005-09-15  Don Porter  <[email protected]>
            2  +
            3  +	[kennykb-numerics-branch]	Merge updates from HEAD.
            4  +
            5  +	* generic/tclStringObj.c (TclAppendFormattedObjs):	Revision
            6  +	to eliminate one round of string copying.
            7  +
            8  +	* generic/tclBasic.c:	More callers of TclObjPrintf and
            9  +	* generic/tclCkalloc.c:	TclFormatToErrorInfo.
           10  +	* generic/tclCmdMZ.c:
           11  +	* generic/tclExecute.c:
           12  +	* generic/tclIORChan.c:
           13  +	* generic/tclMain.c:
           14  +	* generic/tclProc.c:
           15  +	* generic/tclTimer.c:
           16  +	* generic/tclUtil.c:
           17  +	* unix/tclUnixFCmd.c
           18  +
           19  +	* unix/configure:	autoconf-2.59
           20  +
           21  +2005-09-15  Donal K. Fellows  <[email protected]>
           22  +
           23  +	* unix/tcl.m4 (SC_TCL_EARLY_FLAGS): Added extra hack to allow Tcl
           24  +	to transparently open large files on RHEL 3. [Bug 1287638]
           25  +
           26  +2005-09-14  Don Porter  <[email protected]>
           27  +
           28  +	* generic/tclStringObj.c:	Bug fixes: ObjPrintfVA needed to
           29  +	support "*" fields and needed to interpret precision limits on
           30  +	%s conversions as a maximum number of bytes, not Tcl_UniChars, to
           31  +	take from the (char *) argument.
           32  +
           33  +	* generic/tclBasic.c:	Updated several callers to use
           34  +	* generic/tclCkalloc.c: TclFormatToErrorInfo() and/or
           35  +	* generic/tclCmdAH.c:	TclObjPrintf().
           36  +	* generic/tclCmdIL.c:	
           37  +	* generic/tclCmdMZ.c:	
           38  +	* generic/tclDictObj.c:
           39  +	* generic/tclExecute.c:
           40  +	* generic/tclIORChan.c:	
           41  +	* generic/tclIOUtil.c:	
           42  +	* generic/tclNamesp.c:
           43  +	* generic/tclProc.c:
           44  +
           45  +	* library/init.tcl:	Keep [unknown] in sync with errorInfo
           46  +	formatting rules.
           47  +
           48  +2005-09-13  Don Porter  <[email protected]>
           49  +
           50  +	* generic/tclBasic.c:	First caller of TclFormatToErrorInfo.
           51  +
           52  +	* generic/tclInt.h:		Using stdarg.h conventions, add more
           53  +	* generic/tclStringObj.c:	fixed arguments to TclFormatObj() and
           54  +	TclObjPrintf().  Added new routine TclFormatToErrorInfo().
           55  +
           56  +	* generic/tcl.h:	Explicitly standardized on the use of stdarg.h
           57  +	* generic/tclBasic.c:	conventions for functions with variable number
           58  +	* generic/tclInt.h:	of arguments.  Support for varargs.h has been
           59  +	* generic/tclPanic.c:	implicitly gone for some time now.  All
           60  +	* generic/tclResult.c:	TCL_VARARGS* macros purged from Tcl sources,
           61  +	* generic/tclStringObj.c:	leaving only some deprecated #define's
           62  +	* tools/genStubs.tcl:	in tcl.h for the sake of older extensions.
           63  +
           64  +	* generic/tclDecls.h:	make genstubs
           65  +
           66  +	* doc/AddErrInfo.3:	Replaced all documented requirement for use
           67  +	* doc/Eval.3:		of TCL_VARARGS_START() with requirement for
           68  +	* doc/Panic.3:		use of va_start().
           69  +	* doc/SetResult.3:
           70  +	* doc/StringObj.3:
           71  +
     1     72   2005-09-12  Don Porter  <[email protected]>
     2     73   
     3     74   	[kennykb-numerics-branch]	Merge updates from HEAD.
     4     75   
     5     76   	* generic/tclCmdAH.c:		Added support for the "ll" width	
     6     77   	* generic/tclStringObj.c:	specifier to [format].
     7     78   

Changes to doc/AddErrInfo.3.

     1      1   '\"
     2      2   '\" Copyright (c) 1989-1993 The Regents of the University of California.
     3      3   '\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
     4      4   '\"
     5      5   '\" See the file "license.terms" for information on usage and redistribution
     6      6   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     7      7   '\" 
     8         -'\" RCS: @(#) $Id: AddErrInfo.3,v 1.13.2.1 2005/08/15 18:13:58 dgp Exp $
            8  +'\" RCS: @(#) $Id: AddErrInfo.3,v 1.13.2.2 2005/09/15 20:58:38 dgp Exp $
     9      9   '\" 
    10     10   .so man.macros
    11         -.TH Tcl_AddErrorInfo 3 8.0 Tcl "Tcl Library Procedures"
           11  +.TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures"
    12     12   .BS
    13     13   .SH NAME
    14     14   Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
    15     15   .SH SYNOPSIS
    16     16   .nf
    17     17   \fB#include <tcl.h>\fR
    18     18   .VS 8.5
................................................................................
    62     62   .AP Tcl_Obj *errorObjPtr in
    63     63   The \fB-errorcode\fR return option will be set to this value.
    64     64   .AP char *element in
    65     65   String to record as one element of the \fB-errorcode\fR return option.
    66     66   Last \fIelement\fR argument must be NULL.
    67     67   .AP va_list argList in
    68     68   An argument list which must have been initialized using
    69         -\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
           69  +\fBva_start\fR, and cleared using \fBva_end\fR.
    70     70   .AP "const char" *script in
    71     71   Pointer to first character in script containing command (must be <= command)
    72     72   .AP "const char" *command in
    73     73   Pointer to first character in command that generated the error
    74     74   .AP int commandLength in
    75     75   Number of bytes in command; -1 means use all bytes up to first null byte
    76     76   .BE

Changes to doc/Eval.3.

     2      2   '\" Copyright (c) 1989-1993 The Regents of the University of California.
     3      3   '\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
     4      4   '\" Copyright (c) 2000 Scriptics Corporation.
     5      5   '\"
     6      6   '\" See the file "license.terms" for information on usage and redistribution
     7      7   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     8      8   '\" 
     9         -'\" RCS: @(#) $Id: Eval.3,v 1.18.2.2 2005/05/05 17:55:20 kennykb Exp $
            9  +'\" RCS: @(#) $Id: Eval.3,v 1.18.2.3 2005/09/15 20:58:38 dgp Exp $
    10     10   '\" 
    11     11   .so man.macros
    12     12   .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
    13     13   .BS
    14     14   .SH NAME
    15     15   Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
    16     16   .SH SYNOPSIS
................................................................................
    67     67   first null byte are used.
    68     68   .AP "const char" *script in
    69     69   Points to first byte of script to execute (null-terminated and UTF-8).
    70     70   .AP char *part in
    71     71   String forming part of a Tcl script.
    72     72   .AP va_list argList in
    73     73   An argument list which must have been initialized using
    74         -\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
           74  +\fBva_start\fR, and cleared using \fBva_end\fR.
    75     75   .BE
    76     76   
    77     77   .SH DESCRIPTION
    78     78   .PP
    79     79   The procedures described here are invoked to execute Tcl scripts in
    80     80   various forms.
    81     81   \fBTcl_EvalObjEx\fR is the core procedure and is used by many of the others.

Changes to doc/Panic.3.

     1      1   '\"
     2      2   '\" See the file "license.terms" for information on usage and redistribution
     3      3   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     4      4   '\" 
     5         -'\" RCS: @(#) $Id: Panic.3,v 1.7 2004/10/07 15:15:47 dkf Exp $
            5  +'\" RCS: @(#) $Id: Panic.3,v 1.7.2.1 2005/09/15 20:58:38 dgp Exp $
     6      6   '\" 
     7      7   .so man.macros
     8      8   .TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
     9      9   .BS
    10     10   '\"  Note:  do not modify the .SH NAME line immediately below!
    11     11   .SH NAME
    12     12   Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
................................................................................
    27     27   .AS Tcl_PanicProc *panicProc
    28     28   .AP "const char*" format in
    29     29   A printf-style format string.
    30     30   .AP "" arg in
    31     31   Arguments matching the format string.
    32     32   .AP va_list argList in
    33     33   An argument list of arguments matching the format string.
    34         -Must have been initialized using \fBTCL_VARARGS_START\fR,
           34  +Must have been initialized using \fBva_start\fR,
    35     35   and cleared using \fBva_end\fR.
    36     36   .AP Tcl_PanicProc *panicProc in
    37     37   Procedure to report fatal error message and abort.
    38     38   
    39     39   .BE
    40     40   
    41     41   .SH DESCRIPTION

Changes to doc/SetResult.3.

     1      1   '\"
     2      2   '\" Copyright (c) 1989-1993 The Regents of the University of California.
     3      3   '\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
     4      4   '\"
     5      5   '\" See the file "license.terms" for information on usage and redistribution
     6      6   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     7      7   '\" 
     8         -'\" RCS: @(#) $Id: SetResult.3,v 1.11.2.1 2005/05/05 17:55:23 kennykb Exp $
            8  +'\" RCS: @(#) $Id: SetResult.3,v 1.11.2.2 2005/09/15 20:58:38 dgp Exp $
     9      9   '\" 
    10     10   .so man.macros
    11     11   .TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures"
    12     12   .BS
    13     13   .SH NAME
    14     14   Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_FreeResult \- manipulate Tcl result
    15     15   .SH SYNOPSIS
................................................................................
    49     49   to the existing result of \fIinterp\fR.
    50     50   .AP Tcl_FreeProc *freeProc in
    51     51   Address of procedure to call to release storage at
    52     52   \fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
    53     53   \fBTCL_VOLATILE\fR.
    54     54   .AP va_list argList in
    55     55   An argument list which must have been initialized using
    56         -\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
           56  +\fBva_start\fR, and cleared using \fBva_end\fR.
    57     57   .BE
    58     58   
    59     59   .SH DESCRIPTION
    60     60   .PP
    61     61   The procedures described here are utilities for manipulating the
    62     62   result value in a Tcl interpreter.
    63     63   The interpreter result may be either a Tcl object or a string.

Changes to doc/StringObj.3.

     1      1   '\"
     2      2   '\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
     3      3   '\"
     4      4   '\" See the file "license.terms" for information on usage and redistribution
     5      5   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     6      6   '\" 
     7         -'\" RCS: @(#) $Id: StringObj.3,v 1.17.2.1 2005/04/10 23:14:42 kennykb Exp $
            7  +'\" RCS: @(#) $Id: StringObj.3,v 1.17.2.2 2005/09/15 20:58:39 dgp Exp $
     8      8   '\" 
     9      9   .so man.macros
    10     10   .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
    11     11   .BS
    12     12   .SH NAME
    13     13   Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj, Tcl_AttemptSetObjLength \- manipulate Tcl objects as strings
    14     14   .SH SYNOPSIS
................................................................................
   109    109   .AP int *lengthPtr out
   110    110   If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
   111    111   the length of an object's string representation.
   112    112   .AP "const char" *string in
   113    113   Null-terminated string value to append to \fIobjPtr\fR.
   114    114   .AP va_list argList in
   115    115   An argument list which must have been initialised using
   116         -\fBTCL_VARARGS_START\fR, and cleared using \fBva_end\fR.
          116  +\fBva_start\fR, and cleared using \fBva_end\fR.
   117    117   .AP int newLength in
   118    118   New length for the string value of \fIobjPtr\fR, not including the
   119    119   final null character.
   120    120   .AP int objc in
   121    121   The number of elements to concatenate.
   122    122   .AP Tcl_Obj *objv[] in
   123    123   The array of objects to concatenate.

Changes to generic/tcl.h.

     9      9    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
    10     10    * Copyright (c) 1998-2000 by Scriptics Corporation.
    11     11    * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
    12     12    *
    13     13    * See the file "license.terms" for information on usage and redistribution of
    14     14    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15    *
    16         - * RCS: @(#) $Id: tcl.h,v 1.191.2.9 2005/09/09 18:48:40 dgp Exp $
           16  + * RCS: @(#) $Id: tcl.h,v 1.191.2.10 2005/09/15 20:58:39 dgp Exp $
    17     17    */
    18     18   
    19     19   #ifndef _TCL
    20     20   #define _TCL
    21     21   
    22     22   /*
    23     23    * For C++ compilers, use extern "C"
................................................................................
   149    149    * should, so also for their sake, we keep the #include to be consistent with
   150    150    * prior Tcl releases.
   151    151    */
   152    152   
   153    153   #include <stdio.h>
   154    154   
   155    155   /*
   156         - * Definitions that allow Tcl functions with variable numbers of arguments to
   157         - * be used with either varargs.h or stdarg.h. TCL_VARARGS is used in function
   158         - * prototypes. TCL_VARARGS_DEF is used to declare the arguments in a function
   159         - * definiton: it takes the type and name of the first argument and supplies
   160         - * the appropriate argument declaration string for use in the function
   161         - * definition. TCL_VARARGS_START initializes the va_list data structure and
   162         - * returns the first argument.
          156  + * Support for functions with a variable number of arguments.
          157  + *
          158  + * The following TCL_VARARGS* macros are to support old extensions
          159  + * written for older versions of Tcl where the macros permitted
          160  + * support for the varargs.h system as well as stdarg.h .  
          161  + *
          162  + * New code should just directly be written to use stdarg.h conventions.
   163    163    */
   164    164   
   165         -#if !defined(NO_STDARG)
   166         -#   include <stdarg.h>
   167         -#   define TCL_VARARGS(type, name) (type name, ...)
   168         -#   define TCL_VARARGS_DEF(type, name) (type name, ...)
   169         -#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
   170         -#else
   171         -#   include <varargs.h>
   172         -#   define TCL_VARARGS(type, name) ()
   173         -#   define TCL_VARARGS_DEF(type, name) (va_alist)
   174         -#   define TCL_VARARGS_START(type, name, list) \
   175         -	(va_start(list), va_arg(list, type))
          165  +#include <stdarg.h>
          166  +#ifndef TCL_NO_DEPRECATED
          167  +#    define TCL_VARARGS(type, name) (type name, ...)
          168  +#    define TCL_VARARGS_DEF(type, name) (type name, ...)
          169  +#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
   176    170   #endif
   177    171   
   178    172   /*
   179    173    * Macros used to declare a function to be exported by a DLL. Used by Windows,
   180    174    * maps to no-op declarations on non-Windows systems. The default build on
   181    175    * windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be
   182    176    * nonempty. To build a static library, the macro STATIC_BUILD should be
................................................................................
   690    684   	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
   691    685   typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
   692    686   typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
   693    687   	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
   694    688   typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
   695    689   typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
   696    690   	int flags));
   697         -typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
          691  +typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...));
   698    692   typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
   699    693   	Tcl_Channel chan, char *address, int port));
   700    694   typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
   701    695   typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
   702    696   	struct Tcl_Obj *objPtr));
   703    697   typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
   704    698   typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,

Changes to generic/tclBasic.c.

     9      9    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    10     10    * Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11    * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
    12     12    *
    13     13    * See the file "license.terms" for information on usage and redistribution of
    14     14    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15    *
    16         - * RCS: @(#) $Id: tclBasic.c,v 1.136.2.33 2005/09/09 18:48:40 dgp Exp $
           16  + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.34 2005/09/15 20:58:39 dgp Exp $
    17     17    */
    18     18   
    19     19   #include "tclInt.h"
    20     20   #include "tclCompile.h"
    21     21   #include <float.h>
    22     22   #include <math.h>
    23     23   #include "tommath.h"
................................................................................
  3598   3598       CONST char *command;	/* First character in command that generated
  3599   3599   				 * the error. */
  3600   3600       int length;			/* Number of bytes in command (-1 means use
  3601   3601   				 * all bytes up to first null byte). */
  3602   3602   {
  3603   3603       register CONST char *p;
  3604   3604       Interp *iPtr = (Interp *) interp;
  3605         -    Tcl_Obj *message;
         3605  +    int overflow, limit = 150;
  3606   3606   
  3607   3607       if (iPtr->flags & ERR_ALREADY_LOGGED) {
  3608   3608   	/*
  3609   3609   	 * Someone else has already logged error information for this command;
  3610   3610   	 * we shouldn't add anything more.
  3611   3611   	 */
  3612   3612   
................................................................................
  3620   3620       iPtr->errorLine = 1;
  3621   3621       for (p = script; p != command; p++) {
  3622   3622   	if (*p == '\n') {
  3623   3623   	    iPtr->errorLine++;
  3624   3624   	}
  3625   3625       }
  3626   3626   
  3627         -    if (iPtr->errorInfo == NULL) {
  3628         -	message = Tcl_NewStringObj("\n    while executing\n\"", -1);
  3629         -    } else {
  3630         -	message = Tcl_NewStringObj("\n    invoked from within\n\"", -1);
  3631         -    }
  3632         -    Tcl_IncrRefCount(message);
  3633         -    TclAppendLimitedToObj(message, command, length, 153, NULL);
  3634         -    Tcl_AppendToObj(message, "\"", -1);
  3635         -    TclAppendObjToErrorInfo(interp, message);
  3636         -    Tcl_DecrRefCount(message);
         3627  +    overflow = (length > limit);
         3628  +    TclFormatToErrorInfo(interp, "\n    %s\n\"%.*s%s\"",
         3629  +	    ((iPtr->errorInfo == NULL)
         3630  +	    ? "while executing" : "invoked from within"),
         3631  +	    (overflow ? limit : length), command, (overflow ? "..." : ""));
  3637   3632   }
  3638   3633   
  3639   3634   /*
  3640   3635    *----------------------------------------------------------------------
  3641   3636    *
  3642   3637    * Tcl_EvalTokensStandard --
  3643   3638    *
................................................................................
  3827   3822   		Tcl_IncrRefCount(objv[objectsUsed]);
  3828   3823   		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
  3829   3824   		    int numElements;
  3830   3825   
  3831   3826   		    code = Tcl_ListObjLength(interp,
  3832   3827   			    objv[objectsUsed], &numElements);
  3833   3828   		    if (code == TCL_ERROR) {
  3834         -			/*
  3835         -			 * Attempt to expand a non-list.
  3836         -			 */
  3837         -
  3838         -			Tcl_Obj *msg;
  3839         -			Tcl_Obj *wordNum;
  3840         -
  3841         -			msg = Tcl_NewStringObj("\n    (expanding word ", -1);
  3842         -			TclNewIntObj(wordNum, objectsUsed);
  3843         -			Tcl_IncrRefCount(wordNum);
  3844         -			Tcl_IncrRefCount(msg);
  3845         -			Tcl_AppendObjToObj(msg, wordNum);
  3846         -			Tcl_DecrRefCount(wordNum);
  3847         -			Tcl_AppendToObj(msg, ")", -1);
  3848         -			TclAppendObjToErrorInfo(interp, msg);
  3849         -			Tcl_DecrRefCount(msg);
         3829  +			/* Attempt to expand a non-list. */
         3830  +			TclFormatToErrorInfo(interp,
         3831  +				"\n    (expanding word %d)", objectsUsed);
  3850   3832   			Tcl_DecrRefCount(objv[objectsUsed]);
  3851   3833   			goto error;
  3852   3834   		    }
  3853   3835   		    expandRequested = 1;
  3854   3836   		    expand[objectsUsed] = 1;
  3855   3837   		    objectsNeeded += (numElements ? numElements : 1);
  3856   3838   		} else {
................................................................................
  4232   4214       if (returnCode == TCL_BREAK) {
  4233   4215   	Tcl_AppendResult(interp,
  4234   4216   		"invoked \"break\" outside of a loop", (char *) NULL);
  4235   4217       } else if (returnCode == TCL_CONTINUE) {
  4236   4218   	Tcl_AppendResult(interp,
  4237   4219   		"invoked \"continue\" outside of a loop", (char *) NULL);
  4238   4220       } else {
  4239         -	char buf[30 + TCL_INTEGER_SPACE];
  4240         -
  4241         -	sprintf(buf, "command returned bad code: %d", returnCode);
  4242         -	Tcl_SetResult(interp, buf, TCL_VOLATILE);
         4221  +	Tcl_Obj *objPtr = Tcl_NewObj();
         4222  +	TclObjPrintf(NULL, objPtr, "command returned bad code: %d", returnCode);
         4223  +	Tcl_SetObjResult(interp, objPtr);
  4243   4224       }
  4244   4225   }
  4245   4226   
  4246   4227   /*
  4247   4228    *---------------------------------------------------------------------------
  4248   4229    *
  4249   4230    * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
................................................................................
  4837   4818    *	left in interp->result.
  4838   4819    *
  4839   4820    * Side effects:
  4840   4821    *	Depends on what was done by the command.
  4841   4822    *
  4842   4823    *----------------------------------------------------------------------
  4843   4824    */
  4844         -	/* VARARGS2 */ /* ARGSUSED */
         4825  +	/* ARGSUSED */
  4845   4826   int
  4846         -Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
         4827  +Tcl_VarEval(Tcl_Interp *interp, ...)
  4847   4828   {
  4848         -    Tcl_Interp *interp;
  4849   4829       va_list argList;
  4850   4830       int result;
  4851   4831   
  4852         -    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
         4832  +    va_start(argList, interp);
  4853   4833       result = Tcl_VarEvalVA(interp, argList);
  4854   4834       va_end(argList);
  4855   4835   
  4856   4836       return result;
  4857   4837   }
  4858   4838   
  4859   4839   /*

Changes to generic/tclCkalloc.c.

    10     10    * Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution of
    13     13    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15     15    * This code contributed by Karl Lehenbauer and Mark Diekhans
    16     16    *
    17         - * RCS: @(#) $Id: tclCkalloc.c,v 1.22.2.1 2005/08/02 18:15:12 dgp Exp $
           17  + * RCS: @(#) $Id: tclCkalloc.c,v 1.22.2.2 2005/09/15 20:58:39 dgp Exp $
    18     18    */
    19     19   
    20     20   #include "tclInt.h"
    21     21   
    22     22   #define FALSE	0
    23     23   #define TRUE	1
    24     24   
................................................................................
   839    839   	}
   840    840   	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
   841    841   	    return TCL_ERROR;
   842    842   	}
   843    843   	return TCL_OK;
   844    844       }
   845    845       if (strcmp(argv[1],"info") == 0) {
   846         -	char buf[400];
   847         -	sprintf(buf, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
          846  +	Tcl_Obj *objPtr = Tcl_NewObj();
          847  +	TclObjPrintf(NULL, objPtr, "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10d\n",
   848    848   		"total mallocs", total_mallocs, "total frees", total_frees,
   849    849   		"current packets allocated", current_malloc_packets,
   850    850   		"current bytes allocated", current_bytes_malloced,
   851    851   		"maximum packets allocated", maximum_malloc_packets,
   852    852   		"maximum bytes allocated", maximum_bytes_malloced);
   853         -	Tcl_SetResult(interp, buf, TCL_VOLATILE);
          853  +	Tcl_SetObjResult(interp, objPtr);
   854    854   	return TCL_OK;
   855    855       }
   856    856       if (strcmp(argv[1],"init") == 0) {
   857    857   	if (argc != 3) {
   858    858   	    goto bad_suboption;
   859    859   	}
   860    860   	init_malloced_bodies = (strcmp(argv[2],"on") == 0);

Changes to generic/tclCmdAH.c.

     6      6    *
     7      7    * Copyright (c) 1987-1993 The Regents of the University of California.
     8      8    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
     9      9    *
    10     10    * See the file "license.terms" for information on usage and redistribution of
    11     11    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12    *
    13         - * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.9 2005/09/12 19:12:27 dgp Exp $
           13  + * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.10 2005/09/15 20:58:39 dgp Exp $
    14     14    */
    15     15   
    16     16   #include "tclInt.h"
    17     17   #include <locale.h>
    18     18   
    19     19   #define NEW_FORMAT 1
    20     20   
................................................................................
   183    183       }
   184    184   
   185    185     match:
   186    186       if (body != -1) {
   187    187   	armPtr = caseObjv[body - 1];
   188    188   	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
   189    189   	if (result == TCL_ERROR) {
   190         -	    char msg[100 + TCL_INTEGER_SPACE];
   191         -
   192         -	    arg = TclGetString(armPtr);
   193         -	    sprintf(msg, "\n    (\"%.50s\" arm line %d)", arg,
   194         -		    interp->errorLine);
   195         -	    Tcl_AddObjErrorInfo(interp, msg, -1);
          190  +	    TclFormatToErrorInfo(interp, "\n    (\"%.50s\" arm line %d)",
          191  +		    TclGetString(armPtr), interp->errorLine);
   196    192   	}
   197    193   	return result;
   198    194       }
   199    195   
   200    196       /*
   201    197        * Nothing matched: return nothing.
   202    198        */
................................................................................
   249    245       result = Tcl_EvalObjEx(interp, objv[1], 0);
   250    246   
   251    247       /*
   252    248        * We disable catch in interpreters where the limit has been exceeded.
   253    249        */
   254    250   
   255    251       if (Tcl_LimitExceeded(interp)) {
   256         -	char msg[32 + TCL_INTEGER_SPACE];
   257         -
   258         -	sprintf(msg, "\n    (\"catch\" body line %d)", interp->errorLine);
   259         -	Tcl_AddErrorInfo(interp, msg);
          252  +	TclFormatToErrorInfo(interp, "\n    (\"catch\" body line %d)",
          253  +		interp->errorLine);
   260    254   	return TCL_ERROR;
   261    255       }
   262    256   
   263    257       if (objc >= 3) {
   264    258   	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
   265    259   		Tcl_GetObjResult(interp), 0)) {
   266    260   	    Tcl_ResetResult(interp);
................................................................................
   659    653   	 * object when it decrements its refcount after eval'ing it.
   660    654   	 */
   661    655   
   662    656   	objPtr = Tcl_ConcatObj(objc-1, objv+1);
   663    657   	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
   664    658       }
   665    659       if (result == TCL_ERROR) {
   666         -	char msg[32 + TCL_INTEGER_SPACE];
   667         -
   668         -	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
   669         -	Tcl_AddObjErrorInfo(interp, msg, -1);
          660  +	TclFormatToErrorInfo(interp,"\n    (\"eval\" body line %d)",
          661  +		interp->errorLine);
   670    662       }
   671    663       return result;
   672    664   }
   673    665   
   674    666   /*
   675    667    *----------------------------------------------------------------------
   676    668    *
................................................................................
  1625   1617   	}
  1626   1618   	if (!value) {
  1627   1619   	    break;
  1628   1620   	}
  1629   1621   	result = Tcl_EvalObjEx(interp, objv[4], 0);
  1630   1622   	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
  1631   1623   	    if (result == TCL_ERROR) {
  1632         -		char msg[32 + TCL_INTEGER_SPACE];
  1633         -
  1634         -		sprintf(msg, "\n    (\"for\" body line %d)",interp->errorLine);
  1635         -		Tcl_AddErrorInfo(interp, msg);
         1624  +		TclFormatToErrorInfo(interp, "\n    (\"for\" body line %d)",
         1625  +			interp->errorLine);
  1636   1626   	    }
  1637   1627   	    break;
  1638   1628   	}
  1639   1629   	result = Tcl_EvalObjEx(interp, objv[3], 0);
  1640   1630   	if (result == TCL_BREAK) {
  1641   1631   	    break;
  1642   1632   	} else if (result != TCL_OK) {
................................................................................
  1842   1832   	if (result != TCL_OK) {
  1843   1833   	    if (result == TCL_CONTINUE) {
  1844   1834   		result = TCL_OK;
  1845   1835   	    } else if (result == TCL_BREAK) {
  1846   1836   		result = TCL_OK;
  1847   1837   		break;
  1848   1838   	    } else if (result == TCL_ERROR) {
  1849         -		char msg[32 + TCL_INTEGER_SPACE];
  1850         -
  1851         -		sprintf(msg, "\n    (\"foreach\" body line %d)",
  1852         -			interp->errorLine);
  1853         -		Tcl_AddObjErrorInfo(interp, msg, -1);
         1839  +		TclFormatToErrorInfo(interp,
         1840  +			"\n    (\"foreach\" body line %d)", interp->errorLine);
  1854   1841   		break;
  1855   1842   	    } else {
  1856   1843   		break;
  1857   1844   	    }
  1858   1845   	}
  1859   1846       }
  1860   1847       if (result == TCL_OK) {

Changes to generic/tclCmdIL.c.

    12     12    * Copyright (c) 1998-1999 by Scriptics Corporation.
    13     13    * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
    14     14    * Copyright (c) 2005 Donal K. Fellows.
    15     15    *
    16     16    * See the file "license.terms" for information on usage and redistribution of
    17     17    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    18     18    *
    19         - * RCS: @(#) $Id: tclCmdIL.c,v 1.70.2.8 2005/08/29 18:38:45 dgp Exp $
           19  + * RCS: @(#) $Id: tclCmdIL.c,v 1.70.2.9 2005/09/15 20:58:39 dgp Exp $
    20     20    */
    21     21   
    22     22   #include "tclInt.h"
    23     23   #include "tclRegexp.h"
    24     24   
    25     25   /*
    26     26    * During execution of the "lsort" command, structures of the following type
................................................................................
  3415   3415   	     * their scale is sensible yet, but we at least perform the
  3416   3416   	     * syntactic check here.
  3417   3417   	     */
  3418   3418   
  3419   3419   	    for (j=0 ; j<sortInfo.indexc ; j++) {
  3420   3420   		if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
  3421   3421   			&sortInfo.indexv[j]) != TCL_OK) {
  3422         -		    char buffer[TCL_INTEGER_SPACE];
  3423         -
  3424   3422   		    if (sortInfo.indexc > 1) {
  3425   3423   			ckfree((char *) sortInfo.indexv);
  3426   3424   		    }
  3427         -		    sprintf(buffer, "%d", j);
  3428         -		    Tcl_AddErrorInfo(interp,
  3429         -			    "\n    (-index option item number ");
  3430         -		    Tcl_AddErrorInfo(interp, buffer);
  3431         -		    Tcl_AddErrorInfo(interp, ")");
         3425  +		    TclFormatToErrorInfo(interp,
         3426  +			    "\n    (-index option item number %d)", j);
  3432   3427   		    return TCL_ERROR;
  3433   3428   		}
  3434   3429   	    }
  3435   3430   	    break;
  3436   3431   	}
  3437   3432   	}
  3438   3433       }
................................................................................
  4030   4025   	     * their scale is sensible yet, but we at least perform the
  4031   4026   	     * syntactic check here.
  4032   4027   	     */
  4033   4028   
  4034   4029   	    for (j=0 ; j<sortInfo.indexc ; j++) {
  4035   4030   		if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
  4036   4031   			&sortInfo.indexv[j]) != TCL_OK) {
  4037         -		    char buffer[TCL_INTEGER_SPACE];
  4038         -
  4039   4032   		    if (sortInfo.indexc > 1) {
  4040   4033   			ckfree((char *) sortInfo.indexv);
  4041   4034   		    }
  4042         -		    sprintf(buffer, "%d", j);
  4043         -		    Tcl_AddErrorInfo(interp,
  4044         -			    "\n    (-index option item number ");
  4045         -		    Tcl_AddErrorInfo(interp, buffer);
  4046         -		    Tcl_AddErrorInfo(interp, ")");
         4035  +		    TclFormatToErrorInfo(interp,
         4036  +			    "\n    (-index option item number %d)", j);
  4047   4037   		    return TCL_ERROR;
  4048   4038   		}
  4049   4039   	    }
  4050   4040   	    i++;
  4051   4041   	    break;
  4052   4042   	}
  4053   4043   	case LSORT_INTEGER:

Changes to generic/tclCmdMZ.c.

    11     11    * Copyright (c) 1998-2000 Scriptics Corporation.
    12     12    * Copyright (c) 2002 ActiveState Corporation.
    13     13    * Copyright (c) 2003 Donal K. Fellows.
    14     14    *
    15     15    * See the file "license.terms" for information on usage and redistribution of
    16     16    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    17     17    *
    18         - * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.12 2005/08/29 18:38:45 dgp Exp $
           18  + * RCS: @(#) $Id: tclCmdMZ.c,v 1.115.2.13 2005/09/15 20:58:39 dgp Exp $
    19     19    */
    20     20   
    21     21   #include "tclInt.h"
    22     22   #include "tclRegexp.h"
    23     23   
    24     24   /*
    25     25    *----------------------------------------------------------------------
................................................................................
  2122   2122   		 * with back-division. [Bug #714106]
  2123   2123   		 */
  2124   2124   
  2125   2125   		Tcl_Obj *resultPtr;
  2126   2126   
  2127   2127   		length2 = length1 * count;
  2128   2128   		if ((length2 / count) != length1) {
  2129         -		    char buf[TCL_INTEGER_SPACE+1];
  2130         -
  2131         -		    sprintf(buf, "%d", INT_MAX);
  2132         -		    Tcl_AppendResult(interp,
  2133         -			    "string size overflow, must be less than ",
  2134         -			    buf, (char *) NULL);
         2129  +		    resultPtr = Tcl_NewObj();
         2130  +		    TclObjPrintf(NULL, resultPtr,
         2131  +			    "string size overflow, must be less than %d",
         2132  +			    INT_MAX);
         2133  +		    Tcl_SetObjResult(interp, resultPtr);
  2135   2134   		    return TCL_ERROR;
  2136   2135   		}
  2137   2136   
  2138   2137   		/*
  2139   2138   		 * Include space for the NULL.
  2140   2139   		 */
  2141   2140   
................................................................................
  2530   2529   Tcl_SwitchObjCmd(dummy, interp, objc, objv)
  2531   2530       ClientData dummy;		/* Not used. */
  2532   2531       Tcl_Interp *interp;		/* Current interpreter. */
  2533   2532       int objc;			/* Number of arguments. */
  2534   2533       Tcl_Obj *CONST objv[];	/* Argument objects. */
  2535   2534   {
  2536   2535       int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved, noCase;
         2536  +    int patternLength;
  2537   2537       char *pattern;
  2538   2538       Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
  2539   2539       Tcl_Obj *CONST *savedObjv = objv;
  2540   2540       Tcl_RegExp regExpr = NULL;
  2541   2541   
  2542   2542       /*
  2543   2543        * If you add options that make -e and -g not unique prefixes of -exact or
................................................................................
  2709   2709       }
  2710   2710   
  2711   2711       for (i = 0; i < objc; i += 2) {
  2712   2712   	/*
  2713   2713   	 * See if the pattern matches the string.
  2714   2714   	 */
  2715   2715   
  2716         -	pattern = TclGetString(objv[i]);
         2716  +	pattern = Tcl_GetStringFromObj(objv[i], &patternLength);
  2717   2717   
  2718   2718   	if ((i == objc - 2) && (*pattern == 'd')
  2719   2719   		&& (strcmp(pattern, "default") == 0)) {
  2720   2720   	    Tcl_Obj *emptyObj = NULL;
  2721   2721   
  2722   2722   	    /*
  2723   2723   	     * If either indexVarObj or matchVarObj are non-NULL, we're in
................................................................................
  2884   2884       result = Tcl_EvalObjEx(interp, objv[j], 0);
  2885   2885   
  2886   2886       /*
  2887   2887        * Generate an error message if necessary.
  2888   2888        */
  2889   2889   
  2890   2890       if (result == TCL_ERROR) {
  2891         -	Tcl_Obj *msg = Tcl_NewStringObj("\n    (\"", -1);
  2892         -	Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
  2893         -
  2894         -	Tcl_IncrRefCount(msg);
  2895         -	Tcl_IncrRefCount(errorLine);
  2896         -	TclAppendLimitedToObj(msg, pattern, -1, 50, "");
  2897         -	Tcl_AppendToObj(msg,"\" arm line ", -1);
  2898         -	Tcl_AppendObjToObj(msg, errorLine);
  2899         -	Tcl_DecrRefCount(errorLine);
  2900         -	Tcl_AppendToObj(msg,")", -1);
  2901         -	TclAppendObjToErrorInfo(interp, msg);
  2902         -	Tcl_DecrRefCount(msg);
         2891  +	int limit = 50;
         2892  +	int overflow = (patternLength > limit);
         2893  +	TclFormatToErrorInfo(interp, "\n    (\"%.*s%s\" arm line %d)",
         2894  +		(overflow ? limit : patternLength), pattern,
         2895  +		(overflow ? "..." : ""), interp->errorLine);
  2903   2896       }
  2904   2897       return result;
  2905   2898   }
  2906   2899   
  2907   2900   /*
  2908   2901    *----------------------------------------------------------------------
  2909   2902    *
................................................................................
  3028   3021   	}
  3029   3022   	if (!value) {
  3030   3023   	    break;
  3031   3024   	}
  3032   3025   	result = Tcl_EvalObjEx(interp, objv[2], 0);
  3033   3026   	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
  3034   3027   	    if (result == TCL_ERROR) {
  3035         -		char msg[32 + TCL_INTEGER_SPACE];
  3036         -
  3037         -		sprintf(msg, "\n    (\"while\" body line %d)",
         3028  +		TclFormatToErrorInfo(interp, "\n    (\"while\" body line %d)",
  3038   3029   			interp->errorLine);
  3039         -		Tcl_AddErrorInfo(interp, msg);
  3040   3030   	    }
  3041   3031   	    break;
  3042   3032   	}
  3043   3033       }
  3044   3034       if (result == TCL_BREAK) {
  3045   3035   	result = TCL_OK;
  3046   3036       }

Changes to generic/tclDecls.h.

     4      4    *	Declarations of functions in the platform independent public Tcl API.
     5      5    *
     6      6    * Copyright (c) 1998-1999 by Scriptics Corporation.
     7      7    *
     8      8    * See the file "license.terms" for information on usage and redistribution
     9      9    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10    *
    11         - * RCS: @(#) $Id: tclDecls.h,v 1.107.2.7 2005/08/25 15:46:30 dgp Exp $
           11  + * RCS: @(#) $Id: tclDecls.h,v 1.107.2.8 2005/09/15 20:58:39 dgp Exp $
    12     12    */
    13     13   
    14     14   #ifndef _TCLDECLS
    15     15   #define _TCLDECLS
    16     16   
    17     17   #undef TCL_STORAGE_CLASS
    18     18   #ifdef BUILD_tcl
................................................................................
    51     51   				Tcl_Interp * interp, CONST char * name, 
    52     52   				CONST char * version, int exact, 
    53     53   				ClientData * clientDataPtr));
    54     54   #endif
    55     55   #ifndef Tcl_Panic_TCL_DECLARED
    56     56   #define Tcl_Panic_TCL_DECLARED
    57     57   /* 2 */
    58         -EXTERN void		Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
           58  +EXTERN void		Tcl_Panic _ANSI_ARGS_((CONST char *format, ...));
    59     59   #endif
    60     60   #ifndef Tcl_Alloc_TCL_DECLARED
    61     61   #define Tcl_Alloc_TCL_DECLARED
    62     62   /* 3 */
    63     63   EXTERN char *		Tcl_Alloc _ANSI_ARGS_((unsigned int size));
    64     64   #endif
    65     65   #ifndef Tcl_Free_TCL_DECLARED
................................................................................
   127    127   /* 14 */
   128    128   EXTERN int		Tcl_AppendAllObjTypes _ANSI_ARGS_((
   129    129   				Tcl_Interp * interp, Tcl_Obj * objPtr));
   130    130   #endif
   131    131   #ifndef Tcl_AppendStringsToObj_TCL_DECLARED
   132    132   #define Tcl_AppendStringsToObj_TCL_DECLARED
   133    133   /* 15 */
   134         -EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr));
          134  +EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_((Tcl_Obj *objPtr, ...));
   135    135   #endif
   136    136   #ifndef Tcl_AppendToObj_TCL_DECLARED
   137    137   #define Tcl_AppendToObj_TCL_DECLARED
   138    138   /* 16 */
   139    139   EXTERN void		Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj* objPtr, 
   140    140   				CONST char* bytes, int length));
   141    141   #endif
................................................................................
   457    457   /* 69 */
   458    458   EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp * interp, 
   459    459   				CONST char * element));
   460    460   #endif
   461    461   #ifndef Tcl_AppendResult_TCL_DECLARED
   462    462   #define Tcl_AppendResult_TCL_DECLARED
   463    463   /* 70 */
   464         -EXTERN void		Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
          464  +EXTERN void		Tcl_AppendResult _ANSI_ARGS_((Tcl_Interp *interp, ...));
   465    465   #endif
   466    466   #ifndef Tcl_AsyncCreate_TCL_DECLARED
   467    467   #define Tcl_AsyncCreate_TCL_DECLARED
   468    468   /* 71 */
   469    469   EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc * proc, 
   470    470   				ClientData clientData));
   471    471   #endif
................................................................................
  1446   1446   #define Tcl_SetErrno_TCL_DECLARED
  1447   1447   /* 227 */
  1448   1448   EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
  1449   1449   #endif
  1450   1450   #ifndef Tcl_SetErrorCode_TCL_DECLARED
  1451   1451   #define Tcl_SetErrorCode_TCL_DECLARED
  1452   1452   /* 228 */
  1453         -EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
         1453  +EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_((Tcl_Interp *interp, ...));
  1454   1454   #endif
  1455   1455   #ifndef Tcl_SetMaxBlockTime_TCL_DECLARED
  1456   1456   #define Tcl_SetMaxBlockTime_TCL_DECLARED
  1457   1457   /* 229 */
  1458   1458   EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time * timePtr));
  1459   1459   #endif
  1460   1460   #ifndef Tcl_SetPanicProc_TCL_DECLARED
................................................................................
  1649   1649   				CONST char * frameName, CONST char * part1, 
  1650   1650   				CONST char * part2, CONST char * localName, 
  1651   1651   				int flags));
  1652   1652   #endif
  1653   1653   #ifndef Tcl_VarEval_TCL_DECLARED
  1654   1654   #define Tcl_VarEval_TCL_DECLARED
  1655   1655   /* 260 */
  1656         -EXTERN int		Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
         1656  +EXTERN int		Tcl_VarEval _ANSI_ARGS_((Tcl_Interp *interp, ...));
  1657   1657   #endif
  1658   1658   #ifndef Tcl_VarTraceInfo_TCL_DECLARED
  1659   1659   #define Tcl_VarTraceInfo_TCL_DECLARED
  1660   1660   /* 261 */
  1661   1661   EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp, 
  1662   1662   				CONST char * varName, int flags, 
  1663   1663   				Tcl_VarTraceProc * procPtr, 
................................................................................
  3529   3529   
  3530   3530   typedef struct TclStubs {
  3531   3531       int magic;
  3532   3532       struct TclStubHooks *hooks;
  3533   3533   
  3534   3534       int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */
  3535   3535       CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */
  3536         -    void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */
         3536  +    void (*tcl_Panic) _ANSI_ARGS_((CONST char *format, ...)); /* 2 */
  3537   3537       char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
  3538   3538       void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */
  3539   3539       char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */
  3540   3540       char * (*tcl_DbCkalloc) _ANSI_ARGS_((unsigned int size, CONST char * file, int line)); /* 6 */
  3541   3541       int (*tcl_DbCkfree) _ANSI_ARGS_((char * ptr, CONST char * file, int line)); /* 7 */
  3542   3542       char * (*tcl_DbCkrealloc) _ANSI_ARGS_((char * ptr, unsigned int size, CONST char * file, int line)); /* 8 */
  3543   3543   #if !defined(__WIN32__) /* UNIX */
................................................................................
  3552   3552   #ifdef __WIN32__
  3553   3553       void *reserved10;
  3554   3554   #endif /* __WIN32__ */
  3555   3555       void (*tcl_SetTimer) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 11 */
  3556   3556       void (*tcl_Sleep) _ANSI_ARGS_((int ms)); /* 12 */
  3557   3557       int (*tcl_WaitForEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 13 */
  3558   3558       int (*tcl_AppendAllObjTypes) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 14 */
  3559         -    void (*tcl_AppendStringsToObj) _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr)); /* 15 */
         3559  +    void (*tcl_AppendStringsToObj) _ANSI_ARGS_((Tcl_Obj *objPtr, ...)); /* 15 */
  3560   3560       void (*tcl_AppendToObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 16 */
  3561   3561       Tcl_Obj * (*tcl_ConcatObj) _ANSI_ARGS_((int objc, Tcl_Obj *CONST objv[])); /* 17 */
  3562   3562       int (*tcl_ConvertToType) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_ObjType * typePtr)); /* 18 */
  3563   3563       void (*tcl_DbDecrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 19 */
  3564   3564       void (*tcl_DbIncrRefCount) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 20 */
  3565   3565       int (*tcl_DbIsShared) _ANSI_ARGS_((Tcl_Obj * objPtr, CONST char * file, int line)); /* 21 */
  3566   3566       Tcl_Obj * (*tcl_DbNewBooleanObj) _ANSI_ARGS_((int boolValue, CONST char * file, int line)); /* 22 */
................................................................................
  3607   3607       void (*tcl_SetLongObj) _ANSI_ARGS_((Tcl_Obj * objPtr, long longValue)); /* 63 */
  3608   3608       void (*tcl_SetObjLength) _ANSI_ARGS_((Tcl_Obj * objPtr, int length)); /* 64 */
  3609   3609       void (*tcl_SetStringObj) _ANSI_ARGS_((Tcl_Obj* objPtr, CONST char* bytes, int length)); /* 65 */
  3610   3610       void (*tcl_AddErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message)); /* 66 */
  3611   3611       void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * message, int length)); /* 67 */
  3612   3612       void (*tcl_AllowExceptions) _ANSI_ARGS_((Tcl_Interp * interp)); /* 68 */
  3613   3613       void (*tcl_AppendElement) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * element)); /* 69 */
  3614         -    void (*tcl_AppendResult) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 70 */
         3614  +    void (*tcl_AppendResult) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 70 */
  3615   3615       Tcl_AsyncHandler (*tcl_AsyncCreate) _ANSI_ARGS_((Tcl_AsyncProc * proc, ClientData clientData)); /* 71 */
  3616   3616       void (*tcl_AsyncDelete) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 72 */
  3617   3617       int (*tcl_AsyncInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int code)); /* 73 */
  3618   3618       void (*tcl_AsyncMark) _ANSI_ARGS_((Tcl_AsyncHandler async)); /* 74 */
  3619   3619       int (*tcl_AsyncReady) _ANSI_ARGS_((void)); /* 75 */
  3620   3620       void (*tcl_BackgroundError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 76 */
  3621   3621       char (*tcl_Backslash) _ANSI_ARGS_((CONST char * src, int * readPtr)); /* 77 */
................................................................................
  3785   3785       int (*tcl_ServiceAll) _ANSI_ARGS_((void)); /* 221 */
  3786   3786       int (*tcl_ServiceEvent) _ANSI_ARGS_((int flags)); /* 222 */
  3787   3787       void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */
  3788   3788       void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */
  3789   3789       int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, CONST char * newValue)); /* 225 */
  3790   3790       int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST Tcl_CmdInfo * infoPtr)); /* 226 */
  3791   3791       void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */
  3792         -    void (*tcl_SetErrorCode) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 228 */
         3792  +    void (*tcl_SetErrorCode) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 228 */
  3793   3793       void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */
  3794   3794       void (*tcl_SetPanicProc) _ANSI_ARGS_((Tcl_PanicProc * panicProc)); /* 230 */
  3795   3795       int (*tcl_SetRecursionLimit) _ANSI_ARGS_((Tcl_Interp * interp, int depth)); /* 231 */
  3796   3796       void (*tcl_SetResult) _ANSI_ARGS_((Tcl_Interp * interp, char * result, Tcl_FreeProc * freeProc)); /* 232 */
  3797   3797       int (*tcl_SetServiceMode) _ANSI_ARGS_((int mode)); /* 233 */
  3798   3798       void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */
  3799   3799       void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */
................................................................................
  3817   3817       int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 253 */
  3818   3818       int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 254 */
  3819   3819       void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
  3820   3820       void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
  3821   3821       void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 257 */
  3822   3822       int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 258 */
  3823   3823       int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */
  3824         -    int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */
         3824  +    int (*tcl_VarEval) _ANSI_ARGS_((Tcl_Interp *interp, ...)); /* 260 */
  3825   3825       ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
  3826   3826       ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
  3827   3827       int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char * s, int slen)); /* 263 */
  3828   3828       void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], CONST char * message)); /* 264 */
  3829   3829       int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */
  3830   3830       void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */
  3831   3831       void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */

Changes to generic/tclDictObj.c.

     5      5    *	type and its accessor command.
     6      6    *
     7      7    * Copyright (c) 2002 by Donal K. Fellows.
     8      8    *
     9      9    * See the file "license.terms" for information on usage and redistribution
    10     10    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    11     11    *
    12         - * RCS: @(#) $Id: tclDictObj.c,v 1.27.2.4 2005/08/18 18:18:45 dgp Exp $
           12  + * RCS: @(#) $Id: tclDictObj.c,v 1.27.2.5 2005/09/15 20:58:39 dgp Exp $
    13     13    */
    14     14   
    15     15   #include "tclInt.h"
    16     16   #include "tommath.h"
    17     17   
    18     18   /*
    19     19    * Forward declaration.
................................................................................
  2358   2358   	result = Tcl_EvalObjEx(interp, scriptObj, 0);
  2359   2359   	if (result == TCL_CONTINUE) {
  2360   2360   	    result = TCL_OK;
  2361   2361   	} else if (result != TCL_OK) {
  2362   2362   	    if (result == TCL_BREAK) {
  2363   2363   		result = TCL_OK;
  2364   2364   	    } else if (result == TCL_ERROR) {
  2365         -		char msg[32 + TCL_INTEGER_SPACE];
  2366         -
  2367         -		sprintf(msg, "\n    (\"dict for\" body line %d)",
  2368         -			interp->errorLine);
  2369         -		Tcl_AddObjErrorInfo(interp, msg, -1);
         2365  +		TclFormatToErrorInfo(interp,
         2366  +			"\n    (\"dict for\" body line %d)", interp->errorLine);
  2370   2367   	    }
  2371   2368   	    break;
  2372   2369   	}
  2373   2370   
  2374   2371   	Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
  2375   2372       }
  2376   2373   
................................................................................
  2541   2538   	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
  2542   2539       };
  2543   2540       Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
  2544   2541       Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
  2545   2542       Tcl_DictSearch search;
  2546   2543       int index, varc, done, result, satisfied;
  2547   2544       char *pattern;
  2548         -    char msg[32 + TCL_INTEGER_SPACE];
  2549   2545   
  2550   2546       if (objc < 4) {
  2551   2547   	Tcl_WrongNumArgs(interp, 2, objv, "dictionary filterType ...");
  2552   2548   	return TCL_ERROR;
  2553   2549       }
  2554   2550       if (Tcl_GetIndexFromObj(interp, objv[3], filters, "filterType",
  2555   2551   	     0, &index) != TCL_OK) {
................................................................................
  2706   2702   		 */
  2707   2703   		Tcl_ResetResult(interp);
  2708   2704   		Tcl_DictObjDone(&search);
  2709   2705   	    case TCL_CONTINUE:
  2710   2706   		result = TCL_OK;
  2711   2707   		break;
  2712   2708   	    case TCL_ERROR:
  2713         -		sprintf(msg, "\n    (\"dict filter\" script line %d)",
         2709  +		TclFormatToErrorInfo(interp,
         2710  +			"\n    (\"dict filter\" script line %d)",
  2714   2711   			interp->errorLine);
  2715         -		Tcl_AddObjErrorInfo(interp, msg, -1);
  2716   2712   	    default:
  2717   2713   		goto abnormalResult;
  2718   2714   	    }
  2719   2715   
  2720   2716   	    TclDecrRefCount(keyObj);
  2721   2717   	    TclDecrRefCount(valueObj);
  2722   2718   

Changes to generic/tclExecute.c.

     8      8    * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
     9      9    * Copyright (c) 2002-2005 by Miguel Sofer.
    10     10    * Copyright (c) 2005 by Donal K. Fellows.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution of
    13     13    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15         - * RCS: @(#) $Id: tclExecute.c,v 1.167.2.38 2005/08/25 21:21:33 dgp Exp $
           15  + * RCS: @(#) $Id: tclExecute.c,v 1.167.2.39 2005/09/15 20:58:39 dgp Exp $
    16     16    */
    17     17   
    18     18   #include "tclInt.h"
    19     19   #include "tclCompile.h"
    20     20   #include "tommath.h"
    21     21   
    22     22   #include <math.h>
................................................................................
  6889   6889   	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
  6890   6890   	} else {
  6891   6891   	    s = "floating-point value too large to represent";
  6892   6892   	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
  6893   6893   	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
  6894   6894   	}
  6895   6895       } else {
  6896         -	char msg[64 + TCL_INTEGER_SPACE];
  6897         -
  6898         -	sprintf(msg, "unknown floating-point error, errno = %d", errno);
  6899         -	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
  6900         -	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
         6896  +	Tcl_Obj *objPtr = Tcl_NewObj();
         6897  +	TclObjPrintf(NULL, objPtr,
         6898  +		"unknown floating-point error, errno = %d", errno);
         6899  +	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", 
         6900  +		Tcl_GetString(objPtr), (char *) NULL);
         6901  +	Tcl_SetObjResult(interp, objPtr);
  6901   6902       }
  6902   6903   }
  6903   6904   
  6904   6905   #ifdef TCL_COMPILE_STATS
  6905   6906   /*
  6906   6907    *----------------------------------------------------------------------
  6907   6908    *

Changes to generic/tclIORChan.c.

    11     11    *      See TIP #219 for the specification of this functionality.
    12     12    *
    13     13    * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
    14     14    *
    15     15    * See the file "license.terms" for information on usage and redistribution
    16     16    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    17     17    *
    18         - * RCS: @(#) $Id: tclIORChan.c,v 1.1.2.4 2005/09/12 14:47:16 dgp Exp $
           18  + * RCS: @(#) $Id: tclIORChan.c,v 1.1.2.5 2005/09/15 20:58:39 dgp Exp $
    19     19    */
    20     20   
    21     21   #include <tclInt.h>
    22     22   #include <tclIO.h>
    23     23   #include <assert.h>
    24     24   
    25     25   #ifndef EINVAL
................................................................................
  1719   1719           Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
  1720   1720   	return res;
  1721   1721       }
  1722   1722   
  1723   1723       if ((listc % 2) == 1) {
  1724   1724           /* Odd number of elements is wrong.
  1725   1725   	 */
  1726         -
  1727         -        char buf [20];
  1728         -
  1729         -	sprintf (buf, "%d", listc);
  1730         -	Tcl_ResetResult  (interp);
  1731         -	Tcl_AppendResult (interp,
  1732         -			  "Expected list with even number of elements, got ",
  1733         -			  buf, (listc == 1 ? " element" : " elements"),
  1734         -			  " instead", (char*) NULL);
  1735         -
         1726  +	Tcl_Obj *objPtr = Tcl_NewObj();
         1727  +	Tcl_ResetResult(interp);
         1728  +	TclObjPrintf(NULL, objPtr, "Expected list with even number of "
         1729  +		"elements, got %d element%s instead", listc, 
         1730  +		(listc == 1 ? "" : "s"));
         1731  +	Tcl_SetObjResult(interp, objPtr);
  1736   1732   	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
  1737   1733   	return TCL_ERROR;
  1738   1734       }
  1739   1735   
  1740   1736   
  1741   1737       {
  1742   1738           int len;
................................................................................
  1961   1957        */
  1962   1958   
  1963   1959   #ifdef TCL_THREADS
  1964   1960       TCL_DECLARE_MUTEX (rcCounterMutex)
  1965   1961   #endif
  1966   1962       static unsigned long rcCounter = 0;
  1967   1963   
  1968         -    char     channelName [50];
  1969         -    Tcl_Obj* res = Tcl_NewStringObj ("rc", -1);
         1964  +    Tcl_Obj* res = Tcl_NewObj ();
  1970   1965   
  1971   1966   #ifdef TCL_THREADS
  1972   1967       Tcl_MutexLock (&rcCounterMutex);
  1973   1968   #endif
  1974   1969   
  1975         -    sprintf (channelName, "%lu", (unsigned long) rcCounter);
         1970  +    TclObjPrintf(NULL, res, "rc%lu", rcCounter);
  1976   1971       rcCounter ++;
  1977   1972   
  1978   1973   #ifdef TCL_THREADS
  1979   1974       Tcl_MutexUnlock (&rcCounterMutex);
  1980   1975   #endif
  1981   1976   
  1982         -    Tcl_AppendStringsToObj (res, channelName, (char*) NULL);
  1983   1977       return res;
  1984   1978   }
  1985   1979   
  1986   1980   
  1987   1981   static void
  1988   1982   RcFree (rcPtr)
  1989   1983        ReflectingChannel* rcPtr;

Changes to generic/tclIOUtil.c.

    13     13    * Copyright (c) 1991-1994 The Regents of the University of California.
    14     14    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    15     15    * Copyright (c) 2001-2004 Vincent Darley.
    16     16    *
    17     17    * See the file "license.terms" for information on usage and redistribution of
    18     18    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    19     19    *
    20         - * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.6 2005/09/09 18:48:40 dgp Exp $
           20  + * RCS: @(#) $Id: tclIOUtil.c,v 1.113.2.7 2005/09/15 20:58:39 dgp Exp $
    21     21    */
    22     22   
    23     23   #include "tclInt.h"
    24     24   #ifdef __WIN32__
    25     25   #   include "tclWinInt.h"
    26     26   #endif
    27     27   #include "tclFileSystem.h"
................................................................................
  1808   1808   
  1809   1809       if (result == TCL_RETURN) {
  1810   1810   	result = TclUpdateReturnInfo(iPtr);
  1811   1811       } else if (result == TCL_ERROR) {
  1812   1812   	/*
  1813   1813   	 * Record information telling where the error occurred.
  1814   1814   	 */
  1815         -
  1816         -	Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
  1817         -	Tcl_Obj *msg = Tcl_NewStringObj("\n    (file \"", -1);
  1818   1815   	CONST char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
  1819         -	Tcl_IncrRefCount(msg);
  1820         -	Tcl_IncrRefCount(errorLine);
  1821         -	TclAppendLimitedToObj(msg, pathString, length, 150, "");
  1822         -	Tcl_AppendToObj(msg, "\" line ", -1);
  1823         -	Tcl_AppendObjToObj(msg, errorLine);
  1824         -	Tcl_DecrRefCount(errorLine);
  1825         -	Tcl_AppendToObj(msg, ")", -1);
  1826         -	TclAppendObjToErrorInfo(interp, msg);
  1827         -	Tcl_DecrRefCount(msg);
         1816  +	int limit = 150;
         1817  +	int overflow = (length > limit);
         1818  +
         1819  +	TclFormatToErrorInfo(interp, "\n    (file \"%.*s%s\" line %d)",
         1820  +		(overflow ? limit : length), pathString,
         1821  +		(overflow ? "..." : ""), interp->errorLine);
  1828   1822       }
  1829   1823   
  1830   1824     end:
  1831   1825       Tcl_DecrRefCount(objPtr);
  1832   1826       return result;
  1833   1827   }
  1834   1828   

Changes to generic/tclInt.h.

     8      8    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
     9      9    * Copyright (c) 1998-19/99 by Scriptics Corporation.
    10     10    * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution of
    13     13    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15         - * RCS: @(#) $Id: tclInt.h,v 1.202.2.38 2005/09/09 18:48:40 dgp Exp $
           15  + * RCS: @(#) $Id: tclInt.h,v 1.202.2.39 2005/09/15 20:58:39 dgp Exp $
    16     16    */
    17     17   
    18     18   #ifndef _TCLINT
    19     19   #define _TCLINT
    20     20   
    21     21   /*
    22     22    * Some numerics configuration options
................................................................................
  2034   2034   MODULE_SCOPE void	TclFinalizeNotifier(void);
  2035   2035   MODULE_SCOPE void	TclFinalizeObjects(void);
  2036   2036   MODULE_SCOPE void	TclFinalizePreserve(void);
  2037   2037   MODULE_SCOPE void	TclFinalizeSynchronization(void);
  2038   2038   MODULE_SCOPE void	TclFinalizeThreadData(void);
  2039   2039   MODULE_SCOPE double	TclFloor(mp_int* a);
  2040   2040   MODULE_SCOPE void	TclFormatNaN(double value, char* buffer);
  2041         -MODULE_SCOPE int	TclFormatObj TCL_VARARGS(Tcl_Interp *, arg1);
         2041  +MODULE_SCOPE int	TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
         2042  +			    CONST char *format, ...);
         2043  +MODULE_SCOPE int	TclFormatToErrorInfo(Tcl_Interp *interp,
         2044  +			    CONST char *format, ...);
  2042   2045   MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
  2043   2046   			    CONST char *attributeName, int *indexPtr);
  2044   2047   MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
  2045   2048   MODULE_SCOPE int	TclGetEncodingFromObj(Tcl_Interp *interp,
  2046   2049   			    Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
  2047   2050   MODULE_SCOPE int	TclGetNamespaceFromObj(Tcl_Interp *interp,
  2048   2051   			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
................................................................................
  2092   2095   			    Tcl_Obj* valuePtr);
  2093   2096   MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
  2094   2097   			    Tcl_Obj *CONST objv[], Tcl_Obj **optionsPtrPtr,
  2095   2098   			    int *codePtr, int *levelPtr);
  2096   2099   MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
  2097   2100   			    int objc, Tcl_Obj *CONST objv[],
  2098   2101   			    Tcl_Namespace *nsPtr, int flags);
  2099         -MODULE_SCOPE int	TclObjPrintf TCL_VARARGS(Tcl_Interp *, arg1);
         2102  +MODULE_SCOPE int	TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr,
         2103  +			    CONST char *format, ...);
  2100   2104   MODULE_SCOPE int	TclParseBackslash(CONST char *src,
  2101   2105   			    int numBytes, int *readPtr, char *dst);
  2102   2106   MODULE_SCOPE int	TclParseHex(CONST char *src, int numBytes,
  2103   2107   			    Tcl_UniChar *resultPtr);
  2104   2108   MODULE_SCOPE int	TclParseNumber(Tcl_Interp* interp, Tcl_Obj* objPtr,
  2105   2109   			    CONST char* type, CONST char* string,
  2106   2110   			    size_t length, CONST char** endPtrPtr, int flags);
................................................................................
  2156   2160   MODULE_SCOPE ClientData	TclpGetNativeCwd(ClientData clientData);
  2157   2161   MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
  2158   2162   MODULE_SCOPE Tcl_Obj*	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
  2159   2163   			    int linkType);
  2160   2164   MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
  2161   2165   MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
  2162   2166   			    Tcl_PathPart portion);
  2163         -MODULE_SCOPE void	TclpPanic TCL_VARARGS(CONST char *, format);
         2167  +MODULE_SCOPE void	TclpPanic(CONST char *format, ...);
  2164   2168   MODULE_SCOPE char *	TclpReadlink(CONST char *fileName,
  2165   2169   			    Tcl_DString *linkPtr);
  2166   2170   MODULE_SCOPE void	TclpReleaseFile(TclFile file);
  2167   2171   MODULE_SCOPE void	TclpSetInterfaces(void);
  2168   2172   MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
  2169   2173   MODULE_SCOPE void	TclpUnloadFile(Tcl_LoadHandle loadHandle);
  2170   2174   MODULE_SCOPE VOID *	TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);

Changes to generic/tclMain.c.

     6      6    * Copyright (c) 1988-1994 The Regents of the University of California.
     7      7    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
     8      8    * Copyright (c) 2000 Ajuba Solutions.
     9      9    *
    10     10    * See the file "license.terms" for information on usage and redistribution of
    11     11    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12    *
    13         - * RCS: @(#) $Id: tclMain.c,v 1.30.2.1 2005/08/02 18:16:01 dgp Exp $
           13  + * RCS: @(#) $Id: tclMain.c,v 1.30.2.2 2005/09/15 20:58:39 dgp Exp $
    14     14    */
    15     15   
    16     16   #include "tclInt.h"
    17     17   
    18     18   #undef TCL_STORAGE_CLASS
    19     19   #define TCL_STORAGE_CLASS DLLEXPORT
    20     20   
................................................................................
   651    651       if (commandPtr != NULL) {
   652    652   	Tcl_DecrRefCount(commandPtr);
   653    653       }
   654    654   
   655    655       /*
   656    656        * Rather than calling exit, invoke the "exit" command so that users can
   657    657        * replace "exit" with some other command to do additional cleanup on
   658         -     * exit. The Tcl_Eval call should never return.
          658  +     * exit. The Tcl_EvalObjEx call should never return.
   659    659        */
   660    660   
   661    661       if (!Tcl_InterpDeleted(interp)) {
   662    662   	if (!Tcl_LimitExceeded(interp)) {
   663         -	    char buffer[TCL_INTEGER_SPACE + 5];
   664         -
   665         -	    sprintf(buffer, "exit %d", exitCode);
   666         -	    Tcl_Eval(interp, buffer);
          663  +	    Tcl_Obj *cmd = Tcl_NewObj();
          664  +	    TclObjPrintf(NULL, cmd, "exit %d", exitCode);
          665  +	    Tcl_IncrRefCount(cmd);
          666  +	    Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
          667  +	    Tcl_DecrRefCount(cmd);
   667    668   	}
   668    669   
   669    670   	/*
   670         -	 * If Tcl_Eval returns, trying to eval [exit], something unusual is
   671         -	 * happening. Maybe interp has been deleted; maybe [exit] was
          671  +	 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
          672  +	 * is happening. Maybe interp has been deleted; maybe [exit] was
   672    673   	 * redefined, maybe we've blown up because of an exceeded limit. We
   673    674   	 * still want to cleanup and exit.
   674    675   	 */
   675    676   
   676    677   	if (!Tcl_InterpDeleted(interp)) {
   677    678   	    Tcl_DeleteInterp(interp);
   678    679   	}

Changes to generic/tclNamesp.c.

    17     17    *   Michael J. McLennan
    18     18    *   Bell Labs Innovations for Lucent Technologies
    19     19    *   [email protected]
    20     20    *
    21     21    * See the file "license.terms" for information on usage and redistribution
    22     22    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    23     23    *
    24         - * RCS: @(#) $Id: tclNamesp.c,v 1.66.2.9 2005/08/29 18:38:45 dgp Exp $
           24  + * RCS: @(#) $Id: tclNamesp.c,v 1.66.2.10 2005/09/15 20:58:39 dgp Exp $
    25     25    */
    26     26   
    27     27   #include "tclInt.h"
    28     28   
    29     29   /*
    30     30    * Initial size of stack allocated space for tail list - used when resetting
    31     31    * shadowed command references in the functin: TclResetShadowedCmdRefs.
................................................................................
  3399   3399   	 */
  3400   3400   
  3401   3401   	objPtr = Tcl_ConcatObj(objc-3, objv+3);
  3402   3402   	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
  3403   3403       }
  3404   3404   
  3405   3405       if (result == TCL_ERROR) {
  3406         -	Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
  3407         -	Tcl_Obj *msg = Tcl_NewStringObj("\n    (in namespace eval \"", -1);
  3408         -	Tcl_IncrRefCount(errorLine);
  3409         -	Tcl_IncrRefCount(msg);
  3410         -	TclAppendLimitedToObj(msg, namespacePtr->fullName, -1, 200, "");
  3411         -	Tcl_AppendToObj(msg, "\" script line ", -1);
  3412         -	Tcl_AppendObjToObj(msg, errorLine);
  3413         -	Tcl_DecrRefCount(errorLine);
  3414         -	Tcl_AppendToObj(msg, ")", -1);
  3415         -	TclAppendObjToErrorInfo(interp, msg);
  3416         -	Tcl_DecrRefCount(msg);
         3406  +	int length = strlen(namespacePtr->fullName);
         3407  +	int limit = 200;
         3408  +	int overflow = (length > limit);
         3409  +
         3410  +	TclFormatToErrorInfo(interp,
         3411  +		"\n    (in namespace eval \"%.*s%s\" script line %d)",
         3412  +		(overflow ? limit : length), namespacePtr->fullName,
         3413  +		(overflow ? "..." : ""), interp->errorLine);
  3417   3414       }
  3418   3415   
  3419   3416       /*
  3420   3417        * Restore the previous "current" namespace.
  3421   3418        */
  3422   3419   
  3423   3420       TclPopStackFrame(interp);
................................................................................
  3812   3809   	concatObjv[1] = listPtr;
  3813   3810   	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
  3814   3811   	result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
  3815   3812   	Tcl_DecrRefCount(listPtr);    /* we're done with the list object */
  3816   3813       }
  3817   3814   
  3818   3815       if (result == TCL_ERROR) {
  3819         -	Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
  3820         -	Tcl_Obj *msg = Tcl_NewStringObj("\n    (in namespace inscope \"", -1);
         3816  +	int length = strlen(namespacePtr->fullName);
         3817  +	int limit = 200;
         3818  +	int overflow = (length > limit);
  3821   3819   
  3822         -	Tcl_IncrRefCount(errorLine);
  3823         -	Tcl_IncrRefCount(msg);
  3824         -	TclAppendLimitedToObj(msg, namespacePtr->fullName, -1, 200, "");
  3825         -	Tcl_AppendToObj(msg, "\" script line ", -1);
  3826         -	Tcl_AppendObjToObj(msg, errorLine);
  3827         -	Tcl_DecrRefCount(errorLine);
  3828         -	Tcl_AppendToObj(msg, ")", -1);
  3829         -	TclAppendObjToErrorInfo(interp, msg);
  3830         -	Tcl_DecrRefCount(msg);
         3820  +	TclFormatToErrorInfo(interp,
         3821  +		"\n    (in namespace inscope \"%.*s%s\" script line %d)",
         3822  +		(overflow ? limit : length), namespacePtr->fullName,
         3823  +		(overflow ? "..." : ""), interp->errorLine);
  3831   3824       }
  3832   3825   
  3833   3826       /*
  3834   3827        * Restore the previous "current" namespace.
  3835   3828        */
  3836   3829   
  3837   3830       TclPopStackFrame(interp);

Changes to generic/tclPanic.c.

     8      8    * Copyright (c) 1988-1993 The Regents of the University of California.
     9      9    * Copyright (c) 1994 Sun Microsystems, Inc.
    10     10    * Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution of
    13     13    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15         - * RCS: @(#) $Id: tclPanic.c,v 1.5.2.1 2005/08/02 18:16:04 dgp Exp $
           15  + * RCS: @(#) $Id: tclPanic.c,v 1.5.2.2 2005/09/15 20:58:40 dgp Exp $
    16     16    */
    17     17   
    18     18   #include "tclInt.h"
    19     19   
    20     20   /*
    21     21    * The panicProc variable contains a pointer to an application specific panic
    22     22    * procedure.
................................................................................
   116    116    *
   117    117    * Side effects:
   118    118    *	The process dies, entering the debugger if possible.
   119    119    *
   120    120    *----------------------------------------------------------------------
   121    121    */
   122    122   
   123         -	/* VARARGS ARGSUSED */
          123  +	/* ARGSUSED */
   124    124   void
   125         -Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
          125  +Tcl_Panic(CONST char *format, ...)
   126    126   {
   127    127       va_list argList;
   128         -    CONST char *format;
   129    128   
   130         -    format = TCL_VARARGS_START(CONST char *,arg1,argList);
          129  +    va_start(argList, format);
   131    130       Tcl_PanicVA(format, argList);
   132    131       va_end (argList);
   133    132   }
   134    133   
   135    134   /*
   136    135    * Local Variables:
   137    136    * mode: c
   138    137    * c-basic-offset: 4
   139    138    * fill-column: 78
   140    139    * End:
   141    140    */

Changes to generic/tclProc.c.

     6      6    *
     7      7    * Copyright (c) 1987-1993 The Regents of the University of California.
     8      8    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
     9      9    *
    10     10    * See the file "license.terms" for information on usage and redistribution of
    11     11    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12    *
    13         - * RCS: @(#) $Id: tclProc.c,v 1.66.2.6 2005/08/19 21:55:21 dgp Exp $
           13  + * RCS: @(#) $Id: tclProc.c,v 1.66.2.7 2005/09/15 20:58:40 dgp Exp $
    14     14    */
    15     15   
    16     16   #include "tclInt.h"
    17     17   #include "tclCompile.h"
    18     18   
    19     19   /*
    20     20    * Prototypes for static functions in this file
................................................................................
   333    333       result = Tcl_SplitList(interp, args, &numArgs, &argArray);
   334    334       if (result != TCL_OK) {
   335    335   	goto procError;
   336    336       }
   337    337   
   338    338       if (precompiled) {
   339    339   	if (numArgs > procPtr->numArgs) {
   340         -	    char buf[40 + TCL_INTEGER_SPACE + TCL_INTEGER_SPACE];
   341         -	    sprintf(buf, "%d entries, precompiled header expects %d",
   342         -		    numArgs, procPtr->numArgs);
   343         -	    Tcl_AppendResult(interp, "procedure \"", procName,
   344         -		    "\": arg list contains ", buf, NULL);
          340  +	    Tcl_Obj *objPtr = Tcl_NewObj();
          341  +	    TclObjPrintf(NULL, objPtr,
          342  +		    "procedure \"%s\": arg list contains %d entries, "
          343  +		    "precompiled header expects %d", procName, numArgs,
          344  +		    procPtr->numArgs);
          345  +	    Tcl_SetObjResult(interp, objPtr);
   345    346   	    goto procError;
   346    347   	}
   347    348   	localPtr = procPtr->firstLocalPtr;
   348    349       } else {
   349    350   	procPtr->numArgs = numArgs;
   350    351   	procPtr->numCompiledLocals = numArgs;
   351    352       }
................................................................................
   424    425   	    if ((localPtr->nameLength != nameLength)
   425    426   		    || (strcmp(localPtr->name, fieldValues[0]))
   426    427   		    || (localPtr->frameIndex != i)
   427    428   		    || ((localPtr->flags & ~VAR_UNDEFINED)
   428    429   			    != (VAR_SCALAR | VAR_ARGUMENT))
   429    430   		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
   430    431   		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
   431         -		char buf[40 + TCL_INTEGER_SPACE];
   432         -
          432  +		Tcl_Obj *objPtr = Tcl_NewObj();
          433  +		TclObjPrintf(NULL, objPtr,
          434  +			"procedure \"%s\": formal parameter %d is "
          435  +			"inconsistent with precompiled body", procName, i);
          436  +		Tcl_SetObjResult(interp, objPtr);
   433    437   		ckfree((char *) fieldValues);
   434         -		sprintf(buf, "%d is inconsistent with precompiled body", i);
   435         -		Tcl_AppendResult(interp, "procedure \"", procName,
   436         -			"\": formal parameter ", buf, (char *) NULL);
   437    438   		goto procError;
   438    439   	    }
   439    440   
   440    441   	    /*
   441    442   	     * compare the default value if any
   442    443   	     */
   443    444   
   444    445   	    if (localPtr->defValuePtr != NULL) {
   445    446   		int tmpLength;
   446    447   		char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
   447    448   			&tmpLength);
   448    449   		if ((valueLength != tmpLength) ||
   449    450   			strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
   450         -		    Tcl_AppendResult(interp, "procedure \"", procName,
   451         -			    "\": formal parameter \"", fieldValues[0],
   452         -			    "\" has default value inconsistent with ",
   453         -			    "precompiled body", (char *) NULL);
          451  +		    Tcl_Obj *objPtr = Tcl_NewObj();
          452  +
          453  +		    TclObjPrintf(NULL, objPtr,
          454  +			    "procedure \"%s\": formal parameter \"%s\" has "
          455  +			    "default value inconsistent with precompiled body",
          456  +			    procName, fieldValues[0]);
          457  +		    Tcl_SetObjResult(interp, objPtr);
   454    458   		    ckfree((char *) fieldValues);
   455    459   		    goto procError;
   456    460   		}
   457    461   		if ((i == numArgs - 1)
   458    462   			&& (localPtr->nameLength == 4)
   459    463   			&& (localPtr->name[0] == 'a')
   460    464   			&& (strcmp(localPtr->name, "args") == 0)) {
................................................................................
   814    818   
   815    819   	Tcl_Obj *objPtr;
   816    820   
   817    821   	objPtr = Tcl_ConcatObj(objc, objv);
   818    822   	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
   819    823       }
   820    824       if (result == TCL_ERROR) {
   821         -	char msg[32 + TCL_INTEGER_SPACE];
   822         -	sprintf(msg, "\n    (\"uplevel\" body line %d)", interp->errorLine);
   823         -	Tcl_AddObjErrorInfo(interp, msg, -1);
          825  +	TclFormatToErrorInfo(interp, "\n    (\"uplevel\" body line %d)",
          826  +		interp->errorLine);
   824    827       }
   825    828   
   826    829       /*
   827    830        * Restore the variable frame, and return.
   828    831        */
   829    832   
   830    833       iPtr->varFramePtr = savedVarFramePtr;
................................................................................
  1492   1495   	    TclPopStackFrame(interp);
  1493   1496   	}
  1494   1497   
  1495   1498    	iPtr->compiledProcPtr = saveProcPtr;
  1496   1499   
  1497   1500    	if (result != TCL_OK) {
  1498   1501    	    if (result == TCL_ERROR) {
  1499         -		Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
  1500         -		Tcl_Obj *message =
  1501         -			Tcl_NewStringObj("\n    (compiling ", -1);
         1502  +		int length = strlen(procName);
         1503  +		int limit = 50;
         1504  +		int overflow = (length > limit);
  1502   1505   
  1503         -		Tcl_IncrRefCount(message);
  1504         -		Tcl_AppendStringsToObj(message, description, " \"", NULL);
  1505         -		TclAppendLimitedToObj(message, procName, -1, 50, NULL);
  1506         -		Tcl_AppendToObj(message, "\", line ", -1);
  1507         -		Tcl_AppendObjToObj(message, errorLine);
  1508         -		Tcl_DecrRefCount(errorLine);
  1509         -		Tcl_AppendToObj(message, ")", -1);
  1510         - 		TclAppendObjToErrorInfo(interp, message);
  1511         -		Tcl_DecrRefCount(message);
         1506  +		TclFormatToErrorInfo(interp,
         1507  +			"\n    (compiling %s \"%.*s%s\", line %d)",
         1508  +			description, (overflow ? limit : length), procName,
         1509  +			(overflow ? "..." : ""), interp->errorLine);
  1512   1510   	    }
  1513   1511    	    return result;
  1514   1512    	}
  1515   1513       } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
  1516   1514   	/*
  1517   1515   	 * The resolver epoch has changed, but we only need to invalidate the
  1518   1516   	 * resolver cache.
................................................................................
  1550   1548   				 * called and returned returnCode. */
  1551   1549       char *procName;		/* Name of the procedure. Used for error
  1552   1550   				 * messages and trace information. */
  1553   1551       int nameLen;		/* Number of bytes in procedure's name. */
  1554   1552       int returnCode;		/* The unexpected result code. */
  1555   1553   {
  1556   1554       Interp *iPtr = (Interp *) interp;
  1557         -    Tcl_Obj *message, *errorLine;
         1555  +    int overflow, limit = 60;
  1558   1556   
  1559   1557       if (returnCode == TCL_OK) {
  1560   1558   	return TCL_OK;
  1561   1559       }
  1562   1560       if ((returnCode > TCL_CONTINUE) || (returnCode < TCL_OK)) {
  1563   1561   	return returnCode;
  1564   1562       }
................................................................................
  1567   1565       }
  1568   1566       if (returnCode != TCL_ERROR) {
  1569   1567   	Tcl_ResetResult(interp);
  1570   1568   	Tcl_AppendResult(interp, "invoked \"",
  1571   1569   		((returnCode == TCL_BREAK) ? "break" : "continue"),
  1572   1570   		"\" outside of a loop", NULL);
  1573   1571       }
  1574         -    errorLine = Tcl_NewIntObj(interp->errorLine);
  1575         -    message = Tcl_NewStringObj("\n    (procedure \"", -1);
  1576         -    Tcl_IncrRefCount(message);
  1577         -    TclAppendLimitedToObj(message, procName, nameLen, 60, NULL);
  1578         -    Tcl_AppendToObj(message, "\" line ", -1);
  1579         -    Tcl_AppendObjToObj(message, errorLine);
  1580         -    Tcl_DecrRefCount(errorLine);
  1581         -    Tcl_AppendToObj(message, ")", -1);
  1582         -    TclAppendObjToErrorInfo(interp, message);
  1583         -    Tcl_DecrRefCount(message);
         1572  +    overflow = (nameLen > limit);
         1573  +    TclFormatToErrorInfo(interp, "\n    (procedure \"%.*s%s\" line %d)",
         1574  +	    (overflow ? limit : nameLen), procName,
         1575  +	    (overflow ? "..." : ""), interp->errorLine);
  1584   1576       return TCL_ERROR;
  1585   1577   }
  1586   1578   
  1587   1579   /*
  1588   1580    *----------------------------------------------------------------------
  1589   1581    *
  1590   1582    * TclProcDeleteProc --

Changes to generic/tclResult.c.

     4      4    *	This file contains code to manage the interpreter result.
     5      5    *
     6      6    * Copyright (c) 1997 by Sun Microsystems, Inc.
     7      7    *
     8      8    * See the file "license.terms" for information on usage and redistribution of
     9      9    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10    *
    11         - * RCS: @(#) $Id: tclResult.c,v 1.23.2.4 2005/09/09 18:48:40 dgp Exp $
           11  + * RCS: @(#) $Id: tclResult.c,v 1.23.2.5 2005/09/15 20:58:40 dgp Exp $
    12     12    */
    13     13   
    14     14   #include "tclInt.h"
    15     15   
    16     16   /*
    17     17    * Indices of the standard return options dictionary keys.
    18     18    */
................................................................................
   659    659    *	If the string result is non-empty, the object result forced to be a
   660    660    *	duplicate of it first. There will be a string result afterwards.
   661    661    *
   662    662    *----------------------------------------------------------------------
   663    663    */
   664    664   
   665    665   void
   666         -Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
          666  +Tcl_AppendResult(Tcl_Interp *interp, ...)
   667    667   {
   668         -    Tcl_Interp *interp;
   669    668       va_list argList;
   670    669   
   671         -    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
          670  +    va_start(argList, interp);
   672    671       Tcl_AppendResultVA(interp, argList);
   673    672       va_end(argList);
   674    673   }
   675    674   
   676    675   /*
   677    676    *----------------------------------------------------------------------
   678    677    *
................................................................................
  1026   1025    *	The errorCode field of the interp is modified to hold all of the
  1027   1026    *	arguments to this function, in a list form with each argument becoming
  1028   1027    *	one element of the list.
  1029   1028    *
  1030   1029    *----------------------------------------------------------------------
  1031   1030    */
  1032   1031   
  1033         -	/* VARARGS2 */
  1034   1032   void
  1035         -Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
         1033  +Tcl_SetErrorCode(Tcl_Interp *interp, ...)
  1036   1034   {
  1037         -    Tcl_Interp *interp;
  1038   1035       va_list argList;
  1039   1036   
  1040   1037       /*
  1041   1038        * Scan through the arguments one at a time, appending them to the
  1042   1039        * errorCode field as list elements.
  1043   1040        */
  1044   1041   
  1045         -    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
         1042  +    va_start(argList, interp);
  1046   1043       Tcl_SetErrorCodeVA(interp, argList);
  1047   1044       va_end(argList);
  1048   1045   }
  1049   1046   
  1050   1047   /*
  1051   1048    *----------------------------------------------------------------------
  1052   1049    *

Changes to generic/tclStringObj.c.

    29     29    *
    30     30    * Copyright (c) 1995-1997 Sun Microsystems, Inc.
    31     31    * Copyright (c) 1999 by Scriptics Corporation.
    32     32    *
    33     33    * See the file "license.terms" for information on usage and redistribution of
    34     34    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    35     35    *
    36         - * RCS: @(#) $Id: tclStringObj.c,v 1.35.2.8 2005/09/12 19:39:01 dgp Exp $ */
           36  + * RCS: @(#) $Id: tclStringObj.c,v 1.35.2.9 2005/09/15 20:58:40 dgp Exp $ */
    37     37   
    38     38   #include "tclInt.h"
    39     39   #include "tommath.h"
    40     40   
    41     41   /*
    42     42    * Prototypes for functions defined later in this file:
    43     43    */
................................................................................
    50     50   			    int numChars));
    51     51   static void		AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
    52     52   			    CONST char *bytes, int numBytes));
    53     53   static void		AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
    54     54   			    CONST char *bytes, int numBytes));
    55     55   static void		FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
    56     56   static int		FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp,
           57  +			    Tcl_Obj *objPtr, CONST char *format,
    57     58   			    va_list argList));
    58     59   static int		ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp,
           60  +			    Tcl_Obj *objPtr, CONST char *format,
    59     61   			    va_list argList));
    60     62   static void		FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
    61     63   static void		DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
    62     64   			    Tcl_Obj *copyPtr));
    63     65   static int		SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
    64     66   			    Tcl_Obj *objPtr));
    65     67   static void		UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
................................................................................
  1661   1663    *	The contents of all the string arguments are appended to the string
  1662   1664    *	representation of objPtr.
  1663   1665    *
  1664   1666    *----------------------------------------------------------------------
  1665   1667    */
  1666   1668   
  1667   1669   void
  1668         -Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
         1670  +Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
  1669   1671   {
  1670         -    register Tcl_Obj *objPtr;
  1671   1672       va_list argList;
  1672   1673   
  1673         -    objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
         1674  +    va_start(argList, objPtr);
  1674   1675       Tcl_AppendStringsToObjVA(objPtr, argList);
  1675   1676       va_end(argList);
  1676   1677   }
  1677   1678   
  1678   1679   /*
  1679   1680    *----------------------------------------------------------------------
  1680   1681    *
................................................................................
  1692   1693    * Side effects:
  1693   1694    *	None.
  1694   1695    *
  1695   1696    *----------------------------------------------------------------------
  1696   1697    */
  1697   1698   
  1698   1699   int
  1699         -TclAppendFormattedObjs(interp, baseObj, format, objc, objv)
         1700  +TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
  1700   1701       Tcl_Interp *interp;
  1701         -    Tcl_Obj *baseObj;
         1702  +    Tcl_Obj *appendObj;
  1702   1703       CONST char *format;
  1703   1704       int objc;
  1704   1705       Tcl_Obj *CONST objv[];
  1705   1706   {
  1706   1707       CONST char *span = format;
  1707   1708       int numBytes = 0;
  1708   1709       int objIndex = 0;
  1709   1710       int gotXpg = 0, gotSequential = 0;
  1710         -    Tcl_Obj *appendObj = Tcl_NewObj();
         1711  +    int originalLength;
  1711   1712       CONST char *msg;
  1712   1713       CONST char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers";
  1713   1714       CONST char *badIndex[2] = {
  1714   1715   	"not enough arguments for all format specifiers",
  1715   1716   	"\"%n$\" argument index out of range"
  1716   1717       };
  1717   1718   
  1718         -    if (Tcl_IsShared(baseObj)) {
         1719  +    if (Tcl_IsShared(appendObj)) {
  1719   1720   	Tcl_Panic("TclAppendFormattedObjs called with shared object");
  1720   1721       }
         1722  +    Tcl_GetStringFromObj(appendObj, &originalLength);
  1721   1723   
  1722         -    Tcl_IncrRefCount(appendObj);
  1723   1724       /* format string is NUL-terminated */
  1724   1725       while (*format != '\0') {
  1725   1726   	char *end;
  1726   1727   	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
  1727   1728   	int width, gotPrecision, precision, useShort, useWide, useBig;
  1728   1729   	int newXpg, numChars, allocSegment = 0;
  1729   1730   	Tcl_Obj *segment;
................................................................................
  2231   2232   	objIndex += gotSequential;
  2232   2233       }
  2233   2234       if (numBytes) {
  2234   2235   	Tcl_AppendToObj(appendObj, span, numBytes);
  2235   2236   	numBytes = 0;
  2236   2237       }
  2237   2238   
  2238         -    Tcl_AppendObjToObj(baseObj, appendObj);
  2239         -    Tcl_DecrRefCount(appendObj);
  2240   2239       return TCL_OK;
  2241   2240   
  2242   2241     errorMsg:
  2243   2242       if (interp != NULL) {
  2244   2243   	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
  2245   2244       }
  2246   2245     error:
  2247         -    Tcl_DecrRefCount(appendObj);
         2246  +    Tcl_SetObjLength(appendObj, originalLength);
  2248   2247       return TCL_ERROR;
  2249   2248   }
  2250   2249   
  2251   2250   /*
  2252   2251    *---------------------------------------------------------------------------
  2253   2252    *
  2254   2253    * FormatObjVA --
................................................................................
  2262   2261    * Side effects:
  2263   2262    *	Reallocates the String internal rep.
  2264   2263    *
  2265   2264    *---------------------------------------------------------------------------
  2266   2265    */
  2267   2266   
  2268   2267   static int
  2269         -FormatObjVA(interp, argList)
  2270         -    Tcl_Interp *interp;
  2271         -    va_list argList;
         2268  +FormatObjVA(Tcl_Interp *interp,
         2269  +    Tcl_Obj *objPtr,
         2270  +    CONST char *format,
         2271  +    va_list argList)
  2272   2272   {
  2273   2273       int code, objc;
  2274   2274       Tcl_Obj **objv, *element, *list = Tcl_NewObj();
  2275         -    CONST char *format;
  2276         -    Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
  2277         -
  2278         -    if (objPtr == NULL) {
  2279         -	Tcl_Panic("TclFormatObj: no Tcl_Obj to append to");
  2280         -    }
  2281         -
  2282         -    format = va_arg(argList, CONST char *);
  2283         -    if (format == NULL) {
  2284         -	Tcl_Panic("TclFormatObj: no format string argument");
  2285         -    }
  2286   2275   
  2287   2276       Tcl_IncrRefCount(list);
  2288   2277       element = va_arg(argList, Tcl_Obj *);
  2289   2278       while (element != NULL) {
  2290   2279   	Tcl_ListObjAppendElement(NULL, list, element);
  2291   2280   	element = va_arg(argList, Tcl_Obj *);
  2292   2281       }
................................................................................
  2307   2296    * Side effects:
  2308   2297    * 	None.
  2309   2298    *
  2310   2299    *---------------------------------------------------------------------------
  2311   2300    */
  2312   2301   
  2313   2302   int
  2314         -TclFormatObj TCL_VARARGS_DEF(Tcl_Interp *,arg1)
         2303  +TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
  2315   2304   {
  2316   2305       va_list argList;
  2317   2306       int result;
  2318         -    Tcl_Interp *interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
  2319         -    result = FormatObjVA(interp, argList);
         2307  +
         2308  +    va_start(argList, format);
         2309  +    result = FormatObjVA(interp, objPtr, format, argList);
  2320   2310       va_end(argList);
  2321   2311       return result;
  2322   2312   }
  2323   2313   
  2324   2314   /*
  2325   2315    *---------------------------------------------------------------------------
  2326   2316    *
................................................................................
  2330   2320    *
  2331   2321    * Side effects:
  2332   2322    *
  2333   2323    *---------------------------------------------------------------------------
  2334   2324    */
  2335   2325   
  2336   2326   static int
  2337         -ObjPrintfVA(interp, argList)
  2338         -    Tcl_Interp *interp;
  2339         -    va_list argList;
         2327  +ObjPrintfVA(
         2328  +    Tcl_Interp *interp,
         2329  +    Tcl_Obj *objPtr,
         2330  +    CONST char *format,
         2331  +    va_list argList)
  2340   2332   {
  2341   2333       int code, objc;
  2342   2334       Tcl_Obj **objv, *list = Tcl_NewObj();
  2343         -    CONST char *format, *p;
  2344         -    Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
         2335  +    CONST char *p;
         2336  +    char *end;
  2345   2337   
  2346         -    if (objPtr == NULL) {
  2347         -	Tcl_Panic("TclObjPrintf: no Tcl_Obj to append to");
  2348         -    }
  2349         -
  2350         -    p = format = va_arg(argList, CONST char *);
  2351         -    if (format == NULL) {
  2352         -	Tcl_Panic("TclObjPrintf: no format string argument");
  2353         -    }
  2354         -
         2338  +    p = format;
  2355   2339       Tcl_IncrRefCount(list);
  2356   2340       while (*p != '\0') {
  2357         -	int size = 0;
  2358         -	int seekingConversion = 1;
         2341  +	int size = 0, seekingConversion = 1, gotPrecision = 0;
         2342  +	int lastNum = -1, numBytes = -1;
         2343  +
  2359   2344   	if (*p++ != '%') {
  2360   2345   	    continue;
  2361   2346   	}
  2362   2347   	if (*p == '%') {
  2363   2348   	    p++;
  2364   2349   	    continue;
  2365   2350   	}
  2366   2351   	do {
  2367   2352   	    switch (*p) {
  2368   2353   
  2369   2354   	    case '\0':
  2370   2355   		seekingConversion = 0;
  2371   2356   		break;
  2372         -	    case 's':
  2373         -		Tcl_ListObjAppendElement(NULL, list, Tcl_NewStringObj(
  2374         -			va_arg(argList, char *), -1));
         2357  +	    case 's': {
         2358  +		char *bytes = va_arg(argList, char *);
  2375   2359   		seekingConversion = 0;
         2360  +		if (gotPrecision) {
         2361  +		    char *end = bytes + lastNum;
         2362  +		    char *q = bytes;
         2363  +		    while ((q < end) && (*q != '\0')) {
         2364  +			q++;
         2365  +		    }
         2366  +		    numBytes = (int)(q - bytes);
         2367  +		}
         2368  +		Tcl_ListObjAppendElement(NULL, list,
         2369  +			Tcl_NewStringObj(bytes , numBytes));
         2370  +		/* We took no more than numBytes bytes from the (char *).
         2371  +		 * In turn, [format] will take no more than numBytes
         2372  +		 * characters from the Tcl_Obj.  Since numBytes characters
         2373  +		 * must be no less than numBytes bytes, the character limit
         2374  +		 * will have no effect and we can just pass it through.
         2375  +		 */
  2376   2376   		break;
         2377  +	    }
  2377   2378   	    case 'c':
  2378   2379   	    case 'i':
  2379   2380   	    case 'u':
  2380   2381   	    case 'd':
  2381   2382   	    case 'o':
  2382   2383   	    case 'x':
  2383   2384   	    case 'X':
................................................................................
  2399   2400   	    case 'f':
  2400   2401   	    case 'g':
  2401   2402   	    case 'G':
  2402   2403   		Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
  2403   2404   			va_arg(argList, double)));
  2404   2405   		seekingConversion = 0;
  2405   2406   		break;
         2407  +	    case '*':
         2408  +		lastNum = (int)va_arg(argList, int);
         2409  +		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
         2410  +		p++;
         2411  +		break;
         2412  +	    case '0': case '1': case '2': case '3': case '4':
         2413  +	    case '5': case '6': case '7': case '8': case '9':
         2414  +		lastNum = (int) strtoul(p, &end, 10);
         2415  +		p = end;
         2416  +		break;
         2417  +	    case '.':
         2418  +		gotPrecision = 1;
         2419  +		p++;
         2420  +		break;
         2421  +	    /* TODO: support for wide (and bignum?) arguments */
  2406   2422   	    case 'l':
  2407   2423   		size = 1;
  2408   2424   		p++;
  2409   2425   		break;
  2410   2426   	    case 'h':
  2411   2427   		size = -1;
  2412   2428   	    default:
................................................................................
  2431   2447    * Side effects:
  2432   2448    * 	None.
  2433   2449    *
  2434   2450    *---------------------------------------------------------------------------
  2435   2451    */
  2436   2452   
  2437   2453   int
  2438         -TclObjPrintf TCL_VARARGS_DEF(Tcl_Interp *,arg1)
         2454  +TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
  2439   2455   {
  2440   2456       va_list argList;
  2441   2457       int result;
  2442         -    Tcl_Interp *interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
  2443         -    result = ObjPrintfVA(interp, argList);
         2458  +
         2459  +    va_start(argList, format);
         2460  +    result = ObjPrintfVA(interp, objPtr, format, argList);
  2444   2461       va_end(argList);
  2445   2462       return result;
  2446   2463   }
         2464  +
         2465  +/*
         2466  + *----------------------------------------------------------------------
         2467  + *
         2468  + * TclFormatToErrorInfo --
         2469  + *
         2470  + * Results:
         2471  + *
         2472  + * Side effects:
         2473  + *
         2474  + *----------------------------------------------------------------------
         2475  + */
         2476  +
         2477  +int
         2478  +TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
         2479  +{
         2480  +    int code;
         2481  +    va_list argList;
         2482  +    Tcl_Obj *objPtr = Tcl_NewObj();
         2483  +
         2484  +    va_start(argList, format);
         2485  +    code = ObjPrintfVA(interp, objPtr, format, argList);
         2486  +    va_end(argList);
         2487  +    if (code != TCL_OK) {
         2488  +        return code;
         2489  +    }
         2490  +    TclAppendObjToErrorInfo(interp, objPtr);
         2491  +    Tcl_DecrRefCount(objPtr);
         2492  +    return TCL_OK;
         2493  +}
  2447   2494   
  2448   2495   /*
  2449   2496    *---------------------------------------------------------------------------
  2450   2497    *
  2451   2498    * FillUnicodeRep --
  2452   2499    *
  2453   2500    *	Populate the Unicode internal rep with the Unicode form of its string

Changes to generic/tclTimer.c.

     5      5    *	including the "after" command.
     6      6    *
     7      7    * Copyright (c) 1997 by Sun Microsystems, Inc.
     8      8    *
     9      9    * See the file "license.terms" for information on usage and redistribution of
    10     10    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    11     11    *
    12         - * RCS: @(#) $Id: tclTimer.c,v 1.12.2.4 2005/08/02 18:16:10 dgp Exp $
           12  + * RCS: @(#) $Id: tclTimer.c,v 1.12.2.5 2005/09/15 20:58:40 dgp Exp $
    13     13    */
    14     14   
    15     15   #include "tclInt.h"
    16     16   
    17     17   /*
    18     18    * For each timer callback that's pending there is one record of the following
    19     19    * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
................................................................................
   777    777       int length;
   778    778       char *argString;
   779    779       int index;
   780    780       char buf[16 + TCL_INTEGER_SPACE];
   781    781       static CONST char *afterSubCmds[] = {
   782    782   	"cancel", "idle", "info", (char *) NULL
   783    783       };
          784  +    Tcl_Obj *objPtr;
   784    785       enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
   785    786       ThreadSpecificData *tsdPtr = InitTimer();
   786    787   
   787    788       if (objc < 2) {
   788    789   	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
   789    790   	return TCL_ERROR;
   790    791       }
................................................................................
   844    845   
   845    846   	afterPtr->id = tsdPtr->afterId;
   846    847   	tsdPtr->afterId += 1;
   847    848   	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
   848    849   		(ClientData) afterPtr);
   849    850   	afterPtr->nextPtr = assocPtr->firstAfterPtr;
   850    851   	assocPtr->firstAfterPtr = afterPtr;
   851         -	sprintf(buf, "after#%d", afterPtr->id);
   852         -	Tcl_AppendResult(interp, buf, (char *) NULL);
          852  +	objPtr = Tcl_NewObj();
          853  +	TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
          854  +	Tcl_SetObjResult(interp, objPtr);
   853    855   	return TCL_OK;
   854    856       }
   855    857   
   856    858       /*
   857    859        * If it's not a number it must be a subcommand. Note that we're using a
   858    860        * custom error message here, so we do not pass an interpreter to T_GIFO.
   859    861        */
................................................................................
   922    924   	Tcl_IncrRefCount(afterPtr->commandPtr);
   923    925   	afterPtr->id = tsdPtr->afterId;
   924    926   	tsdPtr->afterId += 1;
   925    927   	afterPtr->token = NULL;
   926    928   	afterPtr->nextPtr = assocPtr->firstAfterPtr;
   927    929   	assocPtr->firstAfterPtr = afterPtr;
   928    930   	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
   929         -	sprintf(buf, "after#%d", afterPtr->id);
   930         -	Tcl_AppendResult(interp, buf, (char *) NULL);
          931  +	objPtr = Tcl_NewObj();
          932  +	TclObjPrintf(NULL, objPtr, "after#%d", afterPtr->id);
          933  +	Tcl_SetObjResult(interp, objPtr);
   931    934   	break;
   932    935       case AFTER_INFO: {
   933    936   	Tcl_Obj *resultListPtr;
   934    937   
   935    938   	if (objc == 2) {
   936    939   	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
   937    940   		    afterPtr = afterPtr->nextPtr) {

Changes to generic/tclUtil.c.

     7      7    * Copyright (c) 1987-1993 The Regents of the University of California.
     8      8    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
     9      9    * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
    10     10    *
    11     11    * See the file "license.terms" for information on usage and redistribution of
    12     12    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    13     13    *
    14         - *  RCS: @(#) $Id: tclUtil.c,v 1.51.2.19 2005/09/09 18:48:40 dgp Exp $
           14  + *  RCS: @(#) $Id: tclUtil.c,v 1.51.2.20 2005/09/15 20:58:40 dgp Exp $
    15     15    */
    16     16   
    17     17   #include "tclInt.h"
    18     18   #include <float.h>
    19     19   #include <math.h>
    20     20   
    21     21   /*
................................................................................
   213    213   		}
   214    214   
   215    215   		/*
   216    216   		 * Garbage after the closing brace; return an error.
   217    217   		 */
   218    218   
   219    219   		if (interp != NULL) {
   220         -		    char buf[100];
   221         -
          220  +		    Tcl_Obj *objPtr = Tcl_NewObj();
   222    221   		    p2 = p;
   223    222   		    while ((p2 < limit)
   224    223   			    && (!isspace(UCHAR(*p2)))	/* INTL: ISO space. */
   225    224   			    && (p2 < p+20)) {
   226    225   			p2++;
   227    226   		    }
   228         -		    sprintf(buf,
   229         -			    "list element in braces followed by \"%.*s\" instead of space",
   230         -			    (int) (p2-p), p);
   231         -		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
          227  +		    TclObjPrintf(NULL, objPtr,
          228  +			    "list element in braces followed by \"%.*s\" "
          229  +			    "instead of space", (int) (p2-p), p);
          230  +		    Tcl_SetObjResult(interp, objPtr);
   232    231   		}
   233    232   		return TCL_ERROR;
   234    233   	    }
   235    234   	    break;
   236    235   
   237    236   	    /*
   238    237   	     * Backslash: skip over everything up to the end of the backslash
................................................................................
   275    274   		}
   276    275   
   277    276   		/*
   278    277   		 * Garbage after the closing quote; return an error.
   279    278   		 */
   280    279   
   281    280   		if (interp != NULL) {
   282         -		    char buf[100];
   283         -
          281  +		    Tcl_Obj *objPtr = Tcl_NewObj();
   284    282   		    p2 = p;
   285    283   		    while ((p2 < limit)
   286    284   			    && (!isspace(UCHAR(*p2)))	/* INTL: ISO space */
   287    285   			    && (p2 < p+20)) {
   288    286   			p2++;
   289    287   		    }
   290         -		    sprintf(buf,
   291         -			    "list element in quotes followed by \"%.*s\" %s",
   292         -			    (int) (p2-p), p, "instead of space");
   293         -		    Tcl_SetResult(interp, buf, TCL_VOLATILE);
          288  +		    TclObjPrintf(NULL, objPtr,
          289  +			    "list element in quotes followed by \"%.*s\" "
          290  +			    "instead of space", (int) (p2-p), p);
          291  +		    Tcl_SetObjResult(interp, objPtr);
   294    292   		}
   295    293   		return TCL_ERROR;
   296    294   	    }
   297    295   	    break;
   298    296   	}
   299    297   	p++;
   300    298       }

Changes to library/init.tcl.

     1      1   # init.tcl --
     2      2   #
     3      3   # Default system startup file for Tcl-based applications.  Defines
     4      4   # "unknown" procedure and auto-load facilities.
     5      5   #
     6         -# RCS: @(#) $Id: init.tcl,v 1.69.2.5 2005/08/25 15:46:31 dgp Exp $
            6  +# RCS: @(#) $Id: init.tcl,v 1.69.2.6 2005/09/15 20:58:40 dgp Exp $
     7      7   #
     8      8   # Copyright (c) 1991-1993 The Regents of the University of California.
     9      9   # Copyright (c) 1994-1996 Sun Microsystems, Inc.
    10     10   # Copyright (c) 1998-1999 Scriptics Corporation.
    11     11   # Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
    12     12   #
    13     13   # See the file "license.terms" for information on usage and redistribution
................................................................................
   268    268   		# Compute stack trace contribution from the [uplevel].
   269    269   		# Note the dependence on how Tcl_AddErrorInfo, etc. 
   270    270   		# construct the stack trace.
   271    271   		#
   272    272   		set errorInfo [dict get $opts -errorinfo]
   273    273   		set errorCode [dict get $opts -errorcode]
   274    274   		set cinfo $args
   275         -		if {[string bytelength $cinfo] > 153} {
   276         -		    set cinfo [string range $cinfo 0 152]
          275  +		if {[string bytelength $cinfo] > 150} {
          276  +		    set cinfo [string range $cinfo 0 150]
   277    277   		    while {[string bytelength $cinfo] > 150} {
   278    278   			set cinfo [string range $cinfo 0 end-1]
   279    279   		    }
   280    280   		    append cinfo ...
   281    281   		}
   282    282   		append cinfo "\"\n    (\"uplevel\" body line 1)"
   283    283   		append cinfo "\n    invoked from within"

Changes to tools/genStubs.tcl.

     4      4   #	interface.  
     5      5   #	
     6      6   #
     7      7   # Copyright (c) 1998-1999 by Scriptics Corporation.
     8      8   # See the file "license.terms" for information on usage and redistribution
     9      9   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10   # 
    11         -# RCS: @(#) $Id: genStubs.tcl,v 1.17 2004/03/17 18:14:18 das Exp $
           11  +# RCS: @(#) $Id: genStubs.tcl,v 1.17.2.1 2005/09/15 20:58:40 dgp Exp $
    12     12   
    13     13   package require Tcl 8
    14     14   
    15     15   namespace eval genStubs {
    16     16       # libraryName --
    17     17       #
    18     18       #	The name of the entire library.  This value is used to compute
................................................................................
   367    367       set arg1 [lindex $args 0]
   368    368       switch -exact $arg1 {
   369    369   	void {
   370    370   	    append line "(void)"
   371    371   	}
   372    372   	TCL_VARARGS {
   373    373   	    set arg [lindex $args 1]
   374         -	    append line "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
          374  +	    append line "([lindex $arg 0][lindex $arg 1], ...)"
   375    375   	}
   376    376   	default {
   377    377   	    set sep "("
   378    378   	    foreach arg $args {
   379    379   		append line $sep
   380    380   		set next {}
   381    381   		append next [lindex $arg 0] " " [lindex $arg 1] \
................................................................................
   460    460   
   461    461       append text "/* Slot $index */\n" $rtype "\n" $fname
   462    462   
   463    463       set arg1 [lindex $args 0]
   464    464   
   465    465       if {![string compare $arg1 "TCL_VARARGS"]} {
   466    466   	lassign [lindex $args 1] type argName 
   467         -	append text " TCL_VARARGS_DEF($type,$argName)\n\{\n"
          467  +	append text " ($type$argName, ...)\n\{\n"
   468    468   	append text "    " $type " var;\n    va_list argList;\n"
   469    469   	if {[string compare $rtype "void"]} {
   470    470   	    append text "    " $rtype " resultValue;\n"
   471    471   	}
   472         -	append text "\n    var = (" $type ") TCL_VARARGS_START(" \
   473         -		$type "," $argName ",argList);\n\n    "
          472  +	append text "\n    var = (" $type ") (va_start(argList, " \
          473  +		$argName "), " $argName ");\n\n    "
   474    474   	if {[string compare $rtype "void"]} {
   475    475   	    append text "resultValue = "
   476    476   	}
   477    477   	append text "(" $name "StubsPtr->" $lfname "VA)(var, argList);\n"
   478    478   	append text "    va_end(argList);\n"
   479    479   	if {[string compare $rtype "void"]} {
   480    480   	    append text "return resultValue;\n"
................................................................................
   529    529       set arg1 [lindex $args 0]
   530    530       switch -exact $arg1 {
   531    531   	void {
   532    532   	    append text "(void)"
   533    533   	}
   534    534   	TCL_VARARGS {
   535    535   	    set arg [lindex $args 1]
   536         -	    append text "TCL_VARARGS([lindex $arg 0],[lindex $arg 1])"
          536  +	    append text "([lindex $arg 0][lindex $arg 1], ...)"
   537    537   	}
   538    538   	default {
   539    539   	    set sep "("
   540    540   	    foreach arg $args {
   541    541   		append text $sep [lindex $arg 0] " " [lindex $arg 1] \
   542    542   			[lindex $arg 2]
   543    543   		set sep ", "

Changes to unix/configure.

  8948   8948   
  8949   8949   cat >>confdefs.h <<\_ACEOF
  8950   8950   #define _LARGEFILE64_SOURCE 1
  8951   8951   _ACEOF
  8952   8952   
  8953   8953   	tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
  8954   8954       fi
         8955  +
         8956  +    if test "${tcl_cv_flag__largefile_source64+set}" = set; then
         8957  +  echo $ECHO_N "(cached) $ECHO_C" >&6
         8958  +else
         8959  +  cat >conftest.$ac_ext <<_ACEOF
         8960  +/* confdefs.h.  */
         8961  +_ACEOF
         8962  +cat confdefs.h >>conftest.$ac_ext
         8963  +cat >>conftest.$ac_ext <<_ACEOF
         8964  +/* end confdefs.h.  */
         8965  +#include <sys/stat.h>
         8966  +int
         8967  +main ()
         8968  +{
         8969  +char *p = (char *)open64;
         8970  +  ;
         8971  +  return 0;
         8972  +}
         8973  +_ACEOF
         8974  +rm -f conftest.$ac_objext
         8975  +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
         8976  +  (eval $ac_compile) 2>conftest.er1
         8977  +  ac_status=$?
         8978  +  grep -v '^ *+' conftest.er1 >conftest.err
         8979  +  rm -f conftest.er1
         8980  +  cat conftest.err >&5
         8981  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         8982  +  (exit $ac_status); } &&
         8983  +	 { ac_try='test -z "$ac_c_werror_flag"
         8984  +			 || test ! -s conftest.err'
         8985  +  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
         8986  +  (eval $ac_try) 2>&5
         8987  +  ac_status=$?
         8988  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         8989  +  (exit $ac_status); }; } &&
         8990  +	 { ac_try='test -s conftest.$ac_objext'
         8991  +  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
         8992  +  (eval $ac_try) 2>&5
         8993  +  ac_status=$?
         8994  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         8995  +  (exit $ac_status); }; }; then
         8996  +  tcl_cv_flag__largefile_source64=no
         8997  +else
         8998  +  echo "$as_me: failed program was:" >&5
         8999  +sed 's/^/| /' conftest.$ac_ext >&5
         9000  +
         9001  +cat >conftest.$ac_ext <<_ACEOF
         9002  +/* confdefs.h.  */
         9003  +_ACEOF
         9004  +cat confdefs.h >>conftest.$ac_ext
         9005  +cat >>conftest.$ac_ext <<_ACEOF
         9006  +/* end confdefs.h.  */
         9007  +#define _LARGEFILE_SOURCE64 1
         9008  +#include <sys/stat.h>
         9009  +int
         9010  +main ()
         9011  +{
         9012  +char *p = (char *)open64;
         9013  +  ;
         9014  +  return 0;
         9015  +}
         9016  +_ACEOF
         9017  +rm -f conftest.$ac_objext
         9018  +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
         9019  +  (eval $ac_compile) 2>conftest.er1
         9020  +  ac_status=$?
         9021  +  grep -v '^ *+' conftest.er1 >conftest.err
         9022  +  rm -f conftest.er1
         9023  +  cat conftest.err >&5
         9024  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         9025  +  (exit $ac_status); } &&
         9026  +	 { ac_try='test -z "$ac_c_werror_flag"
         9027  +			 || test ! -s conftest.err'
         9028  +  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
         9029  +  (eval $ac_try) 2>&5
         9030  +  ac_status=$?
         9031  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         9032  +  (exit $ac_status); }; } &&
         9033  +	 { ac_try='test -s conftest.$ac_objext'
         9034  +  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
         9035  +  (eval $ac_try) 2>&5
         9036  +  ac_status=$?
         9037  +  echo "$as_me:$LINENO: \$? = $ac_status" >&5
         9038  +  (exit $ac_status); }; }; then
         9039  +  tcl_cv_flag__largefile_source64=yes
         9040  +else
         9041  +  echo "$as_me: failed program was:" >&5
         9042  +sed 's/^/| /' conftest.$ac_ext >&5
         9043  +
         9044  +tcl_cv_flag__largefile_source64=no
         9045  +fi
         9046  +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
         9047  +fi
         9048  +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
         9049  +fi
         9050  +
         9051  +    if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then
         9052  +
         9053  +cat >>confdefs.h <<\_ACEOF
         9054  +#define _LARGEFILE_SOURCE64 1
         9055  +_ACEOF
         9056  +
         9057  +	tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
         9058  +    fi
  8955   9059       if test "x${tcl_flags}" = "x" ; then
  8956   9060   	echo "$as_me:$LINENO: result: none" >&5
  8957   9061   echo "${ECHO_T}none" >&6
  8958   9062       else
  8959   9063   	echo "$as_me:$LINENO: result: ${tcl_flags}" >&5
  8960   9064   echo "${ECHO_T}${tcl_flags}" >&6
  8961   9065       fi

Changes to unix/tcl.m4.

  2518   2518   AC_DEFUN(SC_TCL_EARLY_FLAGS,[
  2519   2519       AC_MSG_CHECKING([for required early compiler flags])
  2520   2520       tcl_flags=""
  2521   2521       SC_TCL_EARLY_FLAG(_ISOC99_SOURCE,[#include <stdlib.h>],
  2522   2522   	[char *p = (char *)strtoll; char *q = (char *)strtoull;])
  2523   2523       SC_TCL_EARLY_FLAG(_LARGEFILE64_SOURCE,[#include <sys/stat.h>],
  2524   2524   	[struct stat64 buf; int i = stat64("/", &buf);])
         2525  +    SC_TCL_EARLY_FLAG(_LARGEFILE_SOURCE64,[#include <sys/stat.h>],
         2526  +	[char *p = (char *)open64;])
  2525   2527       if test "x${tcl_flags}" = "x" ; then
  2526   2528   	AC_MSG_RESULT(none)
  2527   2529       else
  2528   2530   	AC_MSG_RESULT(${tcl_flags})
  2529   2531       fi])
  2530   2532   
  2531   2533   #--------------------------------------------------------------------

Changes to unix/tclUnixFCmd.c.

     6      6    *	already be translated to native format.
     7      7    *
     8      8    * Copyright (c) 1996-1998 Sun Microsystems, Inc.
     9      9    *
    10     10    * See the file "license.terms" for information on usage and redistribution of
    11     11    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12    *
    13         - * RCS: @(#) $Id: tclUnixFCmd.c,v 1.40.2.3 2005/08/02 18:16:56 dgp Exp $
           13  + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.40.2.4 2005/09/15 20:58:40 dgp Exp $
    14     14    *
    15     15    * Portions of this code were derived from NetBSD source code which has the
    16     16    * following copyright notice:
    17     17    *
    18     18    * Copyright (c) 1988, 1993, 1994
    19     19    *      The Regents of the University of California.  All rights reserved.
    20     20    *
................................................................................
  1282   1282   GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
  1283   1283       Tcl_Interp *interp;		    /* The interp we are using for errors. */
  1284   1284       int objIndex;		    /* The index of the attribute. */
  1285   1285       Tcl_Obj *fileName;  	    /* The name of the file (UTF-8). */
  1286   1286       Tcl_Obj **attributePtrPtr;	    /* A pointer to return the object with. */
  1287   1287   {
  1288   1288       Tcl_StatBuf statBuf;
  1289         -    char returnString[7];
  1290   1289       int result;
  1291   1290   
  1292   1291       result = TclpObjStat(fileName, &statBuf);
  1293   1292   
  1294   1293       if (result != 0) {
  1295   1294   	if (interp != NULL) {
  1296   1295   	    Tcl_AppendResult(interp, "could not read \"",
  1297   1296   		    Tcl_GetString(fileName), "\": ",
  1298   1297   		    Tcl_PosixError(interp), (char *) NULL);
  1299   1298   	}
  1300   1299   	return TCL_ERROR;
  1301   1300       }
  1302   1301   
  1303         -    sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
  1304         -
  1305         -    *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
         1302  +    *attributePtrPtr = Tcl_NewObj();
         1303  +    TclObjPrintf(NULL, *attributePtrPtr, "%0#5lo",
         1304  +	    (long) (statBuf.st_mode & 0x00007FFF));
  1306   1305   
  1307   1306       return TCL_OK;
  1308   1307   }
  1309   1308   
  1310   1309   /*
  1311   1310    *---------------------------------------------------------------------------
  1312   1311    *