Tcl Source Code

Check-in [e777d7ae20]
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:allow simple optimization of the OK case, at the cost of some code duplication
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | mig-catch-compiler
Files: files | file ages | folders
SHA1: e777d7ae20218b0958feef4dfbcc9e73db3214ab
User & Date: mig 2013-12-11 17:13:15
Context
2013-12-11
17:29
merge new catch compiler check-in: 35565158e5 user: mig tags: mig-optimize
17:13
allow simple optimization of the OK case, at the cost of some code duplication Closed-Leaf check-in: e777d7ae20 user: mig tags: mig-catch-compiler
16:48
merge mark check-in: e0c8c98af2 user: mig tags: mig-catch-compiler
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

610
611
612
613
614
615
616
617
618



619
620













621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642

643
644
645
646




647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678


679
680
681
682
683
684
685
	/* drop the script */
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    ExceptionRangeEnds(envPtr, range);

    /*
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
     * and jump around the "error case" code.



     */














    PushStringLiteral(envPtr, "0");
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /* 
     * Emit the "error case" epilogue. Push the interpreter result and the
     * return code.
     */

    TclAdjustStackDepth(-2, envPtr);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point is empty */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: result returnCode */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /*

     * Push the return options if the caller wants them. This needs to happen
     * before INST_END_CATCH
     */





    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    }

    /*
     * End the catch
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*
     * Save the result and return options if the caller wants them. This needs
     * to happen after INST_END_CATCH (compile-3.6/7).
     */

    if (optsIndex != -1) {
	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		result returnCode
     * Reverse the stack to store the result.
     */

    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    if (resultIndex != -1) {
	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
    }
    TclEmitOpcode(	INST_POP,			envPtr);



    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --






|
|
>
>
>


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








|

<
<
<

<
<
<
<
<
<
<
<
>
|
|


>
>
>
>



<
<
<
<
<











<
<
<
<
<
<
<
<


<
|
|
>
>







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646



647








648
649
650
651
652
653
654
655
656
657
658
659





660
661
662
663
664
665
666
667
668
669
670








671
672

673
674
675
676
677
678
679
680
681
682
683
	/* drop the script */
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    ExceptionRangeEnds(envPtr, range);

    /*
     * Emit the "no errors" epilogue: last instruction is push "0" (TCL_OK)
     * as the catch result, and jump to the end. There is some code
     * duplication in order to allow the optimization of the OK case.
     *
     * NOTE: see comments on instruction ordering below!
     */

    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    }
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (optsIndex != -1) {
	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    if (resultIndex != -1) {
	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
    }
    TclEmitOpcode(	INST_POP,			envPtr);
    
    PushStringLiteral(envPtr, "0");
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /* 
     * Emit the "error case" epilogue. Push the interpreter result and the
     * return code.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, range, catchOffset);












    /* Stack at this point is empty. Push the return code, then push the
     * result and return options if the caller wants them. This needs to
     * happen before INST_END_CATCH.
     */

    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
    if (resultIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    }
    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    }





    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*
     * Save the result and return options if the caller wants them. This needs
     * to happen after INST_END_CATCH (compile-3.6/7).
     */

    if (optsIndex != -1) {
	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }








    if (resultIndex != -1) {
	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);

	TclEmitOpcode(	INST_POP,			envPtr);
    }

    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --