Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | merge trunk's elimination of register keyword |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | dgp-refactor |
Files: | files | file ages | folders |
SHA3-256: |
9e3083e018d7ff4d820a3d6c2fa1bb97 |
User & Date: | dgp 2019-08-26 18:56:09.209 |
Context
2019-08-26
| ||
19:04 | merge trunk check-in: 00ce529160 user: dgp tags: dgp-refactor | |
18:56 | merge trunk's elimination of register keyword check-in: 9e3083e018 user: dgp tags: dgp-refactor | |
18:44 | merge trunk through Aug 14 check-in: 129893e072 user: dgp tags: dgp-refactor | |
2019-08-15
| ||
08:10 | Merge 8.7 check-in: f33e2933b5 user: jan.nijtmans tags: trunk | |
Changes
Changes to doc/OpenFileChnl.3.
︙ | ︙ | |||
273 274 275 276 277 278 279 | error for argc and argv to override stdio channels for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set. .PP If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | error for argc and argv to override stdio channels for which \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set. .PP If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR returns NULL and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in the interpreter's result. \fIinterp\fR cannot be NULL. .PP The newly created channel is not registered in the supplied interpreter; to register it, use \fBTcl_RegisterChannel\fR, described below. If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was previously closed, the act of creating the new channel also assigns it as a replacement for the standard channel. .SH TCL_MAKEFILECHANNEL |
︙ | ︙ |
Changes to generic/tclAlloc.c.
︙ | ︙ | |||
249 250 251 252 253 254 255 | *---------------------------------------------------------------------- */ void * TclpAlloc( size_t numBytes) /* Number of bytes to allocate. */ { | | | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | *---------------------------------------------------------------------- */ void * TclpAlloc( size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; size_t amount; struct block *bigBlockPtr = NULL; if (!allocInit) { /* * We have to make the "self initializing" because Tcl_Alloc may be * used before any other part of Tcl. E.g., see main() for tclsh! */ |
︙ | ︙ | |||
383 384 385 386 387 388 389 | *---------------------------------------------------------------------- */ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { | | | | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | *---------------------------------------------------------------------- */ static void MoreCore( size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; /* * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a * VAX, I think) or for a negative arg. |
︙ | ︙ | |||
443 444 445 446 447 448 449 | *---------------------------------------------------------------------- */ void TclpFree( void *oldPtr) /* Pointer to memory to free. */ { | | | | 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | *---------------------------------------------------------------------- */ void TclpFree( void *oldPtr) /* Pointer to memory to free. */ { size_t size; union overhead *overPtr; struct block *bigBlockPtr; if (oldPtr == NULL) { return; } Tcl_MutexLock(allocMutexPtr); |
︙ | ︙ | |||
640 641 642 643 644 645 646 | */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { | | | | 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 | */ #ifdef MSTATS void mstats( char *s) /* Where to write info. */ { unsigned int i, j; union overhead *overPtr; size_t totalFree = 0, totalUsed = 0; Tcl_MutexLock(allocMutexPtr); fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); for (i = 0; i < NBUCKETS; i++) { for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
847 848 849 850 851 852 853 | CompileAssembleObj( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ | | | 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 | CompileAssembleObj( Tcl_Interp *interp, /* Tcl interpreter */ Tcl_Obj *objPtr) /* Source code to assemble */ { Interp *iPtr = (Interp *) interp; /* Internals of the interpreter */ CompileEnv compEnv; /* Compilation environment structure */ ByteCode *codePtr = NULL; /* Bytecode resulting from the assembly */ Namespace* namespacePtr; /* Namespace in which variable and command * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ size_t sourceLen; /* Length of the source code in bytes */ |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
1253 1254 1255 1256 1257 1258 1259 | *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { | | | | 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 | *---------------------------------------------------------------------- */ int TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { const CmdInfo *cmdInfoPtr; const UnsafeEnsembleInfo *unsafePtr; if (interp == NULL) { return TCL_ERROR; } for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) { if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) { Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); |
︙ | ︙ | |||
2755 2756 2757 2758 2759 2760 2761 | *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 | *---------------------------------------------------------------------- */ int TclInvokeStringCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = clientData; int i, result; const char **argv = TclStackAlloc(interp, (objc + 1) * sizeof(char *)); |
︙ | ︙ | |||
2804 2805 2806 2807 2808 2809 2810 | */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ | | | 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 | */ int TclInvokeObjectCommand( ClientData clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Command *cmdPtr = clientData; Tcl_Obj *objPtr; int i, length, result; Tcl_Obj **objv = TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *))); |
︙ | ︙ | |||
3288 3289 3290 3291 3292 3293 3294 | * call to Tcl_CreateCommand. The command must * not have been deleted. */ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; | | | 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 | * call to Tcl_CreateCommand. The command must * not have been deleted. */ Tcl_Obj *objPtr) /* Points to the object onto which the * command's full name is appended. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) command; char *name; /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ |
︙ | ︙ | |||
3572 3573 3574 3575 3576 3577 3578 | * the name from cmdPtr */ const char *newName, /* Command's new name, or NULL if the command * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { | | | 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 | * the name from cmdPtr */ const char *newName, /* Command's new name, or NULL if the command * is not being renamed */ int flags) /* Flags indicating the type of traces to * trigger, either TCL_TRACE_DELETE or * TCL_TRACE_RENAME. */ { CommandTrace *tracePtr; ActiveCommandTrace active; char *result; Tcl_Obj *oldNamePtr = NULL; Tcl_InterpState state = NULL; if (cmdPtr->flags & CMD_TRACE_ACTIVE) { /* |
︙ | ︙ | |||
3762 3763 3764 3765 3766 3767 3768 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( | | | 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { Tcl_Free(cmdPtr); } } |
︙ | ︙ | |||
3792 3793 3794 3795 3796 3797 3798 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { | | | 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 | *---------------------------------------------------------------------- */ int TclInterpReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; /* * Reset the interpreter's result and clear out any previous error * information. */ Tcl_ResetResult(interp); |
︙ | ︙ | |||
3864 3865 3866 3867 3868 3869 3870 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { | | | 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 | */ int TclResetCancellation( Tcl_Interp *interp, int force) { Interp *iPtr = (Interp *) interp; if (iPtr == NULL) { return TCL_ERROR; } if (force || (iPtr->numLevels == 0)) { TclUnsetCancelFlags(iPtr); |
︙ | ︙ | |||
3906 3907 3908 3909 3910 3911 3912 | */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { | | | 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 | */ int Tcl_Canceled( Tcl_Interp *interp, int flags) { Interp *iPtr = (Interp *) interp; /* * Has the current script in progress for this interpreter been canceled * or is the stack being unwound due to the previous script cancellation? */ if (!TclCanceled(iPtr)) { |
︙ | ︙ | |||
5335 5336 5337 5338 5339 5340 5341 | void TclAdvanceLines( int *line, const char *start, const char *end) { | | | 5335 5336 5337 5338 5339 5340 5341 5342 5343 5344 5345 5346 5347 5348 5349 | void TclAdvanceLines( int *line, const char *start, const char *end) { const char *p; for (p = start; p < end; p++) { if (*p == '\n') { (*line)++; } } } |
︙ | ︙ | |||
5784 5785 5786 5787 5788 5789 5790 | *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ | | | | | 5784 5785 5786 5787 5788 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 5816 5817 5818 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 | *---------------------------------------------------------------------- */ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ { return TclEvalObjEx(interp, objPtr, flags, NULL, 0); } int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { int result = TCL_OK; NRE_callback *rootPtr = TOP_CB(interp); result = TclNREvalObjEx(interp, objPtr, flags, invoker, word); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */ const CmdFrame *invoker, /* Frame of the command doing the eval. */ int word) /* Index of the word which is in objPtr. */ { |
︙ | ︙ | |||
6126 6127 6128 6129 6130 6131 6132 | int Tcl_ExprLong( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { | | | 6126 6127 6128 6129 6130 6131 6132 6133 6134 6135 6136 6137 6138 6139 6140 | int Tcl_ExprLong( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ long *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; |
︙ | ︙ | |||
6150 6151 6152 6153 6154 6155 6156 | int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { | | | 6150 6151 6152 6153 6154 6155 6156 6157 6158 6159 6160 6161 6162 6163 6164 | int Tcl_ExprDouble( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ const char *exprstring, /* Expression to evaluate. */ double *ptr) /* Where to store result. */ { Tcl_Obj *exprPtr; int result = TCL_OK; if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ |
︙ | ︙ | |||
6219 6220 6221 6222 6223 6224 6225 | *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 6233 | *-------------------------------------------------------------- */ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; int result, type; double d; ClientData internalPtr; |
︙ | ︙ | |||
6266 6267 6268 6269 6270 6271 6272 | return result; } int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6266 6267 6268 6269 6270 6271 6272 6273 6274 6275 6276 6277 6278 6279 6280 | return result; } int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; int result, type; ClientData internalPtr; result = Tcl_ExprObj(interp, objPtr, &resultPtr); |
︙ | ︙ | |||
6302 6303 6304 6305 6306 6307 6308 | return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ | | | 6302 6303 6304 6305 6306 6307 6308 6309 6310 6311 6312 6313 6314 6315 6316 | return result; } int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; int result; result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result == TCL_OK) { |
︙ | ︙ | |||
6412 6413 6414 6415 6416 6417 6418 | int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { | | | 6412 6413 6414 6415 6416 6417 6418 6419 6420 6421 6422 6423 6424 6425 6426 | int TclNRInvoke( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTblPtr; /* Table of hidden commands. */ const char *cmdName; /* Name of the command from objv[0]. */ Tcl_HashEntry *hPtr = NULL; Command *cmdPtr; cmdName = TclGetString(objv[0]); hTblPtr = iPtr->hiddenCmdTablePtr; |
︙ | ︙ | |||
6534 6535 6536 6537 6538 6539 6540 | Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { size_t length; const char *message = TclGetStringFromObj(objPtr, &length); | | | 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 | Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { size_t length; const char *message = TclGetStringFromObj(objPtr, &length); Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); /* * If we are just starting to log an error, errorInfo is initialized from * the error message in the interpreter's result. */ |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
2271 2272 2273 2274 2275 2276 2277 | value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { | | | | | 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 | value -= (((unsigned) 1) << 31); } returnNumericObject: if (*numberCachePtrPtr == NULL) { return Tcl_NewWideIntObj(value); } else { Tcl_HashTable *tablePtr = *numberCachePtrPtr; Tcl_HashEntry *hPtr; int isNew; hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); if (!isNew) { return Tcl_GetHashValue(hPtr); } if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { Tcl_Obj *objPtr = Tcl_NewWideIntObj(value); Tcl_IncrRefCount(objPtr); Tcl_SetHashValue(hPtr, objPtr); return objPtr; } /* |
︙ | ︙ | |||
2399 2400 2401 2402 2403 2404 2405 | if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { | | | 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 | if (numberCachePtr == NULL) { return; } hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { Tcl_Obj *value = Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); } hEntry = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(numberCachePtr); |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
730 731 732 733 734 735 736 | int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 | int TclNREvalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
2112 2113 2114 2115 2116 2117 2118 | Tcl_Interp *interp, /* Interpreter for error reports. */ Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; | | | 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 | Tcl_Interp *interp, /* Interpreter for error reports. */ Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field, *value; unsigned short mode; /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! * * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want * to have an object (i.e. possibly cached) array variable name but a * string element name, so no API exists. Messy. |
︙ | ︙ | |||
2489 2490 2491 2492 2493 2494 2495 | * evaluation. */ int collect, /* Select collecting or accumulating mode * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; | | | 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 | * evaluation. */ int collect, /* Select collecting or accumulating mode * (TCL_EACH_*) */ int objc, /* The arguments being passed in... */ Tcl_Obj *const objv[]) { int numLists = (objc-2) / 2; struct ForeachState *statePtr; int i, j, result; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, "varList list ?varList list ...? command"); return TCL_ERROR; } |
︙ | ︙ | |||
2614 2615 2616 2617 2618 2619 2620 | static int ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { | | | 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 | static int ForeachLoopStep( ClientData data[], Tcl_Interp *interp, int result) { struct ForeachState *statePtr = data[0]; /* * Process the result code from this run of the [foreach] body. Note that * this switch uses fallthroughs in several places. Maintainer aware! */ switch (result) { |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
471 472 473 474 475 476 477 | static int InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | static int InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *listObjPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); |
︙ | ︙ | |||
534 535 536 537 538 539 540 | static int InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 | static int InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; size_t numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; |
︙ | ︙ | |||
639 640 641 642 643 644 645 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; | | | 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *cmdName, *pattern; const char *simplePattern; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; |
︙ | ︙ | |||
1839 1840 1841 1842 1843 1844 1845 | Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ | | | 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 | Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; /* * Get the pattern and find the "effective namespace" in which to list * procs. */ |
︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | *---------------------------------------------------------------------- */ int Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; size_t index; int len, result; if (objc < 3) { |
︙ | ︙ | |||
2495 2496 2497 2498 2499 2500 2501 | *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 | *---------------------------------------------------------------------- */ int Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. * Otherwise set the interpreter's result object to be a list object. */ |
︙ | ︙ | |||
2532 2533 2534 2535 2536 2537 2538 | */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 | */ int Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; |
︙ | ︙ | |||
2578 2579 2580 2581 2582 2583 2584 | */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 | */ int Tcl_LpopObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; if (objc < 2) { |
︙ | ︙ | |||
2671 2672 2673 2674 2675 2676 2677 | */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ | | | 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 | */ int Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; size_t first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); |
︙ | ︙ | |||
2858 2859 2860 2861 2862 2863 2864 | *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 | *---------------------------------------------------------------------- */ int Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray = NULL; /* * Check arguments for legality: |
︙ | ︙ | |||
2924 2925 2926 2927 2928 2929 2930 | * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { | | | 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 | * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. */ CLANG_ASSERT(dataArray || totalElems == 0 ); if (objc == 1) { Tcl_Obj *tmpPtr = objv[0]; tmpPtr->refCount += elementCount; for (i=0 ; i<elementCount ; i++) { dataArray[i] = tmpPtr; } } else { int j, k = 0; |
︙ | ︙ | |||
2970 2971 2972 2973 2974 2975 2976 | int Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 | int Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; size_t first, last; int listLen, numToDelete, result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last ?element ...?"); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
1660 1661 1662 1663 1664 1665 1666 | * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain; size_t elemSize; | | | 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 | * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; int lenRemain; size_t elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, |
︙ | ︙ | |||
1841 1842 1843 1844 1845 1846 1847 | * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; size_t lenRemain; size_t elemSize; | | | 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 | * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; size_t lenRemain; size_t elemSize; const char *p; string1 = TclGetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { if (TCL_ERROR == TclFindElement(NULL, p, lenRemain, |
︙ | ︙ | |||
4067 4068 4069 4070 4071 4072 4073 | int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 | int Tcl_TimeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *objPtr; Tcl_Obj *objs[4]; int i, result; int count; double totalMicroSec; #ifndef TCL_WIDE_CLICKS Tcl_Time start, stop; #else Tcl_WideInt start, stop; #endif |
︙ | ︙ | |||
4168 4169 4170 4171 4172 4173 4174 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ | | | | | 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static double measureOverhead = 0; /* global measure-overhead */ double overhead = -1; /* given measure-overhead */ Tcl_Obj *objPtr; int result, i; Tcl_Obj *calibrate = NULL, *direct = NULL; Tcl_WideUInt count = 0; /* Holds repetition count */ Tcl_WideInt maxms = WIDE_MIN; /* Maximal running time (in milliseconds) */ Tcl_WideUInt maxcnt = WIDE_MAX; /* Maximal count of iterations. */ Tcl_WideUInt threshold = 1; /* Current threshold for check time (faster * repeat count without time check) */ Tcl_WideUInt maxIterTm = 1; /* Max time of some iteration as max * threshold, additionally avoiding divide to * zero (i.e., never < 1) */ unsigned short factor = 50; /* Factor (4..50) limiting threshold to avoid * growth of execution time. */ Tcl_WideInt start, middle, stop; #ifndef TCL_WIDE_CLICKS Tcl_Time now; #endif /* !TCL_WIDE_CLICKS */ static const char *const options[] = { "-direct", "-overhead", "-calibrate", "--", NULL }; enum options { |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
2913 2914 2915 2916 2917 2918 2919 | */ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { | | | | 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 | */ static ClientData DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { ForeachInfo *srcPtr = clientData; ForeachInfo *dupPtr; ForeachVarList *srcListPtr, *dupListPtr; int numVars, i, j, numLists = srcPtr->numLists; dupPtr = Tcl_Alloc(sizeof(ForeachInfo) + numLists * sizeof(ForeachVarList *)); dupPtr->numLists = numLists; dupPtr->firstValueTemp = srcPtr->firstValueTemp; dupPtr->loopCtTemp = srcPtr->loopCtTemp; |
︙ | ︙ | |||
2962 2963 2964 2965 2966 2967 2968 | */ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { | | | | | 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 | */ static void FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { ForeachInfo *infoPtr = clientData; ForeachVarList *listPtr; int numLists = infoPtr->numLists; int i; for (i = 0; i < numLists; i++) { listPtr = infoPtr->varLists[i]; Tcl_Free(listPtr); } Tcl_Free(infoPtr); } |
︙ | ︙ | |||
2998 2999 3000 3001 3002 3003 3004 | static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 | static void PrintForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); |
︙ | ︙ | |||
3038 3039 3040 3041 3042 3043 3044 | static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 | static void PrintNewForeachInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=", infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); |
︙ | ︙ | |||
3068 3069 3070 3071 3072 3073 3074 | static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 | static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Data stores. */ |
︙ | ︙ | |||
3115 3116 3117 3118 3119 3120 3121 | static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | | 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 | static void DisassembleNewForeachInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { ForeachInfo *infoPtr = clientData; ForeachVarList *varsPtr; int i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. */ |
︙ | ︙ | |||
3441 3442 3443 3444 3445 3446 3447 | Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { | | | | 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 | Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ int *localIndexPtr, /* Must not be NULL. */ int *isScalarPtr) /* Must not be NULL. */ { const char *p; const char *last, *name, *elName; size_t n; Tcl_Token *elemTokenPtr = NULL; size_t nameLen, elNameLen; int simpleVarName, localIndex; int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; /* * Decide if we can use a frame slot for the var/array name or if we need |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
1868 1869 1870 1871 1872 1873 1874 | * way to statically avoid the problems you get from strings-to-be-matched * that start with a - (the interpreted code falls apart if it encounters * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { | | | | 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 | * way to statically avoid the problems you get from strings-to-be-matched * that start with a - (the interpreted code falls apart if it encounters * them, so we punt if we *might* encounter them as that is the easiest * way of emulating the behaviour). */ for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) { size_t size = tokenPtr[1].size; const char *chrs = tokenPtr[1].start; /* * We only process literal options, and we assume that -e, -g and -n * are unique prefixes of -exact, -glob and -nocase respectively (true * at time of writing). Note that -exact and -glob may only be given * at most once or we bail out (error case). */ |
︙ | ︙ | |||
2608 2609 2610 2611 2612 2613 2614 | static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { | | | 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 | static void PrintJumptableInfo( ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset, i = 0; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { |
︙ | ︙ | |||
2637 2638 2639 2640 2641 2642 2643 | static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { | | | 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 | static void DisassembleJumptableInfo( ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; Tcl_Obj *mapping = Tcl_NewObj(); Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
986 987 988 989 990 991 992 | * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( | | | 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 | * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr); assert(codePtr != NULL); TclReleaseByteCode(codePtr); |
︙ | ︙ | |||
1017 1018 1019 1020 1021 1022 1023 | * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclPreserveByteCode( | | | | | | | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 | * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclPreserveByteCode( ByteCode *codePtr) { codePtr->refCount++; } void TclReleaseByteCode( ByteCode *codePtr) { if (codePtr->refCount-- > 1) { return; } /* Just dropped to refcount==0. Clean up. */ CleanupByteCode(codePtr); } static void CleanupByteCode( ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; Interp *iPtr = (Interp *) interp; int numLitObjects = codePtr->numLitObjects; Tcl_Obj **objArrayPtr, *objPtr; const AuxData *auxDataPtr; int i; #ifdef TCL_COMPILE_STATS if (interp != NULL) { ByteCodeStats *statsPtr; Tcl_Time destroyTime; int lifetimeSec, lifetimeMicroSec, log2; |
︙ | ︙ | |||
1396 1397 1398 1399 1400 1401 1402 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( | | | | 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { ByteCode *codePtr; ByteCodeGetIntRep(objPtr, &substCodeType, codePtr); assert(codePtr != NULL); TclReleaseByteCode(codePtr); } |
︙ | ︙ | |||
1447 1448 1449 1450 1451 1452 1453 | *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ | | | 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 | *---------------------------------------------------------------------- */ void TclInitCompileEnv( Tcl_Interp *interp, /* The interpreter for which a CompileEnv * structure is initialized. */ CompileEnv *envPtr,/* Points to the CompileEnv structure to * initialize. */ const char *stringPtr, /* The source string to be compiled. */ size_t numBytes, /* Number of bytes in source string. */ const CmdFrame *invoker, /* Location context invoking the bcc */ int word) /* Index of the word in that context getting * compiled */ { |
︙ | ︙ | |||
1649 1650 1651 1652 1653 1654 1655 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( | | | 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { Tcl_DeleteHashTable(&envPtr->litMap); if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would * have transferred to it. */ |
︙ | ︙ | |||
2814 2815 2816 2817 2818 2819 2820 | Tcl_IncrRefCount(envPtr->literalArrayPtr[i]); TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); } } ByteCode * TclInitByteCode( | | | | | 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 | Tcl_IncrRefCount(envPtr->literalArrayPtr[i]); TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); } } ByteCode * TclInitByteCode( CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes; size_t structureSize; unsigned char *p; #ifdef TCL_COMPILE_DEBUG unsigned char *nextPtr; #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; int isNew; Interp *iPtr; |
︙ | ︙ | |||
2952 2953 2954 2955 2956 2957 2958 | ByteCode * TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, | | | 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 | ByteCode * TclInitByteCodeObj( Tcl_Obj *objPtr, /* Points object that should be initialized, * and whose string rep contains the source * code. */ const Tcl_ObjType *typePtr, CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { ByteCode *codePtr; PreventCycle(objPtr, envPtr); codePtr = TclInitByteCode(envPtr); |
︙ | ︙ | |||
2997 2998 2999 3000 3001 3002 3003 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( | | | | | 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ size_t nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; int localVar = -1; int i; Proc *procPtr; /* * If not creating a temporary, does a local variable of the specified * name already exist? */ |
︙ | ︙ | |||
3289 3290 3291 3292 3293 3294 3295 | * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ | | | | | 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 | * *---------------------------------------------------------------------- */ int TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; int index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* * Expand the ExceptionRange array. The currently allocated entries * are stored between elements 0 and (envPtr->exceptArrayNext - 1) * [inclusive]. |
︙ | ︙ | |||
3685 3686 3687 3688 3689 3690 3691 | int TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ | | | 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 | int TclCreateAuxData( ClientData clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { AuxData *auxDataPtr; /* Points to the new AuxData structure */ if (envPtr->auxData == NULL) { envPtr->auxData = BA_AuxData_Create(); } |
︙ | ︙ | |||
4248 4249 4250 4251 4252 4253 4254 | * encode. */ ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { | | | 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 | * encode. */ ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { unsigned char *p = startPtr; int codeDelta, codeLen, srcDelta, srcLen, prevOffset; BA_CmdLocation *map = envPtr->cmdMap; BP_CmdLocation ptr; CmdLocation *cmdLocPtr; /* * Encode the code offset for each command as a sequence of deltas. |
︙ | ︙ | |||
4370 4371 4372 4373 4374 4375 4376 | void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; | | | 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 | void RecordByteCodeStats( ByteCode *codePtr) /* Points to ByteCode structure with info * to add to accumulated statistics. */ { Interp *iPtr = (Interp *) *codePtr->interpHandle; ByteCodeStats *statsPtr; if (iPtr == NULL) { /* Avoid segfaulting in case we're called in a deleted interp */ return; } statsPtr = &(iPtr->stats); |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
537 538 539 540 541 542 543 | FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; | | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | FormatInstruction( ByteCode *codePtr, /* Bytecode containing the instruction. */ const unsigned char *pc, /* Points to first byte of instruction. */ Tcl_Obj *bufferObj) /* Object to append instruction info to. */ { Proc *procPtr = codePtr->procPtr; unsigned char opCode = *pc; const InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; char suffixBuffer[128]; /* Additional info to print after main opcode * and immediates. */ |
︙ | ︙ | |||
858 859 860 861 862 863 864 | static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { | | | | 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 | static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ int maxChars) /* Maximum number of chars to print. */ { const char *p; int i = 0, len; Tcl_UniChar ch = 0; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); return; } |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
115 116 117 118 119 120 121 | * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } return Tcl_NewStringObj(nsPtr->fullName, -1); } |
︙ | ︙ | |||
1809 1810 1811 1812 1813 1814 1815 | char *fullName = NULL; /* Full name of the subcommand. */ size_t stringLength, i; size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { | | | 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 | char *fullName = NULL; /* Full name of the subcommand. */ size_t stringLength, i; size_t tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = TclGetStringFromObj(subObj, &stringLength); for (i=0 ; i<tableLength ; i++) { int cmp = strncmp(subcmdName, ensemblePtr->subcommandArrayPtr[i], stringLength); if (cmp == 0) { if (fullName != NULL) { /* * Since there's never the exact-match case to worry about |
︙ | ︙ | |||
2400 2401 2402 2403 2404 2405 2406 | static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { | | | 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 | static void MakeCachedEnsembleCommand( Tcl_Obj *objPtr, EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr, Tcl_Obj *fix) { EnsembleCmdRep *ensembleCmd; ECRGetIntRep(objPtr, ensembleCmd); if (ensembleCmd) { TclCleanupCommandMacro(ensembleCmd->token); if (ensembleCmd->fix) { Tcl_DecrRefCount(ensembleCmd->fix); } |
︙ | ︙ |
Changes to generic/tclFileName.c.
︙ | ︙ | |||
1070 1071 1072 1073 1074 1075 1076 | /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { | | | 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 | /* * Convert forward slashes to backslashes in Windows paths because some * system interfaces don't accept forward slashes. */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { char *p; for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { if (*p == '/') { *p = '\\'; } } } |
︙ | ︙ | |||
2076 2077 2078 2079 2080 2081 2082 | static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; | | | 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 | static int SkipToChar( char **stringPtr, /* Pointer string to check. */ int match) /* Character to find. */ { int quoted, level; char *p; quoted = 0; level = 0; for (p = *stringPtr; *p != '\0'; p++) { if (quoted) { quoted = 0; |
︙ | ︙ | |||
2627 2628 2629 2630 2631 2632 2633 | Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else | | | 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 | Tcl_WideUInt Tcl_GetBlocksFromStat( const Tcl_StatBuf *statPtr) { #ifdef HAVE_STRUCT_STAT_ST_BLOCKS return (Tcl_WideUInt) statPtr->st_blocks; #else unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr); return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize; #endif } unsigned Tcl_GetBlockSizeFromStat( |
︙ | ︙ |
Changes to generic/tclHash.c.
︙ | ︙ | |||
102 103 104 105 106 107 108 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( | | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType) /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an * integer >= 2. */ { /* |
︙ | ︙ | |||
140 141 142 143 144 145 146 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( | | | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitCustomHashTable( Tcl_HashTable *tablePtr, /* Pointer to table record, which is supplied * by the caller. */ int keyType, /* Type of keys to use in table: * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS, * or an integer >= 2. */ const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the |
︙ | ︙ | |||
241 242 243 244 245 246 247 | CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { | | | 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 | CreateHashEntry( Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ const char *key, /* Key to use to find or create matching * entry. */ int *newPtr) /* Store info here telling whether a new entry * was created. */ { Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; size_t hash, index; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; |
︙ | ︙ | |||
361 362 363 364 365 366 367 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { | | | 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 | *---------------------------------------------------------------------- */ void Tcl_DeleteHashEntry( Tcl_HashEntry *entryPtr) { Tcl_HashEntry *prevPtr; const Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; size_t index; tablePtr = entryPtr->tablePtr; |
︙ | ︙ | |||
430 431 432 433 434 435 436 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( | | | | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 | * The hash table is no longer useable. * *---------------------------------------------------------------------- */ void Tcl_DeleteHashTable( Tcl_HashTable *tablePtr) /* Table to delete. */ { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; size_t i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { typePtr = &tclOneWordHashKeyType; |
︙ | ︙ | |||
538 539 540 541 542 543 544 | * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( | | | 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | * None. * *---------------------------------------------------------------------- */ Tcl_HashEntry * Tcl_NextHashEntry( Tcl_HashSearch *searchPtr) /* Place to store information about progress * through the table. Must have been * initialized by calling * Tcl_FirstHashEntry. */ { Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr = searchPtr->tablePtr; |
︙ | ︙ | |||
585 586 587 588 589 590 591 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; | | | 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 | char * Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; Tcl_HashEntry *hPtr; char *result, *p; /* * Compute a histogram of bucket usage. */ for (i = 0; i < NUM_COUNTERS; i++) { |
︙ | ︙ | |||
655 656 657 658 659 660 661 | static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; | | | 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 | static Tcl_HashEntry * AllocArrayEntry( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; int *iPtr1, *iPtr2; Tcl_HashEntry *hPtr; int count; size_t size; count = tablePtr->keyType; size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); |
︙ | ︙ | |||
738 739 740 741 742 743 744 | */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | | 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 | */ static TCL_HASH_TYPE HashArrayKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const int *array = (const int *) keyPtr; TCL_HASH_TYPE result; int count; for (result = 0, count = tablePtr->keyType; count > 0; count--, array++) { result += *array; } return result; |
︙ | ︙ | |||
832 833 834 835 836 837 838 | */ static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { | | | | | 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 | */ static TCL_HASH_TYPE HashStringKey( Tcl_HashTable *tablePtr, /* Hash table. */ void *keyPtr) /* Key from which to compute hash value. */ { const char *string = keyPtr; TCL_HASH_TYPE result; char c; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: |
︙ | ︙ | |||
953 954 955 956 957 958 959 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( | | | | | 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 | * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void RebuildTable( Tcl_HashTable *tablePtr) /* Table to enlarge. */ { size_t count, index, oldSize = tablePtr->numBuckets; Tcl_HashEntry **oldBuckets = tablePtr->buckets; Tcl_HashEntry **oldChainPtr, **newChainPtr; Tcl_HashEntry *hPtr; const Tcl_HashKeyType *typePtr; /* Avoid outgrowing capability of the memory allocators */ if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) { tablePtr->rebuildSize = INT_MAX; return; } |
︙ | ︙ |
Changes to generic/tclHistory.c.
︙ | ︙ | |||
57 58 59 60 61 62 63 | * be executed. */ const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | * be executed. */ const char *cmd, /* Command to record. */ int flags) /* Additional flags. TCL_NO_EVAL means only * record: don't execute command. * TCL_EVAL_GLOBAL means use Tcl_GlobalEval * instead of Tcl_Eval. */ { Tcl_Obj *cmdPtr; int result; if (cmd[0]) { /* * Call Tcl_RecordAndEvalObj to do the actual work. */ |
︙ | ︙ | |||
202 203 204 205 206 207 208 | */ static void DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { | | | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | */ static void DeleteHistoryObjs( ClientData clientData, Tcl_Interp *interp) { HistoryObjs *histObjsPtr = clientData; TclDecrRefCount(histObjsPtr->historyObj); TclDecrRefCount(histObjsPtr->addObj); Tcl_Free(histObjsPtr); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
7480 7481 7482 7483 7484 7485 7486 | int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { | | | 7480 7481 7482 7483 7484 7485 7486 7487 7488 7489 7490 7491 7492 7493 7494 | int bytesBuffered; for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL; bufPtr = bufPtr->nextPtr) { bytesBuffered += BytesLeft(bufPtr); } if (statePtr->curOutPtr != NULL) { ChannelBuffer *curOutPtr = statePtr->curOutPtr; if (IsBufferReady(curOutPtr)) { bytesBuffered += BytesLeft(curOutPtr); } } return bytesBuffered; |
︙ | ︙ | |||
11220 11221 11222 11223 11224 11225 11226 | * representation. * *---------------------------------------------------------------------- */ static void DupChannelIntRep( | | | | 11220 11221 11222 11223 11224 11225 11226 11227 11228 11229 11230 11231 11232 11233 11234 11235 11236 | * representation. * *---------------------------------------------------------------------- */ static void DupChannelIntRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "Channel". */ Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { ResolvedChanName *resPtr; ChanGetIntRep(srcPtr, resPtr); assert(resPtr); ChanSetIntRep(copyPtr, resPtr); |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
2121 2122 2123 2124 2125 2126 2127 | *---------------------------------------------------------------------- */ static Tcl_Obj * DecodeEventMask( int mask) { | | | 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 | *---------------------------------------------------------------------- */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: |
︙ | ︙ |
Changes to generic/tclIORTrans.c.
︙ | ︙ | |||
1702 1703 1704 1705 1706 1707 1708 | * DUPLICATE of 'DecodeEventMask' in tclIORChan.c */ static Tcl_Obj * DecodeEventMask( int mask) { | | | 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 | * DUPLICATE of 'DecodeEventMask' in tclIORChan.c */ static Tcl_Obj * DecodeEventMask( int mask) { const char *eventStr; Tcl_Obj *evObj; switch (mask & RANDW) { case RANDW: eventStr = "read write"; break; case TCL_READABLE: |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
︙ | ︙ | |||
353 354 355 356 357 358 359 | * *---------------------------------------------------------------------- */ static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | * *---------------------------------------------------------------------- */ static int SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); } return TCL_ERROR; |
︙ | ︙ | |||
385 386 387 388 389 390 391 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | */ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1; const char *indexStr = EXPAND_OF(indexRep); Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
874 875 876 877 878 879 880 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { | | | 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 | for (i=0 ; i<toPrint ; i++) { /* * Add the element, quoting it if necessary. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) { IndexRep *indexRep = irPtr->twoPtrValue.ptr1; elementStr = EXPAND_OF(indexRep); elemLen = strlen(elementStr); } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } flags = 0; |
︙ | ︙ | |||
921 922 923 924 925 926 927 | * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { | | | 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 | * If the object is an index type use the index table which allows for * the correct error message even if the subcommand was abbreviated. * Otherwise, just use the string rep. */ const Tcl_ObjIntRep *irPtr; if ((irPtr = TclFetchIntRep(objv[i], &indexType))) { IndexRep *indexRep = irPtr->twoPtrValue.ptr1; Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL); } else { /* * Quote the argument if it contains spaces (Bug 942757). */ |
︙ | ︙ | |||
1008 1009 1010 1011 1012 1013 1014 | * processed here. Should be NULL if no return * of arguments is desired. */ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ | | | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 | * processed here. Should be NULL if no return * of arguments is desired. */ { Tcl_Obj **leftovers; /* Array to write back to remObjv on * successful exit. Will include the name of * the command. */ int nrem; /* Size of leftovers.*/ const Tcl_ArgvInfo *infoPtr; /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; char c; /* Second character of current arg (used for * quick check for matching; use 2nd char. * because first char. will almost always be * '-'). */ int srcIndex; /* Location from which to read next argument * from objv. */ int dstIndex; /* Used to keep track of current arguments * being processed, primarily for error |
︙ | ︙ | |||
1263 1264 1265 1266 1267 1268 1269 | PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { | | | 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 | PrintUsage( Tcl_Interp *interp, /* Place information in this interp's result * area. */ const Tcl_ArgvInfo *argTable) /* Array of command-specific argument * descriptions. */ { const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 static const char spaces[] = " "; char tmp[TCL_DOUBLE_SPACE]; Tcl_Obj *msg; /* |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 | MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); | > | 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 | MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(int byte); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); |
︙ | ︙ |
Changes to generic/tclInterp.c.
︙ | ︙ | |||
3358 3359 3360 3361 3362 3363 3364 | *---------------------------------------------------------------------- */ int Tcl_LimitExceeded( Tcl_Interp *interp) { | | | 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 | *---------------------------------------------------------------------- */ int Tcl_LimitExceeded( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; return iPtr->limit.exceeded != 0; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3389 3390 3391 3392 3393 3394 3395 | *---------------------------------------------------------------------- */ int Tcl_LimitReady( Tcl_Interp *interp) { | | | | 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 | *---------------------------------------------------------------------- */ int Tcl_LimitReady( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; if (iPtr->limit.active != 0) { int ticker = ++iPtr->limit.granularityTicker; if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || (ticker % iPtr->limit.cmdGranularity == 0))) { return 1; } if ((iPtr->limit.active & TCL_LIMIT_TIME) && |
︙ | ︙ | |||
3436 3437 3438 3439 3440 3441 3442 | */ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; | | | 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 | */ int Tcl_LimitCheck( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; int ticker = iPtr->limit.granularityTicker; if (Tcl_InterpDeleted(interp)) { return TCL_OK; } if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) && ((iPtr->limit.cmdGranularity == 1) || |
︙ | ︙ |
Changes to generic/tclListObj.c.
︙ | ︙ | |||
520 521 522 523 524 525 526 | * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 | * *---------------------------------------------------------------------- */ int Tcl_ListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object for which an element array is * to be returned. */ int *objcPtr, /* Where to store the count of objects * referenced by objv. */ Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of * pointers to the list's objects. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; |
︙ | ︙ | |||
585 586 587 588 589 590 591 | * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 | * *---------------------------------------------------------------------- */ int Tcl_ListObjAppendList( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append elements to. */ Tcl_Obj *elemListPtr) /* List obj with elements to append. */ { int objc; Tcl_Obj **objv; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); |
︙ | ︙ | |||
647 648 649 650 651 652 653 | int Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { | | | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | int Tcl_ListObjAppendElement( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to append objPtr to. */ Tcl_Obj *objPtr) /* Object to append to listPtr's list. */ { List *listRepPtr, *newPtr = NULL; int numElems, numRequired, needGrow, isShared, attempt; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement"); } ListGetIntRep(listPtr, listRepPtr); |
︙ | ︙ | |||
823 824 825 826 827 828 829 | * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 | * *---------------------------------------------------------------------- */ int Tcl_ListObjIndex( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object to index into. */ int index, /* Index of element to return. */ Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; (void) TclGetStringFromObj(listPtr, &length); |
︙ | ︙ | |||
881 882 883 884 885 886 887 | * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ | | | | | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 | * *---------------------------------------------------------------------- */ int Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listPtr, /* List object whose #elements to return. */ int *intPtr) /* The resulting int is stored here. */ { List *listRepPtr; ListGetIntRep(listPtr, listRepPtr); if (listRepPtr == NULL) { int result; size_t length; (void) TclGetStringFromObj(listPtr, &length); |
︙ | ︙ | |||
957 958 959 960 961 962 963 | int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; | | | 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 | int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; Tcl_Obj **elemPtrs; int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared; if (Tcl_IsShared(listPtr)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } ListGetIntRep(listPtr, listRepPtr); |
︙ | ︙ |
Changes to generic/tclLiteral.c.
︙ | ︙ | |||
55 56 57 58 59 60 61 | * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | * The literal table is made ready for use. * *---------------------------------------------------------------------- */ void TclInitLiteralTable( LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", TCL_SMALL_HASH_TABLE); #endif |
︙ | ︙ | |||
402 403 404 405 406 407 408 | *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ | | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 | *---------------------------------------------------------------------- */ int TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ size_t length, /* Number of bytes in the string. If * TCL_AUTO_LENGTH, the string consists of * all bytes up to the first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to |
︙ | ︙ | |||
475 476 477 478 479 480 481 | *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 | *---------------------------------------------------------------------- */ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *entryPtr; const char *bytes; size_t globalHash, length; bytes = TclGetStringFromObj(objPtr, &length); globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL; entryPtr=entryPtr->nextPtr) { |
︙ | ︙ | |||
521 522 523 524 525 526 527 | *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 | *---------------------------------------------------------------------- */ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { Tcl_Obj **lPtr; Tcl_Obj *newObjPtr; Tcl_HashEntry *hePtr; |
︙ | ︙ | |||
571 572 573 574 575 576 577 | * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( | | | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | * literal object. * *---------------------------------------------------------------------- */ int TclAddLiteralObj( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* UNUSED. Still in place due to publication * in the internal stubs table, and use by * tclcompiler. */ { int objIndex; |
︙ | ︙ | |||
614 615 616 617 618 619 620 | * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( | | | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 | * The local literal table is updated to refer to the new entries. * *---------------------------------------------------------------------- */ static void ExpandLocalLiteralArray( CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ |
︙ | ︙ | |||
675 676 677 678 679 680 681 | *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ | | | | 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | *---------------------------------------------------------------------- */ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; size_t length, index; if (iPtr == NULL) { goto done; } |
︙ | ︙ | |||
754 755 756 757 758 759 760 | * None. * *---------------------------------------------------------------------- */ static size_t HashString( | | | | 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 | * None. * *---------------------------------------------------------------------- */ static size_t HashString( const char *string, /* String for which to compute hash value. */ size_t length) /* Number of bytes in the string. */ { size_t result = 0; /* * I tried a zillion different hash functions and asked many other people * for advice. Many people had their own favorite functions, all * different, but no-one had much idea why they were good ones. I chose * the one below (multiply by 9 and add new character) because of the * following reasons: |
︙ | ︙ | |||
818 819 820 821 822 823 824 | * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( | | | | | 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 | * Memory gets reallocated and entries get rehashed into new buckets. * *---------------------------------------------------------------------- */ static void RebuildLiteralTable( LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; LiteralEntry **oldChainPtr, **newChainPtr; LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; size_t oldSize, count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; |
︙ | ︙ | |||
946 947 948 949 950 951 952 | char * TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; | | | 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 | char * TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 size_t count[NUM_COUNTERS], overflow, i, j; double average, tmp; LiteralEntry *entryPtr; char *result, *p; /* * Compute a histogram of bucket usage. For each bucket chain i, j is the * number of entries in the chain. */ |
︙ | ︙ | |||
1053 1054 1055 1056 1057 1058 1059 | */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { | | | | 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 | */ void TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { LiteralTable *globalTablePtr = &iPtr->literalTable; LiteralEntry *globalPtr; char *bytes; size_t i, length, count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
236 237 238 239 240 241 242 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( | | | 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetCurrentNamespace( Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { return TclGetCurrentNamespace(interp); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
260 261 262 263 264 265 266 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( | | | 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 | * None. * *---------------------------------------------------------------------- */ Tcl_Namespace * Tcl_GetGlobalNamespace( Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { return TclGetGlobalNamespace(interp); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
312 313 314 315 316 317 318 | * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; | | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 | * created in the frame. If 0, the frame is * for a "namespace eval" or "namespace * inscope" command and var references are * treated as references to namespace * variables. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = (CallFrame *) callFramePtr; Namespace *nsPtr; if (namespacePtr == NULL) { nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; /* |
︙ | ︙ | |||
389 390 391 392 393 394 395 | *---------------------------------------------------------------------- */ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { | | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | *---------------------------------------------------------------------- */ void Tcl_PopCallFrame( Tcl_Interp *interp) /* Interpreter with call frame to pop. */ { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; /* * It's important to remove the call frame from the interpreter's stack of * call frames before deleting local variables, so that traces invoked by * the variable deletion don't see the partially-deleted frame. */ |
︙ | ︙ | |||
674 675 676 677 678 679 680 | ClientData clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; | | | 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 | ClientData clientData, /* One-word value to store with namespace. */ Tcl_NamespaceDeleteProc *deleteProc) /* Function called to delete client data when * the namespace is deleted. NULL if no * function should be called. */ { Interp *iPtr = (Interp *) interp; Namespace *nsPtr, *ancestorPtr; Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr; Namespace *globalNsPtr = iPtr->globalNsPtr; const char *simpleName; Tcl_HashEntry *entryPtr; Tcl_DString buffer1, buffer2; Tcl_DString *namePtr, *buffPtr; int newEntry; |
︙ | ︙ | |||
842 843 844 845 846 847 848 | Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { | | | 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 | Tcl_DStringInit(&buffer1); Tcl_DStringInit(&buffer2); namePtr = &buffer1; buffPtr = &buffer2; for (ancestorPtr = nsPtr; ancestorPtr != NULL; ancestorPtr = ancestorPtr->parentPtr) { if (ancestorPtr != globalNsPtr) { Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); /* * Clear the unwanted buffer or we end up appending to previous |
︙ | ︙ | |||
916 917 918 919 920 921 922 | *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { | | | 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 | *---------------------------------------------------------------------- */ void Tcl_DeleteNamespace( Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */ { Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr; |
︙ | ︙ | |||
1112 1113 1114 1115 1116 1117 1118 | * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( | | | | 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 | * Deletes all commands, variables and namespaces in this namespace. * *---------------------------------------------------------------------- */ void TclTeardownNamespace( Namespace *nsPtr) /* Points to the namespace to be dismantled * and unlinked from its parent. */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; size_t i; /* * Start by destroying the namespace's variable table, since variables * might trigger traces. Variable table should be cleared but not freed! * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards. |
︙ | ︙ | |||
1300 1301 1302 1303 1304 1305 1306 | * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( | | | 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 | * None. * *---------------------------------------------------------------------- */ static void NamespaceFree( Namespace *nsPtr) /* Points to the namespace to free. */ { /* * Most of the namespace's contents are freed when the namespace is * deleted by Tcl_DeleteNamespace. All that remains is to free its names * (for error messages), and the structure itself. */ |
︙ | ︙ | |||
1623 1624 1625 1626 1627 1628 1629 | int allowOverwrite) /* If nonzero, allow existing commands to be * overwritten by imported commands. If 0, * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; | | | 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 | int allowOverwrite) /* If nonzero, allow existing commands to be * overwritten by imported commands. If 0, * return an error if an imported cmd * conflicts with an existing one. */ { Namespace *nsPtr, *importNsPtr, *dummyPtr; const char *simplePattern; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { |
︙ | ︙ | |||
1908 1909 1910 1911 1912 1913 1914 | * removed. NULL for current namespace. */ const char *pattern) /* String pattern indicating which imported * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; | | | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 | * removed. NULL for current namespace. */ const char *pattern) /* String pattern indicating which imported * commands to remove. */ { Namespace *nsPtr, *sourceNsPtr, *dummyPtr; const char *simplePattern; char *cmdName; Tcl_HashEntry *hPtr; Tcl_HashSearch search; /* * If the specified namespace is NULL, use the current namespace. */ if (namespacePtr == NULL) { |
︙ | ︙ | |||
2035 2036 2037 2038 2039 2040 2041 | */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { | | | 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 | */ Tcl_Command TclGetOriginalCommand( Tcl_Command command) /* The imported command for which the original * command should be returned. */ { Command *cmdPtr = (Command *) command; ImportedCmdData *dataPtr; if (cmdPtr->deleteProc != DeleteImportedCmd) { return NULL; } while (cmdPtr->deleteProc == DeleteImportedCmd) { |
︙ | ︙ | |||
2124 2125 2126 2127 2128 2129 2130 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; | | | 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 | DeleteImportedCmd( ClientData clientData) /* Points to the imported command's * ImportedCmdData structure. */ { ImportedCmdData *dataPtr = clientData; Command *realCmdPtr = dataPtr->realCmdPtr; Command *selfPtr = dataPtr->selfPtr; ImportRef *refPtr, *prevPtr; prevPtr = NULL; for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL; refPtr = refPtr->nextPtr) { if (refPtr->importedCmdPtr == selfPtr) { /* * Remove *refPtr from real command's list of imported commands |
︙ | ︙ | |||
2544 2545 2546 2547 2548 2549 2550 | * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ | | | 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 | * (current namespace if contextNsPtr is * NULL), then in global namespace. */ Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or * if the name starts with "::". Otherwise, * points to namespace in which to resolve * name; if NULL, look up name in the current * namespace. */ int flags) /* Flags controlling namespace lookup: an OR'd * combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG flags. */ { Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; const char *dummy; /* |
︙ | ︙ | |||
2615 2616 2617 2618 2619 2620 2621 | * namespace if contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; | | | | 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 | * namespace if contextNsPtr is NULL), and * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY * and TCL_NAMESPACE_ONLY are given, * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; Namespace *cxtNsPtr; Tcl_HashEntry *entryPtr; Command *cmdPtr; const char *simpleName; int result; /* * If this namespace has a command resolver, then give it first crack at * the command resolution. If the interpreter has any command resolvers, * consult them next. The command resolver functions may return a |
︙ | ︙ | |||
2727 2728 2729 2730 2731 2732 2733 | if (entryPtr != NULL) { cmdPtr = Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; | | | 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 | if (entryPtr != NULL) { cmdPtr = Tcl_GetHashValue(entryPtr); } } } } else { Namespace *nsPtr[2]; int search; TclGetNamespaceForQualName(interp, name, cxtNsPtr, flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /* * Look for the command in the command table of its namespace. Be sure * to check both possible search paths: from the specified namespace |
︙ | ︙ | |||
2801 2802 2803 2804 2805 2806 2807 | void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; | | | 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 | void TclResetShadowedCmdRefs( Tcl_Interp *interp, /* Interpreter containing the new command. */ Command *newCmdPtr) /* Points to the new command. */ { char *cmdName; Tcl_HashEntry *hPtr; Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ Namespace **trailPtr = TclStackAlloc(interp, trailSize * sizeof(Namespace *)); |
︙ | ︙ | |||
3051 3052 3053 3054 3055 3056 3057 | Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; | | | 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 | Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); const char *pattern = NULL; Tcl_DString buffer; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Tcl_Obj *listPtr, *elemPtr; /* * Get a pointer to the specified namespace, or the current namespace. */ |
︙ | ︙ | |||
3177 3178 3179 3180 3181 3182 3183 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; | | | 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); return TCL_ERROR; } |
︙ | ︙ | |||
3256 3257 3258 3259 3260 3261 3262 | static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 | static int NamespaceCurrentCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *currNsPtr; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } /* |
︙ | ︙ | |||
3321 3322 3323 3324 3325 3326 3327 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; | | | 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Namespace *namespacePtr; const char *name; int i; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?name name...?"); return TCL_ERROR; } /* |
︙ | ︙ | |||
3739 3740 3741 3742 3743 3744 3745 | NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; | | | 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 | NamespaceForgetCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *pattern; int i, result; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?"); return TCL_ERROR; } for (i = 1; i < objc; i++) { |
︙ | ︙ | |||
3805 3806 3807 3808 3809 3810 3811 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; | | | 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 | ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int allowOverwrite = 0; const char *string, *pattern; int i, result; int firstArg; if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?"); return TCL_ERROR; } |
︙ | ︙ | |||
3958 3959 3960 3961 3962 3963 3964 | * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; | | | 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 | * of extra arguments to form the command to evaluate. */ if (objc == 3) { cmdObjPtr = objv[2]; } else { Tcl_Obj *concatObjv[2]; Tcl_Obj *listPtr; listPtr = Tcl_NewListObj(0, NULL); for (i = 3; i < objc; i++) { if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){ Tcl_DecrRefCount(listPtr); /* Free unneeded obj. */ return TCL_ERROR; } |
︙ | ︙ | |||
4360 4361 4362 4363 4364 4365 4366 | static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 | static int NamespaceQualifiersCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; size_t length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } |
︙ | ︙ | |||
4615 4616 4617 4618 4619 4620 4621 | static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 | static int NamespaceTailCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *name, *p; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } /* |
︙ | ︙ | |||
4818 4819 4820 4821 4822 4823 4824 | * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( | | | 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 | * the namespace, it's structure will be freed. * *---------------------------------------------------------------------- */ static void FreeNsNameInternalRep( Tcl_Obj *objPtr) /* nsName object with internal representation * to free. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(objPtr, resNamePtr); assert(resNamePtr != NULL); |
︙ | ︙ | |||
4865 4866 4867 4868 4869 4870 4871 | * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 | * *---------------------------------------------------------------------- */ static void DupNsNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedNsName *resNamePtr; NsNameGetIntRep(srcPtr, resNamePtr); assert(resNamePtr != NULL); NsNameSetIntRep(copyPtr, resNamePtr); } |
︙ | ︙ | |||
4901 4902 4903 4904 4905 4906 4907 | */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ | | | | 4901 4902 4903 4904 4905 4906 4907 4908 4909 4910 4911 4912 4913 4914 4915 4916 4917 4918 4919 | */ static int SetNsNameFromAny( Tcl_Interp *interp, /* Points to the namespace in which to resolve * name. Also used for error reporting if not * NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { const char *dummy; Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr; ResolvedNsName *resNamePtr; const char *name; if (interp == NULL) { return TCL_ERROR; } name = TclGetString(objPtr); |
︙ | ︙ | |||
5028 5029 5030 5031 5032 5033 5034 | * the error. */ size_t length, /* Number of bytes in command (-1 means * use all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { | | | 5028 5029 5030 5031 5032 5033 5034 5035 5036 5037 5038 5039 5040 5041 5042 | * the error. */ size_t length, /* Number of bytes in command (-1 means * use all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution * context */ { const char *p; Interp *iPtr = (Interp *) interp; int overflow, limit = 150; Var *varPtr, *arrayPtr; if (iPtr->flags & ERR_ALREADY_LOGGED) { /* * Someone else has already logged error information for this command; |
︙ | ︙ |
Changes to generic/tclOO.c.
︙ | ︙ | |||
785 786 787 788 789 790 791 | */ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { | | | 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 | */ static void MyDeleted( ClientData clientData) /* Reference to the object whose [my] has been * squelched. */ { Object *oPtr = clientData; oPtr->myCommand = NULL; } static void MyClassDeleted( ClientData clientData) |
︙ | ︙ | |||
1648 1649 1650 1651 1652 1653 1654 | * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { | | | 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 | * unique name. */ int objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; Object *oPtr; ClientData clientData[4]; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { return NULL; } |
︙ | ︙ | |||
1718 1719 1720 1721 1722 1723 1724 | * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { | | | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 | * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ int skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ { Class *classPtr = (Class *) cls; CallContext *contextPtr; Tcl_InterpState state; Object *oPtr; oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr); if (oPtr == NULL) { return TCL_ERROR; |
︙ | ︙ | |||
2652 2653 2654 2655 2656 2657 2658 | /* * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { | | | 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 | /* * Give plugged in code a chance to remap the method name. */ methodNamePtr = objv[1]; if (oPtr->mapMethodNameProc != NULL) { Class **startClsPtr = &startCls; Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr); result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr, (Tcl_Class *) startClsPtr, mappedMethodName); if (result != TCL_OK) { TclDecrRefCount(mappedMethodName); if (result == TCL_BREAK) { |
︙ | ︙ | |||
2711 2712 2713 2714 2715 2716 2717 | * Check to see if we need to apply magical tricks to start part way * through the call chain. */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { | | | 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 | * Check to see if we need to apply magical tricks to start part way * through the call chain. */ if (startCls != NULL) { for (; contextPtr->index < contextPtr->callPtr->numChain; contextPtr->index++) { struct MInvoke *miPtr = &contextPtr->callPtr->chain[contextPtr->index]; if (miPtr->isFilter) { continue; } if (miPtr->mPtr->declaringClassPtr == startCls) { break; |
︙ | ︙ | |||
2849 2850 2851 2852 2853 2854 2855 | TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { | | | 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 | TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { CallContext *contextPtr = (CallContext *) context; if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless the * interpreter is being torn down, in which case we might be getting * here because of methods/destructors doing a [next] (or equivalent) * unexpectedly. |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
︙ | ︙ | |||
422 423 424 425 426 427 428 | * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); | | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 | * also used for error reporting. */ Tcl_ObjectContext context, /* The object/call context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* The actual arguments. */ { CallContext *contextPtr = (CallContext *) context; Tcl_Object object = Tcl_ObjectContextObject(context); const int skip = Tcl_ObjectContextSkippedArgs(context); CallFrame *framePtr, **framePtrPtr = &framePtr; Tcl_Obj *scriptPtr; CmdFrame *invoker; if (objc-1 < skip) { Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?"); return TCL_ERROR; |
︙ | ︙ | |||
1118 1119 1120 1121 1122 1123 1124 | case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { | | | 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 | case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr); Object *oPtr; const char *type; if (miPtr->filterDeclarer != NULL) { oPtr = miPtr->filterDeclarer->thisPtr; type = "class"; } else { |
︙ | ︙ |
Changes to generic/tclOOCall.c.
︙ | ︙ | |||
164 165 166 167 168 169 170 | * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { | | | 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | * ---------------------------------------------------------------------- */ void TclOODeleteContext( CallContext *contextPtr) { Object *oPtr = contextPtr->oPtr; TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { TclStackFree(oPtr->fPtr->interp, contextPtr); /* * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore |
︙ | ︙ | |||
310 311 312 313 314 315 316 | Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { | | | 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { CallContext *const contextPtr = clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; /* * If this is the first step along the chain, we preserve the method * entries in the chain so that they do not get deleted out from under our |
︙ | ︙ | |||
964 965 966 967 968 969 970 | int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { | | | 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 | int flags) /* Used to check if we're mixin-consistent * only. Mixin-consistent means that either * we're looking to add things from a mixin * and we have passed a mixin, or we're not * looking to add things from a mixin and have * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; int i; /* * Return if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to * the call chain. * |
︙ | ︙ | |||
1652 1653 1654 1655 1656 1657 1658 | } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodName); if (hPtr != NULL) { | | | 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 | } if (classPtr == contextCls) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodName); if (hPtr != NULL) { Method *mPtr = Tcl_GetHashValue(hPtr); if (IS_PRIVATE(mPtr)) { AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); return 1; } } |
︙ | ︙ | |||
1736 1737 1738 1739 1740 1741 1742 | Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { | | | 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 | Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); if (classPtr->flags & HAS_PRIVATE_METHODS) { privateDanger |= 1; } if (hPtr != NULL) { Method *mPtr = Tcl_GetHashValue(hPtr); if (!IS_PRIVATE(mPtr)) { if (!(flags & KNOWN_STATE)) { if (flags & PUBLIC_METHOD) { if (!IS_PUBLIC(mPtr)) { return privateDanger; } |
︙ | ︙ |
Changes to generic/tclOODefineCmds.c.
︙ | ︙ | |||
775 776 777 778 779 780 781 | FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { size_t length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); | | | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 | FindCommand( Tcl_Interp *interp, Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { size_t length; const char *nameStr, *string = TclGetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; Tcl_Command cmd, cmd2; /* * If someone is playing games, we stop playing right now. */ |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
︙ | ︙ | |||
145 146 147 148 149 150 151 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { | | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Object *oPtr = (Object *) object; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; |
︙ | ︙ | |||
217 218 219 220 221 222 223 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { | | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | const Tcl_MethodType *typePtr, /* The type of method this is, which defines * how to invoke, delete and clone the * method. */ void *clientData) /* Some data associated with the particular * method to be created. */ { Class *clsPtr = (Class *) cls; Method *mPtr; Tcl_HashEntry *hPtr; int isNew; if (nameObj == NULL) { mPtr = Tcl_Alloc(sizeof(Method)); mPtr->namePtr = NULL; mPtr->refCount = 1; |
︙ | ︙ | |||
340 341 342 343 344 345 346 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; | | | 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; ProcedureMethod *pmPtr; Tcl_Method method; if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = Tcl_Alloc(sizeof(ProcedureMethod)); memset(pmPtr, 0, sizeof(ProcedureMethod)); |
︙ | ︙ | |||
392 393 394 395 396 397 398 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | * NULL. */ ProcedureMethod **pmPtrPtr) /* Place to write pointer to procedure method * structure to allow for deeper tuning of the * structure's contents. NULL if caller is not * interested. */ { int argsLen; /* -1 => delete argsObj before exit */ ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; if (argsObj == NULL) { argsLen = -1; argsObj = Tcl_NewObj(); Tcl_IncrRefCount(argsObj); |
︙ | ︙ | |||
792 793 794 795 796 797 798 | * method. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; | | | 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | * method. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv, /* Array of arguments. */ PMFrameData *fdPtr) /* Place to store information about the call * frame. */ { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; /* * Compute basic information on the basis of the type of method it is. */ |
︙ | ︙ | |||
825 826 827 828 829 830 831 | /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { | | | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 | /* * Magic to enable things like [incr Tcl], which wants methods to run in * their class's namespace. */ if (pmPtr->flags & USE_DECLARER_NS) { Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) mPtr->declaringClassPtr->thisPtr->namespacePtr; } else { nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr; |
︙ | ︙ | |||
896 897 898 899 900 901 902 | fdPtr->efi.fields[0].proc = NULL; fdPtr->efi.fields[0].clientData = fdPtr->nameObj; if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { | | | 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 | fdPtr->efi.fields[0].proc = NULL; fdPtr->efi.fields[0].clientData = fdPtr->nameObj; if (pmPtr->gfivProc != NULL) { fdPtr->efi.fields[1].name = ""; fdPtr->efi.fields[1].proc = pmPtr->gfivProc; fdPtr->efi.fields[1].clientData = pmPtr; } else { Tcl_Method method = Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); if (Tcl_MethodDeclarerObject(method) != NULL) { fdPtr->efi.fields[1].name = "object"; } else { fdPtr->efi.fields[1].name = "class"; } |
︙ | ︙ | |||
1291 1292 1293 1294 1295 1296 1297 | Tcl_Free(pmPtr); } static void DeleteProcedureMethod( void *clientData) { | | | 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 | Tcl_Free(pmPtr); } static void DeleteProcedureMethod( void *clientData) { ProcedureMethod *pmPtr = clientData; if (pmPtr->refCount-- <= 1) { DeleteProcedureMethodRecord(pmPtr); } } static int |
︙ | ︙ | |||
1384 1385 1386 1387 1388 1389 1390 | Object *oPtr, /* The object to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; | | | 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 | Object *oPtr, /* The object to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); |
︙ | ︙ | |||
1423 1424 1425 1426 1427 1428 1429 | Class *clsPtr, /* The class to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; | | | 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 | Class *clsPtr, /* The class to attach the method to. */ int flags, /* Whether the method is public or not. */ Tcl_Obj *nameObj, /* The name of the method. */ Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { int prefixLen; ForwardMethod *fmPtr; if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "method forward prefix must be non-empty", -1)); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
833 834 835 836 837 838 839 | int Tcl_AppendAllObjTypes( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { | | | 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 | int Tcl_AppendAllObjTypes( Tcl_Interp *interp, /* Interpreter used for error reporting. */ Tcl_Obj *objPtr) /* Points to the Tcl object onto which the * name of each registered type is appended as * a list element. */ { Tcl_HashEntry *hPtr; Tcl_HashSearch search; int numElems; /* * Get the test for a valid list out of the way first. */ |
︙ | ︙ | |||
881 882 883 884 885 886 887 | *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { | | | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 | *---------------------------------------------------------------------- */ const Tcl_ObjType * Tcl_GetObjType( const char *typeName) /* Name of Tcl object type to look up. */ { Tcl_HashEntry *hPtr; const Tcl_ObjType *typePtr = NULL; Tcl_MutexLock(&tableMutex); hPtr = Tcl_FindHashEntry(&typeTable, typeName); if (hPtr != NULL) { typePtr = Tcl_GetHashValue(hPtr); } |
︙ | ︙ | |||
1011 1012 1013 1014 1015 1016 1017 | * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( | | | | | 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | * None. *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclDbInitNewObj( Tcl_Obj *objPtr, const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { objPtr->refCount = 0; objPtr->typePtr = NULL; TclInitStringRep(objPtr, NULL, 0); #if TCL_THREADS |
︙ | ︙ | |||
1098 1099 1100 1101 1102 1103 1104 | } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { | | | 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 | } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewObj(void) { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclNewObj(objPtr); return objPtr; |
︙ | ︙ | |||
1140 1141 1142 1143 1144 1145 1146 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( | | | | | 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewObj( const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; /* * Use the macro defined in tclInt.h - it will use the correct allocator. */ TclDbNewObj(objPtr, file, line); return objPtr; |
︙ | ︙ | |||
1195 1196 1197 1198 1199 1200 1201 | #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; | | | | 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 | #define OBJS_TO_ALLOC_EACH_TIME 100 void TclAllocateFreeObjects(void) { size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); char *basePtr; Tcl_Obj *prevPtr, *objPtr; int i; /* * This has been noted by Purify to be a potential leak. The problem is * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory, * but leaves it to Tcl's memory subsystem finalization to release it. |
︙ | ︙ | |||
1247 1248 1249 1250 1251 1252 1253 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( | | | | 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 | * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { const Tcl_ObjType *typePtr = objPtr->typePtr; /* * This macro declares a variable, so must come here... */ ObjInitDeletionContext(context); |
︙ | ︙ | |||
1372 1373 1374 1375 1376 1377 1378 | } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( | | | 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 | } } } #else /* TCL_MEM_DEBUG */ void TclFreeObj( Tcl_Obj *objPtr) /* The object to be freed. */ { /* * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) * with 'length == -1'. */ |
︙ | ︙ | |||
1581 1582 1583 1584 1585 1586 1587 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( | | | 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetString( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be returned. */ { 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 |
︙ | ︙ | |||
1637 1638 1639 1640 1641 1642 1643 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( | | | | 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 | * representation from the internal representation. * *---------------------------------------------------------------------- */ char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ 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 (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 |
︙ | ︙ | |||
1775 1776 1777 1778 1779 1780 1781 | * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( | | | 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 | * the string representation NULL to mark it invalid. * *---------------------------------------------------------------------- */ void Tcl_InvalidateStringRep( Tcl_Obj *objPtr) /* Object whose string rep byte pointer should * be freed. */ { TclInvalidateStringRep(objPtr); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1914 1915 1916 1917 1918 1919 1920 | * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 | * *---------------------------------------------------------------------- */ int Tcl_GetBooleanFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get boolean. */ int *boolPtr) /* Place to store resulting boolean. */ { do { if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) { *boolPtr = (objPtr->internalRep.wideValue != 0); return TCL_OK; } if (objPtr->typePtr == &tclDoubleType) { |
︙ | ︙ | |||
1971 1972 1973 1974 1975 1976 1977 | * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 | * *---------------------------------------------------------------------- */ int TclSetBooleanFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { /* * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine * whether a boolean conversion is possible without generating the string * rep. */ |
︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 | Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( | | | 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 | Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } return TCL_ERROR; } static int ParseBoolean( Tcl_Obj *objPtr) /* The object to parse/convert. */ { int newBool; char lowerCase[6]; size_t i, length; const char *str = TclGetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { |
︙ | ︙ | |||
2159 2160 2161 2162 2163 2164 2165 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( | | | | | 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewDoubleObj Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { return Tcl_DbNewDoubleObj(dblValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewDoubleObj( double dblValue) /* Double used to initialize the object. */ { Tcl_Obj *objPtr; TclNewDoubleObj(objPtr, dblValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* |
︙ | ︙ | |||
2207 2208 2209 2210 2211 2212 2213 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( | | | | | 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; objPtr->typePtr = &tclDoubleType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewDoubleObj( double dblValue, /* Double used to initialize the object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewDoubleObj(dblValue); } |
︙ | ︙ | |||
2258 2259 2260 2261 2262 2263 2264 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( | | | | 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetDoubleObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ double dblValue) /* Double used to set the object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj"); } TclSetDoubleObj(objPtr, dblValue); } |
︙ | ︙ | |||
2291 2292 2293 2294 2295 2296 2297 | * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 | * *---------------------------------------------------------------------- */ int Tcl_GetDoubleFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a double. */ double *dblPtr) /* Place to store resulting double. */ { do { if (objPtr->typePtr == &tclDoubleType) { if (TclIsNaN(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "floating point value is Not a Number", -1)); |
︙ | ︙ | |||
2346 2347 2348 2349 2350 2351 2352 | * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 | * *---------------------------------------------------------------------- */ static int SetDoubleFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1, NULL, 0); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 | * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( | | | 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 | * double-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfDouble( Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE); TclOOM(dst, TCL_DOUBLE_SPACE + 1); Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); |
︙ | ︙ | |||
2416 2417 2418 2419 2420 2421 2422 | * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 | * *---------------------------------------------------------------------- */ int Tcl_GetIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a int. */ int *intPtr) /* Place to store resulting int. */ { #if (LONG_MAX == INT_MAX) return TclGetLongFromObj(interp, objPtr, (long *) intPtr); #else long l; if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) { |
︙ | ︙ | |||
2487 2488 2489 2490 2491 2492 2493 | * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( | | | 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 | * int-to-string conversion. * *---------------------------------------------------------------------- */ static void UpdateStringOfInt( Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); TclOOM(dst, TCL_INTEGER_SPACE + 1); (void) Tcl_InitStringRep(objPtr, NULL, TclFormatInt(dst, objPtr->internalRep.wideValue)); } |
︙ | ︙ | |||
2532 2533 2534 2535 2536 2537 2538 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( | | | | | 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 | #ifndef TCL_NO_DEPRECATED #undef Tcl_NewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { return Tcl_DbNewWideIntObj(longValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewLongObj( long longValue) /* Long integer used to initialize the * new object. */ { Tcl_Obj *objPtr; TclNewIntObj(objPtr, longValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ #endif /* TCL_NO_DEPRECATED */ |
︙ | ︙ | |||
2591 2592 2593 2594 2595 2596 2597 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( | | | | | 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 | #ifndef TCL_NO_DEPRECATED #undef Tcl_DbNewLongObj #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); /* Optimized TclInvalidateStringRep */ objPtr->bytes = NULL; objPtr->internalRep.wideValue = longValue; objPtr->typePtr = &tclIntType; return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewLongObj( long longValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { return Tcl_NewWideIntObj(longValue); |
︙ | ︙ | |||
2649 2650 2651 2652 2653 2654 2655 | * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 | * *---------------------------------------------------------------------- */ int Tcl_GetLongFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* The object from which to get a long. */ long *longPtr) /* Place to store resulting long. */ { do { #ifdef TCL_WIDE_INT_IS_LONG if (objPtr->typePtr == &tclIntType) { *longPtr = objPtr->internalRep.wideValue; return TCL_OK; } |
︙ | ︙ | |||
2763 2764 2765 2766 2767 2768 2769 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( | | | | | 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 | */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewWideIntObj Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { return Tcl_DbNewWideIntObj(wideValue, "unknown", 0); } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_NewWideIntObj( Tcl_WideInt wideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewObj(objPtr); TclSetIntObj(objPtr, wideValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ |
︙ | ︙ | |||
2822 2823 2824 2825 2826 2827 2828 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( | | | | | 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 | *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Wide integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); TclSetIntObj(objPtr, wideValue); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewWideIntObj( Tcl_WideInt wideValue, /* Long integer used to initialize the new * object. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { |
︙ | ︙ | |||
2873 2874 2875 2876 2877 2878 2879 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( | | | | 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 | * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideIntObj( Tcl_Obj *objPtr, /* Object w. internal rep to init. */ Tcl_WideInt wideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } |
︙ | ︙ | |||
2909 2910 2911 2912 2913 2914 2915 | * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 | * *---------------------------------------------------------------------- */ int Tcl_GetWideIntFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object from which to get a wide int. */ Tcl_WideInt *wideIntPtr) /* Place to store resulting long. */ { do { if (objPtr->typePtr == &tclIntType) { *wideIntPtr = objPtr->internalRep.wideValue; return TCL_OK; } |
︙ | ︙ | |||
3601 3602 3603 3604 3605 3606 3607 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( | | | 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbIncrRefCount( Tcl_Obj *objPtr, /* The object we are registering a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG |
︙ | ︙ | |||
3664 3665 3666 3667 3668 3669 3670 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( | | | 3664 3665 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 | * The object's ref count is incremented. * *---------------------------------------------------------------------- */ void Tcl_DbDecrRefCount( Tcl_Obj *objPtr, /* The object we are releasing a reference * to. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 | * None. * *---------------------------------------------------------------------- */ int Tcl_DbIsShared( Tcl_Obj *objPtr, /* The object to test for being shared. */ const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { #ifdef TCL_MEM_DEBUG if (objPtr->refCount == 0x61616161) { |
︙ | ︙ | |||
3802 3803 3804 3805 3806 3807 3808 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( | | | 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 | * Tcl_CreateHashEntry. * *---------------------------------------------------------------------- */ void Tcl_InitObjHashTable( Tcl_HashTable *tablePtr) /* Pointer to table record, which is supplied * by the caller. */ { Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS, &tclObjHashKeyType); } |
︙ | ︙ | |||
3865 3866 3867 3868 3869 3870 3871 | int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; | | | | 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 | int TclCompareObjKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr; Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue; const char *p1, *p2; size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller if (objPtr1 == objPtr2) return 1; */ |
︙ | ︙ | |||
4023 4024 4025 4026 4027 4028 4029 | *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ | | | | 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 4035 4036 4037 4038 4039 4040 4041 4042 4043 | *---------------------------------------------------------------------- */ Tcl_Command Tcl_GetCommandFromObj( Tcl_Interp *interp, /* The interpreter in which to resolve the * command and to report errors. */ Tcl_Obj *objPtr) /* The object containing the command's name. * If the name starts with "::", will be * looked up in global namespace. Else, looked * up first in the current namespace, then in * global namespace. */ { ResolvedCmdName *resPtr; /* * Get the internal representation, converting to a command type if * needed. The internal representation is a ResolvedCmdName that points to * the actual command. * * Check the context namespace and the namespace epoch of the resolved |
︙ | ︙ | |||
4052 4053 4054 4055 4056 4057 4058 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { | | | | 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 | * * If any check fails, then force another conversion to the command type, * to discard the old rep and create a new one. */ resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (objPtr->typePtr == &tclCmdNameType) { Command *cmdPtr = resPtr->cmdPtr; if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch) && (interp == cmdPtr->nsPtr->interp) && !(cmdPtr->nsPtr->flags & NS_DYING)) { Namespace *refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { return (Tcl_Command) cmdPtr; |
︙ | ︙ | |||
4159 4160 4161 4162 4163 4164 4165 | } } void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ | | | | 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 | } } void TclSetCmdNameObj( Tcl_Interp *interp, /* Points to interpreter containing command * that should be cached in objPtr. */ Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a * CmdName object. */ Command *cmdPtr) /* Points to Command structure that the * CmdName object should refer to. */ { ResolvedCmdName *resPtr; if (objPtr->typePtr == &tclCmdNameType) { resPtr = objPtr->internalRep.twoPtrValue.ptr1; if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } |
︙ | ︙ | |||
4199 4200 4201 4202 4203 4204 4205 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( | | | | 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 | * ResolvedSymbol, which may free the Command structure. * *---------------------------------------------------------------------- */ static void FreeCmdNameInternalRep( Tcl_Obj *objPtr) /* CmdName object with internal * representation to free. */ { ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1; /* * Decrement the reference count of the ResolvedCmdName structure. If * there are no more uses, free the ResolvedCmdName structure. */ if (resPtr->refCount-- <= 1) { |
︙ | ︙ | |||
4247 4248 4249 4250 4251 4252 4253 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ | | | | 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 | * *---------------------------------------------------------------------- */ static void DupCmdNameInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1; copyPtr->internalRep.twoPtrValue.ptr1 = resPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; resPtr->refCount++; copyPtr->typePtr = &tclCmdNameType; } |
︙ | ︙ | |||
4281 4282 4283 4284 4285 4286 4287 | * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ | | | | | 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 | * *---------------------------------------------------------------------- */ static int SetCmdNameFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { const char *name; Command *cmdPtr; ResolvedCmdName *resPtr; if (interp == NULL) { return TCL_ERROR; } /* * Find the Command structure, if any, that describes the command called |
︙ | ︙ |
Changes to generic/tclParse.c.
︙ | ︙ | |||
1102 1103 1104 1105 1106 1107 1108 | const char *src, /* First character to parse. */ size_t numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { | | | | 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 | const char *src, /* First character to parse. */ size_t numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type * of character that ends run of whitespace */ { char type = TYPE_NORMAL; const char *p = src; while (1) { while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { numBytes--; p++; } if (numBytes && (type & TYPE_SUBS)) { |
︙ | ︙ | |||
1205 1206 1207 1208 1209 1210 1211 | const char *src, /* First character to parse. */ size_t numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; | | | 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 | const char *src, /* First character to parse. */ size_t numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ { int result = 0; const char *p = src; while (numBytes--) { unsigned char digit = UCHAR(*p); if (!isxdigit(digit) || (result > 0x10fff)) { break; } |
︙ | ︙ | |||
1262 1263 1264 1265 1266 1267 1268 | size_t numBytes, /* Max number of bytes to scan. */ size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most 4 bytes will be written there. */ { | | | 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 | size_t numBytes, /* Max number of bytes to scan. */ size_t *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be * written. At most 4 bytes will be written there. */ { const char *p = src+1; Tcl_UniChar unichar = 0; int result; size_t count; char buf[4] = ""; if (numBytes == 0) { if (readPtr != NULL) { |
︙ | ︙ | |||
1447 1448 1449 1450 1451 1452 1453 | ParseComment( const char *src, /* First character to parse. */ size_t numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { | | | 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 | ParseComment( const char *src, /* First character to parse. */ size_t numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ { const char *p = src; int incomplete = parsePtr->incomplete; while (numBytes) { size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; |
︙ | ︙ | |||
1514 1515 1516 1517 1518 1519 1520 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( | | | 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 | * None. * *---------------------------------------------------------------------- */ static int ParseTokens( const char *src, /* First character to parse. */ size_t numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in * mask. */ int flags, /* OR-ed bits indicating what substitutions to * perform: TCL_SUBST_COMMANDS, |
︙ | ︙ | |||
1874 1875 1876 1877 1878 1879 1880 | Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int flags) /* Bit flags to control details of the parsing. * Only the PARSE_APPEND flag has an effect * here. Other flags are passed along. */ { Tcl_Token *tokenPtr; | | | 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 | Tcl_Parse *parsePtr, /* Structure to fill in with information about * the variable name. */ int flags) /* Bit flags to control details of the parsing. * Only the PARSE_APPEND flag has an effect * here. Other flags are passed along. */ { Tcl_Token *tokenPtr; const char *src; int varIndex; unsigned array; int append = (flags & PARSE_APPEND); if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } |
︙ | ︙ | |||
2061 2062 2063 2064 2065 2066 2067 | * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ | | | | 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 | * *---------------------------------------------------------------------- */ const char * Tcl_ParseVar( Tcl_Interp *interp, /* Context for looking up variable. */ const char *start, /* Start of variable substitution. First * character must be "$". */ const char **termPtr) /* If non-NULL, points to word to fill in with * character just after last one in the * variable specifier. */ { Tcl_Obj *objPtr; int code; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); if (TCL_OK != TclParseVarName(interp, start, -1, parsePtr, PARSE_USE_INTERNAL_TOKENS)) { Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); |
︙ | ︙ | |||
2173 2174 2175 2176 2177 2178 2179 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ | | | | 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int flags, /* Bit flags to control details of the parsing. * Only the PARSE_APPEND flag has an effect * here. Other flags are passed along. */ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after * the terminating '}' if the parse was * successful. */ { Tcl_Token *tokenPtr; const char *src; int startIndex, level; size_t length; int append = (flags & PARSE_APPEND); if ((numBytes == 0) || (start == NULL)) { return TCL_ERROR; } |
︙ | ︙ | |||
2313 2314 2315 2316 2317 2318 2319 | * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace * preceded by a '<whitespace>#' on the same line. */ { | | | 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 | * Guess if the problem is due to comments by searching the source string * for a possible open brace within the context of a comment. Since we * aren't performing a full Tcl parse, just look for an open brace * preceded by a '<whitespace>#' on the same line. */ { int openBrace = 0; while (--src > start) { switch (*src) { case '{': openBrace = 1; break; case '\n': |
︙ | ︙ | |||
2396 2397 2398 2399 2400 2401 2402 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ | | | 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 | Tcl_Interp *interp, /* Interpreter to use for error reporting; if * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ size_t numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about * the string. */ int flags, /* Bit flags to control details of the parsing. * Only the PARSE_APPEND flag has an effect * here. Other flags are passed along. */ const char **termPtr) /* If non-NULL, points to word in which to * store a pointer to the character just after |
︙ | ︙ |
Changes to generic/tclPathObj.c.
︙ | ︙ | |||
2499 2500 2501 2502 2503 2504 2505 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( | | | 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 | * Memory may be allocated. * *--------------------------------------------------------------------------- */ static void UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); size_t cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { Tcl_Panic("Called UpdateStringOfFsPath with invalid object"); |
︙ | ︙ |
Changes to generic/tclPipe.c.
︙ | ︙ | |||
179 180 181 182 183 184 185 | void Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { | | | 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | void Tcl_DetachPids( int numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { Detached *detPtr; int i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { detPtr = Tcl_Alloc(sizeof(Detached)); detPtr->pid = pidPtr[i]; detPtr->nextPtr = detList; |
︙ | ︙ | |||
215 216 217 218 219 220 221 | * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs(void) { | | | 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | * *---------------------------------------------------------------------- */ void Tcl_ReapDetachedProcs(void) { Detached *detPtr; Detached *nextPtr, *prevPtr; int status, code; Tcl_MutexLock(&pipeMutex); for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) { status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL); if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR |
︙ | ︙ |
Changes to generic/tclResult.c.
︙ | ︙ | |||
226 227 228 229 230 231 232 | *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ | | | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | *---------------------------------------------------------------------- */ void Tcl_SetObjResult( Tcl_Interp *interp, /* Interpreter with which to associate the * return object value. */ Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj * result is made an empty string object. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldObjResult = iPtr->objResultPtr; iPtr->objResultPtr = objPtr; Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ /* * We wait until the end to release the old object result, in case we are * setting the result to itself. |
︙ | ︙ | |||
268 269 270 271 272 273 274 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { | | | 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { Interp *iPtr = (Interp *) interp; return iPtr->objResultPtr; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
389 390 391 392 393 394 395 | * remain the same). * *---------------------------------------------------------------------- */ void Tcl_FreeResult( | | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 | * remain the same). * *---------------------------------------------------------------------- */ void Tcl_FreeResult( Tcl_Interp *interp)/* Interpreter for which to free result. */ { Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
417 418 419 420 421 422 423 | * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( | | | | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 | * It also clears any error information for the interpreter. * *---------------------------------------------------------------------- */ void Tcl_ResetResult( Tcl_Interp *interp)/* Interpreter for which to clear result. */ { Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL, iPtr->errorCode, TCL_GLOBAL_ONLY); |
︙ | ︙ | |||
470 471 472 473 474 475 476 | * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( | | | | 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | * the interpreter. * *---------------------------------------------------------------------- */ static void ResetObjResult( Interp *iPtr) /* Points to the interpreter whose result * object should be reset. */ { Tcl_Obj *objResultPtr = iPtr->objResultPtr; if (Tcl_IsShared(objResultPtr)) { TclDecrRefCount(objResultPtr); TclNewObj(objResultPtr); Tcl_IncrRefCount(objResultPtr); iPtr->objResultPtr = objResultPtr; } else { |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
5219 5220 5221 5222 5223 5224 5225 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5219 5220 5221 5222 5223 5224 5225 5226 5227 5228 5229 5230 5231 5232 5233 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsetCmd( void *data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 2) { |
︙ | ︙ | |||
5251 5252 5253 5254 5255 5256 5257 | argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ | | | 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 | argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } static int Testset2Cmd( void *data, /* Additional flags for Get/SetVar2. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); const char *value; if (argc == 3) { |
︙ | ︙ | |||
5302 5303 5304 5305 5306 5307 5308 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsaveresultCmd( void *dummy, /* Not used. */ | | | 5302 5303 5304 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 | *---------------------------------------------------------------------- */ /* ARGSUSED */ static int TestsaveresultCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; static const char *const optionStrings[] = { |
︙ | ︙ | |||
5429 5430 5431 5432 5433 5434 5435 | * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( void *dummy, /* Not used. */ | | | 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 5441 5442 5443 | * *---------------------------------------------------------------------- */ static int TestmainthreadCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); Tcl_SetObjResult(interp, idObj); |
︙ | ︙ | |||
5490 5491 5492 5493 5494 5495 5496 | * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( void *dummy, /* Not used. */ | | | 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 | * *---------------------------------------------------------------------- */ static int TestsetmainloopCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 0; Tcl_SetMainLoop(MainLoop); return TCL_OK; } |
︙ | ︙ | |||
5519 5520 5521 5522 5523 5524 5525 | * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( void *dummy, /* Not used. */ | | | 5519 5520 5521 5522 5523 5524 5525 5526 5527 5528 5529 5530 5531 5532 5533 | * *---------------------------------------------------------------------- */ static int TestexitmainloopCmd( void *dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; } |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
49 50 51 52 53 54 55 | int objc, Tcl_Obj *const objv[]); #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | int objc, Tcl_Obj *const objv[]); #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); } Tcl_DeleteAssocData(interp, VARPTR_KEY); Tcl_Free(varPtr); } |
︙ | ︙ | |||
87 88 89 90 91 92 93 | *---------------------------------------------------------------------- */ int TclObjTest_Init( Tcl_Interp *interp) { | | | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | *---------------------------------------------------------------------- */ int TclObjTest_Init( Tcl_Interp *interp) { int i; /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; |
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | 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", | | | | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 | 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", "appendself", "appendself2", NULL }; if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
1340 1341 1342 1343 1344 1345 1346 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; | | < < < < < < | 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 | strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { length = -1; } Tcl_SetIntObj(Tcl_GetObjResult(interp), length); break; case 10: /* appendself */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } |
︙ | ︙ | |||
1377 1378 1379 1380 1381 1382 1383 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; | | | 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 | "index value out of range", -1)); return TCL_ERROR; } Tcl_AppendToObj(varPtr[varIndex], string + i, length - i); Tcl_SetObjResult(interp, varPtr[varIndex]); break; case 11: /* appendself2 */ if (objc != 4) { goto wrongNumArgs; } if (varPtr[varIndex] == NULL) { SetVarToObj(varPtr, varIndex, Tcl_NewObj()); } |
︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
︙ | ︙ | |||
244 245 246 247 248 249 250 | void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; Cache **nextPtrPtr; | | | 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 | void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; Cache **nextPtrPtr; unsigned int bucket; /* * Flush blocks. */ for (bucket = 0; bucket < NBUCKETS; ++bucket) { if (cachePtr->buckets[bucket].numFree > 0) { |
︙ | ︙ | |||
301 302 303 304 305 306 307 | void * TclpAlloc( size_t reqSize) { Cache *cachePtr; Block *blockPtr; | | | 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | void * TclpAlloc( size_t reqSize) { Cache *cachePtr; Block *blockPtr; int bucket; size_t size; GETCACHE(cachePtr); /* * Increment the requested size to include room for the Block structure. * Call TclpSysAlloc() directly if the required amount is greater than the |
︙ | ︙ | |||
507 508 509 510 511 512 513 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { | | | | | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclThreadAllocObj(void) { Cache *cachePtr; Tcl_Obj *objPtr; GETCACHE(cachePtr); /* * Get this thread's obj list structure and move or allocate new objs if * necessary. */ if (cachePtr->numObjects == 0) { int numMove; Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { if (numMove > NOBJALLOC) { numMove = NOBJALLOC; } |
︙ | ︙ | |||
679 680 681 682 683 684 685 | static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { | | | 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 | static void MoveObjs( Cache *fromPtr, Cache *toPtr, int numMove) { Tcl_Obj *objPtr = fromPtr->firstObjPtr; Tcl_Obj *fromFirstObjPtr = objPtr; toPtr->numObjects += numMove; fromPtr->numObjects -= numMove; /* * Find the last object to be moved; set the next one (the first one not |
︙ | ︙ | |||
780 781 782 783 784 785 786 | static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { | | | | 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 | static char * Block2Ptr( Block *blockPtr, int bucket, unsigned int reqSize) { void *ptr; blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC; blockPtr->sourceBucket = bucket; blockPtr->blockReqSize = reqSize; ptr = ((void *) (blockPtr + 1)); #if RCHECK ((unsigned char *)(ptr))[reqSize] = MAGIC; #endif return (char *) ptr; } static Block * Ptr2Block( char *ptr) { Block *blockPtr; blockPtr = (((Block *) ptr) - 1); if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) { Tcl_Panic("alloc: invalid block: %p: %x %x", blockPtr, blockPtr->magicNum1, blockPtr->magicNum2); } #if RCHECK |
︙ | ︙ | |||
930 931 932 933 934 935 936 | */ static int GetBlocks( Cache *cachePtr, int bucket) { | | | | 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 | */ static int GetBlocks( Cache *cachePtr, int bucket) { Block *blockPtr; size_t n; /* * First, atttempt to move blocks from the shared cache. Note the * potentially dirty read of numFree before acquiring the lock which is a * slight performance enhancement. The value is verified after the lock is * actually acquired. */ |
︙ | ︙ | |||
976 977 978 979 980 981 982 | blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { | | | 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 | blockPtr->nextBlock = NULL; } } UnlockBucket(cachePtr, bucket); } if (cachePtr->buckets[bucket].numFree == 0) { size_t size; /* * If no blocks could be moved from shared, first look for a larger * block in this cache to split up. */ blockPtr = NULL; |
︙ | ︙ |
Changes to generic/tclTimer.c.
︙ | ︙ | |||
213 214 215 216 217 218 219 | TimerExitProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { | | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 | TimerExitProc( ClientData clientData) /* Not used. */ { ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey); Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL); if (tsdPtr != NULL) { TimerHandler *timerHandlerPtr; timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; while (timerHandlerPtr != NULL) { tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr; Tcl_Free(timerHandlerPtr); timerHandlerPtr = tsdPtr->firstTimerHandlerPtr; } |
︙ | ︙ | |||
290 291 292 293 294 295 296 | Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { | | | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 | Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, ClientData clientData) { TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); timerHandlerPtr = Tcl_Alloc(sizeof(TimerHandler)); /* * Fill in fields for the event. */ |
︙ | ︙ | |||
351 352 353 354 355 356 357 | */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { | | | 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | */ void Tcl_DeleteTimerHandler( Tcl_TimerToken token) /* Result previously returned by * Tcl_DeleteTimerHandler. */ { TimerHandler *timerHandlerPtr, *prevPtr; ThreadSpecificData *tsdPtr = InitTimer(); if (token == NULL) { return; } for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; |
︙ | ︙ | |||
617 618 619 620 621 622 623 | */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { | | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | */ void Tcl_DoWhenIdle( Tcl_IdleProc *proc, /* Function to invoke. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr; Tcl_Time blockTime; ThreadSpecificData *tsdPtr = InitTimer(); idlePtr = Tcl_Alloc(sizeof(IdleHandler)); idlePtr->proc = proc; idlePtr->clientData = clientData; idlePtr->generation = tsdPtr->idleGeneration; |
︙ | ︙ | |||
661 662 663 664 665 666 667 | */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { | | | 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 | */ void Tcl_CancelIdleCall( Tcl_IdleProc *proc, /* Function that was previously registered. */ ClientData clientData) /* Arbitrary value to pass to proc. */ { IdleHandler *idlePtr, *prevPtr; IdleHandler *nextPtr; ThreadSpecificData *tsdPtr = InitTimer(); for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL; prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) { while ((idlePtr->proc == proc) && (idlePtr->clientData == clientData)) { |
︙ | ︙ |
Changes to generic/tclTrace.c.
︙ | ︙ | |||
132 133 134 135 136 137 138 | static int StringTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, | | | 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 | static int StringTraceProc(ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, Tcl_Obj *const objv[]); static void StringTraceDeleteProc(ClientData clientData); static void DisposeTraceResult(int flags, char *result); static int TraceVarEx(Tcl_Interp *interp, const char *part1, const char *part2, VarTrace *tracePtr); /* * The following structure holds the client data for string-based * trace procs */ typedef struct { |
︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 | Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; | | | 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 | Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData prevClientData) /* If non-NULL, gives last value returned by * this function, so this call will return the * next trace after that one. If NULL, this * call will return the first trace. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return NULL; } |
︙ | ︙ | |||
1111 1112 1113 1114 1115 1116 1117 | * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; | | | 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 | * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function to call when specified ops are * invoked upon cmdName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { Command *cmdPtr; CommandTrace *tracePtr; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, TCL_LEAVE_ERR_MSG); if (cmdPtr == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1174 1175 1176 1177 1178 1179 1180 | const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 | const char *cmdName, /* Name of command. */ int flags, /* OR-ed collection of bits, including any of * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any * of the TRACE_*_EXEC flags */ Tcl_CommandTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { CommandTrace *tracePtr; CommandTrace *prevPtr; Command *cmdPtr; Interp *iPtr = (Interp *) interp; ActiveCommandTrace *activePtr; int hasExecTraces = 0; cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL, |
︙ | ︙ | |||
1669 1670 1671 1672 1673 1674 1675 | * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ | | | | 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 | * *---------------------------------------------------------------------- */ static int CallTraceFunction( Tcl_Interp *interp, /* The current interpreter. */ Trace *tracePtr, /* Describes the trace function to call. */ Command *cmdPtr, /* Points to command's Command struct. */ const char *command, /* Points to the first character of the * command's source before substitutions. */ size_t numChars, /* The number of characters in the command's * source. */ int objc, /* Number of arguments for the command. */ Tcl_Obj *const objv[]) /* Pointers to Tcl_Obj of each argument. */ { Interp *iPtr = (Interp *) interp; char *commandCopy; int traceCode; /* |
︙ | ︙ | |||
2062 2063 2064 2065 2066 2067 2068 | Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { | | | 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 | Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } Tcl_DStringFree(&cmd); } } if (destroy && result != NULL) { Tcl_Obj *errMsgObj = (Tcl_Obj *) result; Tcl_DecrRefCount(errMsgObj); result = NULL; } return result; } |
︙ | ︙ | |||
2139 2140 2141 2142 2143 2144 2145 | int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { | | | | 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 | int level, /* Maximum nesting level */ int flags, /* Flags, see above */ Tcl_CmdObjTraceProc *proc, /* Trace callback */ ClientData clientData, /* Client data for the callback */ Tcl_CmdObjTraceDeleteProc *delProc) /* Function to call when trace is deleted */ { Trace *tracePtr; Interp *iPtr = (Interp *) interp; /* * Test if this trace allows inline compilation of commands. */ if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) { if (iPtr->tracesForbiddingInline == 0) { |
︙ | ︙ | |||
2339 2340 2341 2342 2343 2344 2345 | Tcl_DeleteTrace( Tcl_Interp *interp, /* Interpreter that contains trace. */ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; | | | 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 | Tcl_DeleteTrace( Tcl_Interp *interp, /* Interpreter that contains trace. */ Tcl_Trace trace) /* Token for trace (returned previously by * Tcl_CreateTrace). */ { Interp *iPtr = (Interp *) interp; Trace *prevPtr, *tracePtr = (Trace *) trace; Trace **tracePtr2 = &iPtr->tracePtr; ActiveInterpTrace *activePtr; /* * Locate the trace entry in the interpreter's trace list, and remove it * from the list. */ |
︙ | ︙ | |||
2531 2532 2533 2534 2535 2536 2537 | * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 | * *---------------------------------------------------------------------- */ int TclObjCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe |
︙ | ︙ | |||
2565 2566 2567 2568 2569 2570 2571 | return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ | | | | 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 | return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg); } int TclCallVarTraces( Interp *iPtr, /* Interpreter containing variable. */ Var *arrayPtr, /* Pointer to array variable that contains the * variable, or NULL if the variable isn't an * element of an array. */ Var *varPtr, /* Variable whose traces are to be invoked. */ const char *part1, const char *part2, /* Variable's two-part name. */ int flags, /* Flags passed to trace functions: indicates * what's happening to variable, plus maybe * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */ int leaveErrMsg) /* If true, and one of the traces indicates an * error, then leave an error message and * stack trace information in *iPTr. */ { VarTrace *tracePtr; ActiveVarTrace active; char *result; const char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; int disposeFlags = 0; |
︙ | ︙ | |||
2873 2874 2875 2876 2877 2878 2879 | int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 | int flags, /* OR-ed collection of bits describing current * trace, including any of TCL_TRACE_READS, * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function assocated with trace. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; VarTrace *prevPtr, *nextPtr; Var *varPtr, *arrayPtr; Interp *iPtr = (Interp *) interp; ActiveVarTrace *activePtr; int flagMask, allFlags = 0; Tcl_HashEntry *hPtr; |
︙ | ︙ | |||
3022 3023 3024 3025 3026 3027 3028 | /* * Find the relevant trace, if any, and return its clientData. */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { | | | 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 | /* * Find the relevant trace, if any, and return its clientData. */ hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr); if (hPtr) { VarTrace *tracePtr = Tcl_GetHashValue(hPtr); if (prevClientData != NULL) { for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) { if ((tracePtr->clientData == prevClientData) && (tracePtr->traceProc == proc)) { tracePtr = tracePtr->nextPtr; break; |
︙ | ︙ | |||
3079 3080 3081 3082 3083 3084 3085 | * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { | | | 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 | * TCL_TRACE_READS, TCL_TRACE_WRITES, * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and * TCL_NAMESPACE_ONLY. */ Tcl_VarTraceProc *proc, /* Function to call when specified ops are * invoked upon varName. */ ClientData clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; int result; tracePtr = Tcl_Alloc(sizeof(VarTrace)); tracePtr->traceProc = proc; tracePtr->clientData = clientData; tracePtr->flags = flags; |
︙ | ︙ | |||
3124 3125 3126 3127 3128 3129 3130 | TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ | | | 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 | TraceVarEx( Tcl_Interp *interp, /* Interpreter in which variable is to be * traced. */ const char *part1, /* Name of scalar variable or array. */ const char *part2, /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ VarTrace *tracePtr)/* Structure containing flags, traceProc and * clientData fields. Others should be left * blank. Will be Tcl_Free()d (eventually) if * this function returns TCL_OK, and up to * caller to free if this function returns * TCL_ERROR. */ { Interp *iPtr = (Interp *) interp; |
︙ | ︙ |
Changes to generic/tclUtf.c.
︙ | ︙ | |||
350 351 352 353 354 355 356 | 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; int Tcl_UtfToUniChar( | | | | 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 | 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F, 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014, 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; int Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by * the UTF-8 string. */ { Tcl_UniChar byte; /* * Unroll 1 to 4 byte UTF-8 sequences. */ |
︙ | ︙ | |||
729 730 731 732 733 734 735 | * None. * *--------------------------------------------------------------------------- */ size_t Tcl_NumUtfChars( | | | | | 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 | * None. * *--------------------------------------------------------------------------- */ size_t Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ size_t length) /* The length of the string in bytes, or -1 * for strlen(string). */ { Tcl_UniChar ch = 0; size_t i = 0; /* * The separate implementations are faster. * * Since this is a time-sensitive function, we also do the check for the * single-byte char case specially. */ if (length == TCL_AUTO_LENGTH) { while (*src != '\0') { src += TclUtfToUniChar(src, &ch); i++; } } else { const char *endPtr = src + length - 4; while (src < endPtr) { src += TclUtfToUniChar(src, &ch); i++; } endPtr += 4; while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) { |
︙ | ︙ | |||
967 968 969 970 971 972 973 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( | | | | 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 | * None. * *--------------------------------------------------------------------------- */ int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int fullchar = 0; #if TCL_UTF_MAX <= 4 size_t len = 0; #endif |
︙ | ︙ | |||
1016 1017 1018 1019 1020 1021 1022 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( | | | | 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 | * None. * *--------------------------------------------------------------------------- */ const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ size_t index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; #if TCL_UTF_MAX <= 4 size_t len = 0; #endif if (index != TCL_INDEX_NONE) { |
︙ | ︙ | |||
1329 1330 1331 1332 1333 1334 1335 | { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ | | | 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 | { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes * fine in the strcmp manner. */ int result = 0; for ( ; numBytes != 0; numBytes--, cs++, ct++) { if (*cs != *ct) { result = UCHAR(*cs) - UCHAR(*ct); break; } } |
︙ | ︙ |
Changes to generic/tclUtil.c.
︙ | ︙ | |||
1338 1339 1340 1341 1342 1343 1344 | * None. * *---------------------------------------------------------------------- */ size_t Tcl_ConvertCountedElement( | | | 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 | * None. * *---------------------------------------------------------------------- */ size_t Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ size_t length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { size_t numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; |
︙ | ︙ | |||
1371 1372 1373 1374 1375 1376 1377 | * None. * *---------------------------------------------------------------------- */ size_t TclConvertElement( | | | 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 | * None. * *---------------------------------------------------------------------- */ size_t TclConvertElement( const char *src, /* Source information for list element. */ size_t length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { int conversion = flags & CONVERT_MASK; char *p = dst; |
︙ | ︙ |
Changes to generic/tclVar.c.
︙ | ︙ | |||
528 529 530 531 532 533 534 | * *---------------------------------------------------------------------- */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ | | | 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 | * *---------------------------------------------------------------------- */ Var * TclObjLookupVar( Tcl_Interp *interp, /* Interpreter to use for lookup. */ Tcl_Obj *part1Ptr, /* If part2 isn't NULL, this is the name of an * array. Otherwise, this is a full variable * name that could include a parenthesized * array element. */ const char *part2, /* Name of element within array, or NULL. */ int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * and TCL_LEAVE_ERR_MSG bits matter. */ const char *msg, /* Verb to use in error messages, e.g. "read" |
︙ | ︙ | |||
601 602 603 604 605 606 607 | Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; | | | 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 | Var **arrayPtrPtr) /* If the name refers to an element of an * array, *arrayPtrPtr gets filled in with * address of array variable. Otherwise this * is set to NULL. */ { Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Var *varPtr; /* Points to the variable's in-frame Var * structure. */ const char *errMsg = NULL; int index, parsed = 0; int localIndex; Tcl_Obj *namePtr, *arrayPtr, *elem; |
︙ | ︙ | |||
977 978 979 980 981 982 983 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { | | | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; size_t localLen; for (i=0 ; i<localCt ; i++, objPtrPtr++) { Tcl_Obj *objPtr = *objPtrPtr; if (objPtr) { localNameStr = TclGetStringFromObj(objPtr, &localLen); if ((varLen == localLen) && (varName[0] == localNameStr[0]) && !memcmp(varName, localNameStr, varLen)) { *indexPtr = i; |
︙ | ︙ | |||
1273 1274 1275 1276 1277 1278 1279 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | | 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjGetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-null, points to an object holding * the name of an element in the array * part1Ptr. */ int flags) /* OR-ed combination of TCL_GLOBAL_ONLY and * TCL_LEAVE_ERR_MSG bits. */ { Var *varPtr, *arrayPtr; |
︙ | ︙ | |||
1371 1372 1373 1374 1375 1376 1377 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrGetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* The variable to be read.*/ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ const int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, and |
︙ | ︙ | |||
1477 1478 1479 1480 1481 1482 1483 | *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ | | | 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_SetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp,/* Current interpreter. */ int 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); |
︙ | ︙ | |||
1654 1655 1656 1657 1658 1659 1660 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ | | | | 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 | *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_ObjSetVar2( Tcl_Interp *interp, /* Command interpreter in which variable is to * be found. */ Tcl_Obj *part1Ptr, /* Points to an object holding the name of an * array (if part2 is non-NULL) or the name of * a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, points to an object holding * the name of an element in the array * part1Ptr. */ Tcl_Obj *newValuePtr, /* New value for variable. */ int flags) /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or * TCL_LEAVE_ERR_MSG. */ |
︙ | ︙ | |||
1894 1895 1896 1897 1898 1899 1900 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ | | | 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 | *---------------------------------------------------------------------- */ Tcl_Obj * TclPtrSetVarIdx( Tcl_Interp *interp, /* Command interpreter in which variable is to * be looked up. */ Var *varPtr, /* Reference to the variable to set. */ Var *arrayPtr, /* Reference to the array containing the * variable, or NULL if the variable is a * scalar. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. NULL if the 'index' * parameter is >= 0 */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element |
︙ | ︙ | |||
2214 2215 2216 2217 2218 2219 2220 | * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { | | | 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 | * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the * variable, or -1. Only used when part1Ptr is * NULL. */ { Tcl_Obj *varValuePtr; if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags, index); if (TclIsVarInHash(varPtr)) { |
︙ | ︙ | |||
2424 2425 2426 2427 2428 2429 2430 | *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ | | | 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 | *---------------------------------------------------------------------- */ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ Var *varPtr, /* The variable to be unset. */ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ const int flags, /* OR-ed combination of any of |
︙ | ︙ | |||
2678 2679 2680 2681 2682 2683 2684 | int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 | int Tcl_UnsetObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, flags = TCL_LEAVE_ERR_MSG; const char *name; if (objc == 1) { /* * Do nothing if no arguments supplied, so as to match command * documentation. */ |
︙ | ︙ | |||
2747 2748 2749 2750 2751 2752 2753 | Tcl_AppendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; | | | 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 | Tcl_AppendObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; Tcl_Obj *varValuePtr = NULL; /* Initialized to avoid compiler warning. */ int i; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
4746 4747 4748 4749 4750 4751 4752 | Tcl_Interp *interp, /* Interpreter containing the variable. */ Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; | | | 4746 4747 4748 4749 4750 4751 4752 4753 4754 4755 4756 4757 4758 4759 4760 | Tcl_Interp *interp, /* Interpreter containing the variable. */ Tcl_Var variable, /* Token for the variable returned by a * previous call to Tcl_FindNamespaceVar. */ Tcl_Obj *objPtr) /* Points to the object onto which the * variable's full name is appended. */ { Interp *iPtr = (Interp *) interp; Var *varPtr = (Var *) variable; Tcl_Obj *namePtr; Namespace *nsPtr; if (!varPtr || TclIsVarArrayElement(varPtr)) { return; } |
︙ | ︙ | |||
4806 4807 4808 4809 4810 4811 4812 | Tcl_GlobalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; | | | | 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 | Tcl_GlobalObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int 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, i; /* * If we are not executing inside a Tcl procedure, just return. */ if (!HasLocalVars(iPtr->varFramePtr)) { |
︙ | ︙ | |||
5203 5204 5205 5206 5207 5208 5209 | * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, | | | 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 5214 5215 5216 5217 | * *---------------------------------------------------------------------- */ static void DeleteSearches( Interp *iPtr, Var *arrayVarPtr) /* Variable whose searches are to be * deleted. */ { ArraySearch *searchPtr, *nextPtr; Tcl_HashEntry *sPtr; if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) { sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr); |
︙ | ︙ | |||
5345 5346 5347 5348 5349 5350 5351 | TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; | | | 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 5358 5359 | TclDeleteVars( Interp *iPtr, /* Interpreter to which variables belong. */ TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; Var *varPtr; int flags; Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback functions. */ |
︙ | ︙ | |||
5397 5398 5399 5400 5401 5402 5403 | void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { | | | 5397 5398 5399 5400 5401 5402 5403 5404 5405 5406 5407 5408 5409 5410 5411 | void TclDeleteCompiledLocalVars( Interp *iPtr, /* Interpreter to which variables belong. */ CallFrame *framePtr) /* Procedure call frame containing compiler- * assigned local variables to delete. */ { Var *varPtr; int numLocals, i; Tcl_Obj **namePtrPtr; numLocals = framePtr->numCompiledLocals; varPtr = framePtr->compiledLocals; namePtrPtr = &localName(framePtr, 0); for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) { |
︙ | ︙ | |||
5446 5447 5448 5449 5450 5451 5452 | int flags, /* Flags to pass to TclCallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; | | | 5446 5447 5448 5449 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 | int flags, /* Flags to pass to TclCallVarTraces: * TCL_TRACE_UNSETS and sometimes * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */ int index) { Tcl_HashSearch search; Tcl_HashEntry *tPtr; Var *elPtr; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; VarTrace *tracePtr; for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search); elPtr != NULL; elPtr = VarHashNextVar(&search)) { if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) { |
︙ | ︙ | |||
5635 5636 5637 5638 5639 5640 5641 | * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { | | | | 5635 5636 5637 5638 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 5654 5655 5656 5657 5658 5659 5660 5661 5662 5663 5664 5665 5666 | * Tcl_Obj), or NULL if it is a scalar variable */ static void FreeParsedVarName( Tcl_Obj *objPtr) { Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(objPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ if (arrayPtr != NULL) { TclDecrRefCount(arrayPtr); TclDecrRefCount(elem); } } static void DupParsedVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { Tcl_Obj *arrayPtr, *elem; int parsed; ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem); parsed++; /* Silence compiler. */ ParsedSetIntRep(dupPtr, arrayPtr, elem); } |
︙ | ︙ | |||
5741 5742 5743 5744 5745 5746 5747 | * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; | | | 5741 5742 5743 5744 5745 5746 5747 5748 5749 5750 5751 5752 5753 5754 5755 | * TCL_GLOBAL_ONLY is ignored. */ { Interp *iPtr = (Interp *) interp; ResolverScheme *resPtr; Namespace *nsPtr[2], *cxtNsPtr; const char *simpleName; Var *varPtr; int search; int result; Tcl_Var var; Tcl_Obj *simpleNamePtr; const char *name = TclGetString(namePtr); /* * If this namespace has a variable resolver, then give it first crack at |
︙ | ︙ | |||
6397 6398 6399 6400 6401 6402 6403 | static int CompareVarKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; | | | | 6397 6398 6399 6400 6401 6402 6403 6404 6405 6406 6407 6408 6409 6410 6411 6412 | static int CompareVarKeys( void *keyPtr, /* New key to compare. */ Tcl_HashEntry *hPtr) /* Existing key to compare. */ { Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr; Tcl_Obj *objPtr2 = hPtr->key.objPtr; const char *p1, *p2; size_t l1, l2; /* * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller * * if (objPtr1 == objPtr2) return 1; */ |
︙ | ︙ |
Changes to tests/stringObj.test.
︙ | ︙ | |||
435 436 437 438 439 440 441 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo | | | | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 | } 1 test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} { string length [testbytestring \x01\x00\x02] } 3 test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj { teststringobj set 1 foo teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj maxchars 1 teststringobj append 1 bar -1 teststringobj setlength 1 0 teststringobj append 1 bar -1 teststringobj get 1 } {bar} test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj { |
︙ | ︙ |
Changes to tests/utf.test.
︙ | ︙ | |||
467 468 469 470 471 472 473 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b | | | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 | test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 a teststringobj set 2 b teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result -1 test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 b teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 B teststringobj set 2 a teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \ -setup { testobj freeallvars } \ -body { teststringobj set 1 aBcB teststringobj set 2 abca teststringobj maxchars 1 teststringobj maxchars 2 string compare -nocase [teststringobj get 1] [teststringobj get 2] } \ -cleanup { testobj freeallvars } \ -result 1 |
︙ | ︙ |