Tcl Source Code

Check-in [9bfc46124e]
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: Extended the domain of round(.) to all non-Inf, non-NaN doubles, using bignums for the result as needed.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1:9bfc46124e39bfac5e51ac58b87d536941cf15b8
User & Date: dgp 2005-08-25 14:58:07
Context
2005-08-25
15:46
[kennykb-numerics-branch] Merge updates from HEAD
* generic/tclExecute.c: Bug fix. ...
check-in: 6d651867f9 user: dgp tags: kennykb-numerics-branch
14:58
[kennykb-numerics-branch]
* generic/tclBasic.c: Extended the domain of round(.) t...
check-in: 9bfc46124e user: dgp tags: kennykb-numerics-branch
2005-08-24
21:49
[kennykb-numerics-branch]
* generic/tclBasic.c: Revised implementation of the cei...
check-in: 9cbb2232b7 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-08-24  Kevin Kenny  <kennykb@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Corrected some TRACE bugs that prevented
	compilation with --enable-symbols=all.
	* generic/tclStrToD.c: Revised commentary to prepare for a
>
>
>
>
>
>
>







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

	[kennykb-numerics-branch]

	* generic/tclBasic.c:	Extended the domain of round(.) to all
	non-Inf, non-NaN doubles, using bignums for the result as needed.

2005-08-24  Kevin Kenny  <kennykb@users.sourceforge.net>

	[kennykb-numerics-branch]

	* generic/tclExecute.c: Corrected some TRACE bugs that prevented
	compilation with --enable-symbols=all.
	* generic/tclStrToD.c: Revised commentary to prepare for a

Changes to generic/tclBasic.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
....
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534




5535
5536
5537
5538
5539
5540
5541
....
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
....
5594
5595
5596
5597
5598
5599
5600




5601




























5602
5603
5604
5605
5606
5607
5608
 * 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.27 2005/08/24 21:49:22 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
ExprRoundFunc(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 */
{
    Tcl_Obj *valuePtr, *resPtr;
    double d, a, f;
    mp_int big;





    /* Check the argument count. */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 1, objc, objv);
	return TCL_ERROR;
    }
................................................................................
    }
    if ((valuePtr->typePtr == &tclIntType) ||
	    (valuePtr->typePtr == &tclWideIntType)) {
	Tcl_SetObjResult(interp, valuePtr);
	return TCL_OK;
    }
    GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);
#else
    if (Tcl_GetDoubleFromObj(interp, valuePtr, &d) != TCL_OK) {
	/* Non-numeric */
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) {
	/* Integers are already rounded */
	mp_clear(&big);
	Tcl_SetObjResult(interp, valuePtr);
	return TCL_OK;
    }
#endif

    /* 
     * Round the number to the nearest integer.  I'd like to use rint()
     * or nearbyint(), but they are far from universal.
     */

    a = fabs(d);
................................................................................

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "integer value too large to represent", -1));
    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	    "integer value too large to represent", (char *) NULL);

    return TCL_ERROR;

































}

static int
ExprSrandFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */







|







 







|
|

>
>
>
>







 







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







 







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







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
....
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
....
5553
5554
5555
5556
5557
5558
5559












5560
5561
5562
5563
5564
5565
5566
....
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
 * 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.28 2005/08/25 14:58:07 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <math.h>
#include "tommath.h"
................................................................................
ExprRoundFunc(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 */
{
    Tcl_Obj *valuePtr;
    double d, fractPart, intPart;
    mp_int big;
#if 0
    double a, f;
    Tcl_Obj *resPtr;
#endif

    /* Check the argument count. */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 1, objc, objv);
	return TCL_ERROR;
    }
................................................................................
    }
    if ((valuePtr->typePtr == &tclIntType) ||
	    (valuePtr->typePtr == &tclWideIntType)) {
	Tcl_SetObjResult(interp, valuePtr);
	return TCL_OK;
    }
    GET_DOUBLE_VALUE(d, valuePtr, valuePtr->typePtr);













    /* 
     * Round the number to the nearest integer.  I'd like to use rint()
     * or nearbyint(), but they are far from universal.
     */

    a = fabs(d);
................................................................................

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "integer value too large to represent", -1));
    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
	    "integer value too large to represent", (char *) NULL);

    return TCL_ERROR;
#else
    if (Tcl_GetDoubleFromObj(interp, valuePtr, &d) != TCL_OK) {
	/* Non-numeric */
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(NULL, valuePtr, &big) == TCL_OK) {
	/* Integers are already rounded */
	mp_clear(&big);
	Tcl_SetObjResult(interp, valuePtr);
	return TCL_OK;
    }
    fractPart = modf(d, &intPart);
    if (fractPart == 0.0) {
	if (TclInitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	if (TclInitBignumFromDouble(interp, intPart, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (fractPart < 0.0) {
	    if (fractPart < -0.5
		    || (fractPart == -0.5 && fmod(intPart, 2.0) != 0.0)) {
		mp_sub_d(&big, 1, &big);
	    }
	} else if (fractPart > 0.5
		|| (fractPart == 0.5 && fmod(intPart, 2.0) != 0.0)) {
	    mp_add_d(&big, 1, &big);
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
    return TCL_OK;
#endif
}

static int
ExprSrandFunc(clientData, interp, objc, objv)
    ClientData clientData;	/* Ignored. */
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * function. */