Tcl Source Code

Check-in [215aa64c5c]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:
[kennykb-numerics-branch]
* generic/tclBasic.c: Updated more callers to make use of TclGetNumberFromObj. Removed some dead code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:215aa64c5c70555f745af43756b300d310f475dc
User & Date: dgp 2005-10-04 13:49:35
Context
2005-10-04
16:00
[kennykb-numerics-branch]
* generic/tclExecute.c: Updated TclIncrObj() to more effi...
check-in: 0f923b5cc0 user: dgp tags: kennykb-numerics-branch
13:49
[kennykb-numerics-branch]
* generic/tclBasic.c: Updated more callers to make use ...
check-in: 215aa64c5c user: dgp tags: kennykb-numerics-branch
2005-10-03
19:32
* generic/tclBasic.c: Re-implemented ExprRoundFunc and ExprEntierFunc to use TclGe...
check-in: 2435e3e70d user: dgp tags: kennykb-numerics-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.








1
2
3
4
5
6
7







2005-10-03  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Re-implemented ExprRoundFunc and ExprEntierFunc
	to use TclGetNumberFromObj.

>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
2005-10-04  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Updated more callers to make use of
	TclGetNumberFromObj.  Removed some dead code.

2005-10-03  Don Porter  <dgp@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Re-implemented ExprRoundFunc and ExprEntierFunc
	to use TclGetNumberFromObj.

Changes to generic/tclBasic.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
....
4352
4353
4354
4355
4356
4357
4358
4359
4360

4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381











4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394

4395
4396





4397


4398
4399

4400
4401
4402
4403
4404


4405
4406


4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
....
5202
5203
5204
5205
5206
5207
5208
5209

5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224




5225
5226


5227



5228
5229



5230
5231


5232

5233
5234
5235
5236
5237
5238
5239
5240
5241
5242







5243











5244

5245
5246
5247
5248
5249
5250












5251
5252
5253
5254
5255
5256
5257
....
5336
5337
5338
5339
5340
5341
5342


5343
5344
5345
5346
5347
5348
5349
5350





5351
5352
5353
5354
5355
5356
5357
....
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694

5695
5696
5697
5698
5699
5700
5701
....
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.136.2.38 2005/10/03 19:32:42 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprSrandFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprUnaryFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprWideFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);
#if 0
static int	VerifyExprObjType (Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
static void	MathFuncWrongNumArgs (Tcl_Interp* interp, int expected,
		    int actual, Tcl_Obj *CONST *objv);

#if 0
#ifndef TCL_WIDE_INT_IS_LONG
/*
 * Extract a double value from a general numeric object.
 */

#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
    if ((typePtr) == &tclIntType) {					\
	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
    } else if ((typePtr) == &tclWideIntType) {				\
	(doubleVar) = Tcl_WideAsDouble((objPtr)->internalRep.wideValue);\
    } else {								\
	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
    }
#else /* TCL_WIDE_INT_IS_LONG */
#define GET_DOUBLE_VALUE(doubleVar, objPtr, typePtr)			\
    if (((typePtr) == &tclIntType) || ((typePtr) == &tclWideIntType)) { \
	(doubleVar) = (double) (objPtr)->internalRep.longValue;		\
    } else {								\
	(doubleVar) = (objPtr)->internalRep.doubleValue;		\
    }
#endif /* TCL_WIDE_INT_IS_LONG */
#define GET_WIDE_OR_INT(resultVar, objPtr, longVar, wideVar)		\
    (resultVar) = Tcl_GetWideIntFromObj((Tcl_Interp *) NULL, (objPtr),	\
	    &(wideVar));						\
    if ((resultVar) == TCL_OK && (wideVar) >= Tcl_LongAsWide(LONG_MIN)	\
	    && (wideVar) <= Tcl_LongAsWide(LONG_MAX)) {			\
	(objPtr)->typePtr = &tclIntType;				\
	(objPtr)->internalRep.longValue = (longVar)			\
		= Tcl_WideAsLong(wideVar);				\
    }
#define IS_INTEGER_TYPE(typePtr)					\
	((typePtr) == &tclIntType || (typePtr) == &tclWideIntType)
#define IS_NUMERIC_TYPE(typePtr)					\
	(IS_INTEGER_TYPE(typePtr) || (typePtr) == &tclDoubleType)
#endif

extern TclStubs tclStubs;

/*
 * The following structure defines the commands in the Tcl core.
 */

typedef struct {
................................................................................
Tcl_ExprLongObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
    register Tcl_Obj *objPtr;	/* Expression to evaluate. */
    long *ptr;			/* Where to store long result. */
{
    Tcl_Obj *resultPtr;
    int result;
    double d;


    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }
    /* TODO - This could use a Tcl_GetNumberFromObj */
    if (Tcl_GetDoubleFromObj(interp, resultPtr, &d) != TCL_OK) {
	result = TCL_ERROR;
    } else if (resultPtr->typePtr == &tclDoubleType) {
	if (d < -(double) ULONG_MAX || d > (double) ULONG_MAX ) {
	    Tcl_SetResult(interp, "integer value too large to represent",
			  TCL_STATIC);
	    result = TCL_ERROR;
	} else if (d >= 0) {
	    *ptr = (long)(unsigned long)d;
	} else {
	    *ptr = -(long)(unsigned long)-d;
	}
    } else {
	result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
    }











    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
    return result;
}

int
Tcl_ExprDoubleObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
    register Tcl_Obj *objPtr;	/* Expression to evaluate. */
    double *ptr;		/* Where to store double result. */
{
    Tcl_Obj *resultPtr;
    int result;


    result = Tcl_ExprObj(interp, objPtr, &resultPtr);





    if (result == TCL_OK) {


#ifndef ACCEPT_NAN
	result = Tcl_GetDoubleFromObj( interp, resultPtr, ptr );

#else
	result = Tcl_GetDoubleFromObj( NULL, resultPtr, ptr );
	if (result != TCL_OK) {
	    if (resultPtr->typePtr == &tclDoubleType) {
		*ptr = resultPtr->internalRep.doubleValue;


		result = TCL_OK;
	    } else {


		Tcl_GetDoubleFromObj( interp, resultPtr, ptr );
	    }
	}
#endif
	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
    }
    return result;
}

int
Tcl_ExprBooleanObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
................................................................................
ExprAbsFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    double d;

    mp_int big;
    Tcl_Obj *valuePtr = objv[1];

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    /* TODO - an Tcl_GetNumberFromObj call might be more useful ? */
    if (Tcl_GetDoubleFromObj(NULL, valuePtr, &d) == TCL_ERROR) {
#ifdef ACCEPT_NAN
	if (valuePtr->typePtr == &tclDoubleType) {
	    Tcl_SetObjResult(interp, valuePtr);
	    return TCL_OK;
	}




#endif
	/* TODO - decide what the right error message, etc. */


	Tcl_SetObjResult(interp, Tcl_NewStringObj("non-numeric argument", -1));



	return TCL_ERROR;
    }



    if (d >= 0.0) {
	/* Non-negative values are their own absolute value */


	Tcl_SetObjResult(interp, valuePtr);

	return TCL_OK;
    }

    /*
     * To take the absolute value of a negative value, take care to
     * keep the same data type, fixed vs. floating point, and to
     * promote to wider type if needed.
     *
     * TODO: efficient use of narrower ints.
     */



















    if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) {

	mp_neg(&big, &big);
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
    }
    return TCL_OK;












}

static int
ExprBoolFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
................................................................................
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }
    if (type == TCL_NUMBER_DOUBLE) {


	mp_int big;
	if (TclInitBignumFromDouble(interp, *((CONST double *)ptr), &big)
		!= TCL_OK) {
	    /* Infinity */
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	return TCL_OK;





    }
    if (type != TCL_NUMBER_NAN) {
	/* All integers are already of integer type */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }
    /* Get the error message for NaN */
................................................................................
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *valuePtr;
    long i = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    valuePtr = objv[1];


    /* TODO: error message reform? */
#if 0
    if (VerifyExprObjType(interp, valuePtr) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    if (Tcl_GetLongFromObj(interp, valuePtr, &i) != TCL_OK) {
	/*
	 * At this point, the only other possible type is double
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"can't use floating-point value as argument to srand", -1));
	 */

	return TCL_ERROR;
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc() for more details.
     */
................................................................................
     * will always succeed.
     */

    return ExprRandFunc(clientData, interp, 1, objv);

}
 
#if 0
/*
 *----------------------------------------------------------------------
 *
 * VerifyExprObjType --
 *
 *	This procedure is called by the math functions to verify that the
 *	object is either an int or double, coercing it if necessary. If an
 *	error occurs during conversion, an error message is left in the
 *	interpreter's result unless "interp" is NULL.
 *
 * Results:
 *	TCL_OK if it was int or double, TCL_ERROR otherwise
 *
 * Side effects:
 *	objPtr is ensured to be of tclIntType, tclWideIntType or
 *	tclDoubleType.
 *
 *----------------------------------------------------------------------
 */

static int
VerifyExprObjType(interp, objPtr)
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    Tcl_Obj *objPtr;		/* Points to the object to type check. */
{
    if (IS_NUMERIC_TYPE(objPtr->typePtr)) {
	return TCL_OK;
    } else {
	int length, result = TCL_OK;
	char *s = Tcl_GetStringFromObj(objPtr, &length);

	if (TclLooksLikeInt(s, length)) {
	    long i;     /* Set but never used, needed in GET_WIDE_OR_INT */
	    Tcl_WideInt w;
	    GET_WIDE_OR_INT(result, objPtr, i, w);
	} else {
	    double d;
	    result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d);
	}
	if ((result != TCL_OK) && (interp != NULL)) {
	    if (TclCheckBadOctal((Tcl_Interp *) NULL, s)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"argument to math function was an invalid octal number",
			-1));
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"argument to math function didn't have numeric value",
			-1));
	    }
	}
	return result;
    }
}
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * MathFuncWrongNumArgs --
 *
 *	Generate an error message when a math function presents the wrong
 *	number of arguments.







|







 







<
<
<



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|

>





|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>












|
>


>
>
>
>
>

>
>

|
>
|
<
<
<
<
>
>
|
<
>
>
|
|
|
<
|
<







 







|
>

<






|
<
<
<
<
|
|
>
>
>
>
|
|
>
>
|
>
>
>
|

>
>
>
|
<
>
>
|
>



<
<
<
<
<
<
<
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
|
|
<
|
|
|
|
|
>
>
>
>
>







 







<










<

<
<
<
<
<
<
<
<
|
<
<
<
<
<
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
73
74
75
76
77
78
79



80
81
82





































83
84
85
86
87
88
89
....
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381




4382
4383
4384

4385
4386
4387
4388
4389

4390

4391
4392
4393
4394
4395
4396
4397
....
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189

5190
5191
5192
5193
5194
5195
5196




5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216

5217
5218
5219
5220
5221
5222
5223







5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
....
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358

5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
....
5679
5680
5681
5682
5683
5684
5685

5686
5687
5688
5689
5690
5691
5692
5693
5694
5695

5696








5697





5698
5699
5700
5701
5702
5703
5704
5705
....
5717
5718
5719
5720
5721
5722
5723

























































5724
5725
5726
5727
5728
5729
5730
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * 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.136.2.39 2005/10/04 13:49:36 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprSrandFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprUnaryFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);
static int	ExprWideFunc (ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *CONST *objv);



static void	MathFuncWrongNumArgs (Tcl_Interp* interp, int expected,
		    int actual, Tcl_Obj *CONST *objv);






































extern TclStubs tclStubs;

/*
 * The following structure defines the commands in the Tcl core.
 */

typedef struct {
................................................................................
Tcl_ExprLongObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
    register Tcl_Obj *objPtr;	/* Expression to evaluate. */
    long *ptr;			/* Where to store long result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    double d;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    switch (type) {
    case TCL_NUMBER_DOUBLE: {
	mp_int big;
	d = *((CONST double *)internalPtr);
	Tcl_DecrRefCount(resultPtr);
	if (TclInitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewBignumObj(&big);
	/* FALLTHROUGH */
    }
    case TCL_NUMBER_LONG:
    case TCL_NUMBER_WIDE:
    case TCL_NUMBER_BIG:
	result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
	break;

    case TCL_NUMBER_NAN:
	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
	result = TCL_ERROR;
    }

    Tcl_DecrRefCount(resultPtr);  /* discard the result object */
    return result;
}

int
Tcl_ExprDoubleObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
    register Tcl_Obj *objPtr;	/* Expression to evaluate. */
    double *ptr;		/* Where to store double result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
    if (result == TCL_OK) {
	switch (type) {
	case TCL_NUMBER_NAN:
#ifndef ACCEPT_NAN
	    result = Tcl_GetDoubleFromObj( interp, resultPtr, ptr );
	    break;
#endif




	case TCL_NUMBER_DOUBLE:
	    *ptr = *((CONST double *)internalPtr);
	    result = TCL_OK;

	    break;
	default:
	    result = Tcl_GetDoubleFromObj( interp, resultPtr, ptr );
	}
    }

    Tcl_DecrRefCount(resultPtr);  /* discard the result object */

    return result;
}

int
Tcl_ExprBooleanObj(interp, objPtr, ptr)
    Tcl_Interp *interp;		/* Context in which to evaluate the
				 * expression. */
................................................................................
ExprAbsFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    ClientData ptr;
    int type;
    mp_int big;


    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {




	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_LONG) {
	long l = *((CONST long int *)ptr);
	if (l < (long)0) {
	    if (l == LONG_MIN) {
		TclBNInitBignumFromLong(&big, l);
		goto tooLarge;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
	} else {
	    Tcl_SetObjResult(interp, objv[1]);
	}
	return TCL_OK;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	double d = *((CONST double *)ptr);
	if (d < 0.0) {

	    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	} else {
	    Tcl_SetObjResult(interp, objv[1]);
	}
	return TCL_OK;
    }








#ifndef NO_WIDE_TYPE
    if (type == TCL_NUMBER_WIDE) {
	Tcl_WideInt w = *((CONST Tcl_WideInt *)ptr);
	if (w < (Tcl_WideInt)0) {
	    if (w == LLONG_MIN) {
		TclBNInitBignumFromWideInt(&big, w);
		goto tooLarge;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
	} else {
	    Tcl_SetObjResult(interp, objv[1]);
	}
	return TCL_OK;
    }
#endif

    if (type == TCL_NUMBER_BIG) {
	/* TODO: const correctness ? */
	if (mp_cmp_d((mp_int *)ptr, 0) == MP_LT) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	    Tcl_SetObjResult(interp, objv[1]);
	}
	return TCL_OK;
    }

    if (type == TCL_NUMBER_NAN) {
#ifdef ACCEPT_NAN
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
#else
	double d;
	Tcl_GetDoubleFromObj(interp, objv[1], &d);
	return TCL_ERROR;
#endif
    }
}

static int
ExprBoolFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
................................................................................
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }
    if (type == TCL_NUMBER_DOUBLE) {
	d = *((CONST double *)ptr);
	if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
	    mp_int big;
	    if (TclInitBignumFromDouble(interp, d, &big) != TCL_OK) {

		/* Infinity */
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	    return TCL_OK;
	} else {
	    long result = (long)d;
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
	    return TCL_OK;
	}
    }
    if (type != TCL_NUMBER_NAN) {
	/* All integers are already of integer type */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }
    /* Get the error message for NaN */
................................................................................
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */
    int objc;			/* Actual parameter count */
    Tcl_Obj *CONST *objv;	/* Parameter vector */
{
    Interp *iPtr = (Interp *) interp;

    long i = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }










    if (Tcl_GetLongFromObj(interp, objv[1], &i) != TCL_OK) {





	/* TODO: more ::errorInfo here?  or in caller? */
	return TCL_ERROR;
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc() for more details.
     */
................................................................................
     * will always succeed.
     */

    return ExprRandFunc(clientData, interp, 1, objv);

}
 

























































/*
 *----------------------------------------------------------------------
 *
 * MathFuncWrongNumArgs --
 *
 *	Generate an error message when a math function presents the wrong
 *	number of arguments.