Tcl Source Code

Check-in [1a7995155b]
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:
* generic/tclStringObj.c (TclAppendFormattedObjs): Revision to eliminate one round of string copying.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | kennykb-numerics-branch-20050915
Files: files | file ages | folders
SHA1: 1a7995155bc5f8a85c738e894ee304aef1c73d71
User & Date: dgp 2005-09-15 16:58:24
Context
2005-09-15
23:13
* doc/ParseCmd.3: copy/paste fix [Bug 1292427]
check-in: 72ad6487a4 user: msofer tags: trunk
16:58
* generic/tclStringObj.c (TclAppendFormattedObjs): Revision to eliminate one ro...
check-in: 1a7995155b user: dgp tags: trunk, kennykb-numerics-branch-20050915
16:40
* generic/tclBasic.c: More callers of TclObjPrintf and * generic/tclCkalloc.c: Tcl...
check-in: cf51f10457 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1



2
3
4
5
6
7
8
2005-09-15  Don Porter  <[email protected]>




	* generic/tclBasic.c:	More callers of TclObjPrintf and
	* generic/tclCkalloc.c:	TclFormatToErrorInfo.
	* generic/tclCmdMZ.c:
	* generic/tclExecute.c:
	* generic/tclIORChan.c:
	* generic/tclMain.c:
>
>
>







1
2
3
4
5
6
7
8
9
10
11
2005-09-15  Don Porter  <[email protected]>

	* generic/tclStringObj.c (TclAppendFormattedObjs):	Revision
	to eliminate one round of string copying.

	* generic/tclBasic.c:	More callers of TclObjPrintf and
	* generic/tclCkalloc.c:	TclFormatToErrorInfo.
	* generic/tclCmdMZ.c:
	* generic/tclExecute.c:
	* generic/tclIORChan.c:
	* generic/tclMain.c:

Changes to generic/tclStringObj.c.

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718

1719
1720
1721
1722
1723
1724
1725
1726
1727
....
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStringObj.c,v 1.47 2005/09/14 21:32:17 dgp Exp $ */

#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */

................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclAppendFormattedObjs(interp, baseObj, format, objc, objv)
    Tcl_Interp *interp;
    Tcl_Obj *baseObj;
    CONST char *format;
    int objc;
    Tcl_Obj *CONST objv[];
{
    CONST char *span = format;
    int numBytes = 0;
    int objIndex = 0;
    int gotXpg = 0, gotSequential = 0;
    Tcl_Obj *appendObj = Tcl_NewObj();
    CONST char *msg;
    CONST char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers";
    CONST char *badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"
    };

    if (Tcl_IsShared(baseObj)) {
	Tcl_Panic("TclAppendFormattedObjs called with shared object");
    }


    Tcl_IncrRefCount(appendObj);
    /* format string is NUL-terminated */
    while (*format != '\0') {
	char *end;
	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
	int width, gotPrecision, precision, useShort, useWide;
	int newXpg, numChars, allocSegment = 0;
	Tcl_Obj *segment;
................................................................................
	objIndex += gotSequential;
    }
    if (numBytes) {
	Tcl_AppendToObj(appendObj, span, numBytes);
	numBytes = 0;
    }

    Tcl_AppendObjToObj(baseObj, appendObj);
    Tcl_DecrRefCount(appendObj);
    return TCL_OK;

  errorMsg:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
    }
  error:
    Tcl_DecrRefCount(appendObj);
    return TCL_ERROR;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * FormatObjVA --






|







 







|

|








|







|


>

<







 







<
<







|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
....
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720

1721
1722
1723
1724
1725
1726
1727
....
2181
2182
2183
2184
2185
2186
2187


2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStringObj.c,v 1.48 2005/09/15 16:58:24 dgp Exp $ */

#include "tclInt.h"

/*
 * Prototypes for functions defined later in this file:
 */

................................................................................
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclAppendFormattedObjs(interp, appendObj, format, objc, objv)
    Tcl_Interp *interp;
    Tcl_Obj *appendObj;
    CONST char *format;
    int objc;
    Tcl_Obj *CONST objv[];
{
    CONST char *span = format;
    int numBytes = 0;
    int objIndex = 0;
    int gotXpg = 0, gotSequential = 0;
    int originalLength;
    CONST char *msg;
    CONST char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers";
    CONST char *badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"
    };

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("TclAppendFormattedObjs called with shared object");
    }
    Tcl_GetStringFromObj(appendObj, &originalLength);


    /* format string is NUL-terminated */
    while (*format != '\0') {
	char *end;
	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
	int width, gotPrecision, precision, useShort, useWide;
	int newXpg, numChars, allocSegment = 0;
	Tcl_Obj *segment;
................................................................................
	objIndex += gotSequential;
    }
    if (numBytes) {
	Tcl_AppendToObj(appendObj, span, numBytes);
	numBytes = 0;
    }



    return TCL_OK;

  errorMsg:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
    }
  error:
    Tcl_SetObjLength(appendObj, originalLength);
    return TCL_ERROR;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * FormatObjVA --