Tcl Source Code

Check-in [2d7e29783f]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
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/tcl.h: Changed name of the new Tcl_Obj intrep field * generic/tclObj.c: from "bignumValue" to "ptrAndLongRep" as * generic/tclProc.c: described in TIP 237, and more suitable for other more general uses.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | kennykb-numerics-branch
Files: files | file ages | folders
SHA1: 2d7e29783fc5036b3a465e3af5d2c04d9d768abe
User & Date: dgp 2005-09-27 18:42:53
Context
2005-09-28
00:23
formatting check-in: 255d501bf2 user: dgp tags: kennykb-numerics-branch
2005-09-27
18:42
[kennykb-numerics-branch]
* generic/tcl.h: Changed name of the new Tcl_Obj i...
 check-in: 2d7e29783f user: dgp tags: kennykb-numerics-branch
2005-09-26
20:16
Merge changes from HEAD, including libtommath 0.36 check-in: 14146661ef user: kennykb tags: kennykb-numerics-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 










1
2
3
4
5
6
7









2005-09-26  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Merge updates from HEAD.
	
2005-09-26  Kevin Kenny  <[email protected]>

	* libtommath/:                   Updated to release 0.36.

>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

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

	[kennykb-numerics-branch]

	* generic/tcl.h:	Changed name of the new Tcl_Obj intrep field
	* generic/tclObj.c:	from "bignumValue" to "ptrAndLongRep" as
	* generic/tclProc.c:	described in TIP 237, and more suitable for
	other more general uses.

2005-09-26  Kevin Kenny  <[email protected]>

	[kennykb-numerics-branch] Merge updates from HEAD.
	
2005-09-26  Kevin Kenny  <[email protected]>

	* libtommath/:                   Updated to release 0.36.

Changes to generic/tcl.h. 

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 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.h,v 1.191.2.10 2005/09/15 20:58:39 dgp Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
................................................................................
	Tcl_WideInt wideValue;	/*   - a long long value */
	struct {		/*   - internal rep as two pointers */
	    VOID *ptr1;
	    VOID *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a wide int, tightly
				 *     packed fields */
	    VOID *digits;	/* Pointer to digits */
	    unsigned long misc;	/* Alloc, used, and signum packed into a
				 * single word */
	} bignumValue;
    } internalRep;
} Tcl_Obj;

/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to test
 * whether an object is shared (i.e. has reference count > 1). Note: clients
 * should use Tcl_DecrRefCount() when they are finished using an object, and







|







 







|
|

|








9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783

 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 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.h,v 1.191.2.11 2005/09/27 18:42:54 dgp Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
................................................................................
	Tcl_WideInt wideValue;	/*   - a long long value */
	struct {		/*   - internal rep as two pointers */
	    VOID *ptr1;
	    VOID *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a wide int, tightly
				 *     packed fields */
	    VOID *ptr;		/* Pointer to digits */
	    unsigned long value;/* Alloc, used, and signum packed into a
				 * single word */
	} ptrAndLongRep;
    } internalRep;
} Tcl_Obj;

/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to test
 * whether an object is shared (i.e. has reference count > 1). Note: clients
 * should use Tcl_DecrRefCount() when they are finished using an object, and

Changes to generic/tclObj.c. 

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
....
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
....
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
....
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
....
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741

 * 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.38 2005/09/23 16:13:14 dgp Exp $
 */

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

#define BIGNUM_AUTO_NARROW 1
................................................................................
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7fff) { \
	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
	*temp = bignum; \
	(objPtr)->internalRep.bignumValue.digits = (void*) temp; \
	(objPtr)->internalRep.bignumValue.misc = -1; \
    } else { \
	if ((bignum).alloc > 0x7fff) { \
	    mp_shrink(&(bignum)); \
	} \
	(objPtr)->internalRep.bignumValue.digits = (void*) (bignum).dp; \
	(objPtr)->internalRep.bignumValue.misc = ( \
		((bignum).sign << 30) \
		| ((bignum).alloc << 15) \
		| ((bignum).used)); \
    }

#define UNPACK_BIGNUM(objPtr, bignum) \
    if ((objPtr)->internalRep.bignumValue.misc == -1) { \
	(bignum) = *((mp_int *) ((objPtr)->internalRep.bignumValue.digits)); \
    } else { \
	(bignum).dp = (mp_digit*) (objPtr)->internalRep.bignumValue.digits; \
	(bignum).sign = (objPtr)->internalRep.bignumValue.misc >> 30; \
	(bignum).alloc = \
		((objPtr)->internalRep.bignumValue.misc >> 15) & 0x7fff; \
	(bignum).used = (objPtr)->internalRep.bignumValue.misc & 0x7fff; \
    }

/*
 * Prototypes for procedures defined later in this file:
 */

static int		ParseBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
................................................................................
	    *boolPtr = (d != 0.0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
#ifdef BIGNUM_AUTO_NARROW
	    *boolPtr = 1;
#else
	    *boolPtr = ((objPtr->internalRep.bignumValue.misc & 0x7fff)!=0);
#endif
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
................................................................................
static void
FreeBignum(Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (objPtr->internalRep.bignumValue.misc < 0) {
	ckfree((char *)objPtr->internalRep.bignumValue.digits);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupBignum --
................................................................................
 * 	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
................................................................................
		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;
	}







|







 







|
|




<
|
|
|
<



|
|

|
|

|
|







 







|







 







|
|







 







|







 







|
|








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
144
145
146
147
148
149
150
151
152
153
154
155
156

157
158
159

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
....
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
....
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
....
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
....
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739

 * 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.39 2005/09/27 18:42:54 dgp Exp $
 */

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

#define BIGNUM_AUTO_NARROW 1
................................................................................
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7fff) { \
	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
	*temp = bignum; \
	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) temp; \
	(objPtr)->internalRep.ptrAndLongRep.value = -1; \
    } else { \
	if ((bignum).alloc > 0x7fff) { \
	    mp_shrink(&(bignum)); \
	} \

	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) (bignum).dp; \
	(objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used)); \

    }

#define UNPACK_BIGNUM(objPtr, bignum) \
    if ((objPtr)->internalRep.ptrAndLongRep.value == -1) { \
	(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
    } else { \
	(bignum).dp = (mp_digit*) (objPtr)->internalRep.ptrAndLongRep.ptr; \
	(bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
	(bignum).alloc = \
		((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
	(bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
    }

/*
 * Prototypes for procedures defined later in this file:
 */

static int		ParseBoolean _ANSI_ARGS_((Tcl_Obj *objPtr));
................................................................................
	    *boolPtr = (d != 0.0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
#ifdef BIGNUM_AUTO_NARROW
	    *boolPtr = 1;
#else
	    *boolPtr = ((objPtr->internalRep.ptrAndLongRep.value & 0x7fff)!=0);
#endif
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
................................................................................
static void
FreeBignum(Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (objPtr->internalRep.ptrAndLongRep.value < 0) {
	ckfree((char *)objPtr->internalRep.ptrAndLongRep.ptr);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupBignum --
................................................................................
 * 	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, and the 'interp'
 *	argument is not NULL, an error message is stored in the interpreter
 *	result.
 *
 *----------------------------------------------------------------------
 */

int
................................................................................
		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.ptrAndLongRep.ptr = NULL;
		objPtr->internalRep.ptrAndLongRep.value = 0;
		objPtr->typePtr = NULL;
		if (objPtr->bytes == NULL) {
		    TclInitStringRep(objPtr, NULL, 0);
		}
	    }
	    return TCL_OK;
	}

Changes to generic/tclProc.c. 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
...
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713

 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclProc.c,v 1.66.2.7 2005/09/15 20:58:40 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file
................................................................................
	    if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
		goto levelError;
	    }

	    /*
	     * Cache for future reference.
	     *
	     * TODO: Use the new bignumValue (long + pointer) intrep
	     */

	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 0;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
................................................................................
	    if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
		return -1;
	    }

	    /*
	     * Cache for future reference.
	     *
	     * TODO: Use the new bignumValue (long + pointer) intrep
	     */

	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 1;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	    level = curLevel - level;







|







 







|







 







|








6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
...
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713

 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclProc.c,v 1.66.2.8 2005/09/27 18:42:54 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file
................................................................................
	    if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
		goto levelError;
	    }

	    /*
	     * Cache for future reference.
	     *
	     * TODO: Use the new ptrAndLongRep intrep
	     */

	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 0;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
................................................................................
	    if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
		return -1;
	    }

	    /*
	     * Cache for future reference.
	     *
	     * TODO: Use the new ptrAndLongRep intrep
	     */

	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 1;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	    level = curLevel - level;

This page was generated in about 0.065s by Fossil 2.9 [0fd79a3e09] 2019-07-13 13:05:19