Diff
Not logged in

Differences From Artifact [282924d905]:

To Artifact [d13c0c4e9b]:


195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







			    int justConstants);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static Tcl_ObjCmdProc2	ArrayForNRCmd;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, Tcl_Size index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233







-
+







			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, Tcl_Size index);

/*
 * TIP #508: [array default]
 */

static Tcl_ObjCmdProc	ArrayDefaultCmd;
static Tcl_ObjCmdProc2	ArrayDefaultCmd;
static void		DeleteArrayVar(Var *arrayPtr);
static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);

/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */
1508
1509
1510
1511
1512
1513
1514
1515

1516
1517
1518
1519
1520
1521
1522
1508
1509
1510
1511
1512
1513
1514

1515
1516
1517
1518
1519
1520
1521
1522







-
+







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

int
Tcl_SetObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
2755
2756
2757
2758
2759
2760
2761
2762

2763
2764
2765

2766
2767
2768
2769
2770
2771
2772
2755
2756
2757
2758
2759
2760
2761

2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2772







-
+


-
+







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

int
Tcl_UnsetObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i;
    Tcl_Size i;
    int flags = TCL_LEAVE_ERR_MSG;
    const char *name;

    if (objc == 1) {
	/*
	 * Do nothing if no arguments supplied, so as to match command
	 * documentation.
2823
2824
2825
2826
2827
2828
2829
2830

2831
2832
2833
2834
2835
2836

2837
2838
2839
2840
2841
2842
2843
2823
2824
2825
2826
2827
2828
2829

2830
2831
2832
2833
2834
2835

2836
2837
2838
2839
2840
2841
2842
2843







-
+





-
+







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

int
Tcl_AppendObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr = NULL;
				/* Initialized to avoid compiler warning. */
    int i;
    Tcl_Size i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
2888
2889
2890
2891
2892
2893
2894
2895

2896
2897
2898
2899
2900
2901
2902
2888
2889
2890
2891
2892
2893
2894

2895
2896
2897
2898
2899
2900
2901
2902







-
+







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

int
Tcl_LappendObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    Tcl_Size numElems;
    Var *varPtr, *arrayPtr;
    int result, createdNewObj;

3094
3095
3096
3097
3098
3099
3100
3101

3102
3103
3104

3105
3106
3107
3108
3109
3110
3111

3112
3113
3114
3115
3116
3117
3118
3094
3095
3096
3097
3098
3099
3100

3101
3102
3103

3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115
3116
3117
3118







-
+


-
+






-
+







    return donerc;
}

static int
ArrayForObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, ArrayForNRCmd, clientData, objc, objv);
    return Tcl_NRCallObjProc2(interp, ArrayForNRCmd, clientData, objc, objv);
}

static int
ArrayForNRCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    int isArray;
    Tcl_Size numVars;
3341
3342
3343
3344
3345
3346
3347
3348

3349
3350
3351
3352
3353
3354
3355
3341
3342
3343
3344
3345
3346
3347

3348
3349
3350
3351
3352
3353
3354
3355







-
+







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

static int
ArrayStartSearchCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    int isArray;
    ArraySearch *searchPtr;

    if (objc != 2) {
3436
3437
3438
3439
3440
3441
3442
3443

3444
3445
3446
3447
3448
3449
3450
3436
3437
3438
3439
3440
3441
3442

3443
3444
3445
3446
3447
3448
3449
3450







-
+







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

static int
ArrayAnyMoreCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    int gotValue, isArray;
    ArraySearch *searchPtr;
3514
3515
3516
3517
3518
3519
3520
3521

3522
3523
3524
3525
3526
3527
3528
3514
3515
3516
3517
3518
3519
3520

3521
3522
3523
3524
3525
3526
3527
3528







-
+







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

static int
ArrayNextElementCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;

3594
3595
3596
3597
3598
3599
3600
3601

3602
3603
3604
3605
3606
3607
3608
3594
3595
3596
3597
3598
3599
3600

3601
3602
3603
3604
3605
3606
3607
3608







-
+







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

static int
ArrayDoneSearchCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;
3654
3655
3656
3657
3658
3659
3660
3661

3662
3663
3664
3665
3666
3667
3668
3654
3655
3656
3657
3658
3659
3660

3661
3662
3663
3664
3665
3666
3667
3668







-
+







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

static int
ArrayExistsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *)interp;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
3694
3695
3696
3697
3698
3699
3700
3701

3702
3703
3704
3705
3706
3707
3708
3694
3695
3696
3697
3698
3699
3700

3701
3702
3703
3704
3705
3706
3707
3708







-
+







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

static int
ArrayGetCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
3854
3855
3856
3857
3858
3859
3860
3861

3862
3863
3864
3865
3866
3867
3868
3854
3855
3856
3857
3858
3859
3860

3861
3862
3863
3864
3865
3866
3867
3868







-
+







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

static int
ArrayNamesCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum arrayNamesOptionsEnum {OPT_EXACT, OPT_GLOB, OPT_REGEXP} mode = OPT_GLOB;
    Var *varPtr, *varPtr2;
4022
4023
4024
4025
4026
4027
4028
4029

4030
4031
4032
4033
4034
4035
4036
4022
4023
4024
4025
4026
4027
4028

4029
4030
4031
4032
4033
4034
4035
4036







-
+







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

static int
ArraySetCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Var *varPtr, *arrayPtr;
    int result;

4206
4207
4208
4209
4210
4211
4212
4213

4214
4215
4216
4217
4218
4219
4220
4206
4207
4208
4209
4210
4211
4212

4213
4214
4215
4216
4217
4218
4219
4220







-
+







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

static int
ArraySizeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_HashSearch search;
    Var *varPtr2;
    int isArray, size = 0;

4265
4266
4267
4268
4269
4270
4271
4272

4273
4274
4275
4276
4277
4278
4279
4265
4266
4267
4268
4269
4270
4271

4272
4273
4274
4275
4276
4277
4278
4279







-
+







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

static int
ArrayStatsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj;
    char *stats;
    int isArray;

4319
4320
4321
4322
4323
4324
4325
4326

4327
4328
4329
4330
4331
4332
4333
4319
4320
4321
4322
4323
4324
4325

4326
4327
4328
4329
4330
4331
4332
4333







-
+







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

static int
ArrayUnsetCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
4598
4599
4600
4601
4602
4603
4604
4605

4606
4607
4608
4609
4610
4611
4612
4598
4599
4600
4601
4602
4603
4604

4605
4606
4607
4608
4609
4610
4611
4612







-
+







    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    const char *myName,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
    Tcl_Size index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
{
    Tcl_Obj *myNamePtr = NULL;
    int result;

    if (myName) {
	myNamePtr = Tcl_NewStringObj(myName, -1);
4887
4888
4889
4890
4891
4892
4893
4894

4895
4896
4897
4898
4899
4900
4901
4887
4888
4889
4890
4891
4892
4893

4894
4895
4896
4897
4898
4899
4900
4901







-
+







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

int
Tcl_ConstObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *part1Ptr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName value");
4962
4963
4964
4965
4966
4967
4968
4969

4970
4971
4972
4973
4974
4975
4976
4977

4978
4979
4980
4981
4982
4983
4984
4962
4963
4964
4965
4966
4967
4968

4969
4970
4971
4972
4973
4974
4975
4976

4977
4978
4979
4980
4981
4982
4983
4984







-
+







-
+







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

int
Tcl_GlobalObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *objPtr, *tailPtr;
    const char *varName;
    const char *tail;
    int result;
    int i;
    Tcl_Size i;

    /*
     * If we are not executing inside a Tcl procedure, just return.
     */

    if (!HasLocalVars(iPtr->varFramePtr)) {
	return TCL_OK;
5067
5068
5069
5070
5071
5072
5073
5074

5075
5076
5077
5078
5079
5080
5081
5082


5083
5084
5085
5086
5087
5088
5089
5067
5068
5069
5070
5071
5072
5073

5074
5075
5076
5077
5078
5079
5080


5081
5082
5083
5084
5085
5086
5087
5088
5089







-
+






-
-
+
+







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

int
Tcl_VariableObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *tail, *cp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr;
    int i;
    int result;
    Tcl_Size i;
    int  result;
    Tcl_Obj *varNamePtr, *tailPtr;

    for (i=1 ; i<objc ; i+=2) {
	/*
	 * Look up each variable in the current namespace context, creating it
	 * if necessary.
	 */
5201
5202
5203
5204
5205
5206
5207
5208

5209
5210
5211
5212
5213
5214
5215
5201
5202
5203
5204
5205
5206
5207

5208
5209
5210
5211
5212
5213
5214
5215







-
+







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

int
Tcl_UpvarObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CallFrame *framePtr;
    int result, hasLevel;
    Tcl_Obj *levelObj;

    if (objc < 3) {
6017
6018
6019
6020
6021
6022
6023
6024

6025
6026
6027
6028
6029
6030
6031
6017
6018
6019
6020
6021
6022
6023

6024
6025
6026
6027
6028
6029
6030
6031







-
+







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

int
TclInfoVarsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *pattern, *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
6168
6169
6170
6171
6172
6173
6174
6175

6176
6177
6178
6179
6180
6181
6182
6168
6169
6170
6171
6172
6173
6174

6175
6176
6177
6178
6179
6180
6181
6182







-
+







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

int
TclInfoGlobalsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName, *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
6261
6262
6263
6264
6265
6266
6267
6268

6269
6270
6271
6272
6273
6274
6275
6261
6262
6263
6264
6265
6266
6267

6268
6269
6270
6271
6272
6273
6274
6275







-
+







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

int
TclInfoLocalsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *patternPtr, *listPtr;

    if (objc == 1) {
	patternPtr = NULL;
6320
6321
6322
6323
6324
6325
6326
6327

6328
6329
6330
6331
6332
6333
6334
6320
6321
6322
6323
6324
6325
6326

6327
6328
6329
6330
6331
6332
6333
6334







-
+







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

int
TclInfoConstsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *pattern, *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
6719
6720
6721
6722
6723
6724
6725
6726

6727
6728
6729
6730
6731
6732
6733
6719
6720
6721
6722
6723
6724
6725

6726
6727
6728
6729
6730
6731
6732
6733







-
+







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

int
TclInfoConstantCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    int result;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName");
6848
6849
6850
6851
6852
6853
6854
6855

6856
6857
6858
6859
6860
6861
6862
6848
6849
6850
6851
6852
6853
6854

6855
6856
6857
6858
6859
6860
6861
6862







-
+







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

static int
ArrayDefaultCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET } option;
    Tcl_Obj *arrayNameObj, *defaultValueObj;