Tcl Source Code

Check-in [bd1fb54305]
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:And the last bits that need fixing; the code is still less efficient than desired but should now not crash.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dkf-loop-exception-range-work
Files: files | file ages | folders
SHA1: bd1fb54305b2f19c408ca2bd7224a0dd5c0dfe1f
User & Date: dkf 2013-10-20 18:11:35
Context
2013-10-20
18:15
[2835313] Ensure correct stack balance when break and continue exceptions are about: the hard cases ... check-in: 582877d8ab user: dkf tags: trunk
18:11
And the last bits that need fixing; the code is still less efficient than desired but should now not... Closed-Leaf check-in: bd1fb54305 user: dkf tags: dkf-loop-exception-range-work
2013-10-19
14:11
Fix handling of 'invokeExpanded' and start to do 'returnStk'. check-in: 7e41c534a9 user: dkf tags: dkf-loop-exception-range-work
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclAssembly.c.

   242    242   			    int count);
   243    243   static void		BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
   244    244   			    int opnd, int count);
   245    245   static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
   246    246   			    int opnd, int count);
   247    247   static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
   248    248   			    int param, int count);
          249  +static void		BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
          250  +			    int param, int count);
   249    251   static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
   250    252   			    int count);
   251    253   static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
   252    254   static int		CalculateJumpRelocations(AssemblyEnv*, int*);
   253    255   static int		CheckForUnclosedCatches(AssemblyEnv*);
   254    256   static int		CheckForThrowInWrongContext(AssemblyEnv*);
   255    257   static int		CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
................................................................................
   675    677       BBEmitOpcode(assemEnvPtr, tblIdx, count);
   676    678       TclEmitInt4(opnd, assemEnvPtr->envPtr);
   677    679   }
   678    680   
   679    681   /*
   680    682    *-----------------------------------------------------------------------------
   681    683    *
   682         - * BBEmitInst1or4 --
          684  + * BBEmitInst1or4, BBEmitInvoke1or4 --
   683    685    *
   684    686    *	Emits a 1- or 4-byte operation according to the magnitude of the
   685         - *	operand
          687  + *	operand. The Invoke variant generates wrapping stack-balance
          688  + *	management if necessary (which is not normally required in assembled
          689  + *	code, as loop exception ranges, expansions, breaks and continues can't
          690  + *	be issued currently).
   686    691    *
   687    692    *-----------------------------------------------------------------------------
   688    693    */
   689    694   
   690    695   static void
   691    696   BBEmitInst1or4(
   692    697       AssemblyEnv* assemEnvPtr,	/* Assembly environment */
................................................................................
   707    712       }
   708    713       TclEmitInt1(op, envPtr);
   709    714       if (param <= 0xff) {
   710    715   	TclEmitInt1(param, envPtr);
   711    716       } else {
   712    717   	TclEmitInt4(param, envPtr);
   713    718       }
          719  +    TclUpdateAtCmdStart(op, envPtr);
          720  +    BBUpdateStackReqs(bbPtr, tblIdx, count);
          721  +}
          722  +
          723  +static void
          724  +BBEmitInvoke1or4(
          725  +    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
          726  +    int tblIdx,			/* Index in TalInstructionTable of op */
          727  +    int param,			/* Variable-length parameter */
          728  +    int count)			/* Arity if variadic */
          729  +{
          730  +    CompileEnv* envPtr = assemEnvPtr->envPtr;
          731  +				/* Compilation environment */
          732  +    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
          733  +				/* Current basic block */
          734  +    int op = TalInstructionTable[tblIdx].tclInstCode;
          735  +
          736  +    if (param <= 0xff) {
          737  +	op >>= 8;
          738  +    } else {
          739  +	op &= 0xff;
          740  +    }
          741  +    TclEmitInvoke(envPtr, op, param);
   714    742       TclUpdateAtCmdStart(op, envPtr);
   715    743       BBUpdateStackReqs(bbPtr, tblIdx, count);
   716    744   }
   717    745   
   718    746   /*
   719    747    *-----------------------------------------------------------------------------
   720    748    *
................................................................................
  1446   1474   	    goto cleanup;
  1447   1475   	}
  1448   1476   	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
  1449   1477   		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
  1450   1478   	    goto cleanup;
  1451   1479   	}
  1452   1480   
  1453         -	// FIXME - use TclEmitInvoke
  1454         -	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
         1481  +	BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
  1455   1482   	break;
  1456   1483   
  1457   1484       case ASSEM_JUMP:
  1458   1485       case ASSEM_JUMP4:
  1459   1486   	if (parsePtr->numWords != 2) {
  1460   1487   	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
  1461   1488   	    goto cleanup;

Changes to generic/tclCompCmds.c.

  1671   1671       TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
  1672   1672       TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
  1673   1673       TclEmitOpcode(	INST_END_CATCH,				envPtr);
  1674   1674       TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);
  1675   1675   
  1676   1676       TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
  1677   1677       TclEmitInt4(		infoIndex,			envPtr);
  1678         -    TclEmitOpcode(	INST_RETURN_STK,			envPtr);
         1678  +    TclEmitInvoke(envPtr,INST_RETURN_STK);
  1679   1679   
  1680   1680       if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
  1681   1681   	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
  1682   1682   		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
  1683   1683       }
  1684   1684       TclStackFree(interp, keyTokenPtrs);
  1685   1685       return TCL_OK;
................................................................................
  2029   2029       }
  2030   2030       Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
  2031   2031       if (dictVar == -1) {
  2032   2032   	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
  2033   2033       } else {
  2034   2034   	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
  2035   2035       }
  2036         -    TclEmitOpcode(		INST_RETURN_STK,		envPtr);
         2036  +    TclEmitInvoke(envPtr,	INST_RETURN_STK);
  2037   2037   
  2038   2038       /*
  2039   2039        * Prepare for the start of the next command.
  2040   2040        */
  2041   2041   
  2042   2042       if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
  2043   2043   	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",

Changes to generic/tclCompCmdsGR.c.

  2377   2377   
  2378   2378       objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
  2379   2379   
  2380   2380       /*
  2381   2381        * Scan through the return options. If any are unknown at compile time,
  2382   2382        * there is no value in bytecompiling. Save the option values known in an
  2383   2383        * objv array for merging into a return options dictionary.
         2384  +     *
         2385  +     * TODO: There is potential for improvement if all option keys are known
         2386  +     * at compile time and all option values relating to '-code' and '-level'
         2387  +     * are known at compile time.
  2384   2388        */
  2385   2389   
  2386   2390       for (objc = 0; objc < numOptionWords; objc++) {
  2387   2391   	objv[objc] = Tcl_NewObj();
  2388   2392   	Tcl_IncrRefCount(objv[objc]);
  2389   2393   	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
  2390   2394   	    /*
  2391         -	     * Non-literal, so punt to run-time.
         2395  +	     * Non-literal, so punt to run-time assembly of the dictionary.
  2392   2396   	     */
  2393   2397   
  2394   2398   	    for (; objc>=0 ; objc--) {
  2395   2399   		TclDecrRefCount(objv[objc]);
  2396   2400   	    }
  2397   2401   	    TclStackFree(interp, objv);
  2398   2402   	    goto issueRuntimeReturn;

Changes to generic/tclCompCmdsSZ.c.

    95     95       (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
    96     96   #define FIXJUMP1(var) \
    97     97       TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
    98     98   #define LOAD(idx) \
    99     99       if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
   100    100   #define STORE(idx) \
   101    101       if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
          102  +#define INVOKE(name) \
          103  +    TclEmitInvoke(envPtr,INST_##name)
   102    104   
   103    105   /*
   104    106    *----------------------------------------------------------------------
   105    107    *
   106    108    * TclCompileSetCmd --
   107    109    *
   108    110    *	Procedure called to compile the "set" command.
................................................................................
   869    871   	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
   870    872   	OP(	PUSH_RETURN_OPTIONS);
   871    873   	OP(	PUSH_RESULT);
   872    874   	OP(	PUSH_RETURN_CODE);
   873    875   	OP(	END_CATCH);
   874    876   	OP(	RETURN_CODE_BRANCH);
   875    877   
   876         -	/* ERROR -> reraise it */
          878  +	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
   877    879   	OP(	RETURN_STK);
   878    880   	OP(	NOP);
   879    881   
   880    882   	/* RETURN */
   881    883   	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
   882    884   
   883    885   	/* BREAK */
................................................................................
  2392   2394   	    OP(				POP);
  2393   2395   	    PUSH(			"-during");
  2394   2396   	    OP4(			REVERSE, 2);
  2395   2397   	    OP44(			DICT_SET, 1, optionsVar);
  2396   2398   	    TclAdjustStackDepth(-1, envPtr);
  2397   2399   	    FIXJUMP1(		dontChangeOptions);
  2398   2400   	    OP4(			REVERSE, 2);
  2399         -	    OP(				RETURN_STK);
         2401  +	    INVOKE(			RETURN_STK);
  2400   2402   	}
  2401   2403   
  2402   2404   	JUMP4(				JUMP, addrsToFix[i]);
  2403   2405   	if (matchClauses[i]) {
  2404   2406   	    FIXJUMP4(	notECJumpSource);
  2405   2407   	}
  2406   2408   	FIXJUMP4(	notCodeJumpSource);
................................................................................
  2411   2413        * exception. Note also that INST_RETURN_STK can proceed to the next
  2412   2414        * instruction.
  2413   2415        */
  2414   2416   
  2415   2417       OP(					POP);
  2416   2418       LOAD(				optionsVar);
  2417   2419       LOAD(				resultVar);
  2418         -    OP(					RETURN_STK);
         2420  +    INVOKE(				RETURN_STK);
  2419   2421   
  2420   2422       /*
  2421   2423        * Fix all the jumps from taken clauses to here (which is the end of the
  2422   2424        * [try]).
  2423   2425        */
  2424   2426   
  2425   2427       if (!trapZero) {
................................................................................
  2720   2722       OP(					POP);
  2721   2723       FIXJUMP1(			finalError);
  2722   2724       STORE(				resultVar);
  2723   2725       OP(					POP);
  2724   2726       FIXJUMP1(			finalOK);
  2725   2727       LOAD(				optionsVar);
  2726   2728       LOAD(				resultVar);
  2727         -    OP(					RETURN_STK);
         2729  +    INVOKE(				RETURN_STK);
  2728   2730   
  2729   2731       return TCL_OK;
  2730   2732   }
  2731   2733   
  2732   2734   static int
  2733   2735   IssueTryFinallyInstructions(
  2734   2736       Tcl_Interp *interp,
................................................................................
  2779   2781       FIXJUMP1(		jumpSplice);
  2780   2782       OP4(				REVERSE, 4);
  2781   2783       OP(					POP);
  2782   2784       OP(					POP);
  2783   2785       OP1(				JUMP1, 7);
  2784   2786       FIXJUMP1(		jumpOK);
  2785   2787       OP4(				REVERSE, 2);
  2786         -    OP(					RETURN_STK);
         2788  +    INVOKE(				RETURN_STK);
  2787   2789       return TCL_OK;
  2788   2790   }
  2789   2791   
  2790   2792   /*
  2791   2793    *----------------------------------------------------------------------
  2792   2794    *
  2793   2795    * TclCompileUnsetCmd --