summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c176
1 files changed, 9 insertions, 167 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9071782..f9cfed9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.259 2007/06/28 21:10:37 patthoyts Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.260 2007/06/28 21:24:56 dgp Exp $
*/
#include "tclInt.h"
@@ -2936,10 +2936,6 @@ Tcl_CreateMathFunc(
OldMathFuncData *data = (OldMathFuncData *)
ckalloc(sizeof(OldMathFuncData));
- if (numArgs > MAX_MATH_ARGS) {
- Tcl_Panic("attempt to create a math function with too many args");
- }
-
data->proc = proc;
data->numArgs = numArgs;
data->argTypes = (Tcl_ValueType*) ckalloc(numArgs * sizeof(Tcl_ValueType));
@@ -2981,12 +2977,8 @@ OldMathFuncProc(
{
Tcl_Obj *valuePtr;
OldMathFuncData *dataPtr = clientData;
- Tcl_Value args[MAX_MATH_ARGS];
- Tcl_Value funcResult;
+ Tcl_Value funcResult, *args;
int result;
-#if 0
- int i;
-#endif
int j, k;
double d;
@@ -3003,59 +2995,11 @@ OldMathFuncProc(
* Convert arguments from Tcl_Obj's to Tcl_Value's.
*/
-#if 0
+ args = (Tcl_Value *)
+ TclStackAlloc(interp, dataPtr->numArgs * sizeof(Tcl_Value));
for (j = 1, k = 0; j < objc; ++j, ++k) {
- valuePtr = objv[j];
- if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /*
- * Copy the object's numeric value to the argument record, converting
- * it if necessary.
- */
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- if (dataPtr->argTypes[k] == TCL_DOUBLE) {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = i;
- } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
- args[k].type = TCL_WIDE_INT;
- args[k].wideValue = Tcl_LongAsWide(i);
- } else {
- args[k].type = TCL_INT;
- args[k].intValue = i;
- }
- } else if (valuePtr->typePtr == &tclWideIntType) {
- Tcl_WideInt w;
- TclGetWide(w,valuePtr);
- if (dataPtr->argTypes[k] == TCL_DOUBLE) {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = Tcl_WideAsDouble(w);
- } else if (dataPtr->argTypes[k] == TCL_INT) {
- args[k].type = TCL_INT;
- args[k].intValue = Tcl_WideAsLong(w);
- } else {
- args[k].type = TCL_WIDE_INT;
- args[k].wideValue = w;
- }
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (dataPtr->argTypes[k] == TCL_INT) {
- args[k].type = TCL_INT;
- args[k].intValue = (long) d;
- } else if (dataPtr->argTypes[k] == TCL_WIDE_INT) {
- args[k].type = TCL_WIDE_INT;
- args[k].wideValue = Tcl_DoubleAsWide(d);
- } else {
- args[k].type = TCL_DOUBLE;
- args[k].doubleValue = d;
- }
- }
- }
-#else
- for (j = 1, k = 0; j < objc; ++j, ++k) {
+ /* TODO: Convert to TclGetNumberFromObj() ? */
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
@@ -3072,6 +3016,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",-1));
TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
+ TclStackFree(interp, args);
return TCL_ERROR;
}
@@ -3103,6 +3048,7 @@ OldMathFuncProc(
break;
case TCL_INT:
if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
+ TclStackFree(interp, args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
@@ -3111,6 +3057,7 @@ OldMathFuncProc(
break;
case TCL_WIDE_INT:
if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
+ TclStackFree(interp, args);
return TCL_ERROR;
}
valuePtr = Tcl_GetObjResult(interp);
@@ -3119,7 +3066,6 @@ OldMathFuncProc(
break;
}
}
-#endif
/*
* Call the function.
@@ -3127,6 +3073,7 @@ OldMathFuncProc(
errno = 0;
result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
+ TclStackFree(interp, args);
if (result != TCL_OK) {
return result;
}
@@ -5934,28 +5881,6 @@ ExprDoubleFunc(
Tcl_Obj *const *objv) /* Actual parameter vector */
{
double dResult;
-#if 0
- Tcl_Obj* valuePtr;
- Tcl_Obj* oResult;
-
- /*
- * Check parameter type
- */
-
- if (objc != 2) {
- MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- GET_DOUBLE_VALUE(dResult, valuePtr, valuePtr->typePtr);
- TclNewDoubleObj(oResult, dResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
- }
- }
-
- return TCL_ERROR;
-#else
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
@@ -5971,7 +5896,6 @@ ExprDoubleFunc(
}
Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
return TCL_OK;
-#endif
}
static int
@@ -6040,46 +5964,6 @@ ExprIntFunc(
{
long iResult;
Tcl_Obj *objPtr;
-#if 0
- register Tcl_Obj *valuePtr;
- Tcl_Obj* oResult;
-
- if (objc != 2) {
- MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- if (valuePtr->typePtr == &tclIntType) {
- iResult = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- TclGetLongFromWide(iResult,valuePtr);
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (d < 0.0) {
- if (d < (double) (long) LONG_MIN) {
- tooLarge:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", NULL);
- return TCL_ERROR;
- }
- } else if (d > (double) LONG_MAX) {
- goto tooLarge;
- }
- if (IS_NAN(d) || IS_INF(d)) {
- TclExprFloatError(interp, d);
- return TCL_ERROR;
- }
- iResult = (long) d;
- }
- TclNewIntObj(oResult, iResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
- }
- }
- return TCL_ERROR;
-#else
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -6100,7 +5984,6 @@ ExprIntFunc(
}
Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
return TCL_OK;
-#endif
}
static int
@@ -6113,46 +5996,6 @@ ExprWideFunc(
{
Tcl_WideInt wResult;
Tcl_Obj *objPtr;
-#if 0
- register Tcl_Obj *valuePtr;
- Tcl_Obj *oResult;
-
- if (objc != 2) {
- MathFuncWrongNumArgs(interp, 2, objc, objv);
- } else {
- valuePtr = objv[1];
- if (VerifyExprObjType(interp, valuePtr) == TCL_OK) {
- if (valuePtr->typePtr == &tclIntType) {
- wResult = valuePtr->internalRep.longValue;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- wResult = valuePtr->internalRep.wideValue;
- } else {
- d = valuePtr->internalRep.doubleValue;
- if (d < 0.0) {
- if (d < Tcl_WideAsDouble(LLONG_MIN)) {
- tooLarge:
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "integer value too large to represent", -1));
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", NULL);
- return TCL_ERROR;
- }
- } else if (d > Tcl_WideAsDouble(LLONG_MAX)) {
- goto tooLarge;
- }
- if (IS_NAN(d) || IS_INF(d)) {
- TclExprFloatError(interp, d);
- return TCL_ERROR;
- }
- wResult = (Tcl_WideInt) d;
- }
- TclNewWideIntObj(oResult, wResult);
- Tcl_SetObjResult(interp, oResult);
- return TCL_OK;
- }
- }
- return TCL_ERROR;
-#else
if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -6173,7 +6016,6 @@ ExprWideFunc(
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
return TCL_OK;
-#endif
}
static int
generated by cgit v0.12 at 2024-08-24 17:46:26 (GMT)