Diff
Not logged in

Differences From Artifact [29598505a9]:

To Artifact [57793c78b6]:


189
190
191
192
193
194
195




196
197
198
199
200


201
202






203
204
205
206
207
208
209
/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks,
			    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 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,







>
>
>
>





>
>
|

>
>
>
>
>
>







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks,
			    int justConstants);
static Tcl_ObjCmdProc	ArrayAnyMoreCmd;
static Tcl_ObjCmdProc	ArrayDoneSearchCmd;
static Tcl_ObjCmdProc	ArrayNextElementCmd;
static Tcl_ObjCmdProc	ArrayStartSearchCmd;
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_ObjCmdProc	ArrayExistsCmd;
static Tcl_ObjCmdProc	ArrayForObjCmd;
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static Tcl_ObjCmdProc	ArrayGetCmd;
static Tcl_ObjCmdProc	ArrayNamesCmd;
static Tcl_ObjCmdProc	ArraySetCmd;
static Tcl_ObjCmdProc	ArraySizeCmd;
static Tcl_ObjCmdProc	ArrayStatsCmd;
static Tcl_ObjCmdProc	ArrayUnsetCmd;
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,
238
239
240
241
242
243
244

















245
246
247
248
249
250
251

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;


















/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table







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







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;

const EnsembleImplMap tclArrayImplMap[] = {
    {"anymore",		ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"default",		ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd,	NULL,		NULL, 0},
    {"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"exists",		ArrayExistsCmd,		TclCompileArrayExistsCmd,	NULL,		NULL, 0},
    {"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd,		ArrayForNRCmd,	NULL, 0}, // TODO: compile?
    {"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd,	NULL,		NULL, 0},
    {"names",		ArrayNamesCmd,		TclCompileBasic1To3ArgCmd,	NULL,		NULL, 0},
    {"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"set",		ArraySetCmd,		TclCompileArraySetCmd,		NULL,		NULL, 0},
    {"size",		ArraySizeCmd,		TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"unset",		ArrayUnsetCmd,		TclCompileArrayUnsetCmd,	NULL,		NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
263
264
265
266
267
268
269

270

271
272
273
274
275
276
277
    TCL_OBJTYPE_V0
};

#define LocalSetInternalRep(objPtr, index, namePtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\

	if (ptr) {Tcl_IncrRefCount(ptr);}				\

	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetInternalRep(objPtr, index, name)			\
    do {								\







>
|
>







292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
    TCL_OBJTYPE_V0
};

#define LocalSetInternalRep(objPtr, index, namePtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {							\
	    Tcl_IncrRefCount(ptr);					\
	}								\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreInternalRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetInternalRep(objPtr, index, name)			\
    do {								\
288
289
290
291
292
293
294

295


296

297
298
299
300
301
302
303
};

#define ParsedSetInternalRep(objPtr, arrayPtr, elem)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\

	if (ptr1) {Tcl_IncrRefCount(ptr1);}				\


	if (ptr2) {Tcl_IncrRefCount(ptr2);}				\

	ir.twoPtrValue.ptr1 = ptr1;					\
	ir.twoPtrValue.ptr2 = ptr2;					\
	Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir);	\
    } while (0)

#define ParsedGetInternalRep(objPtr, parsed, array, elem)		\
    do {								\







>
|
>
>
|
>







319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
};

#define ParsedSetInternalRep(objPtr, arrayPtr, elem)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
	Tcl_Obj *ptr2 = (elem);						\
	if (ptr1) {							\
	    Tcl_IncrRefCount(ptr1);					\
	}								\
	if (ptr2) {							\
	    Tcl_IncrRefCount(ptr2);					\
	}								\
	ir.twoPtrValue.ptr1 = ptr1;					\
	ir.twoPtrValue.ptr2 = ptr2;					\
	Tcl_StoreInternalRep((objPtr), &parsedVarNameType, &ir);	\
    } while (0)

#define ParsedGetInternalRep(objPtr, parsed, array, elem)		\
    do {								\
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitArrayCmd --
 *
 *	This creates the ensemble for the "array" command.
 *
 * Results:
 *	The handle for the created ensemble.
 *
 * Side effects:
 *	Creates a command in the global namespace.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "array", arrayImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * ObjMakeUpvar --
 *
 *	This function does all of the work of the "global" and "upvar"
 *	commands.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error







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







4471
4472
4473
4474
4475
4476
4477








































4478
4479
4480
4481
4482
4483
4484
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *








































 * ObjMakeUpvar --
 *
 *	This function does all of the work of the "global" and "upvar"
 *	commands.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
4934
4935
4936
4937
4938
4939
4940
4941

4942
4943
4944
4945
4946
4947
4948
     */
    if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL,
	    objv[2], TCL_LEAVE_ERR_MSG) == NULL) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	return TCL_ERROR;
    };

    TclSetVarConstant(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







<
>







4929
4930
4931
4932
4933
4934
4935

4936
4937
4938
4939
4940
4941
4942
4943
     */
    if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL,
	    objv[2], TCL_LEAVE_ERR_MSG) == NULL) {
	if (TclIsVarUndefined(varPtr)) {
	    CleanupVar(varPtr, arrayPtr);
	}
	return TCL_ERROR;

    }
    TclSetVarConstant(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *