Tcl Source Code

Check-in [9bfada5e22]
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:Expand all the cases of the [string cat] engine.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-string-cat
Files: files | file ages | folders
SHA1: 9bfada5e22589c160ed9a4b6655372d2198beec3
User & Date: dgp 2016-11-01 15:07:30
Context
2016-11-01
15:12
Trim away obsolete code. check-in: 8c1453cc30 user: dgp tags: dgp-string-cat
15:07
Expand all the cases of the [string cat] engine. check-in: 9bfada5e22 user: dgp tags: dgp-string-cat
2016-10-31
18:10
Reduce copies in the pure binary implementation of [string cat]. check-in: 210148adc5 user: dgp tags: dgp-string-cat
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclStringObj.c.

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
....
2708
2709
2710
2711
2712
2713
2714
2715
2716


2717


2718
2719
2720










2721


2722


2723





2724
2725




















2726
2727








2728
2729
2730
2731
2732
2733
2734
    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;

    if (binary) {
	/* Efficiently produce a pure binary result */
	unsigned char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;
	
	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
................................................................................

	    if (objPtr->bytes == NULL) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    } else {






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










	objResultPtr = Tcl_DuplicateObj(objResultPtr);


    }






























	while (objc--) {
	    Tcl_AppendObjToObj(objResultPtr, *objv++);








	}
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}
 
/*






>




>





|



>
|
<
<
>
>
>
>
|
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>




>

>
>
|


|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
<
|
|
|
|
>
|
|
|
|
|
<




|







 








|
>
>

>
>

|
<
>
>
>
>
>
>
>
>
>
>
|
>
>
|
>
>

>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

<
>
>
>
>
>
>
>
>







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
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731

2732
2733
2734
2735
2736
2737
2738
2739
2740
2741

2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
....
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
    int inPlace,
    int objc,
    Tcl_Obj * const objv[],
    Tcl_Obj **objPtrPtr)
{
    Tcl_Obj *objResultPtr;
    int i, length = 0, binary = 1, first = 0;
    int allowUniChar = 1, requestUniChar = 0;

    /* assert (objc >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

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

	if (objPtr->bytes) {
	    /* Value has a string rep. */
	    if (objPtr->length) {


		/*
		 * Non-empty string rep. Not a pure bytearray, so we 
		 * won't create a pure bytearray
		 */
	 	binary = 0;
		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    if (TclIsPureByteArray(objPtr)) {
		allowUniChar = 0;
	    } else {
		binary = 0;
		if (objPtr->typePtr == &tclStringType) {
		    /* Have a pure Unicode value; ask to preserve it */
		    requestUniChar = 1;
		} else {
		    /* Have another type; prevent shimmer */
		    allowUniChar = 0;
		}
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
        for (i = 0; i < objc && length >= 0; i++) {
	    Tcl_Obj *objPtr = objv[i];

	    if (objPtr->bytes == NULL) {
		int numBytes;

		Tcl_GetByteArrayFromObj(objPtr, &numBytes);
		if (length == 0) {
		    first = i;
		}
		length += numBytes;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
        for (i = 0; i < objc && length >= 0; i++) {
	    Tcl_Obj *objPtr = objv[i];

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int numChars;

		Tcl_GetUnicodeFromObj(objPtr, &numChars);
		if (length == 0) {
		    first = i;
		}
		length += numChars;
	    }
	}
    } else {
	/* Result will be concat of string reps. Pre-size it. */
        for (i = 0; i < objc && length >= 0; i++) {
	    Tcl_Obj *objPtr = objv[i];
	    int numBytes;

	    Tcl_GetStringFromObj(objPtr, &numBytes);
	    if ((length == 0) && numBytes) {
		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;

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;
	
	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
................................................................................

	    if (objPtr->bytes == NULL) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;


	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    Tcl_GetStringFromObj(objResultPtr, &start);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetString(objResultPtr) + start;
	    if (length > start) {
		TclFreeIntRep(objResultPtr);
	    }
	} else {
	    objResultPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {

	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}
 
/*