summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c188
1 files changed, 19 insertions, 169 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 89305e6..9607d6e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -107,63 +107,6 @@ long tclObjsFreed = 0;
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
-/*
- * Support pre-8.5 bytecodes unless specifically requested otherwise.
- */
-
-#ifndef TCL_SUPPORT_84_BYTECODE
-#define TCL_SUPPORT_84_BYTECODE 1
-#endif
-
-#if TCL_SUPPORT_84_BYTECODE
-/*
- * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
- * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
- */
-
-typedef struct {
- const char *name; /* Name of function. */
- int numArgs; /* Number of arguments for function. */
-} BuiltinFunc;
-
-/*
- * Table describing the built-in math functions. Entries in this table are
- * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
- * operand byte.
- */
-
-static BuiltinFunc const tclBuiltinFuncTable[] = {
- {"acos", 1},
- {"asin", 1},
- {"atan", 1},
- {"atan2", 2},
- {"ceil", 1},
- {"cos", 1},
- {"cosh", 1},
- {"exp", 1},
- {"floor", 1},
- {"fmod", 2},
- {"hypot", 2},
- {"log", 1},
- {"log10", 1},
- {"pow", 2},
- {"sin", 1},
- {"sinh", 1},
- {"sqrt", 1},
- {"tan", 1},
- {"tanh", 1},
- {"abs", 1},
- {"double", 1},
- {"int", 1},
- {"rand", 0},
- {"round", 1},
- {"srand", 1},
- {"wide", 1},
- {NULL, 0},
-};
-
-#define LAST_BUILTIN_FUNC 25
-#endif
/*
* NR_TEBC
@@ -171,7 +114,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
* Minimal data required to fully reconstruct the execution state.
*/
-typedef struct TEBCdata {
+typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
ptrdiff_t *catchTop; /* These fields are used on return TO this */
@@ -330,7 +273,7 @@ VarHashCreateVar(
NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
default: \
if ((condition) < 0) { \
- TclNewIntObj(objResultPtr, -1); \
+ TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
@@ -351,7 +294,7 @@ VarHashCreateVar(
NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
default: \
if ((condition) < 0) { \
- TclNewIntObj(objResultPtr, -1); \
+ TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
@@ -362,7 +305,7 @@ VarHashCreateVar(
#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
do{ \
if ((condition) < 0) { \
- TclNewIntObj(objResultPtr, -1); \
+ TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
@@ -371,7 +314,7 @@ VarHashCreateVar(
#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
do{ \
if ((condition) < 0) { \
- TclNewIntObj(objResultPtr, -1); \
+ TclNewLongObj(objResultPtr, -1); \
} else { \
objResultPtr = TCONST((condition) > 0); \
} \
@@ -939,9 +882,9 @@ TclCreateExecEnv(
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
- TclNewBooleanObj(eePtr->constants[0], 0);
+ TclNewLongObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
- TclNewBooleanObj(eePtr->constants[1], 1);
+ TclNewLongObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
@@ -3067,90 +3010,15 @@ TEBCresume(
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
-#if TCL_SUPPORT_84_BYTECODE
- case INST_CALL_BUILTIN_FUNC1:
- /*
- * Call one of the built-in pre-8.5 Tcl math functions. This
- * translates to INST_INVOKE_STK1 with the first argument of
- * ::tcl::mathfunc::$objv[0]. We need to insert the named math
- * function into the stack.
- */
-
- opnd = TclGetUInt1AtPtr(pc+1);
- if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
- TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
- Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
- }
-
- TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
- Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
-
- /*
- * Only 0, 1 or 2 args.
- */
-
- {
- int numArgs = tclBuiltinFuncTable[opnd].numArgs;
- Tcl_Obj *tmpPtr1, *tmpPtr2;
-
- if (numArgs == 0) {
- PUSH_OBJECT(objPtr);
- } else if (numArgs == 1) {
- tmpPtr1 = POP_OBJECT();
- PUSH_OBJECT(objPtr);
- PUSH_OBJECT(tmpPtr1);
- Tcl_DecrRefCount(tmpPtr1);
- } else {
- tmpPtr2 = POP_OBJECT();
- tmpPtr1 = POP_OBJECT();
- PUSH_OBJECT(objPtr);
- PUSH_OBJECT(tmpPtr1);
- PUSH_OBJECT(tmpPtr2);
- Tcl_DecrRefCount(tmpPtr1);
- Tcl_DecrRefCount(tmpPtr2);
- }
- objc = numArgs + 1;
- }
- pcAdjustment = 2;
- goto doInvocation;
-
- case INST_CALL_FUNC1:
- /*
- * Call a non-builtin Tcl math function previously registered by a
- * call to Tcl_CreateMathFunc pre-8.5. This is essentially
- * INST_INVOKE_STK1 converting the first arg to
- * ::tcl::mathfunc::$objv[0].
- */
-
- objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
- * name is the 0-th argument. */
-
- objPtr = OBJ_AT_DEPTH(objc-1);
- TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
- Tcl_AppendObjToObj(tmpPtr, objPtr);
- Tcl_DecrRefCount(objPtr);
-
- /*
- * Variation of PUSH_OBJECT.
- */
-
- OBJ_AT_DEPTH(objc-1) = tmpPtr;
- Tcl_IncrRefCount(tmpPtr);
-
- pcAdjustment = 2;
- goto doInvocation;
-#else
/*
* INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
- * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
- * remains for existing bytecode precompiled files.
+ * changes to add a ::tcl::mathfunc namespace in 8.5.
*/
case INST_CALL_BUILTIN_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
case INST_CALL_FUNC1:
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
-#endif
case INST_INVOKE_REPLACE:
objc = TclGetUInt4AtPtr(pc+1);
@@ -4525,7 +4393,7 @@ TEBCresume(
NEXT_INST_F(1, 0, 1);
}
case INST_INFO_LEVEL_NUM:
- TclNewIntObj(objResultPtr, iPtr->varFramePtr->level);
+ TclNewLongObj(objResultPtr, iPtr->varFramePtr->level);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
case INST_INFO_LEVEL_ARGS: {
@@ -4893,7 +4761,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclNewIntObj(objResultPtr, length);
+ TclNewLongObj(objResultPtr, length);
TRACE_APPEND(("%d\n", length));
NEXT_INST_F(1, 1, 1);
@@ -5375,7 +5243,7 @@ TEBCresume(
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
length = Tcl_GetCharLength(valuePtr);
- TclNewIntObj(objResultPtr, length);
+ TclNewLongObj(objResultPtr, length);
TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
@@ -5787,7 +5655,7 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
@@ -5808,7 +5676,7 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
- TclNewIntObj(objResultPtr, match);
+ TclNewLongObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
case INST_STR_CLASS:
@@ -5987,7 +5855,7 @@ TEBCresume(
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
}
- TclNewIntObj(objResultPtr, type1);
+ TclNewLongObj(objResultPtr, type1);
TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
NEXT_INST_F(1, 1, 1);
@@ -6194,7 +6062,7 @@ TEBCresume(
if (l1 > 0L) {
objResultPtr = TCONST(0);
} else {
- TclNewIntObj(objResultPtr, -1);
+ TclNewLongObj(objResultPtr, -1);
}
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
@@ -6391,16 +6259,6 @@ TEBCresume(
w2 = (Tcl_WideInt) l2;
wResult = w1 - w2;
#ifdef TCL_WIDE_INT_IS_LONG
- /*
- * Must check for overflow. The macro tests for overflows in
- * sums by looking at the sign bits. As we have a subtraction
- * here, we are adding -w2. As -w2 could in turn overflow, we
- * test with ~w2 instead: it has the opposite sign bit to w2
- * so it does the job. Note that the only "bad" case (w2==0)
- * is irrelevant for this macro, as in that case w1 and
- * wResult have the same sign and there is no overflow anyway.
- */
-
if (Overflowing(w1, ~w2, wResult)) {
goto overflow;
}
@@ -7094,7 +6952,7 @@ TEBCresume(
NEXT_INST_F(1, 0, -1);
case INST_PUSH_RETURN_CODE:
- TclNewIntObj(objResultPtr, result);
+ TclNewLongObj(objResultPtr, result);
TRACE(("=> %u\n", result));
NEXT_INST_F(1, 0, 1);
@@ -9646,16 +9504,7 @@ IllegalExprOperandType(
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
- int numBytes;
- const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
-
- if (numBytes == 0) {
- description = "empty string";
- } else if (TclCheckBadOctal(NULL, bytes)) {
- description = "invalid octal number";
- } else {
- description = "non-numeric string";
- }
+ description = "non-numeric string";
} else if (type == TCL_NUMBER_NAN) {
description = "non-numeric floating-point value";
} else if (type == TCL_NUMBER_DOUBLE) {
@@ -9666,7 +9515,8 @@ IllegalExprOperandType(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't use %s as operand of \"%s\"", description, operator));
+ "can't use %s \"%s\" as operand of \"%s\"", description,
+ Tcl_GetString(opndPtr), operator));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
generated by cgit v0.12 at 2024-11-25 16:00:35 (GMT)