Tcl Source Code

Check-in [006f71d8fb]
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:
* generic/tclGet.c: Corrected out of date comments and removed * generic/tclInt.decls: internal routine TclGetLong() that's no longer used. If an extension is using this from the internal stubs table, it can shift to the public routine Tcl_GetLongFromObj() or can request addition of a public Tcl_GetLong(). ***POTENTIAL INCOMPATIBILITY***
* generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c:
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: 006f71d8fb9cbcab88a2c05cbace6bb4cc6f075b
User & Date: dgp 2008-07-08 17:52:14
Context
2008-07-09
14:41
add a vqtcl entry check-in: 1c90799316 user: patthoyts tags: trunk
2008-07-08
17:52
* generic/tclGet.c: Corrected out of date comments and removed * generic/tclInt....
check-in: 006f71d8fb user: dgp tags: trunk, potential incompatibility
12:34
Tighten up language. check-in: 8ee2474038 user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.













1
2
3
4
5
6
7











2008-07-08  Donal K. Fellows  <[email protected]>

	* doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
	this page easier to read for a "Tcl 8.6" audience.

2008-07-07  Andreas Kupries  <[email protected]>

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







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

	* generic/tclGet.c:	Corrected out of date comments and removed
	* generic/tclInt.decls:	internal routine TclGetLong() that's no longer
	used.  If an extension is using this from the internal stubs table,
	it can shift to the public routine Tcl_GetLongFromObj() or can 
	request addition of a public Tcl_GetLong().
	***POTENTIAL INCOMPATIBILITY***

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

2008-07-08  Donal K. Fellows  <[email protected]>

	* doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
	this page easier to read for a "Tcl 8.6" audience.

2008-07-07  Andreas Kupries  <[email protected]>

Changes to generic/tclGet.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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
...
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 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: tclGet.c,v 1.21 2008/04/27 22:21:30 dkf Exp $
 */

#include "tclInt.h"
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_GetInt(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    const char *src,		/* String containing a (possibly signed)
				 * integer in a form acceptable to strtoul. */

    int *intPtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = Tcl_GetIntFromObj(interp, &obj, intPtr);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclGetLong --
 *
 *	Given a string, produce the corresponding long integer value. This
 *	routine is a version of Tcl_GetInt but returns a "long" instead of an
 *	"int" (a difference that matters on 64-bit architectures).
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *longPtr will be set
 *	to the long integer value equivalent to src. If src is improperly
 *	formed then TCL_ERROR is returned and an error message will be left in
 *	the interp's result if interp is non-NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLong(
    Tcl_Interp *interp,		/* Interpreter used for error reporting if not
				 * NULL. */
    const char *src,		/* String containing a (possibly signed) long
				 * integer in a form acceptable to strtoul. */
    long *longPtr)		/* Place to store converted long result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = Tcl_GetLongFromObj(interp, &obj, longPtr);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_GetDouble(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing a floating-point number
				 * in a form acceptable to strtod. */

    double *doublePtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBoolean(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing a boolean number
				 * specified either as 1/0 or true/false or
				 * yes/no. */
    int *boolPtr)		/* Place to store converted result, which will
				 * be 0 or 1. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;






|







 







|
>












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







 







|
>







 







|
|
<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55












































56
57
58
59
60
61
62
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
120
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 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: tclGet.c,v 1.22 2008/07/08 17:52:15 dgp Exp $
 */

#include "tclInt.h"
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_GetInt(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    const char *src,		/* String containing a (possibly signed)
				 * integer in a form acceptable to
				 * Tcl_GetIntFromObj(). */
    int *intPtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = Tcl_GetIntFromObj(interp, &obj, intPtr);
    if (obj.refCount > 1) {












































	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_GetDouble(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing a floating-point number
				 * in a form acceptable to
				 * Tcl_GetDoubleFromObj(). */
    double *doublePtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
................................................................................
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBoolean(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing one of the boolean values
				 * 1, 0, true, false, yes, no, on, off. */

    int *boolPtr)		/* Place to store converted result, which will
				 * be 0 or 1. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;

Changes to generic/tclInt.decls.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
159
160
161
162
163
164
165

166
167
168

169
170
171
172
173
174
175
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tclInt.decls,v 1.122 2008/06/13 05:45:12 mistachkin Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

................................................................................
	    int endValue, int *indexPtr)
}
# Removed in 8.4b2:
#declare 35 generic {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}

declare 36 generic {
    int TclGetLong(Tcl_Interp *interp, CONST char *str, long *longPtr)
}

declare 37 generic {
    int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
}
declare 38 generic {
    int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName,
	    Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
	    Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,






|







 







>
|
|
<
>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
159
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tclInt.decls,v 1.123 2008/07/08 17:52:17 dgp Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

................................................................................
	    int endValue, int *indexPtr)
}
# Removed in 8.4b2:
#declare 35 generic {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2
#declare 36 generic {
#    int TclGetLong(Tcl_Interp *interp, CONST char *str, long *longPtr)

#}
declare 37 generic {
    int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
}
declare 38 generic {
    int TclGetNamespaceForQualName(Tcl_Interp *interp, CONST char *qualName,
	    Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
	    Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,

Changes to generic/tclIntDecls.h.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
....
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
....
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
 *	versions.  Use at your own risk.
 *
 * 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: tclIntDecls.h,v 1.116 2008/06/13 05:45:13 mistachkin Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

................................................................................
#define TclGetIntForIndex_TCL_DECLARED
/* 34 */
EXTERN int		TclGetIntForIndex (Tcl_Interp * interp, 
				Tcl_Obj * objPtr, int endValue, 
				int * indexPtr);
#endif
/* Slot 35 is reserved */
#ifndef TclGetLong_TCL_DECLARED
#define TclGetLong_TCL_DECLARED
/* 36 */
EXTERN int		TclGetLong (Tcl_Interp * interp, CONST char * str, 
				long * longPtr);
#endif
#ifndef TclGetLoadedPackages_TCL_DECLARED
#define TclGetLoadedPackages_TCL_DECLARED
/* 37 */
EXTERN int		TclGetLoadedPackages (Tcl_Interp * interp, 
				char * targetName);
#endif
#ifndef TclGetNamespaceForQualName_TCL_DECLARED
................................................................................
    void *reserved29;
    void *reserved30;
    CONST char * (*tclGetExtension) (CONST char * name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr); /* 32 */
    void *reserved33;
    int (*tclGetIntForIndex) (Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr); /* 34 */
    void *reserved35;
    int (*tclGetLong) (Tcl_Interp * interp, CONST char * str, long * longPtr); /* 36 */
    int (*tclGetLoadedPackages) (Tcl_Interp * interp, char * targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp * interp, CONST char * str, int * seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
    char * (*tclpGetUserHome) (CONST char * name, Tcl_DString * bufferPtr); /* 42 */
    void *reserved43;
................................................................................
#endif
/* Slot 33 is reserved */
#ifndef TclGetIntForIndex
#define TclGetIntForIndex \
	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
#endif
/* Slot 35 is reserved */
#ifndef TclGetLong
#define TclGetLong \
	(tclIntStubsPtr->tclGetLong) /* 36 */
#endif
#ifndef TclGetLoadedPackages
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#endif
#ifndef TclGetNamespaceForQualName
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */






|







 







|
<
<
<
<
<







 







|







 







|
<
<
<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
205
206
207
208
209
210
211
212





213
214
215
216
217
218
219
....
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
....
1469
1470
1471
1472
1473
1474
1475
1476



1477
1478
1479
1480
1481
1482
1483
 *	versions.  Use at your own risk.
 *
 * 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: tclIntDecls.h,v 1.117 2008/07/08 17:52:17 dgp Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

................................................................................
#define TclGetIntForIndex_TCL_DECLARED
/* 34 */
EXTERN int		TclGetIntForIndex (Tcl_Interp * interp, 
				Tcl_Obj * objPtr, int endValue, 
				int * indexPtr);
#endif
/* Slot 35 is reserved */
/* Slot 36 is reserved */





#ifndef TclGetLoadedPackages_TCL_DECLARED
#define TclGetLoadedPackages_TCL_DECLARED
/* 37 */
EXTERN int		TclGetLoadedPackages (Tcl_Interp * interp, 
				char * targetName);
#endif
#ifndef TclGetNamespaceForQualName_TCL_DECLARED
................................................................................
    void *reserved29;
    void *reserved30;
    CONST char * (*tclGetExtension) (CONST char * name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp * interp, CONST char * str, CallFrame ** framePtrPtr); /* 32 */
    void *reserved33;
    int (*tclGetIntForIndex) (Tcl_Interp * interp, Tcl_Obj * objPtr, int endValue, int * indexPtr); /* 34 */
    void *reserved35;
    void *reserved36;
    int (*tclGetLoadedPackages) (Tcl_Interp * interp, char * targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp * interp, CONST char * qualName, Namespace * cxtNsPtr, int flags, Namespace ** nsPtrPtr, Namespace ** altNsPtrPtr, Namespace ** actualCxtPtrPtr, CONST char ** simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp * interp, CONST char * str, int * seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
    char * (*tclpGetUserHome) (CONST char * name, Tcl_DString * bufferPtr); /* 42 */
    void *reserved43;
................................................................................
#endif
/* Slot 33 is reserved */
#ifndef TclGetIntForIndex
#define TclGetIntForIndex \
	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
#endif
/* Slot 35 is reserved */
/* Slot 36 is reserved */



#ifndef TclGetLoadedPackages
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#endif
#ifndef TclGetNamespaceForQualName
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 *	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.154 2008/06/13 05:45:14 mistachkin Exp $
 */

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

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    NULL, /* 29 */
    NULL, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    NULL, /* 33 */
    TclGetIntForIndex, /* 34 */
    NULL, /* 35 */
    TclGetLong, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    NULL, /* 43 */






|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
 *	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.155 2008/07/08 17:52:17 dgp Exp $
 */

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

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    NULL, /* 29 */
    NULL, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    NULL, /* 33 */
    TclGetIntForIndex, /* 34 */
    NULL, /* 35 */
    NULL, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    NULL, /* 43 */