概要
include
"tclInt.h"
"tclCompile.h"
<float.h>
<limits.h>
<math.h>
"tommath.h"
変数宣言
/*
* Determine whether we're using IEEE floating point
*/
#if
&& (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
# define IEEE_FLOATING_POINT
/* Largest odd integer that can be represented exactly in a double */
# define MAX_EXACT 9007199254740991.0
#endif
/*
* The following structure defines the client data for a math function
* registered with Tcl_CreateMathFunc
*/
typedef struct OldMathFuncData {
Tcl_MathProc *proc; /* Handler function */
int numArgs; /* Number of args expected */
Tcl_ValueType *argTypes; /* Types of the args */
[[ClientData]] clientData; /* Client data for the handler function */
} OldMathFuncData;
/*
* The following structure define the commands in the Tcl core.
*/
typedef struct {
const char *name; /* Name of object-based command. */
Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
CompileProc *compileProc; /* Function called to compile command. */
int isSafe; /* If non-zero, command will be present in
* safe interpreter. Otherwise it will be
* hidden. */
} CmdInfo;
/*
* The built-in commands, and the functions that implement them:
*/
static const CmdInfo builtInCmds[] = {
/*
* Commands in the generic core.
*/
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, 1},
{"apply", Tcl_ApplyObjCmd, NULL, 1},
{"array", Tcl_ArrayObjCmd, NULL, 1},
{"binary", Tcl_BinaryObjCmd, NULL, 1},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, 1},
#ifndef
EXCLUDE_OBSOLETE_COMMANDS
{"case", Tcl_CaseObjCmd, NULL, 1},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, 1},
{"concat", Tcl_ConcatObjCmd, NULL, 1},
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, 1},
{"error", Tcl_ErrorObjCmd, NULL, 1},
{"eval", Tcl_EvalObjCmd, NULL, 1},
{"expr", Tcl_ExprObjCmd, TclCompileExprCmd, 1},
{"for", Tcl_ForObjCmd, TclCompileForCmd, 1},
{"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, 1},
{"format", Tcl_FormatObjCmd, NULL, 1},
{"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, 1},
{"if", Tcl_IfObjCmd, TclCompileIfCmd, 1},
{"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, 1},
{"join", Tcl_JoinObjCmd, NULL, 1},
{"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, 1},
{"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, 1},
{"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, 1},
{"linsert", Tcl_LinsertObjCmd, NULL, 1},
{"list", Tcl_ListObjCmd, TclCompileListCmd, 1},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, 1},
{"lrange", Tcl_LrangeObjCmd, NULL, 1},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, 1},
{"lreplace", Tcl_LreplaceObjCmd, NULL, 1},
{"lreverse", Tcl_LreverseObjCmd, NULL, 1},
{"lsearch", Tcl_LsearchObjCmd, NULL, 1},
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, 1},
{"lsort", Tcl_LsortObjCmd, NULL, 1},
{"namespace", Tcl_NamespaceObjCmd, TclCompileNamespaceCmd, 1},
{"package", Tcl_PackageObjCmd, NULL, 1},
{"proc", Tcl_ProcObjCmd, NULL, 1},
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, 1},
{"regsub", Tcl_RegsubObjCmd, NULL, 1},
{"rename", Tcl_RenameObjCmd, NULL, 1},
{"return", Tcl_ReturnObjCmd, TclCompileReturnCmd, 1},
{"scan", Tcl_ScanObjCmd, NULL, 1},
{"set", Tcl_SetObjCmd, TclCompileSetCmd, 1},
{"split", Tcl_SplitObjCmd, NULL, 1},
{"subst", Tcl_SubstObjCmd, NULL, 1},
{"switch", Tcl_SwitchObjCmd, TclCompileSwitchCmd, 1},
{"trace", Tcl_TraceObjCmd, NULL, 1},
{"unset", Tcl_UnsetObjCmd, NULL, 1},
{"uplevel", Tcl_UplevelObjCmd, NULL, 1},
{"upvar", Tcl_UpvarObjCmd, TclCompileUpvarCmd, 1},
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, 1},
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, 1},
/*
* Commands in the OS-interface. Note that many of these are unsafe.
*/
{"after", Tcl_AfterObjCmd, NULL, 1},
{"cd", Tcl_CdObjCmd, NULL, 0},
{"close", Tcl_CloseObjCmd, NULL, 1},
{"eof", Tcl_EofObjCmd, NULL, 1},
{"encoding", Tcl_EncodingObjCmd, NULL, 0},
{"exec", Tcl_ExecObjCmd, NULL, 0},
{"exit", Tcl_ExitObjCmd, NULL, 0},
{"fblocked", Tcl_FblockedObjCmd, NULL, 1},
{"fconfigure", Tcl_FconfigureObjCmd, NULL, 0},
{"fcopy", Tcl_FcopyObjCmd, NULL, 1},
{"file", Tcl_FileObjCmd, NULL, 0},
{"fileevent", Tcl_FileEventObjCmd, NULL, 1},
{"flush", Tcl_FlushObjCmd, NULL, 1},
{"gets", Tcl_GetsObjCmd, NULL, 1},
{"glob", Tcl_GlobObjCmd, NULL, 0},
{"load", Tcl_LoadObjCmd, NULL, 0},
{"open", Tcl_OpenObjCmd, NULL, 0},
{"pid", Tcl_PidObjCmd, NULL, 1},
{"puts", Tcl_PutsObjCmd, NULL, 1},
{"pwd", Tcl_PwdObjCmd, NULL, 0},
{"read", Tcl_ReadObjCmd, NULL, 1},
{"seek", Tcl_SeekObjCmd, NULL, 1},
{"socket", Tcl_SocketObjCmd, NULL, 0},
{"source", Tcl_SourceObjCmd, NULL, 0},
{"tell", Tcl_TellObjCmd, NULL, 1},
{"time", Tcl_TimeObjCmd, NULL, 1},
{"unload", Tcl_UnloadObjCmd, NULL, 0},
{"update", Tcl_UpdateObjCmd, NULL, 1},
{"vwait", Tcl_VwaitObjCmd, NULL, 1},
{NULL, NULL, NULL, 0}
};
/*
* Math functions. All are safe.
*/
typedef struct {
const char *name; /* Name of the function. The full name is
* "::tcl::mathfunc::<name>". */
Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */
ClientData clientData; /* Client data for the function */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "abs", ExprAbsFunc, NULL },
{ "acos", ExprUnaryFunc, (ClientData) acos },
{ "asin", ExprUnaryFunc, (ClientData) asin },
{ "atan", ExprUnaryFunc, (ClientData) atan },
{ "atan2", ExprBinaryFunc, (ClientData) atan2 },
{ "bool", ExprBoolFunc, NULL },
{ "ceil", ExprCeilFunc, NULL },
{ "cos", ExprUnaryFunc, (ClientData) cos },
{ "cosh", ExprUnaryFunc, (ClientData) cosh },
{ "double", ExprDoubleFunc, NULL },
{ "entier", ExprEntierFunc, NULL },
{ "exp", ExprUnaryFunc, (ClientData) exp },
{ "floor", ExprFloorFunc, NULL },
{ "fmod", ExprBinaryFunc, (ClientData) fmod },
{ "hypot", ExprBinaryFunc, (ClientData) hypot },
{ "int", ExprIntFunc, NULL },
{ "isqrt", ExprIsqrtFunc, NULL },
{ "log", ExprUnaryFunc, (ClientData) log },
{ "log10", ExprUnaryFunc, (ClientData) log10 },
{ "pow", ExprBinaryFunc, (ClientData) pow },
{ "rand", ExprRandFunc, NULL },
{ "round", ExprRoundFunc, NULL },
{ "sin", ExprUnaryFunc, (ClientData) sin },
{ "sinh", ExprUnaryFunc, (ClientData) sinh },
{ "sqrt", ExprSqrtFunc, NULL },
{ "srand", ExprSrandFunc, NULL },
{ "tan", ExprUnaryFunc, (ClientData) tan },
{ "tanh", ExprUnaryFunc, (ClientData) tanh },
{ "wide", ExprWideFunc, NULL },
{ NULL, NULL, NULL }
};
/*
* TIP#174's math operators. All are safe.
*/
typedef struct {
const char *name; /* Name of object-based command. */
Tcl_ObjCmdProc *objProc; /* Object-based function for command. */
CompileProc *compileProc; /* Function called to compile command. */
union {
int numArgs;
int identity;
} i;
const char *expected; /* For error message, what argument(s)
* were expected. */
} OpCmdInfo;
static const OpCmdInfo mathOpCmds[] = {
{ "~", TclSingleOpCmd, TclCompileInvertOpCmd,
/* numArgs */ {1}, "integer"},
{ "!", TclSingleOpCmd, TclCompileNotOpCmd,
/* numArgs */ {1}, "boolean"},
{ "+", TclVariadicOpCmd, TclCompileAddOpCmd,
/* identity */ {0}, NULL},
{ "*", TclVariadicOpCmd, TclCompileMulOpCmd,
/* identity */ {1}, NULL},
{ "&", TclVariadicOpCmd, TclCompileAndOpCmd,
/* identity */ {-1}, NULL},
{ "|", TclVariadicOpCmd, TclCompileOrOpCmd,
/* identity */ {0}, NULL},
{ "^", TclVariadicOpCmd, TclCompileXorOpCmd,
/* identity */ {0}, NULL},
{ "**", TclVariadicOpCmd, TclCompilePowOpCmd,
/* identity */ {1}, NULL},
{ "<<", TclSingleOpCmd, TclCompileLshiftOpCmd,
/* numArgs */ {2}, "integer shift"},
{ ">>", TclSingleOpCmd, TclCompileRshiftOpCmd,
/* numArgs */ {2}, "integer shift"},
{ "%", TclSingleOpCmd, TclCompileModOpCmd,
/* numArgs */ {2}, "integer integer"},
{ "!=", TclSingleOpCmd, TclCompileNeqOpCmd,
/* numArgs */ {2}, "value value"},
{ "ne", TclSingleOpCmd, TclCompileStrneqOpCmd,
/* numArgs */ {2}, "value value"},
{ "in", TclSingleOpCmd, TclCompileInOpCmd,
/* numArgs */ {2}, "value list"},
{ "ni", TclSingleOpCmd, TclCompileNiOpCmd,
/* numArgs */ {2}, "value list"},
{ "-", TclNoIdentOpCmd, TclCompileMinusOpCmd,
/* unused */ {0}, "value ?value ...?"},
{ "/", TclNoIdentOpCmd, TclCompileDivOpCmd,
/* unused */ {0}, "value ?value ...?"},
{ "<", TclSortingOpCmd, TclCompileLessOpCmd,
/* unused */ {0}, NULL},
{ "<=", TclSortingOpCmd, TclCompileLeqOpCmd,
/* unused */ {0}, NULL},
{ ">", TclSortingOpCmd, TclCompileGreaterOpCmd,
/* unused */ {0}, NULL},
{ ">=", TclSortingOpCmd, TclCompileGeqOpCmd,
/* unused */ {0}, NULL},
{ "==", TclSortingOpCmd, TclCompileEqOpCmd,
/* unused */ {0}, NULL},
{ "eq", TclSortingOpCmd, TclCompileStreqOpCmd,
/* unused */ {0}, NULL},
{ NULL, NULL, NULL,
{0}, NULL}
};
/*
* Macros for stack checks. The goal of these macros is to allow the size of
* the stack to be checked (so preventing overflow) in a *cheap* way. Note
* that the check needs to be (amortized) cheap since it is on the critical
* path for recursion.
*/
#if
defined(TCL_NO_STACK_CHECK)
/*
* Stack check disabled: make them noops.
*/
# define CheckCStack(interp, localIntPtr) 1
# define GetCStackParams(iPtr) /* do nothing */
#elif
defined(TCL_CROSS_COMPILE)
/*
* This variable is static and only set *once*, during library initialization.
* It therefore needs no thread guards.
*/
static int stackGrowsDown = 1;
# define GetCStackParams(iPtr) \
stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
# define CheckCStack(iPtr, localIntPtr) \
(stackGrowsDown \
? ((localIntPtr) > (iPtr)->stackBound) \
: ((localIntPtr) < (iPtr)->stackBound) \
)
#else
/* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
# define GetCStackParams(iPtr) \
TclpGetCStackParams(&((iPtr)->stackBound))
# ifdef TCL_STACK_GROWS_UP
# define CheckCStack(iPtr, localIntPtr) \
(!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
# else /* TCL_STACK_GROWS_UP */
# define CheckCStack(iPtr, localIntPtr) \
((localIntPtr) > (iPtr)->stackBound)
# endif /* TCL_STACK_GROWS_UP */
#endif
/* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */
関数
最終更新：2011年11月01日 10:53
