Tcl Source Code

Check-in [dd93281cd4]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
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/tclExecute.c: Revise TclIncrObj() to call Tcl_GetBignumAndClearObj.
* generic/tcl.decls: Add Tcl_GetBignumAndClearObj. * generic/tclObj.c:
* generic/tclDecls.h: make genstubs * generic/tclStubInit.c:
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: dd93281cd4676aa92e6c0c590631841bad708835
User & Date: dgp 2005-09-20 14:11:51
Context
2005-09-23
04:03
[kennykb-numerics-branch]
* generic/tclStrToD.c: Memory leak. Comment in TclSetBi...
check-in: 961337390c user: dgp tags: kennykb-numerics-branch
2005-09-20
14:11
[kennykb-numerics-branch]
* generic/tclExecute.c: Revise TclIncrObj() to call ...
check-in: dd93281cd4 user: dgp tags: kennykb-numerics-branch
2005-09-16
19:29
[kennykb-numerics-branch]
* generic/tclInt.h: Added TclBNInitBigNumFrom...
check-in: 6e1addf33e 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-09-16  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:		Added TclBNInitBigNumFromWideInt()
	* generic/tclTomMathInterface.c:	so that every caller isn't
	required to duplicate the sign logic to use the unsigned interface.
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
2005-09-20  Don Porter  <[email protected]>

	[kennykb-numerics-branch]
	
	* generic/tclExecute.c:	Revise TclIncrObj() to call
	Tcl_GetBignumAndClearObj.

	* generic/tcl.decls:	Add Tcl_GetBignumAndClearObj.
	* generic/tclObj.c:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2005-09-16  Don Porter  <[email protected]>

	[kennykb-numerics-branch]

	* generic/tclInt.h:		Added TclBNInitBigNumFromWideInt()
	* generic/tclTomMathInterface.c:	so that every caller isn't
	required to duplicate the sign logic to use the unsigned interface.

Changes to generic/tcl.decls.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1999
2000
2001
2002
2003
2004
2005


2006

2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
#	
#
# 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: tcl.decls,v 1.105.2.8 2005/08/25 15:46:30 dgp Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 557 generic {
    void Tcl_SetBignumObj( Tcl_Obj* obj, mp_int* value )
}
declare 558 generic {
    int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
}




# TIP #208:
declare 559 generic {
    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
}
declare 560 generic {
    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
	    Tcl_ChannelType *chanTypePtr)
}

# TIP#219 (Tcl Channel Reflection API) akupries

declare 561 generic {
    void Tcl_SetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj* msg)
}
declare 562 generic {
    void Tcl_GetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj** msg)
}
declare 563 generic {
    void Tcl_SetChannelError (Tcl_Channel chan, Tcl_Obj* msg)
}
declare 564 generic {
    void Tcl_GetChannelError (Tcl_Channel chan, Tcl_Obj** msg)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.






|







 







>
>
|
>

|


|






|


|


|


|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
#	
#
# 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: tcl.decls,v 1.105.2.9 2005/09/20 14:11:51 dgp Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 557 generic {
    void Tcl_SetBignumObj( Tcl_Obj* obj, mp_int* value )
}
declare 558 generic {
    int Tcl_GetBignumFromObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
}
declare 559 generic {
    int Tcl_GetBignumAndClearObj( Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value )
}

# TIP #208:
declare 560 generic {
    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
}
declare 561 generic {
    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
	    Tcl_ChannelType *chanTypePtr)
}

# TIP#219 (Tcl Channel Reflection API) akupries

declare 562 generic {
    void Tcl_SetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj* msg)
}
declare 563 generic {
    void Tcl_GetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj** msg)
}
declare 564 generic {
    void Tcl_SetChannelError (Tcl_Channel chan, Tcl_Obj* msg)
}
declare 565 generic {
    void Tcl_GetChannelError (Tcl_Channel chan, Tcl_Obj** msg)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3479
3480
3481
3482
3483
3484
3485







3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
....
4116
4117
4118
4119
4120
4121
4122

4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
....
6398
6399
6400
6401
6402
6403
6404




6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.107.2.8 2005/09/15 20:58:39 dgp Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
................................................................................
				mp_int* value));
#endif
#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
#define Tcl_GetBignumFromObj_TCL_DECLARED
/* 558 */
EXTERN int		Tcl_GetBignumFromObj _ANSI_ARGS_((Tcl_Interp* interp, 
				Tcl_Obj* obj, mp_int* value));







#endif
#ifndef Tcl_TruncateChannel_TCL_DECLARED
#define Tcl_TruncateChannel_TCL_DECLARED
/* 559 */
EXTERN int		Tcl_TruncateChannel _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_WideInt length));
#endif
#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
#define Tcl_ChannelTruncateProc_TCL_DECLARED
/* 560 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc _ANSI_ARGS_((
				Tcl_ChannelType * chanTypePtr));
#endif
#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
#define Tcl_SetChannelErrorInterp_TCL_DECLARED
/* 561 */
EXTERN void		Tcl_SetChannelErrorInterp _ANSI_ARGS_((
				Tcl_Interp* interp, Tcl_Obj* msg));
#endif
#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
#define Tcl_GetChannelErrorInterp_TCL_DECLARED
/* 562 */
EXTERN void		Tcl_GetChannelErrorInterp _ANSI_ARGS_((
				Tcl_Interp* interp, Tcl_Obj** msg));
#endif
#ifndef Tcl_SetChannelError_TCL_DECLARED
#define Tcl_SetChannelError_TCL_DECLARED
/* 563 */
EXTERN void		Tcl_SetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_Obj* msg));
#endif
#ifndef Tcl_GetChannelError_TCL_DECLARED
#define Tcl_GetChannelError_TCL_DECLARED
/* 564 */
EXTERN void		Tcl_GetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_Obj** msg));
#endif

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
................................................................................
    void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
    void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
    Tcl_Obj* (*tcl_NewBignumObj) _ANSI_ARGS_((mp_int* value)); /* 555 */
    Tcl_Obj* (*tcl_DbNewBignumObj) _ANSI_ARGS_((mp_int* value, CONST char* file, int line)); /* 556 */
    void (*tcl_SetBignumObj) _ANSI_ARGS_((Tcl_Obj* obj, mp_int* value)); /* 557 */
    int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */

    int (*tcl_TruncateChannel) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt length)); /* 559 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 560 */
    void (*tcl_SetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* msg)); /* 561 */
    void (*tcl_GetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj** msg)); /* 562 */
    void (*tcl_SetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj* msg)); /* 563 */
    void (*tcl_GetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj** msg)); /* 564 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus
................................................................................
#define Tcl_SetBignumObj \
	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
#endif
#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
#endif




#ifndef Tcl_TruncateChannel
#define Tcl_TruncateChannel \
	(tclStubsPtr->tcl_TruncateChannel) /* 559 */
#endif
#ifndef Tcl_ChannelTruncateProc
#define Tcl_ChannelTruncateProc \
	(tclStubsPtr->tcl_ChannelTruncateProc) /* 560 */
#endif
#ifndef Tcl_SetChannelErrorInterp
#define Tcl_SetChannelErrorInterp \
	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 561 */
#endif
#ifndef Tcl_GetChannelErrorInterp
#define Tcl_GetChannelErrorInterp \
	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 562 */
#endif
#ifndef Tcl_SetChannelError
#define Tcl_SetChannelError \
	(tclStubsPtr->tcl_SetChannelError) /* 563 */
#endif
#ifndef Tcl_GetChannelError
#define Tcl_GetChannelError \
	(tclStubsPtr->tcl_GetChannelError) /* 564 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */







|







 







>
>
>
>
>
>
>



|





|





|





|





|





|







 







>
|
|
|
|
|
|







 







>
>
>
>


|



|



|



|



|



|











4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
....
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
....
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.107.2.9 2005/09/20 14:11:51 dgp Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
................................................................................
				mp_int* value));
#endif
#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
#define Tcl_GetBignumFromObj_TCL_DECLARED
/* 558 */
EXTERN int		Tcl_GetBignumFromObj _ANSI_ARGS_((Tcl_Interp* interp, 
				Tcl_Obj* obj, mp_int* value));
#endif
#ifndef Tcl_GetBignumAndClearObj_TCL_DECLARED
#define Tcl_GetBignumAndClearObj_TCL_DECLARED
/* 559 */
EXTERN int		Tcl_GetBignumAndClearObj _ANSI_ARGS_((
				Tcl_Interp* interp, Tcl_Obj* obj, 
				mp_int* value));
#endif
#ifndef Tcl_TruncateChannel_TCL_DECLARED
#define Tcl_TruncateChannel_TCL_DECLARED
/* 560 */
EXTERN int		Tcl_TruncateChannel _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_WideInt length));
#endif
#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
#define Tcl_ChannelTruncateProc_TCL_DECLARED
/* 561 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc _ANSI_ARGS_((
				Tcl_ChannelType * chanTypePtr));
#endif
#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
#define Tcl_SetChannelErrorInterp_TCL_DECLARED
/* 562 */
EXTERN void		Tcl_SetChannelErrorInterp _ANSI_ARGS_((
				Tcl_Interp* interp, Tcl_Obj* msg));
#endif
#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
#define Tcl_GetChannelErrorInterp_TCL_DECLARED
/* 563 */
EXTERN void		Tcl_GetChannelErrorInterp _ANSI_ARGS_((
				Tcl_Interp* interp, Tcl_Obj** msg));
#endif
#ifndef Tcl_SetChannelError_TCL_DECLARED
#define Tcl_SetChannelError_TCL_DECLARED
/* 564 */
EXTERN void		Tcl_SetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_Obj* msg));
#endif
#ifndef Tcl_GetChannelError_TCL_DECLARED
#define Tcl_GetChannelError_TCL_DECLARED
/* 565 */
EXTERN void		Tcl_GetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
				Tcl_Obj** msg));
#endif

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
................................................................................
    void (*tcl_SetTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc* getProc, Tcl_ScaleTimeProc* scaleProc, ClientData clientData)); /* 552 */
    void (*tcl_QueryTimeProc) _ANSI_ARGS_((Tcl_GetTimeProc** getProc, Tcl_ScaleTimeProc** scaleProc, ClientData* clientData)); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 554 */
    Tcl_Obj* (*tcl_NewBignumObj) _ANSI_ARGS_((mp_int* value)); /* 555 */
    Tcl_Obj* (*tcl_DbNewBignumObj) _ANSI_ARGS_((mp_int* value, CONST char* file, int line)); /* 556 */
    void (*tcl_SetBignumObj) _ANSI_ARGS_((Tcl_Obj* obj, mp_int* value)); /* 557 */
    int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */
    int (*tcl_GetBignumAndClearObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 559 */
    int (*tcl_TruncateChannel) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt length)); /* 560 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 561 */
    void (*tcl_SetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* msg)); /* 562 */
    void (*tcl_GetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj** msg)); /* 563 */
    void (*tcl_SetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj* msg)); /* 564 */
    void (*tcl_GetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj** msg)); /* 565 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern TclStubs *tclStubsPtr;
#ifdef __cplusplus
................................................................................
#define Tcl_SetBignumObj \
	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
#endif
#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
#endif
#ifndef Tcl_GetBignumAndClearObj
#define Tcl_GetBignumAndClearObj \
	(tclStubsPtr->tcl_GetBignumAndClearObj) /* 559 */
#endif
#ifndef Tcl_TruncateChannel
#define Tcl_TruncateChannel \
	(tclStubsPtr->tcl_TruncateChannel) /* 560 */
#endif
#ifndef Tcl_ChannelTruncateProc
#define Tcl_ChannelTruncateProc \
	(tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
#endif
#ifndef Tcl_SetChannelErrorInterp
#define Tcl_SetChannelErrorInterp \
	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
#endif
#ifndef Tcl_GetChannelErrorInterp
#define Tcl_GetChannelErrorInterp \
	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
#endif
#ifndef Tcl_SetChannelError
#define Tcl_SetChannelError \
	(tclStubsPtr->tcl_SetChannelError) /* 564 */
#endif
#ifndef Tcl_GetChannelError
#define Tcl_GetChannelError \
	(tclStubsPtr->tcl_GetChannelError) /* 565 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */

Changes to generic/tclExecute.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.167.2.41 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
................................................................................
{
    mp_int value, incr;

    if (Tcl_IsShared(valuePtr)) {
	Tcl_Panic("shared object passed to TclIncrObj");
    }

    if (Tcl_GetBignumFromObj(interp, valuePtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(interp, incrPtr, &incr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }
    mp_add(&value, &incr, &value);






|







 







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002-2005 by Miguel Sofer.
 * Copyright (c) 2005 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.167.2.42 2005/09/20 14:11:51 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
................................................................................
{
    mp_int value, incr;

    if (Tcl_IsShared(valuePtr)) {
	Tcl_Panic("shared object passed to TclIncrObj");
    }

    if (Tcl_GetBignumAndClearObj(interp, valuePtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(interp, incrPtr, &incr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (reading increment)");
	return TCL_ERROR;
    }
    mp_add(&value, &incr, &value);

Changes to generic/tclObj.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
190
191
192
193
194
195
196


197
198
199
200
201
202
203
....
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698

2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724

2725
2726
2727












2728
2729
2730
2731
2732
2733
2734
....
2748
2749
2750
2751
2752
2753
2754






































































2755
2756
2757
2758
2759
2760
2761
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 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: tclObj.c,v 1.72.2.35 2005/09/16 19:29:02 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
static void		UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
#endif

static void		FreeBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
static void		DupBignum _ANSI_ARGS_((Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr));
static void		UpdateStringOfBignum _ANSI_ARGS_((Tcl_Obj *objPtr));



/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocObjEntry _ANSI_ARGS_((
			    Tcl_HashTable *tablePtr, VOID *keyPtr));
................................................................................
    return Tcl_NewBignumObj(bignumValue);
}
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBignumFromObj --
 *
 *	This procedure retrieves a 'bignum' value from a Tcl object,
 *	converting the object if necessary.

 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared.  If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in. The raw value of the object is
 *	returned, and Tcl owns that memory, so the caller should NOT invoke
 *	mp_clear afterwards.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBignumFromObj(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj* objPtr,		/* Object to read */

    mp_int* bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {

	    mp_int temp;
	    UNPACK_BIGNUM(objPtr, temp);
	    mp_init_copy(bignumValue, &temp);












	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
................................................................................
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}






































































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetBignumObj --
 *
 *	This procedure sets the value of a Tcl_Obj to a large integer.






|







 







>
>







 







|


|
>










<
<
<
<
<




|


>




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







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
....
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711





2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
....
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2001 by ActiveState Corporation.
 * Copyright (c) 2005 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: tclObj.c,v 1.72.2.36 2005/09/20 14:11:52 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>

#define BIGNUM_AUTO_NARROW 1
................................................................................
static void		UpdateStringOfWideInt _ANSI_ARGS_((Tcl_Obj *objPtr));
#endif

static void		FreeBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
static void		DupBignum _ANSI_ARGS_((Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr));
static void		UpdateStringOfBignum _ANSI_ARGS_((Tcl_Obj *objPtr));
static int		GetBignumFromObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *objPtr, int copy, mp_int *bignumValue));

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocObjEntry _ANSI_ARGS_((
			    Tcl_HashTable *tablePtr, VOID *keyPtr));
................................................................................
    return Tcl_NewBignumObj(bignumValue);
}
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * GetBignumFromObj --
 *
 *	This procedure retrieves a 'bignum' value from a Tcl object,
 *	converting the object if necessary.  Either copies or transfers
 * 	the mp_int value depending on the copy flag value passed in.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared.  If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *





 *----------------------------------------------------------------------
 */

int
GetBignumFromObj(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj* objPtr,		/* Object to read */
    int copy,			/* Whether to copy the returned bignum value */
    mp_int* bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {
	    if (copy) {
		mp_int temp;
		UNPACK_BIGNUM(objPtr, temp);
		mp_init_copy(bignumValue, &temp);
	    } else {
		if (Tcl_IsShared(objPtr)) {
		    Tcl_Panic("Tcl_GetBignumAndClearObj called on shared Tcl_Obj");
		}
		UNPACK_BIGNUM(objPtr, *bignumValue);
		objPtr->internalRep.bignumValue.digits = NULL;
		objPtr->internalRep.bignumValue.misc = 0;
		objPtr->typePtr = NULL;
		if (objPtr->bytes == NULL) {
		    TclInitStringRep(objPtr, NULL, 0);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
................................................................................
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBignumFromObj --
 *
 *	This procedure retrieves a 'bignum' value from a Tcl object,
 *	converting the object if necessary.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared.  If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in.  Tcl will initialize the mp_int
 *	as it sets the value.  The value is a copy of the value in objPtr,
 *	so it becomes the responsibility of the caller to call mp_clear on
 *	it.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBignumFromObj(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj* objPtr,		/* Object to read */
    mp_int* bignumValue)	/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 1, bignumValue);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBignumAndClearObj --
 *
 *	This procedure retrieves a 'bignum' value from a Tcl object,
 *	converting the object if necessary.
 *
 * Results:
 *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
 *
 * Side effects:
 *	A copy of bignum is stored in *bignumValue, which is expected to be
 *	uninitialized or cleared.  If conversion fails, an the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *	It is expected that the caller will NOT have invoked mp_init on the
 *	bignum value before passing it in.  Tcl will initialize the mp_int
 *	as it sets the value.  The value is transferred from the internals
 *	of objPtr to the caller, passing responsibility of the caller to
 *	call mp_clear on it.  The objPtr is cleared to hold an empty value.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBignumAndClearObj(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj* objPtr,		/* Object to read */
    mp_int* bignumValue)	/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 0, bignumValue);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetBignumObj --
 *
 *	This procedure sets the value of a Tcl_Obj to a large integer.

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
978
979
980
981
982
983
984

985
986
987
988
989
990
991
992
993
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.16 2005/08/25 15:46:31 dgp Exp $
 */

#include "tclInt.h"

/*
 * Remove macros that will interfere with the definitions below.
 */
................................................................................
    Tcl_SetTimeProc, /* 552 */
    Tcl_QueryTimeProc, /* 553 */
    Tcl_ChannelThreadActionProc, /* 554 */
    Tcl_NewBignumObj, /* 555 */
    Tcl_DbNewBignumObj, /* 556 */
    Tcl_SetBignumObj, /* 557 */
    Tcl_GetBignumFromObj, /* 558 */

    Tcl_TruncateChannel, /* 559 */
    Tcl_ChannelTruncateProc, /* 560 */
    Tcl_SetChannelErrorInterp, /* 561 */
    Tcl_GetChannelErrorInterp, /* 562 */
    Tcl_SetChannelError, /* 563 */
    Tcl_GetChannelError, /* 564 */
};

/* !END!: Do not edit above this line. */






|







 







>
|
|
|
|
|
|



4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.109.2.17 2005/09/20 14:11:52 dgp Exp $
 */

#include "tclInt.h"

/*
 * Remove macros that will interfere with the definitions below.
 */
................................................................................
    Tcl_SetTimeProc, /* 552 */
    Tcl_QueryTimeProc, /* 553 */
    Tcl_ChannelThreadActionProc, /* 554 */
    Tcl_NewBignumObj, /* 555 */
    Tcl_DbNewBignumObj, /* 556 */
    Tcl_SetBignumObj, /* 557 */
    Tcl_GetBignumFromObj, /* 558 */
    Tcl_GetBignumAndClearObj, /* 559 */
    Tcl_TruncateChannel, /* 560 */
    Tcl_ChannelTruncateProc, /* 561 */
    Tcl_SetChannelErrorInterp, /* 562 */
    Tcl_GetChannelErrorInterp, /* 563 */
    Tcl_SetChannelError, /* 564 */
    Tcl_GetChannelError, /* 565 */
};

/* !END!: Do not edit above this line. */