Tcl Source Code

Check-in [8c1453cc30]
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:Trim away obsolete code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-string-cat
Files: files | file ages | folders
SHA1: 8c1453cc30cb1b28254211c99e9b40607fddcd31
User & Date: dgp 2016-11-01 15:12:07
Context
2016-11-01
15:42
Replace indexing with pointer increments. Closed-Leaf check-in: 78ef6f929b user: dgp tags: dgp-string-cat
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclExecute.c.

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
2754
2755
2756
2757
2758
2759
2760
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
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
	    *b = tmpPtr;
	    a++; b--;
	}
	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_STR_CONCAT1: {
	int appendLen = 0;
	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.
	 */

	for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
	    if (((*currPtr)->typePtr != &tclByteArrayType)
		    && ((*currPtr)->bytes != tclEmptyStringRep)) {
		onlyb = 0;
		break;
	    } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
		    ((*currPtr)->bytes != NULL)) {
		onlyb = 0;
		break;
	    }
	}

	/*
	 * Compute the length to be appended.
	 */

	if (onlyb) {
	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
		if ((*currPtr)->bytes != tclEmptyStringRep) {
		    Tcl_GetByteArrayFromObj(*currPtr, &length);
		    appendLen += length;
		}
	    }
	} else {
	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
		bytes = TclGetStringFromObj(*currPtr, &length);
		if (bytes != NULL) {
		    appendLen += length;
		}
	    }
	}

	if (appendLen < 0) {
	    /* TODO: convert panic to error ? */
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	/*
	 * If nothing is to be appended, just return the first object by
	 * dropping all the others from the stack; this saves both the
	 * computation and copy of the string rep of the first object,
	 * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
	 */

	if (appendLen == 0) {
	    TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	    NEXT_INST_V(2, (opnd-1), 0);
	}

	/*
	 * If the first object is shared, we need a new obj for the result;
	 * otherwise, we can reuse the first object. In any case, make sure it
	 * has enough room to accomodate all the concatenated bytes. Note that
	 * if it is unshared its bytes are copied by ckrealloc, so that we set
	 * the loop parameters to avoid copying them again: p points to the
	 * end of the already copied bytes, currPtr to the second object.
	 */

	objResultPtr = OBJ_AT_DEPTH(opnd-1);
	if (!onlyb) {
	    bytes = TclGetStringFromObj(objResultPtr, &length);
	    if (length + appendLen < 0) {
		/* TODO: convert panic to error ? */
		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
			INT_MAX);
	    }
#ifndef TCL_COMPILE_DEBUG
	    if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
		TclFreeIntRep(objResultPtr);
		objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
		objResultPtr->length = length + appendLen;
		p = TclGetString(objResultPtr) + length;
		currPtr = &OBJ_AT_DEPTH(opnd - 2);
	    } else
#endif
	    {
		p = ckalloc(length + appendLen + 1);
		TclNewObj(objResultPtr);
		objResultPtr->bytes = p;
		objResultPtr->length = length + appendLen;
		currPtr = &OBJ_AT_DEPTH(opnd - 1);
	    }

	    /*
	     * Append the remaining characters.
	     */

	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
		bytes = TclGetStringFromObj(*currPtr, &length);
		if (bytes != NULL) {
		    memcpy(p, bytes, (size_t) length);
		    p += length;
		}
	    }
	    *p = '\0';
	} else {
	    bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
	    if (length + appendLen < 0) {
		/* TODO: convert panic to error ? */
		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
			INT_MAX);
	    }
#ifndef TCL_COMPILE_DEBUG
	    if (!Tcl_IsShared(objResultPtr)) {
		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
			length + appendLen);
		p = bytes + length;
		currPtr = &OBJ_AT_DEPTH(opnd - 2);
	    } else
#endif
	    {
		TclNewObj(objResultPtr);
		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
			length + appendLen);
		p = bytes;
		currPtr = &OBJ_AT_DEPTH(opnd - 1);
	    }

	    /*
	     * Append the remaining characters.
	     */

	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
		if ((*currPtr)->bytes != tclEmptyStringRep) {
		    bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
		    memcpy(p, bytes, (size_t) length);
		    p += length;
		}
	    }
	}
#endif

	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);
    }

    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
	 * and then decrement their ref counts.
	 */







|
<
<
<
<



<





<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<







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
	    *b = tmpPtr;
	    a++; b--;
	}
	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_STR_CONCAT1:





	opnd = TclGetUInt1AtPtr(pc+1);


	if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}




















































	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);























































































	NEXT_INST_V(2, opnd, 1);


    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
	 * and then decrement their ref counts.
	 */