Tcl Source Code

Check-in [53494f969b]
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 trunk

Fossil has hopelessly fouled up this checkin's branch history.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | mig-review
Files: files | file ages | folders
SHA1: 53494f969b4fca72e735c40fcdd6d42086c1e460
User & Date: dgp 2013-06-05 15:24:04
Original Comment: merge trunk
Context
2013-06-05
15:24
merge trunk

Fossil has hopelessly fouled up this checkin's branch history. Closed-Leaf check-in: 53494f969b user: dgp tags: mig-review

15:22
[Bugs 2835313, 3614226, 3614342]: Complete the construction of break/continue compilers that get the... check-in: 0cf4701170 user: dgp tags: trunk
11:59
merge trunk check-in: 0208fd3481 user: dgp tags: mig-review
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
853
854
855
856
857
858
859

860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_BREAK here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopBreakFixup(envPtr, auxPtr);

    } else {
	/*
	 * Emit a real break.
	 */

	PushStringLiteral(envPtr, "");
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
	TclEmitInt4(0, envPtr);
    }

    /*
     * Instructions that raise exceptions don't really have to follow the
     * usual stack management rules, but the cleanup code does.
     */

    TclAdjustStackDepth(1, envPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileCatchCmd --
................................................................................
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_CONTINUE here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopContinueFixup(envPtr, auxPtr);

    } else {
	/*
	 * Emit a real continue.
	 */

	PushStringLiteral(envPtr, "");
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
	TclEmitInt4(0, envPtr);
    }

    /*
     * Instructions that raise exceptions don't really have to follow the
     * usual stack management rules, but the cleanup code does.
     */

    TclAdjustStackDepth(1, envPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --






>











<
<
<
<
<
<







 







>











<
<
<
<
<
<







515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533






534
535
536
537
538
539
540
...
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866






867
868
869
870
871
872
873
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_BREAK here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopBreakFixup(envPtr, auxPtr);
	TclAdjustStackDepth(1, envPtr);
    } else {
	/*
	 * Emit a real break.
	 */

	PushStringLiteral(envPtr, "");
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr);
	TclEmitInt4(0, envPtr);
    }







    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileCatchCmd --
................................................................................
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_CONTINUE here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopContinueFixup(envPtr, auxPtr);
	TclAdjustStackDepth(1, envPtr);
    } else {
	/*
	 * Emit a real continue.
	 */

	PushStringLiteral(envPtr, "");
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr);
	TclEmitInt4(0, envPtr);
    }







    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --

Changes to generic/tclExecute.c.

256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
....
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
....
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
....
2744
2745
2746
2747
2748
2749
2750




2751
2752
2753
2754
2755
2756
2757
....
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
....
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
 *
 * We use the new compile-time assertions to check that nCleanup is constant
 * and within range.
 */

/* Verify the stack depth, only when no expansion is in progress */

#if TCL_COMPILE_DEBUG
#define CHECK_STACK()							\
    do {								\
	ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH,			\
		/*checkStack*/ !(starting || auxObjList));		\
	starting = 0;							\
    } while (0)
#else
................................................................................
	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);
	    }
#if !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
................................................................................
	} 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);
	    }
#if !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
................................................................................
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();




	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

#ifdef TCL_COMPILE_DEBUG
................................................................................
	/*
	 * An external evaluation (INST_INVOKE or INST_EVAL) returned
	 * something different from TCL_OK, or else INST_BREAK or
	 * INST_CONTINUE were called.
	 */

    processExceptionReturn:
#if TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_INVOKE_STK1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
	    break;
	case INST_INVOKE_STK4:
	    opnd = TclGetUInt4AtPtr(pc+1);
................................................................................
	    result = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
		    StringForResultCode(result),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#if TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
			result, O2S(objPtr)));
	    } else {
		TRACE_APPEND(("%s, result= \"%s\"\n",






|







 







|







 







|







 







>
>
>
>







 







|







 







|







256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
....
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
....
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
....
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
....
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
....
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
 *
 * We use the new compile-time assertions to check that nCleanup is constant
 * and within range.
 */

/* Verify the stack depth, only when no expansion is in progress */

#ifdef TCL_COMPILE_DEBUG
#define CHECK_STACK()							\
    do {								\
	ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH,			\
		/*checkStack*/ !(starting || auxObjList));		\
	starting = 0;							\
    } while (0)
#else
................................................................................
	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
................................................................................
	} 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
................................................................................
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

#ifdef TCL_COMPILE_DEBUG
................................................................................
	/*
	 * An external evaluation (INST_INVOKE or INST_EVAL) returned
	 * something different from TCL_OK, or else INST_BREAK or
	 * INST_CONTINUE were called.
	 */

    processExceptionReturn:
#ifdef TCL_COMPILE_DEBUG
	switch (*pc) {
	case INST_INVOKE_STK1:
	    opnd = TclGetUInt1AtPtr(pc+1);
	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
	    break;
	case INST_INVOKE_STK4:
	    opnd = TclGetUInt4AtPtr(pc+1);
................................................................................
	    result = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %d, new pc %d\n",
		    StringForResultCode(result),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);
	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
			result, O2S(objPtr)));
	    } else {
		TRACE_APPEND(("%s, result= \"%s\"\n",