Tcl Source Code

Check-in [405aba7ca5]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Initial commit of new C API for array enumeration. TIP forthcoming. Work far from complete, only Tcl_ArraySize() implemented as of yet. See http://wiki.tcl.tk/48264 for more information.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | amg-array-enum-c-api
Files: files | file ages | folders
SHA1: 405aba7ca5e89284f89bbe9af43d3d3cef5b069a
User & Date: andy 2016-11-21 13:12:11
Context
2016-11-21
18:25
[array size] should 0 if argument does not name an array. TODO: Distinguish between existence error... check-in: b0ceb88495 user: andy tags: amg-array-enum-c-api
13:12
Initial commit of new C API for array enumeration. TIP forthcoming. Work far from complete, only T... check-in: 405aba7ca5 user: andy tags: amg-array-enum-c-api
10:15
More internal use of size_t in stead of int. check-in: ef4da65408 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.decls.

2321
2322
2323
2324
2325
2326
2327



















2328
2329
2330
2331
2332
2333
2334
# TIP #400
declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #




















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

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

interface tclPlat






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







2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
# TIP #400
declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #

# TIP #XXX
declare 631 {
    int Tcl_ArraySize(Tcl_Interp *interp, Tcl_Obj *part1Ptr, int flags)
}
declare 632 {
    Tcl_ArraySearch Tcl_ArraySearchStart(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	int flags)
}
declare 633 {
    Tcl_Obj *Tcl_ArraySearchNext(Tcl_ArraySearch search)
}
declare 634 {
    void Tcl_ArraySeachDone(Tcl_ArraySearch search)
}
declare 635 {
    int Tcl_ArrayNames(Tcl_Interp *interp, Tcl_Obj *part1Ptr, int *objcPtr,
	Tcl_Obj ***objvPtr, int flags)
}

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

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

interface tclPlat

Changes to generic/tcl.h.

528
529
530
531
532
533
534

535
536
537
538
539
540
541
#else
    int errorLineDontUse; /* Don't use in extensions! */
#endif
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Interp;


typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
typedef struct Tcl_EncodingState_ *Tcl_EncodingState;






>







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
#else
    int errorLineDontUse; /* Don't use in extensions! */
#endif
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Interp;

typedef struct Tcl_ArraySearch_ *Tcl_ArraySearch;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
typedef struct Tcl_EncodingState_ *Tcl_EncodingState;

Changes to generic/tclDecls.h.

1812
1813
1814
1815
1816
1817
1818













1819
1820
1821
1822
1823
1824
1825
....
2478
2479
2480
2481
2482
2483
2484





2485
2486
2487
2488
2489
2490
2491
....
3770
3771
3772
3773
3774
3775
3776










3777
3778
3779
3780
3781
3782
3783
/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);
/* 630 */
EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);














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

................................................................................
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */





} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_LoadFile) /* 627 */
#define Tcl_FindSymbol \
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */











#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp






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







 







>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>







1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
....
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
....
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);
/* 630 */
EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN int		Tcl_ArraySize(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				int flags);
/* 632 */
EXTERN Tcl_ArraySearch	Tcl_ArraySearchStart(Tcl_Interp *interp,
				Tcl_Obj *part1Ptr, int flags);
/* 633 */
EXTERN Tcl_Obj *	Tcl_ArraySearchNext(Tcl_ArraySearch search);
/* 634 */
EXTERN void		Tcl_ArraySeachDone(Tcl_ArraySearch search);
/* 635 */
EXTERN int		Tcl_ArrayNames(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				int *objcPtr, Tcl_Obj ***objvPtr, int flags);

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

................................................................................
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    int (*tcl_ArraySize) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, int flags); /* 631 */
    Tcl_ArraySearch (*tcl_ArraySearchStart) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, int flags); /* 632 */
    Tcl_Obj * (*tcl_ArraySearchNext) (Tcl_ArraySearch search); /* 633 */
    void (*tcl_ArraySeachDone) (Tcl_ArraySearch search); /* 634 */
    int (*tcl_ArrayNames) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, int *objcPtr, Tcl_Obj ***objvPtr, int flags); /* 635 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_LoadFile) /* 627 */
#define Tcl_FindSymbol \
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_ArraySize \
	(tclStubsPtr->tcl_ArraySize) /* 631 */
#define Tcl_ArraySearchStart \
	(tclStubsPtr->tcl_ArraySearchStart) /* 632 */
#define Tcl_ArraySearchNext \
	(tclStubsPtr->tcl_ArraySearchNext) /* 633 */
#define Tcl_ArraySeachDone \
	(tclStubsPtr->tcl_ArraySeachDone) /* 634 */
#define Tcl_ArrayNames \
	(tclStubsPtr->tcl_ArrayNames) /* 635 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

Changes to generic/tclVar.c.

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
....
1040
1041
1042
1043
1044
1045
1046






























































































1047
1048
1049
1050
1051
1052
1053
....
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729

3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

/*
 * The following structure describes an enumerative search in progress on an
 * array variable; this are invoked with options to the "array" command.
 */

typedef struct ArraySearch {
    Tcl_Obj *name;		/* Name of this search */
    int id;			/* Integer id used to distinguish among
				 * multiple concurrent searches for the same
				 * array. */
    struct Var *varPtr;		/* Pointer to array variable that's being
				 * searched. */
    Tcl_HashSearch search;	/* Info kept by the hash module about progress
................................................................................
				 * through the array. */
    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
				 * be enumerated (it's leftover from the
				 * Tcl_FirstHashEntry call or from an "array
				 * anymore" command). NULL means must call
				 * Tcl_NextHashEntry to get value to
				 * return. */

    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;

/*
 * Forward references to functions defined later in this file:
 */
................................................................................
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), NULL);
	    }
	}
    }
    return varPtr;
}






























































































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar --
 *
 *	Return the value of a Tcl variable as a string.
................................................................................
static int
ArraySizeCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varNameObj;
    Tcl_HashSearch search;
    Var *varPtr2;
    int size = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

    /*
     * Locate the array variable.
     */

    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {

	    return TCL_ERROR;
	}
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces. We can only iterate over the array if it exists...
     */

    if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	    if (!TclIsVarUndefined(varPtr2)) {
		size++;
	    }
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
    return TCL_OK;
}
 
/*






|







 







>
|







 







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







 







<
<
<
<
<
|





<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
....
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
....
3788
3789
3790
3791
3792
3793
3794





3795
3796
3797
3798
3799
3800

3801

















3802
3803





















3804
3805
3806
3807
3808
3809
3810
#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

/*
 * The following structure describes an enumerative search in progress on an
 * array variable; this are invoked with options to the "array" command.
 */

typedef struct Tcl_ArraySearch_ {
    Tcl_Obj *name;		/* Name of this search */
    int id;			/* Integer id used to distinguish among
				 * multiple concurrent searches for the same
				 * array. */
    struct Var *varPtr;		/* Pointer to array variable that's being
				 * searched. */
    Tcl_HashSearch search;	/* Info kept by the hash module about progress
................................................................................
				 * through the array. */
    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
				 * be enumerated (it's leftover from the
				 * Tcl_FirstHashEntry call or from an "array
				 * anymore" command). NULL means must call
				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct Tcl_ArraySearch_ *nextPtr;
				/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;

/*
 * Forward references to functions defined later in this file:
 */
................................................................................
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), NULL);
	    }
	}
    }
    return varPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ArraySize --
 *
 *	This function returns the number of elements in an array variable.
 *
 * Results:
 *	The return value is normally the integer count of array elements. If
 *	part1Ptr does not name an array, -1 is returned and (if flags contains
 *	TCL_LEAVE_ERR_MSG) an error message is placed in interp's result.
 *
 * Side effects:
 *	None.
 *	
 *----------------------------------------------------------------------
 */

int
Tcl_ArraySize(
    Tcl_Interp *interp,		/* Command interpreter in which part1Ptr is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
				 * bits. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Tcl_HashSearch search;
    Var *varPtr2;
    int leaveErrMsg = flags & TCL_LEAVE_ERR_MSG ? 1 : 0;
    int size = 0;

    /*
     * Locate the array variable.
     */

    varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, NULL,
		flags|TCL_TRACE_ARRAY, leaveErrMsg, -1) == TCL_ERROR) {
	    return -1;
	}
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces. We can only iterate over the array if it exists...
     */

    if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	    if (!TclIsVarUndefined(varPtr2)) {
		size++;
	    }
	}
    }

    return size;
}
 
/*
 *----------------------------------------------------------------------
 * 
 *----------------------------------------------------------------------
 */
Tcl_ArraySearch
Tcl_ArraySearchStart(
    Tcl_Interp *interp,		/* Command interpreter in which part1Ptr is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of array variable in interp. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
				 * bits. */
{
    return NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar --
 *
 *	Return the value of a Tcl variable as a string.
................................................................................
static int
ArraySizeCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{





    int size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }



















    if ((size = Tcl_ArraySize(interp, objv[1], TCL_LEAVE_ERR_MSG)) < 0) {
	return TCL_ERROR;





















    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
    return TCL_OK;
}
 
/*