Tcl Source Code

	    if (optsIndex < 0) {
		return TCL_ERROR;
	    }
	}
    }

    /*
     * We will compile the catch command. Declare the exception range
     * that it uses.
     */

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);

    /*
     * If the body is a simple word, compile a BEGIN_CATCH instruction,
     * followed by the instructions to eval the body.
     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to
     * evaluate the substituted body.
     * Care has to be taken to make sure that substitution happens outside
     * the catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    SetLineInformation(1);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {

	 *    simple:            <mark> returnCode
	 */

	goto dropScriptAtEnd;
    }

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

    PushLiteral(envPtr, "0", 1);
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
    /* Stack at this point: ?script? <mark> result TCL_OK */

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

    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point:  ?script? */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /*
     * Update the target of the jump after the "no errors" code. 
     */

    /* Stack at this point: ?script? 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 */


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

    /*
     * End the catch

    if (optsIndex != -1) {
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
    } else {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    /*
     * Store the result if requested, and remove it from the stack
     */

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

    /*
     * Stack is now ?script? ?returnOptions? returnCode.
     * If the options dict has been requested, it is buried on the stack
     * under the return code. Reverse the stack to bring it to the top,
     * store it and remove it from the stack.
     */

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

  dropScriptAtEnd:

    /*
     * Stack is now ?script? result. Get rid of the subst'ed script
     * if it's hanging arond.
     */

    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /* 
     * Result of all this, on either branch, should have been to leave
     * one operand -- the return code -- on the stack.
     */

    if (envPtr->currStackDepth != initStackDepth + 1) {
	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
		  envPtr->currStackDepth, initStackDepth+1);
    }
    return TCL_OK;