Tcl Source Code

Check-in [8f63620a09]
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:WIP
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-string-cat
Files: files | file ages | folders
SHA1: 8f63620a09f7be74ad811b706baf5cc40ccce9a5
User & Date: dgp 2016-10-28 20:33:55
Context
2016-10-31
14:18
merge trunk check-in: acd1d0f9c7 user: dgp tags: dgp-string-cat
2016-10-28
20:33
WIP check-in: 8f63620a09 user: dgp tags: dgp-string-cat
16:55
revise [dict append] to make use of common [string cat] engine. check-in: 673871f49c user: dgp tags: dgp-string-cat
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCmdIL.c.

2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    if (Tcl_GetCharLength(joinObjPtr) == 0) {
	Tcl_IncrRefCount(elemPtrs[0]);
	TclStringCatObjv(interp, listLen, elemPtrs, &resObjPtr);
	Tcl_DecrRefCount(elemPtrs[0]);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {







|
|
<







2183
2184
2185
2186
2187
2188
2189
2190
2191

2192
2193
2194
2195
2196
2197
2198
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    if (Tcl_GetCharLength(joinObjPtr) == 0) {
	TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
		&resObjPtr);

    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {

Changes to generic/tclCmdMZ.c.

2869
2870
2871
2872
2873
2874
2875
2876

2877
2878
2879
2880
2881
2882
2883
	/*
	 * Other trivial case, single arg, just return it.
	 */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    code = TclStringCatObjv(interp, objc-1, objv+1, &objResultPtr);


    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, objResultPtr);
	return TCL_OK;
    }

    return code;






|
>







2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
	/*
	 * Other trivial case, single arg, just return it.
	 */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
	    &objResultPtr);

    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, objResultPtr);
	return TCL_OK;
    }

    return code;

Changes to generic/tclDictObj.c.

2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
	Tcl_Obj *appendObjPtr = NULL;

	if (objc > 3) {
	    /* Something to append */

	    if (objc == 4) {
		appendObjPtr = objv[3];
	    } else if (TCL_OK != TclStringCatObjv(interp, objc-3, objv+3,
		    &appendObjPtr)) {
		return TCL_ERROR;
	    }
	}

	if (appendObjPtr == NULL) {
	    /* => (objc == 3) => (valuePtr == NULL) */
	    TclNewObj(valuePtr);






|
|







2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
	Tcl_Obj *appendObjPtr = NULL;

	if (objc > 3) {
	    /* Something to append */

	    if (objc == 4) {
		appendObjPtr = objv[3];
	    } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		    objc-3, objv+3, &appendObjPtr)) {
		return TCL_ERROR;
	    }
	}

	if (appendObjPtr == NULL) {
	    /* => (objc == 3) => (valuePtr == NULL) */
	    TclNewObj(valuePtr);

Changes to generic/tclExecute.c.

2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
	char *bytes, *p;
	Tcl_Obj **currPtr;
	int onlyb = 1;

	opnd = TclGetUInt1AtPtr(pc+1);

#if 1
	if (TCL_OK != TclStringCatObjv(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
		&objResultPtr)) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
#else
	/*
	 * Detect only-bytearray-or-null case.
	 */






|
|







2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
	char *bytes, *p;
	Tcl_Obj **currPtr;
	int onlyb = 1;

	opnd = TclGetUInt1AtPtr(pc+1);

#if 1
	if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
#else
	/*
	 * Detect only-bytearray-or-null case.
	 */

Changes to generic/tclInt.h.

3131
3132
3133
3134
3135
3136
3137
3138

3139
3140
3141
3142
3143
3144
3145
3146
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int objc,

			    Tcl_Obj *const objv[], Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,






|
>
|







3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,

Changes to generic/tclStringObj.c.

2626
2627
2628
2629
2630
2631
2632

2633
2634
2635
2636
2637

2638
2639
2640
















































2641
2642
2643
2644






2645
2646
2647
2648
2649
2650
2651
 *
 *---------------------------------------------------------------------------
 */

int
TclStringCatObjv(
    Tcl_Interp *interp,

    int objc,
    Tcl_Obj * const objv[],
    Tcl_Obj **objPtrPtr)
{
    Tcl_Obj *objResultPtr;


    /* assert (objc >= 2) */

















































    objResultPtr = *objv++; objc--;
    if (Tcl_IsShared(objResultPtr)) {
	objResultPtr = Tcl_DuplicateObj(objResultPtr);
    }






    while (objc--) {
	Tcl_AppendObjToObj(objResultPtr, *objv++);
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}
 






>





>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|


>
>
>
>
>
>







2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
 *
 *---------------------------------------------------------------------------
 */

int
TclStringCatObjv(
    Tcl_Interp *interp,
    int inPlace,
    int objc,
    Tcl_Obj * const objv[],
    Tcl_Obj **objPtrPtr)
{
    Tcl_Obj *objResultPtr;
    int i, length = 0, binary = 1, first = 0;

    /* assert (objc >= 2) */

    /*
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    for (i = 0; i < objc && binary; i++) {
	Tcl_Obj *objPtr = objv[i];

	if (objPtr->bytes) {
	    if (objPtr->length == 0) {
		continue;
	    }
	    binary = 0;
	} else if (!TclIsPureByteArray(objPtr)) {
	    binary = 0;
	}
    }

    if (binary) {
        for (i = 0; i < objc && length >= 0; i++) {
	    if (objv[i]->bytes == NULL) {
		int numBytes;

		Tcl_GetByteArrayFromObj(objv[i], &numBytes);
		if (length == 0) {
		    first = i;
		}
		length += numBytes;
	    }
	}
	if (length < 0) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"max size for a Tcl value (%d bytes) exceeded",
			INT_MAX));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	if (length == 0) {
	    /* Total length of zero means every value has length zero */
	    *objPtrPtr = objv[0];
	    return TCL_OK;
	}
    } 

    objv += first; objc -= first;
    objResultPtr = *objv++; objc--;
    if (!inPlace || Tcl_IsShared(objResultPtr)) {
	objResultPtr = Tcl_DuplicateObj(objResultPtr);
    }

    if (binary) {
	Tcl_SetByteArrayLength(objResultPtr, length);
    }


    while (objc--) {
	Tcl_AppendObjToObj(objResultPtr, *objv++);
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}