Tcl Source Code

Check-in [e007a2ab3c]
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:Re-base to 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-481
Files: files | file ages | folders
SHA3-256: e007a2ab3ccaf5427ba3011146959352a578a40fa52a73f3b50fb41e8bef6542
User & Date: jan.nijtmans 2018-10-08 22:22:14
Context
2018-10-09
18:12
Merge 8.7 Add Unsigned functions to the implementation. TIP text is still far behind describing what... check-in: 9e83b1442d user: jan.nijtmans tags: tip-481
2018-10-08
22:22
Re-base to 8.7 check-in: e007a2ab3c user: jan.nijtmans tags: tip-481
20:47
Fix MSVC warning: warning C4146: unary minus operator applied to unsigned type, result still unsign... check-in: e03ac1dc7c user: jan.nijtmans tags: core-8-branch
2018-08-14
07:27
Merge 8.7. Also provide a new function for handling ByteArrays check-in: 2e99b95206 user: jan.nijtmans tags: tip-481
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.decls.

2341
2342
2343
2344
2345
2346
2347















2348
2349
2350
2351
2352
2353
2354
declare 634 {
    Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
	    unsigned char *data, size_t datalen, int copy)
}
















# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

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






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







2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
declare 634 {
    Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
	    unsigned char *data, size_t datalen, int copy)
}

# TIP #481
declare 636 {
    int Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    void *intPtr, int flags)
}
declare 637 {
    char *Tcl_GetStringFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 638 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 639 {
    unsigned char *Tcl_GetByteArrayFromObj2(Tcl_Obj *objPtr, size_t *lengthPtr)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

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

Changes to generic/tcl.h.

1102
1103
1104
1105
1106
1107
1108







1109
1110
1111
1112
1113
1114
1115
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_READ_ONLY	0x80







 
/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE






>
>
>
>
>
>
>







1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_READ_ONLY	0x80

/*
 * Types for Tcl_GetValue():
 */

#define TCL_TYPE_I(type) (0x100 | (int)sizeof(type)) /* signed integer */
#define TCL_TYPE_D(type) (0x300 | (int)sizeof(type)) /* float/double/long double */
 
/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE

Changes to generic/tclBinary.c.

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
...
438
439
440
441
442
443
444

445
446
447
448
449
450
451




















452
453
454
455
456
457
458
...
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct ByteArray {
    int used;			/* The number of bytes used in the byte
				 * array. */
    int allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
................................................................................
    objPtr->typePtr = &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
 *
 *	Attempt to get the array of bytes from the Tcl object. If the object
 *	is not already a ByteArray object, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	Pointer to array of bytes representing the ByteArray object.
................................................................................
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new internal rep.
 *
 *----------------------------------------------------------------------
 */


unsigned char *
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;





















    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);

................................................................................
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
................................................................................
void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    int len)
{
    ByteArray *byteArrayPtr;
    int needed;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
................................................................................
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    needed = byteArrayPtr->used + len;
    /*
     * If we need to, resize the allocated space in the byte array.
     */






|

|







|







 







|







 







>







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







 







|







 







|







 







|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
...
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
...
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct ByteArray {
    unsigned int used;		/* The number of bytes used in the byte
				 * array. */
    unsigned int allocated;	/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[1];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		(TclOffset(ByteArray, bytes) + (len))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
................................................................................
    objPtr->typePtr = &properByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj/Tcl_GetByteArrayFromObj2 --
 *
 *	Attempt to get the array of bytes from the Tcl object. If the object
 *	is not already a ByteArray object, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	Pointer to array of bytes representing the ByteArray object.
................................................................................
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new internal rep.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetByteArrayFromObj
unsigned char *
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;

    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = baPtr->used;
    }
    return (unsigned char *) baPtr->bytes;
}

unsigned char *
Tcl_GetByteArrayFromObj2(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;

    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);

................................................................................
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if ((size_t)length > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
................................................................................
void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    int len)
{
    ByteArray *byteArrayPtr;
    size_t needed;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
................................................................................
    }
    if ((objPtr->typePtr != &properByteArrayType)
	    && (objPtr->typePtr != &tclByteArrayType)) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if ((size_t)len + byteArrayPtr->used > INT_MAX) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    needed = byteArrayPtr->used + len;
    /*
     * If we need to, resize the allocated space in the byte array.
     */

Changes to generic/tclDecls.h.

1871
1872
1873
1874
1875
1876
1877












1878
1879
1880
1881
1882
1883
1884
....
2542
2543
2544
2545
2546
2547
2548




2549
2550
2551
2552
2553
2554
2555
....
3844
3845
3846
3847
3848
3849
3850








3851
3852
3853
3854
3855
3856
3857
....
4009
4010
4011
4012
4013
4014
4015


































4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
				const char *mountPoint);
/* 634 */
EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
/* 635 */
EXTERN int		TclZipfs_MountBuffer(Tcl_Interp *interp,
				const char *mountPoint, unsigned char *data,
				size_t datalen, int copy);













typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */




} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */









#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
................................................................................
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UtfNcasecmp(s1,s2,n) \
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UniCharNcasecmp(ucs,uct,n) \
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
#   endif
#endif



































#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#undef Tcl_GetUnicode
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)

/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#endif /* _TCLDECLS */






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







 







>
>
>
>







 







>
>
>
>
>
>
>
>







 







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











<
<













1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
....
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
....
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
....
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084


4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
				const char *mountPoint);
/* 634 */
EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
/* 635 */
EXTERN int		TclZipfs_MountBuffer(Tcl_Interp *interp,
				const char *mountPoint, unsigned char *data,
				size_t datalen, int copy);
/* 636 */
EXTERN int		Tcl_GetValue(Tcl_Interp *interp, Tcl_Obj *objPtr,
				void *intPtr, int flags);
/* 637 */
EXTERN char *		Tcl_GetStringFromObj2(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 638 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj2(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 639 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj2(Tcl_Obj *objPtr,
				size_t *lengthPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
    int (*tcl_GetValue) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *intPtr, int flags); /* 636 */
    char * (*tcl_GetStringFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 637 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 638 */
    unsigned char * (*tcl_GetByteArrayFromObj2) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 639 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
#define Tcl_GetValue \
	(tclStubsPtr->tcl_GetValue) /* 636 */
#define Tcl_GetStringFromObj2 \
	(tclStubsPtr->tcl_GetStringFromObj2) /* 637 */
#define Tcl_GetUnicodeFromObj2 \
	(tclStubsPtr->tcl_GetUnicodeFromObj2) /* 638 */
#define Tcl_GetByteArrayFromObj2 \
	(tclStubsPtr->tcl_GetByteArrayFromObj2) /* 639 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
................................................................................
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UtfNcasecmp(s1,s2,n) \
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UniCharNcasecmp(ucs,uct,n) \
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
#   endif
#endif

#undef Tcl_GetDoubleFromObj
#undef Tcl_GetIntFromObj
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef Tcl_GetByteArrayFromObj
#undef Tcl_GetUnicode
#if defined(USE_TCL_STUBS)
#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \
	(sizeof(*dblPtr) == sizeof(double) ? tclStubsPtr->tcl_GetDoubleFromObj(interp, objPtr, (double *)dblPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr)))
#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \
	(sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetByteArrayFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicode(objPtr) \
	tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, NULL)
#else
#define Tcl_GetDoubleFromObj(interp, objPtr, dblPtr) \
	(sizeof(*dblPtr) == sizeof(double) ? (Tcl_GetDoubleFromObj)(interp, objPtr, (double *)dblPtr) : Tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr)))
#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \
	(sizeof(*intPtr) == sizeof(int) ? (Tcl_GetIntFromObj)(interp, objPtr, (int *)intPtr) : Tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr)))
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : Tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : Tcl_GetByteArrayFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj2(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicode(objPtr) \
	(Tcl_GetUnicodeFromObj)(objPtr, NULL)
#endif

#undef Tcl_NewLongObj
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))



/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#endif /* _TCLDECLS */

Changes to generic/tclObj.c.

1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
....
1679
1680
1681
1682
1683
1684
1685

1686
1687
1688
1689
1690
1691
1692
....
1717
1718
1719
1720
1721
1722
1723












































1724
1725
1726
1727
1728
1729
1730
....
2288
2289
2290
2291
2292
2293
2294

2295
2296
2297
2298
2299
2300
2301
....
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
....
2497
2498
2499
2500
2501
2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
....
2525
2526
2527
2528
2529
2530
2531



























2532
2533
2534
2535
2536
2537
2538
    }
    return objPtr->bytes;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj --
 *
 *	Returns the string representation's byte array pointer and length for
 *	an object.
 *
 * Results:
 *	Returns a pointer to the string representation of objPtr. If lengthPtr
 *	isn't NULL, the length of the string representation is stored at
................................................................................
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */


char *
Tcl_GetStringFromObj(
    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    register int *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
................................................................................
	}
    }
    if (lengthPtr != NULL) {
	*lengthPtr = objPtr->length;
    }
    return objPtr->bytes;
}












































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_InvalidateStringRep --
 *
 *	This function is called to invalidate an object's string
................................................................................
 * Side effects:
 *	If the object is not already a double, the conversion will free any
 *	old internal representation.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_GetDoubleFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a double. */
    register double *dblPtr)	/* Place to store resulting double. */
{
    do {
................................................................................

    TclSetIntObj(objPtr, intValue);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *
 *	Attempt to return an int from the Tcl object "objPtr". If the object
 *	is not already an int, an attempt will be made to convert it to one.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 *	checks whether the current value of the long can be represented by an
................................................................................
 *
 * Side effects:
 *	If the object is not already an int, the conversion will free any old
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
    register int *intPtr)	/* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
................................................................................
	}
	return TCL_ERROR;
    }
    *intPtr = (int) l;
    return TCL_OK;
#endif
}



























 
/*
 *----------------------------------------------------------------------
 *
 * SetIntFromAny --
 *
 *	Attempts to force the internal representation for a Tcl object to






|







 







>







 







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







 







>







 







|







 







|
>







 







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







1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
....
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
....
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
....
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
....
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
....
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
....
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
    }
    return objPtr->bytes;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj/Tcl_GetStringFromObj2 --
 *
 *	Returns the string representation's byte array pointer and length for
 *	an object.
 *
 * Results:
 *	Returns a pointer to the string representation of objPtr. If lengthPtr
 *	isn't NULL, the length of the string representation is stored at
................................................................................
 * Side effects:
 *	May call the object's updateStringProc to update the string
 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetStringFromObj
char *
Tcl_GetStringFromObj(
    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    register int *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
................................................................................
	}
    }
    if (lengthPtr != NULL) {
	*lengthPtr = objPtr->length;
    }
    return objPtr->bytes;
}

char *
Tcl_GetStringFromObj2(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    size_t *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */

	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	if (objPtr->bytes == NULL || objPtr->length < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    if (lengthPtr != NULL) {
#if TK_MAJOR_VERSION > 8
	*lengthPtr = objPtr->length;
#else
	*lengthPtr = (unsigned)objPtr->length;
#endif
    }
    return objPtr->bytes;
}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_InvalidateStringRep --
 *
 *	This function is called to invalidate an object's string
................................................................................
 * Side effects:
 *	If the object is not already a double, the conversion will free any
 *	old internal representation.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetDoubleFromObj
int
Tcl_GetDoubleFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a double. */
    register double *dblPtr)	/* Place to store resulting double. */
{
    do {
................................................................................

    TclSetIntObj(objPtr, intValue);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj/Tcl_GetValue --
 *
 *	Attempt to return an int from the Tcl object "objPtr". If the object
 *	is not already an int, an attempt will be made to convert it to one.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 *	checks whether the current value of the long can be represented by an
................................................................................
 *
 * Side effects:
 *	If the object is not already an int, the conversion will free any old
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */
 
#undef Tcl_GetIntFromObj
int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
    register int *intPtr)	/* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
................................................................................
	}
	return TCL_ERROR;
    }
    *intPtr = (int) l;
    return TCL_OK;
#endif
}

int
Tcl_GetValue(
    Tcl_Interp *interp,        /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,           /* The object from which to get a int. */
    void *ptr,                 /* Place to store resulting int. */
    int flags)
{
    double value;
    int result;
    if (flags == TCL_TYPE_I(int)) {
	return Tcl_GetIntFromObj(interp, objPtr, ptr);
    }
    if (flags == TCL_TYPE_I(Tcl_WideInt)) {
	return Tcl_GetWideIntFromObj(interp, objPtr, ptr);
    }
    result = Tcl_GetDoubleFromObj(interp, objPtr, &value);
    if (flags == TCL_TYPE_D(double)) {
	*(double *)ptr = value;
    } else if (flags == TCL_TYPE_D(float)) {
	*(float *)ptr = (float) value;
    } else {
	*(long double *)ptr = (long double) value;
    }
    return result;
}

 
/*
 *----------------------------------------------------------------------
 *
 * SetIntFromAny --
 *
 *	Attempts to force the internal representation for a Tcl object to

Changes to generic/tclStringObj.c.

616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646
647























648
649
650
651
652
653
654
    return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	Get the Unicode form of the String object with length. If the object
 *	is not already a String object, it will be converted to one. If the
 *	String object does not have a Unicode rep, then one is create from the
 *	UTF string format.
 *
 * Results:
................................................................................
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */


Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    int *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;
























    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);






|







 







>









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







616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
...
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
    return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj/Tcl_GetUnicodeFromObj2 --
 *
 *	Get the Unicode form of the String object with length. If the object
 *	is not already a String object, it will be converted to one. If the
 *	String object does not have a Unicode rep, then one is create from the
 *	UTF string format.
 *
 * Results:
................................................................................
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetUnicodeFromObj
Tcl_UniChar *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    int *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->unicode;
}
Tcl_UniChar *
Tcl_GetUnicodeFromObj2(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    size_t *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);

Changes to generic/tclStubInit.c.

1577
1578
1579
1580
1581
1582
1583




1584
1585
1586
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */
    TclZipfs_Mount, /* 632 */
    TclZipfs_Unmount, /* 633 */
    TclZipfs_TclLibrary, /* 634 */
    TclZipfs_MountBuffer, /* 635 */




};

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






>
>
>
>



1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */
    TclZipfs_Mount, /* 632 */
    TclZipfs_Unmount, /* 633 */
    TclZipfs_TclLibrary, /* 634 */
    TclZipfs_MountBuffer, /* 635 */
    Tcl_GetValue, /* 636 */
    Tcl_GetStringFromObj2, /* 637 */
    Tcl_GetUnicodeFromObj2, /* 638 */
    Tcl_GetByteArrayFromObj2, /* 639 */
};

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

Changes to generic/tclTest.c.

1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
....
1743
1744
1745
1746
1747
1748
1749
1750

1751
1752

1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
....
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
....
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
....
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
....
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
....
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
....
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
....
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
	TCL_DD_SHORTEST,
	TCL_DD_STEELE,
	TCL_DD_E_FORMAT,
	TCL_DD_F_FORMAT
    };

    const Tcl_ObjType* doubleType;
    double d;
    int status;
    int ndigits;
    int type;
    int decpt;
    int signum;
    char* str;
    char* endPtr;
    Tcl_Obj* strObj;
    Tcl_Obj* retval;
................................................................................
	Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
	return TCL_ERROR;
    }
    status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
    if (status != TCL_OK) {
	doubleType = Tcl_GetObjType("double");
	if (objv[1]->typePtr == doubleType
	    || TclIsNaN(objv[1]->internalRep.doubleValue)) {

	    status = TCL_OK;
	    memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));

	}
    }
    if (status != TCL_OK
	|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
	|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
................................................................................
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {
	    if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) {
................................................................................
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}
    } else if (strcmp(argv[1], "update") == 0) {
................................................................................
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}
	if (argv[7][0]) {
................................................................................
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");
	}
................................................................................
TestparserObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
................................................................................
TestexprparserObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "expr length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
................................................................................
    size_t argv2;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
    }
    argv2 = (size_t)argv1;
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
    return TCL_OK;
}
 
/*






|

|







 







|
>

|
>






|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
....
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
....
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
....
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
....
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
....
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
....
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
....
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
....
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
	TCL_DD_SHORTEST,
	TCL_DD_STEELE,
	TCL_DD_E_FORMAT,
	TCL_DD_F_FORMAT
    };

    const Tcl_ObjType* doubleType;
    long double d;
    int status;
    size_t ndigits;
    int type;
    int decpt;
    int signum;
    char* str;
    char* endPtr;
    Tcl_Obj* strObj;
    Tcl_Obj* retval;
................................................................................
	Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
	return TCL_ERROR;
    }
    status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
    if (status != TCL_OK) {
	doubleType = Tcl_GetObjType("double");
	if (objv[1]->typePtr == doubleType
	    && TclIsNaN(objv[1]->internalRep.doubleValue)) {
	    double d1;
	    status = TCL_OK;
	    memcpy(&d1, &(objv[1]->internalRep.doubleValue), sizeof(double));
	    d = d1;
	}
    }
    if (status != TCL_OK
	|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
	|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %Lg\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
................................................................................
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {
	    if (Tcl_GetInt(interp, argv[7], &v) != TCL_OK) {
................................................................................
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}
    } else if (strcmp(argv[1], "update") == 0) {
................................................................................
		stringVar = ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}
	if (argv[7][0]) {
................................................................................
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");
	}
................................................................................
TestparserObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    size_t length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
................................................................................
TestexprparserObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    size_t length, dummy;
    Tcl_Parse parse;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "expr length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
................................................................................
    size_t argv2;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
    }

    if (objc > 1) {
	Tcl_GetIntFromObj(interp, objv[2], &argv1);
    }
    argv2 = (size_t)argv1;
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
    return TCL_OK;
}
 
/*

Changes to generic/tclTestObj.c.

1167
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
....
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
TeststringobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option, i, length;

#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "getunicode",
................................................................................
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    for (i = 3;  i < objc;  i++) {
		strings[i-3] = Tcl_GetString(objv[i]);
	    }
	    for ( ; i < 12 + 3; i++) {
		strings[i - 3] = NULL;
	    }
	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
		    strings[2], strings[3], strings[4], strings[5],






|
>







 







|







1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
....
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
TeststringobjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option;
    size_t length, i;
#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "getunicode",
................................................................................
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    for (i = 3;  i < (size_t)objc;  i++) {
		strings[i-3] = Tcl_GetString(objv[i]);
	    }
	    for ( ; i < 12 + 3; i++) {
		strings[i - 3] = NULL;
	    }
	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
		    strings[2], strings[3], strings[4], strings[5],

Changes to generic/tclZipfs.c.

2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
....
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
....
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = Tcl_GetStringFromObj(objv[1], 0);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
................................................................................
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetStringFromObj(objv[1], 0);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
................................................................................
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = Tcl_GetStringFromObj(objv[1], 0);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);







|







 







|







 







|







2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
....
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
....
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = Tcl_GetString(objv[1]);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
................................................................................
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
................................................................................
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = Tcl_GetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);