Tcl Source Code

Check-in [d832f58cff]
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Improve readability from some typecasting trickery. Backported from 9.0 (thanks, dkf!)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: d832f58cfffc5f1e759e21ceb233ebd68ae5a593a69cd67bbdeecd4e7365f659
User & Date: jan.nijtmans 2024-05-20 09:54:44
Context
2024-05-20
17:00
Improve tcl::build-info implementation, adapted from dkf's result-helpers branch check-in: be8c771d22 user: jan.nijtmans tags: trunk, main
15:20
Fix [7842f33a5c]: Call chain creation could crash in destructors in some tangled cases check-in: de08cf0323 user: dkf tags: core-8-branch
09:54
Improve readability from some typecasting trickery. Backported from 9.0 (thanks, dkf!) check-in: d832f58cff user: jan.nijtmans tags: core-8-branch
09:32
Backport spacing-related changes from 9.0 check-in: f5469ec0c0 user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

481
482
483
484
485
486
487




488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
    {NULL, NULL}
};

/*
 * 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 */
    double (*fn)(double x);	/* Real function pointer */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",	ExprAbsFunc,	NULL			},
    { "acos",	ExprUnaryFunc,	acos			},
    { "asin",	ExprUnaryFunc,	asin			},
    { "atan",	ExprUnaryFunc,	atan			},
    { "atan2",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) atan2},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	cos				},
    { "cosh",	ExprUnaryFunc,	cosh			},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	exp				},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) fmod},
    { "hypot",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) hypot},
    { "int",	ExprIntFunc,	NULL			},
    { "isfinite", ExprIsFiniteFunc, NULL		},
    { "isinf",	ExprIsInfinityFunc, NULL		},
    { "isnan",	ExprIsNaNFunc,	NULL	    	},
    { "isnormal", ExprIsNormalFunc, NULL		},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "issubnormal", ExprIsSubnormalFunc, NULL,	 },
    { "isunordered", ExprIsUnorderedFunc, NULL,	 },
    { "log",	ExprUnaryFunc,	log				},
    { "log10",	ExprUnaryFunc,	log10			},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) pow},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	sin				},
    { "sinh",	ExprUnaryFunc,	sinh			},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	tan				},
    { "tanh",	ExprUnaryFunc,	tanh			},
    { "wide",	ExprWideFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.







>
>
>
>




|






|


|



|

|
|



|


|
|
|



|


|



|







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
    {NULL, NULL}
};

/*
 * Math functions. All are safe.
 */

typedef double (BuiltinUnaryFunc)(double x);
typedef double (BuiltinBinaryFunc)(double x, double y);
#define BINARY_TYPECAST(fn) \
	(BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn
typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that evaluates the function */
    BuiltinUnaryFunc *fn;	/* Real function pointer */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",	ExprAbsFunc,	NULL			},
    { "acos",	ExprUnaryFunc,	acos			},
    { "asin",	ExprUnaryFunc,	asin			},
    { "atan",	ExprUnaryFunc,	atan			},
    { "atan2",	ExprBinaryFunc,	BINARY_TYPECAST(atan2)	},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	cos			},
    { "cosh",	ExprUnaryFunc,	cosh			},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	exp			},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	BINARY_TYPECAST(fmod)	},
    { "hypot",	ExprBinaryFunc,	BINARY_TYPECAST(hypot)	},
    { "int",	ExprIntFunc,	NULL			},
    { "isfinite", ExprIsFiniteFunc, NULL		},
    { "isinf",	ExprIsInfinityFunc, NULL		},
    { "isnan",	ExprIsNaNFunc,	NULL			},
    { "isnormal", ExprIsNormalFunc, NULL		},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "issubnormal", ExprIsSubnormalFunc, NULL,		},
    { "isunordered", ExprIsUnorderedFunc, NULL,		},
    { "log",	ExprUnaryFunc,	log			},
    { "log10",	ExprUnaryFunc,	log10			},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	BINARY_TYPECAST(pow)	},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	sin			},
    { "sinh",	ExprUnaryFunc,	sinh			},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	tan			},
    { "tanh",	ExprUnaryFunc,	tanh			},
    { "wide",	ExprWideFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    }

#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T)
    /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T
     * the result is a binary incompatible with the 'standard' build of
     * Tcl: All extensions using Tcl_StatBuf need to be recompiled in
     * the same way. Therefore, this is not officially supported.
     * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet)
     */
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 40)) {
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif








|







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    }

#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T)
    /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T
     * the result is a binary incompatible with the 'standard' build of
     * Tcl: All extensions using Tcl_StatBuf need to be recompiled in
     * the same way. Therefore, this is not officially supported.
     * In stead, it is recommended to use Win64 or Tcl 9.0
     */
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 40)) {
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
    }
    return TCL_OK;
}

static int
ExprUnaryFunc(
    void *clientData,	/* Contains the address of a function that
				 * takes one double argument and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    int code;
    double d;
    double (*func)(double) = (double (*)(double)) clientData;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN







|









|







7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
    }
    return TCL_OK;
}

static int
ExprUnaryFunc(
    void *clientData,		/* Contains the address of a function that
				 * takes one double argument and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    int code;
    double d;
    BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprBinaryFunc(
    void *clientData,	/* Contains the address of a function that
				 * takes two double arguments and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    int code;
    double d1, d2;
    double (*func)(double, double) = (double (*)(double, double)) clientData;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN







|









|







7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprBinaryFunc(
    void *clientData,		/* Contains the address of a function that
				 * takes two double arguments and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    int code;
    double d1, d2;
    BuiltinBinaryFunc *func = (BuiltinBinaryFunc *)clientData;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
8067
8068
8069
8070
8071
8072
8073
8074

8075
8076
8077
8078
8079
8080
8081
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++; numBytes--;

		}
	    }
	    goto unChanged;
	} else if (l == WIDE_MIN) {
	    if (sizeof(Tcl_WideInt) > sizeof(int64_t)) {
		Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN;
		if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1,







|
>







8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++;
		    numBytes--;
		}
	    }
	    goto unChanged;
	} else if (l == WIDE_MIN) {
	    if (sizeof(Tcl_WideInt) > sizeof(int64_t)) {
		Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN;
		if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1,