| ︙ | | | ︙ | |
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;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | | | ︙ | |